diff --git a/src/message-window.lisp b/src/message-window.lisp index 64b9d0b..8404315 100644 --- a/src/message-window.lisp +++ b/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))) diff --git a/src/open-message-link-window.lisp b/src/open-message-link-window.lisp index 8b9bd31..7f6c18e 100644 --- a/src/open-message-link-window.lisp +++ b/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)) - (links (reverse (text-utils:collect-links (db:row-message-rendered-text message))))) + (let* ((message (db:find-status-id status-id)) + (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 diff --git a/src/package.lisp b/src/package.lisp index 6cb078e..b866fac 100644 --- a/src/package.lisp +++ b/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)) diff --git a/src/text-utils.lisp b/src/text-utils.lisp index 3ff7329..e43ad76 100644 --- a/src/text-utils.lisp +++ b/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 ()) - (re (strcat (build-re-scheme) "\\P{White_Space}+")) - (words (split-words text)) - (scanner (cl-ppcre:create-scanner re))) - (loop for word in words when (cl-ppcre:scan scanner word) do - (pushnew (cl-ppcre:scan-to-strings scanner word) - results - :test #'string=)) - results))) + (a:when-let* ((all-uris (lines->uri text)) + (re (strcat (build-re-scheme) "\\P{White_Space}+")) + (scanner (cl-ppcre:create-scanner re))) + (let ((results '())) + (loop for uri in all-uris when (cl-ppcre:scan scanner uri) do + (pushnew uri results :test #'string=)) + results)))) (defun percent-encode (string) (percent-encoding:encode string :encoding :utf-8)) diff --git a/src/thread-window.lisp b/src/thread-window.lisp index a8d2284..21129f8 100644 --- a/src/thread-window.lisp +++ b/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) - 2))))) + (truncate (/ (win-width-no-border object) + 2))))) (multiple-value-bind (reblogged-status-body reblogged-status-attachments) (reblogged-data fields) (let ((actual-body (if (string= body reblogged-status-body) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 08c3e86..80b6a73 100644 --- a/src/ui-goodies.lisp +++ b/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))