gnus-shorten-url: Improve and avoid args-out-of-range error

'gnus-shorten-url' (used by 'gnus-summary-browse-url') ignored
fragment identifiers and didn't check substring bounds, in some cases
leading to runtime errors, e.g.:

  (gnus-shorten-url "https://some.url.with/path/and#also_a_long_target" 40)
  ;; => Lisp error: (args-out-of-range "/path/and" -18 nil)

This commit makes it account for #fragments and fixes faulty string
computation, reusing existing helper function.  (bug#39980)

* lisp/vc/ediff-init.el (ediff-truncate-string-left): Rename to
'string-truncate-left' and move...
* lisp/emacs-lisp/subr-x.el (string-truncate-left):  ...here.
All callers changed.
* lisp/gnus/gnus-sum.el (gnus-shorten-url): Fix args-out-of-range
error, don't drop #fragments, use 'string-truncate-left'.
This commit is contained in:
Štěpán Němec 2020-03-07 18:26:44 +01:00
parent c395ebaf21
commit 188bd80a90
4 changed files with 20 additions and 22 deletions

View file

@ -236,6 +236,15 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(string-trim-left (string-trim-right string trim-right) trim-left))
;;;###autoload
(defun string-truncate-left (string length)
"Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
(let ((strlen (length string)))
(if (<= strlen length)
string
(setq length (max 0 (- length 3)))
(concat "..." (substring string (max 0 (- strlen 1 length)))))))
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and

View file

@ -9494,15 +9494,15 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(delete-dups urls)))
(defun gnus-shorten-url (url max)
"Return an excerpt from URL."
"Return an excerpt from URL not exceeding MAX characters."
(if (<= (length url) max)
url
(let ((parsed (url-generic-parse-url url)))
(concat (url-host parsed)
"..."
(substring (url-filename parsed)
(- (length (url-filename parsed))
(max (- max (length (url-host parsed))) 0)))))))
(let* ((parsed (url-generic-parse-url url))
(host (url-host parsed))
(rest (concat (url-filename parsed)
(when-let ((target (url-target parsed)))
(concat "#" target)))))
(concat host (string-truncate-left rest (- max (length host)))))))
(defun gnus-summary-browse-url (&optional external)
"Scan the current article body for links, and offer to browse them.

View file

@ -1510,16 +1510,6 @@ This default should work without changes."
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
(defun ediff-truncate-string-left (str newlen)
;; leave space for ... on the left
(let ((len (length str))
substr)
(if (<= len newlen)
str
(setq newlen (max 0 (- newlen 3)))
(setq substr (substring str (max 0 (- len 1 newlen))))
(concat "..." substr))))
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))

View file

@ -113,7 +113,6 @@
(require 'ediff-wind)
(require 'ediff-util)
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
@ -1172,7 +1171,7 @@ behavior."
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
(ediff-truncate-string-left
(string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@ -1266,7 +1265,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
(ediff-truncate-string-left
(string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@ -1281,7 +1280,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
(ediff-truncate-string-left
(string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@ -1295,7 +1294,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
(ediff-truncate-string-left
(string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)