X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=0e9a5cd4f26a4f5a6dc288e85faec49c11d5fab8;hb=c817252f78512fa3b45892adc3da855d79377c55;hp=51309f7c2345857f1229c285162120662d62dfd4;hpb=327849c1705cd459284775025076887eb3558c33;p=elpher.git diff --git a/elpher.el b/elpher.el index 51309f7..0e9a5cd 100644 --- a/elpher.el +++ b/elpher.el @@ -72,12 +72,13 @@ "i\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 - m: select a directory entry by name (autocompletes)\tfake\tfake\t1" - "i - u: return to parent directory entry\tfake\tfake\t1" - "i - O: visit the root directory of the current server\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 - 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" @@ -98,14 +99,14 @@ (defconst 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) (?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.") @@ -184,51 +185,59 @@ 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) @@ -256,9 +265,18 @@ content and cursor position fields of the node." (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." @@ -287,12 +305,18 @@ content and cursor position fields of the node." ;;; 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 'with-current-buffer "*elpher*" '(elpher-mode) (append (list 'let '((inhibit-read-only t)) - '(erase-buffer)) + '(erase-buffer) + '(elpher-update-header)) args))) @@ -324,7 +348,7 @@ content and cursor position fields of the 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 (eq (elpher-node-getter node) #'elpher-get-url-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" @@ -339,42 +363,41 @@ content and cursor position fields of the node." (display-string (elt fields 0)) (selector (elt fields 1)) (host (elt fields 2)) - (port (elt fields 3))) - (elpher-insert-index-record-helper type display-string selector host port))) + (port (string-to-number (elt fields 3)))) + (elpher-insert-index-record-helper display-string type selector host port))) -(defun elpher-insert-index-record-helper (type display-string selector host port) +(defun elpher-insert-index-record-helper (display-string type selector host port) "Helper 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. This function is essentially the second half of `elpher-insert-index-record', -but broken out so that it can be used by other functions to construct indices -on the fly." - (let ((address (elpher-make-address selector host port)) +but broken out so that it can be used elsewhere." + (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)) + (let* ((margin-code (cadr type-map-entry)) (face (caddr type-map-entry)) - (node (elpher-make-node elpher-current-node address getter))) + (node (elpher-make-node display-string elpher-current-node address))) (elpher-insert-margin margin-code) (insert-text-button display-string 'face face 'elpher-node node - 'elpher-node-type type 'action #'elpher-click-link 'follow-link t 'help-echo (elpher-node-button-help node))) (pcase type - (?i (elpher-insert-margin) ;; Information - (insert (propertize - (if elpher-buttonify-urls-in-directories - (elpher-buttonify-urls display-string) - display-string) - 'face 'elpher-info))) - (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) @@ -464,17 +487,15 @@ calls, as is necessary if the match is performed by `string-match'." (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)))) - (elpher-make-node elpher-current-node address getter)) + (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 selector host port)) - (getter (car (alist-get ?h elpher-type-map)))) - (elpher-make-node elpher-current-node address getter))))) + (address (elpher-make-address ?h selector host port))) + (elpher-make-node url elpher-current-node address))))) (defun elpher-buttonify-urls (string) @@ -565,9 +586,10 @@ calls, as is necessary if the match is performed by `string-match'." (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...")) @@ -654,54 +676,65 @@ calls, as is necessary if the match is performed by `string-match'." ;;; Bookmarks ;; -(defun elpher-make-bookmark (type display-string address) - (list type display-string address)) +(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-type (bookmark) - (elt bookmark 0)) - (defun elpher-bookmark-display-string (bookmark) - (elt bookmark 1)) + "Get the display string of BOOKMARK." + (elt bookmark 0)) (defun elpher-bookmark-address (bookmark) - (elt bookmark 2)) + "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 () - (with-temp-buffer + "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-bookmark (bookmark) - (let ((bookmarks (elpher-load-bookmarks))) +(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-bookmark (bookmark) - (elpher-save-bookmarks - (seq-filter (lambda (this-bookmark) - (not (equal bookmark this-bookmark))) - (elpher-load-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 'u' to return to the previous page.\n\n" - "---- Bookmark list ----\n\n") + (insert "Use 'u' to return to the previous page.\n\n" + "---- Bookmark list ----\n\n") (let ((bookmarks (elpher-load-bookmarks))) (if bookmarks - (dolist (bookmark (elpher-load-bookmarks)) - (let ((type (elpher-bookmark-type bookmark)) - (display-string (elpher-bookmark-display-string bookmark)) + (dolist (bookmark bookmarks) + (let ((display-string (elpher-bookmark-display-string bookmark)) (address (elpher-bookmark-address bookmark))) - (elpher-insert-index-record-helper type display-string + (elpher-insert-index-record-helper display-string + (elpher-address-type address) (elpher-address-selector address) (elpher-address-host address) (elpher-address-port address)))) @@ -710,37 +743,30 @@ calls, as is necessary if the match is performed by `string-match'." (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 - (let ((node (button-get button 'elpher-node)) - (type (button-get button 'elpher-node-type)) - (label (button-label button))) - (if node - (progn - (elpher-add-bookmark - (elpher-make-bookmark type - label - (elpher-node-address node))) - (message "Bookmarked \"%s\"" label)) - (error "Can only bookmark gopher links, not general URLs"))) + (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 - (let ((node (button-get button 'elpher-node)) - (type (button-get button 'elpher-node-type))) - (if node - (elpher-remove-bookmark - (elpher-make-bookmark type - (button-label button) - (elpher-node-address node))) - (error "Can only bookmark gopher links, not general URLs"))) + (elpher-remove-node-bookmark (button-get button 'elpher-node)) (error "No link selected")))) ;;; Interactive navigation procedures @@ -770,10 +796,13 @@ calls, as is necessary if the match is performed by `string-match'." (elpher-make-node-from-matched-url elpher-current-node host-or-url) (let ((selector (read-string "Selector (default none): " nil nil "")) - (port (read-string "Port (default 70): " nil nil 70))) - (elpher-make-node elpher-current-node - (elpher-make-address selector host-or-url port) - #'elpher-get-index-node)))))) + (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))) @@ -849,13 +878,39 @@ calls, as is necessary if the match is performed by `string-match'." (selector (elpher-address-selector address)) (port (elpher-address-port address))) (if (> (length selector) 0) - (let ((root-address (elpher-make-address "" host port))) - (elpher-visit-node (elpher-make-node elpher-current-node - root-address - #'elpher-get-index-node))) + (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 link selected")))) + +(defun elpher-info-current () + "Display information on current node." + (interactive) + (elpher-info-node elpher-current-node)) ;;; Mode and keymap ;; @@ -872,8 +927,9 @@ calls, as is necessary if the match is performed by `string-match'." (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) (when (fboundp 'evil-define-key) - (add-to-list 'evil-motion-state-modes 'elpher-mode) (evil-define-key 'motion map (kbd "TAB") 'elpher-next-link (kbd "C-]") 'elpher-follow-current-link @@ -886,8 +942,12 @@ calls, as is necessary if the match is performed by `string-match'." (kbd "w") 'elpher-view-raw (kbd "d") 'elpher-download (kbd "m") 'elpher-menu + (kbd "i") 'elpher-info-link + (kbd "I") 'elpher-info-current (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.") @@ -895,6 +955,8 @@ calls, as is necessary if the match is performed by `string-match'." (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 ;; @@ -907,9 +969,8 @@ calls, as is necessary if the match is performed by `string-match'." (switch-to-buffer "*elpher*") (switch-to-buffer "*elpher*") (setq elpher-current-node nil) - (let ((start-node (elpher-make-node nil - elpher-start-address - #'elpher-get-index-node))) + (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.