;; 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
"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
(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")))
+ (equal (url-filename url) "/1"))
+ (setf (url-filename url) "/")))
(when (equal "gemini" (url-type url))
;; 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.
;; Cache
+;; We use the following pair of hashmaps to form the cache: one
+;; for the content (rendered server responses), and one for the
+;; position of point within the content.
+;;
+;; The keys for both of these hashmaps are the page addresses, and
+;; the cache persists for as long as the emacs session.
+;;
+;; Whether or not to use cached content is a decision made by the
+;; specific renderer. Some renderers, such as elpher-render-download,
+;; never cache.
+
(defvar elpher-content-cache (make-hash-table :test 'equal))
(defvar elpher-pos-cache (make-hash-table :test 'equal))
;; Page
+;; In our model, a "page" merely represents a combination of a
+;; display string and an elpher address. The distinction exists
+;; because caching, server response acquisition, etc deal only
+;; with addresses.
+
(defun elpher-make-page (display-string address)
"Create a page with DISPLAY-STRING and ADDRESS."
(list display-string address))
'("gophers" "gemini")))
" [TLS encryption]"
""))
- (header (concat display-string
+ (header (concat (replace-regexp-in-string "%" "%%" display-string)
(propertize tls-string 'face 'bold))))
(setq header-line-format header))))
(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
(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'."
(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)
(when elpher-client-certificate
(unless (and (called-interactively-p 'any)
(not (y-or-n-p (concat "Really forget client certificate? "
- "(Throwaway certertificates will be deleted.)"))))
+ "(Throwaway certificates will be deleted.)"))))
(when (cadr elpher-client-certificate)
(delete-file (elt elpher-client-certificate 2))
(delete-file (elt elpher-client-certificate 3)))
(elpher-insert-margin (concat (char-to-string selector-type) "?"))
(insert (propertize display-string
'face 'elpher-unknown)))))
- (insert "\n")
-))
+ (insert "\n")))
(defun elpher-click-link (button)
"Function called when the gopher link BUTTON is activated (via mouse or keypress)."
(?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))
- (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)
(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."
" - 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")
'face 'shadow))
(elpher-restore-pos)))
+
;; Bookmarks page page retrieval
+(defvar elpher-bookmark-group-status (make-hash-table :test 'equal))
+
+(defun elpher-make-bookmark-group-status (group-path)
+ (let ((existing (gethash group-path elpher-bookmark-group-status)))
+ (unless existing
+ (puthash group-path (list nil nil nil) elpher-bookmark-group-status))))
+
+(defun elpher-bookmark-group-start (group-path)
+ (car (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-end (group-path)
+ (cadr (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-expanded-p (group-path)
+ (caddr (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-expanded-toggle (group-path)
+ (setcar (cddr (gethash group-path elpher-bookmark-group-status))
+ (not (elpher-bookmark-group-expanded-p group-path))))
+
+(defun elpher--bookmark-indent (group-path)
+ (insert (make-string (+ 1 (* 2 (length group-path))) ?\s)))
+
+(defun elpher--bookmark-group-starts-here (group-path)
+ (setcar (gethash group-path elpher-bookmark-group-status) (point)))
+
+(defun elpher--bookmark-group-ends-here (group-path)
+ (setcar (cdr (gethash group-path elpher-bookmark-group-status)) (point)))
+
+(defun elpher--update-bookmark-group-visibility (group-path)
+ (let ((start (elpher-bookmark-group-start group-path))
+ (end (elpher-bookmark-group-end group-path))
+ (inhibit-read-only t))
+ (put-text-property start end 'invisible
+ (not (elpher-bookmark-group-expanded-p group-path)))))
+
+(defun elpher--expand-or-collapse-bookmark-group (button)
+ (let ((group-path (button-get button 'elpher-bookmark-group-path)))
+ (elpher-bookmark-group-expanded-toggle group-path)
+ (elpher--update-bookmark-group-visibility group-path)))
+
+(defun elpher--insert-bookmark (bookmark &optional group-path)
+ (let* ((display-string (elpher-bookmark-display-string bookmark))
+ (address (elpher-address-from-url (elpher-bookmark-url bookmark)))
+ (type (if address (elpher-address-type address) nil))
+ (type-map-entry (cdr (assoc type elpher-type-map))))
+ (if type-map-entry
+ (let* ((face (elt type-map-entry 3))
+ (filtered-display-string (ansi-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")))
+
+(defun elpher--insert-bookmark-group (group-entries &optional group-path)
+ (if group-entries
+ (dolist (entry group-entries)
+ (elpher--bookmark-indent group-path)
+ (if (elpher-bookmark-p entry)
+ (elpher--insert-bookmark entry group-path)
+ (let* ((subgroup-name (elpher-bookmark-group-name entry))
+ (subgroup-entries (elpher-bookmark-group-entries entry))
+ (subgroup-path (cons subgroup-name group-path)))
+ (elpher-make-bookmark-group-status subgroup-path)
+ (insert-text-button subgroup-name
+ 'action #'elpher--expand-or-collapse-bookmark-group
+ 'elpher-bookmark-group-path subgroup-path
+ 'follow-link t
+ 'help-echo "Expand or collapse group.")
+ (insert "\n")
+ (elpher--bookmark-group-starts-here subgroup-path)
+ (elpher--insert-bookmark-group subgroup-entries subgroup-path)
+ (elpher--bookmark-group-ends-here subgroup-path)
+ (elpher--update-bookmark-group-visibility subgroup-path))))
+ (elpher--bookmark-indent group-path)
+ (insert "No bookmarks found.\n")))
+
(defun elpher-get-bookmarks-page (renderer)
"Getter to load and display the current bookmark list (RENDERER must be nil)."
(when renderer
(elpher-visit-previous-page)
(error "Command not supported for bookmarks page"))
(elpher-with-clean-buffer
+ ;; (setq buffer-invisibility-spec '((expanded . t)))
(insert "---- Bookmark list ----\n\n")
(let ((bookmarks (elpher-load-bookmarks)))
- (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")))
+ (elpher--insert-bookmark-group bookmarks))
(insert "\n-----------------------\n"
"\n"
"- u: return to previous page\n"
'follow-link t
'help-echo help-string))
(insert "\n")
+ (insert "\n--- Recently visited ---\n\n")
+ (maphash (lambda (address _)
+ (unless (elpher-address-special-p address)
+ (let ((url (elpher-address-to-url address)))
+ (elpher--insert-bookmark (elpher-make-bookmark url url)))))
+ elpher-content-cache)
+ (insert "\n------------------------\n")
(elpher-restore-pos)))
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))
"Get the address for BOOKMARK."
(elt bookmark 1))
+(defun elpher-bookmark-p (entry)
+ "Determine if entry describes a bookmark.
+Otherwise, it will be treated as a bookmark group."
+ (and (listp entry)
+ (= (length entry) 2)
+ (stringp (cadr entry))))
+
+(defun elpher-make-bookmark-group (group-name &optional bookmarks)
+ "Make an elpher bookmark group.
+GROUP-NAME is the name of the group. If non-nil, BOOKMARKS is a
+list of one or more bookmarks or subgroups to appear within this
+group."
+ (cons diplay-string bookmarks))
+
+(defun elpher-bookmark-group-name (group)
+ "Returns the name of bookmark group GROUP."
+ (car group))
+
+(defun elpher-bookmark-group-entries (group)
+ "Returns the entries held in bookmark group GROUP."
+ (cdr group))
+
(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."
(insert-file-contents elpher-bookmarks-file)
(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)))
+ ;; (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.)))
(defun elpher-next-link ()
"Move point to the next link on the current page."
(interactive)
- (forward-button 1))
+ (while
+ (let ((next-button (forward-button 1)))
+ (or (not next-button)
+ (button-get next-button 'invisible)))))
(defun elpher-prev-link ()
"Move point to the previous link on the current page."
(interactive)
- (backward-button 1))
+ (while
+ (let ((prev-button (backward-button 1)))
+ (or (not prev-button)
+ (button-get prev-button 'invisible)))))
(defun elpher-follow-current-link ()
"Open the link or url at point."
(interactive)
(let ((button (button-at (point))))
(if button
- (elpher-info-page (button-get button 'elpher-page))
+ (let ((page (button-get button 'elpher-page)))
+ (if page
+ (elpher-info-page (button-get button 'elpher-page))
+ (error "Not an Elpher page")))
(error "No item selected"))))
(defun elpher-info-current ()