Added transfer progress feedback.
[elpher.git] / elpher.el
index faff8a9..b5373f4 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -2,9 +2,9 @@
 
 ;; Copyright (C) 2019 Tim Vaughan
 
-;; Author: Tim Vaughan <timv@ughan.xyz>
+;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.6.0
+;; Version: 2.7.4
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26"))
 (require 'subr-x)
 (require 'dns)
 (require 'ansi-color)
+(require 'nsm)
 
 
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.6.0"
+(defconst elpher-version "2.7.4"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
   "A gopher client."
   :group 'applications)
 
+;; General appearance and customizations
+
+(defcustom elpher-open-urls-with-eww nil
+  "If non-nil, open URL selectors using eww.
+Otherwise, use the system browser via the BROWSE-URL function."
+  :type '(boolean))
+
+(defcustom elpher-use-header t
+  "If non-nil, display current page information in buffer header."
+  :type '(boolean))
+
+(defcustom elpher-auto-disengage-TLS nil
+  "If non-nil, automatically disengage TLS following an unsuccessful connection.
+While enabling this may seem convenient, it is also potentially dangerous as it
+allows switching from an encrypted channel back to plain text without user input."
+  :type '(boolean))
+
+(defcustom elpher-connection-timeout 5
+  "Specifies the number of seconds to wait for a network connection to time out."
+  :type '(integer))
+
+(defcustom elpher-filter-ansi-from-text nil
+  "If non-nil, filter ANSI escape sequences from text.
+The default behaviour is to use the ansi-color package to interpret these
+sequences."
+  :type '(boolean))
+
+(defcustom elpher-gemini-TLS-cert-checks nil
+  "If non-nil, verify gemini server TLS certs using the default security level.
+Otherwise, certificate verification is disabled.
+
+This defaults to off because it is standard practice for Gemini servers
+to use self-signed certificates, meaning that most servers provide what
+EMACS considers to be an invalid certificate."
+  :type '(boolean))
+
+(defcustom elpher-gemini-max-fill-width 80
+  "Specify the maximum default width (in columns) of text/gemini documents.
+The actual width used is the minimum of this value and the window width at
+the time when the text is rendered."
+  :type '(integer))
+
+(defcustom elpher-bookmarks-file (locate-user-emacs-file "elpher-bookmarks")
+  "Specify the name of the file where elpher bookmarks will be saved."
+  :type '(file))
+
 ;; Face customizations
 
+(defgroup elpher-faces nil
+  "Elpher face customizations."
+  :group 'elpher)
+
 (defface elpher-index
   '((t :inherit font-lock-keyword-face))
   "Face used for directory type directory records.")
 
 (defface elpher-gemini
   '((t :inherit font-lock-regexp-grouping-backslash))
-  "Face used for html type directory records.")
+  "Face used for Gemini type directory records.")
 
 (defface elpher-other-url
   '((t :inherit font-lock-comment-face))
   '((t :inherit shadow))
   "Face used for brackets around directory margin key.")
 
-;; Other customizations
-
-(defcustom elpher-open-urls-with-eww nil
-  "If non-nil, open URL selectors using eww.
-Otherwise, use the system browser via the BROWSE-URL function."
-  :type '(boolean))
-
-(defcustom elpher-use-header t
-  "If non-nil, display current page information in buffer header."
-  :type '(boolean))
-
-(defcustom elpher-auto-disengage-TLS nil
-  "If non-nil, automatically disengage TLS following an unsuccessful connection.
-While enabling this may seem convenient, it is also potentially dangerous as it
-allows switching from an encrypted channel back to plain text without user input."
-  :type '(boolean))
+(defface elpher-gemini-heading1
+  '((t :inherit bold :height 1.8))
+  "Face used for gemini heading level 1.")
 
-(defcustom elpher-connection-timeout 5
-  "Specifies the number of seconds to wait for a network connection to time out."
-  :type '(integer))
+(defface elpher-gemini-heading2
+  '((t :inherit bold :height 1.5))
+  "Face used for gemini heading level 2.")
 
-(defcustom elpher-filter-ansi-from-text nil
-  "If non-nil, filter ANSI escape sequences from text.
-The default behaviour is to use the ansi-color package to interpret these
-sequences."
-  :type '(boolean))
+(defface elpher-gemini-heading3
+  '((t :inherit bold :height 1.2))
+  "Face used for gemini heading level 3.")
 
 ;;; Model
 ;;
@@ -356,6 +392,10 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Retrieve the address corresponding to PAGE."
   (elt page 1))
 
+(defun elpher-page-set-address (page new-address)
+  "Set the address corresponding to PAGE to NEW-ADDRESS."
+  (setcar (cdr page) new-address))
+
 (defvar elpher-current-page nil)
 (defvar elpher-history nil)
 
@@ -392,7 +432,7 @@ unless NO-HISTORY is non-nil."
   (let ((previous-page (pop elpher-history)))
     (if previous-page
         (elpher-visit-page previous-page nil t)
-      (error "No previous page."))))
+      (error "No previous page"))))
       
 (defun elpher-reload-current-page ()
   "Reload the current page, discarding any existing cached content."
@@ -434,6 +474,8 @@ unless NO-HISTORY is non-nil."
   (list 'with-current-buffer "*elpher*"
         '(elpher-mode)
         (append (list 'let '((inhibit-read-only t))
+                      '(setq-local network-security-level
+                                   (default-value 'network-security-level))
                       '(erase-buffer)
                       '(elpher-update-header))
                 args)))
@@ -506,7 +548,9 @@ to ADDRESS."
       (let* ((kill-buffer-query-functions nil)
              (port (elpher-address-port address))
              (host (elpher-address-host address))
-             (selector-string "")
+             (selector-string-parts nil)
+             (bytes-received 0)
+             (hkbytes-received 0)
              (proc (open-network-stream "elpher-process"
                                         nil
                                         (if force-ipv4 (dns-query host) host)
@@ -537,9 +581,23 @@ to ADDRESS."
         (set-process-coding-system proc 'binary)
         (set-process-filter proc
                             (lambda (_proc string)
-                              (cancel-timer timer)
-                              (setq selector-string
-                                    (concat selector-string string))))
+                              (when timer
+                                (cancel-timer timer)
+                                (setq timer nil))
+                              (setq bytes-received (+ bytes-received (length string)))
+                              (let ((new-hkbytes-received (/ bytes-received 102400)))
+                                (when (> new-hkbytes-received hkbytes-received)
+                                  (setq hkbytes-received new-hkbytes-received)
+                                  (with-current-buffer "*elpher*"
+                                    (let ((inhibit-read-only t))
+                                      (goto-char (point-min))
+                                      (beginning-of-line 2)
+                                      (delete-region (point) (point-max))
+                                      (insert "("
+                                              (number-to-string (/ hkbytes-received 10.0))
+                                              " MB read)")))))
+                              (setq selector-string-parts
+                                    (cons string selector-string-parts))))
         (set-process-sentinel proc
                               (lambda (_proc event)
                                 (condition-case the-error
@@ -552,8 +610,11 @@ to ADDRESS."
                                          (concat (elpher-gopher-address-selector address)
                                                  "\r\n"))))
                                      (t
-                                      (cancel-timer timer)
-                                      (funcall renderer selector-string)
+                                      (when timer
+                                        (cancel-timer timer)
+                                        (setq timer nil))
+                                      (funcall renderer (apply #'concat
+                                                               (reverse selector-string-parts)))
                                       (elpher-restore-pos)))
                                   (error
                                    (elpher-network-error address the-error))))))
@@ -571,7 +632,7 @@ once they are retrieved from the gopher server."
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer
-       (insert "LOADING... (use 'u' to cancel)"))
+       (insert "LOADING... (use 'u' to cancel)\n"))
       (condition-case the-error
           (elpher-get-selector address renderer)
         (error
@@ -770,7 +831,9 @@ The response is rendered using the rendering function RENDERER."
   (if (not data)
       nil
     (let* ((address (elpher-page-address elpher-current-page))
-           (selector (elpher-gopher-address-selector address)))
+           (selector (if (elpher-address-gopher-p address)
+                         (elpher-gopher-address-selector address)
+                       (elpher-address-filename address))))
       (elpher-visit-previous-page) ; Do first in case of non-local exits.
       (let* ((filename-proposal (file-name-nondirectory selector))
              (filename (read-file-name "Download complete. Save file as: "
@@ -803,6 +866,8 @@ The response is rendered using the rendering function RENDERER."
   "Retrieve gemini ADDRESS, then render using RENDERER.
 If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
 to ADDRESS."
+  (unless elpher-gemini-TLS-cert-checks
+    (setq-local network-security-level 'low))
   (if (not (gnutls-available-p))
       (error "Cannot establish gemini connection: GnuTLS not available")
     (unless (< (elpher-address-port address) 65536)
@@ -811,7 +876,9 @@ to ADDRESS."
         (let* ((kill-buffer-query-functions nil)
                (port (elpher-address-port address))
                (host (elpher-address-host address))
-               (response-string "")
+               (response-string-parts nil)
+               (bytes-received 0)
+               (hkbytes-received 0)
                (proc (open-network-stream "elpher-process"
                                           nil
                                           (if force-ipv4 (dns-query host) host)
@@ -832,8 +899,20 @@ to ADDRESS."
                                 (when timer
                                   (cancel-timer timer)
                                   (setq timer nil))
-                                (setq response-string
-                                      (concat response-string string))))
+                                (setq bytes-received (+ bytes-received (length string)))
+                                (let ((new-hkbytes-received (/ bytes-received 102400)))
+                                  (when (> new-hkbytes-received hkbytes-received)
+                                    (setq hkbytes-received new-hkbytes-received)
+                                    (with-current-buffer "*elpher*"
+                                      (let ((inhibit-read-only t))
+                                        (goto-char (point-min))
+                                        (beginning-of-line 2)
+                                        (delete-region (point) (point-max))
+                                        (insert "("
+                                                (number-to-string (/ hkbytes-received 10.0))
+                                                " MB read)")))))
+                                (setq response-string-parts
+                                      (cons string response-string-parts))))
           (set-process-sentinel proc
                                 (lambda (proc event)
                                   (condition-case the-error
@@ -845,7 +924,7 @@ to ADDRESS."
                                            (concat (elpher-address-to-url address)
                                                    "\r\n"))))
                                        ((string-prefix-p "deleted" event)) ; do nothing
-                                       ((and (string-empty-p response-string)
+                                       ((and (not response-string-parts)
                                              (not force-ipv4))
                                         ; Try again with IPv4
                                         (message "Connection failed. Retrying with IPv4.")
@@ -853,11 +932,11 @@ to ADDRESS."
                                         (elpher-get-gemini-response address renderer t))
                                        (t
                                         (funcall #'elpher-process-gemini-response
-                                                 response-string
+                                                 (apply #'concat (reverse response-string-parts))
                                                  renderer)
                                         (elpher-restore-pos)))
                                     (error
-                                           (elpher-network-error address the-error))))))
+                                     (elpher-network-error address the-error))))))
       (error
        (error "Error initiating connection to server")))))
 
@@ -903,6 +982,7 @@ that the response was malformed."
                              "gemini"))
                (error "Server tried to automatically redirect to non-gemini URL: %s"
                       response-meta))
+           (elpher-page-set-address elpher-current-page redirect-address)
            (add-to-list 'elpher-gemini-redirect-chain redirect-address)
            (elpher-get-gemini-response redirect-address renderer)))
         (?4 ; Temporary failure
@@ -927,7 +1007,7 @@ that the response was malformed."
               (insert content)
               (elpher-restore-pos))
           (elpher-with-clean-buffer
-           (insert "LOADING GEMINI... (use 'u' to cancel)"))
+           (insert "LOADING GEMINI... (use 'u' to cancel)\n"))
           (setq elpher-gemini-redirect-chain nil)
           (elpher-get-gemini-response address renderer))
       (error
@@ -968,17 +1048,23 @@ that the response was malformed."
         (_other
          (error "Unsupported MIME type %S" mime-type))))))
 
-(defun elpher-gemini-get-link-url (line)
-  "Extract the url portion of LINE, a gemini map file link line."
-  (string-trim (elt (split-string (substring line 2)) 0)))
-
-(defun elpher-gemini-get-link-display-string (line)
-  "Extract the display string portion of LINE, a gemini map file link line."
-  (let* ((rest (string-trim (elt (split-string line "=>") 1)))
+(defun elpher-gemini-get-link-url (link-line)
+  "Extract the url portion of LINK-LINE, a gemini map file link line.
+Returns nil in the event that the contents of the line following the
+=> prefix are empty."
+  (let ((l (split-string (substring link-line 2))))
+    (if l
+        (string-trim (elt l 0))
+      nil)))
+
+(defun elpher-gemini-get-link-display-string (link-line)
+  "Extract the display string portion of LINK-LINE, a gemini map file link line.
+Returns the url portion in the event that the display-string portion is empty."
+  (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))
          (idx (string-match "[ \t]" rest)))
-    (if idx
-        (string-trim (substring rest (+ idx 1)))
-      "")))
+    (string-trim (if idx
+                     (substring rest (+ idx 1))
+                   rest))))
 
 (defun elpher-collapse-dot-sequences (filename)
   "Collapse dot sequences in FILENAME.
@@ -1014,18 +1100,58 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
                 (elpher-collapse-dot-sequences (url-filename address)))))
     address))
 
+(defun elpher-gemini-insert-link (link-line)
+  "Insert link described by LINK-LINE into a text/gemini document."
+  (let* ((url (elpher-gemini-get-link-url link-line))
+         (display-string (elpher-gemini-get-link-display-string link-line))
+         (address (elpher-address-from-gemini-url url))
+         (type (if address (elpher-address-type address) nil))
+         (type-map-entry (cdr (assoc type elpher-type-map))))
+    (when display-string
+      (insert "→ ")
+      (if type-map-entry
+          (let* ((face (elt type-map-entry 3))
+                 (filtered-display-string (ansi-color-filter-apply display-string))
+                 (page (elpher-make-page filtered-display-string address)))
+            (insert-text-button filtered-display-string
+                                'face face
+                                'elpher-page page
+                                'action #'elpher-click-link
+                                'follow-link t
+                                'help-echo (elpher-page-button-help page)))
+        (insert (propertize display-string 'face 'elpher-unknown)))
+      (insert "\n"))))
+  
+(defun elpher-gemini-insert-header (header-line)
+  "Insert header described by HEADER-LINE into a text/gemini document.
+The gemini map file line describing the header is given
+by HEADER-LINE."
+  (when (string-match "^\\(#+\\)[ \t]*" header-line)
+    (let ((level (length (match-string 1 header-line)))
+          (header (substring header-line (match-end 0))))
+      (unless (display-graphic-p)
+        (insert (make-string level ?#) " "))
+      (insert (propertize header 'face
+                          (pcase level
+                            (1 'elpher-gemini-heading1)
+                            (2 'elpher-gemini-heading2)
+                            (3 'elpher-gemini-heading3)
+                            (_ 'default)))
+              "\n"))))
+
 (defun elpher-render-gemini-map (data _parameters)
   "Render DATA as a gemini map file, PARAMETERS is currently unused."
   (elpher-with-clean-buffer
-   (dolist (line (split-string 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)))
+   (let ((preformatted nil))
+     (auto-fill-mode 1)
+     (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
+     (dolist (line (split-string data "\n"))
+       (cond
+        ((string-prefix-p "```" line) (setq preformatted (not preformatted)))
+        (preformatted (insert (elpher-process-text-for-display line) "\n"))
+        ((string-prefix-p "=>" line) (elpher-gemini-insert-link line))
+        ((string-prefix-p "#" line) (elpher-gemini-insert-header line))
+        (t (insert (elpher-process-text-for-display line)) (newline)))))
    (elpher-cache-content
     (elpher-page-address elpher-current-page)
     (buffer-string))))
@@ -1049,7 +1175,7 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer
-       (insert "LOADING... (use 'u' to cancel)"))
+       (insert "LOADING... (use 'u' to cancel)\n"))
       (condition-case the-error
           (let* ((kill-buffer-query-functions nil)
                  (user (let ((filename (elpher-address-filename address)))
@@ -1059,7 +1185,7 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
                  (port (let ((given-port (elpher-address-port address)))
                          (if (> given-port 0) given-port 79)))
                  (host (elpher-address-host address))
-                 (selector-string "")
+                 (selector-string-parts nil)
                  (proc (open-network-stream "elpher-process"
                                             nil
                                             (if force-ipv4 (dns-query host) host)
@@ -1079,9 +1205,11 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
             (set-process-coding-system proc 'binary)
             (set-process-filter proc
                                 (lambda (_proc string)
-                                  (cancel-timer timer)
-                                  (setq selector-string
-                                        (concat selector-string string))))
+                                  (when timer
+                                    (cancel-timer timer)
+                                    (setq timer nil))
+                                  (setq selector-string-parts
+                                        (cons string selector-string-parts))))
             (set-process-sentinel proc
                                   (lambda (_proc event)
                                     (condition-case the-error
@@ -1093,8 +1221,11 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
                                              proc
                                              (concat user "\r\n"))))
                                          (t
-                                          (cancel-timer timer)
-                                          (funcall renderer selector-string)
+                                          (when timer
+                                            (cancel-timer timer)
+                                            (setq timer nil))
+                                          (funcall renderer (apply #'concat
+                                                                   (reverse selector-string-parts)))
                                           (elpher-restore-pos)))))))
         (error
          (elpher-network-error address the-error))))))
@@ -1221,7 +1352,7 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
            "- a: rename selected bookmark\n"
            "\n"
            "Bookmarks are stored in the file ")
-   (let ((filename (locate-user-emacs-file "elpher-bookmarks"))
+   (let ((filename elpher-bookmarks-file)
          (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
      (insert-text-button filename
                          'face 'link
@@ -1258,7 +1389,7 @@ bookmark list, while URL is the url of the entry."
 (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 elpher-bookmarks-file
     (erase-buffer)
     (insert "; Elpher bookmarks file\n\n"
             "; Bookmarks are stored as a list of (label URL) items.\n"
@@ -1271,7 +1402,7 @@ Beware that this completely replaces the existing contents of the file."
   (let ((bookmarks
          (with-temp-buffer
            (ignore-errors
-             (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
+             (insert-file-contents elpher-bookmarks-file)
              (goto-char (point-min))
              (read (current-buffer))))))
     (if (and bookmarks (listp (cadar bookmarks)))