From 008d5001a7780beb247deb54e22c77b06483cdf2 Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 5 Aug 2022 11:30:56 +0200 Subject: [PATCH] - taken into account the query of the original URI when combining it with a path. --- src/gemini-viewer.lisp | 3 ++- src/gemini/gemini-parser.lisp | 32 ++++++++++++++++++++++---------- src/gemini/subscription.lisp | 7 ++++--- src/program-events.lisp | 11 +++++++---- src/ui-goodies.lisp | 7 ++++--- 5 files changed, 39 insertions(+), 21 deletions(-) diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index b9749c2..2cadc72 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -313,10 +313,11 @@ (port port) (path path) (meta meta) + (query query) (status-code status-code) (status-code-description status-code-description)) stream-object (let* ((parsed (gemini-parser:parse-gemini-file src-data)) - (links (gemini-parser:sexp->links parsed host port path)) + (links (gemini-parser:sexp->links parsed host port path query)) (response (gemini-client:make-gemini-file-response status-code status-code-description meta diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index deb0d94..b62bdc0 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -260,18 +260,29 @@ path (fs:parent-dir-path path))) -(defun absolutize-link (link-value original-host original-port original-path) +(defun absolutize-link (link-value original-host original-port original-path original-query) (let ((parsed (or (ignore-errors (iri:iri-parse link-value)) (iri:make-iri nil nil nil nil link-value nil nil)))) (cond ((null (uri:host parsed)) - (let* ((absolute-path-p (string-starts-with-p "/" link-value)) - (path (if absolute-path-p - (uri:path parsed) - (strcat (if original-path - (path-last-dir original-path) - "/") - (uri:path parsed))))) + (let* ((absolute-path-p (string-starts-with-p "/" link-value)) + (query-path-p (uri:query parsed)) + (path (cond + (absolute-path-p + (uri:path parsed)) + ((and query-path-p + original-query) + (strcat (safe-all-but-last-elt original-path) + (uri:path parsed))) + ((or query-path-p + original-query) + (strcat original-path + (uri:path parsed))) + (t + (strcat (if original-path + (path-last-dir original-path) + "/") + (uri:path parsed)))))) (make-gemini-iri original-host (fs:normalize-path path) :query (uri:query parsed) @@ -325,7 +336,7 @@ (setf iri (strcat iri "#" fragment))) iri)) -(defun sexp->links (parsed-gemini original-host original-port original-path +(defun sexp->links (parsed-gemini original-host original-port original-path original-query &key (comes-from-local-file nil)) (loop for node in parsed-gemini @@ -344,7 +355,8 @@ (absolutize-link link-value original-host original-port - original-path))))) + original-path + original-query))))) (make-instance 'gemini-link :target rendered-link :name (tag-value node))))) diff --git a/src/gemini/subscription.lisp b/src/gemini/subscription.lisp index cd1b367..3956d10 100644 --- a/src/gemini/subscription.lisp +++ b/src/gemini/subscription.lisp @@ -73,9 +73,10 @@ be subscribed before (see: 'gemini-subscription:subcribe'" (gemlog-iri (iri:iri-parse url))) (let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a))) (sexp->links parsed - (uri:host gemlog-iri) - (uri:port gemlog-iri) - (uri:path gemlog-iri))))) + (uri:host gemlog-iri) + (uri:port gemlog-iri) + (uri:path gemlog-iri) + (uri:query gemlog-iri))))) (loop for link in links do (when (not (db:find-gemlog-entry (to-s (target link)))) (let ((date (link-post-timestamp (name link)))) diff --git a/src/program-events.lisp b/src/program-events.lisp index cda7043..45d89f4 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -1100,6 +1100,7 @@ nil nil local-path + nil :comes-from-local-file local-path-p)) (ir-text (gemini-parser:sexp->text-rows parsed gemini-client:*gemini-page-theme*))) @@ -1207,6 +1208,7 @@ nil nil parent-dir + nil :comes-from-local-file t)) (local-links (remove-if (lambda (link) (let ((target (gemini-parser:target link))) @@ -1403,10 +1405,11 @@ (url (iri:iri-parse gemlog-url)) (parsed (gemini-parser:parse-gemini-file gemini-page)) (links (gemini-parser:sexp->links parsed - (uri:host url) - (uri:port url) - (uri:path url))) - (theme gemini-client:*gemini-page-theme*)) + (uri:host url) + (uri:port url) + (uri:path url) + (uri:query url))) + (theme gemini-client:*gemini-page-theme*)) (gemini-viewer:maybe-initialize-metadata specials:*message-window*) (refresh-gemini-message-window links gemini-page diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 4af4d81..e00bfa9 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1411,9 +1411,10 @@ Browse and optionally open the links the text of the message window contains." (iri:absolute-url-p uri)) uri (gemini-parser:absolutize-link uri - (uri:host current-url) - (uri:port current-url) - (uri:path current-url))))) + (uri:host current-url) + (uri:port current-url) + (uri:path current-url) + (uri:query current-url))))) (open-message-link-window:open-message-link absolute-uri nil))))) (defun open-previous-link ()