- added a function to extract and display links extracted from the

contents of a message window;
- fixed 'iri:absolute-url-p'.

etc/init.lisp

@@ -386,6 +386,8 @@
 
 (define-key "j"         #'message-scroll-down                         *message-keymap*)
 
+(define-key "l"         #'message-extract-links                       *message-keymap*)
+
 (define-key "left"      #'message-scroll-left                         *message-keymap*)
 
 (define-key "right"     #'message-scroll-right                        *message-keymap*)

src/iri-parser.lisp

@@ -353,7 +353,8 @@
 
 (defun absolute-url-p (url)
   (when-let ((iri (iri:iri-parse url :null-on-error t)))
-    (not (null (uri:scheme iri)))))
+    (not (or (null (uri:scheme iri))
+             (null (uri:host   iri))))))
 
 (defun ipv4-address-p (string)
   (ignore-errors

src/message-window.lisp

@@ -303,8 +303,8 @@
 (defun make-render-vspace-row (&optional (original-object
                                           (make-instance 'gemini-parser:vertical-space)))
   (let ((res (make-instance 'line
-                 :normal-text (make-tui-string (format nil "~%"))
-                 :fields      (list +row-vertical-space-field-key+ 1))))
+                            :normal-text (make-tui-string (format nil "~%"))
+                            :fields      (list +row-vertical-space-field-key+ 1))))
     (row-add-original-object res original-object)
     (row-add-group-id res (gemini-parser:group-id original-object))
     res))
@@ -504,6 +504,14 @@
   (make-instance 'line
                  :normal-text object))
 
+(defgeneric line->text (object))
+
+(defmethod line->text ((object line))
+  (tui-string->chars-string (normal-text object)))
+
+(defmethod line->text ((object sequence))
+  (map 'list #'line->text object))
+
 (defmethod text->rendered-lines-rows (window (text string))
   (let* ((fitted-lines (%fit-text window text))
          (new-rows     (colorize-lines fitted-lines)))
@@ -842,3 +850,20 @@ fragment matches- move the window to the line when matching occurred."
                                  finally (return line))))
             (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/package.lisp

@@ -2268,6 +2268,7 @@
    :generate-gemini-toc
    :gemini-toc-entry
    :gemini-toc-group-id
+   :lines->uri
    :init
    :search-gemini-fragment))
 
@@ -2739,6 +2740,7 @@
    :thread-mark-prevent-delete-selected-message
    :subscribe-to-hash
    :unsubscribe-to-hash
+   :message-extract-links
    :message-scroll-up
    :message-scroll-down
    :message-scroll-left

src/ui-goodies.lisp

@@ -388,6 +388,14 @@ Metadata includes:
                       :prompt        (_ "Unsubscribe to: ")
                       :complete-fn   #'complete:tags-complete)))
 
+(defun message-extract-links ()
+  (when-let* ((all-iris  (message-window:lines->uri *message-window*))
+              (all-links (mapcar (lambda (a)
+                                   (make-instance 'gemini-parser:gemini-link
+                                                  :target a))
+                                 all-iris)))
+    (open-link-window :links all-links)))
+
 (defun message-scroll-up ()
   (message-window:scroll-up *message-window*))
 
@@ -1442,18 +1450,23 @@ If some posts was deleted before, download them again."
                       :prompt      (_ "Search key: ")
                       :complete-fn #'complete:complete-always-empty)))
 
+(defun open-link-window (&key (give-focus t) (enqueue nil) links)
+  (flet ((process ()
+           (open-message-link-window:init-gemini-links links)
+           (when give-focus
+             (focus-to-open-message-link-window))))
+    (if enqueue
+        (with-enqueued-process ()
+          (process))
+        (process))))
+
 (defun open-gemini-message-link-window (&key (give-focus t) (enqueue nil))
   (let* ((window   *message-window*)
          (metadata (message-window:metadata window))
          (links    (gemini-viewer:gemini-metadata-links metadata)))
-    (flet ((process ()
-             (open-message-link-window:init-gemini-links links)
-             (when give-focus
-               (focus-to-open-message-link-window))))
-      (if enqueue
-          (with-enqueued-process ()
-            (process))
-          (process)))))
+    (open-link-window :give-focus give-focus
+                      :enqueue    enqueue
+                      :links      links)))
 
 (defun open-message-link ()
   "Open message links window