cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [gemini] fixed building of URI in 'open-next-visible-link'.

This commit is contained in:
cage 2021-12-04 14:33:53 +01:00
parent 7ffe40668a
commit 1d290898e1
2 changed files with 23 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/iri-parser.lisp
View File

@ -245,6 +245,18 @@
(defclass iri (uri:uri) ())
(defmethod print-object ((object iri) stream)
(print-unreadable-object (object stream)
(format stream
"~s ~s ~s ~s ~s ~s ~s"
(uri:scheme object)
(uri:user-info object)
(uri:host object)
(uri:port object)
(uri:path object)
(uri:query object)
(uri:fragment object))))
(defun make-iri (&optional scheme user-info host port path query fragment)
(make-instance 'iri
:scheme scheme

21
src/ui-goodies.lisp
View File

@ -1219,16 +1219,17 @@ Browse and optionally open the links the text of the message window contains."
(when-let* ((visible-rows (message-window:visible-rows *message-window*))
(link-line (message-window:row-find-original-object visible-rows
'gemini-parser:link-line))
(link-object (message-window:extract-original-object link-line))
(uri (gemini-parser::link-value link-object))
(current-url (iri:iri-parse (gemini-viewer:current-gemini-url)))
(absolute-uri (if (iri:absolute-url-p uri)
uri
(gemini-parser:absolutize-link uri
(uri:host current-url)
(uri:port current-url)
nil))))
(open-message-link-window:open-message-link absolute-uri nil)))
(link-object (message-window:extract-original-object link-line)))
(let* ((uri (gemini-parser::link-value link-object))
(current-url (ignore-errors (iri:iri-parse (gemini-viewer:current-gemini-url))))
(absolute-uri (if (or (null current-url)
(iri:absolute-url-p uri))
uri
(gemini-parser:absolutize-link uri
(uri:host current-url)
(uri:port current-url)
(uri:path current-url)))))
(open-message-link-window:open-message-link absolute-uri nil))))
(defun go-to-next-link ()
(when-let* ((win *message-window*)