;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.4.1
+;; Version: 3.4.2
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
(require 'gnutls)
(require 'socks)
(require 'bookmark)
+(require 'rx)
;;; Global constants
;;
-(defconst elpher-version "3.4.1"
+(defconst elpher-version "3.4.2"
"Current version of elpher.")
(defconst elpher-margin-width 6
'((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.")
(_ '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)
(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."
(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
'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))
#'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)
"Press 'u' to return to the previous page.")))
-;;; General network communication
-;;
-
(defvar elpher-network-timer nil
"Timer used for network connections.")
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
(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)
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)
(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."
(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."
(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."
(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.
(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."
(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."
(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."
(libxml-parse-html-region (point-min) (point-max)))))
(shr-insert-document dom)))))
-;; Gemini page retrieval
+
+;;; Gemini page retrieval
+;;
(defvar elpher-gemini-redirect-chain)
(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)
"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")
+ (insert (propertize (concat (elpher-process-text-for-display
+ (propertize line 'face 'elpher-gemini-preformatted))
+ "\n")
'invisible pref-id
'rear-nonsticky t)))
(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
(reverse headers))))
-;; Finger page connection
+;;; Finger page connection
+;;
(defun elpher-get-finger-page (renderer)
"Opens a finger connection to the current page address.
(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)."
(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.
(browse-url url))))
-;; File page
+;;; File page
+;;
(defun elpher-get-file-page (renderer)
"Getter which renders a local file using RENDERER.
(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))
(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)."
(elpher-restore-pos)))
-;; History page retrieval
+;;; History page retrieval
+;;
(defun elpher-show-history ()
"Show the current contents of elpher's history stack.
;;; 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
(add-hook 'org-mode-hook #'elpher-org-mode-integration)
-;;; Browse URL
+;; Browse URL
;;;###autoload
(defun elpher-browse-url-elpher (url &rest _args)
(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
(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)))
The Lambda Lab / projects / elpher.git / blobdiff