From: plugd Date: Tue, 10 Aug 2021 09:49:10 +0000 (+0200) Subject: Merged Alex's gemini link line filling. X-Git-Tag: v3.3.0~17 X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=commitdiff_plain;h=11d905f730e73f72cc35bbdcb5989ead112b7c4a;hp=753056c2a33987fb834be545679607ad85884bcf Merged Alex's gemini link line filling. --- diff --git a/ISSUES.org b/ISSUES.org index b1556a0..69df28e 100644 --- a/ISSUES.org +++ b/ISSUES.org @@ -130,9 +130,6 @@ this can happen: - [X] shift history out of node tree and into separate stack - [ ] make history stack variables buffer-local - [ ] have elpher-with-clean-buffer select appropriate buffer - -** OPEN Replace support for user-specified starting pages -This used to be available, but was removed during a refactor. ** OPEN Make installing existing certificates easier :LOGBOOK: @@ -304,3 +301,10 @@ call is just incredibly slow for some bizarre reason. Happily, (url-portspec) is functionally equivalent and is orders of magnitude faster. With this replacement, loading the above page takes ~2s and there aren't any other hotspots. + + +** CLOSED Replace support for user-specified starting pages +:LOGBOOK: +- State "CLOSED" from "OPEN" [2021-08-09 Mon 17:46] +:END: +This used to be available, but was removed during a refactor. diff --git a/elpher.el b/elpher.el index 568abb8..84dd7c1 100644 --- a/elpher.el +++ b/elpher.el @@ -324,15 +324,17 @@ the start page." ;; dynamically for and by elpher. All others represent pages which ;; rely on content retrieved over the network. -(defun elpher-address-from-url (url-string) - "Create a ADDRESS object corresponding to the given URL-STRING." +(defun elpher-address-from-url (url-string &optional default-scheme) + "Create a ADDRESS object corresponding to the given URL-STRING. +If DEFAULT-SCHEME is non-nil, this sets the scheme of the URL when one +is not explicitly given." (let ((data (match-data))) ; Prevent parsing clobbering match data (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) elpher-default-url-type)) + (setf (url-type url) default-scheme)) (unless (url-host url) (let ((p (split-string (url-filename url) "/" nil nil))) (setf (url-host url) (car p)) @@ -424,7 +426,7 @@ address refers to, via the table `elpher-type-map'." (defun elpher-address-gopher-p (address) "Return non-nill if ADDRESS object is a gopher address." - (eq 'gopher (elpher-address-type address))) + (pcase (elpher-address-type address) (`(gopher ,_) t))) (defun elpher-address-protocol (address) "Retrieve the transport protocol for ADDRESS." @@ -500,21 +502,23 @@ If no address is defined, returns 0. (This is for compatibility with the URL li "Set the address corresponding to PAGE to NEW-ADDRESS." (setcar (cdr page) new-address)) -(defun elpher-page-from-url (url) +(defun elpher-page-from-url (url &optional default-scheme) "Create a page with address and display string defined by URL. The URL is unhexed prior to its use as a display string to improve -readability." - (elpher-make-page (elpher-url-to-iri url) - (elpher-address-from-url url))) +readability. -(defun elpher-url-to-iri (url) - "Return an IRI for URL. +If DEFAULT-SCHEME is non-nil, this scheme is applied to the URL +in the instance that URL itself doesn't specify one." + (let ((address (elpher-address-from-url url default-scheme))) + (elpher-make-page (elpher-address-to-iri address) address))) + +(defun elpher-address-to-iri (address) + "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 (unwind-protect - (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url)))) - (host (url-host address)) + (let* ((host (url-host address)) (pass (url-password address))) (when host (setf (url-host address) (puny-decode-domain host))) @@ -591,6 +595,21 @@ previously-visited pages,unless NO-HISTORY is non-nil." (goto-char pos) (goto-char (point-min))))) +(defun elpher-get-default-url-scheme () + "Suggest a default URL scheme to use for visiting addresses based on the current page." + (if elpher-current-page + (let* ((address (elpher-page-address elpher-current-page)) + (current-type (elpher-address-type address))) + (pcase current-type + ((or (and 'file (guard (not elpher-history))) + `(about ,_)) + elpher-default-url-type) + (`(about ,_) + elpher-default-url-type) + (_ + (url-type address)))) + elpher-default-url-type)) + ;;; Buffer preparation ;; @@ -1496,7 +1515,7 @@ treatment that a separate function is warranted." (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 " ")) + (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s))) (when display-string (insert elpher-gemini-link-string) (if type-map-entry @@ -1688,6 +1707,8 @@ Assumes UTF-8 encoding for all text files." (elpher-render-text (decode-coding-string body 'utf-8))) ((or "jpg" "jpeg" "gif" "png" "bmp" "tif" "tiff") (elpher-render-image body)) + ((or "gopher" "gophermap") + (elpher-render-index (elpher-decode body))) (_ (elpher-render-download body)))) (elpher-restore-pos)))) @@ -1740,15 +1761,14 @@ Assumes UTF-8 encoding for all text files." (elpher-address-from-url "gemini://geminispace.info/search")) (insert "\n" "Your bookmarks are stored in your ") - (let ((help-string "RET,mouse-1: Open bookmark list")) - (insert-text-button "bookmark list" - 'face 'link - 'action #'elpher-click-link - 'follow-link t - 'help-echo #'elpher--page-button-help - 'elpher-page - (elpher-make-page "Elpher Bookmarks" - (elpher-make-about-address 'bookmarks)))) + (insert-text-button "bookmark list" + 'face 'link + 'action #'elpher-click-link + 'follow-link t + 'help-echo #'elpher--page-button-help + 'elpher-page + (elpher-make-page "Elpher Bookmarks" + (elpher-make-about-address 'bookmarks))) (insert ".\n") (insert (propertize "(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n" @@ -2119,10 +2139,12 @@ supports the old protocol elpher, where the link is self-contained." (defun elpher-go (host-or-url) "Go to a particular gopher site HOST-OR-URL. When run interactively HOST-OR-URL is read from the minibuffer." - (interactive "sGopher or Gemini URL: ") + (interactive (list + (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme))))) (let ((trimmed-host-or-url (string-trim host-or-url))) (unless (string-empty-p trimmed-host-or-url) - (let ((page (elpher-page-from-url trimmed-host-or-url))) + (let ((page (elpher-page-from-url trimmed-host-or-url + (elpher-get-default-url-scheme)))) (switch-to-buffer elpher-buffer-name) (elpher-with-clean-buffer (elpher-visit-page page)) @@ -2132,11 +2154,10 @@ When run interactively HOST-OR-URL is read from the minibuffer." "Go to a particular site read from the minibuffer, initialized with the current URL." (interactive) (let* ((address (elpher-page-address elpher-current-page)) - (url (read-string "Gopher or Gemini URL: " - (unless (elpher-address-about-p address) - (elpher-address-to-url address))))) + (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-visit-page (elpher-page-from-url url) (elpher-get-default-url-scheme))))) (defun elpher-redraw () "Redraw current page." diff --git a/elpher.texi b/elpher.texi index 5892db3..3b54a31 100644 --- a/elpher.texi +++ b/elpher.texi @@ -683,6 +683,11 @@ particular their extension. The current mappings are as follows: Plain text documents. All local text files are assumed to be UTF-8-encoded. +@item @samp{gophermap},@samp{gopher} + +Gophermap files, i.e. files containing a valid directory list as specified +by RFC 1436. + @item @samp{gemini},@samp{gmi} Gemini documents (i.e. documents of MIME type ``text/gemini''). All @@ -703,10 +708,6 @@ much that elpher can sensibly do with unknown binary files.) @end table -Gophermap files (i.e. files containing literally the intended output of -querying a directory selector according to RFC 1436) cannot yet rendered -using @samp{file:}. - @node About pages, Customization, Local files, Top @chapter About pages