X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=fc187410dea19b8034ebee2efa8ababadf4c7ea6;hb=368016ccbc72a248fc00aaaf25fb72ba69b61141;hp=141ab77e6cf2e86d1bbbfc4d5ea81884037c09fb;hpb=30434bceb51b26fcdcabb15710525de6a8ad02e0;p=elpher.git diff --git a/elpher.el b/elpher.el index 141ab77..fc18741 100644 --- a/elpher.el +++ b/elpher.el @@ -1,15 +1,61 @@ -;;; elpher.el --- elisp gopher client +;;; elpher.el --- Full-featured gopher client. + +;; Copyright (C) 2019 Tim Vaughan + +;; Author: Tim Vaughan +;; Created: 11 April 2019 +;; Version: 1.1.0 +;; Keywords: comm gopher +;; Homepage: https://github.com/tgvaughan/elpher +;; Package-Requires: ((emacs "25")) + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . ;;; Commentary: -;; An elisp gopher client. +;; Elpher aims to provide a full-featured gopher client for GNU Emacs. +;; It supports: + +;; - intuitive keyboard and mouse-driven browsing, +;; - caching of visited sites (both content and cursor position), +;; - pleasant and configurable colouring of Gopher directories, +;; - direct visualisation of image files, +;; - (m)enu key support, similar to Emacs' info browser, +;; - clickable web and gopher links in plain text. + +;; Visited pages are stored as a hierarchy rather than a linear history, +;; meaning that navigation between these pages is quick and easy. + +;; To launch Elpher, simply use 'M-x elpher'. This will open a start +;; page containing information on key bindings and suggested starting +;; points for your gopher exploration. + +;; Faces, caching options and start page can be configured via +;; the Elpher customization group in Applications. ;;; Code: +(provide 'elpher) +(require 'seq) +(require 'pp) + ;;; Global constants ;; -(defconst elpher-version "1.0.0" +(defconst elpher-version "1.1.0" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -19,17 +65,21 @@ (mapconcat 'identity (list "i\tfake\tfake\t1" - "i--------------------------------------------\tfake\tfake\t1" - "i Elpher Gopher Client \tfake\tfake\t1" - (format "i version %s\tfake\tfake\t1" elpher-version) - "i--------------------------------------------\tfake\tfake\t1" + "i --------------------------------------------\tfake\tfake\t1" + "i Elpher Gopher Client \tfake\tfake\t1" + (format "i version %s\tfake\tfake\t1" elpher-version) + "i --------------------------------------------\tfake\tfake\t1" "i\tfake\tfake\t1" - "iBasic usage:\tfake\tfake\t1" + "iUsage:\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 - tab/shift-tab: next/prev item on current page\tfake\tfake\t1" + "i - RET/mouse-1: open item under cursor\tfake\tfake\t1" + "i - m: select an item on current page by name (autocompletes)\tfake\tfake\t1" + "i - u: return to parent\tfake\tfake\t1" + "i - O: visit the root menu of the current server\tfake\tfake\t1" + "i - g: go to a particular menu or item\tfake\tfake\t1" + "i - i/I: info on item under cursor or current page\tfake\tfake\t1" + "i - c/C: copy URL representation of item under cursor or current page\tfake\tfake\t1" "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1" "i - R: reload current page (regenerates cache)\tfake\tfake\t1" "i - d: download directory entry under cursor\tfake\tfake\t1" @@ -43,10 +93,24 @@ "isearch terms:\tfake\tfake\t1" "i\tfake\tfake\t1" "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70" - ".") + ".\r\n") "\r\n") "Source for elpher start page.") +(defconst elpher-type-map + '((?0 elpher-get-text-node "T" elpher-text) + (?1 elpher-get-index-node "/" elpher-index) + (?4 elpher-get-node-download "B" elpher-binary) + (?5 elpher-get-node-download "B" elpher-binary) + (?7 elpher-get-search-node "?" elpher-search) + (?8 elpher-get-telnet-node "?" elpher-telnet) + (?9 elpher-get-node-download "B" elpher-binary) + (?g elpher-get-image-node "im" elpher-image) + (?p elpher-get-image-node "im" elpher-image) + (?I elpher-get-image-node "im" elpher-image) + (?h elpher-get-url-node "W" elpher-url)) + "Association list from types to getters, margin codes and index faces.") + ;;; Customization group ;; @@ -55,99 +119,126 @@ "A gopher client." :group 'applications) +;; Face customizations + (defface elpher-index - '((((background dark)) :foreground "deep sky blue") - (((background light)) :foreground "blue")) - "Face used for index records.") + '((t :inherit font-lock-keyword-face)) + "Face used for directory type directory records.") (defface elpher-text - '((((background dark)) :foreground "white") - (((background light)) :weight bold)) - "Face used for text records.") + '((t :inherit bold)) + "Face used for text type directory records.") -(defface elpher-info '() - "Face used for info records.") +(defface elpher-info + '((t :inherit default)) + "Face used for info type directory records.") (defface elpher-image - '((((background dark)) :foreground "green") - (t :foreground "dark green")) - "Face used for image records.") + '((t :inherit font-lock-string-face)) + "Face used for image type directory records.") (defface elpher-search - '((((background light)) :foreground "orange") - (((background dark)) :foreground "dark orange")) - "Face used for search records.") + '((t :inherit warning)) + "Face used for search type directory records.") (defface elpher-url - '((((background dark)) :foreground "yellow") - (((background light)) :foreground "dark red")) - "Face used for url records.") + '((t :inherit font-lock-comment-face)) + "Face used for url type directory records.") + +(defface elpher-telnet + '((t :inherit font-lock-function-name-face)) + "Face used for telnet type directory records.") (defface elpher-binary - '((t :foreground "magenta")) - "Face used for binary records.") + '((t :inherit font-lock-doc-face)) + "Face used for binary type directory records.") (defface elpher-unknown - '((t :foreground "red")) - "Face used for unknown record types.") + '((t :inherit error)) + "Face used for directory records with unknown/unsupported types.") (defface elpher-margin-key - '((((background dark)) :foreground "white")) - "Face used for margin key.") + '((t :inherit bold)) + "Face used for directory margin key.") (defface elpher-margin-brackets - '((t :foreground "blue")) - "Face used for brackets around margin key.") + '((t :inherit shadow)) + "Face used for brackets around directory margin key.") + +;; Other customizations (defcustom elpher-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)) +(defcustom elpher-buttonify-urls-in-directories nil + "If non-nil, turns URLs matched in directories into clickable buttons." + :type '(boolean)) + +(defcustom elpher-cache-images nil + "If non-nil, cache images in memory in the same way as other content." + :type '(boolean)) + +(defcustom elpher-start-address nil + "If nil, the default start directory is shown when Elpher is started. +Otherwise, a list containing the selector, host and port of a directory to +use as the start page." + :type '(list string string integer)) + +(defcustom elpher-use-header t + "If non-nil, display current node information in buffer header." + :type '(boolean)) + ;;; Model ;; ;; Address -(defun elpher-make-address (selector host port) - "Create an address of a gopher object with SELECTOR, HOST and PORT." - (list selector host port)) +(defun elpher-make-address (type selector host port) + "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT." + (list type selector host port)) + +(defun elpher-address-type (address) + "Retrieve type from ADDRESS." + (elt address 0)) (defun elpher-address-selector (address) "Retrieve selector from ADDRESS." - (car address)) + (elt address 1)) (defun elpher-address-host (address) "Retrieve host from ADDRESS." - (cadr address)) + (elt address 2)) (defun elpher-address-port (address) "Retrieve port from ADDRESS." - (caddr address)) + (elt address 3)) ;; Node -(defun elpher-make-node (parent address getter &optional content pos) +(defun elpher-make-node (display-string parent address &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. +DISPLAY-STRING records the display string used for the page. + +PARENT specifies the parent of the node, and ADDRESS specifies the +address of the gopher page. 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)) + (list display-string parent address content pos)) + +(defun elpher-node-display-string (node) + "Retrieve the display string of NODE." + (elt node 0)) (defun elpher-node-parent (node) "Retrieve the parent node of NODE." - (elt node 0)) + (elt node 1)) (defun elpher-node-address (node) "Retrieve the address of NODE." - (elt node 1)) - -(defun elpher-node-getter (node) - "Retrieve the preferred getter function of NODE." (elt node 2)) (defun elpher-node-content (node) @@ -168,16 +259,25 @@ content and cursor position fields of the node." ;; Node graph traversal -(defvar elpher-current-node) +(defvar elpher-current-node nil) (defun elpher-visit-node (node &optional getter) "Visit NODE using its own getter or GETTER, if non-nil." (elpher-save-pos) (elpher-process-cleanup) (setq elpher-current-node node) + (with-current-buffer "*elpher*" + (setq header-line-format "hello")) + ;; (let ((inhibit-read-only t)) + + ;; (force-mode-line-update)) (if getter (funcall getter) - (funcall (elpher-node-getter node)))) + (let* ((address (elpher-node-address node)) + (type (if address + (elpher-address-type address) + ?1))) + (funcall (car (alist-get type elpher-type-map)))))) (defun elpher-visit-parent-node () "Visit the parent of the current node." @@ -202,26 +302,55 @@ content and cursor position fields of the node." (goto-char pos) (goto-char (point-min))))) + ;;; Buffer preparation ;; +(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)))) + (defmacro elpher-with-clean-buffer (&rest args) "Evaluate ARGS with a clean *elpher* buffer as current." - (list 'progn - '(switch-to-buffer "*elpher*") + (list 'with-current-buffer "*elpher*" '(elpher-mode) (append (list 'let '((inhibit-read-only t)) - '(erase-buffer)) + '(erase-buffer) + '(elpher-update-header)) args))) + ;;; Index rendering ;; +(defun elpher-preprocess-text-response (string) + "Clear away CRs and terminating period from STRING." + (replace-regexp-in-string "\n\.\n$" "\n" + (replace-regexp-in-string "\r" "" + string))) + (defun elpher-insert-index (string) "Insert the index corresponding to STRING into the current buffer." - (dolist (line (split-string string "\r\n")) - (unless (= (length line) 0) - (elpher-insert-index-record line)))) + ;; Should be able to split directly on CRLF, but some non-conformant + ;; LF-only servers sadly exist, hence the following. + (let ((str-processed (elpher-preprocess-text-response string)) + formatting-error) + (dolist (line (split-string str-processed "\n")) + (unless (= (length line) 0) + (let* ((type (elt line 0)) + (fields (split-string (substring line 1) "\t")) + (display-string (elt fields 0)) + (selector (elt fields 1)) + (host (elt fields 2)) + (port (if (elt fields 3) + (string-to-number (elt fields 3)) + nil))) + (if (< (length fields) 4) + (setq formatting-error t)) + (elpher-insert-index-record display-string type selector host port)))) + (if formatting-error + (display-warning :warning "One or more badly formatted index records detected.")))) (defun elpher-insert-margin (&optional type-name) "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." @@ -235,60 +364,53 @@ content and cursor position fields of the node." (insert " ")) (insert (make-string elpher-margin-width ?\s)))) -(defvar elpher-type-map - '((?0 elpher-get-text-node "T" elpher-text) - (?1 elpher-get-index-node "/" elpher-index) - (?g elpher-get-image-node "im" elpher-image) - (?p elpher-get-image-node "im" elpher-image) - (?I elpher-get-image-node "im" elpher-image) - (?4 elpher-get-node-download "B" elpher-binary) - (?5 elpher-get-node-download "B" elpher-binary) - (?9 elpher-get-node-download "B" elpher-binary) - (?7 elpher-get-search-node "?" elpher-search)) - "Association list from types to getters, margin codes and index faces.") - -(defun elpher-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 (elpher-make-address selector host port)) - (type-map-entry (alist-get type elpher-type-map))) +(defun elpher-node-button-help (node) + "Return a string containing the help text for a button corresponding to NODE." + (let ((address (elpher-node-address node))) + (if (eq (elpher-address-type address) ?h) + (let ((url (cadr (split-string (elpher-address-selector address) "URL:")))) + (format "mouse-1, RET: open url '%s'" url)) + (format "mouse-1, RET: open '%s' on %s port %s" + (elpher-address-selector address) + (elpher-address-host address) + (elpher-address-port address))))) + +(defun elpher-insert-index-record (display-string type selector host port) + "Function to insert an index record into the current buffer. +The contents of the record are dictated by TYPE, DISPLAY-STRING, SELECTOR, HOST +and PORT." + (let ((address (elpher-make-address type selector host port)) + (type-map-entry (alist-get type elpher-type-map))) (if type-map-entry - (let ((getter (car type-map-entry)) - (margin-code (cadr type-map-entry)) - (face (caddr type-map-entry))) + (let* ((margin-code (cadr type-map-entry)) + (face (caddr type-map-entry)) + (node (elpher-make-node display-string elpher-current-node address))) (elpher-insert-margin margin-code) (insert-text-button display-string 'face face - 'elpher-node (elpher-make-node elpher-current-node - address - getter) + 'elpher-node node 'action #'elpher-click-link 'follow-link t - 'help-echo (format "mouse-1, RET: open %s on %s port %s" - selector host port))) + 'help-echo (elpher-node-button-help node))) (pcase type - (?i (elpher-insert-margin) ; Information - (insert (propertize display-string - 'face 'elpher-info))) - (?h (elpher-insert-margin "W") ; Web link - (let ((url (elt (split-string selector "URL:") 1))) - (insert-text-button display-string - 'face 'elpher-url - 'elpher-url url - 'action #'elpher-click-url - 'follow-link t - 'help-echo (format "mouse-1, RET: open url %s" url)))) - (?.) ; Occurs at end of index, can safely ignore. - (tp (elpher-insert-margin (concat (char-to-string tp) "?")) - (insert (propertize display-string - 'face 'elpher-unknown-face))))) + (?i ;; Information + (elpher-insert-margin) + (insert (propertize + (if elpher-buttonify-urls-in-directories + (elpher-buttonify-urls display-string) + display-string) + 'face 'elpher-info))) + (other ;; Unknown + (elpher-insert-margin (concat (char-to-string type) "?")) + (insert (propertize display-string + 'face 'elpher-unknown-face))))) (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))) + ;;; Selector retrieval (all kinds) ;; @@ -302,7 +424,7 @@ content and cursor position fields of the node." (defun elpher-get-selector (address after) "Retrieve selector specified by ADDRESS, then execute AFTER. -The result is stored as a string in the variable elpher-selector-string." +The result is stored as a string in the variable ‘elpher-selector-string’." (setq elpher-selector-string "") (make-network-process :name "elpher-process" @@ -323,8 +445,8 @@ The result is stored as a string in the variable elpher-selector-string." (if content (progn (elpher-with-clean-buffer - (insert content)) - (elpher-restore-pos)) + (insert content) + (elpher-restore-pos))) (if address (progn (elpher-with-clean-buffer @@ -333,66 +455,70 @@ The result is stored as a string in the variable elpher-selector-string." (lambda (proc event) (unless (string-prefix-p "deleted" event) (elpher-with-clean-buffer - (elpher-insert-index elpher-selector-string)) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (buffer-string)))))) + (elpher-insert-index elpher-selector-string) + (elpher-restore-pos) + (elpher-set-node-content elpher-current-node + (buffer-string))))))) (progn (elpher-with-clean-buffer - (elpher-insert-index elpher-start-index)) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (buffer-string))))))) + (elpher-insert-index elpher-start-index) + (elpher-restore-pos) + (elpher-set-node-content elpher-current-node + (buffer-string)))))))) ;; Text retrieval (defconst elpher-url-regex - "\\(https?\\|gopher\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?" + "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?" "Regexp used to locate and buttinofy URLs in text files loaded by elpher.") +(defun elpher-make-node-from-matched-url (parent &optional string) + "Convert most recent `elpher-url-regex' match to a node. + +PARENT defines the node to set as the parent to the new node. + +If STRING is non-nil, this is given as an argument to all `match-string' +calls, as is necessary if the match is performed by `string-match'." + (let ((url (match-string 0 string)) + (protocol (downcase (match-string 1 string)))) + (if (string= protocol "gopher") + (let* ((host (match-string 2 string)) + (port (if (> (length (match-string 3 string)) 1) + (string-to-number (substring (match-string 3 string) 1)) + 70)) + (type-and-selector (match-string 4 string)) + (type (if (> (length type-and-selector) 1) + (elt type-and-selector 1) + ?1)) + (selector (if (> (length type-and-selector) 1) + (substring type-and-selector 2) + "")) + (address (elpher-make-address type selector host port))) + (elpher-make-node url elpher-current-node address)) + (let* ((host (match-string 2 string)) + (port (if (> (length (match-string 3 string)) 1) + (string-to-number (substring (match-string 3 string) 1)) + 70)) + (selector (concat "URL:" url)) + (address (elpher-make-address ?h selector host port))) + (elpher-make-node url elpher-current-node address))))) + + (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 ((url (match-string 0)) - (protocol (downcase (match-string 1)))) - (if (string= protocol "gopher") - (let* ((host (match-string 2)) - (port 70) - (type-and-selector (match-string 4)) - (type (if (> (length type-and-selector) 1) - (elt type-and-selector 1) - ?1)) - (selector (if (> (length type-and-selector) 1) - (substring type-and-selector 2) - "")) - (address (elpher-make-address selector host port)) - (getter (car (alist-get type elpher-type-map)))) - (make-text-button (match-beginning 0) - (match-end 0) - 'elpher-node (elpher-make-node elpher-current-node - address - getter) - 'action #'elpher-click-link - 'follow-link t - 'help-echo (format "mouse-1, RET: open %s on %s port %s" - selector host port))) + (let ((node (elpher-make-node-from-matched-url elpher-current-node))) (make-text-button (match-beginning 0) (match-end 0) - 'elpher-url url - 'action #'elpher-click-url + 'elpher-node node + 'action #'elpher-click-link 'follow-link t - 'help-echo (format "mouse-1, RET: open url %s" url))))) + 'help-echo (elpher-node-button-help node)))) (buffer-string))) -(defun elpher-process-text (string) - "Remove CRs and trailing period from the gopher text document STRING." - (let* ((chopped-str (replace-regexp-in-string "\r\n\.\r\n$" "\r\n" string)) - (cleaned-str (replace-regexp-in-string "\r" "" chopped-str))) - (elpher-buttonify-urls cleaned-str))) - (defun elpher-get-text-node () "Getter which retrieves the current node contents as a text document." (let ((content (elpher-node-content elpher-current-node)) @@ -400,8 +526,8 @@ The result is stored as a string in the variable elpher-selector-string." (if content (progn (elpher-with-clean-buffer - (insert content)) - (elpher-restore-pos)) + (insert content) + (elpher-restore-pos))) (progn (elpher-with-clean-buffer (insert "LOADING TEXT...")) @@ -409,10 +535,12 @@ The result is stored as a string in the variable elpher-selector-string." (lambda (proc event) (unless (string-prefix-p "deleted" event) (elpher-with-clean-buffer - (insert (elpher-process-text elpher-selector-string))) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - (buffer-string))))))))) + (insert (elpher-buttonify-urls + (elpher-preprocess-text-response + elpher-selector-string))) + (elpher-restore-pos) + (elpher-set-node-content elpher-current-node + (buffer-string)))))))))) ;; Image retrieval @@ -423,25 +551,27 @@ The result is stored as a string in the variable elpher-selector-string." (if content (progn (elpher-with-clean-buffer - (insert-image content)) - (setq cursor-type nil) - (elpher-restore-pos)) - (progn - (elpher-with-clean-buffer - (insert "LOADING IMAGE...")) - (elpher-get-selector address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (let ((image (create-image - (encode-coding-string elpher-selector-string - 'no-conversion) - nil t))) - (elpher-with-clean-buffer - (insert-image image)) - (setq cursor-type nil) - (elpher-restore-pos) - (elpher-set-node-content elpher-current-node - image))))))))) + (insert-image content) + (elpher-restore-pos))) + (if (display-images-p) + (progn + (elpher-with-clean-buffer + (insert "LOADING IMAGE...")) + (elpher-get-selector address + (lambda (proc event) + (unless (string-prefix-p "deleted" event) + (let ((image (create-image + (encode-coding-string + elpher-selector-string + 'no-conversion) + nil t))) + (elpher-with-clean-buffer + (insert-image image) + (elpher-restore-pos)) + (if elpher-cache-images + (elpher-set-node-content elpher-current-node + image))))))) + (elpher-get-node-download))))) ;; Search retrieval @@ -453,15 +583,16 @@ The result is stored as a string in the variable elpher-selector-string." (if content (progn (elpher-with-clean-buffer - (insert content)) - (elpher-restore-pos) + (insert content) + (elpher-restore-pos)) (message "Displaying cached search results. Reload to perform a new search.")) (unwind-protect (let* ((query-string (read-string "Query: ")) (query-selector (concat (elpher-address-selector address) "\t" query-string)) - (search-address (elpher-make-address query-selector - (elpher-address-host address) - (elpher-address-port address)))) + (search-address (elpher-make-address ?1 + query-selector + (elpher-address-host address) + (elpher-address-port address)))) (setq aborted nil) (elpher-with-clean-buffer (insert "LOADING RESULTS...")) @@ -489,8 +620,8 @@ The result is stored as a string in the variable elpher-selector-string." (lambda (proc event) (unless (string-prefix-p "deleted" event) (elpher-with-clean-buffer - (insert elpher-selector-string)) - (goto-char (point-min))))) + (insert elpher-selector-string) + (goto-char (point-min)))))) (progn (elpher-with-clean-buffer (insert elpher-start-index)) @@ -522,8 +653,126 @@ The result is stored as a string in the variable elpher-selector-string." (message (format "Download complate, saved to file %s." elpher-download-filename))))))))) +;; URL retrieval + +(defun elpher-get-url-node () + "Getter which attempts to open the URL specified by the current node." + (let* ((address (elpher-node-address elpher-current-node)) + (selector (elpher-address-selector address))) + (elpher-visit-parent-node) ; Do first in case of non-local exits. + (let ((url (elt (split-string selector "URL:") 1))) + (if elpher-open-urls-with-eww + (browse-web url) + (browse-url url))))) + +;; Telnet node connection + +(defun elpher-get-telnet-node () + "Getter which opens a telnet connection to the server specified by the current node." + (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))) + + +;;; Bookmarks +;; + +(defun elpher-make-bookmark (display-string address) + "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)) + +(defun elpher-bookmark-display-string (bookmark) + "Get the display string of BOOKMARK." + (elt bookmark 0)) + +(defun elpher-bookmark-address (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") + (erase-buffer) + (pp bookmarks (current-buffer)))) + +(defun elpher-load-bookmarks () + "Get the list of bookmarks from the users's bookmark file." + (with-temp-buffer + (ignore-errors + (insert-file-contents (locate-user-emacs-file "elpher-bookmarks")) + (goto-char (point-min)) + (read (current-buffer))))) + +(defun elpher-add-node-bookmark (node) + "Add bookmark to NODE to the saved list of bookmarks." + (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node) + (elpher-node-address node))) + (bookmarks (elpher-load-bookmarks))) + (add-to-list 'bookmarks bookmark) + (elpher-save-bookmarks bookmarks))) + +(defun elpher-remove-node-bookmark (node) + "Remove bookmark to NODE from the saved list of bookmarks." + (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node) + (elpher-node-address node)))) + (elpher-save-bookmarks + (seq-filter (lambda (this-bookmark) + (not (equal bookmark this-bookmark))) + (elpher-load-bookmarks))))) + +(defun elpher-display-bookmarks () + "Display saved bookmark list." + (interactive) + (elpher-with-clean-buffer + (insert "Use 'r' to return to the previous page.\n\n" + "---- Bookmark list ----\n\n") + (let ((bookmarks (elpher-load-bookmarks))) + (if bookmarks + (dolist (bookmark bookmarks) + (let ((display-string (elpher-bookmark-display-string bookmark)) + (address (elpher-bookmark-address bookmark))) + (elpher-insert-index-record display-string + (elpher-address-type address) + (elpher-address-selector address) + (elpher-address-host address) + (elpher-address-port address)))) + (insert "No bookmarks found.\n"))) + (insert "\n-----------------------") + (goto-char (point-min)) + (elpher-next-link))) + +(defun elpher-bookmark-current () + "Bookmark the current node." + (interactive) + (elpher-add-node-bookmark elpher-current-node)) + +(defun elpher-bookmark-link () + "Bookmark the link at point." + (interactive) + (let ((button (button-at (point)))) + (if button + (elpher-add-node-bookmark (button-get button 'elpher-node)) + (error "No link selected")))) + +(defun elpher-unbookmark-current () + "Remove bookmark for the current node." + (interactive) + (elpher-remove-node-bookmark elpher-current-node)) + +(defun elpher-unbookmark-link () + "Remove bookmark for the link at point." + (interactive) + (let ((button (button-at (point)))) + (if button + (elpher-remove-node-bookmark (button-get button 'elpher-node)) + (error "No link selected")))) -;;; Navigation procedures +;;; Interactive navigation procedures ;; (defun elpher-next-link () @@ -536,18 +785,6 @@ The result is stored as a string in the variable elpher-selector-string." (interactive) (backward-button 1)) -(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-click-url (button) - "Function called when the url link BUTTON is activated (via mouse or keypress)." - (let ((url (button-get button 'elpher-url))) - (if elpher-open-urls-with-eww - (browse-web url) - (browse-url url)))) - (defun elpher-follow-current-link () "Open the link or url at point." (interactive) @@ -556,38 +793,50 @@ The result is stored as a string in the variable elpher-selector-string." (defun elpher-go () "Go to a particular gopher site." (interactive) - (let* ( - (hostname (read-string "Gopher host: ")) - (selector (read-string "Selector (default none): " nil nil "")) - (port (read-string "Port (default 70): " nil nil 70)) - (address (list selector hostname port))) - (elpher-visit-node - (elpher-make-node elpher-current-node - address - #'elpher-get-index-node)))) + (let ((node + (let ((host-or-url (read-string "Gopher host or URL: "))) + (if (string-match elpher-url-regex host-or-url) + (elpher-make-node-from-matched-url elpher-current-node + host-or-url) + (let ((selector (read-string "Selector (default none): " nil nil "")) + (port (string-to-number (read-string "Port (default 70): " + nil nil 70)))) + (elpher-make-node (concat "gopher://" host-or-url + ":" port + "/1" selector) + elpher-current-node + (elpher-make-address ?1 selector host-or-url port))))))) + (switch-to-buffer "*elpher*") + (elpher-visit-node node))) (defun elpher-redraw () "Redraw current page." (interactive) - (elpher-visit-node elpher-current-node)) + (if elpher-current-node + (elpher-visit-node elpher-current-node) + (message "No current site."))) (defun elpher-reload () "Reload current page." (interactive) - (elpher-reload-current-node)) + (if elpher-current-node + (elpher-reload-current-node) + (message "No current site."))) (defun elpher-view-raw () "View current page as plain text." (interactive) - (elpher-visit-node elpher-current-node - #'elpher-get-node-raw)) + (if elpher-current-node + (elpher-visit-node elpher-current-node + #'elpher-get-node-raw) + (message "No current site."))) (defun elpher-back () "Go to previous site." (interactive) (if (elpher-node-parent elpher-current-node) (elpher-visit-parent-node) - (message "No previous site."))) + (error "No previous site"))) (defun elpher-download () "Download the link at point." @@ -597,9 +846,107 @@ The result is stored as a string in the variable elpher-selector-string." (let ((node (button-get button 'elpher-node))) (if node (elpher-visit-node (button-get button 'elpher-node) - #'elpher-get-node-download) - (message "Can only download gopher links, not general URLs."))) - (message "No link selected.")))) + #'elpher-get-node-download) + (error "Can only download gopher links, not general URLs"))) + (error "No link selected")))) + +(defun elpher-build-link-map () + "Build alist mapping link names to destination nodes in current buffer." + (let ((link-map nil) + (b (next-button (point-min) t))) + (while b + (add-to-list 'link-map (cons (button-label b) b)) + (setq b (next-button (button-start b)))) + link-map)) + +(defun elpher-menu () + "Select a directory entry by name. Similar to the info browser (m)enu command." + (interactive) + (let* ((link-map (elpher-build-link-map))) + (if link-map + (let ((key (let ((completion-ignore-case t)) + (completing-read "Directory entry/link (tab to autocomplete): " + link-map nil t)))) + (if (and key (> (length key) 0)) + (let ((b (cdr (assoc key link-map)))) + (goto-char (button-start b)) + (button-activate b))))))) + +(defun elpher-root-dir () + "Visit root of current server." + (interactive) + (let ((address (elpher-node-address elpher-current-node))) + (if address + (let ((host (elpher-address-host address)) + (selector (elpher-address-selector address)) + (port (elpher-address-port address))) + (if (> (length selector) 0) + (let ((root-address (elpher-make-address ?1 "" host port))) + (elpher-visit-node + (elpher-make-node (concat "gopher://" host + ":" (number-to-string port) + "/1/") + elpher-current-node + root-address))) + (error "Already at root directory of current server"))) + (error "Command invalid for Elpher start page")))) + +(defun elpher-info-node (node) + "Display information on NODE." + (let ((display-string (elpher-node-display-string node)) + (address (elpher-node-address node))) + (if address + (message "`%s' on %s port %s" + (elpher-address-selector address) + (elpher-address-host address) + (elpher-address-port address)) + (message "%s" display-string)))) + +(defun elpher-info-link () + "Display information on node corresponding to link at point." + (interactive) + (let ((button (button-at (point)))) + (if button + (elpher-info-node (button-get button 'elpher-node)) + (error "No item selected")))) + +(defun elpher-info-current () + "Display information on current node." + (interactive) + (elpher-info-node elpher-current-node)) + +(defun elpher-get-address-url (address) + "Get URL representation of ADDRESS." + (concat "gopher://" + (elpher-address-host address) + (let ((port (elpher-address-port address))) + (if (equal port 70) + "" + (format ":%d" port))) + "/" (string (elpher-address-type address)) + (elpher-address-selector address))) + +(defun elpher-copy-node-url (node) + "Copy URL representation of address of NODE to `kill-ring'." + (let ((address (elpher-node-address node))) + (if address + (let ((url (elpher-get-address-url address))) + (message url) + (kill-new url)) + (error (format "Cannot represent %s as URL" (elpher-node-display-string node)))))) + +(defun elpher-copy-link-url () + "Copy URL of item at point to `kill-ring'." + (interactive) + (let ((button (button-at (point)))) + (if button + (elpher-copy-node-url (button-get button 'elpher-node)) + (error "No item selected")))) + +(defun elpher-copy-current-url () + "Copy URL of current node to `kill-ring'." + (interactive) + (elpher-copy-node-url elpher-current-node)) ;;; Mode and keymap ;; @@ -609,28 +956,47 @@ The result is stored as a string in the variable elpher-selector-string." (define-key map (kbd "TAB") 'elpher-next-link) (define-key map (kbd "") 'elpher-prev-link) (define-key map (kbd "u") 'elpher-back) + (define-key map (kbd "O") 'elpher-root-dir) (define-key map (kbd "g") 'elpher-go) (define-key map (kbd "r") 'elpher-redraw) (define-key map (kbd "R") 'elpher-reload) (define-key map (kbd "w") 'elpher-view-raw) (define-key map (kbd "d") 'elpher-download) + (define-key map (kbd "m") 'elpher-menu) + (define-key map (kbd "i") 'elpher-info-link) + (define-key map (kbd "I") 'elpher-info-current) + (define-key map (kbd "c") 'elpher-copy-link-url) + (define-key map (kbd "C") 'elpher-copy-current-url) (when (fboundp 'evil-define-key) - (evil-define-key 'normal map + (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 + (kbd "O") 'elpher-root-dir (kbd "g") 'elpher-go (kbd "r") 'elpher-redraw (kbd "R") 'elpher-reload (kbd "w") 'elpher-view-raw - (kbd "d") 'elpher-download)) + (kbd "d") 'elpher-download + (kbd "m") 'elpher-menu + (kbd "i") 'elpher-info-link + (kbd "I") 'elpher-info-current + (kbd "c") 'elpher-copy-link-url + (kbd "C") 'elpher-copy-current-url + (kbd "a") 'elpher-bookmark-link + (kbd "A") 'elpher-bookmark-current + (kbd "x") 'elpher-unbookmark-link + (kbd "X") 'elpher-unbookmark-current + (kbd "B") 'elpher-display-bookmarks)) map) "Keymap for gopher client.") (define-derived-mode elpher-mode special-mode "elpher" "Major mode for elpher, an elisp gopher client.") +(when (fboundp 'evil-set-initial-state) + (evil-set-initial-state 'elpher-mode 'motion)) ;;; Main start procedure ;; @@ -639,9 +1005,13 @@ The result is stored as a string in the variable elpher-selector-string." (defun elpher () "Start elpher with default landing page." (interactive) - (setq elpher-current-node nil) - (let ((start-node (elpher-make-node nil nil #'elpher-get-index-node))) - (elpher-visit-node start-node)) + (if (get-buffer "*elpher*") + (switch-to-buffer "*elpher*") + (switch-to-buffer "*elpher*") + (setq elpher-current-node nil) + (let ((start-node (elpher-make-node "Elpher Start Page" + nil elpher-start-address))) + (elpher-visit-node start-node))) "Started Elpher.") ; Otherwise (elpher) evaluates to start page string. ;;; elpher.el ends here