(require 'ansi-color)
(require 'nsm)
(require 'gnutls)
+(require 'socks)
;;; Global constants
"The command used to launch openssl when generating TLS client certificates."
:type '(file))
+(defcustom elpher-default-url-type "gopher"
+ "Default URL type to assume if not explicitly given."
+ :type '(choice (const "gopher")
+ (const "gemini")))
+
(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.
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
'((t :inherit fixed-pitch))
"Face used for pre-formatted gemini text blocks.")
+(defface elpher-gemini-quoted
+ '((t :inherit font-lock-doc-face))
+ "Face used for gemini quoted texts.")
+
;;; Model
;;
(setf (url-filename url)
(url-unhex-string (url-filename url)))
(unless (url-type url)
- (setf (url-type url) "gopher"))
+ (setf (url-type url) elpher-default-url-type))
+ (unless (url-host url)
+ (let ((p (split-string (url-filename url) "/" nil nil)))
+ (setf (url-host url) (car p))
+ (setf (url-filename url)
+ (if (cdr p)
+ (concat "/" (mapconcat #'identity (cdr p) "/"))
+ ""))))
(when (or (equal "gopher" (url-type url))
(equal "gophers" (url-type url)))
;; Gopher defaults
- (unless (url-host url)
- (setf (url-host url) (url-filename url))
- (setf (url-filename url) ""))
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
"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.
(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))))
(if previous-page
(elpher-visit-page previous-page nil t)
(error "No previous page"))))
-
+
(defun elpher-reload-current-page ()
"Reload the current page, discarding any existing cached content."
(elpher-cache-content (elpher-page-address elpher-current-page) nil)
;;; 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
(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."
- (with-current-buffer "*elpher*"
+ (with-current-buffer elpher-buffer-name
(let ((inhibit-read-only t))
(goto-char (point-min))
(if line
(unless (< (elpher-address-port address) 65536)
(error "Cannot establish network connection: port number > 65536"))
(when (and (eq use-tls 'gemini) (not elpher-gemini-TLS-cert-checks))
- (setq-local network-security-level 'low))
+ (setq-local network-security-level 'low)
+ (setq-local gnutls-verify-error nil))
(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))
+ (socks (or elpher-socks-always (string-suffix-p ".onion" host)))
(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
- ((not force-ipv4)
+ ((not (or force-ipv4 socks))
(message "Connection timed out. Retrying with IPv4.")
(elpher-get-host-response address default-port
query-string
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)
+ (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
(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
(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")))))
(elpher-get-gopher-response search-address renderer))
(if aborted
(elpher-visit-previous-page))))))
-
+
;; Raw server response rendering
(defun elpher-render-raw (data &optional mime-type-string)
'help-echo #'elpher--page-button-help))
(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
(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)
(_ 'default)))
- (fill-column (/ (* fill-column
- (font-get (font-spec :name (face-font 'default)) :size))
- (font-get (font-spec :name (face-font face)) :size))))
+ (fill-column (if (display-graphic-p)
+ (/ (* fill-column
+ (font-get (font-spec :name (face-font 'default)) :size))
+ (font-get (font-spec :name (face-font face)) :size)) fill-column)))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
(insert (propertize header 'face face))
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]+\\|>[ \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))
- (adaptive-fill-mode nil)
- (fill-prefix (if (match-string 2 text-line)
- (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line))
- nil)))
+ (let* ((line-prefix (match-string 2 text-line))
+ (processed-text-line
+ (if line-prefix
+ (cond ((string-prefix-p "*" line-prefix)
+ (concat
+ (replace-regexp-in-string "\*"
+ elpher-gemini-bullet-string
+ (match-string 0 text-line))
+ (substring text-line (match-end 0))))
+ ((string-prefix-p ">" line-prefix)
+ (propertize text-line 'face 'elpher-gemini-quoted))
+ (t text-line))
+ text-line))
+ (adaptive-fill-mode nil))
(insert (elpher-process-text-for-display processed-text-line))
(newline)))
'help-echo help-string))
(insert "\n")
(elpher-restore-pos)))
-
+
;;; Bookmarks
;;
DISPLAY-STRING determines how the bookmark will appear in the
bookmark list, while URL is the url of the entry."
(list display-string url))
-
+
(defun elpher-bookmark-display-string (bookmark)
"Get the display string of BOOKMARK."
(elt bookmark 0))
(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."
+ (let ((bookmark-dir (file-name-directory elpher-bookmarks-file)))
+ (unless (file-directory-p bookmark-dir)
+ (make-directory bookmark-dir)))
(with-temp-file elpher-bookmarks-file
(erase-buffer)
(insert "; Elpher bookmarks file\n\n"
(interactive)
(push-button))
+;;;###autoload
(defun elpher-go (host-or-url)
"Go to a particular gopher site HOST-OR-URL.
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)))
- (switch-to-buffer "*elpher*")
+ (switch-to-buffer elpher-buffer-name)
(elpher-visit-page page)
nil))
(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)))
(message "Bookmark removed.")))
(error "No link selected"))))
+;;;###autoload
(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))))
(if button
(elpher-info-page (button-get button 'elpher-page))
(error "No item selected"))))
-
+
(defun elpher-info-current ()
"Display information on current page."
(interactive)
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))
;;
;;;###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
The Lambda Lab / projects / elpher.git / commitdiff