- fixed extraction of URLs of the selected status in threads window if

it is a reblogged one.

src/message-window.lisp

@@ -870,19 +870,9 @@ fragment matches- move the window to the line when matching occurred."
             (row-move window (+ starting-match-row-pos line-matched))
             (draw window)))))))
 
-(defgeneric lines->uri (object))
-
 (defmethod lines->uri ((object message-window))
   (flatten (map-rows object
                      (lambda (row)
                        (when-let* ((text-line (line->text row))
                                    (uri       (lines->uri text-line)))
                          uri)))))
-
-(defmethod lines->uri ((object string))
-  (when-let* ((words (split-words object)))
-    (remove-if (lambda (word)
-                 (if (< (length word) 4)
-                     t
-                     (not (iri:absolute-url-p word))))
-               words)))

src/open-message-link-window.lisp

@@ -41,8 +41,12 @@
                                       :selected-bg   fg
                                       :selected-fg   bg))
                      links)))
-      (let* ((message (db:find-status-id status-id))
+      (let* ((message               (db:find-status-id status-id))
-             (links   (reverse (text-utils:collect-links (db:row-message-rendered-text message)))))
+             (reblogged-status-body (thread-window::reblogged-data message))
+             (body                  (db:row-message-rendered-text message))
+             (links                 (reverse (if (string-not-empty-p reblogged-status-body)
+                                                 (collect-links reblogged-status-body)
+                                                 (collect-links body)))))
         (with-croatoan-window (croatoan-window object)
           (when hooks:*before-displaying-links-hook*
             (setf links

src/package.lisp

@@ -410,6 +410,7 @@
    :cl
    :config)
   (:import-from :misc :definline)
+  (:local-nicknames (:a :alexandria))
   (:export
    :+float-regexp+
    :+integer-regexp+
@@ -450,6 +451,7 @@
    :annotated-text-symbol
    :annotated-text-value
    :box-fit-multiple-column-annotated
+   :lines->uri
    :collect-links
    :percent-encode
    :percent-decode
@@ -2479,7 +2481,6 @@
    :generate-gemini-toc
    :gemini-toc-entry
    :gemini-toc-group-id
-   :lines->uri
    :init
    :search-gemini-fragment))
 

src/text-utils.lisp

@@ -34,9 +34,9 @@
 
 (in-package :text-utils)
 
-(alexandria:define-constant +float-regexp+   "-?[0-9]+(\\.[0-9]+([eE]-?[0-9]+)?)?" :test 'string=)
+(a:define-constant +float-regexp+   "-?[0-9]+(\\.[0-9]+([eE]-?[0-9]+)?)?" :test 'string=)
 
-(alexandria:define-constant +integer-regexp+ "0|[1-9][0-9]+|[1-9]"                 :test 'string=)
+(a:define-constant +integer-regexp+ "0|[1-9][0-9]+|[1-9]"                 :test 'string=)
 
 (defun uchar-length (leading-byte)
   (let ((ones (do* ((ct 7 (1- ct))
@@ -123,9 +123,9 @@
     (let* ((prefix-count    0)
            (sorted-strings (num:shellsort strings #'(lambda (a b) (> (length a)
                                                                      (length b)))))
-           (pivot-string   (alexandria:first-elt sorted-strings))
+           (pivot-string   (a:first-elt sorted-strings))
            (actual-strings (rest sorted-strings))
-           (res            (string (alexandria:first-elt pivot-string))))
+           (res            (string (a:first-elt pivot-string))))
       (labels ((advance-res ()
                  (incf prefix-count)
                  (setf res (strcat res (string (elt pivot-string prefix-count)))))
@@ -625,9 +625,9 @@ printed in the box column by column; in the example above the results are:
       (labels ((length-fitted (line)
                  (length (cat-annotated-values line)))
                (cut-last (line)
-                 (let ((shrinked (coerce (misc:safe-all-but-last-elt (cdr (alexandria:last-elt line)))
+                 (let ((shrinked (coerce (misc:safe-all-but-last-elt (cdr (a:last-elt line)))
                                          'string)))
-                   (setf (cdr (alexandria:last-elt line))
+                   (setf (cdr (a:last-elt line))
                          shrinked)
                    (remove-if (lambda (a)
                                 (let((string (cdr a)))
@@ -660,9 +660,9 @@ printed in the box column by column; in the example above the results are:
              (let* ((raw-string  (cat-annotated-values line))
                     (diff        (- max-width
                                     (length raw-string)))
-                    (last-string (cdr (alexandria:last-elt line))))
+                    (last-string (cdr (a:last-elt line))))
                (when (> diff 0)
-                 (setf (cdr (alexandria:last-elt line))
+                 (setf (cdr (a:last-elt line))
                        (strcat last-string
                                (build-string diff))))
                line))
@@ -702,6 +702,16 @@ printed in the box column by column; in the example above the results are:
                    (list columns)))))
     (fit)))
 
+(defgeneric lines->uri (object))
+
+(defmethod lines->uri ((object string))
+  (a:when-let ((words (split-words object)))
+    (remove-if (lambda (word)
+                 (if (< (length word) 4)
+                     t
+                     (not (iri:absolute-url-p word))))
+               words)))
+
 (defun collect-links (text &optional (schemes '("http" "https" "ftp" "gemini" "gopher")))
   "Collect all hyperlinks in a text marked from a list of valid `schemes'"
   (flet ((build-re-scheme ()
@@ -711,15 +721,13 @@ printed in the box column by column; in the example above the results are:
                       (setf res (strcat res "(" scheme ")|"))
                       (setf res (strcat res "(" scheme ")://"))))
              (strcat "(" res ")"))))
-    (let* ((results ())
+    (a:when-let* ((all-uris (lines->uri text))
-           (re      (strcat (build-re-scheme) "\\P{White_Space}+"))
+                  (re       (strcat (build-re-scheme) "\\P{White_Space}+"))
-           (words   (split-words text))
+                  (scanner (cl-ppcre:create-scanner re)))
-           (scanner (cl-ppcre:create-scanner re)))
+      (let ((results '()))
-      (loop for word in words when (cl-ppcre:scan scanner word) do
+        (loop for uri in all-uris when (cl-ppcre:scan scanner uri) do
-           (pushnew (cl-ppcre:scan-to-strings scanner word)
+          (pushnew uri results :test #'string=))
-                    results
+        results))))
-                    :test #'string=))
-      results)))
 
 (defun percent-encode (string)
   (percent-encoding:encode string :encoding :utf-8))

src/thread-window.lisp

@@ -883,8 +883,8 @@ db:renumber-timeline-message-index."
              (refresh-event (make-instance 'program-events:refresh-conversations-window-event))
              (poll          (db:find-poll-bound-to-status status-id))
              (poll-text     (poll->text (db:row-id poll)
-                                             (truncate (/ (win-width-no-border object)
+                                        (truncate (/ (win-width-no-border object)
-                                                          2)))))
+                                                     2)))))
         (multiple-value-bind (reblogged-status-body reblogged-status-attachments)
             (reblogged-data fields)
           (let ((actual-body        (if (string= body reblogged-status-body)

src/ui-goodies.lisp

@@ -394,7 +394,7 @@ Metadata includes:
                       :complete-fn   #'complete:tags-complete)))
 
 (defun message-extract-links ()
-  (when-let* ((all-iris  (message-window:lines->uri *message-window*))
+  (when-let* ((all-iris  (text-utils:lines->uri *message-window*))
               (all-links (mapcar (lambda (a)
                                    (make-instance 'gemini-parser:gemini-link
                                                   :target a))