move some cycling into new mode & begin other parts of new lib

2 files changed, 306 insertions, 127 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 08b478d2..5269149e 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -34,6 +34,7 @@
 (require 'diminish)
 (require 'ws-butler)
 (require 'mode-local)
+(require 'transient-cycles)
 
 ;; Load these both right now for the *scratch* buffer.
 (require 'paredit) (require 'elisp-slime-nav)
@@ -367,6 +368,7 @@ something which should happen just once."
  '(tab-bar-new-button-show nil)
  '(tab-bar-show 1)
  '(tool-bar-mode nil)
+ '(transient-cycles-buffer-siblings-mode t)
  '(transient-mark-mode nil)
  '(uniquify-buffer-name-style 'post-forward nil (uniquify))
  '(use-short-answers t)
@@ -1039,8 +1041,6 @@ keys (e.g. the use of the left and right arrow keys in
    (interactive "p")
    (if (> count 0) (tab-bar-history-forward) (tab-bar-history-back))))
 
-;; also add useful cycling with arrow keys to C-x p e, C-h i, C-x 4 b
-;; C-x 4 C-o, and others
 (with-eval-after-load 'project
   (when (boundp 'project-prefix-map)	; for Emacs 27
     (spw/bind-command-with-ret-val-cycling
@@ -1054,32 +1054,6 @@ keys (e.g. the use of the left and right arrow keys in
     (when (assoc 'project-eshell project-switch-commands)
       (setcar (assoc 'project-eshell project-switch-commands)
 	      #'spw/project-eshell-with-transient-cycling))))
-(spw/bind-command-with-cycling
- [remap info]
- (spw/buffer-ring-cycle-lambda
-  (spw/buffer-siblings-ring (get-buffer "*info*"))))
-(spw/bind-command-with-ret-val-cycling
- ([remap switch-to-buffer]
-  [remap switch-to-buffer-other-window]
-  [remap switch-to-buffer-other-frame]))
-(spw/bind-command-with-ret-val-cycling
- ([remap display-buffer]
-
-  ;; `switch-to-buffer-other-tab' uses `display-buffer' so needs to be in this
-  ;; invocation of `spw/bind-command-with-ret-val-cycling,' not the previous
-  [remap switch-to-buffer-other-tab]
-
-  ;; For some reason, in the case of `display-buffer-other-frame' only, the
-  ;; transient map gets immediately cancelled, under i3, at least.  Fine on
-  ;; text terminals
-  [remap display-buffer-other-frame])
-
- (spw/buffer-ring-cycle-lambda
-  (spw/buffer-siblings-ring (window-buffer ret-val))
-  (with-selected-window ret-val
-    (let ((display-buffer-overriding-action '((display-buffer-same-window)
-					      (inhibit-same-window . nil))))
-      (display-buffer buffer)))))
 
 ;; For when the buffer's name isn't much help for switching to it, as is often
 ;; the case with notmuch buffers.  Commented out for now because the transient
@@ -2239,105 +2213,6 @@ Single prefix argument to clear."
     (message "C-M-v will scroll %s" (window-buffer (get-mru-window)))))
 (global-set-key "\C-cV" #'spw/set-other-window-to-scroll)
 
-(defconst spw/buffer-siblings-major-modes
-  '(("\\`*unsent mail" . message-mode))
-  "Alist mapping regexps to major modes.
-Buffers whose names match a regexp are considered to be
-associated with buffers with the major mode, regardless of what
-major mode is actually active in the buffer.")
-
-(defun spw/buffer-siblings-ring (buffer)
-  "Return ring of BUFFER clones and buffers sharing the clones' major mode.
-BUFFER itself is the first element of the ring, and then the
-clones of BUFFER, and then buffers merely sharing the major mode
-of the family of clones.
-
-Whether a buffer is considered a clone of BUFFER is determined by
-its name alone.  So clones produced by `clone-buffer' and
-`clone-indirect-buffer' will be counted as siblings, but so will
-the two Eshell buffers produced if you type \\[project-eshell]
-and then \\[universal-argument] \\[project-eshell], as the same
-naming scheme is used.  This is desirable.
-
-The (singular) major mode of the family of clones is determined
-using heuristics, as it is expected that clones of a buffer may
-have different major modes -- that's one of the reasons for
-making indirect clones."
-  (let (buffers
-	(clones-hash (make-hash-table))
-	mode
-	(root-name (if (string-match "\\`\\(.+\\)<[0-9]+>\\'"
-				     (buffer-name buffer))
-		       (match-string 1 (buffer-name buffer))
-		     (buffer-name buffer))))
-    (let* ((clones-regexp
-	    (concat "\\`" (regexp-quote root-name) "\\(<[0-9]+>\\)?\\'"))
-	   (pred (lambda (b) (string-match clones-regexp (buffer-name b)))))
-      ;; Build a list of the clones
-      (setq buffers (cl-remove-if-not pred (buffer-list)))
-      ;; Also build a hash of the clones so that we can answer the question of
-      ;; whether an arbitrary buffer is one of the clones in constant time
-      (dolist (buffer buffers)
-	(puthash buffer t clones-hash))
-      (setq mode
-	    (or
-	     ;; 1. See if this buffer name is associated with a particular
-	     ;; mode.
-	     (cl-loop for pair in spw/buffer-siblings-major-modes
-		      if (string-match (car pair) root-name)
-		      return (cdr pair))
-	     ;; 2. If only one buffer or root clone is visiting a file, use
-	     ;; major mode of that one buffer or root clone.  Don't
-	     ;; consider arbitrary clones visiting files, as this may be
-	     ;; because user cloned, edited down, changed major mode and
-	     ;; wrote to a file.  The only case we want to catch here is
-	     ;; the root of a family of indirect clones, basically.
-	     (and (eq 1 (length buffers))
-		  (with-current-buffer (car buffers)
-		    major-mode))
-	     (when-let ((root-clone (cl-find-if
-				     (lambda (b)
-				       (string= root-name (buffer-name b)))
-				     buffers)))
-	       (with-current-buffer root-clone
-		 (and (buffer-file-name)
-		      major-mode)))
-	     ;; 3. See if the name of one of the clones is a substring of its
-	     ;; major mode, and if so, use that mode.  So *eww* -> eww-mode.
-	     ;; If there are cases this heuristic will get wrong, add to
-	     ;; `spw/buffer-siblings-major-modes' to override.
-	     (let ((root-root-name (regexp-quote
-				    (if (string-match "\\`\\*\\(.+\\)\\*\\'"
-						      root-name)
-					(match-string 1 root-name)
-				      root-name)))
-		   (case-fold-search t))
-	       (cl-loop for buffer in buffers
-			for mode = (symbol-name
-				    (with-current-buffer buffer major-mode))
-			if (string-match root-root-name mode)
-			return mode))
-	     ;; 4. Fallback.
-	     (with-current-buffer buffer major-mode))))
-    (dolist (buffer (buffer-list))
-      (with-current-buffer buffer
-	(when (and (eq mode major-mode)
-		   ;; This is where we make use of our hash of the clones
-		   (not (gethash buffer clones-hash)))
-	  (push buffer buffers))))
-    (let (;; Ensure that original buffer is the first one inserted
-	  ;; into the ring, so that cycling through the ring starting from
-	  ;; the original buffer makes sense.  Usually the original buffer
-	  ;; will be the most recently selected buffer and so highest in
-	  ;; (buffer-list), but when we are called by
-	  ;; `spw/display-buffer-with-transient-cycling' and similar
-	  ;; functions wrapping `display-buffer' not `switch-to-buffer', this
-	  ;; will not be the case
-	  (reversed (nreverse (cons buffer (remove buffer buffers))))
-	  (ring (make-ring (length buffers))))
-      (dolist (buffer reversed ring)
-	(ring-insert ring buffer)))))
-
 (defun spw/locate-source-library (library)
   (interactive (list (read-library-name)))
   (find-file-other-window (locate-library (concat library ".el"))))
diff --git a/.emacs.d/site-lisp/transient-cycles.el b/.emacs.d/site-lisp/transient-cycles.el
index 709c5af0..2ef3351b 100644
--- a/.emacs.d/site-lisp/transient-cycles.el
+++ b/.emacs.d/site-lisp/transient-cycles.el
@@ -55,6 +55,12 @@
 ;; Emacs commands with transient cycling variants the author has found useful.
 ;; `transient-cycles-buffer-siblings-mode' implements a more complex version
 ;; of the transient cycling described in the preceding example.
+;;
+;; Definitions of command variants in this file only hide the fact that
+;; transient cycling went on -- in the example above, how the buffer list is
+;; undisturbed and how only the final buffer is pushed to the window's
+;; previous buffers -- to the extent that doing so does not require saving a
+;; lot of data when commencing transient cycling.
 
 ;;; Code:
 
@@ -75,6 +81,304 @@ commands augmented with transient cycling."
   :type 'key-sequence
   :group 'transient-cycles)
 
+(cl-defmacro transient-cycles-define-commands
+    (bindings commands cycler-generator
+     &key on-exit cycle-forwards-key cycle-backwards-key
+       (keymap '(current-global-map)))
+  "Define command variants closing over BINDINGS as specified by
+COMMANDS with transient cycling as supplied by CYCLER-GENERATOR.
+
+BINDINGS are established by means of `let*' at the beginning of
+each command variant.  Thus each command variant,
+CYCLER-GENERATOR and ON-EXIT close over each of BINDINGS.  The
+storage is intended to last for the duration of transient
+cycling, and may be used for cycling state or to save values from
+before cycling began for restoration during ON-EXIT.
+
+Each of COMMANDS defines a command variant, and should be of the
+form (ORIGINAL ARGS [INTERACTIVE] &body BODY) where ORIGINAL
+names the command for which a transient cycling variant should be
+defined, and ARGS, INTERACTIVE and BODY are as in `lambda'.  If
+INTERACTIVE is absent then the newly defined command is given
+ORIGINAL's interactive form.  As a special case, if ORIGINAL is
+of the form [remap COMMAND], then COMMAND is used as ORIGINAL and
+[remap COMMAND] is bound to the command variant in KEYMAP.
+
+CYCLER-GENERATOR defines a function which will be called with the
+return value of each command variant, and must return a function
+of one argument, which is known as the cycler.  After the call to
+the command variant, a transient map is established in which
+CYCLE-FORWARDS-KEY invokes the cycler with the numeric value of
+the prefix argument and CYCLE-BACKWARDS-KEY invokes the cycler
+with the numeric value of the prefix argument multiplied by -1.
+
+ON-EXIT, if present, is wrapped in a lambda expression with no
+arguments, i.e. (lambda () ON-EXIT), and passed as the third
+argument to `set-transient-map'."
+  (macroexp-progn
+   (cl-loop with on-exit = (and on-exit `(lambda () ,on-exit))
+	 and arg = (gensym) and cycler = (gensym) and tmap = (gensym)
+	 for (original args . body) in commands
+	 for remap-p = (and (vectorp original) (eq 'remap (aref original 0)))
+	 for original* = (if remap-p (aref original 1) original)
+	 for name = (intern
+		     (format "transient-cycles--%s-with-transient-cycling"
+			     (symbol-name original*)))
+	 collect
+	 `(defun ,name ()
+	    ,(format "Like `%s', but augmented with transient cycling."
+		     (symbol-name original*))
+	    (interactive)
+	    (let* (,@bindings
+		   (,arg (call-interactively
+			  (lambda ,args
+			    ,@(if (and (listp (car body))
+				       (eq 'interactive (caar body)))
+				  body
+				(cons (interactive-form original*) body))))))
+	      (when-let ((,cycler (funcall ,cycler-generator ,arg))
+			 (,tmap (make-sparse-keymap)))
+		;; It might be additionally useful to bind something in the
+		;; transient map to kill the current buffer and cycle once.
+		;;
+		;; For the forward direction we could elide this lambda and
+		;; just bind the key to the cycler.  But this way means we are
+		;; consistent in always supplying an integer.
+		(define-key ,tmap
+		    ,(or cycle-forwards-key
+			 '(cond ((memq last-command-event '(up down))
+				 [down])
+				((memq last-command-event '(left right))
+				 [right])
+				(t
+				 transient-cycles-default-cycle-forwards-key)))
+		  (lambda (,arg)
+		    (interactive "p")
+		    (funcall ,cycler ,arg)))
+		(define-key ,tmap
+		    ,(or cycle-backwards-key
+			 '(cond ((memq last-command-event '(up down))
+				 [up])
+				((memq last-command-event '(left right))
+				 [left])
+				(t
+				 transient-cycles-default-cycle-backwards-key)))
+		  (lambda (,arg)
+		    (interactive "p")
+		    (funcall ,cycler (* -1 ,arg))))
+		(set-transient-map ,tmap t ,on-exit))))
+	 when remap-p collect `(define-key ,keymap ,original #',name))))
+(put 'transient-cycles-define-commands 'common-lisp-indent-function
+     '(4 (&whole 2 &rest (&whole 1 4 &body)) &body))
+
+(cl-defmacro transient-cycles-buffer-ring-cycler
+    (&key (start 0)
+       (ring '(transient-cycles-buffer-siblings-ring ret-val))
+       (action '(switch-to-buffer buffer t t)))
+  "Yield a lambda expression to cycle RING from START using ACTION.
+This macro is intended for use as the CYCLER-GENERATOR argument
+to `transient-cycles-define-keys'.
+
+RING is a form which evaluates to a ring of buffers.  It should
+be written in terms of `ret-val', which at time of evaluation
+will hold the return value of calling the command variant as
+described in the docstring of `transient-cycles-define-keys'.
+ACTION is a form in terms of `buffer', which should cycle to
+`buffer' in the relevant sense."
+  (let ((count (gensym))
+	(buffers (gensym))
+	(buffers-pos (gensym)))
+    `(lambda (ret-val)
+       (when-let ((,buffers ,ring)
+		  (,buffers-pos ,start))
+	 (lambda (,count)
+	   (interactive "p")
+	   (cl-incf ,buffers-pos ,count)
+	   (let ((buffer (ring-ref ,buffers ,buffers-pos)))
+	     ,action))))))
+
+(defcustom transient-cycles-buffer-siblings-major-modes
+  '(("\\`*unsent mail" . message-mode))
+  "Alist mapping regexps to major modes.
+Buffers whose names match a regexp are considered to have the
+associated major mode for the purpose of determining whether they
+should be associated with families of clones as generated by
+`transient-cycles-buffer-siblings-ring', which see."
+  :type '(alist :key-type regexp :value-type symbol)
+  :group 'transient-cycles)
+
+(defun transient-cycles-buffer-siblings-ring (buffer)
+  "Return ring of BUFFER clones and buffers sharing the clones' major mode.
+BUFFER itself is the first element of the ring, followed by the
+clones of BUFFER, and then buffers merely sharing the major mode
+of the family of clones.
+
+Clonehood is determined by similarity of buffer names.  Clones
+produced by `clone-buffer' and `clone-indirect-buffer' will be
+counted as siblings, but so will the two Eshell buffers produced
+if you type \\[project-eshell] then \\[universal-argument] \\[project-eshell],
+as the same naming scheme is used.  This is desirable for
+`transient-cycles-buffer-siblings-mode', which see.
+
+The singular major mode of the family of clones is determined
+using heuristics, as it is expected that clones of a buffer may
+have different major modes: visiting one file with more than one
+major mode is one of the primary uses of indirect clones."
+  (let* ((clones-hash (make-hash-table))
+	 (root-name (buffer-name buffer))
+	 (root-name (if (string-match "\\`\\(.+\\)<[0-9]+>\\'" root-name)
+			(match-string 1 root-name)
+		      root-name))
+	 (clones-regexp
+	  (concat "\\`" (regexp-quote root-name) "\\(<[0-9]+>\\)?\\'"))
+	 (clones-pred
+	  (lambda (b) (string-match clones-regexp (buffer-name b))))
+	 (buffers (cl-remove-if-not clones-pred (buffer-list)))
+	 (mode (or (cdr (assoc root-name
+			       transient-cycles-buffer-siblings-major-modes
+			       #'string-match))
+		   ;; If only one buffer or root clone is visiting a file, use
+		   ;; major mode of that one buffer or root clone.  The only
+		   ;; case we want here is the root of a family of indirect
+		   ;; clones.  Thus, don't consider arbitrary clones visiting
+		   ;; files, as this may be because the user cloned, edited
+		   ;; down, changed major mode and then wrote to a file.
+		   (and (= 1 (length buffers))
+			(with-current-buffer (car buffers) major-mode))
+		   (let ((root-clone
+			  (cl-find root-name buffers
+				   :key #'buffer-name :test #'string=)))
+		     (and root-clone (with-current-buffer root-clone
+				       (and (buffer-file-name) major-mode))))
+		   ;; See if the name of one of the clones is a substring of
+		   ;; its major mode, and if so, use that mode.
+		   ;; E.g. *eww* -> `eww-mode'.  Cases this heuristic will get
+		   ;; wrong should have entries in
+		   ;; `transient-cycles-buffer-sublings-major-modes'.
+		   (cl-loop
+		    with root-root-name = (regexp-quote
+					   (string-trim root-name "\\*" "\\*"))
+		    with case-fold-search = t
+		    for buffer in buffers
+		    for mode = (symbol-name
+				(with-current-buffer buffer major-mode))
+		    when (string-match root-root-name mode) return mode)
+		   ;; Fallback.
+		   (with-current-buffer buffer major-mode))))
+    (dolist (buffer buffers) (puthash buffer t clones-hash))
+    (dolist (buffer (buffer-list))
+      (with-current-buffer buffer
+	(when (and (eq mode major-mode) (not (gethash buffer clones-hash)))
+	  (push buffer buffers))))
+    (let ((ring (make-ring (length buffers)))
+	  ;; Often BUFFER will be the most recently selected buffer and so the
+	  ;; car of the buffer list, but not always, and we always want
+	  ;; cycling to begin from BUFFER.
+	  (reversed (nreverse (cons buffer (remove buffer buffers)))))
+      (dolist (buffer reversed ring) (ring-insert ring buffer)))))
+
+
+;;;; Minor modes
+
+(defvar transient-cycles-buffer-siblings-mode-map (make-sparse-keymap)
+  "Keymap for `transient-cycles-buffer-siblings-mode'.")
+
+;;;###autoload
+(define-minor-mode transient-cycles-buffer-siblings-mode
+    "Augment a number of standard buffer switching commands with
+transient cycling through buffer siblings.  After typing
+\\[switch-to-buffer], \\[display-buffer], \\[info] and some
+others, you can use the keys
+`transient-cycles-default-cycle-backwards-key' and
+`transient-cycles-default-cycle-forwards-key' to select a
+different, relevantly similar buffer to select or display
+instead.  See `transient-cycles-buffer-siblings-ring' for details
+of the notion of similarity employed.
+
+The purpose of this mode is to make it easier to handle large
+numbers of similarly-named buffers without having to take the
+time to manually rename them.  For example, suppose while reading
+Info you type \\<Info-mode-map>\\[clone-buffer] several times in
+order to view several pieces of information at once.  Later you
+need to refer back to one of those buffers, but \\[info] will
+always take you to `*info*', and if you use \\[switch-to-buffer]
+it might take you several tries to select the buffer you wanted.
+Thanks to this minor mode, after using either of those commands
+to switch to any `Info-mode' buffer you can quickly cycle through
+to the intended target.
+
+If any of the commands augmented by this minor mode have been
+rebound to key sequences ending in arrow keys, then the cycling
+keys will be the corresponding pair of arrow keys.  For example,
+if you have rebound `switch-to-buffer' to a key sequence ending
+in \\`<left>', then the cycling keys will be \\`<left>' and \\`<right>'."
+  :lighter nil :keymap transient-cycles-buffer-siblings-mode-map :global t
+  :group 'transient-cycles)
+
+(transient-cycles-define-commands (prev-buffers)
+  (([remap switch-to-buffer] (buffer &optional _norecord force-same-window)
+     (prog1 (switch-to-buffer buffer t force-same-window)
+       (setq prev-buffers (window-prev-buffers))))
+
+   ([remap switch-to-buffer-other-window] (buffer-or-name &rest _ignore)
+     (prog1 (switch-to-buffer-other-window buffer-or-name t)
+       (setq prev-buffers (window-prev-buffers))))
+
+   ([remap switch-to-buffer-other-tab] (buffer-or-name)
+     (prog1 (window-buffer (switch-to-buffer-other-tab buffer-or-name))
+       (setq prev-buffers (window-prev-buffers)))))
+
+  (transient-cycles-buffer-ring-cycler)
+  :on-exit (progn (switch-to-buffer (current-buffer) nil t)
+		  (set-window-next-buffers nil nil)
+		  (set-window-prev-buffers nil prev-buffers))
+  :keymap transient-cycles-buffer-siblings-mode-map)
+
+;; Here we don't try to restore the fundamental or frame buffer lists, but it
+;; would be possible to do so.  See (info "(elisp) Buffer List").
+(transient-cycles-define-commands (window prev-buffers)
+  (([remap display-buffer] (buffer-or-name &optional action frame)
+     (prog1 (setq window (display-buffer buffer-or-name action frame))
+       (setq prev-buffers (window-prev-buffers window))))
+
+   ([remap info] (&optional file-or-node buffer)
+    (prog2 (info file-or-node buffer)
+	(setq window (get-buffer-window buffer))
+      (setq prev-buffers (and window (window-prev-buffers window))))))
+
+  (transient-cycles-buffer-ring-cycler
+   :ring (transient-cycles-buffer-siblings-ring (window-buffer ret-val))
+   :action
+   (with-selected-window ret-val
+     (let ((display-buffer-overriding-action
+	    '((display-buffer-same-window) (inhibit-same-window . nil))))
+       (display-buffer buffer))))
+  :on-exit (progn (set-window-next-buffers window nil)
+		  (set-window-prev-buffers window prev-buffers))
+  :keymap transient-cycles-buffer-siblings-mode-map)
+
+(defvar transient-cycles-window-buffers-mode-map (make-sparse-keymap)
+  "Keymap for `transient-cycles-window-buffers-mode'.")
+
+;;;###autoload
+(define-minor-mode transient-cycles-window-buffers-mode
+    "Augment \\[previous-buffer] and \\[next-buffer] with transient
+cycling.  After typing those commands, you can use the cycling
+keys to move forwards and backwards in a virtual list of the
+window's previous, current and next buffers.  When transient
+cycling completes, your starting point will be stored, such that
+\\[transient-cycles-window-buffers-back-and-forth] can quickly
+take you back there.
+
+If either `previous-buffer' or `next-buffer' are bound to key
+sequences ending in arrow keys, then the cycling keys will be the
+corresponding pair of arrow keys.  Thus, by default, the cycling
+keys are \\`<left>' and \\`<right>'.  Otherwise the fallbacks
+`transient-cycles-default-cycle-backwards-key' and
+`transient-cycles-default-cycle-forwards-key' are used."
+  :lighter nil :keymap transient-cycles-window-buffers-mode-map :global t
+  :group 'transient-cycles)
+
 (provide 'transient-cycles)
 
 ;;; transient-cycles.el ends here