;;; elpher.el --- A friendly gopher and gemini client -*- lexical-binding: t -*-
-;; Copyright (C) 2021 Jens Östlund <jostlund@gmail.com>
-;; Copyright (C) 2021 F. Jason Park <jp@neverwas.me>
-;; Copyright (C) 2021 Christopher Brannon <chris@the-brannons.com>
-;; Copyright (C) 2021 Omar Polo <op@omarpolo.com>
-;; Copyright (C) 2021 Noodles! <nnoodle@chiru.no>
-;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
-;; Copyright (C) 2020-2021 Alex Schroeder <alex@gnu.org>
-;; Copyright (C) 2020 Zhiwei Chen <chenzhiwei03@kuaishou.com>
-;; Copyright (C) 2020 condy0919 <condy0919@gmail.com>
-;; Copyright (C) 2020 Alexis <flexibeast@gmail.com>
-;; Copyright (C) 2020 Étienne Deparis <etienne@depar.is>
-;; Copyright (C) 2020 Simon Nicolussi <sinic@sinic.name>
-;; Copyright (C) 2020 Michel Alexandre Salim <michel@michel-slm.name>
-;; Copyright (C) 2020 Koushk Roy <kroy@twilio.com>
-;; Copyright (C) 2020 Vee <vee@vnsf.xyz>
-;; Copyright (C) 2020 Simon South <simon@simonsouth.net>
-;; Copyright (C) 2019-2021 Tim Vaughan <plugd@thelambdalab.xyz>
+;; Copyright (C) 2019-2022 Tim Vaughan <plugd@thelambdalab.xyz>
+;; Copyright (C) 2020-2022 Elpher contributors (See info manual for full list)
;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.2.2
+;; Version: 3.4.1
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;;; Global constants
;;
-(defconst elpher-version "3.2.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)
- (defvar thing-at-point-uri-schemes)
- (defvar xterm-color-preserve-properties))
+ (defvar thing-at-point-uri-schemes))
;;; Customization group
(defcustom elpher-filter-ansi-from-text nil
"If non-nil, filter ANSI escape sequences from text.
-The default behaviour is to use the ansi-color package to interpret these
-sequences."
+The default behaviour is to use the ansi-color package (or xterm-color if it is
+available) to interpret these sequences."
:type '(boolean))
(defcustom elpher-certificate-directory
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
;;
;; dynamically for and by elpher. All others represent pages which
;; rely on content retrieved over the network.
-(defun elpher-address-from-url (url-string)
- "Create a ADDRESS object corresponding to the given URL-STRING."
+(defun elpher-address-from-url (url-string &optional default-scheme)
+ "Create a ADDRESS object corresponding to the given URL-STRING.
+If DEFAULT-SCHEME is non-nil, this sets the scheme of the URL when one
+is not explicitly given."
(let ((data (match-data))) ; Prevent parsing clobbering match data
(unwind-protect
(let ((url (url-generic-parse-url url-string)))
(unless (and (not (url-fullness url)) (url-type url))
- (setf (url-fullness url) t)
(unless (url-type url)
- (setf (url-type url) elpher-default-url-type))
+ (setf (url-type url) default-scheme))
(unless (url-host url)
(let ((p (split-string (url-filename url) "/" nil nil)))
(setf (url-host url) (car p))
(if (cdr p)
(concat "/" (mapconcat #'identity (cdr p) "/"))
""))))
- (when (url-host url)
+ (when (not (string-empty-p (url-host url)))
+ (setf (url-fullness url) t)
(setf (url-host url) (puny-encode-domain (url-host url))))
(when (or (equal "gopher" (url-type url))
(equal "gophers" (url-type url)))
(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-gopher-p (address)
"Return non-nill if ADDRESS object is a gopher address."
- (eq 'gopher (elpher-address-type address)))
+ (pcase (elpher-address-type address) (`(gopher ,_) t)))
(defun elpher-address-protocol (address)
"Retrieve the transport protocol for ADDRESS."
(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)
"Set the address corresponding to PAGE to NEW-ADDRESS."
(setcar (cdr page) new-address))
-(defun elpher-page-from-url (url)
+(defun elpher-page-from-url (url &optional default-scheme)
"Create a page with address and display string defined by URL.
The URL is unhexed prior to its use as a display string to improve
-readability."
- (elpher-make-page (elpher-url-to-iri url)
- (elpher-address-from-url url)))
+readability.
+
+If DEFAULT-SCHEME is non-nil, this scheme is applied to the URL
+in the instance that URL itself doesn't specify one."
+ (let ((address (elpher-address-from-url url default-scheme)))
+ (elpher-make-page (elpher-address-to-iri address) address)))
-(defun elpher-url-to-iri (url)
- "Return an IRI for URL.
+(defun elpher-address-to-iri (address)
+ "Return an IRI for ADDRESS.
Decode percent-escapes and handle punycode in the domain name.
Drop the password, if any."
- (let ((data (match-data))) ; Prevent parsing clobbering match data
+ (let ((data (match-data)) ; Prevent parsing clobbering match data
+ (host (url-host address))
+ (pass (url-password address)))
(unwind-protect
- (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url))))
- (host (url-host address))
+ (let* ((host (url-host address))
(pass (url-password address)))
(when host
(setf (url-host address) (puny-decode-domain host)))
(when pass ; RFC 3986 says we should not render
(setf (url-password address) nil)) ; the password as clear text
- (url-recreate-url address))
+ (elpher-decode (url-unhex-string (url-recreate-url address))))
+ (setf (url-host address) host)
+ (setf (url-password address) pass)
(set-match-data data))))
(defvar elpher-current-page nil
(goto-char pos)
(goto-char (point-min)))))
+(defun elpher-get-default-url-scheme ()
+ "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)))
+ (pcase current-type
+ ((or (and 'file (guard (not elpher-history)))
+ `(about ,_))
+ elpher-default-url-type)
+ (_
+ (url-type address))))
+ elpher-default-url-type))
+
;;; Buffer preparation
;;
;; 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)))
(if (display-images-p)
(let* ((image (create-image
data
- nil t))
- (window (get-buffer-window elpher-buffer-name)))
- (when window
- (setf (image-property image :max-width) (window-body-width window t))
- (setf (image-property image :max-height) (window-body-height window t)))
- (elpher-with-clean-buffer
- (insert-image image)
- (elpher-restore-pos)))
+ nil t)))
+ (if (not image)
+ (error "Unsupported image format")
+ (let ((window (get-buffer-window elpher-buffer-name)))
+ (when window
+ (setf (image-property image :max-width) (window-body-width window t))
+ (setf (image-property image :max-height) (window-body-height window t))))
+ (elpher-with-clean-buffer
+ (insert-image image)
+ (elpher-restore-pos))))
(elpher-render-download data))))
;; Search retrieval and rendering
(defun elpher-gemini-get-link-display-string (link-line)
"Extract the display string portion of LINK-LINE, a gemini map file link line.
-Returns the url portion in the event that the display-string portion is empty."
- (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
+Return nil if this portion is not provided."
+ (let* ((rest (string-trim (substring link-line 2)))
(idx (string-match "[ \t]" rest)))
- (string-trim (if idx
- (substring rest (+ idx 1))
- rest))))
+ (and idx
+ (elpher-color-filter-apply (string-trim (substring rest (+ idx 1)))))))
(defun elpher-collapse-dot-sequences (filename)
"Collapse dot sequences in the (absolute) FILENAME.
(let ((address (url-generic-parse-url url))
(current-address (elpher-page-address elpher-current-page)))
(unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
- (setf (url-fullness address) t)
(if (url-host address) ;if there is an explicit host, filenames are absolute
(if (string-empty-p (url-filename address))
(setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
(setf (url-host address) (url-host current-address))
+ (setf (url-fullness address) (url-host address)) ; set fullness to t if host is set
(setf (url-portspec address) (url-portspec current-address)) ; (url-port) too slow!
(unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
(setf (url-filename address)
(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)))
(defun elpher-gemini-insert-link (link-line)
"Insert link described by LINK-LINE into a text/gemini document."
- (let* ((url (elpher-gemini-get-link-url link-line))
- (display-string (elpher-gemini-get-link-display-string link-line))
- (address (elpher-address-from-gemini-url url))
- (type (if address (elpher-address-type address) nil))
- (type-map-entry (cdr (assoc type elpher-type-map))))
- (when display-string
- (insert elpher-gemini-link-string)
- (if type-map-entry
+ (let ((url (elpher-gemini-get-link-url link-line)))
+ (when url
+ (let* ((given-display-string (elpher-gemini-get-link-display-string link-line))
+ (address (elpher-address-from-gemini-url url))
+ (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)))
+ (when type-map-entry
+ (insert elpher-gemini-link-string)
(let* ((face (elt type-map-entry 3))
- (filtered-display-string (elpher-color-filter-apply display-string))
- (page (elpher-make-page filtered-display-string address)))
- (insert-text-button filtered-display-string
+ (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)))
- (insert "\n"))))
-
-(defvar elpher--gemini-page-headings nil
- "List of headings on the page.")
+ (newline))))))
(defun elpher-gemini-insert-header (header-line)
"Insert header described by HEADER-LINE into a text/gemini document.
(/ (* fill-column
(font-get (font-spec :name (face-font 'default)) :size))
(font-get (font-spec :name (face-font face)) :size)) fill-column)))
- (setq elpher--gemini-page-headings (cons (cons header (point))
- elpher--gemini-page-headings))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
- (insert (propertize header 'face face 'rear-nonsticky t))
+ (insert (propertize header
+ 'face face
+ 'gemini-heading t
+ 'rear-nonsticky t))
(newline))))
(defun elpher-gemini-insert-text (text-line)
width defined by `elpher-gemini-max-fill-width'."
(string-match
(rx (: line-start
- (* (any " \t"))
(optional
(group (or (: "*" (+ (any " \t")))
(: ">" (* (any " \t"))))))))
(propertize text-line 'face 'elpher-gemini-quoted))
(t text-line))
text-line))
- (adaptive-fill-mode t)
- ;; fill-prefix is important for adaptive-fill-mode: without
- ;; it, multi-line list items are not indented correct
- (fill-prefix (if (match-string 1 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
- (setq elpher--gemini-page-headings nil)
- (let ((preformatted nil))
- (auto-fill-mode 1)
+ (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)))))
- (setq elpher--gemini-page-headings (nreverse elpher--gemini-page-headings))
+ (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."
(elpher-page-address elpher-current-page)
(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 nil))
+ (while (setq match (text-property-search-forward 'gemini-heading t t))
+ (push (cons
+ (buffer-substring-no-properties (prop-match-beginning match)
+ (prop-match-end match))
+ (prop-match-beginning match))
+ 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
;; 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)
(elpher-render-text (decode-coding-string body 'utf-8)))
((or "jpg" "jpeg" "gif" "png" "bmp" "tif" "tiff")
(elpher-render-image body))
+ ((or "gopher" "gophermap")
+ (elpher-render-index (elpher-decode body)))
(_
(elpher-render-download body))))
(elpher-restore-pos))))
(elpher-address-from-url "gemini://geminispace.info/search"))
(insert "\n"
"Your bookmarks are stored in your ")
- (let ((help-string "RET,mouse-1: Open bookmark list"))
- (insert-text-button "bookmark list"
- 'face 'link
- 'action #'elpher-click-link
- 'follow-link t
- 'help-echo #'elpher--page-button-help
- 'elpher-page
- (elpher-make-page "Elpher Bookmarks"
- (elpher-make-about-address 'bookmarks))))
+ (insert-text-button "bookmark list"
+ 'face 'link
+ 'action #'elpher-click-link
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help
+ 'elpher-page
+ (elpher-make-page "Elpher Bookmarks"
+ (elpher-make-about-address 'bookmarks)))
(insert ".\n")
(insert (propertize
"(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n"
'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 ()
to the buffer."
(let* ((url (cdr (assq 'location bookmark)))
(cleaned-url (string-trim url))
- (page (elpher-page-from-url cleaned-url)))
+ (page (elpher-page-from-url cleaned-url))
+ (buffer (get-buffer-create elpher-buffer-name)))
(elpher-with-clean-buffer
(elpher-visit-page page))
- (set-buffer (get-buffer elpher-buffer-name))
+ (set-buffer buffer)
nil))
(defun elpher-bookmark-link ()
(let* ((url (elpher-info-current))
(desc (car elpher-current-page))
(protocol (cond
- ((string-prefix-p "gemini:" url) "gemini")
((string-prefix-p "gopher:" url) "gopher")
((string-prefix-p "finger:" url) "finger")
+ ((string-prefix-p "gemini:" url) "gemini")
+ ((string-prefix-p "spartan:" url) "spartan")
(t "elpher"))))
(when (equal "elpher" protocol)
;; Weird link. Or special inner link?
:export (lambda (link description format _plist)
(elpher-org-export-link link description format "gopher"))
:follow (lambda (link _arg) (elpher-org-follow-link link "gopher")))
+ (org-link-set-parameters
+ "spartan"
+ :export (lambda (link description format _plist)
+ (elpher-org-export-link link description format "spartan"))
+ :follow (lambda (link _arg) (elpher-org-follow-link link "spartan")))
(org-link-set-parameters
"finger"
:export (lambda (link description format _plist)
(if (boundp 'browse-url-default-handlers)
(add-to-list
'browse-url-default-handlers
- '("^\\(gopher\\|finger\\|gemini\\)://" . elpher-browse-url-elpher))
+ '("^\\(gopher\\|finger\\|gemini\\|spartan\\)://" . elpher-browse-url-elpher))
;; Patch `browse-url-browser-function' for older ones. The value of
;; that variable is `browse-url-default-browser' by default, so
- ;; that's the function that gets advised.
- (advice-add browse-url-browser-function :before-while
- (lambda (url &rest _args)
- "Handle gemini, gopher, and finger schemes using Elpher."
- (let ((scheme (downcase (car (split-string url ":" t)))))
- (if (member scheme '("gemini" "gopher" "finger"))
- ;; `elpher-go' always returns nil, which will stop the
- ;; advice chain here in a before-while
- (elpher-go url)
- ;; chain must continue, then return t.
- t)))))
+ ;; that's the function that gets advised. If the value is an alist,
+ ;; however, we don't know what to do. Better not interfere?
+ (when (and (symbolp browse-url-browser-function)
+ (fboundp browse-url-browser-function))
+ (advice-add browse-url-browser-function :before-while
+ (lambda (url &rest _args)
+ "Handle gemini, gopher, and finger schemes using Elpher."
+ (let ((scheme (downcase (car (split-string url ":" t)))))
+ (if (member scheme '("gopher" "gemini" "spartan" "finger"))
+ ;; `elpher-go' always returns nil, which will stop the
+ ;; advice chain here in a before-while
+ (elpher-go url)
+ ;; chain must continue, then return t.
+ t))))))
;; Register "gemini://" as a URI scheme so `browse-url' does the right thing
(with-eval-after-load 'thingatpt
;; Make mu4e aware of the gemini world
(setq mu4e~view-beginning-of-url-regexp
- "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
+ "\\(?:https?\\|gopher\\|finger\\|gemini\\|spartan\\)://\\|mailto:")
;;; eww:
;; Let elpher handle gemini, gopher links in eww buffer.
(setq eww-use-browse-url
- "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\)://")
+ "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\|\\`spartan\\)://")
;;; Interactive procedures
(defun elpher-go (host-or-url)
"Go to a particular gopher site HOST-OR-URL.
When run interactively HOST-OR-URL is read from the minibuffer."
- (interactive "sGopher or Gemini URL: ")
+ (interactive (list
+ (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme)))))
(let ((trimmed-host-or-url (string-trim host-or-url)))
(unless (string-empty-p trimmed-host-or-url)
- (let ((page (elpher-page-from-url trimmed-host-or-url)))
- (switch-to-buffer elpher-buffer-name)
+ (let ((page (elpher-page-from-url trimmed-host-or-url
+ (elpher-get-default-url-scheme))))
+ (unless (get-buffer-window elpher-buffer-name t)
+ (switch-to-buffer elpher-buffer-name))
(elpher-with-clean-buffer
(elpher-visit-page page))
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 "Gopher or Gemini URL: "
- (unless (elpher-address-about-p address)
- (elpher-address-to-url address)))))
+ (url (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme))
+ (elpher-address-to-url address))))
(unless (string-empty-p (string-trim url))
(elpher-visit-page (elpher-page-from-url url)))))
(defun elpher-info-page (page)
"Display URL of PAGE in minibuffer."
- (let ((address (elpher-page-address page)))
- (message "%s" (elpher-address-to-url address))))
+ (let* ((address (elpher-page-address page))
+ (url (elpher-address-to-url address))
+ (iri (elpher-address-to-iri address)))
+ (if (equal url iri)
+ (message "%s" url)
+ (message "%s (Raw: %s)" iri url))))
(defun elpher-info-link ()
"Display information on page corresponding to link at point."
This mode is automatically enabled by the interactive
functions which initialize the client, namely
`elpher', and `elpher-go'."
- (setq-local elpher--gemini-page-headings nil)
(setq-local elpher-current-page nil)
(setq-local elpher-history nil)
(setq-local elpher-buffer-name (buffer-name))
(setq-local bookmark-make-record-function #'elpher-bookmark-make-record)
- (setq-local imenu-create-index-function (lambda () elpher--gemini-page-headings))
- (setq-local xterm-color-preserve-properties t))
+ (setq-local imenu-create-index-function #'elpher-build-current-imenu-index))
(when (fboundp 'evil-set-initial-state)
(evil-set-initial-state 'elpher-mode 'motion))
The Lambda Lab / projects / elpher.git / blobdiff