+;;; Global constants
+;;
+
+(defconst elopher-version "1.0.0"
+ "Current version of elopher.")
+
+(defconst elopher-margin-width 6
+ "Width of left-hand margin used when rendering indicies.")
+
+(defconst elopher-start-index
+ (mapconcat
+ 'identity
+ (list "i\tfake\tfake\t1"
+ "i--------------------------------------------\tfake\tfake\t1"
+ "i Elopher Gopher Client \tfake\tfake\t1"
+ (format "i version %s\tfake\tfake\t1" elopher-version)
+ "i--------------------------------------------\tfake\tfake\t1"
+ "i\tfake\tfake\t1"
+ "iBasic usage:\tfake\tfake\t1"
+ "i\tfake\tfake\t1"
+ "i - tab/shift-tab: next/prev directory entry on current page\tfake\tfake\t1"
+ "i - RET/mouse-1: open directory entry under cursor\tfake\tfake\t1"
+ "i - u: return to parent directory entry\tfake\tfake\t1"
+ "i - g: go to a particular 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")
+ "Source for elopher start page.")
+
+
+;;; Customization group
+;;
+
+(defgroup elopher nil
+ "A gopher client."
+ :group 'applications)
+
+(defface elopher-index
+ '((((background dark)) :foreground "deep sky blue")
+ (((background light)) :foreground "blue"))
+ "Face used for index records.")
+
+(defface elopher-text
+ '((((background dark)) :foreground "white")
+ (((background light)) :weight bold))
+ "Face used for text records.")
+
+(defface elopher-info '()
+ "Face used for info records.")
+
+(defface elopher-image
+ '((((background dark)) :foreground "green")
+ (t :foreground "dark green"))
+ "Face used for image records.")
+
+(defface elopher-search
+ '((((background light)) :foreground "orange")
+ (((background dark)) :foreground "dark orange"))
+ "Face used for search records.")
+
+(defface elopher-url
+ '((((background dark)) :foreground "yellow")
+ (((background light)) :foreground "dark red"))
+ "Face used for url records.")
+
+(defface elopher-binary
+ '((t :foreground "magenta"))
+ "Face used for binary records.")
+
+(defface elopher-unknown
+ '((t :foreground "red"))
+ "Face used for unknown record types.")
+
+(defface elopher-margin-key
+ '((((background dark)) :foreground "white"))
+ "Face used for margin key.")
+
+(defface elopher-margin-brackets
+ '((t :foreground "blue"))
+ "Face used for brackets around margin key.")
+
+(defcustom elopher-open-urls-with-eww nil
+ "If non-nil, open URL selectors using eww.
+Otherwise, use the system browser via the BROWSE-URL function."
+ :type '(boolean))
+
+;;; Model
+;;
+
+;; Address
+
+(defun elopher-make-address (selector host port)
+ "Create an address of a gopher object with SELECTOR, HOST and PORT."
+ (list selector host port))
+
+(defun elopher-address-selector (address)
+ "Retrieve selector from ADDRESS."
+ (car address))
+
+(defun elopher-address-host (address)
+ "Retrieve host from ADDRESS."
+ (cadr address))
+
+(defun elopher-address-port (address)
+ "Retrieve port from ADDRESS."
+ (caddr address))
+
+;; Node
+
+(defun elopher-make-node (parent address getter &optional content pos)
+ "Create a node in the gopher page hierarchy.
+
+PARENT specifies the parent of the node, ADDRESS specifies the address of
+the gopher page, GETTER provides the getter function used to obtain this
+page.
+
+The optional arguments CONTENT and POS can be used to fill the cached
+content and cursor position fields of the node."
+ (list parent address getter content pos))
+
+(defun elopher-node-parent (node)
+ "Retrieve the parent node of NODE."
+ (elt node 0))
+
+(defun elopher-node-address (node)
+ "Retrieve the address of NODE."
+ (elt node 1))
+
+(defun elopher-node-getter (node)
+ "Retrieve the preferred getter function of NODE."
+ (elt node 2))
+
+(defun elopher-node-content (node)
+ "Retrieve the cached content of NODE, or nil if none exists."
+ (elt node 3))
+
+(defun elopher-node-pos (node)
+ "Retrieve the cached cursor position for NODE, or nil if none exists."
+ (elt node 4))
+
+(defun elopher-set-node-content (node content)
+ "Set the content cache of NODE to CONTENT."
+ (setcar (nthcdr 3 node) content))
+
+(defun elopher-set-node-pos (node pos)
+ "Set the cursor position cache of NODE to POS."
+ (setcar (nthcdr 4 node) pos))
+
+;; Node graph traversal
+
+(defvar elopher-current-node)
+
+(defun elopher-visit-node (node &optional getter)
+ "Visit NODE using its own getter or GETTER, if non-nil."
+ (elopher-save-pos)
+ (elopher-process-cleanup)
+ (setq elopher-current-node node)
+ (if getter
+ (funcall getter)
+ (funcall (elopher-node-getter node))))
+
+(defun elopher-visit-parent-node ()
+ "Visit the parent of the current node."
+ (let ((parent-node (elopher-node-parent elopher-current-node)))
+ (when parent-node
+ (elopher-visit-node parent-node))))
+
+(defun elopher-reload-current-node ()
+ "Reload the current node, discarding any existing cached content."
+ (elopher-set-node-content elopher-current-node nil)
+ (elopher-visit-node elopher-current-node))
+
+(defun elopher-save-pos ()
+ "Save the current position of point to the current node."
+ (when elopher-current-node
+ (elopher-set-node-pos elopher-current-node (point))))
+
+(defun elopher-restore-pos ()
+ "Restore the position of point to that cached in the current node."
+ (let ((pos (elopher-node-pos elopher-current-node)))
+ (if pos
+ (goto-char pos)
+ (goto-char (point-min)))))
+
+;;; Buffer preparation
+;;
+
+(defmacro elopher-with-clean-buffer (&rest args)
+ "Evaluate ARGS with a clean *elopher* buffer as current."
+ (list 'progn
+ '(switch-to-buffer "*elopher*")
+ '(elopher-mode)
+ (append (list 'let '((inhibit-read-only t))
+ '(erase-buffer))
+ args)))
+
+;;; Index rendering
+;;
+
+(defun elopher-insert-index (string)
+ "Insert the index corresponding to STRING into the current buffer."
+ (dolist (line (split-string string "\r\n"))
+ (unless (= (length line) 0)
+ (elopher-insert-index-record line))))
+
+(defun elopher-insert-margin (&optional type-name)
+ "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
+ (if type-name
+ (progn
+ (insert (format (concat "%" (number-to-string (- elopher-margin-width 1)) "s")
+ (concat
+ (propertize "[" 'face 'elopher-margin-brackets)
+ (propertize type-name 'face 'elopher-margin-key)
+ (propertize "]" 'face 'elopher-margin-brackets))))
+ (insert " "))
+ (insert (make-string elopher-margin-width ?\s))))
+
+(defvar elopher-type-map
+ '((?0 elopher-get-text-node "T" elopher-text)
+ (?1 elopher-get-index-node "/" elopher-index)
+ (?g elopher-get-image-node "im" elopher-image)
+ (?p elopher-get-image-node "im" elopher-image)
+ (?I elopher-get-image-node "im" elopher-image)
+ (?4 elopher-get-node-download "B" elopher-binary)
+ (?5 elopher-get-node-download "B" elopher-binary)
+ (?9 elopher-get-node-download "B" elopher-binary)
+ (?7 elopher-get-search-node "?" elopher-search))
+ "Association list from types to getters, margin codes and index faces.")
+
+(defun elopher-insert-index-record (line)
+ "Insert the index record corresponding to LINE into the current buffer."
+ (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 (elt fields 3))
+ (address (elopher-make-address selector host port))
+ (type-map-entry (alist-get type elopher-type-map)))
+ (if type-map-entry
+ (let ((getter (car type-map-entry))
+ (margin-code (cadr type-map-entry))
+ (face (caddr type-map-entry)))
+ (elopher-insert-margin margin-code)
+ (insert-text-button display-string
+ 'face face
+ 'elopher-node (elopher-make-node elopher-current-node
+ address
+ getter)
+ 'action #'elopher-click-link
+ 'follow-link t
+ 'help-echo (format "mouse-1, RET: open %s on %s port %s"
+ selector host port)))
+ (pcase type
+ (?i (elopher-insert-margin) ; Information
+ (insert (propertize display-string
+ 'face 'elopher-info)))
+ (?h (elopher-insert-margin "W") ; Web link
+ (let ((url (elt (split-string selector "URL:") 1)))
+ (insert-text-button display-string
+ 'face 'elopher-url
+ 'elopher-url url
+ 'action #'elopher-click-url
+ 'follow-link t
+ 'help-echo (format "mouse-1, RET: open url %s" url))))
+ (?.) ; Occurs at end of index, can safely ignore.
+ (tp (elopher-insert-margin (concat (char-to-string tp) "?"))
+ (insert (propertize display-string
+ 'face 'elopher-unknown-face)))))
+ (insert "\n")))
+
+
+;;; Selector retrieval (all kinds)
+;;
+
+(defun elopher-process-cleanup ()
+ "Immediately shut down any extant elopher process."
+ (let ((p (get-process "elopher-process")))
+ (if p (delete-process p))))
+
+(defvar elopher-selector-string)
+
+(defun elopher-get-selector (address after)
+ "Retrieve selector specified by ADDRESS, then execute AFTER.
+The result is stored as a string in the variable elopher-selector-string."
+ (setq elopher-selector-string "")