Add elpher menu
[elpher.git] / elpher.el
index 40e21dc..28f8075 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -441,8 +441,8 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Set the address corresponding to PAGE to NEW-ADDRESS."
   (setcar (cdr page) new-address))
 
-(defvar elpher-current-page nil)
-(defvar elpher-history nil)
+(defvar elpher-current-page nil)       ; buffer local
+(defvar elpher-history nil)            ; buffer local
 
 (defun elpher-visit-page (page &optional renderer no-history)
   "Visit PAGE using its own renderer or RENDERER, if non-nil.
@@ -454,7 +454,7 @@ unless NO-HISTORY is non-nil."
               (equal (elpher-page-address elpher-current-page)
                      (elpher-page-address page)))
     (push elpher-current-page elpher-history))
-  (setq elpher-current-page page)
+  (setq-local elpher-current-page page)
   (let* ((address (elpher-page-address page))
          (type (elpher-address-type address))
          (type-record (cdr (assoc type elpher-type-map))))
@@ -500,6 +500,9 @@ unless NO-HISTORY is non-nil."
 ;;; Buffer preparation
 ;;
 
+(defvar elpher-buffer-name "*elpher*"
+  "The default name of the Elpher buffer.")
+
 (defun elpher-update-header ()
   "If `elpher-use-header' is true, display current page info in window header."
   (if elpher-use-header
@@ -516,19 +519,21 @@ unless NO-HISTORY is non-nil."
 
 (defmacro elpher-with-clean-buffer (&rest args)
   "Evaluate ARGS with a clean *elpher* buffer as current."
-  (list 'with-current-buffer "*elpher*"
-        '(elpher-mode)
-        (append (list 'let '((inhibit-read-only t))
-                      '(setq-local network-security-level
-                                   (default-value 'network-security-level))
-                      '(erase-buffer)
-                      '(elpher-update-header))
-                args)))
+  `(with-current-buffer elpher-buffer-name
+     (unless (eq major-mode 'elpher-mode)
+       ;; avoid resetting buffer-local variables
+       (elpher-mode))
+     (let ((inhibit-read-only t))
+       (setq-local network-security-level
+                   (default-value 'network-security-level))
+       (erase-buffer)
+       (elpher-update-header)
+       ,@args)))
 
 (defun elpher-buffer-message (string &optional line)
   "Replace first line in elpher buffer with STRING.
 If LINE is non-nil, replace that line instead."
-  (with-current-buffer "*elpher*"
+  (with-current-buffer elpher-buffer-name
     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (if line
@@ -1683,7 +1688,7 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (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*")
+    (switch-to-buffer elpher-buffer-name)
     (elpher-visit-page page)
     nil))
 
@@ -1733,8 +1738,8 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 (defun elpher-back-to-start ()
   "Go all the way back to the start page."
   (interactive)
-  (setq elpher-current-page nil)
-  (setq elpher-history nil)
+  (setq-local elpher-current-page nil)
+  (setq-local elpher-history nil)
   (let ((start-page (elpher-make-page "Elpher Start Page"
                                       (elpher-make-special-address 'start))))
     (elpher-visit-page start-page)))
@@ -1864,7 +1869,7 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 (defun elpher-bookmarks ()
   "Visit bookmarks page."
   (interactive)
-  (switch-to-buffer "*elpher*")
+  (switch-to-buffer elpher-buffer-name)
   (elpher-visit-page
    (elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
 
@@ -1989,27 +1994,215 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 
 This mode is automatically enabled by the interactive
 functions which initialize the gopher client, namely
-`elpher', `elpher-go' and `elpher-bookmarks'.")
+`elpher', `elpher-go' and `elpher-bookmarks'."
+  (setq-local elpher-current-page nil)
+  (setq-local elpher-history nil)
+  (setq-local elpher-buffer-name (buffer-name)))
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'elpher-mode 'motion))
 
+;;; Menu
+;;
+
+(defun elpher-menu ()
+  "Show a list of all your `elpher' buffers."
+  (interactive)
+  (switch-to-buffer (get-buffer-create "*Elpher Menu*"))
+  (elpher-menu-mode)
+  (elpher-menu-refresh)
+  (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" '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 "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" Buffer-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
+                :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].
+
+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.
+\\[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,
+     so the Buffer Menu remains visible in its window.
+\\[Buffer-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))
+
+(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)))
+      (if start
+         (save-excursion
+           (goto-char start)
+           (setq-local elpher-title
+                       (buffer-substring-no-properties
+                        start (line-end-position))))
+       "none"))))
+
+(defun elpher-menu-refresh ()
+  "Refresh the list of buffers."
+    ;; Set up `tabulated-list-format'.
+    (setq tabulated-list-format
+         (vector '("T" 1 t)
+                 '("URL" 35 t)
+                 '("Name" 35 t))
+         tabulated-list-sort-key '("Name"))
+    ;; 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))
+           (push (list buf
+                       (vector
+                        (cond ((eq major-mode 'elpher-mode) "E")
+                              ((eq major-mode 'eww-mode) "W"))
+                        (cond ((eq major-mode 'elpher-mode)
+                               (or (elpher-address-to-url
+                                    (elpher-page-address elpher-current-page))
+                                   "none"))
+                              ((eq major-mode 'eww-mode)
+                               (eww-current-url)))
+                        (cond ((eq major-mode 'elpher-mode)
+                               (elpher-find-title))
+                              ((eq major-mode 'eww-mode)
+                               (plist-get eww-data :title)))))
+                 entries))))
+      (setq tabulated-list-entries (nreverse entries)))
+    (tabulated-list-init-header))
 
 ;;; Main start procedure
 ;;
 
 ;;;###autoload
-(defun elpher ()
-  "Start elpher with default landing page."
-  (interactive)
-  (if (get-buffer "*elpher*")
-      (switch-to-buffer "*elpher*")
-    (switch-to-buffer "*elpher*")
-    (setq elpher-current-page nil)
-    (setq elpher-history nil)
-    (let ((start-page (elpher-make-page "Elpher Start Page"
-                                        (elpher-make-special-address 'start))))
-      (elpher-visit-page start-page)))
-  "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
+(defun elpher (&optional arg)
+  "Start elpher with default landing page.
+The buffer used for Elpher sessions is determined by the value of
+‘elpher-buffer-name’.  If there is already an Elpher session active in
+that buffer, Emacs will simply switch to it.  Otherwise, a new session
+will begin.  A numeric prefix arg (as in ‘C-u 42 M-x elpher RET’)
+switches to the session with that number, creating it if necessary.  A
+nonnumeric prefix arg means to create a new session.  Returns the
+buffer selected (or created)."
+  (interactive "P")
+  (let* ((name (default-value 'elpher-buffer-name))
+        (buf (cond ((numberp arg)
+                    (get-buffer-create (format "%s<%d>" name arg)))
+                   (arg
+                    (generate-new-buffer name))
+                   (t
+                    (get-buffer-create name)))))
+    (pop-to-buffer-same-window buf)
+    (unless (buffer-modified-p)
+      (elpher-mode)
+      (let ((start-page (elpher-make-page "Elpher Start Page"
+                                         (elpher-make-special-address 'start))))
+       (elpher-visit-page start-page))
+      "Started Elpher."))); Otherwise (elpher) evaluates to start page string.
 
 ;;; elpher.el ends here