;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.3.2
+;; Version: 3.4.1
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;;; Global constants
;;
-(defconst elpher-version "3.3.2"
+(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-type-face))
+ "Face used for Spartan type directory records.")
+
+(defface elpher-spartan-post
+ '((t :inherit font-lock-string-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
;;
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
- (when (equal "gemini" (url-type url))
- ;; Gemini defaults
+ (when (member (url-type url) '("gemini" "spartan"))
+ ;; Gemini and Spartan defaults
(if (equal (url-filename url) "")
(setf (url-filename url) "/"))))
(elpher-remove-redundant-ports url))
?1
(string-to-char (substring (url-filename address) 1)))))
("gemini" 'gemini)
+ ("spartan" 'spartan)
("telnet" 'telnet)
("finger" 'finger)
("file" 'file)
(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))
;; 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)))
(defun elpher-gemini-get-link-display-string (link-line)
"Extract the display string portion of LINK-LINE, a gemini map file link line.
Return nil if this portion is not provided."
- (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
+ (let* ((rest (string-trim (substring link-line 2)))
(idx (string-match "[ \t]" rest)))
(and idx
(elpher-color-filter-apply (string-trim (substring rest (+ idx 1)))))))
(setf (url-host address) (puny-encode-domain (url-host address))))
(unless (url-type address)
(setf (url-type address) (url-type current-address)))
- (when (equal (url-type address) "gemini")
+ (when (member (url-type address) '("gemini" "spartan"))
(setf (url-filename address)
(elpher-collapse-dot-sequences (url-filename address)))))
(elpher-remove-redundant-ports address)))
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-spartan-insert-query 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."
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."
+ (let* ((host (elpher-address-host address))
+ (path-and-query (url-path-and-query address))
+ (filename (car path-and-query))
+ (data (cdr path-and-query))
+ (data-len (length data)))
+ (elpher-get-host-response address 300
+ (concat host " "
+ filename " "
+ (number-to-string data-len) "\r\n"
+ data)
+ (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-spartan-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))))))
+
+(defun elpher-spartan-insert-query (query-line)
+ "Insert link described by QUERY-LINE into a text/gemini document."
+ (let ((url (elpher-gemini-get-link-url query-line)))
+ (when url
+ (let* ((address (elpher-address-from-gemini-url url))
+ (given-display-string (elpher-gemini-get-link-display-string query-line))
+ (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s)))
+ (insert elpher-gemini-link-string)
+ (let ((display-string (or given-display-string url)))
+ (insert-text-button display-string
+ 'face 'elpher-spartan-post
+ 'display-string display-string
+ 'url (elpher-address-to-url address)
+ 'action #'elpher-spartan-post
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help))
+ (newline)))))
+
+(defun elpher-spartan-post (button)
+ "Function called when the spartan post link BUTTON is clicked."
+ (let* ((display-string (button-get button 'display-string))
+ (url (button-get button 'url))
+ (post-url (concat url "?" (url-hexify-string (read-string "Text to post: ")))))
+ (elpher-visit-page (elpher-make-page
+ display-string
+ (elpher-address-from-url post-url)))))
+
;; 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))