Fixes to the Elpher menu code

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index 40e21dc..13cd006 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))
 
   "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.
 
 (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))
               (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))))
   (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
 ;;
 
 ;;; 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
 (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."
 
 (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."
 
 (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
     (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)))
   (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))
 
     (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)
 (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)))
   (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)
 (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))))
 
   (elpher-visit-page
    (elpher-make-page "Bookmarks Page" (elpher-make-special-address 'bookmarks))))
 


@@ -1989,27 +1994,255 @@ 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
 
 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))
 
 
 (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
 ;;
 
 ;;;###autoload
 
 ;;; 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
 
 ;;; elpher.el ends here