From: Tim Vaughan Date: Sat, 16 May 2020 12:30:50 +0000 (+0200) Subject: Bug fix: redirects now rewrite current address. X-Git-Tag: v2.7.1 X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=bea10793f68037947b6fec30a86316ca2123bbfa;p=elpher.git Bug fix: redirects now rewrite current address. See "Redirects do not rewrite current address" in ISSUES.org for details. --- diff --git a/ISSUES.org b/ISSUES.org index 03ca588..0ce57fd 100644 --- a/ISSUES.org +++ b/ISSUES.org @@ -163,3 +163,11 @@ I suspect the problem is in either ~elpher-visit-node~ or Follow-up: this has been fixed by the new stack-based history system in 2.5. + +** CLOSED Redirects do not rewrite current address + +This is a bug, as gemini://blah.com/hi may get redirected +to gemini://blah.com/hi/, at which point link lines +of the form "=> there" should be interpreted as pointing +at gemini://blah.com/hi/there, while currently they are +interpreted as pointing at gemini://blah.com/there. diff --git a/elpher.el b/elpher.el index f1fe8ea..f13092a 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 2.7.0 +;; Version: 2.7.1 ;; Keywords: comm gopher ;; Homepage: http://thelambdalab.xyz/elpher ;; Package-Requires: ((emacs "26")) @@ -70,7 +70,7 @@ ;;; Global constants ;; -(defconst elpher-version "2.7.0" +(defconst elpher-version "2.7.1" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -388,6 +388,10 @@ If no address is defined, returns 0. (This is for compatibility with the URL li "Retrieve the address corresponding to PAGE." (elt page 1)) +(defun elpher-page-set-address (page new-address) + "Set the address corresponding to PAGE to NEW-ADDRESS." + (setcar (cdr page) new-address)) + (defvar elpher-current-page nil) (defvar elpher-history nil) @@ -940,6 +944,7 @@ that the response was malformed." "gemini")) (error "Server tried to automatically redirect to non-gemini URL: %s" response-meta)) + (elpher-page-set-address elpher-current-page redirect-address) (add-to-list 'elpher-gemini-redirect-chain redirect-address) (elpher-get-gemini-response redirect-address renderer))) (?4 ; Temporary failure @@ -1005,17 +1010,23 @@ that the response was malformed." (_other (error "Unsupported MIME type %S" mime-type)))))) -(defun elpher-gemini-get-link-url (line) - "Extract the url portion of LINE, a gemini map file link line." - (string-trim (elt (split-string (substring line 2)) 0))) - -(defun elpher-gemini-get-link-display-string (line) - "Extract the display string portion of LINE, a gemini map file link line." - (let* ((rest (string-trim (elt (split-string line "=>") 1))) +(defun elpher-gemini-get-link-url (link-line) + "Extract the url portion of LINK-LINE, a gemini map file link line. +Returns nil in the event that the contents of the line following the +=> prefix are empty." + (let ((l (split-string (substring link-line 2)))) + (if l + (string-trim (elt l 0)) + nil))) + +(defun elpher-gemini-get-link-display-string (link-line) + "Extract the display string portion of LINK-LINE, a gemini map file link line. +Returns the url portion in the event that the display-string portion is empty." + (let* ((rest (string-trim (elt (split-string link-line "=>") 1))) (idx (string-match "[ \t]" rest))) - (if idx - (string-trim (substring rest (+ idx 1))) - ""))) + (string-trim (if idx + (substring rest (+ idx 1)) + rest)))) (defun elpher-collapse-dot-sequences (filename) "Collapse dot sequences in FILENAME. @@ -1054,24 +1065,24 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d" (defun elpher-gemini-insert-link (link-line) "Insert link described by LINK-LINE into a text/gemini document." (let* ((url (elpher-gemini-get-link-url link-line)) - (display-string (let ((s (elpher-gemini-get-link-display-string link-line))) - (if (string-empty-p s) url s))) + (display-string (elpher-gemini-get-link-display-string link-line)) (address (elpher-address-from-gemini-url url)) (type (if address (elpher-address-type address) nil)) (type-map-entry (cdr (assoc type elpher-type-map)))) - (insert "→ ") - (if type-map-entry - (let* ((face (elt type-map-entry 3)) - (filtered-display-string (ansi-color-filter-apply display-string)) - (page (elpher-make-page filtered-display-string address))) - (insert-text-button filtered-display-string - 'face face - 'elpher-page page - 'action #'elpher-click-link - 'follow-link t - 'help-echo (elpher-page-button-help page))) - (insert (propertize display-string 'face 'elpher-unknown))) - (insert "\n"))) + (when display-string + (insert "→ ") + (if type-map-entry + (let* ((face (elt type-map-entry 3)) + (filtered-display-string (ansi-color-filter-apply display-string)) + (page (elpher-make-page filtered-display-string address))) + (insert-text-button filtered-display-string + 'face face + 'elpher-page page + 'action #'elpher-click-link + 'follow-link t + 'help-echo (elpher-page-button-help page))) + (insert (propertize display-string 'face 'elpher-unknown))) + (insert "\n")))) (defun elpher-gemini-insert-header (header-line) "Insert header described by HEADER-LINE into a text/gemini document.