Merge remote-tracking branch 'origin/patch_force_ipv4'
[elpher.git] / elpher.el
index f13092a..6e885e4 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -1,10 +1,10 @@
-;;; elpher.el --- A friendly gopher client  -*- lexical-binding:t -*-
+;;; elpher.el --- A friendly gopher and gemini client  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2019 Tim Vaughan
 
-;; Author: Tim Vaughan <timv@ughan.xyz>
+;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.7.1
+;; Version: 2.7.9
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26"))
@@ -26,8 +26,8 @@
 
 ;;; Commentary:
 
-;; Elpher aims to provide a practical and friendly gopher client
-;; for GNU Emacs.  It supports:
+;; Elpher aims to provide a practical and friendly gopher and gemini
+;; client for GNU Emacs.  It supports:
 
 ;; - intuitive keyboard and mouse-driven browsing,
 ;; - out-of-the-box compatibility with evil-mode,
@@ -36,7 +36,7 @@
 ;; - pleasant and configurable colouring of Gopher directories,
 ;; - direct visualisation of image files,
 ;; - a simple bookmark management system,
-;; - connections using TLS encryption,
+;; - gopher connections using TLS encryption,
 ;; - the fledgling Gemini protocol,
 ;; - the greybeard Finger protocol.
 
@@ -70,7 +70,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.7.1"
+(defconst elpher-version "2.7.9"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -148,6 +148,24 @@ 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-gemini-link-string "→ "
+  "Specify the string used to indicate links when rendering gemini maps.
+May be empty."
+  :type '(string))
+
+(defcustom elpher-gemini-bullet-string "•"
+  "Specify the string used for bullets when rendering gemini maps."
+  :type '(string))
+
+(defcustom elpher-bookmarks-file (locate-user-emacs-file "elpher-bookmarks")
+  "Specify the name of the file where elpher bookmarks will be saved."
+  :type '(file))
+
+(defcustom elpher-force-ipv4 nil
+  "If non-nil, force elpher to use ipv4 instead of trying an ipv6 address
+and falling back to an ipv4 address"
+  :type '(boolean))
+
 ;; Face customizations
 
 (defgroup elpher-faces nil
@@ -208,15 +226,19 @@ the time when the text is rendered."
 
 (defface elpher-gemini-heading1
   '((t :inherit bold :height 1.8))
-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 1.")
 
 (defface elpher-gemini-heading2
   '((t :inherit bold :height 1.5))
-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 2.")
 
 (defface elpher-gemini-heading3
   '((t :inherit bold :height 1.2))
-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 3.")
+
+(defface elpher-gemini-preformatted
+  '((t :inherit fixed-pitch))
+  "Face used for pre-formatted gemini text blocks.")
 
 ;;; Model
 ;;
@@ -261,6 +283,7 @@ The basic attributes include: TYPE, SELECTOR, HOST and PORT.
 If the optional attribute TLS is non-nil, the address will be marked as
 requiring gopher-over-TLS."
   (cond
+   ((equal type ?i) nil)
    ((and (equal type ?h)
          (string-prefix-p "URL:" selector))
     (elpher-address-from-url (elt (split-string selector "URL:") 1)))
@@ -349,7 +372,7 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Retrieve gopher selector from ADDRESS object."
   (if (member (url-filename address) '("" "/"))
       ""
-    (substring (url-filename address) 2)))
+    (url-unhex-string (substring (url-filename address) 2))))
 
 
 ;; Cache
@@ -542,9 +565,12 @@ to ADDRESS."
     (error "Cannot retrieve gopher selector: port number > 65536"))
   (condition-case nil
       (let* ((kill-buffer-query-functions nil)
+             (gnutls-verify-error nil) ; We use the NSM for verification
              (port (elpher-address-port address))
              (host (elpher-address-host address))
              (selector-string-parts nil)
+             (bytes-received 0)
+             (hkbytes-received 0)
              (proc (open-network-stream "elpher-process"
                                         nil
                                         (if force-ipv4 (dns-query host) host)
@@ -564,7 +590,7 @@ to ADDRESS."
                                           (progn
                                             (message "Disabling TLS mode.")
                                             (setq elpher-use-tls nil)
-                                            (elpher-get-selector address renderer))
+                                            (elpher-get-selector address renderer elpher-force-ipv4))
                                         (elpher-network-error address "Could not establish encrypted connection")))
                                      ('connect
                                       (elpher-process-cleanup)
@@ -575,7 +601,21 @@ to ADDRESS."
         (set-process-coding-system proc 'binary)
         (set-process-filter proc
                             (lambda (_proc string)
-                              (cancel-timer timer)
+                              (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
@@ -590,7 +630,9 @@ to ADDRESS."
                                          (concat (elpher-gopher-address-selector address)
                                                  "\r\n"))))
                                      (t
-                                      (cancel-timer timer)
+                                      (when timer
+                                        (cancel-timer timer)
+                                        (setq timer nil))
                                       (funcall renderer (apply #'concat
                                                                (reverse selector-string-parts)))
                                       (elpher-restore-pos)))
@@ -610,9 +652,9 @@ 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)
+          (elpher-get-selector address renderer elpher-force-ipv4)
         (error
          (elpher-network-error address the-error))))))
 
@@ -649,12 +691,19 @@ once they are retrieved from the gopher server."
         (insert " "))
     (insert (make-string elpher-margin-width ?\s))))
 
-(defun elpher-page-button-help (page)
-  "Return a string containing the help text for a button corresponding to PAGE."
-  (let ((address (elpher-page-address page)))
-    (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
-                                          address
-                                        (elpher-address-to-url address)))))
+(defun elpher--page-button-help (_window buffer pos)
+  "Function called by Emacs to generate mouse-over text.
+The arguments specify the BUFFER and the POS within the buffer of the item
+for which help is required.  The function returns the help to be
+displayed.  The _WINDOW argument is currently unused."
+  (with-current-buffer buffer
+    (let ((button (button-at pos)))
+      (when button
+        (let* ((page (button-get button 'elpher-page))
+               (address (elpher-page-address page)))
+          (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
+                                                address
+                                              (url-recreate-url address))))))))
 
 (defun elpher-insert-index-record (display-string &optional address)
   "Function to insert an index record into the current buffer.
@@ -674,9 +723,9 @@ If ADDRESS is not supplied or nil the record is rendered as an
                               'elpher-page page
                               'action #'elpher-click-link
                               'follow-link t
-                              'help-echo (elpher-page-button-help page)))
+                              'help-echo #'elpher--page-button-help))
       (pcase type
-        ((or '(gopher ?i) 'nil) ;; Information
+        ('nil ;; Information
          (elpher-insert-margin)
          (let ((propertized-display-string
                 (propertize display-string 'face 'elpher-info)))
@@ -720,7 +769,7 @@ If ADDRESS is not supplied or nil the record is rendered as an
                             'elpher-page  page
                             'action #'elpher-click-link
                             'follow-link t
-                            'help-echo (elpher-page-button-help page)
+                            'help-echo #'elpher--page-button-help
                             'face 'button)))
     (buffer-string)))
 
@@ -785,7 +834,7 @@ The response is rendered using the rendering function RENDERER."
 
             (elpher-with-clean-buffer
              (insert "LOADING RESULTS... (use 'u' to cancel)"))
-            (elpher-get-selector search-address renderer))
+            (elpher-get-selector search-address renderer elpher-force-ipv4))
         (if aborted
             (elpher-visit-previous-page))))))
  
@@ -809,7 +858,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: "
@@ -848,11 +899,15 @@ to ADDRESS."
       (error "Cannot establish gemini connection: GnuTLS not available")
     (unless (< (elpher-address-port address) 65536)
       (error "Cannot establish gemini connection: port number > 65536"))
+    (defvar gnutls-verify-error)
     (condition-case nil
         (let* ((kill-buffer-query-functions nil)
+               (gnutls-verify-error nil) ; We use the NSM for verification
                (port (elpher-address-port address))
                (host (elpher-address-host address))
                (response-string-parts nil)
+               (bytes-received 0)
+               (hkbytes-received 0)
                (proc (open-network-stream "elpher-process"
                                           nil
                                           (if force-ipv4 (dns-query host) host)
@@ -873,6 +928,18 @@ to ADDRESS."
                                 (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 response-string-parts
                                       (cons string response-string-parts))))
           (set-process-sentinel proc
@@ -898,7 +965,7 @@ to ADDRESS."
                                                  renderer)
                                         (elpher-restore-pos)))
                                     (error
-                                           (elpher-network-error address the-error))))))
+                                     (elpher-network-error address the-error))))))
       (error
        (error "Error initiating connection to server")))))
 
@@ -915,7 +982,7 @@ that the response was malformed."
                     (meta (string-trim (substring header 2))))
                 (list code meta body))
             (error "Malformed response: No response status found in header %s" header)))
-      (error "Malformed response: No CRLF-delimited header found"))))
+      (error "Malformed response: No CRLF-delimited header found in response %s" response))))
 
 (defun elpher-process-gemini-response (response-string renderer)
   "Process the gemini response RESPONSE-STRING and pass the result to RENDERER."
@@ -969,7 +1036,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
@@ -1008,7 +1075,7 @@ that the response was malformed."
         ((pred (string-prefix-p "image/"))
          (elpher-render-image body))
         (_other
-         (error "Unsupported MIME type %S" mime-type))))))
+         (elpher-render-download body))))))
 
 (defun elpher-gemini-get-link-url (link-line)
   "Extract the url portion of LINK-LINE, a gemini map file link line.
@@ -1070,7 +1137,7 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
          (type (if address (elpher-address-type address) nil))
          (type-map-entry (cdr (assoc type elpher-type-map))))
     (when display-string
-      (insert "→ ")
+      (insert elpher-gemini-link-string)
       (if type-map-entry
           (let* ((face (elt type-map-entry 3))
                  (filtered-display-string (ansi-color-filter-apply display-string))
@@ -1080,7 +1147,7 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
                                 'elpher-page page
                                 'action #'elpher-click-link
                                 'follow-link t
-                                'help-echo (elpher-page-button-help page)))
+                                'help-echo #'elpher--page-button-help))
         (insert (propertize display-string 'face 'elpher-unknown)))
       (insert "\n"))))
   
@@ -1101,6 +1168,24 @@ by HEADER-LINE."
                             (_ 'default)))
               "\n"))))
 
+(defun elpher-gemini-insert-text (text-line)
+  "Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
+This function uses Emacs' auto-fill to wrap text sensibly to a maximum
+width defined by elpher-gemini-max-fill-width."
+  (string-match "\\(^[ \t]*\\)\\(\*[ \t]\\)?" text-line)
+  (let* ((processed-text-line (if (match-string 2 text-line)
+                                  (concat
+                                   (replace-regexp-in-string "\*"
+                                                             elpher-gemini-bullet-string
+                                                             (match-string 0 text-line))
+                                   (substring text-line (match-end 0)))
+                                text-line))
+         (fill-prefix (if (match-string 1 text-line)
+                          (replace-regexp-in-string "\*" " " (match-string 0 text-line))
+                        nil)))
+    (insert (elpher-process-text-for-display processed-text-line))
+    (newline)))
+
 (defun elpher-render-gemini-map (data _parameters)
   "Render DATA as a gemini map file, PARAMETERS is currently unused."
   (elpher-with-clean-buffer
@@ -1110,10 +1195,12 @@ by HEADER-LINE."
      (dolist (line (split-string data "\n"))
        (cond
         ((string-prefix-p "```" line) (setq preformatted (not preformatted)))
-        (preformatted (insert (elpher-process-text-for-display line) "\n"))
+        (preformatted (insert (elpher-process-text-for-display
+                               (propertize line 'face 'elpher-gemini-preformatted))
+                              "\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)))))
+        (t (elpher-gemini-insert-text line)))))
    (elpher-cache-content
     (elpher-page-address elpher-current-page)
     (buffer-string))))
@@ -1129,7 +1216,10 @@ by HEADER-LINE."
 ;; Finger page connection
 
 (defun elpher-get-finger-page (renderer &optional force-ipv4)
-  "Opens a finger connection to the current page address and renders it using RENDERER."
+  "Opens a finger connection to the current page address.
+The result is rendered using RENDERER.  When the optional argument
+FORCE-IPV4 is non-nil, the IPv4 address returned by a DNS lookup will
+be used explicitly in making the connection."
   (let* ((address (elpher-page-address elpher-current-page))
          (content (elpher-get-cached-content address)))
     (if (and content (funcall renderer nil))
@@ -1137,7 +1227,7 @@ by HEADER-LINE."
          (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)))
@@ -1167,12 +1257,14 @@ by HEADER-LINE."
             (set-process-coding-system proc 'binary)
             (set-process-filter proc
                                 (lambda (_proc string)
-                                  (cancel-timer timer)
+                                  (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
+                                    (condition-case _the-error
                                         (cond
                                          ((string-prefix-p "deleted" event))
                                          ((string-prefix-p "open" event)
@@ -1181,7 +1273,9 @@ by HEADER-LINE."
                                              proc
                                              (concat user "\r\n"))))
                                          (t
-                                          (cancel-timer timer)
+                                          (when timer
+                                            (cancel-timer timer)
+                                            (setq timer nil))
                                           (funcall renderer (apply #'concat
                                                                    (reverse selector-string-parts)))
                                           (elpher-restore-pos)))))))
@@ -1229,7 +1323,7 @@ by HEADER-LINE."
     (error "Command not supported for start page"))
   (elpher-with-clean-buffer
    (insert "     --------------------------------------------\n"
-           "                Elpher Gopher Client             \n"
+           "           Elpher Gopher and Gemini Client       \n"
            "                   version " elpher-version "\n"
            "     --------------------------------------------\n"
            "\n"
@@ -1238,9 +1332,9 @@ by HEADER-LINE."
            " - TAB/Shift-TAB: next/prev item on current page\n"
            " - RET/mouse-1: open item under cursor\n"
            " - m: select an item on current page by name (autocompletes)\n"
-           " - u/mouse-3: return to previous page\n"
+           " - u/mouse-3/U: return to previous page or to the start page\n"
            " - o/O: visit different selector or the root menu of the current server\n"
-           " - g: go to a particular gopher address\n"
+           " - g: go to a particular address (gopher, gemini, finger)\n"
            " - d/D: download item under cursor or current page\n"
            " - i/I: info on item under cursor or current page\n"
            " - c/C: copy URL representation of item under cursor or current page\n"
@@ -1253,13 +1347,17 @@ by HEADER-LINE."
            " - T: toggle TLS gopher mode\n"
            " - .: display the raw server response for the current page\n"
            "\n"
-           "Start your exploration of gopher space:\n")
+           "Start your exploration of gopher space and gemini:\n")
    (elpher-insert-index-record "Floodgap Systems Gopher Server"
                                (elpher-make-gopher-address ?1 "" "gopher.floodgap.com" 70))
+   (elpher-insert-index-record "Project Gemini home page"
+                               (elpher-address-from-url "gemini://gemini.circumlunar.space/"))
    (insert "\n"
-           "Alternatively, select the following item and enter some search terms:\n")
-   (elpher-insert-index-record "Veronica-2 Gopher Search Engine"
+           "Alternatively, select a search engine and enter some search terms:\n")
+   (elpher-insert-index-record "Gopher Search Engine (Veronica-2)"
                                (elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70))
+   (elpher-insert-index-record "Gemini Search Engine (GUS)"
+                               (elpher-address-from-url "gemini://gus.guru/search"))
    (insert "\n"
            "This page contains your bookmarked sites (also visit with B):\n")
    (elpher-insert-index-record "Your Bookmarks" 'bookmarks)
@@ -1310,7 +1408,7 @@ by HEADER-LINE."
            "- 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
@@ -1347,7 +1445,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"
@@ -1360,7 +1458,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)))
@@ -1463,6 +1561,15 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (interactive)
   (elpher-visit-previous-page))
 
+(defun elpher-back-to-start ()
+  "Go all the way back to the start page."
+  (interactive)
+  (setq elpher-current-page nil)
+  (setq elpher-history nil)
+  (let ((start-page (elpher-make-page "Elpher Start Page"
+                                      (elpher-make-special-address 'start))))
+    (elpher-visit-page start-page)))
+
 (defun elpher-download ()
   "Download the link at point."
   (interactive)
@@ -1650,7 +1757,9 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "TAB") 'elpher-next-link)
     (define-key map (kbd "<backtab>") 'elpher-prev-link)
+    (define-key map (kbd "C-M-i") 'elpher-prev-link)
     (define-key map (kbd "u") 'elpher-back)
+    (define-key map (kbd "U") 'elpher-back-to-start)
     (define-key map [mouse-3] 'elpher-back)
     (define-key map (kbd "O") 'elpher-root-dir)
     (define-key map (kbd "g") 'elpher-go)
@@ -1678,6 +1787,7 @@ When run interactively HOST-OR-URL is read from the minibuffer."
         (kbd "C-") 'elpher-follow-current-link
         (kbd "C-t") 'elpher-back
         (kbd "u") 'elpher-back
+        (kbd "U") 'elpher-back-to-start
         [mouse-3] 'elpher-back
         (kbd "g") 'elpher-go
         (kbd "o") 'elpher-go-current
@@ -1723,6 +1833,7 @@ functions which initialize the gopher client, namely
       (switch-to-buffer "*elpher*")
     (switch-to-buffer "*elpher*")
     (setq elpher-current-page nil)
+    (setq elpher-history nil)
     (let ((start-page (elpher-make-page "Elpher Start Page"
                                         (elpher-make-special-address 'start))))
       (elpher-visit-page start-page)))