X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=1dfdded8b0f75f5a9e360601f3baf65c4740e85e;hp=925afa3da7b47a52cba9bdc87238cfb4deab2323;hb=8eb8d6707f84064d3a3cd2947ca04fe17fc3f22e;hpb=65621cde0534f742b5cbd9b523938b296bdd8080 diff --git a/elpher.el b/elpher.el index 925afa3..1dfdded 100644 --- a/elpher.el +++ b/elpher.el @@ -332,7 +332,7 @@ the start page." (unless (and (not (url-fullness url)) (url-type url)) (setf (url-fullness url) t) (unless (url-type url) - (setf (url-type url) (elpher-get-default-url-type))) + (setf (url-type url) elpher-default-url-type)) (unless (url-host url) (let ((p (split-string (url-filename url) "/" nil nil))) (setf (url-host url) (car p)) @@ -340,6 +340,8 @@ the start page." (if (cdr p) (concat "/" (mapconcat #'identity (cdr p) "/")) "")))) + (when (url-host url) + (setf (url-host url) (puny-encode-domain (url-host url)))) (when (or (equal "gopher" (url-type url)) (equal "gophers" (url-type url))) ;; Gopher defaults @@ -353,18 +355,6 @@ the start page." (elpher-remove-redundant-ports url)) (set-match-data data)))) -(defun elpher-get-default-url-type () - "Get the current URL type or `elpher-default-url-type'. -If no scheme is provided for a URL, the current context specifies -the scheme to use, so if we're looking at a gemini page, then the -default type is \"gemini\" even if `elpher-default-url-type' is -\"gopher\"." - (or (and elpher-current-page - (symbol-name - (elpher-address-type - (elpher-page-address elpher-current-page)))) - elpher-default-url-type)) - (defun elpher-remove-redundant-ports (address) "Remove redundant port specifiers from ADDRESS. Here 'redundant' means that the specified port matches the default @@ -521,24 +511,17 @@ readability." "Return an IRI for URL. Decode percent-escapes and handle punycode in the domain name. Drop the password, if any." - (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url)))) - (host (url-host address)) - (pass (url-password address))) - (when host - (setf (url-host address) (puny-decode-domain host))) - (when pass ; RFC 3986 says we should not render - (setf (url-password address) nil)) ; the password as clear text - (url-recreate-url address))) - -(defun elpher-encode-url (iri) - "Return an URL for the IRI. -Encode and use percent-escapes, use punycode for the domain name -if necessary." - (let* ((address (url-generic-parse-url iri)) - (host (url-host address))) - (when host - (setf (url-host address) (puny-encode-domain host))) - (url-recreate-url address))) + (let ((data (match-data))) ; Prevent parsing clobbering match data + (unwind-protect + (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url)))) + (host (url-host address)) + (pass (url-password address))) + (when host + (setf (url-host address) (puny-decode-domain host))) + (when pass ; RFC 3986 says we should not render + (setf (url-password address) nil)) ; the password as clear text + (url-recreate-url address)) + (set-match-data data)))) (defvar elpher-current-page nil "The current page for this Elpher buffer.") @@ -1451,7 +1434,7 @@ 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 - (elpher-encode-url (string-trim (elt l 0))) + (string-trim (elt l 0)) nil))) (defun elpher-gemini-get-link-display-string (link-line) @@ -1461,20 +1444,23 @@ Returns the url portion in the event that the display-string portion is empty." (idx (string-match "[ \t]" rest))) (string-trim (if idx (substring rest (+ idx 1)) - (elpher-url-to-iri rest))))) + rest)))) (defun elpher-collapse-dot-sequences (filename) - "Collapse dot sequences in FILENAME. -For instance, the filename /a/b/../c/./d will reduce to /a/c/d" - (let* ((path (split-string filename "/")) + "Collapse dot sequences in the (absolute) FILENAME. +For instance, the filename \"/a/b/../c/./d\" will reduce to \"/a/c/d\"" + (let* ((path (split-string filename "/" t)) + (is-directory (string-match-p (rx (: (or "." ".." "/") line-end)) filename)) (path-reversed-normalized (seq-reduce (lambda (a b) - (cond ((and a (equal b "..") (cdr a))) - ((and (not a) (equal b "..")) a) ;leading .. are dropped + (cond ((equal b "..") (cdr a)) ((equal b ".") a) (t (cons b a)))) - path nil))) - (string-join (reverse path-reversed-normalized) "/"))) + path nil)) + (path-normalized (reverse path-reversed-normalized))) + (if path-normalized + (concat "/" (string-join path-normalized "/") (and is-directory "/")) + "/"))) (defun elpher-address-from-gemini-url (url) "Extract address from URL with defaults as per gemini map files. @@ -1494,6 +1480,8 @@ treatment that a separate function is warranted." (setf (url-filename address) (concat (file-name-directory (url-filename current-address)) (url-filename address))))) + (when (url-host address) + (setf (url-host address) (puny-encode-domain (url-host address)))) (unless (url-type address) (setf (url-type address) (url-type current-address))) (when (equal (url-type address) "gemini")