bug#39980: [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error

[Štěpán Němec]

On Sun, 12 Apr 2020 17:35:31 +0300
Eli Zaretskii wrote:

> Let's just come up with a local change in gnus-sum, for the emacs-27
> branch, okay?

OK. I think the pat(c)h of least resistence would be as follows
(everything just the same as for master, but with the helper function
localized to gnus-sum and no changes to other files):

>From 9fd1f20078220c17f9e954b556c6b770ca70961a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=A0t=C4=9Bp=C3=A1n=20N=C4=9Bmec?= <stepnem@gmail.com>
Date: Sun, 12 Apr 2020 19:57:59 +0200
Subject: [PATCH] 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.  (bug#39980)

; Do not merge to master, where the helper is put to subr-x.el.

* lisp/gnus/gnus-sum.el (gnus--string-truncate-left): New helper
function (copied from 'ediff-truncate-string-left').
(gnus-shorten-url): Use it and don't drop #fragments.
---
 lisp/gnus/gnus-sum.el | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a40e563e75..9b11d5878d 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9493,16 +9493,26 @@ gnus-collect-urls
       (push primary urls))
     (delete-dups urls)))
 
+;; cf. `ediff-truncate-string-left', to become `string-truncate-left'
+;; in Emacs 28
+(defun gnus--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)))))))
+
 (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 (gnus--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.
-- 
2.26.0

-- 
Štěpán