Removed useless page creation.

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index 9236228..b18a897 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -5,7 +5,7 @@
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019

-;; Version: 3.4.1
+;; Version: 3.4.2

 ;; Keywords: comm gopher
 ;; Homepage: https://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "27.1"))
 ;; Keywords: comm gopher
 ;; Homepage: https://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "27.1"))


@@ -66,11 +66,12 @@
 (require 'gnutls)
 (require 'socks)
 (require 'bookmark)
 (require 'gnutls)
 (require 'socks)
 (require 'bookmark)

+(require 'rx)

 
 ;;; Global constants
 ;;
 
 
 ;;; Global constants
 ;;
 

-(defconst elpher-version "3.4.1"
+(defconst elpher-version "3.4.2"

   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6


@@ -314,6 +315,10 @@ meaningfully."
   '((t :inherit font-lock-doc-face))
   "Face used for gemini quoted texts.")
 
   '((t :inherit font-lock-doc-face))
   "Face used for gemini quoted texts.")
 

+(defface elpher-gemini-preformatted
+  '((t :inherit default))
+  "Face used for gemini preformatted text.")
+

 (defface elpher-gemini-preformatted-toggle
   '((t :inherit button))
   "Face used for buttons used to toggle display of preformatted text.")
 (defface elpher-gemini-preformatted-toggle
   '((t :inherit button))
   "Face used for buttons used to toggle display of preformatted text.")


@@ -425,11 +430,11 @@ address refers to, via the table `elpher-type-map'."
     (_ 'other-url)))
 
 (defun elpher-address-about-p (address)
     (_ 'other-url)))
 
 (defun elpher-address-about-p (address)

-  "Return non-nil if ADDRESS is an  about address."
+  "Return non-nil if ADDRESS is an about address."

   (pcase (elpher-address-type address) (`(about ,_) t)))
 
 (defun elpher-address-gopher-p (address)
   (pcase (elpher-address-type address) (`(about ,_) t)))
 
 (defun elpher-address-gopher-p (address)

-  "Return non-nill if ADDRESS object is a gopher address."
+  "Return non-nil if ADDRESS object is a gopher address."

   (pcase (elpher-address-type address) (`(gopher ,_) t)))
 
 (defun elpher-address-protocol (address)
   (pcase (elpher-address-type address) (`(gopher ,_) t)))
 
 (defun elpher-address-protocol (address)


@@ -443,17 +448,21 @@ For gopher addresses this is a combination of the selector type and selector."
 
 (defun elpher-address-host (address)
   "Retrieve host from ADDRESS object."
 
 (defun elpher-address-host (address)
   "Retrieve host from ADDRESS object."

-  (let ((host-pre (url-host address)))
+  (pcase (url-host address)

     ;; The following strips out square brackets which sometimes enclose IPv6
     ;; addresses.  Doing this here rather than at the parsing stage may seem
     ;; weird, but this lets us way we avoid having to muck with both URL parsing
     ;; and reconstruction.  It's also more efficient, as this method is not
     ;; called during page rendering.
     ;; The following strips out square brackets which sometimes enclose IPv6
     ;; addresses.  Doing this here rather than at the parsing stage may seem
     ;; weird, but this lets us way we avoid having to muck with both URL parsing
     ;; and reconstruction.  It's also more efficient, as this method is not
     ;; called during page rendering.

-    (if (and (> (length host-pre) 2)
-             (eq (elt host-pre 0) ?\[)
-             (eq (elt host-pre (- (length host-pre) 1)) ?\]))
-        (substring host-pre 1 (- (length host-pre) 1))
-      host-pre)))
+    ((rx (: "[" (let ipv6 (* (not "]"))) "]"))
+     ipv6)
+    ;; The following is a work-around for a parsing bug that causes
+    ;; URLs with empty (but not absent, see RFC 1738) usernames to have
+    ;; @ prepended to the hostname.
+    ((rx (: "@" (let rest (+ anything))))
+     rest)
+    (addr
+     addr)))

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


@@ -463,7 +472,8 @@ For gopher addresses this is a combination of the selector type and selector."
   "Retrieve port from ADDRESS object.
 If no address is defined, returns 0.  (This is for compatibility with
 the URL library.)"
   "Retrieve port from ADDRESS object.
 If no address is defined, returns 0.  (This is for compatibility with
 the URL library.)"

-  (url-port address))
+  (let ((port (url-portspec address))) ; (url-port) is too slow!
+    (if port port 0)))

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


@@ -561,7 +571,7 @@ This variable is used by `elpher-show-visited-pages'.")
 (defun elpher-visit-page (page &optional renderer no-history)
   "Visit PAGE using its own renderer or RENDERER, if non-nil.
 Additionally, push PAGE onto the history stack and the list of
 (defun elpher-visit-page (page &optional renderer no-history)
   "Visit PAGE using its own renderer or RENDERER, if non-nil.
 Additionally, push PAGE onto the history stack and the list of

-previously-visited pages,unless NO-HISTORY is non-nil."
+previously-visited pages, unless NO-HISTORY is non-nil."

   (elpher-save-pos)
   (elpher-process-cleanup)
   (unless no-history
   (elpher-save-pos)
   (elpher-process-cleanup)
   (unless no-history


@@ -724,7 +734,8 @@ away CRs and any terminating period."
                           'face 'button)))
     (buffer-string)))
 
                           'face 'button)))
     (buffer-string)))
 

-;;; ANSI colors or XTerm colors (application and filtering)
+
+;; ANSI colors or XTerm colors (application and filtering)

 
 (or (require 'xterm-color nil t)
     (require 'ansi-color))
 
 (or (require 'xterm-color nil t)
     (require 'ansi-color))


@@ -743,17 +754,25 @@ away CRs and any terminating period."
     #'ansi-color-apply)
   "A function to apply ANSI escape sequences.")
 
     #'ansi-color-apply)
   "A function to apply ANSI escape sequences.")
 

-;;; Processing text for display
+(defun elpher-text-has-ansi-escapes-p (string)
+  "Return non-nil if STRING includes an ANSI escape code."
+  (save-match-data
+    (string-match "\x1b\\[" string)))
+
+
+;; Processing text for display

 
 (defun elpher-process-text-for-display (string)
   "Perform any desired processing of STRING prior to display as text.
 Currently includes buttonifying URLs and processing ANSI escape codes."
 
 (defun elpher-process-text-for-display (string)
   "Perform any desired processing of STRING prior to display as text.
 Currently includes buttonifying URLs and processing ANSI escape codes."

-  (elpher-buttonify-urls (if elpher-filter-ansi-from-text
-                             (elpher-color-filter-apply string)
-                           (elpher-color-apply string))))
+  (elpher-buttonify-urls (if (elpher-text-has-ansi-escapes-p string)
+                             (if elpher-filter-ansi-from-text
+                                 (elpher-color-filter-apply string)
+                               (elpher-color-apply string))
+                           string)))

 
 
 
 

-;;; Network error reporting
+;;; General network communication

 ;;
 
 (defun elpher-network-error (address error)
 ;;
 
 (defun elpher-network-error (address error)


@@ -767,9 +786,6 @@ ERROR can be either an error object or a string."
            "Press 'u' to return to the previous page.")))
 
 
            "Press 'u' to return to the previous page.")))
 
 

-;;; General network communication
-;;
-

 (defvar elpher-network-timer nil
   "Timer used for network connections.")
 
 (defvar elpher-network-timer nil
   "Timer used for network connections.")
 


@@ -854,7 +870,8 @@ the host operating system and the local network capabilities.)"
                                                                  nil force-ipv4))
                                       (t
                                        (elpher-network-error address "Connection time-out."))))))
                                                                  nil force-ipv4))
                                       (t
                                        (elpher-network-error address "Connection time-out."))))))

-               (proc (if socks (socks-open-network-stream "elpher-process" nil host service)
+               (proc (if socks
+                         (socks-open-network-stream "elpher-process" nil host service)

                        (make-network-process :name "elpher-process"
                                              :host host
                                              :family (and (or force-ipv4
                        (make-network-process :name "elpher-process"
                                              :host host
                                              :family (and (or force-ipv4


@@ -868,6 +885,7 @@ the host operating system and the local network capabilities.)"
                                                   (cons 'gnutls-x509pki
                                                         (apply #'gnutls-boot-parameters
                                                                gnutls-params)))))))
                                                   (cons 'gnutls-x509pki
                                                         (apply #'gnutls-boot-parameters
                                                                gnutls-params)))))))

+          (process-put proc 'elpher-buffer (current-buffer))

           (setq elpher-network-timer timer)
           (set-process-coding-system proc 'binary 'binary)
           (set-process-query-on-exit-flag proc nil)
           (setq elpher-network-timer timer)
           (set-process-coding-system proc 'binary 'binary)
           (set-process-query-on-exit-flag proc nil)


@@ -911,17 +929,19 @@ the host operating system and the local network capabilities.)"
                                                                   response-processor
                                                                   use-tls t))
                                        (response-string-parts
                                                                   response-processor
                                                                   use-tls t))
                                        (response-string-parts

-                                        (elpher-with-clean-buffer
-                                         (insert "Data received.  Rendering..."))
-                                        (funcall response-processor
-                                                 (apply #'concat (reverse response-string-parts)))
-                                        (elpher-restore-pos))
+                                        (with-current-buffer (process-get proc 'elpher-buffer)
+                                          (elpher-with-clean-buffer
+                                           (insert "Data received.  Rendering..."))
+                                          (funcall response-processor
+                                                   (apply #'concat (reverse response-string-parts)))
+                                          (elpher-restore-pos)))

                                        (t
                                         (error "No response from server")))
                                     (error
                                      (elpher-network-error address the-error)))))
           (when socks
                                        (t
                                         (error "No response from server")))
                                     (error
                                      (elpher-network-error address the-error)))))
           (when socks

-            (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
+            (if use-tls
+                (apply #'gnutls-negotiate :process proc gnutls-params))

             (funcall (process-sentinel proc) proc "open\n")))
       (error
        (elpher-process-cleanup)
             (funcall (process-sentinel proc) proc "open\n")))
       (error
        (elpher-process-cleanup)


@@ -1085,7 +1105,9 @@ once they are retrieved from the gopher server."
         (error
          (elpher-network-error address the-error))))))
 
         (error
          (elpher-network-error address the-error))))))
 

-;; Index rendering
+
+;;; Gopher index rendering
+;;

 
 (defun elpher-insert-margin (&optional type-name)
   "Insert index margin, optionally containing the TYPE-NAME, into current buffer."
 
 (defun elpher-insert-margin (&optional type-name)
   "Insert index margin, optionally containing the TYPE-NAME, into current buffer."


@@ -1169,7 +1191,9 @@ If ADDRESS is not supplied or nil the record is rendered as an
      (elpher-cache-content (elpher-page-address elpher-current-page)
                            (buffer-string)))))
 
      (elpher-cache-content (elpher-page-address elpher-current-page)
                            (buffer-string)))))
 

-;; Text rendering
+
+;;; Gopher text rendering
+;;

 
 (defun elpher-render-text (data &optional _mime-type-string)
   "Render DATA as text.  MIME-TYPE-STRING is unused."
 
 (defun elpher-render-text (data &optional _mime-type-string)
   "Render DATA as text.  MIME-TYPE-STRING is unused."


@@ -1181,7 +1205,9 @@ If ADDRESS is not supplied or nil the record is rendered as an
       (elpher-page-address elpher-current-page)
       (buffer-string)))))
 
       (elpher-page-address elpher-current-page)
       (buffer-string)))))
 

-;; Image retrieval
+
+;;; Image retrieval
+;;

 
 (defun elpher-render-image (data &optional _mime-type-string)
   "Display DATA as image.  MIME-TYPE-STRING is unused."
 
 (defun elpher-render-image (data &optional _mime-type-string)
   "Display DATA as image.  MIME-TYPE-STRING is unused."


@@ -1202,7 +1228,9 @@ If ADDRESS is not supplied or nil the record is rendered as an
              (elpher-restore-pos))))
       (elpher-render-download data))))
 
              (elpher-restore-pos))))
       (elpher-render-download data))))
 

-;; Search retrieval and rendering
+
+;;; Gopher search retrieval and rendering
+;;

 
 (defun elpher-get-gopher-query-page (renderer)
   "Getter for gopher addresses requiring input.
 
 (defun elpher-get-gopher-query-page (renderer)
   "Getter for gopher addresses requiring input.


@@ -1231,7 +1259,9 @@ The response is rendered using the rendering function RENDERER."
         (if aborted
             (elpher-visit-previous-page))))))
 
         (if aborted
             (elpher-visit-previous-page))))))
 

-;; Raw server response rendering
+
+;;; Raw server response rendering
+;;

 
 (defun elpher-render-raw (data &optional mime-type-string)
   "Display raw DATA in buffer.  MIME-TYPE-STRING is also displayed if provided."
 
 (defun elpher-render-raw (data &optional mime-type-string)
   "Display raw DATA in buffer.  MIME-TYPE-STRING is also displayed if provided."


@@ -1244,7 +1274,9 @@ The response is rendered using the rendering function RENDERER."
      (goto-char (point-min)))
     (message "Displaying raw server response.  Reload or redraw to return to standard view.")))
 
      (goto-char (point-min)))
     (message "Displaying raw server response.  Reload or redraw to return to standard view.")))
 

-;; File save "rendering"
+
+;;; File save "rendering"
+;;

 
 (defun elpher-render-download (data &optional _mime-type-string)
   "Save DATA to file.  MIME-TYPE-STRING is unused."
 
 (defun elpher-render-download (data &optional _mime-type-string)
   "Save DATA to file.  MIME-TYPE-STRING is unused."


@@ -1266,7 +1298,9 @@ The response is rendered using the rendering function RENDERER."
             (insert data)))
         (message (format "Saved to file %s." filename))))))
 
             (insert data)))
         (message (format "Saved to file %s." filename))))))
 

-;; HTML rendering
+
+;;; HTML rendering
+;;

 
 (defun elpher-render-html (data &optional _mime-type-string)
   "Render DATA as HTML using shr.  MIME-TYPE-STRING is unused."
 
 (defun elpher-render-html (data &optional _mime-type-string)
   "Render DATA as HTML using shr.  MIME-TYPE-STRING is unused."


@@ -1278,7 +1312,9 @@ The response is rendered using the rendering function RENDERER."
                   (libxml-parse-html-region (point-min) (point-max)))))
        (shr-insert-document dom)))))
 
                   (libxml-parse-html-region (point-min) (point-max)))))
        (shr-insert-document dom)))))
 

-;; Gemini page retrieval
+
+;;; Gemini page retrieval
+;;

 
 (defvar elpher-gemini-redirect-chain)
 
 
 (defvar elpher-gemini-redirect-chain)
 


@@ -1434,6 +1470,9 @@ is a list of possible answers."
       (error
        (elpher-network-error address the-error)))))
 
       (error
        (elpher-network-error address the-error)))))
 

+;;; Gemini page rendering
+;;
+

 (defun elpher-render-gemini (body &optional mime-type-string)
   "Render gemini response BODY with rendering MIME-TYPE-STRING."
   (if (not body)
 (defun elpher-render-gemini (body &optional mime-type-string)
   "Render gemini response BODY with rendering MIME-TYPE-STRING."
   (if (not body)


@@ -1637,7 +1676,9 @@ If non-nil, ALT-TEXT is displayed alongside the button."
   "Insert a LINE of preformatted text.
 PREF-ID is the value assigned to the \"invisible\" text attribute, which
 can be used to toggle the display of the preformatted text."
   "Insert a LINE of preformatted text.
 PREF-ID is the value assigned to the \"invisible\" text attribute, which
 can be used to toggle the display of the preformatted text."

-  (insert (propertize (concat (elpher-process-text-for-display line) "\n")
+  (insert (propertize (concat (elpher-process-text-for-display
+                               (propertize line 'face 'elpher-gemini-preformatted))
+                              "\n")

                       'invisible pref-id
                       'rear-nonsticky t)))
 
                       'invisible pref-id
                       'rear-nonsticky t)))
 


@@ -1651,7 +1692,7 @@ can be used to toggle the display of the preformatted text."
      (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
      (dolist (line (split-string data "\n"))
        (pcase line
      (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
      (dolist (line (split-string data "\n"))
        (pcase line

-         ((rx (: "```" (opt (let alt-text (+ any)))))
+         ((rx (: string-start "```" (opt (let alt-text (+ any)))))

           (setq preformatted
                 (if preformatted
                     nil
           (setq preformatted
                 (if preformatted
                     nil


@@ -1692,7 +1733,8 @@ can be used to toggle the display of the preformatted text."
       (reverse headers))))
 
 
       (reverse headers))))
 
 

-;; Finger page connection
+;;; Finger page connection
+;;

 
 (defun elpher-get-finger-page (renderer)
   "Opens a finger connection to the current page address.
 
 (defun elpher-get-finger-page (renderer)
   "Opens a finger connection to the current page address.


@@ -1718,7 +1760,8 @@ The result is rendered using RENDERER."
          (elpher-network-error address the-error))))))
 
 
          (elpher-network-error address the-error))))))
 
 

-;; Telnet page connection
+;;; Telnet page connection
+;;

 
 (defun elpher-get-telnet-page (renderer)
   "Opens a telnet connection to the current page address (RENDERER must be nil)."
 
 (defun elpher-get-telnet-page (renderer)
   "Opens a telnet connection to the current page address (RENDERER must be nil)."


@@ -1734,7 +1777,8 @@ The result is rendered using RENDERER."
       (telnet host))))
 
 
       (telnet host))))
 
 

-;; Other URL page opening
+;;; Other URL page opening
+;;

 
 (defun elpher-get-other-url-page (renderer)
   "Getter which attempts to open the URL specified by the current page.
 
 (defun elpher-get-other-url-page (renderer)
   "Getter which attempts to open the URL specified by the current page.


@@ -1751,7 +1795,8 @@ The RENDERER argument to this getter must be nil."
       (browse-url url))))
 
 
       (browse-url url))))
 
 

-;; File page
+;;; File page
+;;

 
 (defun elpher-get-file-page (renderer)
   "Getter which renders a local file using RENDERER.
 
 (defun elpher-get-file-page (renderer)
   "Getter which renders a local file using RENDERER.


@@ -1760,10 +1805,10 @@ Assumes UTF-8 encoding for all text files."
          (filename (elpher-address-filename address)))
     (unless (file-exists-p filename)
       (elpher-visit-previous-page)
          (filename (elpher-address-filename address)))
     (unless (file-exists-p filename)
       (elpher-visit-previous-page)

-        (error "File not found"))
+      (error "File not found"))

     (unless (file-readable-p filename)
       (elpher-visit-previous-page)
     (unless (file-readable-p filename)
       (elpher-visit-previous-page)

-        (error "Could not read from file"))
+      (error "Could not read from file"))

     (let ((body (with-temp-buffer
        (let ((coding-system-for-read 'binary)
              (coding-system-for-write 'binary))
     (let ((body (with-temp-buffer
        (let ((coding-system-for-read 'binary)
              (coding-system-for-write 'binary))


@@ -1787,7 +1832,8 @@ Assumes UTF-8 encoding for all text files."
        (elpher-restore-pos))))
 
 
        (elpher-restore-pos))))
 
 

-;; Welcome page retrieval
+;;; Welcome page retrieval
+;;

 
 (defun elpher-get-welcome-page (renderer)
   "Getter which displays the welcome page (RENDERER must be nil)."
 
 (defun elpher-get-welcome-page (renderer)
   "Getter which displays the welcome page (RENDERER must be nil)."


@@ -1881,7 +1927,8 @@ Assumes UTF-8 encoding for all text files."
    (elpher-restore-pos)))
 
 
    (elpher-restore-pos)))
 
 

-;; History page retrieval
+;;; History page retrieval
+;;

 
 (defun elpher-show-history ()
   "Show the current contents of elpher's history stack.
 
 (defun elpher-show-history ()
   "Show the current contents of elpher's history stack.


@@ -1938,6 +1985,7 @@ This is rendered using `elpher-get-visited-pages-page' via `elpher-type-map'."
 
 
 ;;; Bookmarks
 
 
 ;;; Bookmarks

+;;

 
 ;; This code allows Elpher to use the standard Emacs bookmarks: `C-x r
 ;; m' to add a bookmark, `C-x r l' to list bookmarks (which is where
 
 ;; This code allows Elpher to use the standard Emacs bookmarks: `C-x r
 ;; m' to add a bookmark, `C-x r l' to list bookmarks (which is where


@@ -2148,7 +2196,7 @@ supports the old protocol elpher, where the link is self-contained."
 
 (add-hook 'org-mode-hook #'elpher-org-mode-integration)
 
 
 (add-hook 'org-mode-hook #'elpher-org-mode-integration)
 

-;;; Browse URL
+;; Browse URL

 
 ;;;###autoload
 (defun elpher-browse-url-elpher (url &rest _args)
 
 ;;;###autoload
 (defun elpher-browse-url-elpher (url &rest _args)


@@ -2183,13 +2231,13 @@ supports the old protocol elpher, where the link is self-contained."
 (with-eval-after-load 'thingatpt
   (add-to-list 'thing-at-point-uri-schemes "gemini://"))
 
 (with-eval-after-load 'thingatpt
   (add-to-list 'thing-at-point-uri-schemes "gemini://"))
 

-;;; Mu4e:
+;; Mu4e:

 
 ;; Make mu4e aware of the gemini world
 (setq mu4e~view-beginning-of-url-regexp
       "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
 
 
 ;; Make mu4e aware of the gemini world
 (setq mu4e~view-beginning-of-url-regexp
       "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
 

-;;; eww:
+;; eww:

 
 ;; Let elpher handle gemini, gopher links in eww buffer.
 (setq eww-use-browse-url
 
 ;; Let elpher handle gemini, gopher links in eww buffer.
 (setq eww-use-browse-url


@@ -2302,9 +2350,7 @@ current page."
   (if (elpher-address-about-p (elpher-page-address elpher-current-page))
       (error "Cannot download %s"
              (elpher-page-display-string elpher-current-page))
   (if (elpher-address-about-p (elpher-page-address elpher-current-page))
       (error "Cannot download %s"
              (elpher-page-display-string elpher-current-page))

-    (elpher-visit-page (elpher-make-page
-                        (elpher-page-display-string elpher-current-page)
-                        (elpher-page-address elpher-current-page))
+    (elpher-visit-page elpher-current-page

                        #'elpher-render-download
                        t)))
 
                        #'elpher-render-download
                        t)))