Added gophers (gopher with TLS) to external link handlers.
[elpher.git] / elpher.el
index 2a30f99..809e41f 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -1,11 +1,11 @@
 ;;; elpher.el --- A friendly gopher and gemini client  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2019-2022 Tim Vaughan <plugd@thelambdalab.xyz>
+;; Copyright (C) 2019-2023 Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Copyright (C) 2020-2022 Elpher contributors (See info manual for full list)
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 3.4.2
+;; Version: 3.4.3
 ;; Keywords: comm gopher
 ;; Homepage: https://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "27.1"))
 (require 'gnutls)
 (require 'socks)
 (require 'bookmark)
+(require 'rx)
 
 ;;; Global constants
 ;;
 
-(defconst elpher-version "3.4.2"
+(defconst elpher-version "3.4.3"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -570,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
-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
@@ -869,7 +870,8 @@ the host operating system and the local network capabilities.)"
                                                                  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
@@ -883,6 +885,7 @@ the host operating system and the local network capabilities.)"
                                                   (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)
@@ -926,17 +929,19 @@ the host operating system and the local network capabilities.)"
                                                                   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
-            (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)
@@ -1347,14 +1352,17 @@ that the response was malformed."
          (elpher-with-clean-buffer
           (insert "Gemini server is requesting input."))
          (let* ((query-string
-                 (if (eq (elt response-code 1) ?1)
-                     (read-passwd (concat response-meta ": "))
-                   (read-string (concat response-meta ": "))))
+                 (with-local-quit
+                   (if (eq (elt response-code 1) ?1)
+                       (read-passwd (concat response-meta ": "))
+                     (read-string (concat response-meta ": ")))))
                 (query-address (seq-copy (elpher-page-address elpher-current-page)))
                 (old-fname (url-filename query-address)))
-           (setf (url-filename query-address)
-                 (concat old-fname "?" (url-build-query-string `((,query-string)))))
-           (elpher-get-gemini-response query-address renderer)))
+           (if (not query-string)
+               (elpher-visit-previous-page)
+             (setf (url-filename query-address)
+                   (concat old-fname "?" (url-build-query-string `((,query-string)))))
+             (elpher-get-gemini-response query-address renderer))))
         (?2 ; Normal response
          (funcall renderer response-body response-meta))
         (?3 ; Redirect
@@ -1800,10 +1808,10 @@ Assumes UTF-8 encoding for all text files."
          (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)
-        (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))
@@ -2183,6 +2191,11 @@ supports the old protocol elpher, where the link is self-contained."
    :export (lambda (link description format _plist)
              (elpher-org-export-link link description format "gopher"))
    :follow (lambda (link _arg) (elpher-org-follow-link link "gopher")))
+  (org-link-set-parameters
+   "gophers"
+   :export (lambda (link description format _plist)
+             (elpher-org-export-link link description format "gophers"))
+   :follow (lambda (link _arg) (elpher-org-follow-link link "gophers")))
   (org-link-set-parameters
    "finger"
    :export (lambda (link description format _plist)
@@ -2204,7 +2217,7 @@ supports the old protocol elpher, where the link is self-contained."
 (if (boundp 'browse-url-default-handlers)
     (add-to-list
      'browse-url-default-handlers
-     '("^\\(gopher\\|finger\\|gemini\\)://" . elpher-browse-url-elpher))
+     '("^\\(gopher\\|gophers\\|finger\\|gemini\\)://" . elpher-browse-url-elpher))
   ;; Patch `browse-url-browser-function' for older ones. The value of
   ;; that variable is `browse-url-default-browser' by default, so
   ;; that's the function that gets advised. If the value is an alist,
@@ -2215,7 +2228,7 @@ supports the old protocol elpher, where the link is self-contained."
                (lambda (url &rest _args)
                  "Handle gemini, gopher, and finger schemes using Elpher."
                   (let ((scheme (downcase (car (split-string url ":" t)))))
-                    (if (member scheme '("gemini" "gopher" "finger"))
+                    (if (member scheme '("gemini" "gopher" "gophers" "finger"))
                        ;; `elpher-go' always returns nil, which will stop the
                        ;; advice chain here in a before-while
                        (elpher-go url)
@@ -2230,13 +2243,13 @@ supports the old protocol elpher, where the link is self-contained."
 
 ;; Make mu4e aware of the gemini world
 (setq mu4e~view-beginning-of-url-regexp
-      "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
+      "\\(?:https?\\|gopher\\|gophers\\|finger\\|gemini\\)://\\|mailto:")
 
 ;; eww:
 
 ;; Let elpher handle gemini, gopher links in eww buffer.
 (setq eww-use-browse-url
-      "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\)://")
+      "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`gophers\\|\\`finger\\)://")
 
 
 ;;; Interactive procedures
@@ -2262,7 +2275,8 @@ supports the old protocol elpher, where the link is self-contained."
   "Go to a particular gopher site HOST-OR-URL.
 When run interactively HOST-OR-URL is read from the minibuffer."
   (interactive (list
-                (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme)))))
+                (read-string (format "Visit URL (default scheme %s): "
+                                     (elpher-get-default-url-scheme)))))
   (let ((trimmed-host-or-url (string-trim host-or-url)))
     (unless (string-empty-p trimmed-host-or-url)
       (let ((page (elpher-page-from-url trimmed-host-or-url
@@ -2279,10 +2293,14 @@ Unlike `elpher-go', the reader is initialized with the URL of the
 current page."
   (interactive)
   (let* ((address (elpher-page-address elpher-current-page))
-         (url (read-string (format "Visit URL (default scheme %s): " (elpher-get-default-url-scheme))
+         (url (read-string (format "Visit URL (default scheme %s): "
+                                   (elpher-get-default-url-scheme))
                            (elpher-address-to-url address))))
-    (unless (string-empty-p (string-trim url))
-      (elpher-visit-page (elpher-page-from-url url)))))
+    (let ((trimmed-url (string-trim url)))
+      (unless (string-empty-p trimmed-url)
+        (elpher-with-clean-buffer
+         (elpher-visit-page
+          (elpher-page-from-url trimmed-url (elpher-get-default-url-scheme))))))))
 
 (defun elpher-redraw ()
   "Redraw current page."
@@ -2345,9 +2363,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))
-    (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)))