;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.8.0
+;; Version: 2.10.0
;; Keywords: comm gopher
;; Homepage: http://thelambdalab.xyz/elpher
-;; Package-Requires: ((emacs "26.1"))
+;; Package-Requires: ((emacs "26.2"))
;; This file is not part of GNU Emacs.
;;; Global constants
;;
-(defconst elpher-version "2.8.0"
+(defconst elpher-version "2.10.0"
"Current version of elpher.")
(defconst elpher-margin-width 6
;;
(defgroup elpher nil
- "A gopher client."
+ "A gopher and gemini client."
:group 'applications)
;; General appearance and customizations
These certificates may be used for establishing authenticated TLS connections."
:type '(directory))
+(defcustom elpher-openssl-command "openssl"
+ "The command used to launch openssl when generating TLS client certificates."
+ :type '(file))
+
(defcustom elpher-gemini-TLS-cert-checks nil
"If non-nil, verify gemini server TLS certs using the default security level.
Otherwise, certificate verification is disabled.
;; Gemini defaults
(if (equal (url-filename url) "")
(setf (url-filename url) "/"))))
- url)
+ (elpher-remove-redundant-ports url))
(set-match-data data))))
+(defun elpher-remove-redundant-ports (address)
+ "Remove redundant port specifiers from ADDRESS.
+Here 'redundant' means that the specified port matches the default
+for that protocol, eg 70 for gopher."
+ (if (and (not (elpher-address-special-p address))
+ (eq (url-portspec address) ; (url-port) is too slow!
+ (pcase (url-type address)
+ ("gemini" 1965)
+ ((or "gopher" "gophers") 70)
+ ("finger" 79)
+ (_ -1))))
+ (setf (url-portspec address) nil))
+ address)
+
(defun elpher-make-gopher-address (type selector host port &optional tls)
"Create an ADDRESS object using gopher directory record attributes.
The basic attributes include: TYPE, SELECTOR, HOST and PORT.
"Set the address corresponding to PAGE to NEW-ADDRESS."
(setcar (cdr page) new-address))
-(defvar elpher-current-page nil)
-(defvar elpher-history nil)
+(defvar elpher-current-page nil) ; buffer local
+(defvar elpher-history nil) ; buffer local
(defun elpher-visit-page (page &optional renderer no-history)
"Visit PAGE using its own renderer or RENDERER, if non-nil.
(equal (elpher-page-address elpher-current-page)
(elpher-page-address page)))
(push elpher-current-page elpher-history))
- (setq elpher-current-page page)
+ (setq-local elpher-current-page page)
(let* ((address (elpher-page-address page))
(type (elpher-address-type address))
(type-record (cdr (assoc type elpher-type-map))))
;;; Buffer preparation
;;
+(defvar elpher-buffer-name "*elpher*"
+ "The default name of the Elpher buffer.")
+
(defun elpher-update-header ()
"If `elpher-use-header' is true, display current page info in window header."
(if elpher-use-header
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
- (list 'with-current-buffer "*elpher*"
- '(elpher-mode)
- (append (list 'let '((inhibit-read-only t))
- '(setq-local network-security-level
- (default-value 'network-security-level))
- '(erase-buffer)
- '(elpher-update-header))
- args)))
+ `(with-current-buffer elpher-buffer-name
+ (unless (eq major-mode 'elpher-mode)
+ ;; avoid resetting buffer-local variables
+ (elpher-mode))
+ (let ((inhibit-read-only t))
+ (setq-local network-security-level
+ (default-value 'network-security-level))
+ (erase-buffer)
+ (elpher-update-header)
+ ,@args)))
(defun elpher-buffer-message (string &optional line)
"Replace first line in elpher buffer with STRING.
If LINE is non-nil, replace that line instead."
- (with-current-buffer "*elpher*"
+ (with-current-buffer elpher-buffer-name
(let ((inhibit-read-only t))
(goto-char (point-min))
(if line
(t
(elpher-network-error address "Connection time-out.")))))))
(setq elpher-network-timer timer)
- (elpher-buffer-message (concat "Connecting to " host "..."))
+ (elpher-buffer-message (concat "Connecting to " host "..."
+ " (press 'u' to abort)"))
(set-process-filter proc
(lambda (_proc string)
(when timer
(cond
((string-prefix-p "open" event) ; request URL
(elpher-buffer-message
- (concat "Connected to " host ". Receiving data..."))
+ (concat "Connected to " host ". Receiving data..."
+ " (press 'u' to abort)"))
(let ((inhibit-eol-conversion t))
(process-send-string proc query-string)))
((string-prefix-p "deleted" event)) ; do nothing
(error
(error "Error initiating connection to server")))))
-(defun elpher-generate-certificate (name key-file cert-file &optional temporary)
+
+;;; Client-side TLS Certificate Management
+;;
+
+(defun elpher-generate-certificate (common-name key-file cert-file &optional temporary)
+ "Generate a key and a self-signed client TLS certificate using openssl.
+
+The Common Name field of the certificate is set to COMMON-NAME. The
+arguments KEY-FILE and CERT-FILE should contain the absolute paths of
+the key and certificate files to write.
+
+If TEMPORARY is non-nil, the certificate will be given an exporation
+period of one day, and the key and certificate files will be deleted
+when the certificate is no longer needed for the current session.
+
+Otherwise, the certificate will be given a 100 year expiration period
+and the files will not be deleted.
+
+The function returns a list containing the current host name, the
+temporary flag, and the key and cert file names in the form required
+by `gnutls-boot-parameters`."
(let ((exp-key-file (expand-file-name key-file))
(exp-cert-file (expand-file-name cert-file)))
- (call-process "openssl" nil nil nil
- "req" "-x509" "-newkey" "rsa:2048"
- "-days" (if temporary "1" "36500")
- "-nodes"
- "-subj" (concat "/CN=" name)
- "-keyout" exp-key-file
- "-out" exp-cert-file)
- (list (elpher-address-host (elpher-page-address elpher-current-page))
- temporary exp-key-file exp-cert-file)))
+ (condition-case nil
+ (progn
+ (call-process elpher-openssl-command nil nil nil
+ "req" "-x509" "-newkey" "rsa:2048"
+ "-days" (if temporary "1" "36500")
+ "-nodes"
+ "-subj" (concat "/CN=" common-name)
+ "-keyout" exp-key-file
+ "-out" exp-cert-file)
+ (list (elpher-address-host (elpher-page-address elpher-current-page))
+ temporary exp-key-file exp-cert-file))
+ (error
+ (message "Check that openssl is installed, or customize `elpher-openssl-command`.")
+ (error "Program 'openssl', required for certificate generation, not found")))))
(defun elpher-generate-throwaway-certificate ()
+ "Generate and return details of a throwaway certificate.
+The key and certificate files will be deleted when they are no
+longer needed for this session."
(let* ((file-base (make-temp-name "elpher"))
(key-file (concat temporary-file-directory file-base ".key"))
(cert-file (concat temporary-file-directory file-base ".crt")))
(elpher-generate-certificate file-base key-file cert-file t)))
-(defun elpher-generate-permanent-certificate (file-base)
+(defun elpher-generate-persistent-certificate (file-base common-name)
+ "Generate and return details of a persistent certificate.
+The argument FILE-BASE is used as the base for the key and certificate
+files, while COMMON-NAME specifies the common name field of the
+certificate.
+
+The key and certificate files are written to in `elpher-certificate-directory'."
(let* ((key-file (concat elpher-certificate-directory file-base ".key"))
(cert-file (concat elpher-certificate-directory file-base ".crt")))
- (elpher-generate-certificate file-base key-file cert-file)))
+ (elpher-generate-certificate common-name key-file cert-file)))
(defun elpher-get-existing-certificate (file-base)
+ "Return a certificate object corresponding to an existing certificate.
+It is assumed that the key files FILE-BASE.key and FILE-BASE.crt exist in
+the directory `elpher-certificate-directory'."
(let* ((key-file (concat elpher-certificate-directory file-base ".key"))
(cert-file (concat elpher-certificate-directory file-base ".crt")))
(list (elpher-address-host (elpher-page-address elpher-current-page))
(expand-file-name key-file)
(expand-file-name cert-file))))
+(defun elpher-install-and-use-existing-certificate (key-file-src cert-file-src file-base)
+ "Install a key+certificate file pair in `elpher-certificate-directory'.
+The strings KEY-FILE-SRC and CERT-FILE-SRC are the existing key and
+certificate files to install. The argument FILE-BASE is used as the
+base for the installed key and certificate files."
+ (let* ((key-file (concat elpher-certificate-directory file-base ".key"))
+ (cert-file (concat elpher-certificate-directory file-base ".crt")))
+ (if (or (file-exists-p key-file)
+ (file-exists-p cert-file))
+ (error "A certificate with base name %s is already installed" file-base))
+ (copy-file key-file-src key-file)
+ (copy-file cert-file-src cert-file)
+ (list (elpher-address-host (elpher-page-address elpher-current-page))
+ nil
+ (expand-file-name key-file)
+ (expand-file-name cert-file))))
+
(defun elpher-list-existing-certificates ()
+ "Return a list of the persistent certificates in `elpher-certificate-directory'."
(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))
- (when (cadr elpher-client-certificate)
- (delete-file (elt elpher-client-certificate 2))
- (delete-file (elt elpher-client-certificate 3)))
- (setq elpher-client-certificate nil)
+ (elpher-forget-current-certificate)
(message "Disabling client certificate for new host")
nil)
nil))
(?1 ; Input required
(elpher-with-clean-buffer
(insert "Gemini server is requesting input."))
- (let* ((query-string (read-string (concat response-meta ": ")))
+ (let* ((query-string
+ (if (eq (elt response-code 1) ?1)
+ (read-passwd (concat response-meta ": "))
+ (read-string (concat response-meta ": "))))
(query-address (seq-copy (elpher-page-address elpher-current-page)))
(old-fname (url-filename query-address)))
(setf (url-filename query-address)
(insert "Gemini server is requesting a valid TLS certificate:\n\n"))
(auto-fill-mode 1)
(elpher-gemini-insert-text response-meta))
- (let* ((read-answer-short t)
- (res (read-answer "What do you want to do? "
- '(("throwaway" ?t "generate and use throw-away certificate")
- ("permanent" ?p "generate and use permanent certificate")
- ("existing" ?e "use existing certificate")
- ("abort" ?a "stop immediately")))))
- (pcase res
- ("throwaway"
- (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
- ("permanent"
- (let ((file-base (read-string "Name for certificate: ")))
- (setq elpher-client-certificate
- (elpher-generate-permanent-certificate file-base))))
- ("existing"
- (let ((file-base (completing-read "Name of existing certificate (autocompletes, empty response aborts): "
- (elpher-list-existing-certificates)
- nil t)))
- (if (string-empty-p file-base)
- (error "Gemini server requires a client certificate and none was provided")
- (setq elpher-client-certificate
- (elpher-get-existing-certificate file-base)))))
- ;; TODO
- ("abort"
- (error "Gemini server requires a client certificate and none was provided")))
- (elpher-with-clean-buffer)
- (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer)))
+ (let ((chosen-certificate (elpher-choose-client-certificate)))
+ (unless chosen-certificate
+ (error "Gemini server requires a client certificate and none was provided"))
+ (setq elpher-client-certificate chosen-certificate))
+ (elpher-with-clean-buffer)
+ (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer))
(_other
(error "Gemini server response unknown: %s %s"
response-code response-meta))))))
+(defun elpher-choose-client-certificate ()
+ "Prompt for a client certificate to use to establish a TLS connection."
+ (let* ((read-answer-short t))
+ (pcase (read-answer "What do you want to do? "
+ '(("throwaway" ?t
+ "generate and use throw-away certificate")
+ ("persistent" ?p
+ "generate new or use existing persistent certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("throwaway"
+ (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
+ ("persistent"
+ (let* ((existing-certificates (elpher-list-existing-certificates))
+ (file-base (completing-read
+ "Nickname for new or existing certificate (autocompletes, empty response aborts): "
+ existing-certificates)))
+ (if (string-empty-p (string-trim file-base))
+ nil
+ (if (member file-base existing-certificates)
+ (setq elpher-client-certificate
+ (elpher-get-existing-certificate file-base))
+ (pcase (read-answer "Generate new certificate or install externally-generated one? "
+ '(("new" ?n
+ "generate new certificate")
+ ("install" ?i
+ "install existing certificate")
+ ("abort" ?a
+ "stop immediately")))
+ ("new"
+ (let ((common-name (read-string "Common Name field for new certificate: "
+ file-base)))
+ (message "New key and self-signed certificate written to %s"
+ elpher-certificate-directory)
+ (elpher-generate-persistent-certificate file-base common-name)))
+ ("install"
+ (let* ((cert-file (read-file-name "Certificate file: " nil nil t))
+ (key-file (read-file-name "Key file: " nil nil t)))
+ (message "Key and certificate installed in %s for future use"
+ elpher-certificate-directory)
+ (elpher-install-and-use-existing-certificate key-file
+ cert-file
+ file-base)))
+ ("abort" nil))))))
+ ("abort" nil))))
+
(defun elpher-get-gemini-page (renderer)
"Getter which retrieves and renders a Gemini page and renders it using RENDERER."
(let* ((address (elpher-page-address elpher-current-page))
(error
(elpher-network-error address the-error)))))
-
(defun elpher-render-gemini (body &optional mime-type-string)
"Render gemini response BODY with rendering MIME-TYPE-STRING."
(if (not body)
(string-join (reverse path-reversed-normalized) "/")))
(defun elpher-address-from-gemini-url (url)
- "Extract address from URL with defaults as per gemini map files."
+ "Extract address from URL with defaults as per gemini map files.
+While there's obviously some redundancy here between this function and
+`elpher-address-from-url', gemini map file URLs require enough special
+treatment that a separate function is warranted."
(let ((address (url-generic-parse-url url))
(current-address (elpher-page-address elpher-current-page)))
(unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
(url-filename address)))))
(unless (url-type address)
(setf (url-type address) "gemini"))
- (if (equal (url-type address) "gemini")
- (setf (url-filename address)
- (elpher-collapse-dot-sequences (url-filename address)))))
- address))
+ (when (equal (url-type address) "gemini")
+ (setf (url-filename address)
+ (elpher-collapse-dot-sequences (url-filename address)))))
+ (elpher-remove-redundant-ports address)))
(defun elpher-gemini-insert-link (link-line)
"Insert link described by LINK-LINE into a text/gemini document."
(elpher-page-address elpher-current-page)
(buffer-string))))
+
;; Finger page connection
(defun elpher-get-finger-page (renderer)
(elpher-network-error address the-error))))))
+;; Telnet page connection
+
+(defun elpher-get-telnet-page (renderer)
+ "Opens a telnet connection to the current page address (RENDERER must be nil)."
+ (when renderer
+ (elpher-visit-previous-page)
+ (error "Command not supported for telnet URLs"))
+ (let* ((address (elpher-page-address elpher-current-page))
+ (host (elpher-address-host address))
+ (port (elpher-address-port address)))
+ (elpher-visit-previous-page)
+ (if (> port 0)
+ (telnet host port)
+ (telnet host))))
+
+
;; Other URL page opening
(defun elpher-get-other-url-page (renderer)
(browse-web url)
(browse-url url)))))
-;; Telnet page connection
-
-(defun elpher-get-telnet-page (renderer)
- "Opens a telnet connection to the current page address (RENDERER must be nil)."
- (when renderer
- (elpher-visit-previous-page)
- (error "Command not supported for telnet URLs"))
- (let* ((address (elpher-page-address elpher-current-page))
- (host (elpher-address-host address))
- (port (elpher-address-port address)))
- (elpher-visit-previous-page)
- (if (> port 0)
- (telnet host port)
- (telnet host))))
;; Start page page retrieval
" - R: reload current page (regenerates cache)\n"
" - S: set character coding system for gopher (default is to autodetect)\n"
" - T: toggle TLS gopher mode\n"
+ " - F: forget/discard current TLS client certificate\n"
" - .: display the raw server response for the current page\n"
"\n"
"Start your exploration of gopher space and gemini:\n")
(interactive "sGopher or Gemini URL: ")
(let* ((cleaned-host-or-url (string-trim host-or-url))
(address (elpher-address-from-url cleaned-host-or-url))
- (page (elpher-make-page cleaned-host-or-url address)))
- (switch-to-buffer "*elpher*")
+ (page (elpher-make-page cleaned-host-or-url address)))
+ (switch-to-buffer elpher-buffer-name)
(elpher-visit-page page)
nil))
(defun elpher-back-to-start ()
"Go all the way back to the start page."
(interactive)
- (setq elpher-current-page nil)
- (setq elpher-history nil)
+ (setq-local elpher-current-page nil)
+ (setq-local elpher-history nil)
(let ((start-page (elpher-make-page "Elpher Start Page"
(elpher-make-special-address 'start))))
(elpher-visit-page start-page)))
(defun elpher-bookmarks ()
"Visit bookmarks page."
(interactive)
- (switch-to-buffer "*elpher*")
+ (switch-to-buffer elpher-buffer-name)
(elpher-visit-page
(elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
(define-key map (kbd "X") 'elpher-unbookmark-current)
(define-key map (kbd "B") 'elpher-bookmarks)
(define-key map (kbd "S") 'elpher-set-gopher-coding-system)
+ (define-key map (kbd "F") 'elpher-forget-current-certificate)
(when (fboundp 'evil-define-key*)
(evil-define-key* 'motion map
(kbd "TAB") 'elpher-next-link
(kbd "x") 'elpher-unbookmark-link
(kbd "X") 'elpher-unbookmark-current
(kbd "B") 'elpher-bookmarks
- (kbd "S") 'elpher-set-gopher-coding-system))
+ (kbd "S") 'elpher-set-gopher-coding-system
+ (kbd "F") 'elpher-forget-current-certificate))
map)
"Keymap for gopher client.")
This mode is automatically enabled by the interactive
functions which initialize the gopher client, namely
-`elpher', `elpher-go' and `elpher-bookmarks'.")
+`elpher', `elpher-go' and `elpher-bookmarks'."
+ (setq-local elpher-current-page nil)
+ (setq-local elpher-history nil)
+ (setq-local elpher-buffer-name (buffer-name)))
(when (fboundp 'evil-set-initial-state)
(evil-set-initial-state 'elpher-mode 'motion))
+;;; Menu
+;;
+
+(defun elpher-menu ()
+ "Show a list of all your `elpher' buffers."
+ (interactive)
+ (switch-to-buffer (get-buffer-create "*Elpher Menu*"))
+ (elpher-menu-mode)
+ (elpher-menu-refresh)
+ (tabulated-list-print))
+
+(defvar elpher-menu-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map "v" 'Buffer-menu-select)
+ (define-key map "2" 'Buffer-menu-2-window)
+ (define-key map "1" 'Buffer-menu-1-window)
+ (define-key map "f" 'Buffer-menu-this-window)
+ (define-key map "e" 'Buffer-menu-this-window)
+ (define-key map "\C-m" 'Buffer-menu-this-window)
+ (define-key map "o" 'Buffer-menu-other-window)
+ (define-key map "\C-o" 'Buffer-menu-switch-other-window)
+ (define-key map "d" 'Buffer-menu-delete)
+ (define-key map "k" 'Buffer-menu-delete)
+ (define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
+ (define-key map "x" 'Buffer-menu-execute)
+ (define-key map " " 'next-line)
+ (define-key map "\177" 'Buffer-menu-backup-unmark)
+ (define-key map "u" 'Buffer-menu-unmark)
+ (define-key map "m" 'Buffer-menu-mark)
+ (define-key map "b" 'Buffer-menu-bury)
+ (define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers)
+ (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
+ (define-key map (kbd "M-s a C-o") 'Buffer-menu-multi-occur)
+ (define-key map [mouse-2] 'Buffer-menu-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [menu-bar elpher-menu-mode] (cons (purecopy "Elpher-Menu") menu-map))
+ (bindings--define-key menu-map [quit]
+ '(menu-item "Quit" quit-window
+ :help "Remove the elpher menu from the display"))
+ (bindings--define-key menu-map [rev]
+ '(menu-item "Refresh" revert-buffer
+ :help "Refresh the *Elpher Menu* buffer contents"))
+ (bindings--define-key menu-map [s0] menu-bar-separator)
+ (bindings--define-key menu-map [sel]
+ '(menu-item "Select Marked" Buffer-menu-select
+ :help "Select this line's buffer; also display buffers marked with `>'"))
+ (bindings--define-key menu-map [bm2]
+ '(menu-item "Select Two" Buffer-menu-2-window
+ :help "Select this line's buffer, with previous buffer in second window"))
+ (bindings--define-key menu-map [bm1]
+ '(menu-item "Select Current" Buffer-menu-1-window
+ :help "Select this line's buffer, alone, in full frame"))
+ (bindings--define-key menu-map [ow]
+ '(menu-item "Select in Other Window" Buffer-menu-other-window
+ :help "Select this line's buffer in other window, leaving buffer menu visible"))
+ (bindings--define-key menu-map [tw]
+ '(menu-item "Select in Current Window" Buffer-menu-this-window
+ :help "Select this line's buffer in this window"))
+ (bindings--define-key menu-map [s2] menu-bar-separator)
+ (bindings--define-key menu-map [is]
+ '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
+ :help "Search for a regexp through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [ir]
+ '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
+ :help "Search for a string through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [mo]
+ '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur
+ :help "Show lines matching a regexp in marked buffers using Occur"))
+ (bindings--define-key menu-map [s3] menu-bar-separator)
+ (bindings--define-key menu-map [by]
+ '(menu-item "Bury" Buffer-menu-bury
+ :help "Bury the buffer listed on this line"))
+ (bindings--define-key menu-map [ex]
+ '(menu-item "Execute" Buffer-menu-execute
+ :help "Delete buffers marked with k commands"))
+ (bindings--define-key menu-map [s4] menu-bar-separator)
+ (bindings--define-key menu-map [delb]
+ '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
+ :help "Mark buffer on this line to be deleted by x command and move up one line"))
+ (bindings--define-key menu-map [del]
+ '(menu-item "Mark for Delete" Buffer-menu-delete
+ :help "Mark buffer on this line to be deleted by x command"))
+ (bindings--define-key menu-map [umk]
+ '(menu-item "Unmark" Buffer-menu-unmark
+ :help "Cancel all requested operations on buffer on this line and move down"))
+ (bindings--define-key menu-map [mk]
+ '(menu-item "Mark" Buffer-menu-mark
+ :help "Mark buffer on this line for being displayed by v command"))
+ map)
+ "Local keymap for `elpher-menu-mode' buffers.")
+
+(define-derived-mode elpher-menu-mode tabulated-list-mode "Elpher Menu"
+ "Major mode for Elpher Menu buffers.
+The Elpher Menu is invoked by the command \\[elpher-menu].
+
+In Elpher Menu mode, the following commands are defined:
+\\<elpher-menu-mode-map>
+\\[quit-window] Remove the Buffer Menu from the display.
+\\[tabulated-list-sort] sorts buffers according to the current
+ column. With a numerical argument, sort by that column.
+\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu.
+\\[Buffer-menu-other-window] Select that buffer in another window,
+ so the Buffer Menu remains visible in its window.
+\\[Buffer-menu-switch-other-window] Make another window display that buffer.
+\\[Buffer-menu-mark] Mark current line's buffer to be displayed.
+\\[Buffer-menu-select] Select current line's buffer.
+ Also show buffers marked with m, in other windows.
+\\[Buffer-menu-1-window] Select that buffer in full-frame window.
+\\[Buffer-menu-2-window] Select that buffer in one window, together with the
+ buffer selected before this one in another window.
+\\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers.
+\\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers.
+\\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers.
+\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down.
+\\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up.
+\\[Buffer-menu-execute] Delete or save marked buffers.
+\\[Buffer-menu-unmark] Remove all marks from current line.
+ With prefix argument, also move up one line.
+\\[Buffer-menu-backup-unmark] Back up a line and remove marks.
+\\[revert-buffer] Update the list of buffers.
+\\[Buffer-menu-bury] Bury the buffer listed on this line."
+ (add-hook 'tabulated-list-revert-hook 'elpher-menu-refresh))
+
+(defvar elpher-title nil)
+
+(defun elpher-find-title ()
+ "Return the first heading1."
+ (if elpher-title
+ elpher-title
+ (let ((start (text-property-any
+ (point-min) (point-max)
+ 'face 'elpher-gemini-heading1)))
+ (if start
+ (save-excursion
+ (goto-char start)
+ (setq-local elpher-title
+ (buffer-substring-no-properties
+ start (line-end-position))))
+ "none"))))
+
+(defun elpher-menu-refresh ()
+ "Refresh the list of buffers."
+ ;; Set up `tabulated-list-format'.
+ (setq tabulated-list-format
+ (vector '("T" 1 t)
+ '("URL" 35 t)
+ '("Name" 35 t))
+ tabulated-list-sort-key '("Name"))
+ ;; Collect info for each buffer we're interested in.
+ (let (entries)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (memq major-mode '(elpher-mode eww-mode))
+ (push (list buf
+ (vector
+ (cond ((eq major-mode 'elpher-mode) "E")
+ ((eq major-mode 'eww-mode) "W"))
+ (cond ((eq major-mode 'elpher-mode)
+ (or (elpher-address-to-url
+ (elpher-page-address elpher-current-page))
+ "none"))
+ ((eq major-mode 'eww-mode)
+ (eww-current-url)))
+ (cond ((eq major-mode 'elpher-mode)
+ (elpher-find-title))
+ ((eq major-mode 'eww-mode)
+ (plist-get eww-data :title)))))
+ entries))))
+ (setq tabulated-list-entries (nreverse entries)))
+ (tabulated-list-init-header))
;;; Main start procedure
;;
;;;###autoload
-(defun elpher ()
- "Start elpher with default landing page."
- (interactive)
- (if (get-buffer "*elpher*")
- (switch-to-buffer "*elpher*")
- (switch-to-buffer "*elpher*")
- (setq elpher-current-page nil)
- (setq elpher-history nil)
- (let ((start-page (elpher-make-page "Elpher Start Page"
- (elpher-make-special-address 'start))))
- (elpher-visit-page start-page)))
- "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
+(defun elpher (&optional arg)
+ "Start elpher with default landing page.
+The buffer used for Elpher sessions is determined by the value of
+‘elpher-buffer-name’. If there is already an Elpher session active in
+that buffer, Emacs will simply switch to it. Otherwise, a new session
+will begin. A numeric prefix arg (as in ‘C-u 42 M-x elpher RET’)
+switches to the session with that number, creating it if necessary. A
+nonnumeric prefix arg means to create a new session. Returns the
+buffer selected (or created)."
+ (interactive "P")
+ (let* ((name (default-value 'elpher-buffer-name))
+ (buf (cond ((numberp arg)
+ (get-buffer-create (format "%s<%d>" name arg)))
+ (arg
+ (generate-new-buffer name))
+ (t
+ (get-buffer-create name)))))
+ (pop-to-buffer-same-window buf)
+ (unless (buffer-modified-p)
+ (elpher-mode)
+ (let ((start-page (elpher-make-page "Elpher Start Page"
+ (elpher-make-special-address 'start))))
+ (elpher-visit-page start-page))
+ "Started Elpher."))); Otherwise (elpher) evaluates to start page string.
;;; elpher.el ends here
The Lambda Lab / projects / elpher.git / blobdiff