;; 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
(if (cdr p)
(concat "/" (mapconcat #'identity (cdr p) "/"))
""))))
+ (when (url-host url)
+ (setf (url-host url) (puny-encode-domain (url-host url))))
(when (or (equal "gopher" (url-type url))
(equal "gophers" (url-type url)))
;; Gopher defaults
"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 ((data (match-data))) ; Prevent parsing clobbering match data
+ (unwind-protect
+ (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))
+ (set-match-data data))))
+
(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)))
rest))))
(defun elpher-collapse-dot-sequences (filename)
- "Collapse dot sequences in FILENAME.
-For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
- (let* ((path (split-string filename "/"))
+ "Collapse dot sequences in the (absolute) FILENAME.
+For instance, the filename \"/a/b/../c/./d\" will reduce to \"/a/c/d\""
+ (let* ((path (split-string filename "/" t))
+ (is-directory (string-match-p (rx (: (or "." ".." "/") line-end)) filename))
(path-reversed-normalized
(seq-reduce (lambda (a b)
- (cond ((and a (equal b "..") (cdr a)))
- ((and (not a) (equal b "..")) a) ;leading .. are dropped
+ (cond ((equal b "..") (cdr a))
((equal b ".") a)
(t (cons b a))))
- path nil)))
- (string-join (reverse path-reversed-normalized) "/")))
+ path nil))
+ (path-normalized (reverse path-reversed-normalized)))
+ (if path-normalized
+ (concat "/" (string-join path-normalized "/") (and is-directory "/"))
+ "/")))
(defun elpher-address-from-gemini-url (url)
"Extract address from URL with defaults as per gemini map files.
(setf (url-filename address)
(concat (file-name-directory (url-filename current-address))
(url-filename address)))))
+ (when (url-host address)
+ (setf (url-host address) (puny-encode-domain (url-host address))))
(unless (url-type address)
(setf (url-type address) (url-type current-address)))
(when (equal (url-type address) "gemini")
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 ()