Fixed up text/gemini margins, handling of mailto: URLs.

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index 89dcf20..669ed55 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
 ;; Created: 11 April 2019
 
 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
 ;; Created: 11 April 2019

-;; Version: 1.4.7
+;; Version: 2.0.0

 ;; Keywords: comm gopher
 ;; Homepage: https://github.com/tgvaughan/elpher
 ;; Package-Requires: ((emacs "26"))
 ;; Keywords: comm gopher
 ;; Homepage: https://github.com/tgvaughan/elpher
 ;; Package-Requires: ((emacs "26"))


@@ -272,7 +272,8 @@ attributes: TYPE, SELECTOR, HOST and PORT."
 
 (defun elpher-address-gopher-p (address)
   "Return non-nill if ADDRESS object is a gopher address."
 
 (defun elpher-address-gopher-p (address)
   "Return non-nill if ADDRESS object is a gopher address."

-  (memq (elpher-address-protocol address) '("gopher gophers")))
+  (and (not (elpher-address-special-p address))
+       (member (elpher-address-protocol address) '("gopher gophers"))))

 
 (defun elpher-gopher-address-selector (address)
   "Retrieve gopher selector from ADDRESS object."
 
 (defun elpher-gopher-address-selector (address)
   "Retrieve gopher selector from ADDRESS object."


@@ -464,10 +465,12 @@ away CRs and any terminating period."
   (let ((address (elpher-node-address node)))
     (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
 
   (let ((address (elpher-node-address node)))
     (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
 

-(defun elpher-insert-index-record (display-string address)
+(defun elpher-insert-index-record (display-string &optional address)

   "Function to insert an index record into the current buffer.
   "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))
+The contents of the record are dictated by DISPLAY-STRING and ADDRESS.
+If ADDRESS is not supplied or nil the record is rendered as an
+'information' line."
+  (let* ((type (if address (elpher-address-type address) nil))

          (type-map-entry (cdr (assoc type elpher-type-map))))
     (if type-map-entry
         (let* ((margin-code (elt type-map-entry 1))
          (type-map-entry (cdr (assoc type elpher-type-map))))
     (if type-map-entry
         (let* ((margin-code (elt type-map-entry 1))


@@ -481,7 +484,7 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
                               'follow-link t
                               'help-echo (elpher-node-button-help node)))
       (pcase type
                               'follow-link t
                               'help-echo (elpher-node-button-help node)))
       (pcase type

-        ('(gopher ?i) ;; Information
+        ((or '(gopher ?i) 'nil) ;; Information

          (elpher-insert-margin)
          (insert (propertize
                   (if elpher-buttonify-urls-in-directories
          (elpher-insert-margin)
          (insert (propertize
                   (if elpher-buttonify-urls-in-directories


@@ -500,6 +503,18 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
     (elpher-visit-node node)))
 
 
     (elpher-visit-node node)))
 
 

+;;; Network error reporting
+;;
+
+(defun elpher-network-error (address error)
+  (elpher-with-clean-buffer
+   (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
+           "When attempting to retrieve " (elpher-address-to-url address) ":\n"
+           (error-message-string the-error) ".\n"
+           (propertize "\n----------------\n\n" 'face 'error)
+           "Press 'u' to return to the previous page.")))
+
+

 ;;; Gopher selector retrieval (all kinds)
 ;;
 
 ;;; Gopher selector retrieval (all kinds)
 ;;
 


@@ -764,65 +779,183 @@ up to the calling function."
 ;; Gemini node retrieval
 
 (defvar elpher-gemini-response)
 ;; Gemini node retrieval
 
 (defvar elpher-gemini-response)

+(defvar elpher-gemini-response-header)
+(defvar elpher-gemini-in-header)

 
 

-(defun elpher-get-gemini (address after &optional propagate-error)
+(defun elpher-gemini-response-code ()
+  (elt (split-string elpher-gemini-response-header) 0))
+
+(defun elpher-gemini-response-meta ()
+  (string-trim (substring elpher-gemini-response-header
+                          (string-match "[ \t]+" elpher-gemini-response-header))))
+
+(defun elpher-get-gemini (address after)

   "Retrieve gemini ADDRESS, then execute AFTER.
   "Retrieve gemini ADDRESS, then execute AFTER.

-The result is stored as a string in the variable ‘elpher-selector-string’.
+The response header is stored in the variable ‘elpher-gemini-response-header’.
+If available, the response is stored in the variable ‘elpher-gemini-response’.

 
 Usually errors result in an error page being displayed.  This is only
 appropriate if the selector is to be directly viewed.  If PROPAGATE-ERROR
 is non-nil, this message is not displayed.  Instead, the error propagates
 up to the calling function."
   (setq elpher-gemini-response "")
 
 Usually errors result in an error page being displayed.  This is only
 appropriate if the selector is to be directly viewed.  If PROPAGATE-ERROR
 is non-nil, this message is not displayed.  Instead, the error propagates
 up to the calling function."
   (setq elpher-gemini-response "")

+  (setq elpher-gemini-response-header "")
+  (setq elpher-gemini-in-header t)

   (if (not (gnutls-available-p))
   (if (not (gnutls-available-p))

-      (error "Cannot retrieve TLS selector: GnuTLS not available"))
-  (condition-case the-error
-      (let* ((kill-buffer-query-functions nil)
-             (proc (open-network-stream "elpher-process"
-                                        nil
-                                        (elpher-address-host address)
-                                        (elpher-address-port address)
-                                        :type 'tls)))
-        (set-process-coding-system proc 'binary)
-        (set-process-filter proc
-                            (lambda (proc string)
+      (error "Cannot retrieve TLS selector: GnuTLS not available")
+    (let* ((kill-buffer-query-functions nil)
+           (proc (open-network-stream "elpher-process"
+                                      nil
+                                      (elpher-address-host address)
+                                      (elpher-address-port address)
+                                      :type 'tls)))
+      (set-process-coding-system proc 'binary)
+      (set-process-filter proc
+                          (lambda (proc string)
+                            (if elpher-gemini-in-header
+                                (progn
+                                  (setq elpher-gemini-response-header
+                                        (concat elpher-gemini-response-header
+                                                (elt (split-string string "\r\n") 0)))
+                                  (let ((idx (string-match "\r\n" string)))
+                                    (setq elpher-gemini-response
+                                          (substring string (+ idx 2)))
+                                    (setq elpher-gemini-in-header nil)))

                               (setq elpher-gemini-response
                               (setq elpher-gemini-response

-                                    (concat elpher-gemini-response string))))
-        (set-process-sentinel proc after)
-        (process-send-string proc
-                             (concat (elpher-address-to-url address) "\r\n")))
+                                    (concat elpher-gemini-response string)))))
+      (set-process-sentinel proc after)
+      (process-send-string proc
+                           (concat (elpher-address-to-url address) "\r\n")))))
+
+(defun elpher-render-gemini-response (mime-type-raw)
+  (let* ((mime-type-full (if (string-empty-p mime-type-raw)
+                             "text/gemini; charset=utf-8"
+                           mime-type-raw))
+         (mime-type-split (split-string mime-type-full ";"))
+         (mime-type (string-trim (elt mime-type-split 0)))
+         (parameters (if (> (length mime-type-split) 1)
+                         (string-trim (elt mime-type-split 1))
+                       "")))
+    ;; (message "MIME type %S with parameters %S" mime-type parameters)
+    (pcase mime-type
+      ((or "text/gemini" "")
+       (elpher-render--mimetype-text/gemini elpher-gemini-response parameters))
+      ((pred (string-prefix-p "text/"))
+       (elpher-render--mimetype-text/plain elpher-gemini-response parameters))
+      ((pred (string-prefix-p "image/"))
+       (elpher-render--mimetype-image/* elpher-gemini-response parameters))
+      (other
+       (error "Unsupported MIME type %S" mime-type)))))
+
+(defun elpher-gemini-get-link-url (line)
+  (string-trim (elt (split-string (substring line 2)) 0)))
+
+(defun elpher-gemini-get-link-display-string (line)
+  (let* ((rest (string-trim (elt (split-string line "=>") 1)))
+         (idx (string-match "[ \t]" rest)))
+    (if idx
+        (string-trim (substring rest (+ idx 1)))
+      "")))
+
+(defun elpher-address-from-gemini-url (url)
+  (let ((address (url-generic-parse-url url)))
+    (unless (equal (url-type address) "mailto")
+      (setf (url-fullness address) t)
+      (unless (url-host address)
+        (setf (url-host address) (url-host (elpher-node-address elpher-current-node)))
+        (unless (string-prefix-p "/" (url-filename address))
+          (setf (url-filename address)
+                (concat (file-name-as-directory 
+                         (url-filename (elpher-node-address elpher-current-node)))
+                        (url-filename address)))))
+      (unless (url-type address)
+        (setf (url-type address) "gemini"))
+      (unless (> (url-port address) 0)
+        (pcase (url-type address)
+          ("gemini" (setf (url-port address) 1965))
+          ("gopher" (setf (url-port address) 70)))))
+    address))
+
+(defun elpher-render--mimetype-text/gemini (data parameters)
+  (elpher-with-clean-buffer
+   (dolist (line (split-string (elpher-preprocess-text-response data) "\n"))
+     (if (string-prefix-p "=>" line)
+         (let* ((url (elpher-gemini-get-link-url line))
+                (display-string (elpher-gemini-get-link-display-string line))
+                (address (elpher-address-from-gemini-url url)))
+           (if (> (length display-string) 0)
+               (elpher-insert-index-record display-string address)
+             (elpher-insert-index-record url address)))
+       (elpher-insert-index-record line)))
+   (elpher-restore-pos)
+   (elpher-cache-content
+    (elpher-node-address elpher-current-node)
+    (buffer-string))))
+
+(defun elpher-render--mimetype-text/plain (data parameters)
+  (elpher-with-clean-buffer
+   (insert (elpher-buttonify-urls (elpher-preprocess-text-response data)))
+   (elpher-restore-pos)
+   (elpher-cache-content
+    (elpher-node-address elpher-current-node)
+    (buffer-string))))
+
+(defun elpher-render--mimetype-image/* (data parameters)
+  (let ((image (create-image data nil t)))
+    (elpher-with-clean-buffer
+     (insert-image image)
+     (elpher-restore-pos))))
+
+(defun elpher-process-gemini-response (proc event)
+  (condition-case the-error
+      (unless (string-prefix-p "deleted" event)
+        (let ((response-code (elpher-gemini-response-code))
+              (meta (elpher-gemini-response-meta)))
+          (pcase (elt response-code 0)
+            (?1 ; Input required
+             (elpher-with-clean-buffer
+              (insert "Gemini server is requesting input."))
+             (let* ((query-string (read-string (concat meta ": ")))
+                    (url (elpher-address-to-url (elpher-node-address elpher-current-node)))
+                    (query-address (elpher-address-from-url (concat url "?" query-string))))
+               (elpher-get-gemini query-address #'elpher-process-gemini-response)))
+            (?2 ; Normal response
+             (message elpher-gemini-response-header)
+             (elpher-render-gemini-response meta))
+            (?3 ; Redirect
+             (message "Following redirect to %s" meta)
+             (let ((redirect-address (elpher-address-from-gemini-url meta)))
+               (elpher-get-gemini redirect-address #'elpher-process-gemini-response)))
+            (?4 ; Temporary failure
+             (error "Gemini server reports TEMPORARY FAILURE for this request"))
+            (?5 ; Permanent failure
+             (error "Gemini server reports PERMANENT FAILURE for this request"))
+            (?6 ; Client certificate required
+             (error "Gemini server requires client certificate (unsupported at this time)"))
+            (other
+             (error "Gemini server responded with unknown response code %S"
+                    response-code)))))

     (error
     (error

-     (elpher-process-cleanup)
-     (if propagate-error
-         (error the-error)
-       (elpher-with-clean-buffer
-        (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
-                "Failed to connect to " (elpher-address-to-url address) ".\n"
-                (propertize "\n----------------\n\n" 'face 'error)
-                "Press 'u' to return to the previous page."))))))
+     (elpher-network-error (elpher-node-address elpher-current-node) the-error))))
+

 
 (defun elpher-get-gemini-node ()
   "Getter which retrieves and renders a Gemini node."
   (let* ((address (elpher-node-address elpher-current-node))
          (content (elpher-get-cached-content address)))
 
 (defun elpher-get-gemini-node ()
   "Getter which retrieves and renders a Gemini node."
   (let* ((address (elpher-node-address elpher-current-node))
          (content (elpher-get-cached-content address)))

-    (if content
-        (progn
+    (condition-case the-error
+        (if content
+            (progn
+              (elpher-with-clean-buffer
+               (insert content)
+               (elpher-restore-pos)))

           (elpher-with-clean-buffer
           (elpher-with-clean-buffer

-           (insert content)
-           (elpher-restore-pos)))
-      (elpher-with-clean-buffer
-       (insert "LOADING GEMINI... (use 'u' to cancel)"))
-      (elpher-get-gemini address
-                           (lambda (proc event)
-                             (unless (string-prefix-p "deleted" event)
-                               (elpher-with-clean-buffer
-                                (insert (elpher-buttonify-urls
-                                         (elpher-preprocess-text-response
-                                          elpher-gemini-response)))
-                                (elpher-restore-pos)
-                                (elpher-cache-content
-                                 (elpher-node-address elpher-current-node)
-                                 (buffer-string)))))))))
+           (insert "LOADING GEMINI... (use 'u' to cancel)"))
+          (elpher-get-gemini address #'elpher-process-gemini-response))
+      (error
+       (elpher-network-error address the-error)))))
+
+       

 
 
 ;; Other URL node opening
 
 
 ;; Other URL node opening


@@ -1003,12 +1136,10 @@ If ADDRESS is already bookmarked, update the label only."
   (push-button))
 
 (defun elpher-go ()
   (push-button))
 
 (defun elpher-go ()

-  "Go to a particular gopher site read from the minibuffer.
-The site may be specified via a URL or explicitly in terms of
-host, selector and port."
+  "Go to a particular gopher site read from the minibuffer."

   (interactive)
   (let ((node
   (interactive)
   (let ((node

-         (let ((host-or-url (read-string "Gopher host or URL: ")))
+         (let ((host-or-url (read-string "Gopher or Gemini URL: ")))

            (elpher-make-node host-or-url
                              (elpher-address-from-url host-or-url)))))
     (switch-to-buffer "*elpher*")
            (elpher-make-node host-or-url
                              (elpher-address-from-url host-or-url)))))
     (switch-to-buffer "*elpher*")


@@ -1020,7 +1151,7 @@ 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 ((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-address-to-url address))))
+      (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address))))

         (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
 
 (defun elpher-redraw ()
         (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
 
 (defun elpher-redraw ()


@@ -1114,17 +1245,18 @@ host, selector and port."
 (defun elpher-root-dir ()
   "Visit root of current server."
   (interactive)
 (defun elpher-root-dir ()
   "Visit root of current server."
   (interactive)

-  (let* ((address (elpher-node-address elpher-current-node))
-         (host (elpher-address-host address)))
-    (if host
-        (let ((host (elpher-address-host 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 (elpher-address-to-url root-address))))
-            (error "Already at root directory of current server")))
+  (let ((address (elpher-node-address elpher-current-node)))
+    (if (not (elpher-address-special-p address))
+        (if (or (member (url-filename address) '("/" ""))
+                (and (elpher-address-gopher-p address)
+                     (= (length (elpher-gopher-address-selector address)) 0)))
+            (error "Already at root directory of current server")
+          (let ((address-copy (elpher-address-from-url
+                               (elpher-address-to-url address))))
+            (setf (url-filename address-copy) "")
+            (elpher-visit-node
+             (elpher-make-node (elpher-address-to-url address-copy)
+                               address-copy))))

       (error "Command invalid for this page"))))
 
 (defun elpher-bookmarks-current-p ()
       (error "Command invalid for this page"))))
 
 (defun elpher-bookmarks-current-p ()


@@ -1279,7 +1411,6 @@ host, selector and port."
         (kbd "C-") 'elpher-follow-current-link
         (kbd "C-t") 'elpher-back
         (kbd "u") 'elpher-back
         (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 "o") 'elpher-go-current
         (kbd "r") 'elpher-redraw
         (kbd "g") 'elpher-go
         (kbd "o") 'elpher-go-current
         (kbd "r") 'elpher-redraw


@@ -1303,7 +1434,7 @@ host, selector and port."
   "Keymap for gopher client.")
 
 (define-derived-mode elpher-mode special-mode "elpher"
   "Keymap for gopher client.")
 
 (define-derived-mode elpher-mode special-mode "elpher"

-  "Major mode for elpher, an elisp gopher client.
+  "Major mode for elpher, an elisp gopher client.)

 
 This mode is automatically enabled by the interactive
 functions which initialize the gopher client, namely
 
 This mode is automatically enabled by the interactive
 functions which initialize the gopher client, namely