X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=6049d0de10e43db69e108de74f5ff0713c1fd9ed;hb=f68258e6ac8b5ab733566e98b16a0a7447ac7a11;hp=a55b659cdf001db507dd56b62fba4c0d989c39cc;hpb=dbfd5ef1fa1ba682229cc9bdd3778ad8963bdf60;p=elpher.git

diff --git a/elpher.el b/elpher.el
index a55b659..6049d0d 100644
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
 ;; Created: 11 April 2019
-;; Version: 1.0.0
+;; Version: 1.1.0
 ;; Keywords: comm gopher
 ;; Homepage: https://github.com/tgvaughan/elpher
 ;; Package-Requires: ((emacs "25"))
@@ -26,7 +26,25 @@
 
 ;;; 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.
+
+;; 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:
 
@@ -35,7 +53,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 +63,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 +89,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,59 +113,69 @@
   "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-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))
+
 ;;; Model
 ;;
 
@@ -198,7 +240,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."
@@ -237,8 +279,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))
@@ -249,9 +290,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."
@@ -265,18 +310,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))
@@ -299,13 +332,16 @@ 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
-            (insert (propertize display-string
-                                'face 'elpher-info)))
-        (?h (elpher-insert-margin "W") ; Web link
+        (?i (elpher-insert-margin) ;; Information
+            (insert (propertize
+                     (if elpher-buttonify-urls-in-directories
+                         (elpher-buttonify-urls display-string)
+                       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
@@ -313,7 +349,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)))))
@@ -353,8 +388,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
@@ -363,16 +398,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
 
@@ -390,7 +425,9 @@ The result is stored as a string in the variable ‘elpher-selector-string’."
             (protocol (downcase (match-string 1))))
         (if (string= protocol "gopher")
             (let* ((host (match-string 2))
-                   (port 70)
+                   (port (if (match-string 3)
+                             (string-to-number (substring (match-string 3) 1))
+                           70))
                    (type-and-selector (match-string 4))
                    (type (if (> (length type-and-selector) 1)
                              (elt type-and-selector 1)
@@ -407,7 +444,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)
@@ -430,8 +467,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..."))
@@ -439,10 +476,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
 
@@ -453,9 +490,8 @@ 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))
+           (insert-image content)
+           (elpher-restore-pos)))
       (if (display-images-p)
           (progn
             (elpher-with-clean-buffer
@@ -468,9 +504,8 @@ The result is stored as a string in the variable ‘elpher-selector-string’."
                                                                          'no-conversion)
                                                    nil t)))
                                        (elpher-with-clean-buffer
-                                        (insert-image image))
-                                       (setq cursor-type nil)
-                                       (elpher-restore-pos)
+                                        (insert-image image)
+                                        (elpher-restore-pos))
                                        (if elpher-cache-images
                                            (elpher-set-node-content elpher-current-node
                                                                     image)))))))
@@ -486,8 +521,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: "))
@@ -522,8 +557,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))
@@ -589,31 +624,57 @@ 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)
+               (if (not (string= (downcase (match-string 1 host-or-url)) "gopher"))
+                   (error "Only gopher URLs acceptable.")
+                 (let* ((host (match-string 2 host-or-url))
+                        (port (if (match-string 3 host-or-url)
+                                  (string-to-number (substring (match-string 3 host-or-url) 1))
+                                70))
+                        (type-and-selector (match-string 4 host-or-url))
+                        (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))))
+                   (elpher-make-node elpher-current-node
+                                     address
+                                     getter)))
+             (let* ((selector (read-string "Selector (default none): " nil nil ""))
+                    (port (read-string "Port (default 70): " nil nil 70))
+                    (address (list selector host-or-url port)))
+               (elpher-make-node elpher-current-node
+                                 address
+                                 #'elpher-get-index-node))))))
+    (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."
@@ -629,11 +690,49 @@ The result is stored as a string in the variable ‘elpher-selector-string’."
     (if button
         (let ((node (button-get button 'elpher-node)))
           (if node
-              (elpher-visit-node (button-get button 'elpher-node
-                                  #'elpher-get-node-download))
+              (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."))))
 
+(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
 ;;
 
@@ -642,22 +741,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.")
 
@@ -672,9 +775,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