X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=b18a897a393e790eb3dad159bae8d7c1b4b7c3c1;hp=694d8af99d067279480bfaba28d9cc56c1e2e7cf;hb=eb329aec7b8f444fd24ceb4f25168fefb3f570da;hpb=0d68c92d0ad990230c9c018c1f6d43ef63d052c3 diff --git a/elpher.el b/elpher.el index 694d8af..b18a897 100644 --- a/elpher.el +++ b/elpher.el @@ -5,7 +5,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 3.3.2 +;; Version: 3.4.2 ;; Keywords: comm gopher ;; Homepage: https://thelambdalab.xyz/elpher ;; Package-Requires: ((emacs "27.1")) @@ -66,11 +66,12 @@ (require 'gnutls) (require 'socks) (require 'bookmark) +(require 'rx) ;;; Global constants ;; -(defconst elpher-version "3.3.2" +(defconst elpher-version "3.4.2" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -222,6 +223,24 @@ Emacs bookmark menu being accessible via \\[elpher-show-bookmarks] from the start page." :type '(string)) +(defcustom elpher-gemini-hide-preformatted nil + "Cause elpher to hide preformatted gemini text by default. +When this option is enabled, preformatted text in text/gemini documents +is replaced with a button which can be used to toggle its display. + +This is intended to improve accessibility, as preformatted text often +includes art which can be difficult for screen readers to interpret +meaningfully." + :type '(boolean)) + +(defcustom elpher-gemini-preformatted-toggle-bullet "‣ " + "Margin symbol used to distinguish the preformatted text toggle." + :type '(string)) + +(defcustom elpher-gemini-preformatted-toggle-label "[Toggle Preformatted Text]" + "Label of button used to toggle formatted text." + :type '(string)) + ;; Face customizations (defgroup elpher-faces nil @@ -292,14 +311,18 @@ the start page." '((t :inherit bold :height 1.2)) "Face used for gemini heading level 3.") -(defface elpher-gemini-preformatted - '((t :inherit fixed-pitch)) - "Face used for pre-formatted gemini text blocks.") - (defface elpher-gemini-quoted '((t :inherit font-lock-doc-face)) "Face used for gemini quoted texts.") +(defface elpher-gemini-preformatted + '((t :inherit default)) + "Face used for gemini preformatted text.") + +(defface elpher-gemini-preformatted-toggle + '((t :inherit button)) + "Face used for buttons used to toggle display of preformatted text.") + ;;; Model ;; @@ -407,11 +430,11 @@ address refers to, via the table `elpher-type-map'." (_ 'other-url))) (defun elpher-address-about-p (address) - "Return non-nil if ADDRESS is an about address." + "Return non-nil if ADDRESS is an about address." (pcase (elpher-address-type address) (`(about ,_) t))) (defun elpher-address-gopher-p (address) - "Return non-nill if ADDRESS object is a gopher address." + "Return non-nil if ADDRESS object is a gopher address." (pcase (elpher-address-type address) (`(gopher ,_) t))) (defun elpher-address-protocol (address) @@ -425,17 +448,21 @@ For gopher addresses this is a combination of the selector type and selector." (defun elpher-address-host (address) "Retrieve host from ADDRESS object." - (let ((host-pre (url-host address))) + (pcase (url-host address) ;; The following strips out square brackets which sometimes enclose IPv6 ;; addresses. Doing this here rather than at the parsing stage may seem ;; weird, but this lets us way we avoid having to muck with both URL parsing ;; and reconstruction. It's also more efficient, as this method is not ;; called during page rendering. - (if (and (> (length host-pre) 2) - (eq (elt host-pre 0) ?\[) - (eq (elt host-pre (- (length host-pre) 1)) ?\])) - (substring host-pre 1 (- (length host-pre) 1)) - host-pre))) + ((rx (: "[" (let ipv6 (* (not "]"))) "]")) + ipv6) + ;; The following is a work-around for a parsing bug that causes + ;; URLs with empty (but not absent, see RFC 1738) usernames to have + ;; @ prepended to the hostname. + ((rx (: "@" (let rest (+ anything)))) + rest) + (addr + addr))) (defun elpher-address-user (address) "Retrieve user from ADDRESS object." @@ -443,8 +470,10 @@ For gopher addresses this is a combination of the selector type and selector." (defun elpher-address-port (address) "Retrieve port from ADDRESS object. -If no address is defined, returns 0. (This is for compatibility with the URL library.)" - (url-port address)) +If no address is defined, returns 0. (This is for compatibility with +the URL library.)" + (let ((port (url-portspec address))) ; (url-port) is too slow! + (if port port 0))) (defun elpher-gopher-address-selector (address) "Retrieve gopher selector from ADDRESS object." @@ -542,7 +571,7 @@ This variable is used by `elpher-show-visited-pages'.") (defun elpher-visit-page (page &optional renderer no-history) "Visit PAGE using its own renderer or RENDERER, if non-nil. Additionally, push PAGE onto the history stack and the list of -previously-visited pages,unless NO-HISTORY is non-nil." +previously-visited pages, unless NO-HISTORY is non-nil." (elpher-save-pos) (elpher-process-cleanup) (unless no-history @@ -596,7 +625,7 @@ previously-visited pages,unless NO-HISTORY is non-nil." (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." + "Suggest default URL scheme 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))) @@ -604,8 +633,6 @@ previously-visited pages,unless NO-HISTORY is non-nil." ((or (and 'file (guard (not elpher-history))) `(about ,_)) elpher-default-url-type) - (`(about ,_) - elpher-default-url-type) (_ (url-type address)))) elpher-default-url-type)) @@ -707,7 +734,8 @@ away CRs and any terminating period." 'face 'button))) (buffer-string))) -;;; ANSI colors or XTerm colors (application and filtering) + +;; ANSI colors or XTerm colors (application and filtering) (or (require 'xterm-color nil t) (require 'ansi-color)) @@ -726,17 +754,25 @@ away CRs and any terminating period." #'ansi-color-apply) "A function to apply ANSI escape sequences.") -;;; Processing text for display +(defun elpher-text-has-ansi-escapes-p (string) + "Return non-nil if STRING includes an ANSI escape code." + (save-match-data + (string-match "\x1b\\[" string))) + + +;; Processing text for display (defun elpher-process-text-for-display (string) "Perform any desired processing of STRING prior to display as text. Currently includes buttonifying URLs and processing ANSI escape codes." - (elpher-buttonify-urls (if elpher-filter-ansi-from-text - (elpher-color-filter-apply string) - (elpher-color-apply string)))) + (elpher-buttonify-urls (if (elpher-text-has-ansi-escapes-p string) + (if elpher-filter-ansi-from-text + (elpher-color-filter-apply string) + (elpher-color-apply string)) + string))) -;;; Network error reporting +;;; General network communication ;; (defun elpher-network-error (address error) @@ -750,9 +786,6 @@ ERROR can be either an error object or a string." "Press 'u' to return to the previous page."))) -;;; General network communication -;; - (defvar elpher-network-timer nil "Timer used for network connections.") @@ -837,7 +870,8 @@ the host operating system and the local network capabilities.)" nil force-ipv4)) (t (elpher-network-error address "Connection time-out.")))))) - (proc (if socks (socks-open-network-stream "elpher-process" nil host service) + (proc (if socks + (socks-open-network-stream "elpher-process" nil host service) (make-network-process :name "elpher-process" :host host :family (and (or force-ipv4 @@ -851,6 +885,7 @@ the host operating system and the local network capabilities.)" (cons 'gnutls-x509pki (apply #'gnutls-boot-parameters gnutls-params))))))) + (process-put proc 'elpher-buffer (current-buffer)) (setq elpher-network-timer timer) (set-process-coding-system proc 'binary 'binary) (set-process-query-on-exit-flag proc nil) @@ -894,17 +929,19 @@ the host operating system and the local network capabilities.)" response-processor use-tls t)) (response-string-parts - (elpher-with-clean-buffer - (insert "Data received. Rendering...")) - (funcall response-processor - (apply #'concat (reverse response-string-parts))) - (elpher-restore-pos)) + (with-current-buffer (process-get proc 'elpher-buffer) + (elpher-with-clean-buffer + (insert "Data received. Rendering...")) + (funcall response-processor + (apply #'concat (reverse response-string-parts))) + (elpher-restore-pos))) (t (error "No response from server"))) (error (elpher-network-error address the-error))))) (when socks - (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params)) + (if use-tls + (apply #'gnutls-negotiate :process proc gnutls-params)) (funcall (process-sentinel proc) proc "open\n"))) (error (elpher-process-cleanup) @@ -1068,10 +1105,12 @@ once they are retrieved from the gopher server." (error (elpher-network-error address the-error)))))) -;; Index rendering + +;;; Gopher index rendering +;; (defun elpher-insert-margin (&optional type-name) - "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." + "Insert index margin, optionally containing the TYPE-NAME, into current buffer." (if type-name (progn (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s") @@ -1126,7 +1165,7 @@ If ADDRESS is not supplied or nil the record is rendered as an (insert "\n"))) (defun elpher-click-link (button) - "Function called when the gopher link BUTTON is activated (via mouse or keypress)." + "Function called when the gopher link BUTTON is activated." (let ((page (button-get button 'elpher-page))) (elpher-visit-page page))) @@ -1152,7 +1191,9 @@ If ADDRESS is not supplied or nil the record is rendered as an (elpher-cache-content (elpher-page-address elpher-current-page) (buffer-string))))) -;; Text rendering + +;;; Gopher text rendering +;; (defun elpher-render-text (data &optional _mime-type-string) "Render DATA as text. MIME-TYPE-STRING is unused." @@ -1164,7 +1205,9 @@ If ADDRESS is not supplied or nil the record is rendered as an (elpher-page-address elpher-current-page) (buffer-string))))) -;; Image retrieval + +;;; Image retrieval +;; (defun elpher-render-image (data &optional _mime-type-string) "Display DATA as image. MIME-TYPE-STRING is unused." @@ -1185,7 +1228,9 @@ If ADDRESS is not supplied or nil the record is rendered as an (elpher-restore-pos)))) (elpher-render-download data)))) -;; Search retrieval and rendering + +;;; Gopher search retrieval and rendering +;; (defun elpher-get-gopher-query-page (renderer) "Getter for gopher addresses requiring input. @@ -1214,7 +1259,9 @@ The response is rendered using the rendering function RENDERER." (if aborted (elpher-visit-previous-page)))))) -;; Raw server response rendering + +;;; Raw server response rendering +;; (defun elpher-render-raw (data &optional mime-type-string) "Display raw DATA in buffer. MIME-TYPE-STRING is also displayed if provided." @@ -1227,7 +1274,9 @@ The response is rendered using the rendering function RENDERER." (goto-char (point-min))) (message "Displaying raw server response. Reload or redraw to return to standard view."))) -;; File save "rendering" + +;;; File save "rendering" +;; (defun elpher-render-download (data &optional _mime-type-string) "Save DATA to file. MIME-TYPE-STRING is unused." @@ -1249,7 +1298,9 @@ The response is rendered using the rendering function RENDERER." (insert data))) (message (format "Saved to file %s." filename)))))) -;; HTML rendering + +;;; HTML rendering +;; (defun elpher-render-html (data &optional _mime-type-string) "Render DATA as HTML using shr. MIME-TYPE-STRING is unused." @@ -1261,7 +1312,9 @@ The response is rendered using the rendering function RENDERER." (libxml-parse-html-region (point-min) (point-max))))) (shr-insert-document dom))))) -;; Gemini page retrieval + +;;; Gemini page retrieval +;; (defvar elpher-gemini-redirect-chain) @@ -1417,6 +1470,9 @@ is a list of possible answers." (error (elpher-network-error address the-error))))) +;;; Gemini page rendering +;; + (defun elpher-render-gemini (body &optional mime-type-string) "Render gemini response BODY with rendering MIME-TYPE-STRING." (if (not body) @@ -1588,26 +1644,71 @@ width defined by `elpher-gemini-max-fill-width'." (insert (elpher-process-text-for-display processed-text-line)) (newline))) +(defun elpher-gemini-pref-expand-collapse (button) + "Function called when the preformatted text toggle BUTTON is activated." + (let ((id (button-get button 'pref-id))) + (if (invisible-p id) + (remove-from-invisibility-spec id) + (add-to-invisibility-spec id)) + (redraw-display))) + +(defun elpher-gemini-insert-preformatted-toggler (alt-text) + "Insert a button for toggling the visibility of preformatted text. +If non-nil, ALT-TEXT is displayed alongside the button." + (let* ((url-string (url-recreate-url (elpher-page-address elpher-current-page))) + (pref-id (intern (concat "pref-" + (number-to-string (point)) + "-" + url-string)))) + (insert elpher-gemini-preformatted-toggle-bullet) + (when alt-text + (insert (propertize (concat alt-text " ") + 'face 'elpher-gemin-preformatted))) + (insert-text-button elpher-gemini-preformatted-toggle-label + 'action #'elpher-gemini-pref-expand-collapse + 'pref-id pref-id + 'face 'elpher-gemini-preformatted-toggle) + (add-to-invisibility-spec pref-id) + (newline) + pref-id)) + +(defun elpher-gemini-insert-preformatted-line (line &optional pref-id) + "Insert a LINE of preformatted text. +PREF-ID is the value assigned to the \"invisible\" text attribute, which +can be used to toggle the display of the preformatted text." + (insert (propertize (concat (elpher-process-text-for-display + (propertize line 'face 'elpher-gemini-preformatted)) + "\n") + 'invisible pref-id + 'rear-nonsticky t))) + (defun elpher-render-gemini-map (data _parameters) "Render DATA as a gemini map file, PARAMETERS is currently unused." (elpher-with-clean-buffer (auto-fill-mode 1) + (setq-local buffer-invisibility-spec nil) (let ((preformatted nil) (adaptive-fill-mode nil)) ;Prevent automatic setting of fill-prefix (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width)) (dolist (line (split-string data "\n")) - (cond - ((string-prefix-p "```" line) (setq preformatted (not preformatted))) - (preformatted (insert (elpher-process-text-for-display - (propertize line 'face 'elpher-gemini-preformatted)) - "\n")) - ((string-prefix-p "=>" line) - (elpher-gemini-insert-link line)) - ((string-prefix-p "#" line) (elpher-gemini-insert-header line)) - (t (elpher-gemini-insert-text line))))) + (pcase line + ((rx (: string-start "```" (opt (let alt-text (+ any))))) + (setq preformatted + (if preformatted + nil + (if elpher-gemini-hide-preformatted + (elpher-gemini-insert-preformatted-toggler alt-text) + t)))) + ((guard preformatted) + (elpher-gemini-insert-preformatted-line line preformatted)) + ((pred (string-prefix-p "=>")) + (elpher-gemini-insert-link line)) + ((pred (string-prefix-p "#")) + (elpher-gemini-insert-header line)) + (_ (elpher-gemini-insert-text line)))) (elpher-cache-content (elpher-page-address elpher-current-page) - (buffer-string)))) + (buffer-string))))) (defun elpher-render-gemini-plain-text (data _parameters) "Render DATA as plain text file. PARAMETERS is currently unused." @@ -1631,7 +1732,9 @@ width defined by `elpher-gemini-max-fill-width'." headers)) (reverse headers)))) -;; Finger page connection + +;;; Finger page connection +;; (defun elpher-get-finger-page (renderer) "Opens a finger connection to the current page address. @@ -1657,7 +1760,8 @@ The result is rendered using RENDERER." (elpher-network-error address the-error)))))) -;; Telnet page connection +;;; Telnet page connection +;; (defun elpher-get-telnet-page (renderer) "Opens a telnet connection to the current page address (RENDERER must be nil)." @@ -1673,10 +1777,12 @@ The result is rendered using RENDERER." (telnet host)))) -;; Other URL page opening +;;; Other URL page opening +;; (defun elpher-get-other-url-page (renderer) - "Getter which attempts to open the URL specified by the current page (RENDERER must be nil)." + "Getter which attempts to open the URL specified by the current page. +The RENDERER argument to this getter must be nil." (when renderer (elpher-visit-previous-page) (error "Command not supported for general URLs")) @@ -1688,7 +1794,9 @@ The result is rendered using RENDERER." (browse-web url) (browse-url url)))) -;; File page + +;;; File page +;; (defun elpher-get-file-page (renderer) "Getter which renders a local file using RENDERER. @@ -1697,10 +1805,10 @@ Assumes UTF-8 encoding for all text files." (filename (elpher-address-filename address))) (unless (file-exists-p filename) (elpher-visit-previous-page) - (error "File not found")) + (error "File not found")) (unless (file-readable-p filename) (elpher-visit-previous-page) - (error "Could not read from file")) + (error "Could not read from file")) (let ((body (with-temp-buffer (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) @@ -1724,7 +1832,8 @@ Assumes UTF-8 encoding for all text files." (elpher-restore-pos)))) -;; Welcome page retrieval +;;; Welcome page retrieval +;; (defun elpher-get-welcome-page (renderer) "Getter which displays the welcome page (RENDERER must be nil)." @@ -1811,12 +1920,15 @@ Assumes UTF-8 encoding for all text files." 'help-echo help-string)) (insert "\n") (insert (propertize - (concat "(These documents should be available if you have installed Elpher \n" - " using MELPA. Otherwise you may have to install the manual yourself.)\n") + (concat "(These documents should be available if you have installed Elpher\n" + " from MELPA or non-GNU ELPA. Otherwise you may have to install the\n" + " manual yourself.)\n") 'face 'shadow)) (elpher-restore-pos))) -;; History page retrieval + +;;; History page retrieval +;; (defun elpher-show-history () "Show the current contents of elpher's history stack. @@ -1873,6 +1985,7 @@ This is rendered using `elpher-get-visited-pages-page' via `elpher-type-map'." ;;; Bookmarks +;; ;; This code allows Elpher to use the standard Emacs bookmarks: `C-x r ;; m' to add a bookmark, `C-x r l' to list bookmarks (which is where @@ -2083,7 +2196,7 @@ supports the old protocol elpher, where the link is self-contained." (add-hook 'org-mode-hook #'elpher-org-mode-integration) -;;; Browse URL +;; Browse URL ;;;###autoload (defun elpher-browse-url-elpher (url &rest _args) @@ -2118,13 +2231,13 @@ supports the old protocol elpher, where the link is self-contained." (with-eval-after-load 'thingatpt (add-to-list 'thing-at-point-uri-schemes "gemini://")) -;;; Mu4e: +;; Mu4e: ;; Make mu4e aware of the gemini world (setq mu4e~view-beginning-of-url-regexp "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:") -;;; eww: +;; eww: ;; Let elpher handle gemini, gopher links in eww buffer. (setq eww-use-browse-url @@ -2166,7 +2279,9 @@ When run interactively HOST-OR-URL is read from the minibuffer." nil)))) ; non-nil value is displayed by eshell (defun elpher-go-current () - "Go to a particular site read from the minibuffer, initialized with the current URL." + "Go to a particular URL which is read from the minibuffer. +Unlike `elpher-go', the reader is initialized with the URL of the +current page." (interactive) (let* ((address (elpher-page-address elpher-current-page)) (url (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme)) @@ -2235,9 +2350,7 @@ When run interactively HOST-OR-URL is read from the minibuffer." (if (elpher-address-about-p (elpher-page-address elpher-current-page)) (error "Cannot download %s" (elpher-page-display-string elpher-current-page)) - (elpher-visit-page (elpher-make-page - (elpher-page-display-string elpher-current-page) - (elpher-page-address elpher-current-page)) + (elpher-visit-page elpher-current-page #'elpher-render-download t)))