Switch URL and Name position in the menu
[elpher.git] / elpher.el
index 40e21dc..29687f1 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.10.0
+;; Version: 2.10.2
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26.2"))
@@ -71,7 +71,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.10.0"
+(defconst elpher-version "2.10.2"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -209,7 +209,7 @@ some servers which do not support IPv6 can take a long time to time-out."
   "Face used for html type directory records.")
 
 (defface elpher-gemini
-  '((t :inherit font-lock-regexp-grouping-backslash))
+  '((t :inherit font-lock-constant-face))
   "Face used for Gemini type directory records.")
 
 (defface elpher-other-url
@@ -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
@@ -804,6 +809,8 @@ base for the installed key and certificate files."
 
 (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))
@@ -1363,17 +1370,20 @@ treatment that a separate function is warranted."
 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.
@@ -1683,7 +1693,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 +1743,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 +1874,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 +1999,337 @@ 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 (&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)
+                 '("Name" 30 t)
+                 '("URL" 40 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-find-title)
+                          (elpher-page-display-string elpher-current-page)
+                          (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")))
+             ((eq major-mode 'eww-mode)
+              (vector "W"
+                      (or (plist-get eww-data :title)
+                          (buffer-name))
+                      (or (eww-current-url)
+                          "none"))))))
+
+(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-page-display-string (cdr pair)) "?")
+                                      (or (elpher-address-to-url
+                                           (elpher-page-address (cdr pair))) "none")))
+                      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-page-display-string elpher-current-page)
+                                  (buffer-name))
+                              (or (elpher-address-to-url
+                                   (elpher-page-address elpher-current-page)))))
+                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 :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
 ;;
 
 ;;;###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