;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 2.9.1
+;; Version: 2.10.2
;; Keywords: comm gopher
;; Homepage: http://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "26.2"))
;;; Global constants
;;
-(defconst elpher-version "2.9.1"
+(defconst elpher-version "2.10.2"
"Current version of elpher.")
(defconst elpher-margin-width 6
"Face used for html type directory records.")
(defface elpher-gemini
- '((t :inherit font-lock-regexp-grouping-backslash))
+ '((t :inherit font-lock-constant-face))
"Face used for Gemini type directory records.")
(defface elpher-other-url
"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
(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 common-name)
- "Generate and return details of a persistant certificate.
+(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.
(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 persistant certificates in `elpher-certificate-directory'."
+ "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.
+ "Causes any current certificate to be forgotten.)
In the case of throwaway certificates, the key and certificate files
are also deleted."
(interactive)
(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))
- (pcase (read-answer "What do you want to do? "
- '(("throwaway" ?t
- "generate and use throw-away certificate")
- ("permanent" ?p
- "generate new or use existing permanent certificate")
- ("abort" ?a
- "stop immediately")))
- ("throwaway"
- (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
- ("permanent"
- (let* ((existing-certificates (elpher-list-existing-certificates))
- (file-base (completing-read
- "Name of new or existing certificate (autocompletes, empty response aborts): "
- existing-certificates)))
- (if (string-empty-p (string-trim file-base))
- (error "Gemini server requires certificate and none was provided")
- (if (member file-base existing-certificates)
- (setq elpher-client-certificate
- (elpher-get-existing-certificate file-base))
- (let ((common-name (read-string "Common Name field for new certificate: "
- file-base)))
- (setq elpher-client-certificate
- (elpher-generate-permanent-certificate file-base common-name))
- (message "New key and self-signed certificate written to %s"
- elpher-certificate-directory))))))
- ("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)
The gemini map file line describing the header is given
by HEADER-LINE."
(when (string-match "^\\(#+\\)[ \t]*" header-line)
- (let ((level (length (match-string 1 header-line)))
- (header (substring header-line (match-end 0))))
+ (let* ((level (length (match-string 1 header-line)))
+ (header (substring header-line (match-end 0)))
+ (face (pcase level
+ (1 'elpher-gemini-heading1)
+ (2 'elpher-gemini-heading2)
+ (3 'elpher-gemini-heading3)
+ (_ 'default)))
+ (fill-column (/ (* fill-column
+ (font-get (font-spec :name (face-font 'default)) :size))
+ (font-get (font-spec :name (face-font face)) :size))))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
- (insert (propertize header 'face
- (pcase level
- (1 'elpher-gemini-heading1)
- (2 'elpher-gemini-heading2)
- (3 'elpher-gemini-heading3)
- (_ 'default)))
- "\n"))))
+ (insert (propertize header 'face face))
+ (newline))))
(defun elpher-gemini-insert-text (text-line)
"Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
(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*")
+ (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))))
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))
;;
;;;###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