Fix wrong instruction, even if it is only temporary.
[elpher.git] / elpher.el
index 8f0d39b..476bb55 100644 (file)
--- a/elpher.el
+++ b/elpher.el
          "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 - 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"
 (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 +186,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 +266,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 +306,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 +349,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 +364,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 +488,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)
@@ -483,7 +505,7 @@ calls, as is necessary if the match is performed by `string-match'."
     (insert string)
     (goto-char (point-min))
     (while (re-search-forward elpher-url-regex nil t)
-        (let ((node (elpher-make-node-from-matched-string)))
+        (let ((node (elpher-make-node-from-matched-url elpher-current-node)))
           (make-text-button (match-beginning 0)
                             (match-end 0)
                             'elpher-node  node
@@ -565,9 +587,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 +677,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 'r' 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 +744,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 +797,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 +879,72 @@ 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 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
 ;;
@@ -872,8 +961,11 @@ 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)
+    (define-key map (kbd "c") 'elpher-copy-link-url)
+    (define-key map (kbd "C") 'elpher-copy-current-url)
     (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 +978,14 @@ 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 "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.")
@@ -895,6 +993,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 +1007,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.