;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 1.4.5
+;; Version: 1.4.7
;; 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.
;;; Code:
(provide 'elpher)
+
+;;; Dependencies
+;;
+
(require 'seq)
(require 'pp)
(require 'shr)
+(require 'url-util)
+
;;; Global constants
;;
-(defconst elpher-version "1.4.5"
+(defconst elpher-version "1.4.7"
"Current version of elpher.")
(defconst elpher-margin-width 6
"Width of left-hand margin used when rendering indicies.")
-
-(defconst elpher-type-map
- '((?0 elpher-get-text-node "txt" elpher-text)
- (?1 elpher-get-index-node "/" elpher-index)
- (?4 elpher-get-node-download "bin" elpher-binary)
- (?5 elpher-get-node-download "bin" elpher-binary)
- (?7 elpher-get-search-node "?" elpher-search)
- (?8 elpher-get-telnet-node "tel" elpher-telnet)
- (?9 elpher-get-node-download "bin" elpher-binary)
- (?g elpher-get-image-node "img" elpher-image)
- (?p elpher-get-image-node "img" elpher-image)
- (?I elpher-get-image-node "img" elpher-image)
- (?d elpher-get-node-download "doc" elpher-binary)
- (?h elpher-get-url-node "url" elpher-url)
- (bookmarks elpher-get-bookmarks-node "#" elpher-index)
- (start elpher-get-start-node "#" elpher-index))
+(defconst elpher-transport-map
+ '(("gopher" elpher-get-gopher-selector)
+ ("gophers" elpher-get-gopher-selector)
+ ("gemini" elpher-get-gemini-selector)))
+
+(defconst elpher-gopher-type-map
+ '((?0 elpher-display-text "txt" elpher-text)
+ (?1 elpher-display-gophermap "/" elpher-index)
+ (?4 nil "bin" elpher-binary)
+ (?5 nil "bin" elpher-binary)
+ (?7 elpher-display-search-node "?" elpher-search)
+ (?8 elpher-display-telnet-node "tel" elpher-telnet)
+ (?9 nil "bin" elpher-binary)
+ (?g elpher-display-image-node "img" elpher-image)
+ (?p elpher-display-image-node "img" elpher-image)
+ (?I elpher-display-image-node "img" elpher-image)
+ (?d nil "doc" elpher-binary)
+ (?P nil "doc" elpher-binary)
+ (?s nil "snd" elpher-binary)
+ (?h elpher-display-node-html "htm" elpher-html))
"Association list from types to getters, margin codes and index faces.")
+(defconst elpher-mime-type-map
+ '(("text/gemini" elpher-display-node-text)
+ ("text/html" elpher-display-node-html)
+ ("text/*" elpher-display-node-text)
+ ("image/*" elpher-display-image-node)))
;;; Customization group
;;
"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-use-header t
"If non-nil, display current node information in buffer header."
:type '(boolean))
;; Address
-(defun elpher-make-address (type &optional selector host port use-tls)
- "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT.
-Although selector host and port are optional, they are only omitted for
-special address types, such as 'start for the start page.
-
-Setting the USE-TLS parameter to non-nil causes Elpher to engage TLS mode
-before attempting to connect to the server."
- (if use-tls
- (list type selector host port 'tls)
- (list type selector host port)))
-
-(defun elpher-address-type (address)
- "Retrieve type from ADDRESS."
- (elt address 0))
-
-(defun elpher-address-selector (address)
- "Retrieve selector from ADDRESS."
- (elt address 1))
-
-(defun elpher-address-host (address)
- "Retrieve host from ADDRESS."
- (elt address 2))
-
-(defun elpher-address-port (address)
- "Retrieve port from ADDRESS."
- (elt address 3))
-
-(defun elpher-address-use-tls-p (address)
- "Return non-nil if ADDRESS is marked as needing TLS."
- (elt address 4))
-
-(defun elpher-address-special-p (address)
- "Return non-nil if ADDRESS is special (e.g. start page, bookmarks page)."
- (not (elpher-address-host address)))
+(defun elpher-url-from-string (url-string)
+ "Create a URL object corresponding to the given URL-STRING."
+ (let ((url (url-generic-parse-url url-string)))
+ (if (and (url-type url)
+ (url-host url))
+ (setf (url-filename url) (url-unhex-string (url-filename url)))
+ (error "Malformed URL" url))))
+
+(defun elpher-url-to-url-string (url)
+ "Get string representation of URL."
+ (url-encode-url (url-recreate url)))
+
+(defun elpher-url-gopher-p (url)
+ "Return non-nil if URL object specifies a gopher address."
+ (let ((protocol (url-type url)))
+ (if (or (string-equal protocol "gopher")
+ (string-equal protocol "gophers")))))
+
+(defun elpher-gopher-url-selector-type (url)
+ "Retrieve selector type from URL object."
+ (let ((filename (url-filename url)))
+ (if (> (length filename) 0)
+ (string-to-char filename)
+ ?1)))
+
+(defun elpher-gopher-url-selector (url)
+ "Retrieve selector from URL object."
+ (let ((filename (url-filename url)))
+ (if (> (length filename) 0)
+ (substring filename 1)
+ "")))
+
+(defun elpher-url-host (url)
+ "Retrieve host from URL object."
+ (url-host url))
+
+(defun elpher-url-port (url)
+ "Retrieve port from URL object."
+ (url-port url))
+
+(defun elpher-url-use-tls-p (url)
+ "Return non-nil if URL is marked as needing TLS."
+ (string-equal (url-type address) "gophers"))
+
+(defun elpher-url-special-p (url)
+ "Return non-nil if URL object is special (e.g. start page, bookmarks page)."
+ (symbolp url))
;; Node
-(defun elpher-make-node (display-string address &optional parent)
- "Create a node in the gopher page hierarchy.
+(defun elpher-make-node (display-string url &optional parent)
+ "Create a node in the page hierarchy.
DISPLAY-STRING records the display string used for the page.
-ADDRESS specifies the address of the gopher page.
+URL specifies the url object of the page.
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))
+ (list display-string url parent))
(defun elpher-node-display-string (node)
"Retrieve the display string of NODE."
(elt node 0))
-(defun elpher-node-address (node)
- "Retrieve the address of NODE."
+(defun elpher-node-url (node)
+ "Retrieve the URL object of NODE."
(elt node 1))
(defun elpher-node-parent (node)
(defvar elpher-content-cache (make-hash-table :test 'equal))
(defvar elpher-pos-cache (make-hash-table :test 'equal))
-(defun elpher-get-cached-content (address)
- "Retrieve the cached content for ADDRESS, or nil if none exists."
- (gethash address elpher-content-cache))
+(defun elpher-get-cached-content (url)
+ "Retrieve the cached content for URL, or nil if none exists."
+ (gethash url elpher-content-cache))
-(defun elpher-cache-content (address content)
- "Set the content cache for ADDRESS to CONTENT."
- (puthash address content elpher-content-cache))
+(defun elpher-cache-content (url content)
+ "Set the content cache for URL to CONTENT."
+ (puthash url 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-get-cached-pos (url)
+ "Retrieve the cached cursor position for URL, or nil if none exists."
+ (gethash url elpher-pos-cache))
-(defun elpher-cache-pos (address pos)
- "Set the cursor position cache for ADDRESS to POS."
- (puthash address pos elpher-pos-cache))
+(defun elpher-cache-pos (url pos)
+ "Set the cursor position cache for URL to POS."
+ (puthash url pos elpher-pos-cache))
;; Node graph traversal
(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)))
+ (equal (elpher-node-url elpher-current-node)
+ (elpher-node-url 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)
(if getter
(funcall getter)
- (let* ((address (elpher-node-address node))
- (type (elpher-address-type address)))
- (funcall (car (alist-get type elpher-type-map))))))
+ ;; The business below needs updating: mapping from url->getter is different
+ ;; and more complex.
+ (let* ((url (elpher-node-url node))
+ (type (elpher-address-type address))
+ (type-record (alist-get type elpher-type-map)))
+ (if type-record
+ (funcall (car type-record))
+ (elpher-visit-parent-node)
+ (error "Unsupported gopher selector type '%c'" type)))))
(defun elpher-visit-parent-node ()
"Visit the parent of the current node."
;; Text retrieval
(defconst elpher-url-regex
- "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?"
+ "\\([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.")
(defun elpher-make-node-from-matched-url (&optional string)
(protocol (downcase (match-string 1 string))))
(if (or (string= protocol "gopher")
(string= protocol "gophers"))
- (let* ((host (match-string 2 string))
+ (let* ((bare-host (match-string 2 string))
+ (host (if (string-prefix-p "[" bare-host)
+ (substring bare-host 1 (- (length bare-host) 1))
+ bare-host))
(port (if (> (length (match-string 3 string)) 1)
(string-to-number (substring (match-string 3 string) 1))
70))
(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)
- ""))
+ (selector (decode-coding-string
+ (url-unhex-string
+ (if (> (length type-and-selector) 1)
+ (substring type-and-selector 2)
+ "")) 'utf-8))
(use-tls (string= protocol "gophers"))
(address (elpher-make-address type selector host port use-tls)))
(elpher-make-node url address))
(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))
- (content (elpher-get-cached-content address)))
- (if content
+ (let* ((address (elpher-node-address elpher-current-node)))
+ (if (display-images-p)
(progn
(elpher-with-clean-buffer
- (insert-image content)
- (elpher-restore-pos)))
- (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))
- (if elpher-cache-images
- (elpher-cache-content
- (elpher-node-address elpher-current-node)
- image)))))))
- (elpher-get-node-download)))))
+ (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
(let ((address (elpher-node-address elpher-current-node)))
(elpher-with-clean-buffer
(insert "LOADING RAW SERVER RESPONSE... (use 'u' to cancel)"))
- (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)))))
+ (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
" - R: reload current page (regenerates cache)\n"
" - T: toggle TLS mode\n"
" - d/D: download item under cursor or current page\n"
- " - w: display the raw server response for the current page\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")
(not (equal (elpher-bookmark-address bookmark) address)))
(elpher-load-bookmarks))))
+
;;; Interactive procedures
;;
(interactive)
(elpher-info-node elpher-current-node))
-(defun elpher-get-address-url (address)
- "Get URL representation of ADDRESS."
- (let ((type (elpher-address-type address))
- (selector (elpher-address-selector address))
- (host (elpher-address-host address))
- (port (elpher-address-port address)))
- (if (and (equal type ?h)
- (string-prefix-p "URL:" selector))
- (elt (split-string selector "URL:") 1)
- (concat "gopher"
- (if (elpher-address-use-tls-p address) "s" "")
- "://"
- host
- (if (equal port 70)
- ""
- (format ":%d" port))
- "/" (string type)
- selector))))
-
(defun elpher-copy-node-url (node)
"Copy URL representation of address of NODE to `kill-ring'."
(let ((address (elpher-node-address node)))
(message "Coding system fixed to %s. (Reload to see effect)." system)
(message "Coding system set to autodetect. (Reload to see effect)."))))
+
;;; Mode and keymap
;;
(define-key map (kbd "r") 'elpher-redraw)
(define-key map (kbd "R") 'elpher-reload)
(define-key map (kbd "T") 'elpher-toggle-tls)
- (define-key map (kbd "w") 'elpher-view-raw)
+ (define-key map (kbd ".") 'elpher-view-raw)
(define-key map (kbd "d") 'elpher-download)
(define-key map (kbd "D") 'elpher-download-current)
(define-key map (kbd "m") 'elpher-jump)
(kbd "r") 'elpher-redraw
(kbd "R") 'elpher-reload
(kbd "T") 'elpher-toggle-tls
- (kbd "w") 'elpher-view-raw
+ (kbd ".") 'elpher-view-raw
(kbd "d") 'elpher-download
(kbd "D") 'elpher-download-current
(kbd "m") 'elpher-jump
(when (fboundp 'evil-set-initial-state)
(evil-set-initial-state 'elpher-mode 'motion))
+
;;; Main start procedure
;;
The Lambda Lab / projects / elpher.git / blobdiff