;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.3.0
+;; Version: 3.4.1
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;;; Global constants
;;
-(defconst elpher-version "3.3.0"
+(defconst elpher-version "3.4.1"
"Current version of elpher.")
(defconst elpher-margin-width 6
((gopher ?s) elpher-get-gopher-page elpher-render-download "snd" elpher-binary)
((gopher ?h) elpher-get-gopher-page elpher-render-html "htm" elpher-html)
(gemini elpher-get-gemini-page elpher-render-gemini "gem" elpher-gemini)
+ (spartan elpher-get-spartan-page elpher-render-gemini "spt" elpher-spartan)
(finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
(telnet elpher-get-telnet-page nil "tel" elpher-telnet)
(other-url elpher-get-other-url-page nil "url" elpher-other-url)
(declare-function org-link-store-props "ol")
(declare-function org-link-set-parameters "ol")
(defvar ansi-color-context)
+ (defvar xterm-color--current-fg)
+ (defvar xterm-color--current-bg)
(defvar bookmark-make-record-function)
(defvar mu4e~view-beginning-of-url-regexp)
(defvar eww-use-browse-url)
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
'((t :inherit font-lock-constant-face))
"Face used for Gemini type directory records.")
+(defface elpher-spartan
+ '((t :inherit font-lock-constant-face))
+ "Face used for Spartan type directory records.")
+
(defface elpher-other-url
'((t :inherit font-lock-comment-face))
"Face used for other URL type links records.")
'((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-toggle
+ '((t :inherit button))
+ "Face used for buttons used to toggle display of preformatted text.")
+
;;; Model
;;
?1
(string-to-char (substring (url-filename address) 1)))))
("gemini" 'gemini)
+ ("spartan" 'spartan)
("telnet" 'telnet)
("finger" 'finger)
("file" 'file)
(defun elpher-address-host (address)
"Retrieve host from ADDRESS object."
- (url-host address))
+ (let ((host-pre (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)))
(defun elpher-address-user (address)
"Retrieve user from ADDRESS object."
(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.)"
+If no address is defined, returns 0. (This is for compatibility with
+the URL library.)"
(url-port address))
(defun elpher-gopher-address-selector (address)
(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)))
((or (and 'file (guard (not elpher-history)))
`(about ,_))
elpher-default-url-type)
- (`(about ,_)
- elpher-default-url-type)
(_
(url-type address))))
elpher-default-url-type))
;; avoid resetting buffer-local variables
(elpher-mode))
(let ((inhibit-read-only t)
- (ansi-color-context nil)) ;; clean ansi interpreter state
+ (ansi-color-context nil)) ;; clean ansi interpreter state (also next 2 lines)
+ (setq-local xterm-color--current-fg nil)
+ (setq-local xterm-color--current-bg nil)
(setq-local network-security-level
(default-value 'network-security-level))
(erase-buffer)
;; 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")
(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)))
(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)))))
+ (when type-map-entry
+ (insert elpher-gemini-link-string)
+ (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))
+ (newline))))))
(defun elpher-gemini-insert-header (header-line)
"Insert header described by HEADER-LINE into a text/gemini document.
text-line))
(fill-prefix (if line-prefix
(make-string (length (match-string 0 text-line)) ?\s)
- nil)))
+ "")))
(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 line) "\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 (: "```" (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."
(buffer-string))))
(defun elpher-build-current-imenu-index ()
+ "Build imenu index for current elpher buffer."
(save-excursion
(goto-char (point-min))
(let ((match nil)
headers))
(reverse headers))))
+
+;; Spartan page retrieval
+
+(defvar elpher-spartan-redirect-chain)
+
+(defun elpher-get-spartan-page (renderer)
+ "Getter which retrieves and renders a Spartan page and renders it using RENDERER."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (content (elpher-get-cached-content address)))
+ (condition-case the-error
+ (if (and content (funcall renderer nil))
+ (elpher-with-clean-buffer
+ (insert content)
+ (elpher-restore-pos))
+ (elpher-with-clean-buffer
+ (insert "LOADING SPARTAN... (use 'u' to cancel)\n"))
+ (setq elpher-spartan-redirect-chain nil)
+ (elpher-get-spartan-response address renderer))
+ (error
+ (elpher-network-error address the-error)))))
+
+(defun elpher-get-spartan-response (address renderer)
+ "Get response string from spartan server at ADDRESS and render using RENDERER."
+ (elpher-get-host-response address 300
+ (concat (elpher-address-host address) " "
+ (elpher-address-filename address) " "
+ "0\r\n") ; No uploads for now
+ (lambda (response-string)
+ (elpher-process-spartan-response response-string renderer))))
+
+(defun elpher-parse-spartan-response (response)
+ "Parse the RESPONSE string and return a list of components.
+The list is of the form (code meta body). A response of nil implies
+that the response was malformed."
+ (let ((header-end-idx (string-match "\r\n" response)))
+ (if header-end-idx
+ (let ((header (string-trim (substring response 0 header-end-idx)))
+ (body (substring response (+ header-end-idx 2))))
+ (if (>= (length header) 2)
+ (let ((code (substring header 0 1))
+ (meta (string-trim (substring header 1))))
+ (list code meta body))
+ (error "Malformed response: No response status found in header %s" header)))
+ (error "Malformed response: No CRLF-delimited header found in response %s" response))))
+
+(defun elpher-process-spartan-response (response-string renderer)
+ "Process the spartan response RESPONSE-STRING and pass the result to RENDERER."
+ (let ((response-components (elpher-parse-spartan-response response-string)))
+ (let ((response-code (elt response-components 0))
+ (response-meta (elt response-components 1))
+ (response-body (elt response-components 2)))
+ (pcase (elt response-code 0)
+ (?2 ; Normal response
+ (funcall renderer response-body response-meta))
+ (?3 ; Redirect
+ (message "Following redirect to %s" response-meta)
+ (if (>= (length elpher-spartan-redirect-chain) 5)
+ (error "More than 5 consecutive redirects followed"))
+ (let* ((current-address (elpher-page-address elpher-current-page))
+ (redirect-address (elpher-address-from-url
+ (concat "spartan://"
+ (elpher-address-host current-address)
+ ":"
+ (elpher-address-port current-address)
+ "/"
+ response-meta))))
+ (if (member redirect-address elpher-spartan-redirect-chain)
+ (error "Redirect loop detected"))
+ (elpher-page-set-address elpher-current-page redirect-address)
+ (add-to-list 'elpher-gemini-redirect-chain redirect-address)
+ (elpher-get-spartan-response redirect-address renderer)))
+ (?4 ; Client error
+ (error "Spartan server reports CLIENT ERROR for this request: %s %s"
+ response-code response-meta))
+ (?5 ; Server error
+ (error "Spartan server reports SERVER ERROR for this request: %s %s"
+ response-code response-meta))
+ (_other
+ (error "Spartan server response unknown: %s %s"
+ response-code response-meta))))))
+
;; Finger page connection
(defun elpher-get-finger-page (renderer)
;; 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"))
(browse-web url)
(browse-url url))))
+
;; File page
(defun elpher-get-file-page (renderer)
'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
(defun elpher-show-history ()
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))