((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-node-html "htm" elpher-html)
+ ((gopher ?h) elpher-get-html-node "htm" elpher-html)
+ (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.")
+
;;; Customization group
;;
'((t :inherit warning))
"Face used for search type directory records.")
-(defface elpher-url
+(defface elpher-html
+ '((t :inherit font-lock-comment-face))
+ "Face used for url type directory records.")
+
+(defface elpher-other-url
'((t :inherit font-lock-comment-face))
"Face used for url type directory records.")
(defun elpher-address-from-url (url-string)
"Create a ADDRESS object corresponding to the given URL-STRING."
- (let ((url (url-generic-parse-url url-string)))
- (if (and (url-type url)
- (url-host url))
- (let ((is-gopher (or (equal "gopher" (url-type url))
- (equal "gophers" (url-type url)))))
- (setf (url-filename url)
- (url-unhex-string (url-filename url)))
- (when (string-empty-p (url-filename url))
- (if is-gopher
- (setf (url-filename url) "1")))
- (unless (> (url-port url) 0)
- (if is-gopher
- (setf (url-port url) 70)))
- url)
- (error "Malformed URL" url))))
-
-(defun elpher-make-gopher-address (type selector host port)
+ (let ((data (match-data))) ; Prevent parsing clobbering match data
+ (unwind-protect
+ (let ((url (url-generic-parse-url url-string)))
+ (setf (url-fullness url) t)
+ (unless (url-host url)
+ (setf (url-host url) (url-filename url))
+ (setf (url-filename url) ""))
+ (unless (url-type url)
+ (setf (url-type url) "gopher"))
+ (if (and (url-type url)
+ (url-host url))
+ (let ((is-gopher (or (equal "gopher" (url-type url))
+ (equal "gophers" (url-type url)))))
+ (setf (url-filename url)
+ (url-unhex-string (url-filename url)))
+ (when (or (equal (url-filename url) "")
+ (equal (url-filename url) "/"))
+ (if is-gopher
+ (setf (url-filename url) "/1")))
+ (unless (> (url-port url) 0)
+ (if is-gopher
+ (setf (url-port url) 70)))
+ url)
+ (error "Malformed 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."
- (elpher-address-from-url
- (concat "gopher://" host ":" port "/" type selector)))
+ (if (and (equal type ?h)
+ (string-prefix-p "URL:" selector))
+ (elpher-address-from-url (elt (split-string selector "URL:") 1))
+ (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-string (address)
+(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 address))
+ (url-encode-url (url-recreate-url address))
nil))
(defun elpher-address-type (address)
(if (symbolp address)
(list 'special address)
(let ((protocol (url-type address)))
- (cond ((or (string-equal protocol "gopher")
- (string-equal protocol "gophers"))
- (list 'gopher
- ((let ((filename (url-filename address)))
- (if (> (length filename) 0)
- (string-to-char filename)
- ?1)))))
- ((string-equal protocol "gemini")
- 'gemini)))))
+ (cond ((or (equal protocol "gopher")
+ (equal protocol "gophers"))
+ (list 'gopher (string-to-char (substring (url-filename address) 1))))
+ ((equal protocol "gemini")
+ 'gemini)
+ (t 'other-url)))))
(defun elpher-address-protocol (address)
(if (symbolp address)
nil
(url-type address)))
-(defun elpher-gopher-address-selector (address)
- "Retrieve selector from ADDRESS object."
- (let ((filename (url-filename address)))
- (if (> (length filename) 0)
- (substring filename 1)
- "")))
+(defun elpher-address-filename (address)
+ (if (symbolp address)
+ nil
+ (url-filename address)))
(defun elpher-address-host (address)
"Retrieve host from ADDRESS object."
"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."
+ (memq (elpher-address-protocol address) '("gopher gophers")))
+
+(defun elpher-gopher-address-selector (address)
+ "Retrieve gopher selector from ADDRESS object."
+ (substring (url-filename address) 2))
+
;; Node
(defun elpher-make-node (display-string address &optional parent)
(funcall getter)
(let* ((address (elpher-node-address node))
(type (elpher-address-type address))
- (type-record (alist-get type elpher-type-map)))
+ (type-record (cdr (assoc type elpher-type-map))))
(if type-record
(funcall (car type-record))
(elpher-visit-parent-node)
- (error "Unsupported gopher selector type '%c'" type)))))
+ (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))))))))
(defun elpher-visit-parent-node ()
"Visit the parent of the current 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 (equal (elpher-address-type address) '(gopher ?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-gopher-address-selector address)
- (elpher-address-host address)
- (elpher-address-port address)))))
+ (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
(defun elpher-insert-index-record (display-string address)
"Function to insert an index record into the current buffer.
The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
(let* ((type (elpher-address-type address))
- (type-map-entry (alist-get type elpher-type-map)))
+ (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))
(elpher-visit-node node)))
-;;; Selector retrieval (all kinds)
+;;; Gopher selector retrieval (all kinds)
;;
(defun elpher-process-cleanup ()
(error the-error)
(elpher-with-clean-buffer
(insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
- "Failed to connect to " (elpher-get-address-url address) ".\n"
+ "Failed to connect to " (elpher-address-to-url address) ".\n"
(propertize "\n----------------\n\n" 'face 'error)
"Press 'u' to return to the previous page.")))))))
"\\([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)
- "Convert most recent `elpher-url-regex' match to a 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 (or (string= protocol "gopher")
- (string= protocol "gophers"))
- (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-and-selector (match-string 4 string))
- (type (if (> (length type-and-selector) 1)
- (elt type-and-selector 1)
- ?1))
- (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-gopher-address type selector host port use-tls)))
- (elpher-make-node url 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-gopher-address ?h selector host port)))
- (elpher-make-node url address)))))
-
-
(defun elpher-buttonify-urls (string)
"Turn substrings which look like urls in STRING into clickable buttons."
(with-temp-buffer
(insert string)
(goto-char (point-min))
(while (re-search-forward elpher-url-regex nil t)
- (let ((node (elpher-make-node-from-matched-url)))
+ (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
(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))
+ (query-selector (concat (elpher-gopher-address-selector address) "\t" query-string))
(search-address (elpher-make-gopher-address ?1
query-selector
(elpher-address-host address)
(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-address-selector address)))
+ (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: "
(error
(error "Error downloading %s" elpher-download-filename))))))
-;; URL retrieval
+;; HTML node retrieval
(defun elpher-insert-rendered-html (string)
"Use shr to insert rendered view of html STRING into current buffer."
(libxml-parse-html-region (point-min) (point-max)))))
(shr-insert-document dom)))
-(defun elpher-get-url-node ()
- "Getter which attempts to open the URL specified by the current node."
+(defun elpher-get-html-node ()
+ "Getter which retrieves and renders an HTML node."
(let* ((address (elpher-node-address elpher-current-node))
- (selector (elpher-address-selector address)))
- (let ((url (elt (split-string selector "URL:") 1)))
- (if url
+ (selector (elpher-gopher-address-selector address)))
+ (let ((content (elpher-get-cached-content address)))
+ (if content
(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)))
- (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))))))))))))
+ (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))))))))))
+
+
+;; Other URL node opening
+
+(defun elpher-get-other-url-node ()
+ "Getter which attempts to open the URL specified by the current node."
+ (let* ((address (elpher-node-address elpher-current-node))
+ (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
(if bookmarks
(dolist (bookmark bookmarks)
(let ((display-string (elpher-bookmark-display-string bookmark))
- (address (elpher-bookmark-address 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"
;;; 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))
+ (list display-string (elpher-address-to-url address)))
(defun elpher-bookmark-display-string (bookmark)
"Get the display string of BOOKMARK."
"Set the display string of BOOKMARK to DISPLAY-STRING."
(setcar bookmark display-string))
-(defun elpher-bookmark-address (bookmark)
+(defun elpher-bookmark-url (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 "elpher-bookmarks")
+ (with-temp-file (locate-user-emacs-file "elpher2-bookmarks")
(erase-buffer)
- (insert "; Elpher gopher bookmarks file\n\n"
- "; Bookmarks are stored as a list of (label (type selector host port))\n"
- "; s-expressions, where type is stored as a character (i.e. 49 = ?1).\n"
- "; Feel free to edit by hand, but ensure this structure remains intact.\n\n")
+ (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"))
+ (insert-file-contents (locate-user-emacs-file "elpher2-bookmarks"))
(goto-char (point-min))
(read (current-buffer)))))
(defun elpher-add-address-bookmark (address display-string)
- "Save a bookmark for ADDRESS with label 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)))
- (let ((existing-bookmark (rassoc (list address) bookmarks)))
+ (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)
- (add-to-list 'bookmarks (elpher-make-bookmark display-string address))))
+ (add-to-list 'bookmarks (elpher-make-bookmark display-string url))))
(elpher-save-bookmarks bookmarks)))
(defun elpher-remove-address-bookmark (address)
"Remove any bookmark to ADDRESS."
+ (let ((url (elpher-address-to-url address)))
(elpher-save-bookmarks
(seq-filter (lambda (bookmark)
- (not (equal (elpher-bookmark-address bookmark) address)))
- (elpher-load-bookmarks))))
-
+ (not (equal (elpher-bookmark-url bookmark) url)))
+ (elpher-load-bookmarks)))))
;;; Interactive procedures
;;
(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 host-or-url)
- (let ((selector (read-string "Selector (default none): " nil nil ""))
- (port-string (read-string "Port (default 70): " nil nil "70")))
- (elpher-make-node (concat "gopher://" host-or-url
- ":" port-string
- "/1" selector)
- (elpher-make-gopher-address ?1 selector host-or-url
- (string-to-number port-string))))))))
+ (elpher-make-node host-or-url
+ (elpher-address-from-url host-or-url)))))
(switch-to-buffer "*elpher*")
(elpher-visit-node node)))
(let ((address (elpher-node-address elpher-current-node)))
(if (elpher-address-special-p address)
(error "Command not valid for this page")
- (let ((url (read-string "URL: " (elpher-get-address-url address))))
- (if (string-match elpher-url-regex url)
- (let ((new-node (elpher-make-node-from-matched-url url)))
- (unless (equal (elpher-node-address new-node) address)
- (elpher-visit-node new-node)))
- (error "Could not parse URL %s" url))))))
+ (let ((url (read-string "URL: " (elpher-address-to-url address))))
+ (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
(defun elpher-redraw ()
"Redraw current page."
(host (elpher-address-host address)))
(if host
(let ((host (elpher-address-host address))
- (selector (elpher-address-selector address))
+ (selector (elpher-gopher-address-selector address))
(port (elpher-address-port address)))
(if (> (length selector) 0)
(let ((root-address (elpher-make-gopher-address ?1 "" host port)))
(elpher-visit-node
- (elpher-make-node (concat "gopher://" host
- ":" (number-to-string port)
- "/1/")
- root-address)))
+ (elpher-make-node (elpher-address-to-url root-address))))
(error "Already at root directory of current server")))
(error "Command invalid for this page"))))
(defun elpher-bookmarks-current-p ()
"Return non-nil if current node is a bookmarks page."
- (eq (elpher-address-type (elpher-node-address elpher-current-node)) 'bookmarks))
+ (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."
"Display information on NODE."
(let ((display-string (elpher-node-display-string node))
(address (elpher-node-address node)))
- (if (not (elpher-address-special-p 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."
(let ((address (elpher-node-address node)))
(if (elpher-address-special-p address)
(error (format "Cannot represent %s as URL" (elpher-node-display-string node)))
- (let ((url (elpher-get-address-url address)))
+ (let ((url (elpher-address-to-url address)))
(message "Copied \"%s\" to kill-ring/clipboard." url)
(kill-new url)))))
(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
The Lambda Lab / projects / elpher.git / blobdiff