X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=b18a897a393e790eb3dad159bae8d7c1b4b7c3c1;hp=879e68a291ea77f65a577fd41bc7544c6749e1d8;hb=eb329aec7b8f444fd24ceb4f25168fefb3f570da;hpb=b4adbe09255f6a464253e306c1a54eef5238e164 diff --git a/elpher.el b/elpher.el index 879e68a..b18a897 100644 --- a/elpher.el +++ b/elpher.el @@ -5,7 +5,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 3.3.3 +;; 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.3" +(defconst elpher-version "3.4.2" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -310,14 +311,14 @@ meaningfully." '((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.") @@ -429,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) @@ -447,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." @@ -467,7 +472,8 @@ For gopher addresses this is a combination of the selector type and selector." "Retrieve port from ADDRESS object. If no address is defined, returns 0. (This is for compatibility with the URL library.)" - (url-port address)) + (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." @@ -565,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 @@ -728,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)) @@ -747,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) @@ -771,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.") @@ -858,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 @@ -872,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) @@ -915,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) @@ -1089,7 +1105,9 @@ 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 current buffer." @@ -1173,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." @@ -1185,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." @@ -1206,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. @@ -1235,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." @@ -1248,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." @@ -1270,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." @@ -1282,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) @@ -1438,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) @@ -1641,8 +1676,9 @@ If non-nil, ALT-TEXT is displayed alongside the button." "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 line) "\n") - 'face 'elpher-gemini-preformatted + (insert (propertize (concat (elpher-process-text-for-display + (propertize line 'face 'elpher-gemini-preformatted)) + "\n") 'invisible pref-id 'rear-nonsticky t))) @@ -1656,7 +1692,7 @@ can be used to toggle the display of the preformatted text." (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width)) (dolist (line (split-string data "\n")) (pcase line - ((rx (: "```" (opt (let alt-text (+ any))))) + ((rx (: string-start "```" (opt (let alt-text (+ any))))) (setq preformatted (if preformatted nil @@ -1697,7 +1733,8 @@ can be used to toggle the display of the preformatted text." (reverse headers)))) -;; Finger page connection +;;; Finger page connection +;; (defun elpher-get-finger-page (renderer) "Opens a finger connection to the current page address. @@ -1723,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)." @@ -1739,7 +1777,8 @@ 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. @@ -1756,7 +1795,8 @@ The RENDERER argument to this getter must be nil." (browse-url url)))) -;; File page +;;; File page +;; (defun elpher-get-file-page (renderer) "Getter which renders a local file using RENDERER. @@ -1765,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)) @@ -1792,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)." @@ -1879,13 +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. @@ -1942,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 @@ -2152,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) @@ -2187,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 @@ -2306,9 +2350,7 @@ current page." (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)))