+;;; Menu
+;;
+
+(defun elpher-menu (&optional arg)
+ "Show a list of all your `elpher' buffers.
+With an optional argument, add all the history items, too."
+ (interactive "P")
+ (switch-to-buffer (get-buffer-create "*Elpher Menu*"))
+ (elpher-menu-mode)
+ (elpher-menu-refresh arg)
+ (tabulated-list-print))
+
+(defvar elpher-menu-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map "v" 'Buffer-menu-select)
+ (define-key map "2" 'Buffer-menu-2-window)
+ (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" '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 "d" 'Buffer-menu-delete)
+ (define-key map "k" 'Buffer-menu-delete)
+ (define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
+ (define-key map "x" 'Buffer-menu-execute)
+ (define-key map " " 'next-line)
+ (define-key map "\177" 'Buffer-menu-backup-unmark)
+ (define-key map "u" 'Buffer-menu-unmark)
+ (define-key map "m" 'Buffer-menu-mark)
+ (define-key map "b" 'Buffer-menu-bury)
+ (define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers)
+ (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
+ (define-key map (kbd "M-s a C-o") 'Buffer-menu-multi-occur)
+ (define-key map [mouse-2] 'Buffer-menu-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [menu-bar elpher-menu-mode] (cons (purecopy "Elpher-Menu") menu-map))
+ (bindings--define-key menu-map [quit]
+ '(menu-item "Quit" quit-window
+ :help "Remove the elpher menu from the display"))
+ (bindings--define-key menu-map [rev]
+ '(menu-item "Refresh" revert-buffer
+ :help "Refresh the *Elpher Menu* buffer contents"))
+ (bindings--define-key menu-map [s0] menu-bar-separator)
+ (bindings--define-key menu-map [sel]
+ '(menu-item "Select Marked" Buffer-menu-select
+ :help "Select this line's buffer; also display buffers marked with `>'"))
+ (bindings--define-key menu-map [bm2]
+ '(menu-item "Select Two" Buffer-menu-2-window
+ :help "Select this line's buffer, with previous buffer in second window"))
+ (bindings--define-key menu-map [bm1]
+ '(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" 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" 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]
+ '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
+ :help "Search for a regexp through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [ir]
+ '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
+ :help "Search for a string through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [mo]
+ '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur
+ :help "Show lines matching a regexp in marked buffers using Occur"))
+ (bindings--define-key menu-map [s3] menu-bar-separator)
+ (bindings--define-key menu-map [by]
+ '(menu-item "Bury" Buffer-menu-bury
+ :help "Bury the buffer listed on this line"))
+ (bindings--define-key menu-map [ex]
+ '(menu-item "Execute" Buffer-menu-execute
+ :help "Delete buffers marked with k commands"))
+ (bindings--define-key menu-map [s4] menu-bar-separator)
+ (bindings--define-key menu-map [delb]
+ '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
+ :help "Mark buffer on this line to be deleted by x command and move up one line"))
+ (bindings--define-key menu-map [del]
+ '(menu-item "Mark for Delete" Buffer-menu-delete
+ :help "Mark buffer on this line to be deleted by x command"))
+ (bindings--define-key menu-map [umk]
+ '(menu-item "Unmark" Buffer-menu-unmark
+ :help "Cancel all requested operations on buffer on this line and move down"))
+ (bindings--define-key menu-map [mk]
+ '(menu-item "Mark" Buffer-menu-mark
+ :help "Mark buffer on this line for being displayed by v command"))
+ map)
+ "Local keymap for `elpher-menu-mode' buffers.")
+
+(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]. 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
+ column. With a numerical argument, sort by that column.
+\\[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.
+\\[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-1-window] Select that buffer in full-frame window.
+\\[Buffer-menu-2-window] Select that buffer in one window, together with the
+ buffer selected before this one in another window.
+\\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers.
+\\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers.
+\\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers.
+\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down.
+\\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up.
+\\[Buffer-menu-execute] Delete or save marked buffers.
+\\[Buffer-menu-unmark] Remove all marks from current line.
+ With prefix argument, also move up one line.
+\\[Buffer-menu-backup-unmark] Back up a line and remove marks.
+\\[revert-buffer] Update the list of buffers.
+\\[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")))))
+
+(defvar elpher-title nil)
+
+(defun elpher-find-title ()
+ "Return the first heading1."
+ (if elpher-title
+ elpher-title
+ (let ((start (text-property-any
+ (point-min) (point-max)
+ 'face 'elpher-gemini-heading1)))
+ (when start
+ (save-excursion
+ (goto-char start)
+ (setq-local elpher-title
+ (buffer-substring-no-properties
+ start (line-end-position))))))))
+
+(defun elpher-menu-refresh (&optional arg)
+ "Refresh the list of buffers.
+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))
+ tabulated-list-sort-key nil)
+ ;; Collect info for each buffer we're interested in.
+ (let (entries)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (memq major-mode '(elpher-mode eww-mode gemini-mode))
+ (if arg
+ (setq entries (nconc (elpher-menu-refresh-history) entries))
+ (push (elpher-menu-refresh-current) entries)))))
+ (setq tabulated-list-entries (nreverse entries)))
+ (tabulated-list-init-header))
+
+(defun elpher-menu-refresh-current ()
+ "Returns an item for `elpher-menu-refresh'
+based on the current buffer.
+
+An item is a list (BUFFER VECTOR) where BUFFER is the buffer this
+item refers to and VECTOR is what to display in the tabulated
+list established by `elpher-menu-refresh'. See
+`tabulated-list-format'."
+ (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))))
+ ((eq major-mode 'gemini-mode)
+ (vector "E"
+ (or (elpher-address-to-url
+ (elpher-page-address elpher-current-page))
+ "none")
+ (or (elpher-page-display-string elpher-current-page)
+ (buffer-name))))
+ ((eq major-mode 'eww-mode)
+ (vector "W"
+ (or (eww-current-url)
+ "none")
+ (or (plist-get eww-data :title)
+ (buffer-name)))))))
+
+(defun elpher-menu-refresh-history ()
+ "Return current entries for `elpher-menu-refresh'.
+This returns a list of items for the current buffer, based on the
+buffer's history.
+
+An item is a list (BUFFER VECTOR) where BUFFER is the buffer this
+item refers to and VECTOR is what to display in the tabulated
+list established by `elpher-menu-refresh'. See
+`tabulated-list-format'."
+ ;; 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)
+ ;; 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-address-to-url
+ (elpher-page-address (cdr pair))) "none")
+ (or (elpher-page-display-string (cdr pair)) "?")))
+ separator))
+ (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. 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))))
+ separator))
+ ((eq major-mode 'eww-mode)
+ ;; 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 :url) "none")
+ (or (plist-get eww-data :title) "none")))
+ (mapcar (lambda (data)
+ (list
+ (list (current-buffer) 'eww-restore-history data)
+ (vector "W"
+ (or (plist-get data :url) "none")
+ (or (plist-get data :title) "none"))))
+ eww-history))
+ (list separator))))))
+