Added an other-url-specific face.
[elpher.git] / elpher.el
index 56f8e9b..1fa5ed5 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -83,7 +83,8 @@
     ((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-url-node "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.")
   '((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.")
 
@@ -179,15 +184,22 @@ allows switching from an encrypted channel back to plain text without user input
   (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 (string-empty-p (url-filename url))
+                (when (or (equal (url-filename url) "")
+                          (equal (url-filename url) "/"))
                   (if is-gopher
-                      (setf (url-filename url) "1")))
+                      (setf (url-filename url) "/1")))
                 (unless (> (url-port url) 0)
                   (if is-gopher
                       (setf (url-port url) 70)))
@@ -198,12 +210,15 @@ allows switching from an encrypted channel back to plain text without user input
 (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" (if tls "s" "")
-           "://" host
-           ":" (number-to-string port)
-           "/" (string 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."
@@ -223,8 +238,9 @@ attributes: TYPE, SELECTOR, HOST and PORT."
       (cond ((or (equal protocol "gopher")
                  (equal protocol "gophers"))
              (list 'gopher (string-to-char (substring (url-filename address) 1))))
-            ((string-equal protocol "gemini")
-             'gemini)))))
+            ((equal protocol "gemini")
+             'gemini)
+            (t 'other-url)))))
 
 (defun elpher-address-protocol (address)
   (if (symbolp address)
@@ -335,9 +351,11 @@ unless PRESERVE-PARENT is non-nil."
         (elpher-visit-parent-node)
         (pcase type
           (`(gopher ,type-char)
-           (error "Unsupported gopher selector type '%c'" type-char))
+           (error "Unsupported gopher selector type '%c' for '%s'"
+                  type-char (elpher-address-to-url address)))
           (else
-           (error "Unsupported address type '%S'" type)))))))
+           (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."
@@ -438,13 +456,7 @@ 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-gopher-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.
@@ -573,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
@@ -748,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."
@@ -757,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-gopher-address-selector address)))
-    (let ((url (elt (split-string selector "URL:") 1)))
-      (if url
+    (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
 
@@ -861,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"
@@ -958,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)))
 
@@ -977,11 +952,7 @@ host, selector and port."
     (if (elpher-address-special-p address)
         (error "Command not valid for this page")
       (let ((url (read-string "URL: " (elpher-address-to-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))))))
+        (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
 
 (defun elpher-redraw ()
   "Redraw current page."
@@ -1083,10 +1054,7 @@ host, selector and port."
           (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"))))
 
@@ -1159,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-gopher-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."