X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=eaabec59d00a4dbcabea3b47e7d07d93575001c2;hp=81074c3e812cf74fa37a3d7fb656e1bcc5f62f9f;hb=021bacb32d0eb7a797c289097f3d348c0665e0bc;hpb=10ec98b2f396451695e6d8524974c48b14e7ac6f diff --git a/elpher.el b/elpher.el index 81074c3..eaabec5 100644 --- a/elpher.el +++ b/elpher.el @@ -1,13 +1,13 @@ -;;; elpher.el --- Full-featured gopher client. +;;; elpher.el --- A friendly gopher client. -*- lexical-binding:t -*- ;; Copyright (C) 2019 Tim Vaughan ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 1.1.0 +;; Version: 2.3.3 ;; Keywords: comm gopher ;; Homepage: https://github.com/tgvaughan/elpher -;; Package-Requires: ((emacs "25")) +;; Package-Requires: ((emacs "26")) ;; This file is not part of GNU Emacs. @@ -26,90 +26,71 @@ ;;; Commentary: -;; Elpher aims to provide a full-featured gopher client for GNU Emacs. -;; It supports: +;; Elpher aims to provide a practical and friendly gopher client +;; for GNU Emacs. It supports: ;; - intuitive keyboard and mouse-driven browsing, -;; - caching of visited sites (both content and cursor position), +;; - out-of-the-box compatibility with evil-mode, +;; - clickable web and gopher links *in plain text*, +;; - caching of visited sites, ;; - pleasant and configurable colouring of Gopher directories, ;; - direct visualisation of image files, -;; - (m)enu key support, similar to Emacs' info browser, -;; - clickable web and gopher links in plain text. - -;; Visited pages are stored as a hierarchy rather than a linear history, -;; meaning that navigation between these pages is quick and easy. +;; - a simple bookmark management system, +;; - connections using TLS encryption, +;; - basic support for the fledgling Gemini protocol. ;; To launch Elpher, simply use 'M-x elpher'. This will open a start ;; page containing information on key bindings and suggested starting ;; points for your gopher exploration. -;; Faces, caching options and start page can be configured via -;; the Elpher customization group in Applications. +;; Full instructions can be found in the Elpher info manual. + +;; Elpher is under active development. Any suggestions for +;; improvements are welcome! ;;; Code: (provide 'elpher) + +;;; Dependencies +;; + (require 'seq) (require 'pp) +(require 'shr) +(require 'url-util) +(require 'subr-x) + ;;; Global constants ;; -(defconst elpher-version "1.1.0" +(defconst elpher-version "2.3.3" "Current version of elpher.") (defconst elpher-margin-width 6 "Width of left-hand margin used when rendering indicies.") -(defconst elpher-start-index - (mapconcat - 'identity - (list "i\tfake\tfake\t1" - "i --------------------------------------------\tfake\tfake\t1" - "i Elpher Gopher Client \tfake\tfake\t1" - (format "i version %s\tfake\tfake\t1" elpher-version) - "i --------------------------------------------\tfake\tfake\t1" - "i\tfake\tfake\t1" - "iUsage:\tfake\tfake\t1" - "i\tfake\tfake\t1" - "i - tab/shift-tab: next/prev item on current page\tfake\tfake\t1" - "i - RET/mouse-1: open item under cursor\tfake\tfake\t1" - "i - m: select an item on current page by name (autocompletes)\tfake\tfake\t1" - "i - u: return to parent\tfake\tfake\t1" - "i - O: visit the root menu of the current server\tfake\tfake\t1" - "i - g: go to a particular menu or item\tfake\tfake\t1" - "i - i/I: info on item under cursor or current page\tfake\tfake\t1" - "i - c/C: copy URL representation of item under cursor or current page\tfake\tfake\t1" - "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1" - "i - R: reload current page (regenerates cache)\tfake\tfake\t1" - "i - d: download directory entry under cursor\tfake\tfake\t1" - "i - w: display the raw server response for the current page\tfake\tfake\t1" - "i\tfake\tfake\t1" - "iPlaces to start exploring Gopherspace:\tfake\tfake\t1" - "i\tfake\tfake\t1" - "1Floodgap Systems Gopher Server\t\tgopher.floodgap.com\t70" - "i\tfake\tfake\t1" - "iAlternatively, select the following item and enter some\tfake\tfake\t1" - "isearch terms:\tfake\tfake\t1" - "i\tfake\tfake\t1" - "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70" - ".\r\n") - "\r\n") - "Source for elpher start page.") - (defconst elpher-type-map - '((?0 elpher-get-text-node "T" elpher-text) - (?1 elpher-get-index-node "/" elpher-index) - (?4 elpher-get-node-download "B" elpher-binary) - (?5 elpher-get-node-download "B" elpher-binary) - (?7 elpher-get-search-node "?" elpher-search) - (?8 elpher-get-telnet-node "?" elpher-telnet) - (?9 elpher-get-node-download "B" elpher-binary) - (?g elpher-get-image-node "im" elpher-image) - (?p elpher-get-image-node "im" elpher-image) - (?I elpher-get-image-node "im" elpher-image) - (?h elpher-get-url-node "W" elpher-url)) - "Association list from types to getters, margin codes and index faces.") + '(((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) + ((special start) elpher-get-start-node nil)) + "Association list from types to getters, renderers, margin codes and index faces.") ;;; Customization group @@ -122,47 +103,55 @@ ;; Face customizations (defface elpher-index - '((t :inherit org-drawer)) + '((t :inherit font-lock-keyword-face)) "Face used for directory type directory records.") (defface elpher-text - '((t :inherit org-tag)) + '((t :inherit bold)) "Face used for text type directory records.") (defface elpher-info - '((t :inherit org-default)) + '((t :inherit default)) "Face used for info type directory records.") (defface elpher-image - '((t :inherit org-level-4)) + '((t :inherit font-lock-string-face)) "Face used for image type directory records.") (defface elpher-search - '((t :inherit org-level-5)) + '((t :inherit warning)) "Face used for search type directory records.") -(defface elpher-url - '((t :inherit org-level-6)) - "Face used for url type directory records.") +(defface elpher-html + '((t :inherit font-lock-comment-face)) + "Face used for html type directory records.") + +(defface elpher-gemini + '((t :inherit font-lock-regexp-grouping-backslash)) + "Face used for html type directory records.") + +(defface elpher-other-url + '((t :inherit font-lock-comment-face)) + "Face used for other URL type links records.") (defface elpher-telnet - '((t :inherit org-level-6)) + '((t :inherit font-lock-function-name-face)) "Face used for telnet type directory records.") (defface elpher-binary - '((t :inherit org-level-7)) + '((t :inherit font-lock-doc-face)) "Face used for binary type directory records.") (defface elpher-unknown - '((t :inherit org-warning)) + '((t :inherit error)) "Face used for directory records with unknown/unsupported types.") (defface elpher-margin-key - '((t :inherit org-tag)) + '((t :inherit bold)) "Face used for directory margin key.") (defface elpher-margin-brackets - '((t :inherit org-special-keyword)) + '((t :inherit shadow)) "Face used for brackets around directory margin key.") ;; Other customizations @@ -172,132 +161,258 @@ Otherwise, use the system browser via the BROWSE-URL function." :type '(boolean)) -(defcustom elpher-buttonify-urls-in-directories nil +(defcustom elpher-buttonify-urls-in-directories t "If non-nil, turns URLs matched in directories into clickable buttons." :type '(boolean)) -(defcustom elpher-cache-images nil - "If non-nil, cache images in memory in the same way as other content." - :type '(boolean)) - -(defcustom elpher-start-address nil - "If nil, the default start directory is shown when Elpher is started. -Otherwise, a list containing the selector, host and port of a directory to -use as the start page." - :type '(list string string integer)) - (defcustom elpher-use-header t "If non-nil, display current node 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)) + + ;;; Model ;; ;; Address -(defun elpher-make-address (type selector host port) - "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT." - (list type selector host port)) +;; An elpher "address" object is either a url object or a symbol. +;; Symbol addresses are "special", corresponding to pages generated +;; dynamically for and by elpher. All others represent pages which +;; rely on content retrieved over the network. + +(defun elpher-address-from-url (url-string) + "Create a ADDRESS object corresponding to the given URL-STRING." + (let ((data (match-data))) ; Prevent parsing clobbering match data + (unwind-protect + (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")) + (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"))) + (when (equal "gemini" (url-type url)) + ;; Gemini defaults + (if (equal (url-filename url) "") + (setf (url-filename url) "/")))) + url) + (set-match-data data)))) + +(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 + ((and (equal type ?h) + (string-prefix-p "URL:" selector)) + (elpher-address-from-url (elt (split-string selector "URL:") 1))) + ((equal type ?8) + (elpher-address-from-url + (concat "telnet" + "://" host + ":" (number-to-string port)))) + (t + (elpher-address-from-url + (concat "gopher" (if tls "s" "") + "://" host + ":" (number-to-string port) + "/" (string type) + selector))))) + +(defun elpher-make-special-address (type) + "Create an ADDRESS object corresponding to the given special page 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)) (defun elpher-address-type (address) - "Retrieve type from ADDRESS." - (elt address 0)) - -(defun elpher-address-selector (address) - "Retrieve selector from ADDRESS." - (elt address 1)) + "Retrieve type of ADDRESS object. +This is used to determine how to retrieve and render the document the +address refers to, via the table `elpher-type-map'." + (if (symbolp address) + (list 'special address) + (let ((protocol (url-type address))) + (cond ((or (equal protocol "gopher") + (equal protocol "gophers")) + (list 'gopher + (if (member (url-filename address) '("" "/")) + ?1 + (string-to-char (substring (url-filename address) 1))))) + ((equal protocol "gemini") + 'gemini) + ((equal protocol "telnet") + 'telnet) + (t 'other-url))))) + +(defun elpher-address-protocol (address) + "Retrieve the transport protocol for ADDRESS. This is nil for special addresses." + (if (symbolp address) + nil + (url-type address))) + +(defun elpher-address-filename (address) + "Retrieve the filename component of ADDRESS. +For gopher addresses this is a combination of the selector type and selector." + (if (symbolp address) + nil + (url-filename address))) (defun elpher-address-host (address) - "Retrieve host from ADDRESS." - (elt address 2)) + "Retrieve host from ADDRESS object." + (url-host address)) (defun elpher-address-port (address) - "Retrieve port from ADDRESS." - (elt address 3)) + "Retrieve port from ADDRESS object." + (if (symbolp address) + nil) + (if (> (url-port address) 0) + (url-port address) + (or (and (or (equal (url-type address) "gopher") + (equal (url-type address) "gophers")) + 70) + (and (equal (url-type address) "gemini") + 1965)))) + +(defun elpher-address-special-p (address) + "Return non-nil if ADDRESS object is special (e.g. start page, bookmarks 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")))) + +(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 parent address &optional content pos) - "Create a node in the gopher page hierarchy. +(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. -PARENT specifies the parent of the node, and ADDRESS specifies the -address of the gopher page. +ADDRESS specifies the address object of the page. -The optional arguments CONTENT and POS can be used to fill the cached -content and cursor position fields of the node." - (list display-string parent address content pos)) +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-parent (node) - "Retrieve the parent node of NODE." +(defun elpher-node-address (node) + "Retrieve the ADDRESS object of NODE." (elt node 1)) -(defun elpher-node-address (node) - "Retrieve the address of NODE." +(defun elpher-node-parent (node) + "Retrieve the parent node of NODE." (elt node 2)) -(defun elpher-node-content (node) - "Retrieve the cached content of NODE, or nil if none exists." - (elt node 3)) +(defun elpher-set-node-parent (node parent) + "Set the parent node of NODE to be PARENT." + (setcar (cdr (cdr node)) parent)) + +;; Cache -(defun elpher-node-pos (node) - "Retrieve the cached cursor position for NODE, or nil if none exists." - (elt node 4)) +(defvar elpher-content-cache (make-hash-table :test 'equal)) +(defvar elpher-pos-cache (make-hash-table :test 'equal)) -(defun elpher-set-node-content (node content) - "Set the content cache of NODE to CONTENT." - (setcar (nthcdr 3 node) content)) +(defun elpher-get-cached-content (address) + "Retrieve the cached content for ADDRESS, or nil if none exists." + (gethash address elpher-content-cache)) -(defun elpher-set-node-pos (node pos) - "Set the cursor position cache of NODE to POS." - (setcar (nthcdr 4 node) pos)) +(defun elpher-cache-content (address content) + "Set the content cache for ADDRESS to CONTENT." + (puthash address content elpher-content-cache)) + +(defun elpher-get-cached-pos (address) + "Retrieve the cached cursor position for ADDRESS, or nil if none exists." + (gethash address elpher-pos-cache)) + +(defun elpher-cache-pos (address pos) + "Set the cursor position cache for ADDRESS to POS." + (puthash address pos elpher-pos-cache)) ;; Node graph traversal (defvar elpher-current-node nil) -(defun elpher-visit-node (node &optional getter) - "Visit NODE using its own getter or GETTER, if non-nil." +(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." (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) - (with-current-buffer "*elpher*" - (setq header-line-format "hello")) - ;; (let ((inhibit-read-only t)) - - ;; (force-mode-line-update)) - (if getter - (funcall getter) - (let* ((address (elpher-node-address node)) - (type (if address - (elpher-address-type address) - ?1))) - (funcall (car (alist-get type elpher-type-map)))))) + (let* ((address (elpher-node-address node)) + (type (elpher-address-type address)) + (type-record (cdr (assoc type elpher-type-map)))) + (if type-record + (funcall (car type-record) + (if renderer + renderer + (cadr type-record))) + (elpher-visit-parent-node) + (pcase type + (`(gopher ,type-char) + (error "Unsupported gopher selector type '%c' for '%s'" + type-char (elpher-address-to-url address))) + (other + (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)))) + (elpher-visit-node parent-node nil t)))) (defun elpher-reload-current-node () "Reload the current node, discarding any existing cached content." - (elpher-set-node-content elpher-current-node nil) + (elpher-cache-content (elpher-node-address elpher-current-node) nil) (elpher-visit-node elpher-current-node)) (defun elpher-save-pos () "Save the current position of point to the current node." (when elpher-current-node - (elpher-set-node-pos elpher-current-node (point)))) + (elpher-cache-pos (elpher-node-address elpher-current-node) (point)))) (defun elpher-restore-pos () "Restore the position of point to that cached in the current node." - (let ((pos (elpher-node-pos elpher-current-node))) + (let ((pos (elpher-get-cached-pos (elpher-node-address elpher-current-node)))) (if pos (goto-char pos) (goto-char (point-min))))) @@ -309,7 +424,14 @@ content and cursor position fields of the node." (defun elpher-update-header () "If `elpher-use-header' is true, display current node info in window header." (if elpher-use-header - (setq header-line-format (elpher-node-display-string elpher-current-node)))) + (let* ((display-string (elpher-node-display-string elpher-current-node)) + (address (elpher-node-address elpher-current-node)) + (url-string (if (elpher-address-special-p address) + "" + (concat " - " (elpher-address-to-url address) ""))) + (header (replace-regexp-in-string "%" "%%" (concat display-string + url-string)))) + (setq header-line-format header)))) (defmacro elpher-with-clean-buffer (&rest args) "Evaluate ARGS with a clean *elpher* buffer as current." @@ -321,36 +443,140 @@ content and cursor position fields of the node." args))) -;;; Index rendering +;;; Text Processing ;; +(defvar elpher-user-coding-system nil + "User-specified coding system to use for decoding text responses.") + +(defun elpher-decode (string) + "Decode STRING using autodetected or user-specified coding system." + (decode-coding-string string + (if elpher-user-coding-system + elpher-user-coding-system + (detect-coding-string string t)))) + (defun elpher-preprocess-text-response (string) - "Clear away CRs and terminating period from STRING." - (replace-regexp-in-string "\n\.\n$" "\n" - (replace-regexp-in-string "\r" "" - string))) + "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" + (replace-regexp-in-string "\r" "" string)))) + + +;;; Network error reporting +;; + +(defun elpher-network-error (address error) + "Display ERROR message following unsuccessful negotiation with ADDRESS." + (elpher-with-clean-buffer + (insert (propertize "\n---- ERROR -----\n\n" 'face 'error) + "When attempting to retrieve " (elpher-address-to-url address) ":\n" + (error-message-string error) ".\n" + (propertize "\n----------------\n\n" 'face 'error) + "Press 'u' to return to the previous page."))) + + +;;; Gopher selector retrieval +;; + +(defun elpher-process-cleanup () + "Immediately shut down any extant elpher process." + (let ((p (get-process "elpher-process"))) + (if p (delete-process p)))) + +(defvar elpher-use-tls nil + "If non-nil, use TLS to communicate with gopher servers.") + +(defvar elpher-selector-string) + +(defun elpher-get-selector (address after &optional propagate-error) + "Retrieve selector specified by ADDRESS, then execute AFTER. +The result is stored as a string in the variable ‘elpher-selector-string’. + +Usually errors result in an error page being displayed. This is only +appropriate if the selector is to be directly viewed. If PROPAGATE-ERROR +is non-nil, this message is not displayed. Instead, the error propagates +up to the calling function." + (setq elpher-selector-string "") + (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"))) + (condition-case the-error + (let* ((kill-buffer-query-functions nil) + (proc (open-network-stream "elpher-process" + nil + (elpher-address-host address) + (elpher-address-port address) + :type (if elpher-use-tls 'tls 'plain)))) + (set-process-coding-system proc 'binary) + (set-process-filter proc + (lambda (_proc string) + (setq elpher-selector-string + (concat elpher-selector-string string)))) + (set-process-sentinel proc after) + (process-send-string proc + (concat (elpher-gopher-address-selector address) "\n"))) + (error + (if (and (consp the-error) + (eq (car the-error) 'gnutls-error) + (not (equal (elpher-address-protocol address) "gophers")) + (or elpher-auto-disengage-TLS + (yes-or-no-p "Could not establish encrypted connection. Disable TLS mode? "))) + (progn + (message "Disengaging TLS gopher mode.") + (setq elpher-use-tls nil) + (elpher-get-selector address after)) + (elpher-process-cleanup) + (if propagate-error + (error the-error) + (elpher-with-clean-buffer + (insert (propertize "\n---- ERROR -----\n\n" 'face 'error) + "Failed to connect to " (elpher-address-to-url address) ".\n" + (propertize "\n----------------\n\n" 'face 'error) + "Press 'u' to return to the previous page."))))))) + +(defun elpher-get-gopher-node (renderer) + "Getter function for gopher nodes. +The RENDERER procedure is used to display the contents of the node +once they are retrieved from the gopher server." + (let* ((address (elpher-node-address elpher-current-node)) + (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)")) + (elpher-get-selector address + (lambda (_proc event) + (unless (string-prefix-p "deleted" event) + (funcall renderer elpher-selector-string) + (elpher-restore-pos))))))) + +;; Index rendering (defun elpher-insert-index (string) "Insert the index corresponding to STRING into the current buffer." ;; Should be able to split directly on CRLF, but some non-conformant ;; LF-only servers sadly exist, hence the following. - (let ((str-processed (elpher-preprocess-text-response string)) - formatting-error) + (let ((str-processed (elpher-preprocess-text-response string))) (dolist (line (split-string str-processed "\n")) - (unless (= (length line) 0) - (let* ((type (elt line 0)) - (fields (split-string (substring line 1) "\t")) - (display-string (elt fields 0)) - (selector (elt fields 1)) - (host (elt fields 2)) - (port (if (elt fields 3) - (string-to-number (elt fields 3)) - nil))) - (if (< (length fields) 4) - (setq formatting-error t)) - (elpher-insert-index-record display-string type selector host port)))) - (if formatting-error - (display-warning :warning "One or more badly formatted index records detected.")))) + (ignore-errors + (unless (= (length line) 0) + (let* ((type (elt line 0)) + (fields (split-string (substring line 1) "\t")) + (display-string (elt fields 0)) + (selector (elt fields 1)) + (host (elt fields 2)) + (port (if (elt fields 3) + (string-to-number (elt fields 3)) + nil)) + (address (elpher-make-gopher-address type selector host port))) + (elpher-insert-index-record display-string address))))))) (defun elpher-insert-margin (&optional type-name) "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." @@ -367,24 +593,19 @@ content and cursor position fields of the node." (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))) - (if (eq (elpher-address-type address) ?h) - (let ((url (cadr (split-string (elpher-address-selector address) "URL:")))) - (format "mouse-1, RET: open url '%s'" url)) - (format "mouse-1, RET: open '%s' on %s port %s" - (elpher-address-selector address) - (elpher-address-host address) - (elpher-address-port address))))) - -(defun elpher-insert-index-record (display-string type selector host port) + (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))) + +(defun elpher-insert-index-record (display-string &optional address) "Function to insert an index record into the current buffer. -The contents of the record are dictated by TYPE, DISPLAY-STRING, SELECTOR, HOST -and PORT." - (let ((address (elpher-make-address type selector host port)) - (type-map-entry (alist-get type elpher-type-map))) +The contents of the record are dictated by DISPLAY-STRING and ADDRESS. +If ADDRESS is not supplied or nil the record is rendered as an +'information' line." + (let* ((type (if address (elpher-address-type address) nil)) + (type-map-entry (cdr (assoc type elpher-type-map)))) (if type-map-entry - (let* ((margin-code (cadr type-map-entry)) - (face (caddr type-map-entry)) - (node (elpher-make-node display-string elpher-current-node address))) + (let* ((margin-code (elt type-map-entry 2)) + (face (elt type-map-entry 3)) + (node (elpher-make-node display-string address))) (elpher-insert-margin margin-code) (insert-text-button display-string 'face face @@ -393,17 +614,17 @@ and PORT." 'follow-link t 'help-echo (elpher-node-button-help node))) (pcase type - (?i ;; Information + ((or '(gopher ?i) 'nil) ;; Information (elpher-insert-margin) - (insert (propertize - (if elpher-buttonify-urls-in-directories - (elpher-buttonify-urls display-string) - display-string) - 'face 'elpher-info))) - (other ;; Unknown - (elpher-insert-margin (concat (char-to-string type) "?")) + (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)))) + (`(gopher ,selector-type) ;; Unknown + (elpher-insert-margin (concat (char-to-string selector-type) "?")) (insert (propertize display-string - 'face 'elpher-unknown-face))))) + 'face 'elpher-unknown))))) (insert "\n"))) (defun elpher-click-link (button) @@ -411,98 +632,20 @@ and PORT." (let ((node (button-get button 'elpher-node))) (elpher-visit-node node))) +(defun elpher-render-index (data &optional _mime-type-string) + "Render DATA as an index. MIME-TYPE-STRING is unused." + (elpher-with-clean-buffer + (if (not data) + t + (elpher-insert-index data) + (elpher-cache-content (elpher-node-address elpher-current-node) + (buffer-string))))) -;;; Selector retrieval (all kinds) -;; - -(defun elpher-process-cleanup () - "Immediately shut down any extant elpher process." - (let ((p (get-process "elpher-process"))) - (if p (delete-process p)))) - -(defvar elpher-selector-string) - -(defun elpher-get-selector (address after) - "Retrieve selector specified by ADDRESS, then execute AFTER. -The result is stored as a string in the variable ‘elpher-selector-string’." - (setq elpher-selector-string "") - (make-network-process - :name "elpher-process" - :host (elpher-address-host address) - :service (elpher-address-port address) - :filter (lambda (proc string) - (setq elpher-selector-string (concat elpher-selector-string string))) - :sentinel after) - (process-send-string "elpher-process" - (concat (elpher-address-selector address) "\n"))) - -;; Index retrieval - -(defun elpher-get-index-node () - "Getter which retrieves the current node contents as an index." - (let ((content (elpher-node-content elpher-current-node)) - (address (elpher-node-address elpher-current-node))) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (if address - (progn - (elpher-with-clean-buffer - (insert "LOADING DIRECTORY...")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (elpher-insert-index elpher-selector-string) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (buffer-string))))))) - (progn - (elpher-with-clean-buffer - (elpher-insert-index elpher-start-index) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (buffer-string)))))))) - -;; Text retrieval +;; Text rendering (defconst elpher-url-regex - "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?" - "Regexp used to locate and buttinofy URLs in text files loaded by elpher.") - -(defun elpher-make-node-from-matched-url (parent &optional string) - "Convert most recent `elpher-url-regex' match to a node. - -PARENT defines the node to set as the parent to the new node. - -If STRING is non-nil, this is given as an argument to all `match-string' -calls, as is necessary if the match is performed by `string-match'." - (let ((url (match-string 0 string)) - (protocol (downcase (match-string 1 string)))) - (if (string= protocol "gopher") - (let* ((host (match-string 2 string)) - (port (if (> (length (match-string 3 string)) 1) - (string-to-number (substring (match-string 3 string) 1)) - 70)) - (type-and-selector (match-string 4 string)) - (type (if (> (length type-and-selector) 1) - (elt type-and-selector 1) - ?1)) - (selector (if (> (length type-and-selector) 1) - (substring type-and-selector 2) - "")) - (address (elpher-make-address type selector host port))) - (elpher-make-node url elpher-current-node address)) - (let* ((host (match-string 2 string)) - (port (if (> (length (match-string 3 string)) 1) - (string-to-number (substring (match-string 3 string) 1)) - 70)) - (selector (concat "URL:" url)) - (address (elpher-make-address ?h selector host port))) - (elpher-make-node url elpher-current-node address))))) - + "\\([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." @@ -510,186 +653,444 @@ calls, as is necessary if the match is performed by `string-match'." (insert string) (goto-char (point-min)) (while (re-search-forward elpher-url-regex nil t) - (let ((node (elpher-make-node-from-matched-url elpher-current-node))) + (let ((node (elpher-make-node (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)))) + 'help-echo (elpher-node-button-help node) + 'face 'button))) (buffer-string))) -(defun elpher-get-text-node () - "Getter which retrieves the current node contents as a text document." - (let ((content (elpher-node-content elpher-current-node)) - (address (elpher-node-address elpher-current-node))) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (progn - (elpher-with-clean-buffer - (insert "LOADING TEXT...")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (insert (elpher-buttonify-urls - (elpher-preprocess-text-response - elpher-selector-string))) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (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))) + (elpher-cache-content + (elpher-node-address elpher-current-node) + (buffer-string))))) ;; Image retrieval -(defun elpher-get-image-node () - "Getter which retrieves the current node contents as an image to view." - (let ((content (elpher-node-content elpher-current-node)) - (address (elpher-node-address elpher-current-node))) - (if content +(defun elpher-render-image (data &optional _mime-type-string) + "Display DATA as image. MIME-TYPE-STRING is unused." + (if (not data) + nil + (if (display-images-p) (progn - (elpher-with-clean-buffer - (insert-image content) - (elpher-restore-pos))) - (if (display-images-p) - (progn + (let ((image (create-image + data + nil t))) (elpher-with-clean-buffer - (insert "LOADING IMAGE...")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (let ((image (create-image - (encode-coding-string - elpher-selector-string - 'no-conversion) - nil t))) - (elpher-with-clean-buffer - (insert-image image) - (elpher-restore-pos)) - (if elpher-cache-images - (elpher-set-node-content elpher-current-node - image))))))) - (elpher-get-node-download))))) - -;; Search retrieval - -(defun elpher-get-search-node () - "Getter which submits a search query to the address of the current node." - (let ((content (elpher-node-content elpher-current-node)) - (address (elpher-node-address elpher-current-node)) - (aborted t)) - (if content - (progn - (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos)) - (message "Displaying cached search results. Reload to perform a new search.")) + (insert-image image) + (elpher-restore-pos)))) + (elpher-render-download data)))) + +;; Search retrieval and rendering + +(defun elpher-get-gopher-query-node (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)) + (if (and content (funcall renderer nil)) + (elpher-with-clean-buffer + (insert content) + (elpher-restore-pos) + (message "Displaying cached search results. Reload to perform a new search.")) (unwind-protect (let* ((query-string (read-string "Query: ")) - (query-selector (concat (elpher-address-selector address) "\t" query-string)) - (search-address (elpher-make-address ?1 - query-selector - (elpher-address-host address) - (elpher-address-port address)))) + (query-selector (concat (elpher-gopher-address-selector address) "\t" query-string)) + (search-address (elpher-make-gopher-address ?1 + query-selector + (elpher-address-host address) + (elpher-address-port address) + (equal (elpher-address-type address) "gophers")))) (setq aborted nil) + (elpher-with-clean-buffer - (insert "LOADING RESULTS...")) + (insert "LOADING RESULTS... (use 'u' to cancel)")) (elpher-get-selector search-address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (elpher-insert-index elpher-selector-string)) - (goto-char (point-min)) - (elpher-set-node-content elpher-current-node - (buffer-string)))))) + (lambda (_proc event) + (unless (string-prefix-p "deleted" event) + (funcall renderer elpher-selector-string) + (elpher-restore-pos))))) (if aborted (elpher-visit-parent-node)))))) - -;; Raw server response retrieval - -(defun elpher-get-node-raw () - "Getter which retrieves the raw server response for the current node." - (let* ((content (elpher-node-content elpher-current-node)) - (address (elpher-node-address elpher-current-node))) - (elpher-with-clean-buffer - (insert "LOADING RAW SERVER RESPONSE...")) - (if address - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (elpher-with-clean-buffer - (insert elpher-selector-string) - (goto-char (point-min)))))) - (progn - (elpher-with-clean-buffer - (insert elpher-start-index)) - (goto-char (point-min))))) - (message "Displaying raw server response. Reload or redraw to return to standard view.")) -;; File export retrieval - -(defvar elpher-download-filename) +;; Raw server response rendering -(defun elpher-get-node-download () - "Getter which retrieves the current node and writes the result to a file." +(defun elpher-render-raw (data &optional _mime-type-string) + "Display raw DATA in buffer. MIME-TYPE-STRING is unused." + (if (not data) + nil + (elpher-with-clean-buffer + (insert data) + (goto-char (point-min))) + (message "Displaying raw server response. Reload or redraw to return to standard view."))) + +;; File save "rendering" + +(defun elpher-render-download (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* ((filename-proposal (file-name-nondirectory selector)) + (filename (read-file-name "Download complete. Save file as: " + nil nil nil + (if (> (length filename-proposal) 0) + filename-proposal + "download.file")))) + (let ((coding-system-for-write 'binary)) + (with-temp-file filename + (insert data))) + (message (format "Saved to file %s." filename)))))) + +;; HTML rendering + +(defun elpher-render-html (data &optional _mime-type-string) + "Render DATA as HTML using shr. MIME-TYPE-STRING is unused." + (elpher-with-clean-buffer + (if (not data) + t + (let ((dom (with-temp-buffer + (insert data) + (libxml-parse-html-region (point-min) (point-max))))) + (shr-insert-document dom))))) + +;; Gemini node retrieval + +(defvar elpher-gemini-response) + +(defun elpher-get-gemini-response (address after) + "Retrieve gemini ADDRESS, then execute AFTER. +The response is stored in the variable ‘elpher-gemini-response’." + (setq elpher-gemini-response "") + (if (not (gnutls-available-p)) + (error "Cannot retrieve TLS selector: GnuTLS not available") + (condition-case the-error + (let* ((kill-buffer-query-functions nil) + (proc (open-network-stream "elpher-process" + nil + (elpher-address-host address) + (elpher-address-port address) + :type 'tls))) + (set-process-coding-system proc 'binary) + (set-process-filter proc + (lambda (_proc string) + (setq elpher-gemini-response + (concat elpher-gemini-response string)))) + (set-process-sentinel proc after) + (process-send-string proc + (concat (elpher-address-to-url address) "\r\n"))) + (error + (error "Error initiating connection to server"))))) + +(defun elpher-parse-gemini-response (response) + "Parse the RESPONSE string and return a list of components +The list is of the form (code meta body). A response of nil implies +that the response was malformed." + (let ((header-end-idx (string-match "\r\n" response))) + (if header-end-idx + (let ((header (string-trim (substring response 0 header-end-idx))) + (body (substring response (+ header-end-idx 2)))) + (if (>= (length header) 2) + (let ((code (substring header 0 2)) + (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")))) + + +(defun elpher-process-gemini-response (renderer) + "Process the gemini response and pass the result to RENDERER. +The response is assumed to be in the variable `elpher-gemini-response'." + (condition-case the-error + (let ((response-components (elpher-parse-gemini-response elpher-gemini-response))) + (let ((response-code (elt response-components 0)) + (response-meta (elt response-components 1)) + (response-body (elt response-components 2))) + (pcase (elt response-code 0) + (?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)))) + (elpher-get-gemini-response query-address + (lambda (_proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos)))))) + (?2 ; Normal response + ;; (message response-header) + (funcall renderer response-body response-meta)) + (?3 ; Redirect + (message "Following redirect to %s" response-meta) + (let ((redirect-address (elpher-address-from-gemini-url response-meta))) + (elpher-get-gemini-response redirect-address + (lambda (_proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos)))))) + (?4 ; Temporary failure + (error "Gemini server reports TEMPORARY FAILURE for this request: %s %s" + response-code response-meta)) + (?5 ; Permanent 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)")) + (_other + (error "Gemini server response unknown: %s %s" + response-code response-meta))))) + (error + (elpher-network-error (elpher-node-address elpher-current-node) the-error)))) + +(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)) - (selector (elpher-address-selector address))) - (elpher-visit-parent-node) ; Do first in case of non-local exits. - (let* ((filename-proposal (file-name-nondirectory selector)) - (filename (read-file-name "Save file as: " - nil nil nil - (if (> (length filename-proposal) 0) - filename-proposal - "gopher.file")))) - (message "Downloading...") - (setq elpher-download-filename filename) - (elpher-get-selector address - (lambda (proc event) - (let ((coding-system-for-write 'binary)) - (with-temp-file elpher-download-filename - (insert elpher-selector-string) - (message (format "Download complate, saved to file %s." - elpher-download-filename))))))))) + (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)) + (elpher-with-clean-buffer + (insert "LOADING GEMINI... (use 'u' to cancel)")) + (elpher-get-gemini-response address + (lambda (_proc event) + (unless (string-prefix-p "deleted" event) + (funcall #'elpher-process-gemini-response + renderer) + (elpher-restore-pos))))) + (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) + t + (let* ((mime-type-string* (if (or (not mime-type-string) + (string-empty-p mime-type-string)) + "text/gemini; charset=utf-8" + mime-type-string)) + (mime-type-split (split-string mime-type-string* ";" t)) + (mime-type (string-trim (car mime-type-split))) + (parameters (mapcar (lambda (s) + (let ((key-val (split-string s "="))) + (list (downcase (string-trim (car key-val))) + (downcase (string-trim (cadr key-val)))))) + (cdr mime-type-split)))) + (when (string-prefix-p "text/" mime-type) + (setq body (decode-coding-string + body + (if (assoc "charset" parameters) + (intern (cadr (assoc "charset" parameters))) + 'utf-8))) + (setq body (replace-regexp-in-string "\r" "" body))) + (pcase mime-type + ((or "text/gemini" "") + (elpher-render-gemini-map body parameters)) + ((pred (string-prefix-p "text/")) + (elpher-render-gemini-plain-text body parameters)) + ((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))) + (idx (string-match "[ \t]" rest))) + (if idx + (string-trim (substring rest (+ idx 1))) + ""))) + +(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))) + (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls + (setf (url-fullness address) t) + (unless (url-host address) ;if there is an explicit host, filenames are absolute + (setf (url-host address) (url-host (elpher-node-address elpher-current-node))) + (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))) + (url-filename address))))) + (unless (url-type address) + (setf (url-type address) "gemini"))) + address)) + +(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))) + (elpher-cache-content + (elpher-node-address elpher-current-node) + (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)) + (elpher-cache-content + (elpher-node-address elpher-current-node) + (buffer-string)))) -;; URL retrieval +;; Other URL node opening -(defun elpher-get-url-node () - "Getter which attempts to open the URL specified by the current node." +(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)) - (selector (elpher-address-selector address))) - (elpher-visit-parent-node) ; Do first in case of non-local exits. - (let ((url (elt (split-string selector "URL:") 1))) + (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))))) ;; Telnet node connection -(defun elpher-get-telnet-node () - "Getter which opens a telnet connection to the server specified by the current node." +(defun elpher-get-telnet-node (renderer) + "Opens a telnet connection to the current node address (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for telnet URLs")) (let* ((address (elpher-node-address elpher-current-node)) (host (elpher-address-host address)) (port (elpher-address-port address))) (elpher-visit-parent-node) (telnet host port))) +;; Start page node retrieval + +(defun elpher-get-start-node (renderer) + "Getter which displays the start page (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for start page")) + (elpher-with-clean-buffer + (insert " --------------------------------------------\n" + " Elpher Gopher Client \n" + " version " elpher-version "\n" + " --------------------------------------------\n" + "\n" + "Default bindings:\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" + " - 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" + " - 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" + " - T: toggle TLS gopher mode\n" + " - .: display the raw server response for the current page\n" + "\n" + "Start your exploration of gopher space:\n") + (elpher-insert-index-record "Floodgap Systems Gopher Server" + (elpher-make-gopher-address ?1 "" "gopher.floodgap.com" 70)) + (insert "\n" + "Alternatively, select the following item and enter some search terms:\n") + (elpher-insert-index-record "Veronica-2 Gopher Search Engine" + (elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70)) + (insert "\n" + "** Refer to the ") + (let ((help-string "RET,mouse-1: Open Elpher info manual (if available)")) + (insert-text-button "Elpher info manual" + 'face 'link + 'action (lambda (_) + (interactive) + (info "(elpher)")) + 'follow-link t + 'help-echo help-string)) + (insert " for the full documentation. **\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.)") + 'face 'shadow)) + (elpher-restore-pos))) + +;; Bookmarks page node retrieval + +(defun elpher-get-bookmarks-node (renderer) + "Getter to load and display the current bookmark list (RENDERER must be nil)." + (when renderer + (elpher-visit-parent-node) + (error "Command not supported for bookmarks page")) + (elpher-with-clean-buffer + (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"))) + (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 " + (locate-user-emacs-file "elpher-bookmarks")) + (elpher-restore-pos))) + ;;; Bookmarks ;; -(defun elpher-make-bookmark (display-string address) +(defun elpher-make-bookmark (display-string url) "Make an elpher bookmark. DISPLAY-STRING determines how the bookmark will appear in the -bookmark list, while ADDRESS is the address of the entry." - (list display-string address)) +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-bookmark-address (bookmark) +(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)) @@ -698,81 +1099,50 @@ bookmark list, while ADDRESS is the address of the entry." 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." - (with-temp-buffer - (ignore-errors - (insert-file-contents (locate-user-emacs-file "elpher-bookmarks")) - (goto-char (point-min)) - (read (current-buffer))))) - -(defun elpher-add-node-bookmark (node) - "Add bookmark to NODE to the saved list of bookmarks." - (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node) - (elpher-node-address node))) - (bookmarks (elpher-load-bookmarks))) - (add-to-list 'bookmarks bookmark) + (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-node-bookmark (node) - "Remove bookmark to NODE from the saved list of bookmarks." - (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node) - (elpher-node-address node)))) +(defun elpher-remove-address-bookmark (address) + "Remove any bookmark to ADDRESS." + (let ((url (elpher-address-to-url address))) (elpher-save-bookmarks - (seq-filter (lambda (this-bookmark) - (not (equal bookmark this-bookmark))) + (seq-filter (lambda (bookmark) + (not (equal (elpher-bookmark-url bookmark) url))) (elpher-load-bookmarks))))) - -(defun elpher-display-bookmarks () - "Display saved bookmark list." - (interactive) - (elpher-with-clean-buffer - (insert "Use 'r' to return to the previous page.\n\n" - "---- Bookmark list ----\n\n") - (let ((bookmarks (elpher-load-bookmarks))) - (if bookmarks - (dolist (bookmark bookmarks) - (let ((display-string (elpher-bookmark-display-string bookmark)) - (address (elpher-bookmark-address bookmark))) - (elpher-insert-index-record display-string - (elpher-address-type address) - (elpher-address-selector address) - (elpher-address-host address) - (elpher-address-port address)))) - (insert "No bookmarks found.\n"))) - (insert "\n-----------------------") - (goto-char (point-min)) - (elpher-next-link))) - -(defun elpher-bookmark-current () - "Bookmark the current node." - (interactive) - (elpher-add-node-bookmark elpher-current-node)) -(defun elpher-bookmark-link () - "Bookmark the link at point." - (interactive) - (let ((button (button-at (point)))) - (if button - (elpher-add-node-bookmark (button-get button 'elpher-node)) - (error "No link selected")))) - -(defun elpher-unbookmark-current () - "Remove bookmark for the current node." - (interactive) - (elpher-remove-node-bookmark elpher-current-node)) - -(defun elpher-unbookmark-link () - "Remove bookmark for the link at point." - (interactive) - (let ((button (button-at (point)))) - (if button - (elpher-remove-node-bookmark (button-get button 'elpher-node)) - (error "No link selected")))) - -;;; Interactive navigation procedures +;;; Interactive procedures ;; (defun elpher-next-link () @@ -791,44 +1161,57 @@ Beware that this completely replaces the existing contents of the file." (push-button)) (defun elpher-go () - "Go to a particular gopher site." + "Go to a particular gopher site read from the minibuffer." (interactive) (let ((node - (let ((host-or-url (read-string "Gopher host or URL: "))) - (if (string-match elpher-url-regex host-or-url) - (elpher-make-node-from-matched-url elpher-current-node - host-or-url) - (let ((selector (read-string "Selector (default none): " nil nil "")) - (port (string-to-number (read-string "Port (default 70): " - nil nil 70)))) - (elpher-make-node (concat "gopher://" host-or-url - ":" port - "/1" selector) - elpher-current-node - (elpher-make-address ?1 selector host-or-url port))))))) + (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))) -(defun elpher-redraw () +(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))))))) + +(defun elpher-redraw () "Redraw current page." (interactive) (if elpher-current-node (elpher-visit-node elpher-current-node) (message "No current site."))) -(defun elpher-reload () +(defun elpher-reload () "Reload current page." (interactive) (if elpher-current-node (elpher-reload-current-node) (message "No current site."))) +(defun elpher-toggle-tls () + "Toggle TLS encryption mode." + (interactive) + (setq elpher-use-tls (not elpher-use-tls)) + (if elpher-use-tls + (if (gnutls-available-p) + (message "TLS gopher mode enabled. (Will not affect current page until reload.)") + (setq elpher-use-tls nil) + (error "Cannot enable TLS gopher mode: GnuTLS not available")) + (message "TLS gopher mode disabled. (Will not affect current page until reload.)"))) + (defun elpher-view-raw () - "View current page as plain text." + "View raw server response for current page." (interactive) (if elpher-current-node - (elpher-visit-node elpher-current-node - #'elpher-get-node-raw) + (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."))) (defun elpher-back () @@ -844,28 +1227,42 @@ Beware that this completely replaces the existing contents of the file." (let ((button (button-at (point)))) (if button (let ((node (button-get button 'elpher-node))) - (if node - (elpher-visit-node (button-get button 'elpher-node) - #'elpher-get-node-download) - (error "Can only download gopher links, not general URLs"))) + (if (elpher-address-special-p (elpher-node-address node)) + (error "Cannot download %s" + (elpher-node-display-string node)) + (elpher-visit-node (button-get button 'elpher-node) + #'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)) + (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-render-download + t))) + (defun elpher-build-link-map () "Build alist mapping link names to destination nodes in current buffer." (let ((link-map nil) (b (next-button (point-min) t))) (while b - (add-to-list 'link-map (cons (button-label b) b)) + (push (cons (button-label b) b) link-map) (setq b (next-button (button-start b)))) link-map)) -(defun elpher-menu () +(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))) (if link-map (let ((key (let ((completion-ignore-case t)) - (completing-read "Directory entry/link (tab to autocomplete): " + (completing-read "Directory item/link: " link-map nil t)))) (if (and key (> (length key) 0)) (let ((b (cdr (assoc key link-map)))) @@ -876,31 +1273,91 @@ Beware that this completely replaces the existing contents of the file." "Visit root of current server." (interactive) (let ((address (elpher-node-address elpher-current-node))) - (if address - (let ((host (elpher-address-host address)) - (selector (elpher-address-selector address)) - (port (elpher-address-port address))) - (if (> (length selector) 0) - (let ((root-address (elpher-make-address ?1 "" host port))) - (elpher-visit-node - (elpher-make-node (concat "gopher://" host - ":" (number-to-string port) - "/1/") - elpher-current-node - root-address))) - (error "Already at root directory of current server"))) - (error "Command invalid for Elpher start page")))) + (if (not (elpher-address-special-p address)) + (if (or (member (url-filename address) '("/" "")) + (and (elpher-address-gopher-p address) + (= (length (elpher-gopher-address-selector address)) 0))) + (error "Already at root directory of current server") + (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)))) + +(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))) - (if address - (message "`%s' on %s port %s" - (elpher-address-selector address) - (elpher-address-host address) - (elpher-address-port address)) - (message "%s" display-string)))) + (if (elpher-address-special-p address) + (message "Special page: %s" display-string) + (message (elpher-address-to-url address))))) (defun elpher-info-link () "Display information on node corresponding to link at point." @@ -915,25 +1372,14 @@ Beware that this completely replaces the existing contents of the file." (interactive) (elpher-info-node elpher-current-node)) -(defun elpher-get-address-url (address) - "Get URL representation of ADDRESS." - (concat "gopher://" - (elpher-address-host address) - (let ((port (elpher-address-port address))) - (if (equal port 70) - "" - (format ":%d" port))) - "/" (string (elpher-address-type address)) - (elpher-address-selector address))) - (defun elpher-copy-node-url (node) "Copy URL representation of address of NODE to `kill-ring'." (let ((address (elpher-node-address node))) - (if address - (let ((url (elpher-get-address-url address))) - (message url) - (kill-new url)) - (error (format "Cannot represent %s as URL" (elpher-node-display-string node)))))) + (if (elpher-address-special-p address) + (error (format "Cannot represent %s as URL" (elpher-node-display-string node))) + (let ((url (elpher-address-to-url address))) + (message "Copied \"%s\" to kill-ring/clipboard." url) + (kill-new url))))) (defun elpher-copy-link-url () "Copy URL of item at point to `kill-ring'." @@ -948,6 +1394,16 @@ Beware that this completely replaces the existing contents of the file." (interactive) (elpher-copy-node-url elpher-current-node)) +(defun elpher-set-gopher-coding-system () + "Specify an explicit character coding system for gopher selectors." + (interactive) + (let ((system (read-coding-system "Set coding system to use for gopher (default is to autodetect): " nil))) + (setq elpher-user-coding-system system) + (if system + (message "Gopher coding system fixed to %s. (Reload to see effect)." system) + (message "Gopher coding system set to autodetect. (Reload to see effect).")))) + + ;;; Mode and keymap ;; @@ -956,30 +1412,43 @@ Beware that this completely replaces the existing contents of the file." (define-key map (kbd "TAB") 'elpher-next-link) (define-key map (kbd "") 'elpher-prev-link) (define-key map (kbd "u") 'elpher-back) + (define-key map [mouse-3] 'elpher-back) (define-key map (kbd "O") 'elpher-root-dir) (define-key map (kbd "g") 'elpher-go) + (define-key map (kbd "o") 'elpher-go-current) (define-key map (kbd "r") 'elpher-redraw) (define-key map (kbd "R") 'elpher-reload) - (define-key map (kbd "w") 'elpher-view-raw) + (define-key map (kbd "T") 'elpher-toggle-tls) + (define-key map (kbd ".") 'elpher-view-raw) (define-key map (kbd "d") 'elpher-download) - (define-key map (kbd "m") 'elpher-menu) + (define-key map (kbd "D") 'elpher-download-current) + (define-key map (kbd "m") 'elpher-jump) (define-key map (kbd "i") 'elpher-info-link) (define-key map (kbd "I") 'elpher-info-current) (define-key map (kbd "c") 'elpher-copy-link-url) (define-key map (kbd "C") 'elpher-copy-current-url) - (when (fboundp 'evil-define-key) - (evil-define-key 'motion map + (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) + (when (fboundp 'evil-define-key*) + (evil-define-key* 'motion map (kbd "TAB") 'elpher-next-link - (kbd "C-]") 'elpher-follow-current-link + (kbd "C-") 'elpher-follow-current-link (kbd "C-t") 'elpher-back (kbd "u") 'elpher-back - (kbd "O") 'elpher-root-dir + [mouse-3] 'elpher-back (kbd "g") 'elpher-go + (kbd "o") 'elpher-go-current (kbd "r") 'elpher-redraw (kbd "R") 'elpher-reload - (kbd "w") 'elpher-view-raw + (kbd "T") 'elpher-toggle-tls + (kbd ".") 'elpher-view-raw (kbd "d") 'elpher-download - (kbd "m") 'elpher-menu + (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 @@ -988,16 +1457,22 @@ Beware that this completely replaces the existing contents of the file." (kbd "A") 'elpher-bookmark-current (kbd "x") 'elpher-unbookmark-link (kbd "X") 'elpher-unbookmark-current - (kbd "B") 'elpher-display-bookmarks)) + (kbd "B") 'elpher-bookmarks + (kbd "S") 'elpher-set-gopher-coding-system)) map) "Keymap for gopher client.") (define-derived-mode elpher-mode special-mode "elpher" - "Major mode for elpher, an elisp 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'.") (when (fboundp 'evil-set-initial-state) (evil-set-initial-state 'elpher-mode 'motion)) + ;;; Main start procedure ;; @@ -1010,7 +1485,7 @@ Beware that this completely replaces the existing contents of the file." (switch-to-buffer "*elpher*") (setq elpher-current-node nil) (let ((start-node (elpher-make-node "Elpher Start Page" - nil elpher-start-address))) + (elpher-make-special-address 'start)))) (elpher-visit-node start-node))) "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.