Fixed up special page predicate and associated tests.
[elpher.git] / elpher.el
index 5197cb2..39e32a2 100644 (file)
--- a/elpher.el
+++ b/elpher.el
     (finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
     (telnet elpher-get-telnet-page nil "tel" elpher-telnet)
     (other-url elpher-get-other-url-page nil "url" elpher-other-url)
-    ((special start) elpher-get-start-page nil "E" elpher-index)
+    (file elpher-get-file-page nil "~" elpher-gemini)
+    ((special welcome) elpher-get-welcome-page nil "E" elpher-index)
     ((special bookmarks) elpher-get-bookmarks-page nil "E" elpher-index)
     ((special history) elpher-get-history-page nil "E" elpher-index)
     ((special visited-pages) elpher-get-visited-pages-page nil "E" elpher-index))
@@ -224,6 +225,11 @@ Otherwise, \\[elpher-show-bookmarks] will visit a special elpher bookmark
 page within which all of the standard elpher keybindings are active."
   :type '(boolean))
 
+(defcustom elpher-start-page "about:welcome"
+  "Specify the page displayed initially by elpher.
+The default welcome screen \"about:welcome\", while the bookmarks list
+is \"about:bookmarks\".  You can also specify local files via \"file:\".")
+
 ;; Face customizations
 
 (defgroup elpher-faces nil
@@ -380,38 +386,38 @@ requiring gopher-over-TLS."
 
 (defun elpher-make-special-address (type)
   "Create an ADDRESS object corresponding to the given special address symbol TYPE."
-  type)
+  (elpher-address-from-url (concat "about:" (symbol-name type))))
 
 (defun elpher-address-to-url (address)
   "Get string representation of ADDRESS, or nil if ADDRESS is special."
-  (if (elpher-address-special-p address)
-      nil
-    (url-encode-url (url-recreate-url address))))
+  (url-encode-url (url-recreate-url address)))
 
 (defun elpher-address-type (address)
   "Retrieve type of ADDRESS object.
 This is used to determine how to retrieve and render the document the
 address refers to, via the table `elpher-type-map'."
-  (if (symbolp address)
-      (list 'special address)
-    (let ((protocol (url-type address)))
-      (cond ((or (equal protocol "gopher")
-                 (equal protocol "gophers"))
-             (list 'gopher
-                   (if (member (url-filename address) '("" "/"))
-                       ?1
-                     (string-to-char (substring (url-filename address) 1)))))
-            ((equal protocol "gemini")
-             'gemini)
-            ((equal protocol "telnet")
-             'telnet)
-            ((equal protocol "finger")
-             'finger)
-            (t 'other-url)))))
+  (let ((protocol (url-type address)))
+    (pcase (url-type address)
+      ("about"
+       (list 'special (intern (url-filename address))))
+      ((or "gopher" "gophers")
+       (list 'gopher
+             (if (member (url-filename address) '("" "/"))
+                 ?1
+               (string-to-char (substring (url-filename address) 1)))))
+      ("gemini" 'gemini)
+      ("telnet" 'telnet)
+      ("finger" 'finger)
+      ("file" 'file)
+      (_ 'other-url))))
+
+(defun elpher-address-special-p (address)
+  "Return non-nil if ADDRESS is a  special address."
+  (pcase (elpher-address-type address) (`(special ,subtype) t)))
 
 (defun elpher-address-protocol (address)
   "Retrieve the transport protocol for ADDRESS.  This is nil for special addresses."
-  (if (symbolp address)
+  (if (elpher-address-special-p address)
       nil
     (url-type address)))
 
@@ -433,18 +439,13 @@ For gopher addresses this is a combination of the selector type and selector."
 (defun elpher-address-port (address)
   "Retrieve port from ADDRESS object.
 If no address is defined, returns 0.  (This is for compatibility with the URL library.)"
-  (if (symbolp address)
+  (if (elpher-address-special-p address)
       0
     (url-port address)))
 
-(defun elpher-address-special-p (address)
-  "Return non-nil if ADDRESS object is special (e.g. start page page)."
-  (symbolp address))
-
 (defun elpher-address-gopher-p (address)
   "Return non-nill if ADDRESS object is a gopher address."
-  (and (not (elpher-address-special-p address))
-       (member (elpher-address-protocol address) '("gopher" "gophers"))))
+  (eq 'gopher (elpher-address-type address)))
 
 (defun elpher-gopher-address-selector (address)
   "Retrieve gopher selector from ADDRESS object."
@@ -482,9 +483,9 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   (list display-string address))
 
 (defun elpher-make-start-page ()
-  "Create the start page."
-  (elpher-make-page "Elpher Start Page"
-                    (elpher-make-special-address 'start)))
+  "Create the welcome page."
+  (elpher-make-page "Start Page"
+                    (elpher-address-from-url elpher-start-page)))
 
 (defun elpher-page-display-string (page)
   "Retrieve the display string corresponding to PAGE."
@@ -1274,8 +1275,7 @@ that the response was malformed."
          (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
            (if (member redirect-address elpher-gemini-redirect-chain)
                (error "Redirect loop detected"))
-           (if (not (string= (elpher-address-protocol redirect-address)
-                             "gemini"))
+           (if (not (eq (elpher-address-type redirect-address) 'gemini))
                (error "Server tried to automatically redirect to non-gemini URL: %s"
                       response-meta))
            (elpher-page-set-address elpher-current-page redirect-address)
@@ -1623,21 +1623,50 @@ The result is rendered using RENDERER."
     (error "Command not supported for general URLs"))
   (let* ((address (elpher-page-address elpher-current-page))
          (url (elpher-address-to-url address)))
-    (progn
-      (elpher-visit-previous-page) ; Do first in case of non-local exits.
-      (message "Opening URL...")
-      (if elpher-open-urls-with-eww
-          (browse-web url)
-        (browse-url url)))))
-
+    (elpher-visit-previous-page) ; Do first in case of non-local exits.
+    (message "Opening URL...")
+    (if elpher-open-urls-with-eww
+        (browse-web url)
+      (browse-url url))))
 
-;; Start page retrieval
+;; File page
 
-(defun elpher-get-start-page (renderer)
-  "Getter which displays the start page (RENDERER must be nil)."
+(defun elpher-get-file-page (renderer)
+  "Getter which retrieves the contents of a local file and renders it using RENDERER."
+  (let* ((address (elpher-page-address elpher-current-page))
+         (filename (elpher-address-filename address)))
+    (unless (file-exists-p filename)
+      (elpher-visit-previous-page)
+        (error "File not found"))
+    (unless (file-readable-p filename)
+      (elpher-visit-previous-page)
+        (error "Could not read from file"))
+    (funcall
+     (if renderer
+         renderer
+       (pcase (file-name-extension filename)
+         ((or  "gmi" "gemini") #'elpher-render-gemini-map)
+         ((or "htm" "html") #'elpher-render-html)
+         ((or "jpg" "jpeg" "gif" "png" "bmp" "tif" "tiff")
+          #'elpher-render-image)
+         ((or "txt" "") #'elpher-render-text)
+         (t
+          #'elpher-render-download)))
+     (with-temp-buffer
+       (let ((coding-system-for-read 'binary)
+             (coding-system-for-write 'binary))
+         (insert-file-contents-literally filename)
+         (string-as-unibyte (buffer-string))))
+     nil)))
+
+
+;; Welcome page retrieval
+
+(defun elpher-get-welcome-page (renderer)
+  "Getter which displays the welcome page (RENDERER must be nil)."
   (when renderer
     (elpher-visit-previous-page)
-    (error "Command not supported for start page"))
+    (error "Command not supported for welcome page"))
   (elpher-with-clean-buffer
    (insert "     --------------------------------------------\n"
            "           Elpher Gopher and Gemini Client       \n"
@@ -2051,21 +2080,23 @@ supports the old protocol elpher, where the link is self-contained."
   "Go to a particular gopher site HOST-OR-URL.
 When run interactively HOST-OR-URL is read from the minibuffer."
   (interactive "sGopher or Gemini URL: ")
-  (let* ((cleaned-host-or-url (string-trim host-or-url))
-         (address (elpher-address-from-url cleaned-host-or-url))
-         (page (elpher-make-page cleaned-host-or-url address)))
-    (switch-to-buffer elpher-buffer-name)
-    (elpher-with-clean-buffer
-     (elpher-visit-page page))
-    nil))
+  (let ((trimmed-host-or-url (string-trim host-or-url)))
+    (unless (string-empty-p trimmed-host-or-url)
+      (let* ((address (elpher-address-from-url trimmed-host-or-url))
+             (page (elpher-make-page trimmed-host-or-url address)))
+        (switch-to-buffer elpher-buffer-name)
+        (elpher-with-clean-buffer
+         (elpher-visit-page page))
+        nil)))) ; non-nil value is displayed by eshell
 
 (defun elpher-go-current ()
   "Go to a particular site read from the minibuffer, initialized with the current URL."
   (interactive)
-  (let ((address (elpher-page-address elpher-current-page)))
-    (let ((url (read-string "Gopher or Gemini URL: "
-                            (unless (elpher-address-special-p address)
-                              (elpher-address-to-url address)))))
+  (let* ((address (elpher-page-address elpher-current-page))
+         (url (read-string "Gopher or Gemini URL: "
+                           (unless (elpher-address-special-p address)
+                             (elpher-address-to-url address)))))
+    (unless (string-empty-p (string-trim url))
       (elpher-visit-page (elpher-make-page url (elpher-address-from-url url))))))
 
 (defun elpher-redraw ()
@@ -2115,11 +2146,12 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (let ((button (button-at (point))))
     (if button
         (let ((page (button-get button 'elpher-page)))
-          (if (elpher-address-special-p (elpher-page-address page))
-              (error "Cannot download %s"
-                     (elpher-page-display-string page))
-            (elpher-visit-page (button-get button 'elpher-page)
-                               #'elpher-render-download)))
+          (unless page
+            (error "Not an elpher page"))
+          (when (elpher-address-special-p (elpher-page-address page))
+            (error "Cannot download %s" (elpher-page-display-string page)))
+          (elpher-visit-page (button-get button 'elpher-page)
+                             #'elpher-render-download))
       (error "No link selected"))))
 
 (defun elpher-download-current ()
@@ -2175,17 +2207,18 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   "Display information on PAGE."
   (let ((display-string (elpher-page-display-string page))
         (address (elpher-page-address page)))
-    (if (elpher-address-special-p address)
-        (message "Special page: %s" display-string)
-      (message "%s" (elpher-address-to-url address)))))
+    (message "%s" (elpher-address-to-url address))))
 
 (defun elpher-info-link ()
   "Display information on page corresponding to link at point."
   (interactive)
   (let ((button (button-at (point))))
-    (if button
-        (elpher-info-page (button-get button 'elpher-page))
-      (error "No item selected"))))
+    (unless button
+      (error "No item selected"))
+    (let ((page (button-get button 'elpher-page)))
+      (unless page
+        (error "Not an elpher page"))
+      (elpher-info-page page))))
 
 (defun elpher-info-current ()
   "Display information on current page."
@@ -2194,20 +2227,21 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 
 (defun elpher-copy-page-url (page)
   "Copy URL representation of address of PAGE to `kill-ring'."
-  (let ((address (elpher-page-address page)))
-    (if (elpher-address-special-p address)
-        (error (format "Cannot represent %s as URL" (elpher-page-display-string page)))
-      (let ((url (elpher-address-to-url address)))
-        (message "Copied \"%s\" to kill-ring/clipboard." url)
-        (kill-new url)))))
+  (let* ((address (elpher-page-address page))
+         (url (elpher-address-to-url address)))
+    (message "Copied \"%s\" to kill-ring/clipboard." url)
+    (kill-new url)))
 
 (defun elpher-copy-link-url ()
   "Copy URL of item at point to `kill-ring'."
   (interactive)
   (let ((button (button-at (point))))
-    (if button
-        (elpher-copy-page-url (button-get button 'elpher-page))
-      (error "No item selected"))))
+    (unless button
+      (error "No item selected"))
+    (let ((page (button-get button 'elpher-page)))
+      (unless page
+        (error "Not an elpher page"))
+      (elpher-copy-page-url page))))
 
 (defun elpher-copy-current-url ()
   "Copy URL of current page to `kill-ring'."