;;; elpher.el --- A friendly gopher and gemini client -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Tim Vaughan
+;; 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) 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-2020 Tim Vaughan <plugd@thelambdalab.xyz>
;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.8.0
+;; Version: 2.11.0
;; Keywords: comm gopher
;; Homepage: http://thelambdalab.xyz/elpher
-;; Package-Requires: ((emacs "26.1"))
+;; Package-Requires: ((emacs "26.2"))
;; This file is not part of GNU Emacs.
(require 'url-util)
(require 'subr-x)
(require 'dns)
-(require 'ansi-color)
(require 'nsm)
(require 'gnutls)
-
+(require 'socks)
+
+;;; ANSI colors or XTerm colors
+
+(or (require 'xterm-color nil t)
+ (require 'ansi-color))
+
+(defalias 'elpher-color-filter-apply
+ (if (fboundp 'xterm-color-filter)
+ (lambda (s)
+ (let ((xterm-color-render nil))
+ (xterm-color-filter s)))
+ 'ansi-color-filter-apply)
+ "A function to filter out ANSI escape sequences.")
+(defalias 'elpher-color-apply
+ (if (fboundp 'xterm-color-filter)
+ 'xterm-color-filter
+ 'ansi-color-apply)
+ "A function to apply ANSI escape sequences.")
;;; Global constants
;;
-(defconst elpher-version "2.8.0"
+(defconst elpher-version "2.11.0"
"Current version of elpher.")
(defconst elpher-margin-width 6
"Association list from types to getters, renderers, margin codes and index faces.")
+;;; Internal variables
+;;
+
+;; buffer-local
+(defvar elpher--gemini-page-headings nil
+ "List of headings on the page.")
+
+(defvar elpher--gemini-page-links nil
+ "List of links on the page.")
+
+(defvar elpher--gemini-page-links-cache (make-hash-table :test 'equal)
+ "Hash of addresses and page links.")
+
;;; Customization group
;;
(defgroup elpher nil
- "A gopher client."
+ "A gopher and gemini client."
:group 'applications)
;; General appearance and customizations
These certificates may be used for establishing authenticated TLS connections."
:type '(directory))
+(defcustom elpher-openssl-command "openssl"
+ "The command used to launch openssl when generating TLS client certificates."
+ :type '(file))
+
+(defcustom elpher-default-url-type "gopher"
+ "Default URL type (i.e. scheme) to assume if not explicitly given."
+ :type '(choice (const "gopher")
+ (const "gemini")))
+
(defcustom elpher-gemini-TLS-cert-checks nil
"If non-nil, verify gemini server TLS certs using the default security level.
Otherwise, certificate verification is disabled.
some servers which do not support IPv6 can take a long time to time-out."
:type '(boolean))
+(defcustom elpher-socks-always nil
+ "If non-nil, elpher will establish network connections over a SOCKS proxy.
+Otherwise, the SOCKS proxy is only used for connections to onion services."
+ :type '(boolean))
+
+(defcustom elpher-gemini-number-links nil
+ "If non-nil, number links in gemini pages when rendering.
+Links can be accessed by pressing `v' ('visit') followed by the link number."
+ :type '(boolean))
+
;; Face customizations
(defgroup elpher-faces nil
"Face used for html type directory records.")
(defface elpher-gemini
- '((t :inherit font-lock-regexp-grouping-backslash))
+ '((t :inherit font-lock-constant-face))
"Face used for Gemini type directory records.")
(defface elpher-other-url
'((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.")
+
;;; Model
;;
(setf (url-filename url)
(url-unhex-string (url-filename url)))
(unless (url-type url)
- (setf (url-type url) "gopher"))
+ (setf (url-type url) elpher-default-url-type))
+ (unless (url-host url)
+ (let ((p (split-string (url-filename url) "/" nil nil)))
+ (setf (url-host url) (car p))
+ (setf (url-filename url)
+ (if (cdr p)
+ (concat "/" (mapconcat #'identity (cdr p) "/"))
+ ""))))
(when (or (equal "gopher" (url-type url))
(equal "gophers" (url-type url)))
;; Gopher defaults
- (unless (url-host url)
- (setf (url-host url) (url-filename url))
- (setf (url-filename url) ""))
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
;; Gemini defaults
(if (equal (url-filename url) "")
(setf (url-filename url) "/"))))
- url)
+ (elpher-remove-redundant-ports url))
(set-match-data data))))
+(defun elpher-remove-redundant-ports (address)
+ "Remove redundant port specifiers from ADDRESS.
+Here 'redundant' means that the specified port matches the default
+for that protocol, eg 70 for gopher."
+ (if (and (not (elpher-address-special-p address))
+ (eq (url-portspec address) ; (url-port) is too slow!
+ (pcase (url-type address)
+ ("gemini" 1965)
+ ((or "gopher" "gophers") 70)
+ ("finger" 79)
+ (_ -1))))
+ (setf (url-portspec address) nil))
+ address)
+
(defun elpher-make-gopher-address (type selector host port &optional tls)
"Create an ADDRESS object using gopher directory record attributes.
The basic attributes include: TYPE, SELECTOR, HOST and PORT.
"Set the address corresponding to PAGE to NEW-ADDRESS."
(setcar (cdr page) new-address))
-(defvar elpher-current-page nil)
-(defvar elpher-history nil)
+(defvar elpher-current-page nil) ; buffer local
+(defvar elpher-history nil) ; buffer local
(defun elpher-visit-page (page &optional renderer no-history)
"Visit PAGE using its own renderer or RENDERER, if non-nil.
(equal (elpher-page-address elpher-current-page)
(elpher-page-address page)))
(push elpher-current-page elpher-history))
- (setq elpher-current-page page)
+ (setq-local elpher-current-page page)
(let* ((address (elpher-page-address page))
(type (elpher-address-type address))
- (type-record (cdr (assoc type elpher-type-map))))
+ (type-record (cdr (assoc type elpher-type-map)))
+ (page-links nil))
(if type-record
- (funcall (car type-record)
- (if renderer
- renderer
- (cadr type-record)))
+ (progn
+ (funcall (car type-record)
+ (if renderer
+ renderer
+ (cadr type-record)))
+ (setq page-links (gethash address elpher--gemini-page-links-cache))
+ (if page-links
+ (setq elpher--gemini-page-links page-links)))
(elpher-visit-previous-page)
(pcase type
(`(gopher ,type-char)
(if previous-page
(elpher-visit-page previous-page nil t)
(error "No previous page"))))
-
+
(defun elpher-reload-current-page ()
"Reload the current page, discarding any existing cached content."
(elpher-cache-content (elpher-page-address elpher-current-page) nil)
;;; Buffer preparation
;;
+(defvar elpher-buffer-name "*elpher*"
+ "The default name of the Elpher buffer.")
+
(defun elpher-update-header ()
"If `elpher-use-header' is true, display current page info in window header."
(if elpher-use-header
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
- (list 'with-current-buffer "*elpher*"
- '(elpher-mode)
- (append (list 'let '((inhibit-read-only t))
- '(setq-local network-security-level
- (default-value 'network-security-level))
- '(erase-buffer)
- '(elpher-update-header))
- args)))
+ `(with-current-buffer elpher-buffer-name
+ (unless (eq major-mode 'elpher-mode)
+ ;; avoid resetting buffer-local variables
+ (elpher-mode))
+ (let ((inhibit-read-only t))
+ (setq-local network-security-level
+ (default-value 'network-security-level))
+ (erase-buffer)
+ (elpher-update-header)
+ ,@args)))
(defun elpher-buffer-message (string &optional line)
"Replace first line in elpher buffer with STRING.
If LINE is non-nil, replace that line instead."
- (with-current-buffer "*elpher*"
+ (with-current-buffer elpher-buffer-name
(let ((inhibit-read-only t))
(goto-char (point-min))
(if line
(unless (< (elpher-address-port address) 65536)
(error "Cannot establish network connection: port number > 65536"))
(when (and (eq use-tls 'gemini) (not elpher-gemini-TLS-cert-checks))
- (setq-local network-security-level 'low))
+ (setq-local network-security-level 'low)
+ (setq-local gnutls-verify-error nil))
(condition-case nil
(let* ((kill-buffer-query-functions nil)
(port (elpher-address-port address))
+ (service (if (> port 0) port default-port))
(host (elpher-address-host address))
+ (socks (or elpher-socks-always (string-suffix-p ".onion" host)))
(response-string-parts nil)
(bytes-received 0)
(hkbytes-received 0)
- (proc (make-network-process :name "elpher-process"
- :host host
- :family (and force-ipv4 'ipv4)
- :service (if (> port 0) port default-port)
- :buffer nil
- :coding 'binary
- :noquery t
- :nowait t
- :tls-parameters
- (and use-tls
- (cons 'gnutls-x509pki
- (gnutls-boot-parameters
- :type 'gnutls-x509pki
- :hostname host
- :keylist
- (elpher-get-current-keylist address))))))
(timer (run-at-time elpher-connection-timeout nil
(lambda ()
(elpher-process-cleanup)
(cond
; Try again with IPv4
- ((not force-ipv4)
+ ((not (or force-ipv4 socks))
(message "Connection timed out. Retrying with IPv4.")
(elpher-get-host-response address default-port
query-string
response-processor
nil force-ipv4))
(t
- (elpher-network-error address "Connection time-out.")))))))
+ (elpher-network-error address "Connection time-out."))))))
+ (gnutls-params (list :type 'gnutls-x509pki :hostname host
+ :keylist (elpher-get-current-keylist address)))
+ (proc (if socks (socks-open-network-stream "elpher-process" nil host service)
+ (make-network-process :name "elpher-process"
+ :host host
+ :family (and force-ipv4 'ipv4)
+ :service service
+ :buffer nil
+ :nowait t
+ :tls-parameters
+ (and use-tls
+ (cons 'gnutls-x509pki
+ (apply #'gnutls-boot-parameters
+ gnutls-params)))))))
(setq elpher-network-timer timer)
- (elpher-buffer-message (concat "Connecting to " host "..."))
+ (set-process-coding-system proc 'binary 'binary)
+ (set-process-query-on-exit-flag proc nil)
+ (elpher-buffer-message (concat "Connecting to " host "..."
+ " (press 'u' to abort)"))
(set-process-filter proc
(lambda (_proc string)
(when timer
(cond
((string-prefix-p "open" event) ; request URL
(elpher-buffer-message
- (concat "Connected to " host ". Receiving data..."))
+ (concat "Connected to " host ". Receiving data..."
+ " (press 'u' to abort)"))
(let ((inhibit-eol-conversion t))
(process-send-string proc query-string)))
((string-prefix-p "deleted" event)) ; do nothing
((and (not response-string-parts)
- (not (or elpher-ipv4-always force-ipv4)))
+ (not (or elpher-ipv4-always force-ipv4 socks)))
; Try again with IPv4
(message "Connection failed. Retrying with IPv4.")
(elpher-get-host-response address default-port
(t
(error "No response from server")))
(error
- (elpher-network-error address the-error))))))
+ (elpher-network-error address the-error)))))
+ (when socks
+ (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
+ (funcall (process-sentinel proc) proc "open\n")))
(error
(error "Error initiating connection to server")))))
-(defun elpher-generate-certificate (name key-file cert-file &optional temporary)
+
+;;; Client-side TLS Certificate Management
+;;
+
+(defun elpher-generate-certificate (common-name key-file cert-file &optional temporary)
+ "Generate a key and a self-signed client TLS certificate using openssl.
+
+The Common Name field of the certificate is set to COMMON-NAME. The
+arguments KEY-FILE and CERT-FILE should contain the absolute paths of
+the key and certificate files to write.
+
+If TEMPORARY is non-nil, the certificate will be given an exporation
+period of one day, and the key and certificate files will be deleted
+when the certificate is no longer needed for the current session.
+
+Otherwise, the certificate will be given a 100 year expiration period
+and the files will not be deleted.
+
+The function returns a list containing the current host name, the
+temporary flag, and the key and cert file names in the form required
+by `gnutls-boot-parameters`."
(let ((exp-key-file (expand-file-name key-file))
(exp-cert-file (expand-file-name cert-file)))
- (call-process "openssl" nil nil nil
- "req" "-x509" "-newkey" "rsa:2048"
- "-days" (if temporary "1" "36500")
- "-nodes"
- "-subj" (concat "/CN=" name)
- "-keyout" exp-key-file
- "-out" exp-cert-file)
- (list (elpher-address-host (elpher-page-address elpher-current-page))
- temporary exp-key-file exp-cert-file)))
+ (condition-case nil
+ (progn
+ (call-process elpher-openssl-command nil nil nil
+ "req" "-x509" "-newkey" "rsa:2048"
+ "-days" (if temporary "1" "36500")
+ "-nodes"
+ "-subj" (concat "/CN=" common-name)
+ "-keyout" exp-key-file
+ "-out" exp-cert-file)
+ (list (elpher-address-host (elpher-page-address elpher-current-page))
+ temporary exp-key-file exp-cert-file))
+ (error
+ (message "Check that openssl is installed, or customize `elpher-openssl-command`.")
+ (error "Program 'openssl', required for certificate generation, not found")))))
(defun elpher-generate-throwaway-certificate ()
+ "Generate and return details of a throwaway certificate.
+The key and certificate files will be deleted when they are no
+longer needed for this session."
(let* ((file-base (make-temp-name "elpher"))
(key-file (concat temporary-file-directory file-base ".key"))
(cert-file (concat temporary-file-directory file-base ".crt")))
(elpher-generate-certificate file-base key-file cert-file t)))
-(defun elpher-generate-permanent-certificate (file-base)
+(defun elpher-generate-persistent-certificate (file-base common-name)
+ "Generate and return details of a persistent certificate.
+The argument FILE-BASE is used as the base for the key and certificate
+files, while COMMON-NAME specifies the common name field of the
+certificate.
+
+The key and certificate files are written to in `elpher-certificate-directory'."
(let* ((key-file (concat elpher-certificate-directory file-base ".key"))
(cert-file (concat elpher-certificate-directory file-base ".crt")))
- (elpher-generate-certificate file-base key-file cert-file)))
+ (elpher-generate-certificate common-name key-file cert-file)))
(defun elpher-get-existing-certificate (file-base)
+ "Return a certificate object corresponding to an existing certificate.
+It is assumed that the key files FILE-BASE.key and FILE-BASE.crt exist in
+the directory `elpher-certificate-directory'."
(let* ((key-file (concat elpher-certificate-directory file-base ".key"))
(cert-file (concat elpher-certificate-directory file-base ".crt")))
(list (elpher-address-host (elpher-page-address elpher-current-page))
(expand-file-name key-file)
(expand-file-name cert-file))))
+(defun elpher-install-and-use-existing-certificate (key-file-src cert-file-src file-base)
+ "Install a key+certificate file pair in `elpher-certificate-directory'.
+The strings KEY-FILE-SRC and CERT-FILE-SRC are the existing key and
+certificate files to install. The argument FILE-BASE is used as the
+base for the installed key and certificate files."
+ (let* ((key-file (concat elpher-certificate-directory file-base ".key"))
+ (cert-file (concat elpher-certificate-directory file-base ".crt")))
+ (if (or (file-exists-p key-file)
+ (file-exists-p cert-file))
+ (error "A certificate with base name %s is already installed" file-base))
+ (copy-file key-file-src key-file)
+ (copy-file cert-file-src cert-file)
+ (list (elpher-address-host (elpher-page-address elpher-current-page))
+ nil
+ (expand-file-name key-file)
+ (expand-file-name cert-file))))
+
(defun elpher-list-existing-certificates ()
+ "Return a list of the persistent certificates in `elpher-certificate-directory'."
+ (unless (file-directory-p elpher-certificate-directory)
+ (make-directory elpher-certificate-directory))
(mapcar
(lambda (file)
(file-name-sans-extension file))
- (directory-files elpher-certificate-directory nil "\.key$")))
-
+ (directory-files elpher-certificate-directory nil "\\.key$")))
+
+(defun elpher-forget-current-certificate ()
+ "Causes any current certificate to be forgotten.)
+In the case of throwaway certificates, the key and certificate files
+are also deleted."
+ (interactive)
+ (when elpher-client-certificate
+ (unless (and (called-interactively-p 'any)
+ (not (y-or-n-p (concat "Really forget client certificate? "
+ "(Throwaway certificates will be deleted.)"))))
+ (when (cadr elpher-client-certificate)
+ (delete-file (elt elpher-client-certificate 2))
+ (delete-file (elt elpher-client-certificate 3)))
+ (setq elpher-client-certificate nil)
+ (if (called-interactively-p 'any)
+ (message "Client certificate forgotten.")))))
(defun elpher-get-current-keylist (address)
+ "Retrieve the `gnutls-boot-parameters'-compatable keylist.
+
+This is obtained from the client certificate described by
+`elpher-current-certificate', if one is available and the host for
+that certificate matches the host in ADDRESS.
+
+If `elpher-current-certificate' is non-nil, and its host name doesn't
+match that of ADDRESS, the certificate is forgotten."
(if elpher-client-certificate
(if (string= (car elpher-client-certificate)
(elpher-address-host address))
(list (cddr elpher-client-certificate))
- (when (cadr elpher-client-certificate)
- (delete-file (elt elpher-client-certificate 2))
- (delete-file (elt elpher-client-certificate 3)))
- (setq elpher-client-certificate nil)
+ (elpher-forget-current-certificate)
(message "Disabling client certificate for new host")
nil)
nil))
(if type-map-entry
(let* ((margin-code (elt type-map-entry 2))
(face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(elpher-insert-margin margin-code)
(insert-text-button filtered-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
- (ansi-color-filter-apply string)
- (ansi-color-apply string))))
+ (elpher-color-filter-apply string)
+ (elpher-color-apply string))))
(defun elpher-render-text (data &optional _mime-type-string)
"Render DATA as text. MIME-TYPE-STRING is unused."
(elpher-get-gopher-response search-address renderer))
(if aborted
(elpher-visit-previous-page))))))
-
+
;; Raw server response rendering
(defun elpher-render-raw (data &optional mime-type-string)
(?1 ; Input required
(elpher-with-clean-buffer
(insert "Gemini server is requesting input."))
- (let* ((query-string (read-string (concat response-meta ": ")))
+ (let* ((query-string
+ (if (eq (elt response-code 1) ?1)
+ (read-passwd (concat response-meta ": "))
+ (read-string (concat response-meta ": "))))
(query-address (seq-copy (elpher-page-address elpher-current-page)))
(old-fname (url-filename query-address)))
(setf (url-filename query-address)
(insert "Gemini server is requesting a valid TLS certificate:\n\n"))
(auto-fill-mode 1)
(elpher-gemini-insert-text response-meta))
- (let* ((read-answer-short t)
- (res (read-answer "What do you want to do? "
- '(("throwaway" ?t "generate and use throw-away certificate")
- ("permanent" ?p "generate and use permanent certificate")
- ("existing" ?e "use existing certificate")
- ("abort" ?a "stop immediately")))))
- (pcase res
- ("throwaway"
- (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
- ("permanent"
- (let ((file-base (read-string "Name for certificate: ")))
- (setq elpher-client-certificate
- (elpher-generate-permanent-certificate file-base))))
- ("existing"
- (let ((file-base (completing-read "Name of existing certificate (autocompletes, empty response aborts): "
- (elpher-list-existing-certificates)
- nil t)))
- (if (string-empty-p file-base)
- (error "Gemini server requires a client certificate and none was provided")
- (setq elpher-client-certificate
- (elpher-get-existing-certificate file-base)))))
- ;; TODO
- ("abort"
- (error "Gemini server requires a client certificate and none was provided")))
- (elpher-with-clean-buffer)
- (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer)))
+ (let ((chosen-certificate (elpher-choose-client-certificate)))
+ (unless chosen-certificate
+ (error "Gemini server requires a client certificate and none was provided"))
+ (setq elpher-client-certificate chosen-certificate))
+ (elpher-with-clean-buffer)
+ (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer))
(_other
(error "Gemini server response unknown: %s %s"
response-code response-meta))))))
+(defun elpher-choose-client-certificate ()
+ "Prompt for a client certificate to use to establish a TLS connection."
+ (let* ((read-answer-short t))
+ (pcase (read-answer "What do you want to do? "
+ '(("throwaway" ?t
+ "generate and use throw-away certificate")
+ ("persistent" ?p
+ "generate new or use existing persistent certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("throwaway"
+ (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
+ ("persistent"
+ (let* ((existing-certificates (elpher-list-existing-certificates))
+ (file-base (completing-read
+ "Nickname for new or existing certificate (autocompletes, empty response aborts): "
+ existing-certificates)))
+ (if (string-empty-p (string-trim file-base))
+ nil
+ (if (member file-base existing-certificates)
+ (setq elpher-client-certificate
+ (elpher-get-existing-certificate file-base))
+ (pcase (read-answer "Generate new certificate or install externally-generated one? "
+ '(("new" ?n
+ "generate new certificate")
+ ("install" ?i
+ "install existing certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("new"
+ (let ((common-name (read-string "Common Name field for new certificate: "
+ file-base)))
+ (message "New key and self-signed certificate written to %s"
+ elpher-certificate-directory)
+ (elpher-generate-persistent-certificate file-base common-name)))
+ ("install"
+ (let* ((cert-file (read-file-name "Certificate file: " nil nil t))
+ (key-file (read-file-name "Key file: " nil nil t)))
+ (message "Key and certificate installed in %s for future use"
+ elpher-certificate-directory)
+ (elpher-install-and-use-existing-certificate key-file
+ cert-file
+ file-base)))
+ ("abort" nil))))))
+ ("abort" nil))))
+
(defun elpher-get-gemini-page (renderer)
"Getter which retrieves and renders a Gemini page and renders it using RENDERER."
(let* ((address (elpher-page-address elpher-current-page))
(error
(elpher-network-error address the-error)))))
-
(defun elpher-render-gemini (body &optional mime-type-string)
"Render gemini response BODY with rendering MIME-TYPE-STRING."
(if (not body)
(string-join (reverse path-reversed-normalized) "/")))
(defun elpher-address-from-gemini-url (url)
- "Extract address from URL with defaults as per gemini map files."
+ "Extract address from URL with defaults as per gemini map files.
+While there's obviously some redundancy here between this function and
+`elpher-address-from-url', gemini map file URLs require enough special
+treatment that a separate function is warranted."
(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
(url-filename address)))))
(unless (url-type address)
(setf (url-type address) "gemini"))
- (if (equal (url-type address) "gemini")
- (setf (url-filename address)
- (elpher-collapse-dot-sequences (url-filename address)))))
- address))
+ (when (equal (url-type address) "gemini")
+ (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."
(address (elpher-address-from-gemini-url url))
(type (if address (elpher-address-type address) nil))
(type-map-entry (cdr (assoc type elpher-type-map))))
+ (setq elpher--gemini-page-links (append elpher--gemini-page-links `(,address)))
(when display-string
(insert elpher-gemini-link-string)
(if type-map-entry
(let* ((face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(insert-text-button filtered-display-string
'face face
'help-echo #'elpher--page-button-help))
(insert (propertize display-string 'face 'elpher-unknown)))
(insert "\n"))))
-
+
(defun elpher-gemini-insert-header (header-line)
"Insert header described by HEADER-LINE into a text/gemini document.
The gemini map file line describing the header is given
by HEADER-LINE."
(when (string-match "^\\(#+\\)[ \t]*" header-line)
- (let ((level (length (match-string 1 header-line)))
- (header (substring header-line (match-end 0))))
+ (let* ((level (length (match-string 1 header-line)))
+ (header (substring header-line (match-end 0)))
+ (face (pcase level
+ (1 'elpher-gemini-heading1)
+ (2 'elpher-gemini-heading2)
+ (3 'elpher-gemini-heading3)
+ (_ 'default)))
+ (fill-column (if (display-graphic-p)
+ (/ (* 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
- (pcase level
- (1 'elpher-gemini-heading1)
- (2 'elpher-gemini-heading2)
- (3 'elpher-gemini-heading3)
- (_ 'default)))
- "\n"))))
+ (insert (propertize header 'face face))
+ (newline))))
(defun elpher-gemini-insert-text (text-line)
"Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
This function uses Emacs' auto-fill to wrap text sensibly to a maximum
width defined by elpher-gemini-max-fill-width."
(string-match "\\(^[ \t]*\\)\\(\*[ \t]+\\|>[ \t]*\\)?" text-line)
- (let* ((processed-text-line (if (match-string 2 text-line)
- (concat
- (replace-regexp-in-string "\*"
- elpher-gemini-bullet-string
- (match-string 0 text-line))
- (substring text-line (match-end 0)))
- text-line))
- (adaptive-fill-mode nil)
- (fill-prefix (if (match-string 2 text-line)
- (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line))
- nil)))
+ (let* ((line-prefix (match-string 2 text-line))
+ (processed-text-line
+ (if line-prefix
+ (cond ((string-prefix-p "*" line-prefix)
+ (concat
+ (replace-regexp-in-string "\*"
+ elpher-gemini-bullet-string
+ (match-string 0 text-line))
+ (substring text-line (match-end 0))))
+ ((string-prefix-p ">" line-prefix)
+ (propertize text-line 'face 'elpher-gemini-quoted))
+ (t text-line))
+ text-line))
+ (adaptive-fill-mode nil))
(insert (elpher-process-text-for-display processed-text-line))
(newline)))
(defun elpher-render-gemini-map (data _parameters)
"Render DATA as a gemini map file, PARAMETERS is currently unused."
(elpher-with-clean-buffer
- (let ((preformatted nil))
+ (setq elpher--gemini-page-headings nil)
+ (let ((preformatted nil)
+ (link-counter 1))
(auto-fill-mode 1)
(setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
+ (setq elpher--gemini-page-links '())
(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)
+ (progn
+ (if elpher-gemini-number-links
+ (insert
+ (concat
+ "["
+ (number-to-string link-counter)
+ "] ")))
+ (setq link-counter (1+ link-counter))
+ (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))
(elpher-cache-content
(elpher-page-address elpher-current-page)
- (buffer-string))))
+ (buffer-string))
+ (puthash
+ (elpher-page-address elpher-current-page)
+ elpher--gemini-page-links
+ elpher--gemini-page-links-cache)))
(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))))
+
;; Finger page connection
(defun elpher-get-finger-page (renderer)
(elpher-network-error address the-error))))))
+;; Telnet page connection
+
+(defun elpher-get-telnet-page (renderer)
+ "Opens a telnet connection to the current page address (RENDERER must be nil)."
+ (when renderer
+ (elpher-visit-previous-page)
+ (error "Command not supported for telnet URLs"))
+ (let* ((address (elpher-page-address elpher-current-page))
+ (host (elpher-address-host address))
+ (port (elpher-address-port address)))
+ (elpher-visit-previous-page)
+ (if (> port 0)
+ (telnet host port)
+ (telnet host))))
+
+
;; Other URL page opening
(defun elpher-get-other-url-page (renderer)
(browse-web url)
(browse-url url)))))
-;; Telnet page connection
-
-(defun elpher-get-telnet-page (renderer)
- "Opens a telnet connection to the current page address (RENDERER must be nil)."
- (when renderer
- (elpher-visit-previous-page)
- (error "Command not supported for telnet URLs"))
- (let* ((address (elpher-page-address elpher-current-page))
- (host (elpher-address-host address))
- (port (elpher-address-port address)))
- (elpher-visit-previous-page)
- (if (> port 0)
- (telnet host port)
- (telnet host))))
;; Start page page retrieval
" - u/mouse-3/U: return to previous page or to the start page\n"
" - o/O: visit different selector or the root menu of the current server\n"
" - g: go to a particular address (gopher, gemini, finger)\n"
+ " - v: visit a numbered link on a gemini page\n"
" - d/D: download item under cursor or current page\n"
" - i/I: info on item under cursor or current page\n"
" - c/C: copy URL representation of item under cursor or current page\n"
" - R: reload current page (regenerates cache)\n"
" - S: set character coding system for gopher (default is to autodetect)\n"
" - T: toggle TLS gopher mode\n"
+ " - F: forget/discard current TLS client certificate\n"
" - .: display the raw server response for the current page\n"
"\n"
"Start your exploration of gopher space and gemini:\n")
"Alternatively, select a search engine and enter some search terms:\n")
(elpher-insert-index-record "Gopher Search Engine (Veronica-2)"
(elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70))
- (elpher-insert-index-record "Gemini Search Engine (GUS)"
- (elpher-address-from-url "gemini://gus.guru/search"))
+ (elpher-insert-index-record "Gemini Search Engine (geminispace.info)"
+ (elpher-address-from-url "gemini://geminispace.info/search"))
(insert "\n"
"This page contains your bookmarked sites (also visit with B):\n")
(elpher-insert-index-record "Your Bookmarks" 'bookmarks)
'help-echo help-string))
(insert "\n")
(elpher-restore-pos)))
-
+
;;; Bookmarks
;;
DISPLAY-STRING determines how the bookmark will appear in the
bookmark list, while URL is the url of the entry."
(list display-string url))
-
+
(defun elpher-bookmark-display-string (bookmark)
"Get the display string of BOOKMARK."
(elt bookmark 0))
(defun elpher-save-bookmarks (bookmarks)
"Record the bookmark list BOOKMARKS to the user's bookmark file.
Beware that this completely replaces the existing contents of the file."
+ (let ((bookmark-dir (file-name-directory elpher-bookmarks-file)))
+ (unless (file-directory-p bookmark-dir)
+ (make-directory bookmark-dir)))
(with-temp-file elpher-bookmarks-file
(erase-buffer)
(insert "; Elpher bookmarks file\n\n"
(not (equal (elpher-bookmark-url bookmark) url)))
(elpher-load-bookmarks)))))
+;;; Integrations
+;;
+
+(defun elpher-org-link-store ()
+ "Store link to an `elpher' page in org-mode."
+ (when (eq major-mode 'elpher-mode)
+ (let ((link (concat "elpher:" (elpher-info-current)))
+ (desc (car elpher-current-page)))
+ (org-link-store-props :type "elpher"
+ :link link
+ :description desc)
+ t)))
+
+(defun elpher-org-link-follow (link _args)
+ "Follow an `elpher' link in an `org' buffer."
+ (require 'elpher)
+ (message (concat "Got link: " link))
+ (when (or
+ (string-match-p "^gemini://.+" link)
+ (string-match-p "^gopher://.+" link)
+ (string-match-p "^finger://.+" link))
+ (elpher-go (string-remove-prefix "elpher:" link))))
+
+(with-eval-after-load "org"
+ ;; Use `org-link-set-parameters' if defined (org-mode 9+)
+ (if (fboundp 'org-link-set-parameters)
+ (org-link-set-parameters "elpher"
+ :store #'elpher-org-link-store
+ :follow #'elpher-org-link-follow)
+ (org-add-link-type "mu4e" 'elpher-org-link-follow)
+ (add-hook 'org-store-link-functions 'elpher-org-link-store)))
+
+(defun browse-url-elpher (url &rest _args)
+ "Browse URL. This function is used by `browse-url'."
+ (interactive (browse-url-interactive-arg "Elpher URL: "))
+ (elpher-go url))
+
+(with-eval-after-load "browse-url"
+ ;; Use elpher to open gopher, finger and gemini links
+ (when (boundp 'browse-url-default-handlers)
+ (add-to-list 'browse-url-default-handlers
+ '("^\\(gopher\\|finger\\|gemini\\)://" . browse-url-elpher)))
+ ;; Register "gemini://" as a URI scheme so `browse-url' does the right thing
+ (add-to-list 'thing-at-point-uri-schemes "gemini://"))
+
;;; Interactive procedures
;;
(interactive)
(push-button))
+;;;###autoload
(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: ")
(let* ((cleaned-host-or-url (string-trim host-or-url))
(address (elpher-address-from-url cleaned-host-or-url))
- (page (elpher-make-page cleaned-host-or-url address)))
- (switch-to-buffer "*elpher*")
+ (page (elpher-make-page cleaned-host-or-url address)))
+ (switch-to-buffer elpher-buffer-name)
(elpher-visit-page page)
nil))
"Go to a particular site read from the minibuffer, initialized with the current URL."
(interactive)
(let ((address (elpher-page-address elpher-current-page)))
- (if (elpher-address-special-p address)
- (error "Command invalid for this page")
- (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address))))
- (elpher-visit-page (elpher-make-page url (elpher-address-from-url url)))))))
+ (let ((url (read-string "Gopher or Gemini URL: "
+ (unless (elpher-address-special-p address)
+ (elpher-address-to-url address)))))
+ (elpher-visit-page (elpher-make-page url (elpher-address-from-url url))))))
+
+(defun elpher-visit-gemini-numbered-link (n)
+ "Visit link designated by a number."
+ (interactive "nLink number: ")
+ (if (or (> n (length elpher--gemini-page-links))
+ (< n 1))
+ (user-error "Invalid link number"))
+ (let ((address (nth (1- n) elpher--gemini-page-links)))
+ (elpher-go (url-recreate-url address))))
(defun elpher-redraw ()
"Redraw current page."
(defun elpher-back-to-start ()
"Go all the way back to the start page."
(interactive)
- (setq elpher-current-page nil)
- (setq elpher-history nil)
+ (setq-local elpher-current-page nil)
+ (setq-local elpher-history nil)
(let ((start-page (elpher-make-page "Elpher Start Page"
(elpher-make-special-address 'start))))
(elpher-visit-page start-page)))
(message "Bookmark removed.")))
(error "No link selected"))))
+;;;###autoload
(defun elpher-bookmarks ()
"Visit bookmarks page."
(interactive)
- (switch-to-buffer "*elpher*")
+ (switch-to-buffer elpher-buffer-name)
(elpher-visit-page
(elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
(if button
(elpher-info-page (button-get button 'elpher-page))
(error "No item selected"))))
-
+
(defun elpher-info-current ()
"Display information on current page."
(interactive)
(define-key map (kbd "X") 'elpher-unbookmark-current)
(define-key map (kbd "B") 'elpher-bookmarks)
(define-key map (kbd "S") 'elpher-set-gopher-coding-system)
+ (define-key map (kbd "F") 'elpher-forget-current-certificate)
+ (define-key map (kbd "v") 'elpher-visit-gemini-numbered-link)
(when (fboundp 'evil-define-key*)
(evil-define-key* 'motion map
(kbd "TAB") 'elpher-next-link
(kbd "C-") 'elpher-follow-current-link
(kbd "C-t") 'elpher-back
(kbd "u") 'elpher-back
+ (kbd "-") 'elpher-back
+ (kbd "^") 'elpher-back
(kbd "U") 'elpher-back-to-start
[mouse-3] 'elpher-back
- (kbd "g") 'elpher-go
- (kbd "o") 'elpher-go-current
+ (kbd "o") 'elpher-go
+ (kbd "O") 'elpher-go-current
(kbd "r") 'elpher-redraw
(kbd "R") 'elpher-reload
(kbd "T") 'elpher-toggle-tls
(kbd ".") 'elpher-view-raw
(kbd "d") 'elpher-download
(kbd "D") 'elpher-download-current
- (kbd "m") 'elpher-jump
+ (kbd "J") 'elpher-jump
(kbd "i") 'elpher-info-link
(kbd "I") 'elpher-info-current
(kbd "c") 'elpher-copy-link-url
(kbd "x") 'elpher-unbookmark-link
(kbd "X") 'elpher-unbookmark-current
(kbd "B") 'elpher-bookmarks
- (kbd "S") 'elpher-set-gopher-coding-system))
+ (kbd "S") 'elpher-set-gopher-coding-system
+ (kbd "F") 'elpher-forget-current-certificate
+ (kbd "v") 'elpher-visit-gemini-numbered-link))
map)
"Keymap for gopher client.")
This mode is automatically enabled by the interactive
functions which initialize the gopher client, namely
-`elpher', `elpher-go' and `elpher-bookmarks'.")
+`elpher', `elpher-go' and `elpher-bookmarks'."
+ (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 imenu-create-index-function
+ (lambda ()
+ elpher--gemini-page-headings)))
(when (fboundp 'evil-set-initial-state)
(evil-set-initial-state 'elpher-mode 'motion))
;;
;;;###autoload
-(defun elpher ()
- "Start elpher with default landing page."
- (interactive)
- (if (get-buffer "*elpher*")
- (switch-to-buffer "*elpher*")
- (switch-to-buffer "*elpher*")
- (setq elpher-current-page nil)
- (setq elpher-history nil)
- (let ((start-page (elpher-make-page "Elpher Start Page"
- (elpher-make-special-address 'start))))
- (elpher-visit-page start-page)))
- "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
+(defun elpher (&optional arg)
+ "Start elpher with default landing page.
+The buffer used for Elpher sessions is determined by the value of
+‘elpher-buffer-name’. If there is already an Elpher session active in
+that buffer, Emacs will simply switch to it. Otherwise, a new session
+will begin. A numeric prefix arg (as in ‘C-u 42 M-x elpher RET’)
+switches to the session with that number, creating it if necessary. A
+nonnumeric prefix arg means to create a new session. Returns the
+buffer selected (or created)."
+ (interactive "P")
+ (let* ((name (default-value 'elpher-buffer-name))
+ (buf (cond ((numberp arg)
+ (get-buffer-create (format "%s<%d>" name arg)))
+ (arg
+ (generate-new-buffer name))
+ (t
+ (get-buffer-create name)))))
+ (pop-to-buffer-same-window buf)
+ (unless (buffer-modified-p)
+ (elpher-mode)
+ (let ((start-page (elpher-make-page "Elpher Start Page"
+ (elpher-make-special-address 'start))))
+ (elpher-visit-page start-page))
+ "Started Elpher."))); Otherwise (elpher) evaluates to start page string.
;;; elpher.el ends here
The Lambda Lab / projects / elpher.git / blobdiff