;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
;; Created: 11 April 2019
-;; Version: 3.1.0
+;; Version: 3.2.2
;; Keywords: comm gopher
;; Homepage: https://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "27.1"))
;;; Global constants
;;
-(defconst elpher-version "3.1.0"
+(defconst elpher-version "3.2.2"
"Current version of elpher.")
(defconst elpher-margin-width 6
page within which all of the standard elpher keybindings are active."
:type '(boolean))
-(defcustom elpher-start-page "about:welcome"
+(defcustom elpher-start-page-url "about:welcome"
"Specify the page displayed initially by elpher.
-The default welcome screen \"about:welcome\", while the bookmarks list
-is \"about:bookmarks\". You can also specify local files via \"file:\".")
+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
(unless (and (not (url-fullness url)) (url-type url))
(setf (url-fullness url) t)
(unless (url-type url)
- (setf (url-type url) elpher-default-url-type))
+ (setf (url-type url) (elpher-get-default-url-type)))
(unless (url-host url)
(let ((p (split-string (url-filename url) "/" nil nil)))
(setf (url-host url) (car p))
(elpher-remove-redundant-ports url))
(set-match-data data))))
+(defun elpher-get-default-url-type ()
+ "Get the current URL type or `elpher-default-url-type'.
+If no scheme is provided for a URL, the current context specifies
+the scheme to use, so if we're looking at a gemini page, then the
+default type is \"gemini\" even if `elpher-default-url-type' is
+\"gopher\"."
+ (or (and elpher-current-page
+ (symbol-name
+ (elpher-address-type
+ (elpher-page-address elpher-current-page))))
+ elpher-default-url-type))
+
(defun elpher-remove-redundant-ports (address)
"Remove redundant port specifiers from ADDRESS.
Here 'redundant' means that the specified port matches the default
"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'."
- (let ((protocol (url-type address)))
- (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))))
+ (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 ,subtype) t)))
+ (pcase (elpher-address-type address) (`(about ,_) t)))
(defun elpher-address-gopher-p (address)
"Return non-nill if ADDRESS object is a gopher address."
(list display-string address))
(defun elpher-make-start-page ()
- "Create the welcome page."
+ "Create the start page."
(elpher-make-page "Start Page"
- (elpher-address-from-url elpher-start-page)))
+ (elpher-address-from-url elpher-start-page-url)))
(defun elpher-page-display-string (page)
"Retrieve the display string corresponding to PAGE."
"Set the address corresponding to PAGE to NEW-ADDRESS."
(setcar (cdr page) new-address))
+(defun elpher-page-from-url (url)
+ "Create a page with address and display string defined by URL.
+The URL is unhexed prior to its use as a display string to improve
+readability."
+ (elpher-make-page (elpher-url-to-iri url)
+ (elpher-address-from-url url)))
+
+(defun elpher-url-to-iri (url)
+ "Return an IRI for URL.
+Decode percent-escapes and handle punycode in the domain name.
+Drop the password, if any."
+ (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url))))
+ (host (url-host address))
+ (pass (url-password address)))
+ (when host
+ (setf (url-host address) (puny-decode-domain host)))
+ (when pass ; RFC 3986 says we should not render
+ (setf (url-password address) nil)) ; the password as clear text
+ (url-recreate-url address)))
+
+(defun elpher-encode-url (iri)
+ "Return an URL for the IRI.
+Encode and use percent-escapes, use punycode for the domain name
+if necessary."
+ (let* ((address (url-generic-parse-url iri))
+ (host (url-host address)))
+ (when host
+ (setf (url-host address) (puny-encode-domain host)))
+ (url-recreate-url address)))
+
(defvar elpher-current-page nil
"The current page for this Elpher buffer.")
(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-about-p (elpher-page-address page))
(and 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."
(defun elpher-update-header ()
"If `elpher-use-header' is true, display current page info in window header."
- (if elpher-use-header
+ (if (and elpher-use-header elpher-current-page)
(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-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))))
(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)))))
+ (let ((page (elpher-page-from-url (substring-no-properties (match-string 0)))))
(make-text-button (match-beginning 0)
(match-end 0)
'elpher-page page
(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
(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)
+ :family (and (or force-ipv4
+ elpher-ipv4-always)
+ 'ipv4)
:service service
:buffer nil
:nowait t
;; 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-about-p address)
- address
- (elpher-address-to-url address))))))))
+ (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))))))
(defun elpher-insert-index-record (display-string &optional address)
"Function to insert an index record into the current buffer.
(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)))))
nil t))
(window (get-buffer-window elpher-buffer-name)))
(when window
- (setf (image-property image :max-width) (window-pixel-width window))
- (setf (image-property image :max-height) (window-pixel-height 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)))
=> prefix are empty."
(let ((l (split-string (substring link-line 2))))
(if l
- (string-trim (elt l 0))
+ (elpher-encode-url (string-trim (elt l 0)))
nil)))
(defun elpher-gemini-get-link-display-string (link-line)
(idx (string-match "[ \t]" rest)))
(string-trim (if idx
(substring rest (+ idx 1))
- rest))))
+ (elpher-url-to-iri rest)))))
(defun elpher-collapse-dot-sequences (filename)
"Collapse dot sequences in FILENAME.
elpher--gemini-page-headings))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
- (insert (propertize header 'face face))
+ (insert (propertize header 'face face 'rear-nonsticky t))
(newline))))
(defun elpher-gemini-insert-text (text-line)
"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))
+ (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)
(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))
+ (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)))
;; File page
(defun elpher-get-file-page (renderer)
- "Getter which retrieves the contents of a local file and renders it using 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)))
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(insert-file-contents-literally filename)
- (string-as-unibyte (buffer-string))))))
+ (encode-coding-string (buffer-string) 'raw-text)))))
(if renderer
(funcall renderer body nil)
(pcase (file-name-extension filename)
(let ((help-string "RET,mouse-1: Open bookmark list"))
(insert-text-button "bookmark list"
'face 'link
- 'action (lambda (_)
- (interactive)
- (call-interactively #'elpher-show-bookmarks))
+ 'action #'elpher-click-link
'follow-link t
- 'help-echo help-string))
+ 'help-echo #'elpher--page-button-help
+ 'elpher-page
+ (elpher-make-page "Elpher Bookmarks"
+ (elpher-make-about-address 'bookmarks))))
(insert ".\n")
(insert (propertize
"(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n"
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-about-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)
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)))
+ (page (elpher-page-from-url cleaned-url)))
(elpher-with-clean-buffer
(elpher-visit-page page))
(set-buffer (get-buffer elpher-buffer-name))
(elpher-bookmark-import old-bookmarks-file)
(rename-file old-bookmarks-file (concat old-bookmarks-file "-legacy"))))
- (if elpher-use-emacs-bookmark-menu
+ (if (and elpher-use-emacs-bookmark-menu
+ elpher-history)
(progn
(elpher-visit-previous-page)
(call-interactively #'bookmark-bmenu-list))
(interactive "sGopher or Gemini URL: ")
(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)))
+ (let ((page (elpher-page-from-url trimmed-host-or-url)))
(switch-to-buffer elpher-buffer-name)
(elpher-with-clean-buffer
(elpher-visit-page page))
(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))))))
+ (elpher-visit-page (elpher-page-from-url url)))))
(defun elpher-redraw ()
"Redraw current page."
(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)))
+ "Display URL of PAGE in minibuffer."
+ (let ((address (elpher-page-address page)))
(message "%s" (elpher-address-to-url address))))
(defun elpher-info-link ()