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

[Št?pán N?mec]

branch: master
commit 188bd80a903d34ef6a85b09e99890433e7adceb7
Author: Štěpán Němec <address@hidden>
Commit: Štěpán Němec <address@hidden>

    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'.
---
 lisp/emacs-lisp/subr-x.el |  9 +++++++++
 lisp/gnus/gnus-sum.el     | 14 +++++++-------
 lisp/vc/ediff-init.el     | 10 ----------
 lisp/vc/ediff-mult.el     |  9 ++++-----
 4 files changed, 20 insertions(+), 22 deletions(-)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 044c9aa..9f96ac5 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -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
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a47e657..6f36769 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -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.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index e59d4b5..da6509b 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -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 ""))))
 
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8..2b1b079 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -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)