X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=b977a8c3ff9c43da57921caa258ad27fea033aca;hb=b3f3e8e887f515cff6807b89fe3170b2c83b5333;hp=b97d19e10bce4c6185df4a2807607df30568a8ec;hpb=b0db00a75efe7a58126eca590a7e50322ccd123f;p=elpher.git

diff --git a/elpher.el b/elpher.el
index b97d19e..b977a8c 100644
--- a/elpher.el
+++ b/elpher.el
@@ -26,7 +26,26 @@
 
 ;;; Commentary:
 
-;; Elpher is a tool for exploring "gopherspace" using GNU Emacs.
+;; 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.
+
+;; The caching mechanism works by maintaining a hierarchy of visited
+;; pages rather than a linear history, meaning that it is quick and
+;; easy to navigate this history.
+
+;; 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:
 
@@ -35,7 +54,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "1.0.0"
+(defconst elpher-version "1.1.0"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -45,16 +64,18 @@
   (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 - 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 - r: redraw current page (using cached contents if available)\tfake\tfake\t1"
          "i - R: reload current page (regenerates cache)\tfake\tfake\t1"
@@ -69,10 +90,22 @@
          "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)
+    (?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.")
+
 
 ;;; Customization group
 ;;
@@ -81,55 +114,66 @@
   "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 org-drawer))
+  "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 org-tag))
+  "Face used for text type directory records.")
 
-(defface elpher-info '()
-  "Face used for info records.")
+(defface elpher-info
+  '((t :inherit org-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 org-level-4))
+  "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 org-level-5))
+  "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 org-level-6))
+  "Face used for url type directory records.")
 
 (defface elpher-binary
-  '((t :foreground "magenta"))
-  "Face used for binary records.")
+  '((t :inherit org-level-7))
+  "Face used for binary type directory records.")
 
 (defface elpher-unknown
-  '((t :foreground "red"))
-  "Face used for unknown record types.")
+  '((t :inherit org-warning))
+  "Face used for directory records with unknown/unsupported types.")
 
 (defface elpher-margin-key
-  '((((background dark)) :foreground "white"))
-  "Face used for margin key.")
+  '((t :inherit org-tag))
+  "Face used for directory margin key.")
 
 (defface elpher-margin-brackets
-  '((t :foreground "blue"))
-  "Face used for brackets around margin key.")
+  '((t :inherit org-special-keyword))
+  "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-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))
+
+
 ;;; Model
 ;;
 
@@ -194,7 +238,7 @@ 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."
@@ -233,8 +277,7 @@ content and cursor position fields of the 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))
@@ -245,9 +288,13 @@ content and cursor position fields of the node."
 
 (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-no-period (replace-regexp-in-string "\r\n\.\r\n$" "\r\n" string))
+         (str-no-cr (replace-regexp-in-string "\r" "" str-no-period)))
+    (dolist (line (split-string str-no-cr "\n"))
+      (unless (= (length line) 0)
+        (elpher-insert-index-record line)))))
 
 (defun elpher-insert-margin (&optional type-name)
   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
@@ -261,18 +308,6 @@ 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))
@@ -295,13 +330,13 @@ content and cursor position fields of the node."
                                                                getter)
                               'action #'elpher-click-link
                               'follow-link t
-                              'help-echo (format "mouse-1, RET: open %s on %s port %s"
+                              'help-echo (format "mouse-1, RET: open '%s' on %s port %s"
                                                  selector host port)))
       (pcase type
-        (?i (elpher-insert-margin) ; Information
+        (?i (elpher-insert-margin) ;; Information
             (insert (propertize display-string
                                 'face 'elpher-info)))
-        (?h (elpher-insert-margin "W") ; Web link
+        (?h (elpher-insert-margin "W") ;; Web link
             (let ((url (elt (split-string selector "URL:") 1)))
               (insert-text-button display-string
                                   'face 'elpher-url
@@ -309,7 +344,6 @@ content and cursor position fields of the node."
                                   '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)))))
@@ -328,7 +362,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"
@@ -349,8 +383,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
@@ -359,16 +393,16 @@ 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
 
@@ -403,7 +437,7 @@ The result is stored as a string in the variable elpher-selector-string."
                                                                  getter)
                                 'action #'elpher-click-link
                                 'follow-link t
-                                'help-echo (format "mouse-1, RET: open %s on %s port %s"
+                                'help-echo (format "mouse-1, RET: open '%s' on %s port %s"
                                                    selector host port)))
           (make-text-button (match-beginning 0)
                             (match-end 0)
@@ -426,8 +460,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..."))
@@ -435,10 +469,10 @@ 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-process-text elpher-selector-string))
+                                   (elpher-restore-pos)
+                                   (elpher-set-node-content elpher-current-node
+                                                            (buffer-string))))))))))
 
 ;; Image retrieval
 
@@ -449,25 +483,26 @@ 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
 
@@ -479,8 +514,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))
           (message "Displaying cached search results.  Reload to perform a new search."))
       (unwind-protect
           (let* ((query-string (read-string "Query: "))
@@ -515,8 +550,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))
@@ -582,6 +617,7 @@ The result is stored as a string in the variable elpher-selector-string."
 (defun elpher-go ()
   "Go to a particular gopher site."
   (interactive)
+  (switch-to-buffer "*elpher*")
   (let* (
          (hostname (read-string "Gopher host: "))
          (selector (read-string "Selector (default none): " nil nil ""))
@@ -595,18 +631,24 @@ The result is stored as a string in the variable elpher-selector-string."
 (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."
@@ -623,10 +665,48 @@ 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)
+                                 #'elpher-get-node-download)
             (message "Can only download gopher links, not general URLs.")))
       (message "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 "" host port)))
+                (elpher-visit-node (elpher-make-node elpher-current-node
+                                                     root-address
+                                                     #'elpher-get-index-node)))
+            (message "Already at root directory of current server.")))
+      (message "Command invalid for Elpher start page."))))
+
 ;;; Mode and keymap
 ;;
 
@@ -635,22 +715,26 @@ 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 "<backtab>") '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)
     (when (fboundp 'evil-define-key)
       (evil-define-key 'normal 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))
     map)
   "Keymap for gopher client.")
 
@@ -665,9 +749,14 @@ 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 nil
+                                        elpher-start-address
+                                        #'elpher-get-index-node)))
+      (elpher-visit-node start-node)))
   "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
 
 ;;; elpher.el ends here