(require 'url-util)
(require 'subr-x)
(require 'dns)
-(require 'ansi-color)
(require 'nsm)
(require 'gnutls)
+;;; 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.")
;;; Global constants
;;
'("gophers" "gemini")))
" [TLS encryption]"
""))
- (header (concat display-string
- (propertize tls-string 'face 'bold))))
+ (header (url-unhex-string
+ (concat display-string
+ (propertize tls-string 'face 'bold)))))
(setq header-line-format header))))
(defmacro elpher-with-clean-buffer (&rest args)
(defun elpher-list-existing-certificates ()
"Return a list of the persistent certificates in `elpher-certificate-directory'."
+ (unless (file-directory-p elpher-certificate-directory)
+ (make-directory elpher-certificate-directory))
(mapcar
(lambda (file)
(file-name-sans-extension file))
(if type-map-entry
(let* ((margin-code (elt type-map-entry 2))
(face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(elpher-insert-margin margin-code)
(insert-text-button filtered-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
- (ansi-color-filter-apply string)
- (ansi-color-apply string))))
+ (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."
(insert elpher-gemini-link-string)
(if type-map-entry
(let* ((face (elt type-map-entry 3))
- (filtered-display-string (ansi-color-filter-apply display-string))
+ (filtered-display-string (elpher-color-filter-apply display-string))
(page (elpher-make-page filtered-display-string address)))
(insert-text-button filtered-display-string
'face face
The gemini map file line describing the header is given
by HEADER-LINE."
(when (string-match "^\\(#+\\)[ \t]*" header-line)
- (let ((level (length (match-string 1 header-line)))
- (header (substring header-line (match-end 0))))
+ (let* ((level (length (match-string 1 header-line)))
+ (header (substring header-line (match-end 0)))
+ (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))))
(unless (display-graphic-p)
(insert (make-string level ?#) " "))
- (insert (propertize header 'face
- (pcase level
- (1 'elpher-gemini-heading1)
- (2 'elpher-gemini-heading2)
- (3 'elpher-gemini-heading3)
- (_ 'default)))
- "\n"))))
+ (insert (propertize header 'face face))
+ (newline))))
(defun elpher-gemini-insert-text (text-line)
"Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
(define-key map "1" 'Buffer-menu-1-window)
(define-key map "f" 'Buffer-menu-this-window)
(define-key map "e" 'Buffer-menu-this-window)
- (define-key map "\C-m" 'Buffer-menu-this-window)
- (define-key map "o" 'Buffer-menu-other-window)
- (define-key map "\C-o" 'Buffer-menu-switch-other-window)
+ (define-key map "\C-m" 'elpher-menu-this-window)
+ (define-key map "o" 'elpher-menu-other-window)
+ (define-key map "\C-o" 'elpher-menu-switch-other-window)
+ (define-key map "c" 'elpher-menu-copy-current-url)
(define-key map "d" 'Buffer-menu-delete)
(define-key map "k" 'Buffer-menu-delete)
(define-key map "\C-k" 'Buffer-menu-delete)
'(menu-item "Select Current" Buffer-menu-1-window
:help "Select this line's buffer, alone, in full frame"))
(bindings--define-key menu-map [ow]
- '(menu-item "Select in Other Window" Buffer-menu-other-window
+ '(menu-item "Select in Other Window" elpher-menu-other-window
:help "Select this line's buffer in other window, leaving buffer menu visible"))
(bindings--define-key menu-map [tw]
- '(menu-item "Select in Current Window" Buffer-menu-this-window
+ '(menu-item "Select in Current Window" elpher-menu-this-window
:help "Select this line's buffer in this window"))
(bindings--define-key menu-map [s2] menu-bar-separator)
(bindings--define-key menu-map [is]
(define-derived-mode elpher-menu-mode tabulated-list-mode "Elpher Menu"
"Major mode for Elpher Menu buffers.
-The Elpher Menu is invoked by the command \\[elpher-menu].
+The Elpher Menu is invoked by the command \\[elpher-menu]. When
+invoked with a prefix, the command also shows history items.
+Since history items are no longer showing in a buffer, many of
+the commands shown below will not work on them.
In Elpher Menu mode, the following commands are defined:
\\<elpher-menu-mode-map>
\\[quit-window] Remove the Buffer Menu from the display.
-\\[tabulated-list-sort] sorts buffers according to the current
+\\[tabulated-list-sort] Sorts buffers according to the current
column. With a numerical argument, sort by that column.
-\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu.
-\\[Buffer-menu-other-window] Select that buffer in another window,
+\\[elpher-menu-this-window] Select current line's buffer in place of the buffer menu.
+\\[elpher-menu-other-window] Select that buffer in another window,
so the Buffer Menu remains visible in its window.
-\\[Buffer-menu-switch-other-window] Make another window display that buffer.
+\\[elpher-menu-switch-other-window] Make another window display that buffer.
\\[Buffer-menu-mark] Mark current line's buffer to be displayed.
\\[Buffer-menu-select] Select current line's buffer.
Also show buffers marked with m, in other windows.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
(add-hook 'tabulated-list-revert-hook 'elpher-menu-refresh nil t))
+(defun elpher-menu-this-window ()
+ "Select this line’s buffer in this window.
+Switch to the buffer, if possible. If there is no buffer, chances
+are that we're looking at a history item. Let's visit the item
+instead of complaining that their buffers have been killed."
+ (interactive)
+ (elpher-menu-handle-buffer-or-data 'switch-to-buffer))
+
+(defun elpher-menu-other-window ()
+ "Select this line’s buffer in other window, leaving buffer menu visible."
+ (interactive)
+ (elpher-menu-handle-buffer-or-data 'switch-to-buffer-other-window))
+
+(defun elpher-menu-switch-other-window ()
+ "Make the other window select this line's buffer.
+The current window remains selected."
+ (interactive)
+ (elpher-menu-handle-buffer-or-data
+ (lambda (buf) (display-buffer buf t))))
+
+(defun elpher-menu-handle-buffer-or-data (buffer-func)
+ "Handle an item in `elpher-menu-mode'.
+Determine the entry ID of the Tabulated List entry at point. If
+ID is a buffer, invoke BUFFER-FUNC on it. Otherwise, ID is a
+list (BUFFER FUNC ARGS...). Switch to BUFFER using BUFFER-FUNC
+and apply FUNC to ARGS."
+ (let ((data (tabulated-list-get-id)))
+ (cond ((bufferp data)
+ (funcall buffer-func data))
+ ((and (listp data)
+ (buffer-live-p (nth 0 data))
+ (fboundp (nth 1 data)))
+ (funcall buffer-func (nth 0 data))
+ (apply (nth 1 data) (nthcdr 2 data)))
+ (t
+ (error "There's no entry on this line of the menu")))))
+
+(defun elpher-menu-copy-current-url ()
+ "Copy the URL of the current menu item."
+ (interactive)
+ (let ((data (tabulated-list-get-id)))
+ (cond ((bufferp data)
+ (with-current-buffer data
+ (elpher-copy-page-url elpher-current-page)))
+ ((listp data)
+ (elpher-copy-page-url (nth 2 data)))
+ (t
+ (error "There's no entry on this line of the menu")))))
+
+ (defun elpher-copy-current-url ()
+ "Copy URL of current page to `kill-ring'."
+ (interactive)
+ (elpher-copy-page-url elpher-current-page))
+
(defvar elpher-title nil)
(defun elpher-find-title ()
(defun elpher-menu-refresh (&optional arg)
"Refresh the list of buffers.
-With an optional argument, add all the history items, too."
- ;; Set up `tabulated-list-format'.
+With an optional argument, add all the history items, too. Note
+that there are no buffers for history items so many of the buffer
+menu commands won't work on them."
(setq tabulated-list-format
(vector '("T" 1 t)
- '("URL" 40 t)
- '("Name" 30 t))
+ '("Name" 30 t)
+ '("URL" 40 t))
tabulated-list-sort-key nil)
;; Collect info for each buffer we're interested in.
(let (entries)
(list (current-buffer)
(cond ((eq major-mode 'elpher-mode)
(vector "G"
- (or (elpher-address-to-url
- (elpher-page-address elpher-current-page))
- "none")
(or (elpher-find-title)
(elpher-page-display-string elpher-current-page)
- (buffer-name))))
+ (buffer-name))
+ (or (elpher-address-to-url
+ (elpher-page-address elpher-current-page))
+ "none")))
((eq major-mode 'gemini-mode)
(vector "E"
+ (or (elpher-page-display-string elpher-current-page)
+ (buffer-name))
(or (elpher-address-to-url
(elpher-page-address elpher-current-page))
- "none")
- (or (elpher-page-display-string elpher-current-page)
- (buffer-name))))
+ "none")))
((eq major-mode 'eww-mode)
(vector "W"
- (or (eww-current-url)
- "none")
(or (plist-get eww-data :title)
- (buffer-name)))))))
+ (buffer-name))
+ (or (eww-current-url)
+ "none"))))))
(defun elpher-menu-refresh-history ()
"Return current entries for `elpher-menu-refresh'.
item refers to and VECTOR is what to display in the tabulated
list established by `elpher-menu-refresh'. See
`tabulated-list-format'."
- (let ((separator (list (current-buffer)
- (vector
- "-"
- (make-string 25 ?-)
- (make-string 25 ?-)))))
+ ;; Every section starts with the current page, followed by some
+ ;; history items, and ends with the separator.
+ (let ((separator (list nil
+ (vector "-"
+ (make-string 25 ?-)
+ (make-string 25 ?-)))))
(cond ((eq major-mode 'elpher-mode)
- ;; every section starts with the current page and ends with
- ;; the separator
- (mapcar (lambda (page)
- (if page
- (list (current-buffer)
+ ;; A pair is (BUFFER-OR-DATA . PAGE) where BUFFER-OR-DTA is
+ ;; the current buffer, if possible, or list (BUFFER FUNC
+ ;; &rest ARGS) telling us which BUFFER to switch to, and
+ ;; what function to call. The last item of elpher-history
+ ;; has a nil page, so when that shows up, use the separator
+ (mapcar (lambda (pair)
+ (if (cdr pair)
+ (list (car pair)
(vector "G"
+ (or (elpher-page-display-string (cdr pair)) "?")
(or (elpher-address-to-url
- (elpher-page-address page)) "none")
- (or (elpher-page-display-string page) "?")))
+ (elpher-page-address (cdr pair))) "none")))
separator))
- (cons elpher-current-page elpher-history)))
+ (cons (cons (current-buffer) elpher-current-page)
+ (mapcar (lambda (page)
+ (cons (list (current-buffer) 'elpher-visit-page page)
+ page))
+ elpher-history))))
((eq major-mode 'gemini-mode)
- ;; no history means a list of one item
+ ;; No history means a list of one item. Add a separator.
(list (list (current-buffer)
(vector "E"
- (or (elpher-address-to-url
- (elpher-page-address elpher-current-page)))
(or (elpher-page-display-string elpher-current-page)
- (buffer-name))))))
+ (buffer-name))
+ (or (elpher-address-to-url
+ (elpher-page-address elpher-current-page)))))
+ separator))
((eq major-mode 'eww-mode)
- (nconc (mapcar (lambda (data)
- (list (current-buffer)
- (vector "W"
- (or (plist-get data :url) "none")
- (or (plist-get data :title) "none"))))
- (cons eww-data eww-history))
+ ;; A pair is (BUFFER-OR-DATA . PAGE) where BUFFER-OR-DTA is
+ ;; the current buffer, if possible, or list (BUFFER FUNC
+ ;; &rest ARGS) telling us which BUFFER to switch to, and
+ ;; what function to call. Add the separator at the end.
+ (nconc (cons (list (current-buffer)
+ (vector "W"
+ (or (plist-get eww-data :title) "none")
+ (or (plist-get eww-data :url) "none")))
+ (mapcar (lambda (data)
+ (list
+ (list (current-buffer) 'eww-restore-history data)
+ (vector "W"
+ (or (plist-get data :title) "none")
+ (or (plist-get data :url) "none"))))
+ eww-history))
(list separator))))))
;;; Main start procedure
The Lambda Lab / projects / elpher.git / blobdiff