04/04: goggles: Linkify only the matching URL substring.

[Tobias Geerinckx-Rice]

nckx pushed a commit to branch master
in repository maintenance.

commit 2cae951f3fd2fe7f4bb678781e7928428719cae7
Author: Tobias Geerinckx-Rice <me@tobias.gr>
AuthorDate: Sun Sep 25 02:00:01 2022 +0200

    goggles: Linkify only the matching URL substring.
    
    * hydra/goggles.scm (linkify-regexp): Exclude common ‘separators’.
    (make-line-renderer): Render MATCH:PREFIX and MATCH:SUFFIX as plain text.
---
 hydra/goggles.scm | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

diff --git a/hydra/goggles.scm b/hydra/goggles.scm
index 685b33a..502e8ff 100755
--- a/hydra/goggles.scm
+++ b/hydra/goggles.scm
@@ -301,7 +301,12 @@ ul {
   (string=? filename (dirname filename)))
 
 (define linkify-regexp
-  (make-regexp "https?://.+" regexp/icase))
+  ;; Rather than attempt to write a ‘valid URL regexp’, the first few
+  ;; on-line examples of which looked suspect, exclude a few characters
+  ;; commonly observed in practice, e.g.:
+  ;; <nckx> Guix is great! (source: <https://guix.gnu.org>)
+  ;; XXX This and the regexp-exec code below assume max. 1 URL per token.  OK?
+  (make-regexp "https?://[^][><)('\",]+" regexp/icase))
 
 (define (make-line-renderer lines)
   "Return a procedure that converts a line into an SXML
@@ -336,19 +341,26 @@ representation highlighting certain parts."
                       ,nick))
              (span (@ (class "message"))
                    ,@(reverse (fold (lambda (chunk acc)
-                                      (cond
-                                       ((regexp-exec linkify-regexp chunk)
-                                        (cons* " "
-                                               `(a (@ (rel "nofollow")
-                                                     (href ,chunk)) ,chunk)
-                                               " "
-                                               acc))
-                                       (else
-                                        (match acc
-                                          (((? string? s) . rest)
-                                           (cons (string-append s " " chunk) 
(cdr acc)))
-                                          (_ (cons chunk acc)))))) '()
-                                          rest))))))))
+                                      (let* ((m (regexp-exec linkify-regexp
+                                                             chunk)))
+                                        (cond
+                                         ((regexp-match? m)
+                                          (let ((url (match:substring m)))
+                                            (cons* " "
+                                                   (match:suffix m)
+                                                   `(a (@ (rel "nofollow")
+                                                          (href ,url))
+                                                       ,url)
+                                                   (match:prefix m)
+                                                   " "
+                                                   acc)))
+                                         (else
+                                          (match acc
+                                            (((? string? s) . rest)
+                                             (cons (string-append s " " chunk)
+                                                   (cdr acc)))
+                                            (_ (cons chunk acc)))))))
+                                    '() rest))))))))
 
 (define (render-log channel root path)
   ;; PATH is a list of path components