Merge remote-tracking branch 'upstream/patch_gemini_quoted_face' into main

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index cf641ab..72bba89 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -66,6 +66,7 @@
 (require 'ansi-color)
 (require 'nsm)
 (require 'gnutls)
 (require 'ansi-color)
 (require 'nsm)
 (require 'gnutls)

+(require 'socks)

 
 
 ;;; Global constants
 
 
 ;;; Global constants


@@ -178,6 +179,11 @@ This can be useful when browsing from a computer that supports IPv6, because
 some servers which do not support IPv6 can take a long time to time-out."
   :type '(boolean))
 
 some servers which do not support IPv6 can take a long time to time-out."
   :type '(boolean))
 

+(defcustom elpher-socks-always nil
+  "If non-nil, elpher will establish network connections over a SOCKS proxy.
+Otherwise, the SOCKS proxy is only used for connections to onion services."
+  :type '(boolean))
+

 ;; Face customizations
 
 (defgroup elpher-faces nil
 ;; Face customizations
 
 (defgroup elpher-faces nil


@@ -445,8 +451,8 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Set the address corresponding to PAGE to NEW-ADDRESS."
   (setcar (cdr 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)
+(defvar elpher-current-page nil)       ; buffer local
+(defvar elpher-history nil)            ; buffer local

 
 (defun elpher-visit-page (page &optional renderer no-history)
   "Visit PAGE using its own renderer or RENDERER, if non-nil.
 
 (defun elpher-visit-page (page &optional renderer no-history)
   "Visit PAGE using its own renderer or RENDERER, if non-nil.


@@ -458,7 +464,7 @@ unless NO-HISTORY is non-nil."
               (equal (elpher-page-address elpher-current-page)
                      (elpher-page-address page)))
     (push elpher-current-page elpher-history))
               (equal (elpher-page-address elpher-current-page)
                      (elpher-page-address page)))
     (push elpher-current-page elpher-history))

-  (setq elpher-current-page page)
+  (setq-local elpher-current-page page)

   (let* ((address (elpher-page-address page))
          (type (elpher-address-type address))
          (type-record (cdr (assoc type elpher-type-map))))
   (let* ((address (elpher-page-address page))
          (type (elpher-address-type address))
          (type-record (cdr (assoc type elpher-type-map))))


@@ -504,6 +510,9 @@ unless NO-HISTORY is non-nil."
 ;;; Buffer preparation
 ;;
 
 ;;; Buffer preparation
 ;;
 

+(defvar elpher-buffer-name "*elpher*"
+  "The default name of the Elpher buffer.")
+

 (defun elpher-update-header ()
   "If `elpher-use-header' is true, display current page info in window header."
   (if elpher-use-header
 (defun elpher-update-header ()
   "If `elpher-use-header' is true, display current page info in window header."
   (if elpher-use-header


@@ -520,19 +529,21 @@ unless NO-HISTORY is non-nil."
 
 (defmacro elpher-with-clean-buffer (&rest args)
   "Evaluate ARGS with a clean *elpher* buffer as current."
 
 (defmacro elpher-with-clean-buffer (&rest args)
   "Evaluate ARGS with a clean *elpher* buffer as current."

-  (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)))
+  `(with-current-buffer elpher-buffer-name
+     (unless (eq major-mode 'elpher-mode)
+       ;; avoid resetting buffer-local variables
+       (elpher-mode))
+     (let ((inhibit-read-only t))
+       (setq-local network-security-level
+                   (default-value 'network-security-level))
+       (erase-buffer)
+       (elpher-update-header)
+       ,@args)))

 
 (defun elpher-buffer-message (string &optional line)
   "Replace first line in elpher buffer with STRING.
 If LINE is non-nil, replace that line instead."
 
 (defun elpher-buffer-message (string &optional line)
   "Replace first line in elpher buffer with STRING.
 If LINE is non-nil, replace that line instead."

-  (with-current-buffer "*elpher*"
+  (with-current-buffer elpher-buffer-name

     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (if line
     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (if line


@@ -624,32 +635,18 @@ the host operating system and the local network capabilities."
     (condition-case nil
         (let* ((kill-buffer-query-functions nil)
                (port (elpher-address-port address))
     (condition-case nil
         (let* ((kill-buffer-query-functions nil)
                (port (elpher-address-port address))

+               (service (if (> port 0) port default-port))

                (host (elpher-address-host address))
                (host (elpher-address-host address))

+               (socks (or elpher-socks-always (string-suffix-p ".onion" host)))

                (response-string-parts nil)
                (bytes-received 0)
                (hkbytes-received 0)
                (response-string-parts nil)
                (bytes-received 0)
                (hkbytes-received 0)

-               (proc (make-network-process :name "elpher-process"
-                                           :host host
-                                           :family (and force-ipv4 'ipv4)
-                                           :service (if (> port 0) port default-port)
-                                           :buffer nil
-                                           :coding 'binary
-                                           :noquery t
-                                           :nowait t
-                                           :tls-parameters
-                                           (and use-tls
-                                                (cons 'gnutls-x509pki
-                                                      (gnutls-boot-parameters
-                                                       :type 'gnutls-x509pki
-                                                       :hostname host
-                                                       :keylist
-                                                       (elpher-get-current-keylist address))))))

                (timer (run-at-time elpher-connection-timeout nil
                                    (lambda ()
                                      (elpher-process-cleanup)
                                      (cond
                                         ; Try again with IPv4
                (timer (run-at-time elpher-connection-timeout nil
                                    (lambda ()
                                      (elpher-process-cleanup)
                                      (cond
                                         ; Try again with IPv4

-                                      ((not force-ipv4)
+                                      ((not (or force-ipv4 socks))

                                        (message "Connection timed out.  Retrying with IPv4.")
                                        (elpher-get-host-response address default-port
                                                                  query-string
                                        (message "Connection timed out.  Retrying with IPv4.")
                                        (elpher-get-host-response address default-port
                                                                  query-string


@@ -666,8 +663,24 @@ the host operating system and the local network capabilities."
                                                                  response-processor
                                                                  nil force-ipv4))
                                       (t
                                                                  response-processor
                                                                  nil force-ipv4))
                                       (t

-                                       (elpher-network-error address "Connection time-out.")))))))
+                                       (elpher-network-error address "Connection time-out."))))))
+               (gnutls-params (list :type 'gnutls-x509pki :hostname host
+                                    :keylist (elpher-get-current-keylist address)))
+               (proc (if socks (socks-open-network-stream "elpher-process" nil host service)
+                       (make-network-process :name "elpher-process"
+                                             :host host
+                                             :family (and force-ipv4 'ipv4)
+                                             :service service
+                                             :buffer nil
+                                             :nowait t
+                                             :tls-parameters
+                                             (and use-tls
+                                                  (cons 'gnutls-x509pki
+                                                        (apply #'gnutls-boot-parameters
+                                                               gnutls-params)))))))

           (setq elpher-network-timer timer)
           (setq elpher-network-timer timer)

+          (set-process-coding-system proc 'binary 'binary)
+          (set-process-query-on-exit-flag proc nil)

           (elpher-buffer-message (concat "Connecting to " host "..."
                                          " (press 'u' to abort)"))
           (set-process-filter proc
           (elpher-buffer-message (concat "Connecting to " host "..."
                                          " (press 'u' to abort)"))
           (set-process-filter proc


@@ -700,7 +713,7 @@ the host operating system and the local network capabilities."
                                           (process-send-string proc query-string)))
                                        ((string-prefix-p "deleted" event)) ; do nothing
                                        ((and (not response-string-parts)
                                           (process-send-string proc query-string)))
                                        ((string-prefix-p "deleted" event)) ; do nothing
                                        ((and (not response-string-parts)

-                                             (not (or elpher-ipv4-always force-ipv4)))
+                                             (not (or elpher-ipv4-always force-ipv4 socks)))

                                         ; Try again with IPv4
                                         (message "Connection failed. Retrying with IPv4.")
                                         (elpher-get-host-response address default-port
                                         ; Try again with IPv4
                                         (message "Connection failed. Retrying with IPv4.")
                                         (elpher-get-host-response address default-port


@@ -716,7 +729,10 @@ the host operating system and the local network capabilities."
                                        (t
                                         (error "No response from server")))
                                     (error
                                        (t
                                         (error "No response from server")))
                                     (error

-                                     (elpher-network-error address the-error))))))
+                                     (elpher-network-error address the-error)))))
+          (when socks
+            (if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
+            (funcall (process-sentinel proc) proc "open\n")))

       (error
        (error "Error initiating connection to server")))))
 
       (error
        (error "Error initiating connection to server")))))
 


@@ -1371,14 +1387,11 @@ by HEADER-LINE."
   (when (string-match "^\\(#+\\)[ \t]*" header-line)
     (let* ((level (length (match-string 1 header-line)))
            (header (substring header-line (match-end 0)))
   (when (string-match "^\\(#+\\)[ \t]*" header-line)
     (let* ((level (length (match-string 1 header-line)))
            (header (substring header-line (match-end 0)))

-          (face (pcase level
+           (face (pcase level

                    (1 'elpher-gemini-heading1)
                    (2 'elpher-gemini-heading2)
                    (3 'elpher-gemini-heading3)
                    (1 'elpher-gemini-heading1)
                    (2 'elpher-gemini-heading2)
                    (3 'elpher-gemini-heading3)

-                   (_ 'default)))
-          (fill-column (/ (* fill-column
-                             (font-get (font-spec :name (face-font 'default)) :size))
-                          (font-get (font-spec :name (face-font face)) :size))))
+                   (_ 'default))))

       (unless (display-graphic-p)
         (insert (make-string level ?#) " "))
       (insert (propertize header 'face face))
       (unless (display-graphic-p)
         (insert (make-string level ?#) " "))
       (insert (propertize header 'face face))


@@ -1695,7 +1708,7 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (let* ((cleaned-host-or-url (string-trim host-or-url))
          (address (elpher-address-from-url cleaned-host-or-url))
          (page (elpher-make-page cleaned-host-or-url address)))
   (let* ((cleaned-host-or-url (string-trim host-or-url))
          (address (elpher-address-from-url cleaned-host-or-url))
          (page (elpher-make-page cleaned-host-or-url address)))

-    (switch-to-buffer "*elpher*")
+    (switch-to-buffer elpher-buffer-name)

     (elpher-visit-page page)
     nil))
 
     (elpher-visit-page page)
     nil))
 


@@ -1745,8 +1758,8 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 (defun elpher-back-to-start ()
   "Go all the way back to the start page."
   (interactive)
 (defun elpher-back-to-start ()
   "Go all the way back to the start page."
   (interactive)

-  (setq elpher-current-page nil)
-  (setq elpher-history nil)
+  (setq-local elpher-current-page nil)
+  (setq-local elpher-history nil)

   (let ((start-page (elpher-make-page "Elpher Start Page"
                                       (elpher-make-special-address 'start))))
     (elpher-visit-page start-page)))
   (let ((start-page (elpher-make-page "Elpher Start Page"
                                       (elpher-make-special-address 'start))))
     (elpher-visit-page start-page)))


@@ -1876,7 +1889,7 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 (defun elpher-bookmarks ()
   "Visit bookmarks page."
   (interactive)
 (defun elpher-bookmarks ()
   "Visit bookmarks page."
   (interactive)

-  (switch-to-buffer "*elpher*")
+  (switch-to-buffer elpher-buffer-name)

   (elpher-visit-page
    (elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
 
   (elpher-visit-page
    (elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
 


@@ -2001,7 +2014,10 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 
 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

-`elpher', `elpher-go' and `elpher-bookmarks'.")
+`elpher', `elpher-go' and `elpher-bookmarks'."
+  (setq-local elpher-current-page nil)
+  (setq-local elpher-history nil)
+  (setq-local elpher-buffer-name (buffer-name)))

 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'elpher-mode 'motion))
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'elpher-mode 'motion))


@@ -2011,17 +2027,29 @@ functions which initialize the gopher client, namely
 ;;
 
 ;;;###autoload
 ;;
 
 ;;;###autoload

-(defun elpher ()
-  "Start elpher with default landing page."
-  (interactive)
-  (if (get-buffer "*elpher*")
-      (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)))
-  "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
+(defun elpher (&optional arg)
+  "Start elpher with default landing page.
+The buffer used for Elpher sessions is determined by the value of
+‘elpher-buffer-name’.  If there is already an Elpher session active in
+that buffer, Emacs will simply switch to it.  Otherwise, a new session
+will begin.  A numeric prefix arg (as in ‘C-u 42 M-x elpher RET’)
+switches to the session with that number, creating it if necessary.  A
+nonnumeric prefix arg means to create a new session.  Returns the
+buffer selected (or created)."
+  (interactive "P")
+  (let* ((name (default-value 'elpher-buffer-name))
+        (buf (cond ((numberp arg)
+                    (get-buffer-create (format "%s<%d>" name arg)))
+                   (arg
+                    (generate-new-buffer name))
+                   (t
+                    (get-buffer-create name)))))
+    (pop-to-buffer-same-window buf)
+    (unless (buffer-modified-p)
+      (elpher-mode)
+      (let ((start-page (elpher-make-page "Elpher Start Page"
+                                         (elpher-make-special-address 'start))))
+       (elpher-visit-page start-page))
+      "Started Elpher."))); Otherwise (elpher) evaluates to start page string.

 
 ;;; elpher.el ends here
 
 ;;; elpher.el ends here