X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=1fa5ed54ea7291bcd8cc8e12c60c5e93ed2168c0;hp=b501e48da7ac5adc6504a6b2a617165e9573f073;hb=5df0f96c23837284d585c8917744584f70a63c7f;hpb=956d8f2b17e0ac0f2ac4a684c870fb0045a57f68

diff --git a/elpher.el b/elpher.el
index b501e48..1fa5ed5 100644
--- a/elpher.el
+++ b/elpher.el
@@ -83,11 +83,13 @@
     ((gopher ?d) elpher-get-node-download "doc" elpher-binary)
     ((gopher ?P) elpher-get-node-download "doc" elpher-binary)
     ((gopher ?s) elpher-get-node-download "snd" elpher-binary)
-    ((gopher ?h) elpher-get-node-html "htm" elpher-html)
+    ((gopher ?h) elpher-get-html-node "htm" elpher-html)
+    (other-url elpher-get-other-url-node "url" elpher-other-url)
     ((special bookmarks) elpher-get-bookmarks-node)
     ((special start) elpher-get-start-node))
   "Association list from types to getters, margin codes and index faces.")
 
+
 ;;; Customization group
 ;;
 
@@ -117,7 +119,11 @@
   '((t :inherit warning))
   "Face used for search type directory records.")
 
-(defface elpher-url
+(defface elpher-html
+  '((t :inherit font-lock-comment-face))
+  "Face used for url type directory records.")
+
+(defface elpher-other-url
   '((t :inherit font-lock-comment-face))
   "Face used for url type directory records.")
 
@@ -175,37 +181,53 @@ allows switching from an encrypted channel back to plain text without user input
 
 (defun elpher-address-from-url (url-string)
   "Create a ADDRESS object corresponding to the given URL-STRING."
-  (let ((url (url-generic-parse-url url-string)))
-    (if (and (url-type url)
-             (url-host url))
-        (let ((is-gopher (or (equal "gopher" (url-type url))
-                             (equal "gophers" (url-type url)))))
-          (setf (url-filename url)
-                (url-unhex-string (url-filename url)))
-          (when (string-empty-p (url-filename url))
-            (if is-gopher
-                (setf (url-filename url) "1")))
-          (unless (> (url-port url) 0)
-            (if is-gopher
-                (setf (url-port url) 70)))
-          url)
-      (error "Malformed URL" url))))
-
-(defun elpher-make-gopher-address (type selector host port)
+  (let ((data (match-data))) ; Prevent parsing clobbering match data
+    (unwind-protect
+        (let ((url (url-generic-parse-url url-string)))
+          (setf (url-fullness url) t)
+          (unless (url-host url)
+            (setf (url-host url) (url-filename url))
+            (setf (url-filename url) ""))
+          (unless (url-type url)
+            (setf (url-type url) "gopher"))
+          (if (and (url-type url)
+                   (url-host url))
+              (let ((is-gopher (or (equal "gopher" (url-type url))
+                                   (equal "gophers" (url-type url)))))
+                (setf (url-filename url)
+                      (url-unhex-string (url-filename url)))
+                (when (or (equal (url-filename url) "")
+                          (equal (url-filename url) "/"))
+                  (if is-gopher
+                      (setf (url-filename url) "/1")))
+                (unless (> (url-port url) 0)
+                  (if is-gopher
+                      (setf (url-port url) 70)))
+                url)
+            (error "Malformed URL" url)))
+      (set-match-data data))))
+
+(defun elpher-make-gopher-address (type selector host port &optional tls)
   "Create an ADDRESS object corresponding to the given gopher directory record
 attributes: TYPE, SELECTOR, HOST and PORT."
-  (elpher-address-from-url
-   (concat "gopher://" host ":" port "/" type selector)))
+  (if (and (equal type ?h)
+           (string-prefix-p "URL:" selector))
+      (elpher-address-from-url (elt (split-string selector "URL:") 1))
+    (elpher-address-from-url
+     (concat "gopher" (if tls "s" "")
+             "://" host
+             ":" (number-to-string port)
+             "/" (string type)
+             selector))))
 
 (defun elpher-make-special-address (type)
   "Create an ADDRESS object corresponding to the given special page symbol TYPE."
   type)
-              
 
-(defun elpher-address-to-url-string (address)
+(defun elpher-address-to-url (address)
   "Get string representation of ADDRESS, or nil if ADDRESS is special."
   (if (not (elpher-address-special-p address))
-      (url-encode-url (url-recreate address))
+      (url-encode-url (url-recreate-url address))
     nil))
 
 (defun elpher-address-type (address)
@@ -213,27 +235,22 @@ attributes: TYPE, SELECTOR, HOST and PORT."
   (if (symbolp address)
       (list 'special address)
     (let ((protocol (url-type address)))
-      (cond ((or (string-equal protocol "gopher")
-                 (string-equal protocol "gophers"))
-             (list 'gopher
-                   ((let ((filename (url-filename address)))
-                      (if (> (length filename) 0)
-                          (string-to-char filename)
-                        ?1)))))
-            ((string-equal protocol "gemini")
-             'gemini)))))
+      (cond ((or (equal protocol "gopher")
+                 (equal protocol "gophers"))
+             (list 'gopher (string-to-char (substring (url-filename address) 1))))
+            ((equal protocol "gemini")
+             'gemini)
+            (t 'other-url)))))
 
 (defun elpher-address-protocol (address)
   (if (symbolp address)
       nil
     (url-type address)))
 
-(defun elpher-gopher-address-selector (address)
-  "Retrieve selector from ADDRESS object."
-  (let ((filename (url-filename address)))
-    (if (> (length filename) 0)
-        (substring filename 1)
-      "")))
+(defun elpher-address-filename (address)
+  (if (symbolp address)
+      nil
+    (url-filename address)))
 
 (defun elpher-address-host (address)
   "Retrieve host from ADDRESS object."
@@ -247,6 +264,14 @@ attributes: TYPE, SELECTOR, HOST and PORT."
   "Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
   (symbolp address))
 
+(defun elpher-address-gopher-p (address)
+  "Return non-nill if ADDRESS object is a gopher address."
+  (memq (elpher-address-protocol address) '("gopher gophers")))
+
+(defun elpher-gopher-address-selector (address)
+  "Retrieve gopher selector from ADDRESS object."
+  (substring (url-filename address) 2))
+
 ;; Node
 
 (defun elpher-make-node (display-string address &optional parent)
@@ -320,11 +345,17 @@ unless PRESERVE-PARENT is non-nil."
       (funcall getter)
     (let* ((address (elpher-node-address node))
            (type (elpher-address-type address))
-           (type-record (alist-get type elpher-type-map)))
+           (type-record (cdr (assoc type elpher-type-map))))
       (if type-record
           (funcall (car type-record))
         (elpher-visit-parent-node)
-        (error "Unsupported gopher selector type '%c'" type)))))
+        (pcase type
+          (`(gopher ,type-char)
+           (error "Unsupported gopher selector type '%c' for '%s'"
+                  type-char (elpher-address-to-url address)))
+          (else
+           (error "Unsupported address type '%S' for '%s'"
+                  type (elpher-address-to-url address))))))))
 
 (defun elpher-visit-parent-node ()
   "Visit the parent of the current node."
@@ -425,19 +456,13 @@ away CRs and any terminating period."
 (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 (equal (elpher-address-type address) '(gopher ?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-gopher-address-selector address)
-              (elpher-address-host address)
-              (elpher-address-port address)))))
+    (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
 
 (defun elpher-insert-index-record (display-string address)
   "Function to insert an index record into the current buffer.
 The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
   (let* ((type (elpher-address-type address))
-         (type-map-entry (alist-get type elpher-type-map)))
+         (type-map-entry (cdr (assoc type elpher-type-map))))
     (if type-map-entry
         (let* ((margin-code (elt type-map-entry 1))
                (face (elt type-map-entry 2))
@@ -469,7 +494,7 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
     (elpher-visit-node node)))
 
 
-;;; Selector retrieval (all kinds)
+;;; Gopher selector retrieval (all kinds)
 ;;
 
 (defun elpher-process-cleanup ()
@@ -527,7 +552,7 @@ up to the calling function."
            (error the-error)
          (elpher-with-clean-buffer
           (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
-                  "Failed to connect to " (elpher-get-address-url address) ".\n"
+                  "Failed to connect to " (elpher-address-to-url address) ".\n"
                   (propertize "\n----------------\n\n" 'face 'error)
                   "Press 'u' to return to the previous page.")))))))
 
@@ -560,50 +585,14 @@ up to the calling function."
   "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[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 (&optional string)
-  "Convert most recent `elpher-url-regex' match to a 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 (or (string= protocol "gopher")
-            (string= protocol "gophers"))
-        (let* ((bare-host (match-string 2 string))
-               (host (if (string-prefix-p "[" bare-host)
-                         (substring bare-host 1 (- (length bare-host) 1))
-                       bare-host))
-               (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 (decode-coding-string
-                          (url-unhex-string
-                           (if (> (length type-and-selector) 1)
-                               (substring type-and-selector 2)
-                             "")) 'utf-8))
-               (use-tls (string= protocol "gophers"))
-               (address (elpher-make-gopher-address type selector host port use-tls)))
-          (elpher-make-node url 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-gopher-address ?h selector host port)))
-        (elpher-make-node url 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 ((node (elpher-make-node-from-matched-url)))
+      (let ((node (elpher-make-node (match-string 0)
+                                    (elpher-address-from-url (match-string 0)))))
           (make-text-button (match-beginning 0)
                             (match-end 0)
                             'elpher-node  node
@@ -671,7 +660,7 @@ calls, as is necessary if the match is performed by `string-match'."
           (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))
+                 (query-selector (concat (elpher-gopher-address-selector address) "\t" query-string))
                  (search-address (elpher-make-gopher-address ?1
                                                       query-selector
                                                       (elpher-address-host address)
@@ -713,7 +702,7 @@ calls, as is necessary if the match is performed by `string-match'."
 (defun elpher-get-node-download ()
   "Getter which retrieves the current node and writes the result to a file."
   (let* ((address (elpher-node-address elpher-current-node))
-         (selector (elpher-address-selector address)))
+         (selector (elpher-gopher-address-selector address)))
     (elpher-visit-parent-node) ; Do first in case of non-local exits.
     (let* ((filename-proposal (file-name-nondirectory selector))
            (filename (read-file-name "Save file as: "
@@ -735,7 +724,7 @@ calls, as is necessary if the match is performed by `string-match'."
         (error
          (error "Error downloading %s" elpher-download-filename))))))
 
-;; URL retrieval
+;; HTML node retrieval
 
 (defun elpher-insert-rendered-html (string)
   "Use shr to insert rendered view of html STRING into current buffer."
@@ -744,35 +733,41 @@ calls, as is necessary if the match is performed by `string-match'."
                (libxml-parse-html-region (point-min) (point-max)))))
     (shr-insert-document dom)))
 
-(defun elpher-get-url-node ()
-  "Getter which attempts to open the URL specified by the current node."
+(defun elpher-get-html-node ()
+  "Getter which retrieves and renders an HTML node."
   (let* ((address (elpher-node-address elpher-current-node))
-         (selector (elpher-address-selector address)))
-    (let ((url (elt (split-string selector "URL:") 1)))
-      (if url
+         (selector (elpher-gopher-address-selector address)))
+    (let ((content (elpher-get-cached-content address)))
+      (if content
           (progn
-            (elpher-visit-parent-node) ; Do first in case of non-local exits.
-            (message "Opening URL...")
-            (if elpher-open-urls-with-eww
-                (browse-web url)
-              (browse-url url)))
-        (let ((content (elpher-get-cached-content address)))
-          (if content
-              (progn
-                (elpher-with-clean-buffer
-                 (insert content)
-                 (elpher-restore-pos)))
             (elpher-with-clean-buffer
-             (insert "LOADING HTML... (use 'u' to cancel)"))
-            (elpher-get-selector address
-                                 (lambda (proc event)
-                                   (unless (string-prefix-p "deleted" event)
-                                     (elpher-with-clean-buffer
-                                      (elpher-insert-rendered-html elpher-selector-string)
-                                      (goto-char (point-min))
-                                      (elpher-cache-content
-                                       (elpher-node-address elpher-current-node)
-                                       (buffer-string))))))))))))
+             (insert content)
+             (elpher-restore-pos)))
+        (elpher-with-clean-buffer
+         (insert "LOADING HTML... (use 'u' to cancel)"))
+        (elpher-get-selector address
+                             (lambda (proc event)
+                               (unless (string-prefix-p "deleted" event)
+                                 (elpher-with-clean-buffer
+                                  (elpher-insert-rendered-html elpher-selector-string)
+                                  (goto-char (point-min))
+                                  (elpher-cache-content
+                                   (elpher-node-address elpher-current-node)
+                                   (buffer-string))))))))))
+
+
+;; Other URL node opening
+
+(defun elpher-get-other-url-node ()
+  "Getter which attempts to open the URL specified by the current node."
+  (let* ((address (elpher-node-address elpher-current-node))
+         (url (elpher-address-to-url address)))
+    (progn
+      (elpher-visit-parent-node) ; Do first in case of non-local exits.
+      (message "Opening URL...")
+      (if elpher-open-urls-with-eww
+          (browse-web url)
+        (browse-url url)))))
 
 ;; Telnet node connection
 
@@ -848,7 +843,7 @@ calls, as is necessary if the match is performed by `string-match'."
      (if bookmarks
          (dolist (bookmark bookmarks)
            (let ((display-string (elpher-bookmark-display-string bookmark))
-                 (address (elpher-bookmark-address bookmark)))
+                 (address (elpher-address-from-url (elpher-bookmark-url bookmark))))
              (elpher-insert-index-record display-string address)))
        (insert "No bookmarks found.\n")))
    (insert "\n-----------------------\n\n"
@@ -863,11 +858,11 @@ calls, as is necessary if the match is performed by `string-match'."
 ;;; Bookmarks
 ;;
 
-(defun elpher-make-bookmark (display-string address)
+(defun elpher-make-bookmark (display-string url)
   "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))
+  (list display-string (elpher-address-to-url address)))
   
 (defun elpher-bookmark-display-string (bookmark)
   "Get the display string of BOOKMARK."
@@ -877,46 +872,48 @@ bookmark list, while ADDRESS is the address of the entry."
   "Set the display string of BOOKMARK to DISPLAY-STRING."
   (setcar bookmark display-string))
 
-(defun elpher-bookmark-address (bookmark)
+(defun elpher-bookmark-url (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")
+  (with-temp-file (locate-user-emacs-file "elpher2-bookmarks")
     (erase-buffer)
-    (insert "; Elpher gopher bookmarks file\n\n"
-            "; Bookmarks are stored as a list of (label (type selector host port))\n"
-            "; s-expressions, where type is stored as a character (i.e. 49 = ?1).\n"
-            "; Feel free to edit by hand, but ensure this structure remains intact.\n\n")
+    (insert "; Elpher bookmarks file\n\n"
+            "; Bookmarks are stored as a list of (label URL) items.\n"
+            "; Feel free to edit by hand, but take care to ensure\n"
+            "; the list structure remains intact.\n\n")
     (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"))
+      (insert-file-contents (locate-user-emacs-file "elpher2-bookmarks"))
       (goto-char (point-min))
       (read (current-buffer)))))
 
 (defun elpher-add-address-bookmark (address display-string)
-  "Save a bookmark for ADDRESS with label DISPLAY-STRING.
+  "Save a bookmark for ADDRESS with label DISPLAY-STRING.)))
 If ADDRESS is already bookmarked, update the label only."
-  (let ((bookmarks (elpher-load-bookmarks)))
-    (let ((existing-bookmark (rassoc (list address) bookmarks)))
+  (let ((bookmarks (elpher-load-bookmarks))
+        (url (elpher-address-to-url address)))
+    (let ((existing-bookmark (rassoc (list url) bookmarks)))
       (if existing-bookmark
           (elpher-set-bookmark-display-string existing-bookmark display-string)
-        (add-to-list 'bookmarks (elpher-make-bookmark display-string address))))
+        (add-to-list 'bookmarks (elpher-make-bookmark display-string url))))
     (elpher-save-bookmarks bookmarks)))
 
 (defun elpher-remove-address-bookmark (address)
   "Remove any bookmark to ADDRESS."
+  (let ((url (elpher-address-to-url address)))
     (elpher-save-bookmarks
      (seq-filter (lambda (bookmark)
-                   (not (equal (elpher-bookmark-address bookmark) address)))
-                 (elpher-load-bookmarks))))
-
+                   (not (equal (elpher-bookmark-url bookmark) url)))
+                 (elpher-load-bookmarks)))))
 
 ;;; Interactive procedures
 ;;
@@ -943,15 +940,8 @@ host, selector and port."
   (interactive)
   (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 host-or-url)
-             (let ((selector (read-string "Selector (default none): " nil nil ""))
-                   (port-string (read-string "Port (default 70): " nil nil "70")))
-               (elpher-make-node (concat "gopher://" host-or-url
-                                         ":" port-string
-                                         "/1" selector)
-                                 (elpher-make-gopher-address ?1 selector host-or-url
-                                                             (string-to-number port-string))))))))
+           (elpher-make-node host-or-url
+                             (elpher-address-from-url host-or-url)))))
     (switch-to-buffer "*elpher*")
     (elpher-visit-node node)))
 
@@ -961,12 +951,8 @@ host, selector and port."
   (let ((address (elpher-node-address elpher-current-node)))
     (if (elpher-address-special-p address)
         (error "Command not valid for this page")
-      (let ((url (read-string "URL: " (elpher-get-address-url address))))
-        (if (string-match elpher-url-regex url)
-            (let ((new-node (elpher-make-node-from-matched-url url)))
-              (unless (equal (elpher-node-address new-node) address)
-                (elpher-visit-node new-node)))
-          (error "Could not parse URL %s" url))))))
+      (let ((url (read-string "URL: " (elpher-address-to-url address))))
+        (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
 
 (defun elpher-redraw ()
   "Redraw current page."
@@ -1063,21 +1049,19 @@ host, selector and port."
          (host (elpher-address-host address)))
     (if host
         (let ((host (elpher-address-host address))
-              (selector (elpher-address-selector address))
+              (selector (elpher-gopher-address-selector address))
               (port (elpher-address-port address)))
           (if (> (length selector) 0)
               (let ((root-address (elpher-make-gopher-address ?1 "" host port)))
                 (elpher-visit-node
-                 (elpher-make-node (concat "gopher://" host
-                                           ":" (number-to-string port)
-                                           "/1/")
-                                   root-address)))
+                 (elpher-make-node (elpher-address-to-url root-address))))
             (error "Already at root directory of current server")))
       (error "Command invalid for this page"))))
 
 (defun elpher-bookmarks-current-p ()
   "Return non-nil if current node is a bookmarks page."
-  (eq (elpher-address-type (elpher-node-address elpher-current-node)) 'bookmarks))
+  (equal (elpher-address-type (elpher-node-address elpher-current-node))
+         '(special bookmarks)))
 
 (defun elpher-reload-bookmarks ()
   "Reload bookmarks if current node is a bookmarks page."
@@ -1143,12 +1127,9 @@ host, selector and port."
   "Display information on NODE."
   (let ((display-string (elpher-node-display-string node))
         (address (elpher-node-address node)))
-    (if (not (elpher-address-special-p address))
-        (message "`%s' on %s port %s"
-                (elpher-address-selector address)
-                (elpher-address-host address)
-                (elpher-address-port address))
-      (message "%s" display-string))))
+    (if (elpher-address-special-p address)
+        (message "Special page: %s" display-string)
+      (message (elpher-address-to-url address)))))
 
 (defun elpher-info-link ()
   "Display information on node corresponding to link at point."
@@ -1168,7 +1149,7 @@ host, selector and port."
   (let ((address (elpher-node-address node)))
     (if (elpher-address-special-p address)
         (error (format "Cannot represent %s as URL" (elpher-node-display-string node)))
-      (let ((url (elpher-get-address-url address)))
+      (let ((url (elpher-address-to-url address)))
         (message "Copied \"%s\" to kill-ring/clipboard." url)
         (kill-new url)))))
 
@@ -1226,7 +1207,7 @@ host, selector and port."
     (when (fboundp 'evil-define-key)
       (evil-define-key 'motion map
         (kbd "TAB") 'elpher-next-link
-        (kbd "C-]") 'elpher-follow-current-link
+        (kbd "C-") 'elpher-follow-current-link
         (kbd "C-t") 'elpher-back
         (kbd "u") 'elpher-back
         (kbd "O") 'elpher-root-dir