Fixes to the Elpher menu code
[elpher.git] / elpher.el
index b5f995b..13cd006 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -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))))
@@ -521,6 +521,7 @@ unless NO-HISTORY is non-nil."
   "Evaluate ARGS with a clean *elpher* buffer as current."
   `(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
@@ -1737,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)))
@@ -2001,6 +2002,219 @@ functions which initialize the gopher client, namely
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'elpher-mode 'motion))
 
+;;; 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" '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 nil t))
+
+(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."
+    ;; Set up `tabulated-list-format'.
+    (setq tabulated-list-format
+         (vector '("T" 1 t)
+                 '("URL" 35 t)
+                 '("Name" 35 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))
+           (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 ()
+  "Return current entries for `elpher-menu-refresh'.
+If we're only interested in the current entries, then this
+function can only return a list of a single item per buffer."
+  (list (current-buffer)
+       (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)
+               (or (elpher-find-title)
+                   (elpher-page-display-string elpher-current-page)))
+              ((eq major-mode 'eww-mode)
+               (plist-get eww-data :title))))))
+
+(defun elpher-menu-refresh-history ()
+  "Return current entries for `elpher-menu-refresh'.
+If we're only interested in the current entries, then this
+function can only return a list of a single item per buffer."
+  (let ((separator (list (current-buffer)
+                        (vector
+                         "E"
+                         (make-string 25 ?-)
+                         (make-string 25 ?-)))))
+    (if (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)
+                           (vector
+                            "E"
+                            (or (elpher-address-to-url
+                                 (elpher-page-address page)) "none")
+                            (or (elpher-page-display-string page) "?")))
+                   separator))
+               (cons elpher-current-page elpher-history))
+      (nconc (mapcar (lambda (data)
+                      (list (current-buffer)
+                            (vector
+                             "W"
+                             (plist-get data :url)
+                             (plist-get data :title))))
+                    (cons eww-data eww-history))
+            (list separator)))))
 
 ;;; Main start procedure
 ;;
@@ -2025,10 +2239,10 @@ buffer selected (or created)."
                     (get-buffer-create name)))))
     (pop-to-buffer-same-window buf)
     (unless (buffer-modified-p)
-      (let ((elpher-buffer-name (buffer-name)); for elpher-with-clean-buffer
-           (start-page (elpher-make-page "Elpher Start Page"
-                                          (elpher-make-special-address 'start))))
+      (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.
+      "Started Elpher."))); Otherwise (elpher) evaluates to start page string.
 
 ;;; elpher.el ends here