-;;; elpher.el --- A friendly gopher client. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2019 Tim Vaughan
-
-;; Author: Tim Vaughan <tgvaughan@gmail.com>
+;;; 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) 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>
+
+;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.4.4
+;; Version: 3.0.0
;; Keywords: comm gopher
-;; Homepage: http://thelambdalab.xyz/elpher
-;; Package-Requires: ((emacs "26"))
+;; Homepage: https://thelambdalab.xyz/elpher
+;; Package-Requires: ((emacs "27.1"))
;; This file is not part of GNU Emacs.
;;; Commentary:
-;; Elpher aims to provide a practical and friendly gopher client
-;; for GNU Emacs. It supports:
+;; Elpher aims to provide a practical and friendly gopher and gemini
+;; client for GNU Emacs. It supports:
;; - intuitive keyboard and mouse-driven browsing,
;; - out-of-the-box compatibility with evil-mode,
;; - caching of visited sites,
;; - pleasant and configurable colouring of Gopher directories,
;; - direct visualisation of image files,
-;; - a simple bookmark management system,
-;; - connections using TLS encryption,
-;; - support for the fledgling Gemini protocol.
+;; - gopher connections using TLS encryption,
+;; - the fledgling Gemini protocol,
+;; - the greybeard Finger protocol.
;; To launch Elpher, simply use 'M-x elpher'. This will open a start
;; page containing information on key bindings and suggested starting
;; Full instructions can be found in the Elpher info manual.
;; Elpher is under active development. Any suggestions for
-;; improvements are welcome, and can be made on the official
-;; project page, gopher://thelambdalab.xyz/1/projects/elpher/.
+;; improvements are welcome, and can be made on the official project
+;; page, gopher://thelambdalab.xyz/1/projects/elpher, or via the
+;; project mailing list at https://lists.sr.ht/~michel-slm/elpher.
;;; Code:
(require 'url-util)
(require 'subr-x)
(require 'dns)
-
+(require 'nsm)
+(require 'gnutls)
+(require 'socks)
;;; Global constants
;;
-(defconst elpher-version "2.4.4"
+(defconst elpher-version "3.0.0"
"Current version of elpher.")
(defconst elpher-margin-width 6
"Width of left-hand margin used when rendering indicies.")
(defconst elpher-type-map
- '(((gopher ?0) elpher-get-gopher-node elpher-render-text "txt" elpher-text)
- ((gopher ?1) elpher-get-gopher-node elpher-render-index "/" elpher-index)
- ((gopher ?4) elpher-get-gopher-node elpher-render-download "bin" elpher-binary)
- ((gopher ?5) elpher-get-gopher-node elpher-render-download "bin" elpher-binary)
- ((gopher ?7) elpher-get-gopher-query-node elpher-render-index "?" elpher-search)
- ((gopher ?9) elpher-get-gopher-node elpher-render-download "bin" elpher-binary)
- ((gopher ?g) elpher-get-gopher-node elpher-render-image "img" elpher-image)
- ((gopher ?p) elpher-get-gopher-node elpher-render-image "img" elpher-image)
- ((gopher ?I) elpher-get-gopher-node elpher-render-image "img" elpher-image)
- ((gopher ?d) elpher-get-gopher-node elpher-render-download "doc" elpher-binary)
- ((gopher ?P) elpher-get-gopher-node elpher-render-download "doc" elpher-binary)
- ((gopher ?s) elpher-get-gopher-node elpher-render-download "snd" elpher-binary)
- ((gopher ?h) elpher-get-gopher-node elpher-render-html "htm" elpher-html)
- (gemini elpher-get-gemini-node elpher-render-gemini "gem" elpher-gemini)
- (telnet elpher-get-telnet-node nil "tel" elpher-telnet)
- (other-url elpher-get-other-url-node nil "url" elpher-other-url)
- ((special bookmarks) elpher-get-bookmarks-node nil "/" elpher-index)
- ((special start) elpher-get-start-node nil))
+ '(((gopher ?0) elpher-get-gopher-page elpher-render-text "txt" elpher-text)
+ ((gopher ?1) elpher-get-gopher-page elpher-render-index "/" elpher-index)
+ ((gopher ?4) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
+ ((gopher ?5) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
+ ((gopher ?7) elpher-get-gopher-query-page elpher-render-index "?" elpher-search)
+ ((gopher ?9) elpher-get-gopher-page elpher-render-download "bin" elpher-binary)
+ ((gopher ?g) elpher-get-gopher-page elpher-render-image "img" elpher-image)
+ ((gopher ?p) elpher-get-gopher-page elpher-render-image "img" elpher-image)
+ ((gopher ?I) elpher-get-gopher-page elpher-render-image "img" elpher-image)
+ ((gopher ?d) elpher-get-gopher-page elpher-render-download "doc" elpher-binary)
+ ((gopher ?P) elpher-get-gopher-page elpher-render-download "doc" elpher-binary)
+ ((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)
+ (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)
+ ((special start) elpher-get-start-page nil "E" elpher-index)
+ ((special bookmarks) elpher-get-bookmarks-page nil "E" elpher-index)
+ ((special history) elpher-get-history-page nil "E" elpher-index)
+ ((special visited-pages) elpher-get-visited-pages-page nil "E" elpher-index))
"Association list from types to getters, renderers, margin codes and index faces.")
+;;; Declarations to avoid compiler warnings.
+;;
+
+(eval-when-compile
+ (declare-function ansi-color-filter-apply "ansi-color")
+ (declare-function ansi-color-apply "ansi-color")
+ (declare-function bookmark-store "bookmark")
+ (declare-function org-link-store-props "ol")
+ (declare-function org-link-set-parameters "ol")
+ (defvar ansi-color-context)
+ (defvar bookmark-make-record-function)
+ (defvar mu4e~view-beginning-of-url-regexp)
+ (defvar thing-at-point-uri-schemes))
+
+
;;; Customization group
;;
(defgroup elpher nil
- "A gopher client."
+ "A gopher and gemini client."
:group 'applications)
+;; General appearance and customizations
+
+(defcustom elpher-open-urls-with-eww nil
+ "If non-nil, open URL selectors using eww.
+Otherwise, use the system browser via the `browse-url' function."
+ :type '(boolean))
+
+(defcustom elpher-use-header t
+ "If non-nil, display current page information in buffer header."
+ :type '(boolean))
+
+(defcustom elpher-auto-disengage-TLS nil
+ "If non-nil, automatically disengage TLS following an unsuccessful connection.
+While enabling this may seem convenient, it is also potentially
+dangerous as it allows switching from an encrypted channel back to
+plain text without user input."
+ :type '(boolean))
+
+(defcustom elpher-connection-timeout 5
+ "Specifies the number of seconds to wait for a network connection to time out."
+ :type '(integer))
+
+(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."
+ :type '(boolean))
+
+(defcustom elpher-certificate-directory
+ (file-name-as-directory (locate-user-emacs-file "elpher-certificates"))
+ "Specify the name of the directory where client certificates will be stored.
+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.
+
+This defaults to off because it is standard practice for Gemini servers
+to use self-signed certificates, meaning that most servers provide what
+EMACS considers to be an invalid certificate."
+ :type '(boolean))
+
+(defcustom elpher-gemini-max-fill-width 80
+ "Specify the maximum default width (in columns) of text/gemini documents.
+The actual width used is the minimum of this value and the window width at
+the time when the text is rendered."
+ :type '(integer))
+
+(defcustom elpher-gemini-link-string "→ "
+ "Specify the string used to indicate links when rendering gemini maps.
+May be empty."
+ :type '(string))
+
+(defcustom elpher-gemini-bullet-string "•"
+ "Specify the string used for bullets when rendering gemini maps."
+ :type '(string))
+
+(defcustom elpher-ipv4-always nil
+ "If non-nil, elpher will always use IPv4 to establish network connections.
+This can be useful when browsing from a computer that supports IPv6, because
+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-use-emacs-bookmark-menu nil
+ "If non-nil, elpher will only use the native Emacs bookmark menu.
+Otherwise, \\[elpher-show-bookmarks] will visit a special elpher bookmark
+page within which all of the standard elpher keybindings are active."
+ :type '(boolean))
+
;; Face customizations
+(defgroup elpher-faces nil
+ "Elpher face customizations."
+ :group 'elpher)
+
(defface elpher-index
'((t :inherit font-lock-keyword-face))
"Face used for directory type directory records.")
"Face used for html type directory records.")
(defface elpher-gemini
- '((t :inherit font-lock-regexp-grouping-backslash))
- "Face used for html type directory records.")
+ '((t :inherit font-lock-constant-face))
+ "Face used for Gemini type directory records.")
(defface elpher-other-url
'((t :inherit font-lock-comment-face))
'((t :inherit shadow))
"Face used for brackets around directory margin key.")
-;; Other customizations
+(defface elpher-gemini-heading1
+ '((t :inherit bold :height 1.8))
+ "Face used for gemini heading level 1.")
-(defcustom elpher-open-urls-with-eww nil
- "If non-nil, open URL selectors using eww.
-Otherwise, use the system browser via the BROWSE-URL function."
- :type '(boolean))
+(defface elpher-gemini-heading2
+ '((t :inherit bold :height 1.5))
+ "Face used for gemini heading level 2.")
-(defcustom elpher-buttonify-urls-in-directories t
- "If non-nil, turns URLs matched in directories into clickable buttons."
- :type '(boolean))
+(defface elpher-gemini-heading3
+ '((t :inherit bold :height 1.2))
+ "Face used for gemini heading level 3.")
-(defcustom elpher-use-header t
- "If non-nil, display current node information in buffer header."
- :type '(boolean))
+(defface elpher-gemini-preformatted
+ '((t :inherit fixed-pitch))
+ "Face used for pre-formatted gemini text blocks.")
-(defcustom elpher-auto-disengage-TLS nil
- "If non-nil, automatically disengage TLS following an unsuccessful connection.
-While enabling this may seem convenient, it is also potentially dangerous as it
-allows switching from an encrypted channel back to plain text without user input."
- :type '(boolean))
-
-(defcustom elpher-connection-timeout 5
- "Specifies the number of seconds to wait for a network connection to time out."
- :type '(integer))
+(defface elpher-gemini-quoted
+ '((t :inherit font-lock-doc-face))
+ "Face used for gemini quoted texts.")
;;; Model
;;
(let ((url (url-generic-parse-url url-string)))
(unless (and (not (url-fullness url)) (url-type url))
(setf (url-fullness url) t)
- (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.
If the optional attribute TLS is non-nil, the address will be marked as
requiring gopher-over-TLS."
(cond
+ ((equal type ?i) nil)
((and (equal type ?h)
(string-prefix-p "URL:" selector))
(elpher-address-from-url (elt (split-string selector "URL:") 1)))
selector)))))
(defun elpher-make-special-address (type)
- "Create an ADDRESS object corresponding to the given special page symbol TYPE."
+ "Create an ADDRESS object corresponding to the given special address symbol TYPE."
type)
(defun elpher-address-to-url (address)
"Get string representation of ADDRESS, or nil if ADDRESS is special."
- (if (not (elpher-address-special-p address))
- (url-encode-url (url-recreate-url address))
- nil))
+ (if (elpher-address-special-p address)
+ nil
+ (url-encode-url (url-recreate-url address))))
(defun elpher-address-type (address)
"Retrieve type of ADDRESS object.
'gemini)
((equal protocol "telnet")
'telnet)
+ ((equal protocol "finger")
+ 'finger)
(t 'other-url)))))
(defun elpher-address-protocol (address)
For gopher addresses this is a combination of the selector type and selector."
(if (symbolp address)
nil
- (url-filename address)))
+ (url-unhex-string (url-filename address))))
(defun elpher-address-host (address)
"Retrieve host from ADDRESS object."
(url-host address))
+(defun elpher-address-user (address)
+ "Retrieve user from ADDRESS object."
+ (url-user address))
+
(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.)"
(url-port address)))
(defun elpher-address-special-p (address)
- "Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
+ "Return non-nil if ADDRESS object is special (e.g. start page page)."
(symbolp address))
(defun elpher-address-gopher-p (address)
"Return non-nill if ADDRESS object is a gopher address."
(and (not (elpher-address-special-p address))
- (member (elpher-address-protocol address) '("gopher gophers"))))
+ (member (elpher-address-protocol address) '("gopher" "gophers"))))
(defun elpher-gopher-address-selector (address)
"Retrieve gopher selector from ADDRESS object."
(if (member (url-filename address) '("" "/"))
""
- (substring (url-filename address) 2)))
-
-;; Node
-
-(defun elpher-make-node (display-string address &optional parent)
- "Create a node in the page hierarchy.
-
-DISPLAY-STRING records the display string used for the page.
-
-ADDRESS specifies the address object of the page.
+ (url-unhex-string (substring (url-filename address) 2))))
-The optional PARENT specifies the parent node in the hierarchy.
-This is set every time the node is visited, so while it forms
-an important part of the node data there is no need to set it
-initially."
- (list display-string address parent))
-
-(defun elpher-node-display-string (node)
- "Retrieve the display string of NODE."
- (elt node 0))
-
-(defun elpher-node-address (node)
- "Retrieve the ADDRESS object of NODE."
- (elt node 1))
-
-(defun elpher-node-parent (node)
- "Retrieve the parent node of NODE."
- (elt node 2))
-
-(defun elpher-set-node-parent (node parent)
- "Set the parent node of NODE to be PARENT."
- (setcar (cdr (cdr node)) parent))
;; Cache
"Set the cursor position cache for ADDRESS to POS."
(puthash address pos elpher-pos-cache))
-;; Node graph traversal
-(defvar elpher-current-node nil)
+;; Page
+
+(defun elpher-make-page (display-string address)
+ "Create a page with DISPLAY-STRING and ADDRESS."
+ (list display-string address))
+
+(defun elpher-make-start-page ()
+ "Create the start page."
+ (elpher-make-page "Elpher Start Page"
+ (elpher-make-special-address 'start)))
+
+(defun elpher-page-display-string (page)
+ "Retrieve the display string corresponding to PAGE."
+ (elt page 0))
+
+(defun elpher-page-address (page)
+ "Retrieve the address corresponding to PAGE."
+ (elt page 1))
+
+(defun elpher-page-set-address (page new-address)
+ "Set the address corresponding to PAGE to NEW-ADDRESS."
+ (setcar (cdr page) new-address))
-(defun elpher-visit-node (node &optional renderer preserve-parent)
- "Visit NODE using its own renderer or RENDERER, if non-nil.
-Additionally, set the parent of NODE to `elpher-current-node',
-unless PRESERVE-PARENT is non-nil."
+(defvar elpher-current-page nil
+ "The current page for this Elpher buffer.")
+
+(defvar elpher-history nil
+ "The local history stack for this Elpher buffer.
+This variable is used by `elpher-back' and
+`elpher-show-history'.")
+
+(defvar elpher-visited-pages nil
+ "The global history for all Elpher buffers.
+This variable is used by `elpher-show-visited-pages'.")
+
+(defun elpher-visit-page (page &optional renderer no-history)
+ "Visit PAGE using its own renderer or RENDERER, if non-nil.
+Additionally, push PAGE onto the history stack and the list of
+previously-visited pages,unless NO-HISTORY is non-nil."
(elpher-save-pos)
(elpher-process-cleanup)
- (unless preserve-parent
- (if (and (elpher-node-parent elpher-current-node)
- (equal (elpher-node-address elpher-current-node)
- (elpher-node-address node)))
- (elpher-set-node-parent node (elpher-node-parent elpher-current-node))
- (elpher-set-node-parent node elpher-current-node)))
- (setq elpher-current-node node)
- (let* ((address (elpher-node-address node))
+ (unless no-history
+ (unless (equal (elpher-page-address elpher-current-page)
+ (elpher-page-address page))
+ (push elpher-current-page elpher-history)
+ (unless (or (elpher-address-special-p (elpher-page-address page))
+ (and elpher-visited-pages
+ (equal page (car elpher-visited-pages))))
+ (push page elpher-visited-pages))))
+ (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))))
(if type-record
(if renderer
renderer
(cadr type-record)))
- (elpher-visit-parent-node)
+ (elpher-visit-previous-page)
(pcase type
(`(gopher ,type-char)
(error "Unsupported gopher selector type '%c' for '%s'"
(error "Unsupported address type '%S' for '%s'"
other (elpher-address-to-url address)))))))
-(defun elpher-visit-parent-node ()
- "Visit the parent of the current node."
- (let ((parent-node (elpher-node-parent elpher-current-node)))
- (when parent-node
- (elpher-visit-node parent-node nil t))))
-
-(defun elpher-reload-current-node ()
- "Reload the current node, discarding any existing cached content."
- (elpher-cache-content (elpher-node-address elpher-current-node) nil)
- (elpher-visit-node elpher-current-node))
+(defun elpher-visit-previous-page ()
+ "Visit the previous page in the history."
+ (let ((previous-page (pop elpher-history)))
+ (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)
+ (elpher-visit-page elpher-current-page))
(defun elpher-save-pos ()
- "Save the current position of point to the current node."
- (when elpher-current-node
- (elpher-cache-pos (elpher-node-address elpher-current-node) (point))))
+ "Save the current position of point to the current page."
+ (when elpher-current-page
+ (elpher-cache-pos (elpher-page-address elpher-current-page) (point))))
(defun elpher-restore-pos ()
- "Restore the position of point to that cached in the current node."
- (let ((pos (elpher-get-cached-pos (elpher-node-address elpher-current-node))))
+ "Restore the position of point to that cached in the current page."
+ (let ((pos (elpher-get-cached-pos (elpher-page-address elpher-current-page))))
(if pos
(goto-char pos)
(goto-char (point-min)))))
;;; 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 node info in window header."
+ "If `elpher-use-header' is true, display current page info in window header."
(if elpher-use-header
- (let* ((display-string (elpher-node-display-string elpher-current-node))
- (address (elpher-node-address elpher-current-node))
+ (let* ((display-string (elpher-page-display-string elpher-current-page))
+ (address (elpher-page-address elpher-current-page))
(tls-string (if (and (not (elpher-address-special-p address))
(member (elpher-address-protocol address)
'("gophers" "gemini")))
(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))
- '(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)
+ (ansi-color-context nil)) ;; clean ansi interpreter state
+ (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-buffer-name
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (if line
+ (forward-line line))
+ (let ((data (match-data)))
+ (unwind-protect
+ (progn
+ (re-search-forward "^.*$")
+ (replace-match string))
+ (set-match-data data))))))
;;; Text Processing
"Preprocess text selector response contained in STRING.
This involes decoding the character representation, and clearing
away CRs and any terminating period."
- (elpher-decode (replace-regexp-in-string "\n\.\n$" "\n"
+ (elpher-decode (replace-regexp-in-string "\n\\.\n$" "\n"
(replace-regexp-in-string "\r" "" string))))
+;;; Buttonify urls
+
+(defconst elpher-url-regex
+ "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.-]*[a-zA-Z0-9-]\\|\\[[a-zA-Z0-9:]+\\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z_~?/@|:.%#=&-]*[0-9a-zA-Z_~?/@|#-]\\)?\\)?"
+ "Regexp used to locate and buttonify URLs in text files loaded by elpher.")
+
+(defun elpher-buttonify-urls (string)
+ "Turn substrings which look like urls in STRING into clickable buttons."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward elpher-url-regex nil t)
+ (let ((page (elpher-make-page (substring-no-properties (match-string 0))
+ (elpher-address-from-url (match-string 0)))))
+ (make-text-button (match-beginning 0)
+ (match-end 0)
+ 'elpher-page page
+ 'action #'elpher-click-link
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help
+ 'face 'button)))
+ (buffer-string)))
+
+;;; ANSI colors or XTerm colors (application and filtering)
+
+(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.")
+
+;;; Processing text for display
+
+(defun elpher-process-text-for-display (string)
+ "Perform any desired processing of STRING prior to display as text.
+Currently includes buttonifying URLs and processing ANSI escape codes."
+ (elpher-buttonify-urls (if elpher-filter-ansi-from-text
+ (elpher-color-filter-apply string)
+ (elpher-color-apply string))))
+
;;; Network error reporting
;;
"Press 'u' to return to the previous page.")))
-;;; Gopher selector retrieval
+;;; General network communication
;;
(defvar elpher-network-timer nil
"Timer used for network connections.")
+(defvar elpher-use-tls nil
+ "If non-nil, use TLS to communicate with gopher servers.")
+
+(defvar elpher-client-certificate nil
+ "If non-nil, contains client certificate details to use for TLS connections.")
+
(defun elpher-process-cleanup ()
"Immediately shut down any extant elpher process and timers."
(let ((p (get-process "elpher-process")))
(if (timerp elpher-network-timer)
(cancel-timer elpher-network-timer)))
-(defvar elpher-use-tls nil
- "If non-nil, use TLS to communicate with gopher servers.")
+(defun elpher-make-network-timer (thunk)
+ "Creates a timer to run the THUNK after `elpher-connection-timeout' seconds.
+This is just a wraper around `run-at-time' which additionally sets the
+buffer-local variable `elpher-network-timer' to allow
+`elpher-process-cleanup' to also clear the timer."
+ (let ((timer (run-at-time elpher-connection-timeout nil thunk)))
+ (setq-local elpher-network-timer timer)
+ timer))
+
+(defun elpher-get-host-response (address default-port query-string response-processor
+ &optional use-tls force-ipv4)
+ "Generic function for retrieving data from ADDRESS.
+
+When ADDRESS lacks a specific port, DEFAULT-PORT is used instead.
+QUERY-STRING is a string sent to the host specified by ADDRESS to
+illicet a response. This response is passed as an argument to the
+function RESPONSE-PROCESSOR.
+
+If non-nil, USE-TLS specifies that the connection is to be made over
+TLS. If set to gemini, the certificate verification will be disabled
+unless `elpher-gemini-TLS-cert-checks' is non-nil.
+
+If non-nil, FORCE-IPV4 causes the network connection to be made over
+ipv4 only. (The default behaviour when this is not set depends on
+the host operating system and the local network capabilities.)"
+ (if (and use-tls (not (gnutls-available-p)))
+ (error "Use of TLS requires Emacs to be compiled with GNU TLS support")
+ (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 gnutls-verify-error nil))
+ (condition-case nil
+ (let* ((kill-buffer-query-functions nil)
+ (port (elpher-address-port address))
+ (host (elpher-address-host address))
+ (service (if (> port 0) port default-port))
+ (response-string-parts nil)
+ (bytes-received 0)
+ (hkbytes-received 0)
+ (socks (or elpher-socks-always (string-suffix-p ".onion" host)))
+ (gnutls-params (list :type 'gnutls-x509pki
+ :hostname host
+ :keylist
+ (elpher-get-current-keylist address)))
+ (timer (elpher-make-network-timer
+ (lambda ()
+ (elpher-process-cleanup)
+ (cond
+ ; Try again with IPv4
+ ((not (or force-ipv4 socks))
+ (message "Connection timed out. Retrying with IPv4.")
+ (elpher-get-host-response address default-port
+ query-string
+ response-processor
+ use-tls t))
+ ((and use-tls
+ (not (eq use-tls 'gemini))
+ (or elpher-auto-disengage-TLS
+ (y-or-n-p
+ "TLS connetion failed. Disable TLS mode and retry? ")))
+ (setq elpher-use-tls nil)
+ (elpher-get-host-response address default-port
+ query-string
+ response-processor
+ nil force-ipv4))
+ (t
+ (elpher-network-error address "Connection time-out."))))))
+ (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)
+ (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
+ (cancel-timer timer)
+ (setq timer nil))
+ (setq bytes-received (+ bytes-received (length string)))
+ (let ((new-hkbytes-received (/ bytes-received 102400)))
+ (when (> new-hkbytes-received hkbytes-received)
+ (setq hkbytes-received new-hkbytes-received)
+ (elpher-buffer-message
+ (concat "("
+ (number-to-string (/ hkbytes-received 10.0))
+ " MB read)")
+ 1)))
+ (setq response-string-parts
+ (cons string response-string-parts))))
+ (set-process-sentinel proc
+ (lambda (proc event)
+ (when timer
+ (cancel-timer timer))
+ (condition-case the-error
+ (cond
+ ((string-prefix-p "open" event) ; request URL
+ (elpher-buffer-message
+ (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 socks)))
+ ; Try again with IPv4
+ (message "Connection failed. Retrying with IPv4.")
+ (elpher-get-host-response address default-port
+ query-string
+ response-processor
+ use-tls t))
+ (response-string-parts
+ (elpher-with-clean-buffer
+ (insert "Data received. Rendering..."))
+ (funcall response-processor
+ (apply #'concat (reverse response-string-parts)))
+ (elpher-restore-pos))
+ (t
+ (error "No response from server")))
+ (error
+ (elpher-network-error address the-error)))))
+ (when socks
+ (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
+ (funcall (process-sentinel proc) proc "open\n")))
+ (error
+ (elpher-process-cleanup)
+ (error "Error initiating connection to server")))))
+
-(defun elpher-get-selector (address renderer &optional force-ipv4)
- "Retrieve selector specified by ADDRESS, then render it using RENDERER.
-If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
-to ADDRESS."
- (when (equal (elpher-address-protocol address) "gophers")
- (if (gnutls-available-p)
- (when (not elpher-use-tls)
- (setq elpher-use-tls t)
- (message "Engaging TLS gopher mode."))
- (error "Cannot retrieve TLS gopher selector: GnuTLS not available")))
- (unless (< (elpher-address-port address) 65536)
- (error "Cannot retrieve gopher selector: port number > 65536"))
- (condition-case nil
- (let* ((kill-buffer-query-functions nil)
- (port (elpher-address-port address))
- (host (elpher-address-host address))
- (selector-string "")
- (proc (open-network-stream "elpher-process"
- nil
- (if force-ipv4 (dns-query host) host)
- (if (> port 0) port 70)
- :type (if elpher-use-tls 'tls 'plain)
- :nowait t))
- (timer (run-at-time elpher-connection-timeout
- nil
- (lambda ()
- (pcase (process-status proc)
- ('failed
- (if (and (not (equal (elpher-address-protocol address)
- "gophers"))
- elpher-use-tls
- (or elpher-auto-disengage-TLS
- (yes-or-no-p "Could not establish encrypted connection. Disable TLS mode?")))
- (progn
- (message "Disabling TLS mode.")
- (setq elpher-use-tls nil)
- (elpher-get-selector address renderer))
- (elpher-network-error address "Could not establish encrypted connection")))
- ('connect
- (elpher-process-cleanup)
- (unless force-ipv4
- (message "Connection timed out. Retrying with IPv4 address.")
- (elpher-get-selector address renderer t))))))))
- (setq elpher-network-timer timer)
- (set-process-coding-system proc 'binary)
- (set-process-filter proc
- (lambda (_proc string)
- (cancel-timer timer)
- (setq selector-string
- (concat selector-string string))))
- (set-process-sentinel proc
- (lambda (_proc event)
- (condition-case the-error
- (cond
- ((string-prefix-p "deleted" event))
- ((string-prefix-p "open" event)
- (let ((inhibit-eol-conversion t))
- (process-send-string
- proc
- (concat (elpher-gopher-address-selector address)
- "\r\n"))))
- (t
- (cancel-timer timer)
- (funcall renderer selector-string)
- (elpher-restore-pos)))
- (error
- (elpher-network-error address the-error))))))
- (error
- (error "Error initiating connection to server"))))
-
-(defun elpher-get-gopher-node (renderer)
- "Getter function for gopher nodes.
-The RENDERER procedure is used to display the contents of the node
+;;; 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)))
+ (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-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 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))
+ nil
+ (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$")))
+
+(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))
+ (elpher-forget-current-certificate)
+ (message "Disabling client certificate for new host")
+ nil)
+ nil))
+
+
+;;; Gopher selector retrieval
+;;
+
+(defun elpher-get-gopher-response (address renderer)
+ "Get response string from gopher server at ADDRESS and render using RENDERER."
+ (elpher-get-host-response address 70
+ (concat (elpher-gopher-address-selector address) "\r\n")
+ renderer
+ (or (string= (elpher-address-protocol address) "gophers")
+ elpher-use-tls)))
+
+(defun elpher-get-gopher-page (renderer)
+ "Getter function for gopher pages.
+The RENDERER procedure is used to display the contents of the page
once they are retrieved from the gopher server."
- (let* ((address (elpher-node-address elpher-current-node))
+ (let* ((address (elpher-page-address elpher-current-page))
(content (elpher-get-cached-content address)))
(if (and content (funcall renderer nil))
(elpher-with-clean-buffer
(insert content)
(elpher-restore-pos))
(elpher-with-clean-buffer
- (insert "LOADING... (use 'u' to cancel)"))
+ (insert "LOADING... (use 'u' to cancel)\n"))
(condition-case the-error
- (elpher-get-selector address renderer)
+ (elpher-get-gopher-response address renderer)
(error
(elpher-network-error address the-error))))))
(insert " "))
(insert (make-string elpher-margin-width ?\s))))
-(defun elpher-node-button-help (node)
- "Return a string containing the help text for a button corresponding to NODE."
- (let ((address (elpher-node-address node)))
- (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
- address
- (elpher-address-to-url address)))))
+(defun elpher--page-button-help (_window buffer pos)
+ "Function called by Emacs to generate mouse-over text.
+The arguments specify the BUFFER and the POS within the buffer of the item
+for which help is required. The function returns the help to be
+displayed. The _WINDOW argument is currently unused."
+ (with-current-buffer buffer
+ (let ((button (button-at pos)))
+ (when button
+ (let* ((page (button-get button 'elpher-page))
+ (address (elpher-page-address page)))
+ (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
+ address
+ (elpher-address-to-url address))))))))
(defun elpher-insert-index-record (display-string &optional address)
"Function to insert an index record into the current buffer.
(if type-map-entry
(let* ((margin-code (elt type-map-entry 2))
(face (elt type-map-entry 3))
- (node (elpher-make-node display-string address)))
+ (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 display-string
+ (insert-text-button filtered-display-string
'face face
- 'elpher-node node
+ 'elpher-page page
'action #'elpher-click-link
'follow-link t
- 'help-echo (elpher-node-button-help node)))
+ 'help-echo #'elpher--page-button-help))
(pcase type
- ((or '(gopher ?i) 'nil) ;; Information
+ ('nil ;; Information
(elpher-insert-margin)
(let ((propertized-display-string
(propertize display-string 'face 'elpher-info)))
- (insert (if elpher-buttonify-urls-in-directories
- (elpher-buttonify-urls propertized-display-string)
- propertized-display-string))))
+ (insert (elpher-process-text-for-display propertized-display-string))))
(`(gopher ,selector-type) ;; Unknown
(elpher-insert-margin (concat (char-to-string selector-type) "?"))
(insert (propertize display-string
(defun elpher-click-link (button)
"Function called when the gopher link BUTTON is activated (via mouse or keypress)."
- (let ((node (button-get button 'elpher-node)))
- (elpher-visit-node node)))
+ (let ((page (button-get button 'elpher-page)))
+ (elpher-visit-page page)))
(defun elpher-render-index (data &optional _mime-type-string)
"Render DATA as an index. MIME-TYPE-STRING is unused."
(if (not data)
t
(elpher-insert-index data)
- (elpher-cache-content (elpher-node-address elpher-current-node)
+ (elpher-cache-content (elpher-page-address elpher-current-page)
(buffer-string)))))
;; Text rendering
-(defconst elpher-url-regex
- "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]*[a-zA-Z0-9\-]\\|\[[a-zA-Z0-9:]+\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z\-_~?/@|:.%#]*[0-9a-zA-Z\-_~?/@|#]\\)?\\)?"
- "Regexp used to locate and buttniofy URLs in text files loaded by elpher.")
-
-(defun elpher-buttonify-urls (string)
- "Turn substrings which look like urls in STRING into clickable buttons."
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (while (re-search-forward elpher-url-regex nil t)
- (let ((node (elpher-make-node (substring-no-properties (match-string 0))
- (elpher-address-from-url (match-string 0)))))
- (make-text-button (match-beginning 0)
- (match-end 0)
- 'elpher-node node
- 'action #'elpher-click-link
- 'follow-link t
- 'help-echo (elpher-node-button-help node)
- 'face 'button)))
- (buffer-string)))
-
(defun elpher-render-text (data &optional _mime-type-string)
"Render DATA as text. MIME-TYPE-STRING is unused."
(elpher-with-clean-buffer
(if (not data)
t
- (insert (elpher-buttonify-urls (elpher-preprocess-text-response data)))
+ (insert (elpher-process-text-for-display (elpher-preprocess-text-response data)))
(elpher-cache-content
- (elpher-node-address elpher-current-node)
+ (elpher-page-address elpher-current-page)
(buffer-string)))))
;; Image retrieval
;; Search retrieval and rendering
-(defun elpher-get-gopher-query-node (renderer)
+(defun elpher-get-gopher-query-page (renderer)
"Getter for gopher addresses requiring input.
The response is rendered using the rendering function RENDERER."
- (let* ((address (elpher-node-address elpher-current-node))
- (content (elpher-get-cached-content address))
- (aborted t))
+ (let* ((address (elpher-page-address elpher-current-page))
+ (content (elpher-get-cached-content address))
+ (aborted t))
(if (and content (funcall renderer nil))
(elpher-with-clean-buffer
(insert content)
(elpher-with-clean-buffer
(insert "LOADING RESULTS... (use 'u' to cancel)"))
- (elpher-get-selector search-address renderer))
+ (elpher-get-gopher-response search-address renderer))
(if aborted
- (elpher-visit-parent-node))))))
-
+ (elpher-visit-previous-page))))))
+
;; Raw server response rendering
(defun elpher-render-raw (data &optional mime-type-string)
"Save DATA to file. MIME-TYPE-STRING is unused."
(if (not data)
nil
- (let* ((address (elpher-node-address elpher-current-node))
- (selector (elpher-gopher-address-selector address)))
- (elpher-visit-parent-node) ; Do first in case of non-local exits.
+ (let* ((address (elpher-page-address elpher-current-page))
+ (selector (if (elpher-address-gopher-p address)
+ (elpher-gopher-address-selector address)
+ (elpher-address-filename address))))
+ (elpher-visit-previous-page) ; Do first in case of non-local exits.
(let* ((filename-proposal (file-name-nondirectory selector))
(filename (read-file-name "Download complete. Save file as: "
nil nil nil
(libxml-parse-html-region (point-min) (point-max)))))
(shr-insert-document dom)))))
-;; Gemini node retrieval
+;; Gemini page retrieval
(defvar elpher-gemini-redirect-chain)
-(defun elpher-get-gemini-response (address renderer &optional force-ipv4)
- "Retrieve gemini ADDRESS, then render using RENDERER.
-If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
-to ADDRESS."
- (if (not (gnutls-available-p))
- (error "Cannot establish gemini connection: GnuTLS not available")
- (unless (< (elpher-address-port address) 65536)
- (error "Cannot establish gemini connection: port number > 65536"))
- (condition-case nil
- (let* ((kill-buffer-query-functions nil)
- (port (elpher-address-port address))
- (host (elpher-address-host address))
- (response-string "")
- (proc (open-network-stream "elpher-process"
- nil
- (if force-ipv4 (dns-query host) host)
- (if (> port 0) port 1965)
- :type 'tls
- :nowait t))
- (timer (run-at-time elpher-connection-timeout nil
- (lambda ()
- (elpher-process-cleanup)
- (unless force-ipv4
- ; Try again with IPv4
- (message "Connection timed out. Retrying with IPv4.")
- (elpher-get-gemini-response address renderer t))))))
- (setq elpher-network-timer timer)
- (set-process-coding-system proc 'binary)
- (set-process-filter proc
- (lambda (_proc string)
- (cancel-timer timer)
- (setq response-string
- (concat response-string string))))
- (set-process-sentinel proc
- (lambda (proc event)
- (condition-case the-error
- (cond
- ((string-prefix-p "open" event) ; request URL
- (let ((inhibit-eol-conversion t))
- (process-send-string
- proc
- (concat (elpher-address-to-url address)
- "\r\n"))))
- ((string-prefix-p "deleted" event)) ; do nothing
- ((and (string-empty-p response-string)
- (not force-ipv4))
- ; Try again with IPv4
- (message "Connection failed. Retrying with IPv4.")
- (cancel-timer timer)
- (elpher-get-gemini-response address renderer t))
- (t
- (funcall #'elpher-process-gemini-response
- response-string
- renderer)
- (elpher-restore-pos)))
- (error
- (elpher-network-error address the-error))))))
- (error
- (error "Error initiating connection to server")))))
+(defun elpher-get-gemini-response (address renderer)
+ "Get response string from gemini server at ADDRESS and render using RENDERER."
+ (elpher-get-host-response address 1965
+ (concat (elpher-address-to-url address) "\r\n")
+ (lambda (response-string)
+ (elpher-process-gemini-response response-string renderer))
+ 'gemini))
(defun elpher-parse-gemini-response (response)
"Parse the RESPONSE string and return a list of components.
(meta (string-trim (substring header 2))))
(list code meta body))
(error "Malformed response: No response status found in header %s" header)))
- (error "Malformed response: No CRLF-delimited header found"))))
+ (error "Malformed response: No CRLF-delimited header found in response %s" response))))
(defun elpher-process-gemini-response (response-string renderer)
"Process the gemini response RESPONSE-STRING and pass the result to RENDERER."
(?1 ; Input required
(elpher-with-clean-buffer
(insert "Gemini server is requesting input."))
- (let* ((query-string (read-string (concat response-meta ": ")))
- (url (elpher-address-to-url (elpher-node-address elpher-current-node)))
- (query-address (elpher-address-from-url (concat url "?" query-string))))
+ (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)
+ (concat old-fname "?" (url-build-query-string `((,query-string)))))
(elpher-get-gemini-response query-address renderer)))
(?2 ; Normal response
(funcall renderer response-body response-meta))
"gemini"))
(error "Server tried to automatically redirect to non-gemini URL: %s"
response-meta))
+ (elpher-page-set-address elpher-current-page redirect-address)
(add-to-list 'elpher-gemini-redirect-chain redirect-address)
(elpher-get-gemini-response redirect-address renderer)))
(?4 ; Temporary failure
(error "Gemini server reports PERMANENT FAILURE for this request: %s %s"
response-code response-meta))
(?6 ; Client certificate required
- (error "Gemini server requires client certificate (unsupported at this time)"))
+ (elpher-with-clean-buffer
+ (if elpher-client-certificate
+ (insert "Gemini server does not recognise the provided TLS certificate:\n\n")
+ (insert "Gemini server is requesting a valid TLS certificate:\n\n"))
+ (auto-fill-mode 1)
+ (elpher-gemini-insert-text response-meta))
+ (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-get-gemini-node (renderer)
- "Getter which retrieves and renders a Gemini node and renders it using RENDERER."
- (let* ((address (elpher-node-address elpher-current-node))
+(defun elpher--read-answer-polyfill (question answers)
+ "Polyfill for `read-answer' in Emacs 26.1.
+QUESTION is a string containing a question, and ANSWERS
+is a list of possible answers."
+ (completing-read question (mapcar 'identity answers)))
+
+(if (fboundp 'read-answer)
+ (defalias 'elpher-read-answer 'read-answer)
+ (defalias 'elpher-read-answer 'elpher--read-answer-polyfill))
+
+(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))
(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))
+ (insert content)
+ (elpher-restore-pos))
(elpher-with-clean-buffer
- (insert "LOADING GEMINI... (use 'u' to cancel)"))
+ (insert "LOADING GEMINI... (use 'u' to cancel)\n"))
(setq elpher-gemini-redirect-chain nil)
(elpher-get-gemini-response address renderer))
(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)
((pred (string-prefix-p "image/"))
(elpher-render-image body))
(_other
- (error "Unsupported MIME type %S" mime-type))))))
-
-(defun elpher-gemini-get-link-url (line)
- "Extract the url portion of LINE, a gemini map file link line."
- (string-trim (elt (split-string (substring line 2)) 0)))
-
-(defun elpher-gemini-get-link-display-string (line)
- "Extract the display string portion of LINE, a gemini map file link line."
- (let* ((rest (string-trim (elt (split-string line "=>") 1)))
+ (elpher-render-download body))))))
+
+(defun elpher-gemini-get-link-url (link-line)
+ "Extract the url portion of LINK-LINE, a gemini map file link line.
+Returns nil in the event that the contents of the line following the
+=> prefix are empty."
+ (let ((l (split-string (substring link-line 2))))
+ (if l
+ (string-trim (elt l 0))
+ nil)))
+
+(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)))
(idx (string-match "[ \t]" rest)))
- (if idx
- (string-trim (substring rest (+ idx 1)))
- "")))
+ (string-trim (if idx
+ (substring rest (+ idx 1))
+ rest))))
(defun elpher-collapse-dot-sequences (filename)
"Collapse dot sequences in FILENAME.
(string-join (reverse path-reversed-normalized) "/")))
(defun elpher-address-from-gemini-url (url)
- "Extract address from URL with defaults as per gemini map files."
- (let ((address (url-generic-parse-url url)))
+ "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
(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 (elpher-node-address elpher-current-node)))
+ (setf (url-host address) (url-host current-address))
+ (setf (url-port address) (url-port current-address))
(unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
(setf (url-filename address)
- (concat (file-name-directory
- (url-filename (elpher-node-address elpher-current-node)))
+ (concat (file-name-directory (url-filename current-address))
(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."
+ (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* ((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
+ '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.")
+
+(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)))
+ (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 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* ((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 t)
+ ;; fill-prefix is important for adaptive-fill-mode: without
+ ;; it, multi-line list items are not indented correct
+ (fill-prefix (if (match-string 2 text-line)
+ (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line))
+ 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
- (dolist (line (split-string data "\n"))
- (if (string-prefix-p "=>" line)
- (let* ((url (elpher-gemini-get-link-url line))
- (display-string (elpher-gemini-get-link-display-string line))
- (address (elpher-address-from-gemini-url url)))
- (if (> (length display-string) 0)
- (elpher-insert-index-record display-string address)
- (elpher-insert-index-record url address)))
- (elpher-insert-index-record line)))
+ (setq elpher--gemini-page-headings nil)
+ (let ((preformatted nil))
+ (auto-fill-mode 1)
+ (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))
(elpher-cache-content
- (elpher-node-address elpher-current-node)
+ (elpher-page-address elpher-current-page)
(buffer-string))))
(defun elpher-render-gemini-plain-text (data _parameters)
"Render DATA as plain text file. PARAMETERS is currently unused."
(elpher-with-clean-buffer
- (insert (elpher-buttonify-urls data))
+ (insert (elpher-process-text-for-display data))
(elpher-cache-content
- (elpher-node-address elpher-current-node)
+ (elpher-page-address elpher-current-page)
(buffer-string))))
-;; Other URL node opening
-(defun elpher-get-other-url-node (renderer)
- "Getter which attempts to open the URL specified by the current node (RENDERER must be nil)."
- (when renderer
- (elpher-visit-parent-node)
- (error "Command not supported for general URLs"))
- (let* ((address (elpher-node-address elpher-current-node))
- (url (elpher-address-to-url address)))
- (progn
- (elpher-visit-parent-node) ; Do first in case of non-local exits.
- (message "Opening URL...")
- (if elpher-open-urls-with-eww
- (browse-web url)
- (browse-url url)))))
+;; Finger page connection
+
+(defun elpher-get-finger-page (renderer)
+ "Opens a finger connection to the current page address.
+The result is rendered using RENDERER."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (content (elpher-get-cached-content address)))
+ (if (and content (funcall renderer nil))
+ (elpher-with-clean-buffer
+ (insert content)
+ (elpher-restore-pos))
+ (elpher-with-clean-buffer
+ (insert "LOADING... (use 'u' to cancel)\n"))
+ (condition-case the-error
+ (let* ((kill-buffer-query-functions nil)
+ (user (let ((filename (elpher-address-filename address)))
+ (if (> (length filename) 1)
+ (substring filename 1)
+ (elpher-address-user address)))))
+ (elpher-get-host-response address 79
+ (concat user "\r\n")
+ renderer))
+ (error
+ (elpher-network-error address the-error))))))
-;; Telnet node connection
-(defun elpher-get-telnet-node (renderer)
- "Opens a telnet connection to the current node address (RENDERER must be nil)."
+;; 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-parent-node)
+ (elpher-visit-previous-page)
(error "Command not supported for telnet URLs"))
- (let* ((address (elpher-node-address elpher-current-node))
+ (let* ((address (elpher-page-address elpher-current-page))
(host (elpher-address-host address))
(port (elpher-address-port address)))
- (elpher-visit-parent-node)
+ (elpher-visit-previous-page)
(if (> port 0)
(telnet host port)
(telnet host))))
-;; Start page node retrieval
-(defun elpher-get-start-node (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)."
+ (when renderer
+ (elpher-visit-previous-page)
+ (error "Command not supported for general URLs"))
+ (let* ((address (elpher-page-address elpher-current-page))
+ (url (elpher-address-to-url address)))
+ (progn
+ (elpher-visit-previous-page) ; Do first in case of non-local exits.
+ (message "Opening URL...")
+ (if elpher-open-urls-with-eww
+ (browse-web url)
+ (browse-url url)))))
+
+
+;; Start page retrieval
+
+(defun elpher-get-start-page (renderer)
"Getter which displays the start page (RENDERER must be nil)."
(when renderer
- (elpher-visit-parent-node)
+ (elpher-visit-previous-page)
(error "Command not supported for start page"))
(elpher-with-clean-buffer
(insert " --------------------------------------------\n"
- " Elpher Gopher Client \n"
+ " Elpher Gopher and Gemini Client \n"
" version " elpher-version "\n"
" --------------------------------------------\n"
"\n"
" - TAB/Shift-TAB: next/prev item on current page\n"
" - RET/mouse-1: open item under cursor\n"
" - m: select an item on current page by name (autocompletes)\n"
- " - u/mouse-3: return to previous page\n"
- " - o/O: visit different selector or the root menu of the current server\n"
- " - g: go to a particular gopher address\n"
+ " - u/mouse-3/U: return to previous page or to the start page\n"
+ " - g: go to a particular address (gopher, gemini, finger)\n"
+ " - o/O: open a different address selector or the root menu of the current server\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"
" - a/A: bookmark the item under cursor or current page\n"
- " - x/X: remove bookmark for item under cursor or current page\n"
- " - B: visit the bookmarks page\n"
+ " - B: list all bookmarks\n"
+ " - s/S: show current history stack or all previously visted pages\n"
" - r: redraw current page (using cached contents if available)\n"
" - R: reload current page (regenerates cache)\n"
- " - S: set character coding system for gopher (default is to autodetect)\n"
+ " - !: 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:\n")
+ "Start your exploration of gopher space and gemini:\n")
(elpher-insert-index-record "Floodgap Systems Gopher Server"
(elpher-make-gopher-address ?1 "" "gopher.floodgap.com" 70))
+ (elpher-insert-index-record "Project Gemini home page"
+ (elpher-address-from-url "gemini://gemini.circumlunar.space/"))
(insert "\n"
- "Alternatively, select the following item and enter some search terms:\n")
- (elpher-insert-index-record "Veronica-2 Gopher Search Engine"
+ "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 (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)
+ "Your bookmarks are stored in your ")
+ (let ((help-string "RET,mouse-1: Open bookmark list"))
+ (insert-text-button "Emacs bookmark list"
+ 'face 'link
+ 'action (lambda (_)
+ (interactive)
+ (call-interactively #'elpher-show-bookmarks))
+ 'follow-link t
+ 'help-echo help-string))
+ (insert ".\n")
+ (insert (propertize
+ "(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n"
+ 'face 'shadow))
(insert "\n"
- "For Elpher release news or to leave feedback, visit:\n")
+ "The gopher home of the Elpher project is here:\n")
(elpher-insert-index-record "The Elpher Project Page"
(elpher-make-gopher-address ?1
"/projects/elpher/"
"thelambdalab.xyz"
70))
- (insert "\n"
- "** Refer to the ")
(let ((help-string "RET,mouse-1: Open Elpher info manual (if available)"))
- (insert-text-button "Elpher info manual"
+ (insert "\n"
+ "The following info documentation is available:\n"
+ " - ")
+ (insert-text-button "Elpher Manual"
'face 'link
'action (lambda (_)
(interactive)
(info "(elpher)"))
'follow-link t
- 'help-echo help-string))
- (insert " for the full documentation. **\n")
+ 'help-echo help-string)
+ (insert "\n - ")
+ (insert-text-button "Changes introduced by the latest release"
+ 'face 'link
+ 'action (lambda (_)
+ (interactive)
+ (info "(elpher)News"))
+ 'follow-link t
+ 'help-echo help-string))
+ (insert "\n")
(insert (propertize
- (concat " (This should be available if you have installed Elpher using\n"
- " MELPA. Otherwise you will have to install the manual yourself.)\n")
+ (concat " (These documents should be available if you have installed Elpher \n"
+ " using MELPA. Otherwise you may have to install the manual yourself.)\n")
'face 'shadow))
(elpher-restore-pos)))
-;; Bookmarks page node retrieval
+;; History page retrieval
-(defun elpher-get-bookmarks-node (renderer)
- "Getter to load and display the current bookmark list (RENDERER must be nil)."
+(defun elpher-show-history ()
+ "Show the current contents of elpher's history stack.
+Use \\[elpher-show-visited-pages] to see the entire history.
+This is rendered using `elpher-get-history-page' via `elpher-type-map'."
+ (interactive)
+ (elpher-visit-page
+ (elpher-make-page "Current History Stack"
+ (elpher-make-special-address 'history))))
+
+(defun elpher-show-visited-pages ()
+ "Show the all the pages you've visited using Elpher.
+Use \\[elpher-show-history] to see just the current history stack.
+This is rendered using `elpher-get-visited-pages-page' via `elpher-type-map'."
+ (interactive)
+ (elpher-visit-page
+ (elpher-make-page "Elpher Visted Pages"
+ (elpher-make-special-address 'visited-pages))))
+
+(defun elpher-get-history-page (renderer)
+ "Getter which displays the history page (RENDERER must be nil)."
+ (when renderer
+ (elpher-visit-previous-page)
+ (error "Command not supported for history page"))
+ (elpher-display-history-links elpher-history "Current history stack"))
+
+(defun elpher-get-visited-pages-page (renderer)
+ "Getter which displays the list of visited pages (RENDERER must be nil)."
(when renderer
- (elpher-visit-parent-node)
+ (elpher-visit-previous-page)
+ (error "Command not supported for history page"))
+ (elpher-display-history-links
+ (seq-filter (lambda (page)
+ (not (elpher-address-special-p (elpher-page-address page))))
+ elpher-visited-pages)
+ "All visited pages"))
+
+(defun elpher-display-history-links (pages title)
+ "Show all PAGES in an Elpher buffer with a given TITLE."
+ (let* ((title-line (concat "---- " title " ----"))
+ (footer-line (make-string (length title-line) ?-)))
+ (elpher-with-clean-buffer
+ (insert title-line "\n\n")
+ (if pages
+ (dolist (page pages)
+ (when page
+ (let ((display-string (elpher-page-display-string page))
+ (address (elpher-page-address page)))
+ (elpher-insert-index-record display-string address))))
+ (insert "No history items found.\n"))
+ (insert "\n" footer-line "\n"
+ "Select an entry or press 'u' to return to the previous page.")
+ (elpher-restore-pos))))
+
+
+;;; Bookmarks
+
+;; This code allows Elpher to use the standard Emacs bookmarks: `C-x r
+;; m' to add a bookmark, `C-x r l' to list bookmarks (which is where
+;; you can anotate bookmarks!), `C-x r b' to jump to a bookmark, and
+;; so on. See the Bookmarks section in the Emacs info manual for more.
+
+(defvar elpher-bookmark-link nil
+ "Prefer bookmarking a link or the current page.
+Bind this variable dynamically, or set it to t.
+If you set it to t, the commands \\[bookmark-set-no-overwrite]
+and \\[elpher-set-bookmark-no-overwrite] do the same thing.")
+
+(defun elpher-bookmark-make-record ()
+ "Return a bookmark record.
+If `elpher-bookmark-link' is non-nil and point is on a link button,
+return a bookmark record for that link. Otherwise, return a bookmark
+record for the current elpher page."
+ (let* ((button (and elpher-bookmark-link (button-at (point))))
+ (page (if button
+ (button-get button 'elpher-page)
+ elpher-current-page))
+ (address (elpher-page-address page))
+ (url (elpher-address-to-url address))
+ (display-string (elpher-page-display-string page))
+ (pos (if button nil (point))))
+ (if (elpher-address-special-p address)
+ (error "Cannot bookmark %s" display-string)
+ `(,display-string
+ (defaults . (,display-string))
+ (position . ,pos)
+ (location . ,url)
+ (handler . elpher-bookmark-jump)))))
+
+;;;###autoload
+(defun elpher-bookmark-jump (bookmark)
+ "Handler used to open a bookmark using elpher.
+The argument BOOKMARK is a bookmark record passed to the function.
+This handler is responsible for loading the bookmark in some buffer,
+then making that buffer the current buffer. It should not switch
+to the buffer."
+ (let* ((url (cdr (assq 'location bookmark)))
+ (cleaned-url (string-trim url))
+ (address (elpher-address-from-url cleaned-url))
+ (page (elpher-make-page cleaned-url address)))
+ (elpher-with-clean-buffer
+ (elpher-visit-page page))
+ (set-buffer (get-buffer elpher-buffer-name))
+ nil))
+
+(defun elpher-bookmark-link ()
+ "Bookmark the link at point.
+To bookmark the current page, use \\[elpher-bookmark-current]."
+ (interactive)
+ (let ((elpher-bookmark-link t))
+ (bookmark-set-no-overwrite)))
+
+(defun elpher-bookmark-current ()
+ "Bookmark the current page.
+To bookmark the link at point use \\[elpher-bookmark-link]."
+ (interactive)
+ (call-interactively #'bookmark-set-no-overwrite))
+
+(defun elpher-bookmark-import (file)
+ "Import legacy Elpher bookmarks file FILE into Emacs bookmarks."
+ (interactive (list (if (and (boundp 'elpher-bookmarks-file)
+ (file-readable-p elpher-bookmarks-file))
+ elpher-bookmarks-file
+ (read-file-name "Old Elpher bookmarks: "
+ user-emacs-directory nil t
+ "elpher-bookmarks"))))
+ (require 'bookmark)
+ (dolist (bookmark (with-temp-buffer
+ (insert-file-contents file)
+ (read (current-buffer))))
+ (let* ((display-string (car bookmark))
+ (url (cadr bookmark))
+ (record `(,display-string
+ (location . ,url)
+ (handler . elpher-bookmark-jump))))
+ (bookmark-store display-string (cdr record) t)))
+ (bookmark-save))
+
+(defun elpher-get-bookmarks-page (renderer)
+ "Getter which displays the history page (RENDERER must be nil)."
+ (when renderer
+ (elpher-visit-previous-page)
(error "Command not supported for bookmarks page"))
(elpher-with-clean-buffer
- (insert "---- Bookmark list ----\n\n")
- (let ((bookmarks (elpher-load-bookmarks)))
+ (insert " ---- Elpher Bookmarks ---- \n\n")
+ (bookmark-maybe-load-default-file)
+ (let ((bookmarks (bookmark-maybe-sort-alist)))
(if bookmarks
(dolist (bookmark bookmarks)
- (let ((display-string (elpher-bookmark-display-string bookmark))
- (address (elpher-address-from-url (elpher-bookmark-url bookmark))))
- (elpher-insert-index-record display-string address)))
- (insert "No bookmarks found.\n")))
- (insert "\n-----------------------\n"
- "\n"
- "- u: return to previous page\n"
- "- x: delete selected bookmark\n"
- "- a: rename selected bookmark\n"
- "\n"
- "Bookmarks are stored in the file ")
- (let ((filename (locate-user-emacs-file "elpher-bookmarks"))
- (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
- (insert-text-button filename
- 'face 'link
- 'action (lambda (_)
- (interactive)
- (find-file filename))
- 'follow-link t
- 'help-echo help-string))
- (insert "\n")
+ (let* ((name (car bookmark))
+ (url (alist-get 'location (cdr bookmark)))
+ (address (elpher-address-from-url url)))
+ (elpher-insert-index-record name address)))
+ (insert "No bookmarked pages found.\n")))
+ (insert "\n --------------------------\n\n"
+ "Select an entry or press 'u' to return to the previous page.\n\n"
+ "Bookmarks can be renamed or deleted via the ")
+ (insert-text-button "Emacs bookmark menu"
+ 'action (lambda (_)
+ (interactive)
+ (call-interactively #'bookmark-bmenu-list))
+ 'follow-link t
+ 'help-echo "RET,mouse-1: open Emacs bookmark menu")
+ (insert (substitute-command-keys
+ ",\nwhich can also be openned from anywhere using '\\[bookmark-bmenu-list]'."))
(elpher-restore-pos)))
-
-;;; Bookmarks
+(defun elpher-show-bookmarks ()
+ "Display the current list of elpher bookmarks.
+This will also check for a legacy bookmark file and offer to import it."
+ (interactive)
+ (let ((old-bookmarks-file (or (and (boundp 'elpher-bookmarks-file)
+ elpher-bookmarks-file)
+ (locate-user-emacs-file "elpher-bookmarks"))))
+ (when (and (file-readable-p old-bookmarks-file)
+ (y-or-n-p (concat "Legacy elpher-bookmarks file \""
+ old-bookmarks-file
+ "\" found. Import now?")))
+ (elpher-bookmark-import old-bookmarks-file)
+ (rename-file old-bookmarks-file (concat old-bookmarks-file "-legacy"))))
+ (if elpher-use-emacs-bookmark-menu
+ (call-interactively #'bookmark-bmenu-list)
+ (elpher-visit-page
+ (elpher-make-page "Elpher Bookmarks"
+ (elpher-make-special-address 'bookmarks)))))
+
+
+;;; Integrations
;;
-(defun elpher-make-bookmark (display-string url)
- "Make an elpher bookmark.
-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-set-bookmark-display-string (bookmark display-string)
- "Set the display string of BOOKMARK to DISPLAY-STRING."
- (setcar bookmark display-string))
-
-(defun elpher-bookmark-url (bookmark)
- "Get the address for BOOKMARK."
- (elt bookmark 1))
-
-(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."
- (with-temp-file (locate-user-emacs-file "elpher-bookmarks")
- (erase-buffer)
- (insert "; Elpher bookmarks file\n\n"
- "; Bookmarks are stored as a list of (label URL) items.\n"
- "; Feel free to edit by hand, but take care to ensure\n"
- "; the list structure remains intact.\n\n")
- (pp bookmarks (current-buffer))))
-
-(defun elpher-load-bookmarks ()
- "Get the list of bookmarks from the users's bookmark file."
- (let ((bookmarks
- (with-temp-buffer
- (ignore-errors
- (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
- (goto-char (point-min))
- (read (current-buffer))))))
- (if (and bookmarks (listp (cadar bookmarks)))
- (progn
- (message "Reading old bookmark file. (Will be updated on write.)")
- (mapcar (lambda (old-bm)
- (list (car old-bm)
- (elpher-address-to-url (apply #'elpher-make-gopher-address
- (cadr old-bm)))))
- bookmarks))
- bookmarks)))
-
-(defun elpher-add-address-bookmark (address display-string)
- "Save a bookmark for ADDRESS with label DISPLAY-STRING.)))
-If ADDRESS is already bookmarked, update the label only."
- (let ((bookmarks (elpher-load-bookmarks))
- (url (elpher-address-to-url address)))
- (let ((existing-bookmark (rassoc (list url) bookmarks)))
- (if existing-bookmark
- (elpher-set-bookmark-display-string existing-bookmark display-string)
- (push (elpher-make-bookmark display-string url) bookmarks)))
- (elpher-save-bookmarks bookmarks)))
-
-(defun elpher-remove-address-bookmark (address)
- "Remove any bookmark to ADDRESS."
- (let ((url (elpher-address-to-url address)))
- (elpher-save-bookmarks
- (seq-filter (lambda (bookmark)
- (not (equal (elpher-bookmark-url bookmark) url)))
- (elpher-load-bookmarks)))))
+;;; Org
+
+(defun elpher-org-export-link (link description format protocol)
+ "Export a LINK with DESCRIPTION for the given PROTOCOL and FORMAT.
+
+FORMAT is an Org export backend. DESCRIPTION may be nil. PROTOCOL may be one
+of gemini, gopher or finger."
+ (let* ((url (if (equal protocol "elpher")
+ (string-remove-prefix "elpher:" link)
+ (format "%s:%s" protocol link)))
+ (desc (or description url)))
+ (pcase format
+ (`gemini (format "=> %s %s" url desc))
+ (`html (format "<a href=\"%s\">%s</a>" url desc))
+ (`latex (format "\\href{%s}{%s}" url desc))
+ (_ (if (not description)
+ url
+ (format "%s (%s)" desc url))))))
+
+(defun elpher-org-store-link ()
+ "Store link to an `elpher' page in Org."
+ (when (eq major-mode 'elpher-mode)
+ (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")
+ (t "elpher"))))
+ (when (equal "elpher" protocol)
+ ;; Weird link. Or special inner link?
+ (setq url (concat "elpher:" url)))
+ (org-link-store-props :type protocol :link url :description desc)
+ t)))
+
+(defun elpher-org-follow-link (link protocol)
+ "Visit a LINK for the given PROTOCOL.
+
+PROTOCOL may be one of gemini, gopher or finger. This method also
+supports the old protocol elpher, where the link is self-contained."
+ (let ((url (if (equal protocol "elpher")
+ (string-remove-prefix "elpher:" link)
+ (format "%s:%s" protocol link))))
+ (elpher-go url)))
+
+(defun elpher-org-mode-integration ()
+ "Set up `elpher' integration for `org-mode'."
+ (org-link-set-parameters
+ "elpher"
+ :store #'elpher-org-store-link
+ :export (lambda (link description format _plist)
+ (elpher-org-export-link link description format "elpher"))
+ :follow (lambda (link _arg) (elpher-org-follow-link link "elpher")))
+ (org-link-set-parameters
+ "gemini"
+ :export (lambda (link description format _plist)
+ (elpher-org-export-link link description format "gemini"))
+ :follow (lambda (link _arg) (elpher-org-follow-link link "gemini")))
+ (org-link-set-parameters
+ "gopher"
+ :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
+ "finger"
+ :export (lambda (link description format _plist)
+ (elpher-org-export-link link description format "finger"))
+ :follow (lambda (link _arg) (elpher-org-follow-link link "finger"))))
+
+(add-hook 'org-mode-hook #'elpher-org-mode-integration)
+
+;;; Browse URL
+
+;;;###autoload
+(defun elpher-browse-url-elpher (url &rest _args)
+ "Browse URL using Elpher. This function is used by `browse-url'."
+ (interactive (browse-url-interactive-arg "Elpher URL: "))
+ (elpher-go url))
+
+;; Use elpher to open gopher, finger and gemini links
+;; For recent version of `browse-url' package
+(if (boundp 'browse-url-default-handlers)
+ (add-to-list
+ 'browse-url-default-handlers
+ '("^\\(gopher\\|finger\\|gemini\\)://" . 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)))))
+
+;; Register "gemini://" as a URI scheme so `browse-url' does the right thing
+(with-eval-after-load 'thingatpt
+ (add-to-list 'thing-at-point-uri-schemes "gemini://"))
+
+;;; Mu4e:
+
+;; Make mu4e aware of the gemini world
+(setq mu4e~view-beginning-of-url-regexp
+ "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
;;; Interactive procedures
;;
(interactive)
(push-button))
-(defun elpher-go ()
- "Go to a particular gopher site read from the minibuffer."
- (interactive)
- (let ((node
- (let ((host-or-url (read-string "Gopher or Gemini URL: ")))
- (elpher-make-node host-or-url
- (elpher-address-from-url host-or-url)))))
- (switch-to-buffer "*elpher*")
- (elpher-visit-node node)))
+;;;###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-buffer-name)
+ (elpher-with-clean-buffer
+ (elpher-visit-page page))
+ nil))
(defun elpher-go-current ()
"Go to a particular site read from the minibuffer, initialized with the current URL."
(interactive)
- (let ((address (elpher-node-address elpher-current-node)))
- (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-node (elpher-make-node url (elpher-address-from-url url)))))))
+ (let ((address (elpher-page-address elpher-current-page)))
+ (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-redraw ()
"Redraw current page."
(interactive)
- (if elpher-current-node
- (elpher-visit-node elpher-current-node)
- (message "No current site.")))
+ (elpher-visit-page elpher-current-page))
(defun elpher-reload ()
"Reload current page."
(interactive)
- (if elpher-current-node
- (elpher-reload-current-node)
- (message "No current site.")))
+ (elpher-reload-current-page))
(defun elpher-toggle-tls ()
"Toggle TLS encryption mode for gopher."
(defun elpher-view-raw ()
"View raw server response for current page."
(interactive)
- (if elpher-current-node
- (if (elpher-address-special-p (elpher-node-address elpher-current-node))
- (error "This page was not generated by a server")
- (elpher-visit-node elpher-current-node
- #'elpher-render-raw))
- (message "No current site.")))
+ (if (elpher-address-special-p (elpher-page-address elpher-current-page))
+ (error "This page was not generated by a server")
+ (elpher-visit-page elpher-current-page
+ #'elpher-render-raw)))
(defun elpher-back ()
"Go to previous site."
(interactive)
- (if (elpher-node-parent elpher-current-node)
- (elpher-visit-parent-node)
- (error "No previous site")))
+ (elpher-visit-previous-page))
+
+(defun elpher-back-to-start ()
+ "Go all the way back to the start page."
+ (interactive)
+ (setq-local elpher-current-page nil)
+ (setq-local elpher-history nil)
+ (elpher-visit-page (elpher-make-start-page)))
(defun elpher-download ()
"Download the link at point."
(interactive)
(let ((button (button-at (point))))
(if button
- (let ((node (button-get button 'elpher-node)))
- (if (elpher-address-special-p (elpher-node-address node))
+ (let ((page (button-get button 'elpher-page)))
+ (if (elpher-address-special-p (elpher-page-address page))
(error "Cannot download %s"
- (elpher-node-display-string node))
- (elpher-visit-node (button-get button 'elpher-node)
+ (elpher-page-display-string page))
+ (elpher-visit-page (button-get button 'elpher-page)
#'elpher-render-download)))
(error "No link selected"))))
(defun elpher-download-current ()
"Download the current page."
(interactive)
- (if (elpher-address-special-p (elpher-node-address elpher-current-node))
+ (if (elpher-address-special-p (elpher-page-address elpher-current-page))
(error "Cannot download %s"
- (elpher-node-display-string elpher-current-node))
- (elpher-visit-node (elpher-make-node
- (elpher-node-display-string elpher-current-node)
- (elpher-node-address elpher-current-node)
- elpher-current-node)
+ (elpher-page-display-string elpher-current-page))
+ (elpher-visit-page (elpher-make-page
+ (elpher-page-display-string elpher-current-page)
+ (elpher-page-address elpher-current-page))
#'elpher-render-download
t)))
-(defun elpher-build-link-map ()
- "Build alist mapping link names to destination nodes in current buffer."
+(defun elpher--build-link-map ()
+ "Build alist mapping link names to destination pages in current buffer."
(let ((link-map nil)
(b (next-button (point-min) t)))
(while b
(defun elpher-jump ()
"Select a directory entry by name. Similar to the info browser (m)enu command."
(interactive)
- (let* ((link-map (elpher-build-link-map)))
+ (let* ((link-map (elpher--build-link-map)))
(if link-map
(let ((key (let ((completion-ignore-case t))
(completing-read "Directory item/link: "
(defun elpher-root-dir ()
"Visit root of current server."
(interactive)
- (let ((address (elpher-node-address elpher-current-node)))
+ (let ((address (elpher-page-address elpher-current-page)))
(if (not (elpher-address-special-p address))
(if (or (member (url-filename address) '("/" ""))
(and (elpher-address-gopher-p address)
(let ((address-copy (elpher-address-from-url
(elpher-address-to-url address))))
(setf (url-filename address-copy) "")
- (elpher-visit-node
- (elpher-make-node (elpher-address-to-url address-copy)
- address-copy))))
- (error "Command invalid for %s" (elpher-node-display-string elpher-current-node)))))
-
-(defun elpher-bookmarks-current-p ()
- "Return non-nil if current node is a bookmarks page."
- (equal (elpher-address-type (elpher-node-address elpher-current-node))
- '(special bookmarks)))
-
-(defun elpher-reload-bookmarks ()
- "Reload bookmarks if current node is a bookmarks page."
- (if (elpher-bookmarks-current-p)
- (elpher-reload-current-node)))
-
-(defun elpher-bookmark-current ()
- "Bookmark the current node."
- (interactive)
- (let ((address (elpher-node-address elpher-current-node))
- (display-string (elpher-node-display-string elpher-current-node)))
- (if (not (elpher-address-special-p address))
- (let ((bookmark-display-string (read-string "Bookmark display string: "
- display-string)))
- (elpher-add-address-bookmark address bookmark-display-string)
- (message "Bookmark added."))
- (error "Cannot bookmark %s" display-string))))
+ (elpher-go (elpher-address-to-url address-copy))))
+ (error "Command invalid for %s" (elpher-page-display-string elpher-current-page)))))
-(defun elpher-bookmark-link ()
- "Bookmark the link at point."
- (interactive)
- (let ((button (button-at (point))))
- (if button
- (let* ((node (button-get button 'elpher-node))
- (address (elpher-node-address node))
- (display-string (elpher-node-display-string node)))
- (if (not (elpher-address-special-p address))
- (let ((bookmark-display-string (read-string "Bookmark display string: "
- display-string)))
- (elpher-add-address-bookmark address bookmark-display-string)
- (elpher-reload-bookmarks)
- (message "Bookmark added."))
- (error "Cannot bookmark %s" display-string)))
- (error "No link selected"))))
-
-(defun elpher-unbookmark-current ()
- "Remove bookmark for the current node."
- (interactive)
- (let ((address (elpher-node-address elpher-current-node)))
- (unless (elpher-address-special-p address)
- (elpher-remove-address-bookmark address)
- (message "Bookmark removed."))))
-
-(defun elpher-unbookmark-link ()
- "Remove bookmark for the link at point."
- (interactive)
- (let ((button (button-at (point))))
- (if button
- (let ((node (button-get button 'elpher-node)))
- (elpher-remove-address-bookmark (elpher-node-address node))
- (elpher-reload-bookmarks)
- (message "Bookmark removed."))
- (error "No link selected"))))
-
-(defun elpher-bookmarks ()
- "Visit bookmarks page."
- (interactive)
- (switch-to-buffer "*elpher*")
- (elpher-visit-node
- (elpher-make-node "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
-
-(defun elpher-info-node (node)
- "Display information on NODE."
- (let ((display-string (elpher-node-display-string node))
- (address (elpher-node-address node)))
+(defun elpher-info-page (page)
+ "Display information on PAGE."
+ (let ((display-string (elpher-page-display-string page))
+ (address (elpher-page-address page)))
(if (elpher-address-special-p address)
(message "Special page: %s" display-string)
(message "%s" (elpher-address-to-url address)))))
(defun elpher-info-link ()
- "Display information on node corresponding to link at point."
+ "Display information on page corresponding to link at point."
(interactive)
(let ((button (button-at (point))))
(if button
- (elpher-info-node (button-get button 'elpher-node))
+ (elpher-info-page (button-get button 'elpher-page))
(error "No item selected"))))
-
+
(defun elpher-info-current ()
- "Display information on current node."
+ "Display information on current page."
(interactive)
- (elpher-info-node elpher-current-node))
+ (elpher-info-page elpher-current-page))
-(defun elpher-copy-node-url (node)
- "Copy URL representation of address of NODE to `kill-ring'."
- (let ((address (elpher-node-address node)))
+(defun elpher-copy-page-url (page)
+ "Copy URL representation of address of PAGE to `kill-ring'."
+ (let ((address (elpher-page-address page)))
(if (elpher-address-special-p address)
- (error (format "Cannot represent %s as URL" (elpher-node-display-string node)))
+ (error (format "Cannot represent %s as URL" (elpher-page-display-string page)))
(let ((url (elpher-address-to-url address)))
(message "Copied \"%s\" to kill-ring/clipboard." url)
(kill-new url)))))
(interactive)
(let ((button (button-at (point))))
(if button
- (elpher-copy-node-url (button-get button 'elpher-node))
+ (elpher-copy-page-url (button-get button 'elpher-page))
(error "No item selected"))))
(defun elpher-copy-current-url ()
- "Copy URL of current node to `kill-ring'."
+ "Copy URL of current page to `kill-ring'."
(interactive)
- (elpher-copy-node-url elpher-current-node))
+ (elpher-copy-page-url elpher-current-page))
(defun elpher-set-gopher-coding-system ()
"Specify an explicit character coding system for gopher selectors."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "TAB") 'elpher-next-link)
(define-key map (kbd "<backtab>") 'elpher-prev-link)
+ (define-key map (kbd "C-M-i") 'elpher-prev-link)
(define-key map (kbd "u") 'elpher-back)
+ (define-key map (kbd "-") 'elpher-back)
+ (define-key map (kbd "^") 'elpher-back)
(define-key map [mouse-3] 'elpher-back)
- (define-key map (kbd "O") 'elpher-root-dir)
+ (define-key map (kbd "U") 'elpher-back-to-start)
(define-key map (kbd "g") 'elpher-go)
(define-key map (kbd "o") 'elpher-go-current)
+ (define-key map (kbd "O") 'elpher-root-dir)
+ (define-key map (kbd "s") 'elpher-show-history)
+ (define-key map (kbd "S") 'elpher-show-visited-pages)
(define-key map (kbd "r") 'elpher-redraw)
(define-key map (kbd "R") 'elpher-reload)
(define-key map (kbd "T") 'elpher-toggle-tls)
(define-key map (kbd "C") 'elpher-copy-current-url)
(define-key map (kbd "a") 'elpher-bookmark-link)
(define-key map (kbd "A") 'elpher-bookmark-current)
- (define-key map (kbd "x") 'elpher-unbookmark-link)
- (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 "B") 'elpher-show-bookmarks)
+ (define-key map (kbd "!") 'elpher-set-gopher-coding-system)
+ (define-key map (kbd "F") 'elpher-forget-current-certificate)
(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
- [mouse-3] 'elpher-back
- (kbd "g") '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 "i") 'elpher-info-link
- (kbd "I") 'elpher-info-current
- (kbd "c") 'elpher-copy-link-url
- (kbd "C") 'elpher-copy-current-url
- (kbd "a") 'elpher-bookmark-link
- (kbd "A") 'elpher-bookmark-current
- (kbd "x") 'elpher-unbookmark-link
- (kbd "X") 'elpher-unbookmark-current
- (kbd "B") 'elpher-bookmarks
- (kbd "S") 'elpher-set-gopher-coding-system))
+ (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
+ [mouse-3] 'elpher-back
+ (kbd "U") 'elpher-back-to-start
+ (kbd "g") 'elpher-go
+ (kbd "o") 'elpher-go-current
+ (kbd "O") 'elpher-root-dir
+ (kbd "s") 'elpher-show-history
+ (kbd "S") 'elpher-show-visited-pages
+ (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 "i") 'elpher-info-link
+ (kbd "I") 'elpher-info-current
+ (kbd "c") 'elpher-copy-link-url
+ (kbd "C") 'elpher-copy-current-url
+ (kbd "a") 'elpher-bookmark-link
+ (kbd "A") 'elpher-bookmark-current
+ (kbd "B") 'elpher-show-bookmarks
+ (kbd "!") 'elpher-set-gopher-coding-system
+ (kbd "F") 'elpher-forget-current-certificate))
map)
"Keymap for gopher client.")
"Major mode for elpher, an elisp gopher client.
This mode is automatically enabled by the interactive
-functions which initialize the gopher client, namely
-`elpher', `elpher-go' and `elpher-bookmarks'.")
+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))
(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-node nil)
- (let ((start-node (elpher-make-node "Elpher Start Page"
- (elpher-make-special-address 'start))))
- (elpher-visit-node start-node)))
- "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 ‘\\[universal-argument] 42
+\\[execute-extended-command] elpher RET’) switches to the session with
+that number, creating it if necessary. A non numeric 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)
+ (elpher-visit-page (elpher-make-start-page))
+ "Started Elpher."))); Otherwise (elpher) evaluates to start page string.
;;; elpher.el ends here
The Lambda Lab / projects / elpher.git / blobdiff