-;;; elpher.el --- A friendly gopher client.
+;;; elpher.el --- A friendly gopher client. -*- lexical-binding:t -*-
;; Copyright (C) 2019 Tim Vaughan
;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 2.0.0
+;; Version: 2.3.6
;; Keywords: comm gopher
;; Homepage: https://github.com/tgvaughan/elpher
;; Package-Requires: ((emacs "26"))
;; - pleasant and configurable colouring of Gopher directories,
;; - direct visualisation of image files,
;; - a simple bookmark management system,
-;; - connections using TLS encryption.
+;; - 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
(require 'pp)
(require 'shr)
(require 'url-util)
+(require 'subr-x)
;;; Global constants
;;
-(defconst elpher-version "2.0.0"
+(defconst elpher-version "2.3.6"
"Current version of elpher.")
(defconst elpher-margin-width 6
"Width of left-hand margin used when rendering indicies.")
(defconst elpher-type-map
- '(((gopher ?0) elpher-get-text-node "txt" elpher-text)
- ((gopher ?1) elpher-get-index-node "/" elpher-index)
- ((gopher ?4) elpher-get-node-download "bin" elpher-binary)
- ((gopher ?5) elpher-get-node-download "bin" elpher-binary)
- ((gopher ?7) elpher-get-search-node "?" elpher-search)
- ((gopher ?8) elpher-get-telnet-node "tel" elpher-telnet)
- ((gopher ?9) elpher-get-node-download "bin" elpher-binary)
- ((gopher ?g) elpher-get-image-node "img" elpher-image)
- ((gopher ?p) elpher-get-image-node "img" elpher-image)
- ((gopher ?I) elpher-get-image-node "img" elpher-image)
- ((gopher ?d) elpher-get-node-download "doc" elpher-binary)
- ((gopher ?P) elpher-get-node-download "doc" elpher-binary)
- ((gopher ?s) elpher-get-node-download "snd" elpher-binary)
- ((gopher ?h) elpher-get-html-node "htm" elpher-html)
- (gemini elpher-get-gemini-node "gem" elpher-gemini)
- (other-url elpher-get-other-url-node "url" elpher-other-url)
- ((special bookmarks) elpher-get-bookmarks-node)
- ((special start) elpher-get-start-node))
- "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 "/" elpher-index)
+ ((special start) elpher-get-start-node nil))
+ "Association list from types to getters, renderers, margin codes and index faces.")
;;; Customization group
"Face used for html type directory records.")
(defface elpher-gemini
- '((t :inherit font-lock-function-name-face))
+ '((t :inherit font-lock-regexp-grouping-backslash))
"Face used for html type directory records.")
(defface elpher-other-url
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))
(let ((data (match-data))) ; Prevent parsing clobbering match data
(unwind-protect
(let ((url (url-generic-parse-url url-string)))
- (setf (url-fullness url) t)
- (setf (url-filename url)
- (url-unhex-string (url-filename url)))
- (unless (url-type url)
- (setf (url-type url) "gopher"))
- (let ((is-gopher (or (equal "gopher" (url-type url))
- (equal "gophers" (url-type url))))
- (is-gemini (equal "gemini" (url-type url))))
- (when is-gopher
+ (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"))))
+ (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 corresponding to the given gopher directory record
-attributes: TYPE, SELECTOR, HOST and PORT."
- (if (and (equal type ?h)
- (string-prefix-p "URL:" selector))
- (elpher-address-from-url (elt (split-string selector "URL:") 1))
+ "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))))
+ selector)))))
(defun elpher-make-special-address (type)
"Create an ADDRESS object corresponding to the given special page symbol TYPE."
nil))
(defun elpher-address-type (address)
- "Retrieve selector type from ADDRESS object."
+ "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)))
(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)))
(url-host address))
(defun elpher-address-port (address)
- "Retrieve port from ADDRESS object."
- (url-port address))
+ "Retrieve port from ADDRESS object.
+If no address is defined, returns 0. (This is for compatibility with the URL library.)"
+ (if (symbolp address)
+ 0
+ (url-port address)))
(defun elpher-address-special-p (address)
"Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
(defvar elpher-current-node nil)
-(defun elpher-visit-node (node &optional getter preserve-parent)
- "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-set-node-parent node (elpher-node-parent elpher-current-node))
(elpher-set-node-parent node elpher-current-node)))
(setq elpher-current-node node)
- (if getter
- (funcall getter)
- (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))
- (elpher-visit-parent-node)
- (pcase type
- (`(gopher ,type-char)
- (error "Unsupported gopher selector type '%c' for '%s'"
- type-char (elpher-address-to-url address)))
- (else
- (error "Unsupported address type '%S' for '%s'"
- type (elpher-address-to-url address))))))))
+ (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."
(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))
+ (tls-string (if (and (not (elpher-address-special-p address))
+ (member (elpher-address-protocol address)
+ '("gophers" "gemini")))
+ " [TLS encryption]"
+ ""))
+ (header (concat display-string
+ (propertize tls-string 'face 'bold))))
+ (setq header-line-format header))))
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
(replace-regexp-in-string "\r" "" string))))
-;;; 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)))
- (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))
- (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."
- (if type-name
- (progn
- (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s")
- (concat
- (propertize "[" 'face 'elpher-margin-brackets)
- (propertize type-name 'face 'elpher-margin-key)
- (propertize "]" 'face 'elpher-margin-brackets))))
- (insert " "))
- (insert (make-string elpher-margin-width ?\s))))
-
-(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)))
- (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 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 (elt type-map-entry 1))
- (face (elt type-map-entry 2))
- (node (elpher-make-node display-string address)))
- (elpher-insert-margin margin-code)
- (insert-text-button display-string
- 'face face
- 'elpher-node node
- 'action #'elpher-click-link
- 'follow-link t
- 'help-echo (elpher-node-button-help node)))
- (pcase type
- ((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)))
- (`(gopher ,selector-type) ;; Unknown
- (elpher-insert-margin (concat (char-to-string selector-type) "?"))
- (insert (propertize display-string
- 'face 'elpher-unknown)))))
- (insert "\n")))
-
-(defun elpher-click-link (button)
- "Function called when the gopher link BUTTON is activated (via mouse or keypress)."
- (let ((node (button-get button 'elpher-node)))
- (elpher-visit-node node)))
-
-
;;; 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 the-error) ".\n"
+ (error-message-string error) "\n"
(propertize "\n----------------\n\n" 'face 'error)
"Press 'u' to return to the previous page.")))
-;;; Gopher selector retrieval (all kinds)
+;;; Gopher selector retrieval
;;
(defun elpher-process-cleanup ()
(if (gnutls-available-p)
(when (not elpher-use-tls)
(setq elpher-use-tls t)
- (message "Engaging TLS mode."))
- (error "Cannot retrieve TLS selector: GnuTLS not available")))
+ (message "Engaging TLS gopher mode."))
+ (error "Cannot retrieve TLS gopher selector: GnuTLS not available")))
(condition-case the-error
(let* ((kill-buffer-query-functions nil)
+ (port (elpher-address-port address))
(proc (open-network-stream "elpher-process"
nil
(elpher-address-host address)
- (if (> (elpher-address-port address) 0)
- (elpher-address-port address)
- 70)
+ (if (> port 0) port 70)
:type (if elpher-use-tls 'tls 'plain))))
(set-process-coding-system proc 'binary)
(set-process-filter proc
- (lambda (proc string)
+ (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")))
+ (let ((inhibit-eol-conversion t))
+ (process-send-string proc
+ (concat (elpher-gopher-address-selector address) "\r\n"))))
(error
(if (and (consp the-error)
(eq (car the-error) 'gnutls-error)
(or elpher-auto-disengage-TLS
(yes-or-no-p "Could not establish encrypted connection. Disable TLS mode? ")))
(progn
- (message "Disengaging TLS mode.")
+ (message "Disengaging TLS gopher mode.")
(setq elpher-use-tls nil)
(elpher-get-selector address after))
(elpher-process-cleanup)
(propertize "\n----------------\n\n" 'face 'error)
"Press 'u' to return to the previous page.")))))))
-;; Index retrieval
-
-(defun elpher-get-index-node ()
- "Getter which retrieves the current node contents as an index."
+(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 content
- (progn
- (elpher-with-clean-buffer
- (insert content)
- (elpher-restore-pos)))
+ (if (and content (funcall renderer nil))
+ (elpher-with-clean-buffer
+ (insert content)
+ (elpher-restore-pos))
(elpher-with-clean-buffer
- (insert "LOADING DIRECTORY... (use 'u' to cancel)"))
+ (insert "LOADING... (use 'u' to cancel)"))
(elpher-get-selector address
- (lambda (proc event)
+ (lambda (_proc event)
(unless (string-prefix-p "deleted" event)
- (elpher-with-clean-buffer
- (elpher-insert-index elpher-selector-string)
- (elpher-restore-pos)
- (elpher-cache-content
- (elpher-node-address elpher-current-node)
- (buffer-string)))))))))
+ (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)))
+ (dolist (line (split-string str-processed "\n"))
+ (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."
+ (if type-name
+ (progn
+ (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s")
+ (concat
+ (propertize "[" 'face 'elpher-margin-brackets)
+ (propertize type-name 'face 'elpher-margin-key)
+ (propertize "]" 'face 'elpher-margin-brackets))))
+ (insert " "))
+ (insert (make-string elpher-margin-width ?\s))))
+
+(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)))
+ (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
+ address
+ (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 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 (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
+ 'elpher-node node
+ 'action #'elpher-click-link
+ 'follow-link t
+ 'help-echo (elpher-node-button-help node)))
+ (pcase type
+ ((or '(gopher ?i) 'nil) ;; Information
+ (elpher-insert-margin)
+ (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)))))
+ (insert "\n")))
+
+(defun elpher-click-link (button)
+ "Function called when the gopher link BUTTON is activated (via mouse or keypress)."
+ (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)))))
-;; Text retrieval
+;; Text rendering
(defconst elpher-url-regex
- "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^<> \r\n\t(),]*\\)?"
- "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
+ "\\([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."
(insert string)
(goto-char (point-min))
(while (re-search-forward elpher-url-regex nil t)
- (let ((node (elpher-make-node (match-string 0)
+ (let ((node (elpher-make-node (substring-no-properties (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* ((address (elpher-node-address elpher-current-node))
- (content (elpher-get-cached-content address)))
- (if content
- (progn
- (elpher-with-clean-buffer
- (insert content)
- (elpher-restore-pos)))
- (progn
- (elpher-with-clean-buffer
- (insert "LOADING TEXT... (use 'u' to cancel)"))
- (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-cache-content
- (elpher-node-address 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* ((address (elpher-node-address elpher-current-node)))
+(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 "LOADING IMAGE... (use 'u' to cancel)"))
- (elpher-get-selector address
- (lambda (proc event)
- (unless (string-prefix-p "deleted" event)
- (let ((image (create-image
- elpher-selector-string
- nil t)))
- (elpher-with-clean-buffer
- (insert-image image)
- (elpher-restore-pos)))))))
- (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* ((address (elpher-node-address elpher-current-node))
- (content (elpher-get-cached-content address))
- (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."))
+ (let ((image (create-image
+ data
+ nil t)))
+ (elpher-with-clean-buffer
+ (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-gopher-address-selector address) "\t" query-string))
(search-address (elpher-make-gopher-address ?1
- query-selector
- (elpher-address-host address)
- (elpher-address-port address))))
+ 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... (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-cache-content
- (elpher-node-address 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 rendering
-;; Raw server response retrieval
-
-(defun elpher-get-node-raw ()
- "Getter which retrieves the raw server response for the current node."
- (let ((address (elpher-node-address elpher-current-node)))
+(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 "LOADING RAW SERVER RESPONSE... (use 'u' to cancel)"))
- (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)))))))
- (message "Displaying raw server response. Reload or redraw to return to standard view."))
-
-;; File export retrieval
+ (insert data)
+ (goto-char (point-min)))
+ (message "Displaying raw server response. Reload or redraw to return to standard view.")))
-(defvar elpher-download-filename)
+;; File save "rendering"
-(defun elpher-get-node-download ()
- "Getter which retrieves the current node and writes the result to a file."
- (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 "Save file as: "
- nil nil nil
- (if (> (length filename-proposal) 0)
- filename-proposal
- "gopher.file"))))
- (message "Downloading...")
- (setq elpher-download-filename filename)
- (condition-case the-error
- (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)))))
- t)
- (error
- (error "Error downloading %s" elpher-download-filename))))))
-
-;; HTML node retrieval
-
-(defun elpher-insert-rendered-html (string)
- "Use shr to insert rendered view of html STRING into current buffer."
- (let ((dom (with-temp-buffer
- (insert string)
- (libxml-parse-html-region (point-min) (point-max)))))
- (shr-insert-document dom)))
-
-(defun elpher-get-html-node ()
- "Getter which retrieves and renders an HTML node."
- (let* ((address (elpher-node-address elpher-current-node))
- (selector (elpher-gopher-address-selector address)))
- (let ((content (elpher-get-cached-content address)))
- (if content
- (progn
- (elpher-with-clean-buffer
- (insert content)
- (elpher-restore-pos)))
- (elpher-with-clean-buffer
- (insert "LOADING HTML... (use 'u' to cancel)"))
- (elpher-get-selector address
- (lambda (proc event)
- (unless (string-prefix-p "deleted" event)
- (elpher-with-clean-buffer
- (elpher-insert-rendered-html elpher-selector-string)
- (goto-char (point-min))
- (elpher-cache-content
- (elpher-node-address elpher-current-node)
- (buffer-string))))))))))
+(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)
-(defvar elpher-gemini-response-header)
-(defvar elpher-gemini-in-header)
+(defvar elpher-gemini-redirect-chain)
-(defun elpher-get-gemini (address after)
+(defun elpher-get-gemini-response (address after)
"Retrieve gemini ADDRESS, then execute AFTER.
-The response header is stored in the variable ‘elpher-gemini-response-header’.
-If available, the response is stored in the variable ‘elpher-gemini-response’.
-
-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."
+The response is stored in the variable ‘elpher-gemini-response’."
(setq elpher-gemini-response "")
- (setq elpher-gemini-response-header "")
- (setq elpher-gemini-in-header t)
(if (not (gnutls-available-p))
- (error "Cannot retrieve TLS selector: GnuTLS not available")
- (let* ((kill-buffer-query-functions nil)
- (proc (open-network-stream "elpher-process"
- nil
- (elpher-address-host address)
- (if (> (elpher-address-port address) 0)
- (elpher-address-port address)
- 1965)
- :type 'tls)))
- (set-process-coding-system proc 'binary)
- (set-process-filter proc
- (lambda (proc string)
- (if elpher-gemini-in-header
- (progn
- (setq elpher-gemini-response-header
- (concat elpher-gemini-response-header
- (elt (split-string string "\r\n") 0)))
- (let ((idx (string-match "\r\n" string)))
- (setq elpher-gemini-response
- (substring string (+ idx 2)))
- (setq elpher-gemini-in-header nil)))
- (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")))))
-
-
-(defun elpher-render-gemini-response (mime-type-string)
- (let* ((mime-type-string* (if (string-empty-p mime-type-string)
- "text/gemini; charset=utf-8"
- mime-type-string))
- (mime-type-split (split-string mime-type-string* ";"))
- (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))))
- (if (and (equal "text/gemini" mime-type)
- (not (assoc "charset" parameters)))
- (setq parameters (cons (list "charset" "utf-8") parameters)))
- (when (string-prefix-p "text/" mime-type)
- (if (assoc "charset" parameters)
- (setq elpher-gemini-response
- (decode-coding-string elpher-gemini-response
- (intern (cadr (assoc "charset" parameters))))))
- (setq elpher-gemini-response
- (replace-regexp-in-string "\r" "" elpher-gemini-response)))
- (pcase mime-type
- ((or "text/gemini" "")
- (elpher-render--mimetype-text/gemini elpher-gemini-response parameters))
- ((pred (string-prefix-p "text/"))
- (elpher-render--mimetype-text/plain elpher-gemini-response parameters))
- ((pred (string-prefix-p "image/"))
- (elpher-render--mimetype-image/* elpher-gemini-response parameters))
- (other
- (error "Unsupported MIME type %S" mime-type)))))
+ (error "Cannot establish gemini connection: GnuTLS not available")
+ (condition-case the-error
+ (let* ((kill-buffer-query-functions nil)
+ (network-security-level 'medium)
+ (port (elpher-address-port address))
+ (proc (open-network-stream "elpher-process"
+ nil
+ (elpher-address-host address)
+ (if (> port 0) port 1965)
+ :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)
+ (let ((inhibit-eol-conversion t))
+ (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)
+ (if (>= (length elpher-gemini-redirect-chain) 5)
+ (error "More than 5 consecutive redirects followed"))
+ (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
+ (if (member redirect-address elpher-gemini-redirect-chain)
+ (error "Redirect loop detected"))
+ (if (not (string= (elpher-address-protocol redirect-address)
+ "gemini"))
+ (error "Server tried to automatically redirect to non-gemini URL: %s"
+ response-meta))
+ (add-to-list 'elpher-gemini-redirect-chain redirect-address)
+ (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))
+ (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)"))
+ (setq elpher-gemini-redirect-chain nil)
+ (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-collapse-dot-sequences (filename)
+ "Collapse dot sequences in FILENAME.
+For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
+ (let* ((path (split-string filename "/"))
+ (path-reversed-normalized
+ (seq-reduce (lambda (a b)
+ (cond ((and a (equal b "..") (cdr a)))
+ ((and (not a) (equal b "..")) a) ;leading .. are dropped
+ ((equal b ".") a)
+ (t (cons b a))))
+ path nil)))
+ (string-join (reverse path-reversed-normalized) "/")))
+
(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 explicit
+ (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
+ (concat (file-name-directory
(url-filename (elpher-node-address elpher-current-node)))
(url-filename address)))))
(unless (url-type address)
- (setf (url-type address) "gemini")))
+ (setf (url-type address) "gemini"))
+ (if (equal (url-type address) "gemini")
+ (setf (url-filename address)
+ (elpher-collapse-dot-sequences (url-filename address)))))
address))
-(defun elpher-render--mimetype-text/gemini (data parameters)
+(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)
(elpher-insert-index-record display-string address)
(elpher-insert-index-record url address)))
(elpher-insert-index-record line)))
- (elpher-restore-pos)
(elpher-cache-content
(elpher-node-address elpher-current-node)
(buffer-string))))
-(defun elpher-render--mimetype-text/plain (data parameters)
+(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 (elpher-preprocess-text-response data)))
- (elpher-restore-pos)
+ (insert (elpher-buttonify-urls data))
(elpher-cache-content
(elpher-node-address elpher-current-node)
(buffer-string))))
-(defun elpher-render--mimetype-image/* (data parameters)
- (let ((image (create-image data nil t)))
- (elpher-with-clean-buffer
- (insert-image image)
- (elpher-restore-pos))))
-
-(defun elpher-process-gemini-response (proc event)
- (condition-case the-error
- (unless (string-prefix-p "deleted" event)
- (let ((response-code (car (split-string elpher-gemini-response-header)))
- (meta (string-trim
- (substring elpher-gemini-response-header
- (string-match "[ \t]+"
- elpher-gemini-response-header)))))
- (pcase (elt response-code 0)
- (?1 ; Input required
- (elpher-with-clean-buffer
- (insert "Gemini server is requesting input."))
- (let* ((query-string (read-string (concat 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 query-address #'elpher-process-gemini-response)))
- (?2 ; Normal response
- (message elpher-gemini-response-header)
- (elpher-render-gemini-response meta))
- (?3 ; Redirect
- (message "Following redirect to %s" meta)
- (let ((redirect-address (elpher-address-from-gemini-url meta)))
- (elpher-get-gemini redirect-address #'elpher-process-gemini-response)))
- (?4 ; Temporary failure
- (error "Gemini server reports TEMPORARY FAILURE for this request"))
- (?5 ; Permanent failure
- (error "Gemini server reports PERMANENT FAILURE for this request"))
- (?6 ; Client certificate required
- (error "Gemini server requires client certificate (unsupported at this time)"))
- (other
- (error "Gemini server responded with unknown response code %S"
- response-code)))))
- (error
- (elpher-network-error (elpher-node-address elpher-current-node) the-error))))
-
-
-(defun elpher-get-gemini-node ()
- "Getter which retrieves and renders a Gemini node."
- (let* ((address (elpher-node-address elpher-current-node))
- (content (elpher-get-cached-content address)))
- (condition-case the-error
- (if content
- (progn
- (elpher-with-clean-buffer
- (insert content)
- (elpher-restore-pos)))
- (elpher-with-clean-buffer
- (insert "LOADING GEMINI... (use 'u' to cancel)"))
- (elpher-get-gemini address #'elpher-process-gemini-response))
- (error
- (elpher-network-error address the-error)))))
-
-
;; Other URL node opening
-(defun elpher-get-other-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))
(url (elpher-address-to-url address)))
(progn
;; 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)))
+ (if (> port 0)
+ (telnet host port)
+ (telnet host))))
;; Start page node retrieval
-(defun elpher-get-start-node ()
- "Getter which displays the start page."
+(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"
" - 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: return to previous page\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"
" - B: visit the bookmarks page\n"
" - r: redraw current page (using cached contents if available)\n"
" - R: reload current page (regenerates cache)\n"
- " - T: toggle TLS mode\n"
- " - d/D: download item under cursor or current page\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"
- " - S: set an explicit character coding system (default is to autodetect)\n"
"\n"
"Start your exploration of gopher space:\n")
(elpher-insert-index-record "Floodgap Systems Gopher Server"
"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"
+ "This page contains your bookmarked sites (also visit with B):\n")
+ (elpher-insert-index-record "Your Bookmarks" 'bookmarks)
(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 (button)
+ 'action (lambda (_)
(interactive)
(info "(elpher)"))
'follow-link t
;; Bookmarks page node retrieval
-(defun elpher-get-bookmarks-node ()
- "Getter to load and display the current bookmark list."
+(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)))
(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 (elpher-address-to-url 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."
"Get the address for BOOKMARK."
(elt bookmark 1))
-
(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."
- (with-temp-file (locate-user-emacs-file "elpher2-bookmarks")
+ (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"
(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 "elpher2-bookmarks"))
- (goto-char (point-min))
- (read (current-buffer)))))
+ (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.)))
(let ((existing-bookmark (rassoc (list url) bookmarks)))
(if existing-bookmark
(elpher-set-bookmark-display-string existing-bookmark display-string)
- (add-to-list 'bookmarks (elpher-make-bookmark display-string url))))
+ (push (elpher-make-bookmark display-string url) bookmarks)))
(elpher-save-bookmarks bookmarks)))
(defun elpher-remove-address-bookmark (address)
(interactive)
(let ((address (elpher-node-address elpher-current-node)))
(if (elpher-address-special-p address)
- (error "Command not valid for this page")
+ (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)))))))
(message "No current site.")))
(defun elpher-toggle-tls ()
- "Toggle TLS encryption mode."
+ "Toggle TLS encryption mode for gopher."
(interactive)
(setq elpher-use-tls (not elpher-use-tls))
(if elpher-use-tls
(if (gnutls-available-p)
- (message "TLS mode enabled. (Will not affect current page until reload.)")
+ (message "TLS gopher mode enabled. (Will not affect current page until reload.)")
(setq elpher-use-tls nil)
- (error "Cannot enable TLS mode: GnuTLS not available"))
- (message "TLS mode disabled. (Will not affect current page until reload.)")))
+ (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 raw server response for current page."
(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-get-node-raw))
+ #'elpher-render-raw))
(message "No current site.")))
(defun elpher-back ()
(if button
(let ((node (button-get button 'elpher-node)))
(if (elpher-address-special-p (elpher-node-address node))
- (error "Cannot download this link")
+ (error "Cannot download %s"
+ (elpher-node-display-string node))
(elpher-visit-node (button-get button 'elpher-node)
- #'elpher-get-node-download)))
+ #'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 this page")
+ (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-get-node-download
+ #'elpher-render-download
t)))
(defun elpher-build-link-map ()
(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))
(elpher-visit-node
(elpher-make-node (elpher-address-to-url address-copy)
address-copy))))
- (error "Command invalid for this page"))))
+ (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."
(address (elpher-node-address node)))
(if (elpher-address-special-p address)
(message "Special page: %s" display-string)
- (message (elpher-address-to-url address)))))
+ (message "%s" (elpher-address-to-url address)))))
(defun elpher-info-link ()
"Display information on node corresponding to link at point."
(interactive)
(elpher-copy-node-url elpher-current-node))
-(defun elpher-set-coding-system ()
- "Specify an explicit character coding system."
+(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 (default is to autodetect): " nil)))
+ (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 "Coding system fixed to %s. (Reload to see effect)." system)
- (message "Coding system set to autodetect. (Reload to see effect)."))))
+ (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
(define-key map (kbd "TAB") 'elpher-next-link)
(define-key map (kbd "<backtab>") '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 "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-coding-system)
- (when (fboundp 'evil-define-key)
- (evil-define-key 'motion map
+ (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-t") 'elpher-back
(kbd "u") 'elpher-back
+ [mouse-3] 'elpher-back
(kbd "g") 'elpher-go
(kbd "o") 'elpher-go-current
(kbd "r") 'elpher-redraw
(kbd "x") 'elpher-unbookmark-link
(kbd "X") 'elpher-unbookmark-current
(kbd "B") 'elpher-bookmarks
- (kbd "S") 'elpher-set-coding-system))
+ (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