X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=dfd139bec31ee234f8ec67ec4c173f7e4e7529f0;hp=3656189260624be1314edfa73219ddce6db1cfc7;hb=03387286db913a90c9e7cd889b0152cb7de39f67;hpb=d5116907245377fe7103153408861564cc2b0dcd diff --git a/elpher.el b/elpher.el index 3656189..dfd139b 100644 --- a/elpher.el +++ b/elpher.el @@ -332,7 +332,6 @@ is not explicitly given." (unwind-protect (let ((url (url-generic-parse-url url-string))) (unless (and (not (url-fullness url)) (url-type url)) - (setf (url-fullness url) t) (unless (url-type url) (setf (url-type url) default-scheme)) (unless (url-host url) @@ -342,7 +341,8 @@ is not explicitly given." (if (cdr p) (concat "/" (mapconcat #'identity (cdr p) "/")) "")))) - (when (url-host url) + (when (not (string-empty-p (url-host url))) + (setf (url-fullness url) t) (setf (url-host url) (puny-encode-domain (url-host url)))) (when (or (equal "gopher" (url-type url)) (equal "gophers" (url-type url))) @@ -516,7 +516,9 @@ in the instance that URL itself doesn't specify one." "Return an IRI for ADDRESS. Decode percent-escapes and handle punycode in the domain name. Drop the password, if any." - (let ((data (match-data))) ; Prevent parsing clobbering match data + (let ((data (match-data)) ; Prevent parsing clobbering match data + (host (url-host address)) + (pass (url-password address))) (unwind-protect (let* ((host (url-host address)) (pass (url-password address))) @@ -524,7 +526,9 @@ Drop the password, if any." (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)) + (elpher-decode (url-unhex-string (url-recreate-url address)))) + (setf (url-host address) host) + (setf (url-password address) pass) (set-match-data data)))) (defvar elpher-current-page nil @@ -1171,14 +1175,16 @@ If ADDRESS is not supplied or nil the record is rendered as an (if (display-images-p) (let* ((image (create-image data - nil t)) - (window (get-buffer-window elpher-buffer-name))) - (when window - (setf (image-property image :max-width) (window-body-width window t)) - (setf (image-property image :max-height) (window-body-height window t))) - (elpher-with-clean-buffer - (insert-image image) - (elpher-restore-pos))) + nil t))) + (if (not image) + (error "Unsupported image format") + (let ((window (get-buffer-window elpher-buffer-name))) + (when window + (setf (image-property image :max-width) (window-body-width window t)) + (setf (image-property image :max-height) (window-body-height window t)))) + (elpher-with-clean-buffer + (insert-image image) + (elpher-restore-pos)))) (elpher-render-download data)))) ;; Search retrieval and rendering @@ -1458,12 +1464,11 @@ Returns nil in the event that the contents of the line following the (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." +Return nil if this portion is not provided." (let* ((rest (string-trim (elt (split-string link-line "=>") 1))) (idx (string-match "[ \t]" rest))) - (string-trim (if idx - (substring rest (+ idx 1)) - rest)))) + (and idx + (elpher-color-filter-apply (string-trim (substring rest (+ idx 1))))))) (defun elpher-collapse-dot-sequences (filename) "Collapse dot sequences in the (absolute) FILENAME. @@ -1489,11 +1494,11 @@ treatment that a separate function is warranted." (let ((address (url-generic-parse-url url)) (current-address (elpher-page-address elpher-current-page))) (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls - (setf (url-fullness address) t) (if (url-host address) ;if there is an explicit host, filenames are absolute (if (string-empty-p (url-filename address)) (setf (url-filename address) "/")) ;ensure empty filename is marked as absolute (setf (url-host address) (url-host current-address)) + (setf (url-fullness address) (url-host address)) ; set fullness to t if host is set (setf (url-portspec address) (url-portspec current-address)) ; (url-port) too slow! (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links (setf (url-filename address) @@ -1510,26 +1515,28 @@ treatment that a separate function is warranted." (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 (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))) - (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s))) - (when display-string - (insert elpher-gemini-link-string) - (if type-map-entry - (let* ((face (elt type-map-entry 3)) - (filtered-display-string (elpher-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)) - (insert (propertize display-string 'face 'elpher-unknown))) - (newline)))) + (let ((url (elpher-gemini-get-link-url link-line))) + (when url + (let* ((given-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))) + (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s))) + (insert elpher-gemini-link-string) + (if type-map-entry + (let* ((face (elt type-map-entry 3)) + (display-string (or given-display-string + (elpher-address-to-iri address))) + (page (elpher-make-page display-string + address))) + (insert-text-button display-string + 'face face + 'elpher-page page + 'action #'elpher-click-link + 'follow-link t + 'help-echo #'elpher--page-button-help)) + (insert (propertize display-string 'face 'elpher-unknown))) + (newline))))) (defun elpher-gemini-insert-header (header-line) "Insert header described by HEADER-LINE into a text/gemini document. @@ -2165,7 +2172,7 @@ When run interactively HOST-OR-URL is read from the minibuffer." (url (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme)) (elpher-address-to-url address)))) (unless (string-empty-p (string-trim url)) - (elpher-visit-page (elpher-page-from-url url) (elpher-get-default-url-scheme))))) + (elpher-visit-page (elpher-page-from-url url))))) (defun elpher-redraw () "Redraw current page."