;; Copyright (C) 2021 Christopher Brannon <chris@the-brannons.com>
;; Copyright (C) 2021 Omar Polo <op@omarpolo.com>
;; Copyright (C) 2021 Noodles! <nnoodle@chiru.no>
+;; Copyright (C) 2021 Abhiseck Paira <abhiseckpaira@disroot.org>
;; Copyright (C) 2020-2021 Alex Schroeder <alex@gnu.org>
;; Copyright (C) 2020 Zhiwei Chen <chenzhiwei03@kuaishou.com>
;; Copyright (C) 2020 condy0919 <condy0919@gmail.com>
;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.0.0
+;; Version: 3.2.1
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;; Full instructions can be found in the Elpher info manual.
;; Elpher is under active development. Any suggestions for
-;; improvements are welcome, and can be made on the official
-;; project page, gopher://thelambdalab.xyz/elpher, or via the
+;; improvements are welcome, and can be made on the official project
+;; page, gopher://thelambdalab.xyz/1/projects/elpher, or via the
;; project mailing list at https://lists.sr.ht/~michel-slm/elpher.
;;; Code:
;;
(require 'seq)
-(require 'pp)
(require 'shr)
(require 'url-util)
(require 'subr-x)
-(require 'dns)
(require 'nsm)
(require 'gnutls)
(require 'socks)
-
-;;; ANSI colors or XTerm colors
-
-(or (require 'xterm-color nil t)
- (require 'ansi-color))
-
-(defalias 'elpher-color-filter-apply
- (if (fboundp 'xterm-color-filter)
- (lambda (s)
- (let ((_xterm-color-render nil))
- (xterm-color-filter s)))
- #'ansi-color-filter-apply)
- "A function to filter out ANSI escape sequences.")
-
-(defalias 'elpher-color-apply
- (if (fboundp 'xterm-color-filter)
- #'xterm-color-filter
- #'ansi-color-apply)
- "A function to apply ANSI escape sequences.")
+(require 'bookmark)
;;; Global constants
;;
-(defconst elpher-version "3.0.0"
+(defconst elpher-version "3.2.1"
"Current version of elpher.")
(defconst elpher-margin-width 6
(finger elpher-get-finger-page elpher-render-text "txt" elpher-text)
(telnet elpher-get-telnet-page nil "tel" elpher-telnet)
(other-url elpher-get-other-url-page nil "url" elpher-other-url)
- ((special start) elpher-get-start-page nil "E" elpher-index)
- ((special history) elpher-get-history-page nil "E" elpher-index)
- ((special visited-pages) elpher-get-visited-pages-page nil "E" elpher-index))
+ (file elpher-get-file-page nil "~" elpher-gemini)
+ ((about welcome) elpher-get-welcome-page nil "E" elpher-index)
+ ((about bookmarks) elpher-get-bookmarks-page nil "E" elpher-index)
+ ((about history) elpher-get-history-page nil "E" elpher-index)
+ ((about visited-pages) elpher-get-visited-pages-page nil "E" elpher-index))
"Association list from types to getters, renderers, margin codes and index faces.")
(defvar ansi-color-context)
(defvar bookmark-make-record-function)
(defvar mu4e~view-beginning-of-url-regexp)
- (defvar thing-at-point-uri-schemes))
+ (defvar eww-use-browse-url)
+ (defvar thing-at-point-uri-schemes)
+ (defvar xterm-color-preserve-properties))
;;; Customization group
Otherwise, the SOCKS proxy is only used for connections to onion services."
:type '(boolean))
+(defcustom elpher-use-emacs-bookmark-menu nil
+ "If non-nil, elpher will only use the native Emacs bookmark menu.
+Otherwise, \\[elpher-show-bookmarks] will visit a special elpher bookmark
+page within which all of the standard elpher keybindings are active."
+ :type '(boolean))
+
+(defcustom elpher-start-page "about:welcome"
+ "Specify the page displayed initially by elpher.
+The default welcome screen is \"about:welcome\", while the bookmarks list
+is \"about:bookmarks\". You can also specify local files via \"file:\".
+
+Beware that using \"about:bookmarks\" as a start page in combination with
+the `elpher-use-bookmark-menu' variable set to non-nil will prevent the
+Emacs bookmark menu being accessible via \\[elpher-show-bookmarks] from
+the start page."
+ :type '(string))
+
;; Face customizations
(defgroup elpher-faces nil
;; Address
;; An elpher "address" object is either a url object or a symbol.
-;; Symbol addresses are "special", corresponding to pages generated
+;; Addresses with the "about" type, corresponding to pages generated
;; dynamically for and by elpher. All others represent pages which
;; rely on content retrieved over the network.
"Remove redundant port specifiers from ADDRESS.
Here 'redundant' means that the specified port matches the default
for that protocol, eg 70 for gopher."
- (if (and (not (elpher-address-special-p address))
+ (if (and (not (elpher-address-about-p address))
(eq (url-portspec address) ; (url-port) is too slow!
(pcase (url-type address)
("gemini" 1965)
"/" (string type)
selector)))))
-(defun elpher-make-special-address (type)
- "Create an ADDRESS object corresponding to the given special address symbol TYPE."
- type)
+(defun elpher-make-about-address (type)
+ "Create an ADDRESS object corresponding to the given about address TYPE."
+ (elpher-address-from-url (concat "about:" (symbol-name type))))
(defun elpher-address-to-url (address)
- "Get string representation of ADDRESS, or nil if ADDRESS is special."
- (if (elpher-address-special-p address)
- nil
- (url-encode-url (url-recreate-url address))))
+ "Get string representation of ADDRESS."
+ (url-encode-url (url-recreate-url address)))
(defun elpher-address-type (address)
"Retrieve type of ADDRESS object.
This is used to determine how to retrieve and render the document the
address refers to, via the table `elpher-type-map'."
- (if (symbolp address)
- (list 'special address)
- (let ((protocol (url-type address)))
- (cond ((or (equal protocol "gopher")
- (equal protocol "gophers"))
- (list 'gopher
- (if (member (url-filename address) '("" "/"))
- ?1
- (string-to-char (substring (url-filename address) 1)))))
- ((equal protocol "gemini")
- 'gemini)
- ((equal protocol "telnet")
- 'telnet)
- ((equal protocol "finger")
- 'finger)
- (t 'other-url)))))
+ (pcase (url-type address)
+ ("about"
+ (list 'about (intern (url-filename address))))
+ ((or "gopher" "gophers")
+ (list 'gopher
+ (if (member (url-filename address) '("" "/"))
+ ?1
+ (string-to-char (substring (url-filename address) 1)))))
+ ("gemini" 'gemini)
+ ("telnet" 'telnet)
+ ("finger" 'finger)
+ ("file" 'file)
+ (_ 'other-url)))
+
+(defun elpher-address-about-p (address)
+ "Return non-nil if ADDRESS is an about address."
+ (pcase (elpher-address-type address) (`(about ,_) t)))
+
+(defun elpher-address-gopher-p (address)
+ "Return non-nill if ADDRESS object is a gopher address."
+ (eq 'gopher (elpher-address-type address)))
(defun elpher-address-protocol (address)
- "Retrieve the transport protocol for ADDRESS. This is nil for special addresses."
- (if (symbolp address)
- nil
- (url-type address)))
+ "Retrieve the transport protocol for ADDRESS."
+ (url-type address))
(defun elpher-address-filename (address)
"Retrieve the filename component of ADDRESS.
For gopher addresses this is a combination of the selector type and selector."
- (if (symbolp address)
- nil
- (url-unhex-string (url-filename address))))
+ (url-unhex-string (url-filename address)))
(defun elpher-address-host (address)
"Retrieve host from ADDRESS object."
(defun elpher-address-port (address)
"Retrieve port from ADDRESS object.
If no address is defined, returns 0. (This is for compatibility with the URL library.)"
- (if (symbolp address)
- 0
- (url-port address)))
-
-(defun elpher-address-special-p (address)
- "Return non-nil if ADDRESS object is special (e.g. start page page)."
- (symbolp address))
-
-(defun elpher-address-gopher-p (address)
- "Return non-nill if ADDRESS object is a gopher address."
- (and (not (elpher-address-special-p address))
- (member (elpher-address-protocol address) '("gopher" "gophers"))))
+ (url-port address))
(defun elpher-gopher-address-selector (address)
"Retrieve gopher selector from ADDRESS object."
(list display-string address))
(defun elpher-make-start-page ()
- "Create the start page."
- (elpher-make-page "Elpher Start Page"
- (elpher-make-special-address 'start)))
+ "Create the welcome page."
+ (elpher-make-page "Start Page"
+ (elpher-address-from-url elpher-start-page)))
(defun elpher-page-display-string (page)
"Retrieve the display string corresponding to PAGE."
(elpher-save-pos)
(elpher-process-cleanup)
(unless no-history
- (unless (equal (elpher-page-address elpher-current-page)
- (elpher-page-address page))
+ (unless (or (not elpher-current-page)
+ (equal (elpher-page-address elpher-current-page)
+ (elpher-page-address page)))
(push elpher-current-page elpher-history)
- (unless (or (elpher-address-special-p (elpher-page-address page))
+ (unless (or (elpher-address-about-p (elpher-page-address page))
(and elpher-visited-pages
(equal page (car elpher-visited-pages))))
(push page elpher-visited-pages))))
(defun elpher-visit-previous-page ()
"Visit the previous page in the history."
- (let ((previous-page (pop elpher-history)))
- (if previous-page
- (elpher-visit-page previous-page nil t)
- (error "No previous page"))))
+ (if elpher-history
+ (elpher-visit-page (pop elpher-history) nil t)
+ (error "No previous page")))
(defun elpher-reload-current-page ()
"Reload the current page, discarding any existing cached content."
"If `elpher-use-header' is true, display current page info in window header."
(if elpher-use-header
(let* ((display-string (elpher-page-display-string elpher-current-page))
+ (sanitized-display-string (replace-regexp-in-string "%" "%%" display-string))
(address (elpher-page-address elpher-current-page))
- (tls-string (if (and (not (elpher-address-special-p address))
+ (tls-string (if (and (not (elpher-address-about-p address))
(member (elpher-address-protocol address)
'("gophers" "gemini")))
" [TLS encryption]"
""))
- (header (concat display-string
+ (header (concat sanitized-display-string
(propertize tls-string 'face 'bold))))
(setq header-line-format header))))
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
+ (declare (debug (body))) ;; Allow edebug to step through body
`(with-current-buffer elpher-buffer-name
(unless (eq major-mode 'elpher-mode)
;; avoid resetting buffer-local variables
(elpher-decode (replace-regexp-in-string "\n\\.\n$" "\n"
(replace-regexp-in-string "\r" "" string))))
+;;; Buttonify urls
+
+(defconst elpher-url-regex
+ "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.-]*[a-zA-Z0-9-]\\|\\[[a-zA-Z0-9:]+\\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z_~?/@|:.%#=&-]*[0-9a-zA-Z_~?/@|#-]\\)?\\)?"
+ "Regexp used to locate and buttonify URLs in text files loaded by elpher.")
+
+(defun elpher-buttonify-urls (string)
+ "Turn substrings which look like urls in STRING into clickable buttons."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward elpher-url-regex nil t)
+ (let ((page (elpher-make-page (substring-no-properties (match-string 0))
+ (elpher-address-from-url (match-string 0)))))
+ (make-text-button (match-beginning 0)
+ (match-end 0)
+ 'elpher-page page
+ 'action #'elpher-click-link
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help
+ 'face 'button)))
+ (buffer-string)))
+
+;;; ANSI colors or XTerm colors (application and filtering)
+
+(or (require 'xterm-color nil t)
+ (require 'ansi-color))
+
+(defalias 'elpher-color-filter-apply
+ (if (fboundp 'xterm-color-filter)
+ (lambda (s)
+ (let ((_xterm-color-render nil))
+ (xterm-color-filter s)))
+ #'ansi-color-filter-apply)
+ "A function to filter out ANSI escape sequences.")
+
+(defalias 'elpher-color-apply
+ (if (fboundp 'xterm-color-filter)
+ #'xterm-color-filter
+ #'ansi-color-apply)
+ "A function to apply ANSI escape sequences.")
+
+;;; 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."
+ (elpher-buttonify-urls (if elpher-filter-ansi-from-text
+ (elpher-color-filter-apply string)
+ (elpher-color-apply string))))
+
;;; Network error reporting
;;
(if (timerp elpher-network-timer)
(cancel-timer elpher-network-timer)))
+(defun elpher-make-network-timer (thunk)
+ "Create a timer to run the THUNK after `elpher-connection-timeout' seconds.
+This is just a wraper around `run-at-time' which additionally sets the
+buffer-local variable `elpher-network-timer' to allow
+`elpher-process-cleanup' to also clear the timer."
+ (let ((timer (run-at-time elpher-connection-timeout nil thunk)))
+ (setq-local elpher-network-timer timer)
+ timer))
+
(defun elpher-get-host-response (address default-port query-string response-processor
&optional use-tls force-ipv4)
"Generic function for retrieving data from ADDRESS.
: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))))))
- (timer (run-at-time elpher-connection-timeout nil
+ (timer (elpher-make-network-timer
(lambda ()
(elpher-process-cleanup)
(cond
; Try again with IPv4
- ((not (or force-ipv4 socks))
+ ((not (or elpher-ipv4-always 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."))))))
+ (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
+ elpher-ipv4-always)
+ '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)
(if use-tls (apply #'gnutls-negotiate :process proc gnutls-params))
(funcall (process-sentinel proc) proc "open\n")))
(error
+ (elpher-process-cleanup)
(error "Error initiating connection to server")))))
;; Index rendering
-(defun elpher-insert-index (string)
- "Insert the index corresponding to STRING into the current buffer."
- ;; Should be able to split directly on CRLF, but some non-conformant
- ;; LF-only servers sadly exist, hence the following.
- (let ((str-processed (elpher-preprocess-text-response string)))
- (dolist (line (split-string str-processed "\n"))
- (ignore-errors
- (unless (= (length line) 0)
- (let* ((type (elt line 0))
- (fields (split-string (substring line 1) "\t"))
- (display-string (elt fields 0))
- (selector (elt fields 1))
- (host (elt fields 2))
- (port (if (elt fields 3)
- (string-to-number (elt fields 3))
- nil))
- (address (elpher-make-gopher-address type selector host port)))
- (elpher-insert-index-record display-string address)))))))
-
(defun elpher-insert-margin (&optional type-name)
"Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
(if type-name
(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)
+ (format "mouse-1, RET: open '%s'" (if (elpher-address-about-p address)
address
(elpher-address-to-url address))))))))
(elpher-with-clean-buffer
(if (not data)
t
- (elpher-insert-index data)
+ (let ((data-processed (elpher-preprocess-text-response data)))
+ (dolist (line (split-string data-processed "\n"))
+ (ignore-errors
+ (unless (= (length line) 0)
+ (let* ((type (elt line 0))
+ (fields (split-string (substring line 1) "\t"))
+ (display-string (elt fields 0))
+ (selector (elt fields 1))
+ (host (elt fields 2))
+ (port (if (elt fields 3)
+ (string-to-number (elt fields 3))
+ nil))
+ (address (elpher-make-gopher-address type selector host port)))
+ (elpher-insert-index-record display-string address))))))
(elpher-cache-content (elpher-page-address elpher-current-page)
(buffer-string)))))
;; Text rendering
-(defconst elpher-url-regex
- "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.-]*[a-zA-Z0-9-]\\|\\[[a-zA-Z0-9:]+\\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z_~?/@|:.%#=&-]*[0-9a-zA-Z_~?/@|#-]\\)?\\)?"
- "Regexp used to locate and buttonify URLs in text files loaded by elpher.")
-
-(defun elpher-buttonify-urls (string)
- "Turn substrings which look like urls in STRING into clickable buttons."
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (while (re-search-forward elpher-url-regex nil t)
- (let ((page (elpher-make-page (substring-no-properties (match-string 0))
- (elpher-address-from-url (match-string 0)))))
- (make-text-button (match-beginning 0)
- (match-end 0)
- 'elpher-page page
- 'action #'elpher-click-link
- 'follow-link t
- 'help-echo #'elpher--page-button-help
- 'face 'button)))
- (buffer-string)))
-
-(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))))
-
(defun elpher-render-text (data &optional _mime-type-string)
"Render DATA as text. MIME-TYPE-STRING is unused."
(elpher-with-clean-buffer
(if (not data)
nil
(if (display-images-p)
- (progn
- (let ((image (create-image
- data
- nil t)))
- (elpher-with-clean-buffer
- (insert-image image)
- (elpher-restore-pos))))
+ (let* ((image (create-image
+ data
+ nil t))
+ (window (get-buffer-window elpher-buffer-name)))
+ (when window
+ (setf (image-property image :max-width) (window-body-width window t))
+ (setf (image-property image :max-height) (window-body-height window t)))
+ (elpher-with-clean-buffer
+ (insert-image image)
+ (elpher-restore-pos)))
(elpher-render-download data))))
;; Search retrieval and rendering
(let ((redirect-address (elpher-address-from-gemini-url response-meta)))
(if (member redirect-address elpher-gemini-redirect-chain)
(error "Redirect loop detected"))
- (if (not (string= (elpher-address-protocol redirect-address)
- "gemini"))
+ (if (not (eq (elpher-address-type redirect-address) 'gemini))
(error "Server tried to automatically redirect to non-gemini URL: %s"
response-meta))
(elpher-page-set-address elpher-current-page redirect-address)
(if (string-empty-p (url-filename address))
(setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
(setf (url-host address) (url-host current-address))
- (setf (url-port address) (url-port current-address))
+ (setf (url-portspec address) (url-portspec current-address)) ; (url-port) too slow!
(unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
(setf (url-filename address)
(concat (file-name-directory (url-filename current-address))
(url-filename address)))))
(unless (url-type address)
- (setf (url-type address) "gemini"))
+ (setf (url-type address) (url-type current-address)))
(when (equal (url-type address) "gemini")
(setf (url-filename address)
(elpher-collapse-dot-sequences (url-filename address)))))
"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]+\\|>[ \t]*\\)?" text-line)
- (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 t)
- ;; fill-prefix is important for adaptive-fill-mode: without
- ;; it, multi-line list items are not indented correct
- (fill-prefix (if (match-string 2 text-line)
- (replace-regexp-in-string "[>\*]" " " (match-string 0 text-line))
- nil)))
- (insert (elpher-process-text-for-display processed-text-line))
- (newline)))
+ (if (string-empty-p text-line)
+ (insert "\n")
+ (string-match
+ (rx (: line-start
+ (* (any " \t"))
+ (optional
+ (group (or (: "*" (+ (any " \t")))
+ (: ">" (* (any " \t"))))))))
+ text-line)
+ (let* ((line-prefix (match-string 1 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 t)
+ ;; fill-prefix is important for adaptive-fill-mode: without
+ ;; it, multi-line list items are not indented correct
+ (fill-prefix (if (match-string 1 text-line)
+ (make-string (length (match-string 0 text-line)) ?\s)
+ 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."
(error "Command not supported for general URLs"))
(let* ((address (elpher-page-address elpher-current-page))
(url (elpher-address-to-url address)))
- (progn
- (elpher-visit-previous-page) ; Do first in case of non-local exits.
- (message "Opening URL...")
- (if elpher-open-urls-with-eww
- (browse-web url)
- (browse-url url)))))
-
+ (elpher-visit-previous-page) ; Do first in case of non-local exits.
+ (message "Opening URL...")
+ (if elpher-open-urls-with-eww
+ (browse-web url)
+ (browse-url url))))
-;; Start page retrieval
+;; File page
-(defun elpher-get-start-page (renderer)
- "Getter which displays the start page (RENDERER must be nil)."
+(defun elpher-get-file-page (renderer)
+ "Getter which renders a local file using RENDERER.
+Assumes UTF-8 encoding for all text files."
+ (let* ((address (elpher-page-address elpher-current-page))
+ (filename (elpher-address-filename address)))
+ (unless (file-exists-p filename)
+ (elpher-visit-previous-page)
+ (error "File not found"))
+ (unless (file-readable-p filename)
+ (elpher-visit-previous-page)
+ (error "Could not read from file"))
+ (let ((body (with-temp-buffer
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (insert-file-contents-literally filename)
+ (encode-coding-string (buffer-string) 'raw-text)))))
+ (if renderer
+ (funcall renderer body nil)
+ (pcase (file-name-extension filename)
+ ((or "gmi" "gemini")
+ (elpher-render-gemini-map (decode-coding-string body 'utf-8) nil))
+ ((or "htm" "html")
+ (elpher-render-html (decode-coding-string body 'utf-8)))
+ ((or "txt" "")
+ (elpher-render-text (decode-coding-string body 'utf-8)))
+ ((or "jpg" "jpeg" "gif" "png" "bmp" "tif" "tiff")
+ (elpher-render-image body))
+ (_
+ (elpher-render-download body))))
+ (elpher-restore-pos))))
+
+
+;; Welcome page retrieval
+
+(defun elpher-get-welcome-page (renderer)
+ "Getter which displays the welcome page (RENDERER must be nil)."
(when renderer
(elpher-visit-previous-page)
- (error "Command not supported for start page"))
+ (error "Command not supported for welcome page"))
(elpher-with-clean-buffer
(insert " --------------------------------------------\n"
" Elpher Gopher and Gemini Client \n"
(elpher-address-from-url "gemini://geminispace.info/search"))
(insert "\n"
"Your bookmarks are stored in your ")
- (let ((help-string "RET,mouse-1: Open Emacs bookmark list"))
- (insert-text-button "Emacs bookmark list"
+ (let ((help-string "RET,mouse-1: Open bookmark list"))
+ (insert-text-button "bookmark list"
'face 'link
'action (lambda (_)
(interactive)
- (call-interactively #'elpher-open-bookmarks))
+ (call-interactively #'elpher-show-bookmarks))
'follow-link t
'help-echo help-string))
(insert ".\n")
"(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n"
'face 'shadow))
(insert "\n"
- "For Elpher release news or to leave feedback, visit:\n")
+ "The gopher home of the Elpher project is here:\n")
(elpher-insert-index-record "The Elpher Project Page"
(elpher-make-gopher-address ?1
"/projects/elpher/"
"thelambdalab.xyz"
70))
- (insert "\n"
- "** Refer to the ")
(let ((help-string "RET,mouse-1: Open Elpher info manual (if available)"))
- (insert-text-button "Elpher info manual"
+ (insert "\n"
+ "The following info documentation is available:\n"
+ " - ")
+ (insert-text-button "Elpher Manual"
'face 'link
'action (lambda (_)
(interactive)
(info "(elpher)"))
'follow-link t
- 'help-echo help-string))
- (insert " for the full documentation. **\n")
+ 'help-echo help-string)
+ (insert "\n - ")
+ (insert-text-button "Changes introduced by the latest release"
+ 'face 'link
+ 'action (lambda (_)
+ (interactive)
+ (info "(elpher)News"))
+ 'follow-link t
+ 'help-echo help-string))
+ (insert "\n")
(insert (propertize
- (concat " (This should be available if you have installed Elpher using\n"
- " MELPA. Otherwise you will have to install the manual yourself.)\n")
+ (concat "(These documents should be available if you have installed Elpher \n"
+ " using MELPA. Otherwise you may have to install the manual yourself.)\n")
'face 'shadow))
(elpher-restore-pos)))
(interactive)
(elpher-visit-page
(elpher-make-page "Current History Stack"
- (elpher-make-special-address 'history))))
+ (elpher-make-about-address 'history))))
(defun elpher-show-visited-pages ()
"Show the all the pages you've visited using Elpher.
(interactive)
(elpher-visit-page
(elpher-make-page "Elpher Visted Pages"
- (elpher-make-special-address 'visited-pages))))
+ (elpher-make-about-address 'visited-pages))))
(defun elpher-get-history-page (renderer)
"Getter which displays the history page (RENDERER must be nil)."
(error "Command not supported for history page"))
(elpher-display-history-links
(seq-filter (lambda (page)
- (not (elpher-address-special-p (elpher-page-address page))))
+ (not (elpher-address-about-p (elpher-page-address page))))
elpher-visited-pages)
"All visited pages"))
(defun elpher-display-history-links (pages title)
"Show all PAGES in an Elpher buffer with a given TITLE."
- (let* ((title-line (concat "---- " title " ----"))
+ (let* ((title-line (concat " ---- " title " ----"))
(footer-line (make-string (length title-line) ?-)))
(elpher-with-clean-buffer
(insert title-line "\n\n")
(address (elpher-page-address page)))
(elpher-insert-index-record display-string address))))
(insert "No history items found.\n"))
- (insert "\n" footer-line "\n"
- "Select and entry or press 'u' to return to the previous page.")
+ (insert "\n " footer-line "\n"
+ "Select an entry or press 'u' to return to the previous page.")
(elpher-restore-pos))))
return a bookmark record for that link. Otherwise, return a bookmark
record for the current elpher page."
(let* ((button (and elpher-bookmark-link (button-at (point))))
- (page (if button
- (button-get button 'elpher-page)
- elpher-current-page))
- (address (elpher-page-address page))
- (url (elpher-address-to-url address))
- (display-string (elpher-page-display-string page))
- (pos (if button nil (point))))
- (if (elpher-address-special-p address)
- (error "Cannot bookmark %s" display-string)
- `(,display-string
- (defaults . (,display-string))
- (position . ,pos)
- (location . ,url)
- (handler . elpher-bookmark-jump)))))
+ (page (if button
+ (button-get button 'elpher-page)
+ elpher-current-page)))
+ (unless page
+ (error "Cannot bookmark this link"))
+ (let* ((address (elpher-page-address page))
+ (url (elpher-address-to-url address))
+ (display-string (elpher-page-display-string page))
+ (pos (if button nil (point))))
+ (if (elpher-address-about-p address)
+ (error "Cannot bookmark %s" display-string)
+ `(,display-string
+ (defaults . (,display-string))
+ (position . ,pos)
+ (location . ,url)
+ (handler . elpher-bookmark-jump))))))
;;;###autoload
(defun elpher-bookmark-jump (bookmark)
- "Go to a particular BOOKMARK."
- (let* ((url (cdr (assq 'location bookmark))))
- (elpher-go url)))
+ "Handler used to open a bookmark using elpher.
+The argument BOOKMARK is a bookmark record passed to the function.
+This handler is responsible for loading the bookmark in some buffer,
+then making that buffer the current buffer. It should not switch
+to the buffer."
+ (let* ((url (cdr (assq 'location bookmark)))
+ (cleaned-url (string-trim url))
+ (address (elpher-address-from-url cleaned-url))
+ (page (elpher-make-page cleaned-url address)))
+ (elpher-with-clean-buffer
+ (elpher-visit-page page))
+ (set-buffer (get-buffer elpher-buffer-name))
+ nil))
(defun elpher-bookmark-link ()
"Bookmark the link at point.
(read-file-name "Old Elpher bookmarks: "
user-emacs-directory nil t
"elpher-bookmarks"))))
- (require 'bookmark)
(dolist (bookmark (with-temp-buffer
(insert-file-contents file)
(read (current-buffer))))
(bookmark-store display-string (cdr record) t)))
(bookmark-save))
-(defun elpher-open-bookmarks ()
- "Display the current list of elpher bookmarks.
-This is just a call to `bookmark-bmenu-list', but we also check for a legacy
-bookmark file and offer to import it."
- (interactive)
+(defun elpher-get-bookmarks-page (renderer)
+ "Getter which displays the bookmarks (RENDERER must be nil)."
+ (when renderer
+ (elpher-visit-previous-page)
+ (error "Command not supported for bookmarks page"))
+
(let ((old-bookmarks-file (or (and (boundp 'elpher-bookmarks-file)
elpher-bookmarks-file)
(locate-user-emacs-file "elpher-bookmarks"))))
"\" found. Import now?")))
(elpher-bookmark-import old-bookmarks-file)
(rename-file old-bookmarks-file (concat old-bookmarks-file "-legacy"))))
- (call-interactively #'bookmark-bmenu-list))
+
+ (if (and elpher-use-emacs-bookmark-menu
+ elpher-history)
+ (progn
+ (elpher-visit-previous-page)
+ (call-interactively #'bookmark-bmenu-list))
+ (elpher-with-clean-buffer
+ (insert " ---- Elpher Bookmarks ---- \n\n")
+ (bookmark-maybe-load-default-file)
+ (dolist (bookmark (bookmark-maybe-sort-alist))
+ (when (eq #'elpher-bookmark-jump (alist-get 'handler (cdr bookmark)))
+ (let* ((name (car bookmark))
+ (url (alist-get 'location (cdr bookmark)))
+ (address (elpher-address-from-url url)))
+ (elpher-insert-index-record name address))))
+ (when (<= (line-number-at-pos) 3)
+ (insert "No bookmarked pages found.\n"))
+ (insert "\n --------------------------\n\n"
+ "Select an entry or press 'u' to return to the previous page.\n\n"
+ "Bookmarks can be renamed or deleted via the ")
+ (insert-text-button "Emacs bookmark menu"
+ 'action (lambda (_)
+ (interactive)
+ (call-interactively #'bookmark-bmenu-list))
+ 'follow-link t
+ 'help-echo "RET,mouse-1: open Emacs bookmark menu")
+ (insert (substitute-command-keys
+ ",\nwhich can also be opened from anywhere using '\\[bookmark-bmenu-list]'."))
+ (elpher-restore-pos))))
+
+(defun elpher-show-bookmarks ()
+ "Interactive function to display the current list of elpher bookmarks."
+ (interactive)
+ (elpher-visit-page
+ (elpher-make-page "Elpher Bookmarks"
+ (elpher-make-about-address 'bookmarks))))
;;; Integrations
(setq mu4e~view-beginning-of-url-regexp
"\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:")
+;;; eww:
+
+;; Let elpher handle gemini, gopher links in eww buffer.
+(setq eww-use-browse-url
+ "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\)://")
+
+
;;; Interactive procedures
;;
"Go to a particular gopher site HOST-OR-URL.
When run interactively HOST-OR-URL is read from the minibuffer."
(interactive "sGopher or Gemini URL: ")
- (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-buffer-name)
- (elpher-with-clean-buffer
- (elpher-visit-page page))
- nil))
+ (let ((trimmed-host-or-url (string-trim host-or-url)))
+ (unless (string-empty-p trimmed-host-or-url)
+ (let* ((address (elpher-address-from-url trimmed-host-or-url))
+ (page (elpher-make-page trimmed-host-or-url address)))
+ (switch-to-buffer elpher-buffer-name)
+ (elpher-with-clean-buffer
+ (elpher-visit-page page))
+ nil)))) ; non-nil value is displayed by eshell
(defun elpher-go-current ()
"Go to a particular site read from the minibuffer, initialized with the current URL."
(interactive)
- (let ((address (elpher-page-address elpher-current-page)))
- (let ((url (read-string "Gopher or Gemini URL: "
- (unless (elpher-address-special-p address)
- (elpher-address-to-url address)))))
+ (let* ((address (elpher-page-address elpher-current-page))
+ (url (read-string "Gopher or Gemini URL: "
+ (unless (elpher-address-about-p address)
+ (elpher-address-to-url address)))))
+ (unless (string-empty-p (string-trim url))
(elpher-visit-page (elpher-make-page url (elpher-address-from-url url))))))
(defun elpher-redraw ()
(defun elpher-view-raw ()
"View raw server response for current page."
(interactive)
- (if (elpher-address-special-p (elpher-page-address elpher-current-page))
+ (if (elpher-address-about-p (elpher-page-address elpher-current-page))
(error "This page was not generated by a server")
(elpher-visit-page elpher-current-page
#'elpher-render-raw)))
(let ((button (button-at (point))))
(if button
(let ((page (button-get button 'elpher-page)))
- (if (elpher-address-special-p (elpher-page-address page))
- (error "Cannot download %s"
- (elpher-page-display-string page))
- (elpher-visit-page (button-get button 'elpher-page)
- #'elpher-render-download)))
+ (unless page
+ (error "Not an elpher page"))
+ (when (elpher-address-about-p (elpher-page-address page))
+ (error "Cannot download %s" (elpher-page-display-string page)))
+ (elpher-visit-page (button-get button 'elpher-page)
+ #'elpher-render-download))
(error "No link selected"))))
(defun elpher-download-current ()
"Download the current page."
(interactive)
- (if (elpher-address-special-p (elpher-page-address 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
"Visit root of current server."
(interactive)
(let ((address (elpher-page-address elpher-current-page)))
- (if (not (elpher-address-special-p address))
+ (if (not (elpher-address-about-p address))
(if (or (member (url-filename address) '("/" ""))
(and (elpher-address-gopher-p address)
(= (length (elpher-gopher-address-selector address)) 0)))
(error "Command invalid for %s" (elpher-page-display-string elpher-current-page)))))
(defun elpher-info-page (page)
- "Display information on PAGE."
- (let ((display-string (elpher-page-display-string page))
- (address (elpher-page-address page)))
- (if (elpher-address-special-p address)
- (message "Special page: %s" display-string)
- (message "%s" (elpher-address-to-url address)))))
+ "Display URL of PAGE in minibuffer."
+ (let ((address (elpher-page-address page)))
+ (message "%s" (elpher-address-to-url address))))
(defun elpher-info-link ()
"Display information on page corresponding to link at point."
(interactive)
(let ((button (button-at (point))))
- (if button
- (elpher-info-page (button-get button 'elpher-page))
- (error "No item selected"))))
+ (unless button
+ (error "No item selected"))
+ (let ((page (button-get button 'elpher-page)))
+ (unless page
+ (error "Not an elpher page"))
+ (elpher-info-page page))))
(defun elpher-info-current ()
"Display information on current page."
(defun elpher-copy-page-url (page)
"Copy URL representation of address of PAGE to `kill-ring'."
- (let ((address (elpher-page-address page)))
- (if (elpher-address-special-p address)
- (error (format "Cannot represent %s as URL" (elpher-page-display-string page)))
- (let ((url (elpher-address-to-url address)))
- (message "Copied \"%s\" to kill-ring/clipboard." url)
- (kill-new url)))))
+ (let* ((address (elpher-page-address page))
+ (url (elpher-address-to-url address)))
+ (message "Copied \"%s\" to kill-ring/clipboard." url)
+ (kill-new url)))
(defun elpher-copy-link-url ()
"Copy URL of item at point to `kill-ring'."
(interactive)
(let ((button (button-at (point))))
- (if button
- (elpher-copy-page-url (button-get button 'elpher-page))
- (error "No item selected"))))
+ (unless button
+ (error "No item selected"))
+ (let ((page (button-get button 'elpher-page)))
+ (unless page
+ (error "Not an elpher page"))
+ (elpher-copy-page-url page))))
(defun elpher-copy-current-url ()
"Copy URL of current page to `kill-ring'."
(define-key map (kbd "C") 'elpher-copy-current-url)
(define-key map (kbd "a") 'elpher-bookmark-link)
(define-key map (kbd "A") 'elpher-bookmark-current)
- (define-key map (kbd "B") 'elpher-open-bookmarks)
+ (define-key map (kbd "B") 'elpher-show-bookmarks)
(define-key map (kbd "!") 'elpher-set-gopher-coding-system)
(define-key map (kbd "F") 'elpher-forget-current-certificate)
(when (fboundp 'evil-define-key*)
(kbd "C") 'elpher-copy-current-url
(kbd "a") 'elpher-bookmark-link
(kbd "A") 'elpher-bookmark-current
- (kbd "B") 'elpher-open-bookmarks
+ (kbd "B") 'elpher-show-bookmarks
(kbd "!") 'elpher-set-gopher-coding-system
(kbd "F") 'elpher-forget-current-certificate))
map)
(setq-local elpher-history nil)
(setq-local elpher-buffer-name (buffer-name))
(setq-local bookmark-make-record-function #'elpher-bookmark-make-record)
- (setq-local imenu-create-index-function (lambda () elpher--gemini-page-headings)))
+ (setq-local imenu-create-index-function (lambda () elpher--gemini-page-headings))
+ (setq-local xterm-color-preserve-properties t))
(when (fboundp 'evil-set-initial-state)
(evil-set-initial-state 'elpher-mode 'motion))
The Lambda Lab / projects / elpher.git / blobdiff