factor out spw/transient-cycles-define-buffer-switch

1 files changed, 44 insertions, 16 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 8c945eea..3123dc91 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -451,6 +451,45 @@ that's something we can determine.")
   ;; If HOST looks like an FQDN, require that `spw/fqdn' is non-nil and equal.
   (string= host (if (cl-find ?. host) spw/fqdn (system-name))))
 
+;; This is a combination of the two `transient-cycles-define-commands' forms
+;; for `transient-cycles-buffer-siblings-mode'.  We could factor this out of
+;; those and make it part of the library's API, but currently those two forms
+;; also serve as nice usage examples for `transient-cycles-define-commands'.
+(defmacro spw/transient-cycles-define-buffer-switch
+    (commands &rest keyword-arguments)
+  (declare (indent 0))
+  (let ((window (gensym))
+	(prev-buffers (gensym)))
+    `(transient-cycles-define-commands (,window ,prev-buffers)
+       ,(cl-loop for (original lambda . body) in commands collect
+		 `(,original ,lambda
+		   ,@(and (listp (car body))
+			  (eq (caar body) 'interactive) (list (pop body)))
+		   (let ((ret-val ,(macroexp-progn body)))
+		     (when (windowp ret-val) (setq ,window ret-val))
+		     (setq ,prev-buffers (window-prev-buffers ,window))
+		     ret-val)))
+       (transient-cycles-buffer-ring-cycler
+	:ring (cl-etypecase ret-val
+		(buffer (transient-cycles-buffer-siblings-ring ret-val))
+		(window (transient-cycles-buffer-siblings-ring
+			 (window-buffer ret-val)))
+		(ring ret-val))
+	:action (if (windowp ret-val)
+		    (with-selected-window ret-val
+		      (let ((display-buffer-overriding-action
+			     '((display-buffer-same-window)
+			       (inhibit-same-window . nil))))
+			(display-buffer buffer)))
+		  (switch-to-buffer buffer t t)))
+       :on-exit (if ,window
+		    (progn (set-window-next-buffers ,window nil)
+			   (set-window-prev-buffers ,window ,prev-buffers))
+		  (switch-to-buffer (current-buffer) nil t)
+		  (set-window-next-buffers nil nil)
+		  (set-window-prev-buffers nil ,prev-buffers))
+       . ,keyword-arguments)))
+
 
 ;;;; The *scratch* and *notes* buffers
 
@@ -1584,7 +1623,7 @@ The ideas behind these behaviours are as follows.
 
 (spw/reclaim-keys-from dired-x dired-mode-map "\M-!")
 
-(transient-cycles-define-commands (prev-buffers)
+(spw/transient-cycles-define-buffer-switch
   ((("\M-!" . spw/eshell-jump) (arg)
       (interactive "p")
       (let ((>>> (and (> arg 1) (format " >>>#<buffer %s>" (buffer-name)))))
@@ -1600,30 +1639,19 @@ The ideas behind these behaviours are as follows.
 		  (insert >>>)
 		  (backward-char (length >>>))
 		  (when (> (point) eshell-last-output-end)
-		    (just-one-space))))))
-	  (setq prev-buffers (window-prev-buffers)))))
+		    (just-one-space)))))))))
    ;; This could be on C-z C-j, like `dired-jump', w/ corresponding C-z 4 C-j
    ;; and C-z 5 C-j.  But I'd want C-z 4 C-j much more often than C-z C-j.
    (("\M-&" . spw/eshell-jump-from-here) (arg)
       (interactive "P")
-      (prog1 (spw/eshell-jump arg t)
-	(setq prev-buffers (window-prev-buffers)))))
-  (transient-cycles-buffer-ring-cycler :ring ret-val)
-  :on-exit (progn (switch-to-buffer (current-buffer) nil t)
-		  (set-window-next-buffers nil nil)
-		  (set-window-prev-buffers nil prev-buffers)))
+      (spw/eshell-jump arg t))))
 
 (with-eval-after-load 'project
   (when (boundp 'project-prefix-map)	; for Emacs 27
-    (transient-cycles-define-commands (prev-buffers)
+    (spw/transient-cycles-define-buffer-switch
       ((("e" .  spw/project-eshell) (arg)
 	  (interactive "P")
-	  (prog1 (spw/eshell-jump arg 'project)
-	    (setq prev-buffers (window-prev-buffers)))))
-      (transient-cycles-buffer-ring-cycler :ring ret-val)
-      :on-exit (progn (switch-to-buffer (current-buffer) nil t)
-		      (set-window-next-buffers nil nil)
-		      (set-window-prev-buffers nil prev-buffers))
+	  (spw/eshell-jump arg 'project)))
       ;; Bind into project-prefix-map, rather than adding a remap, so that we
       ;; have it under C-x 4 p, C-x 5 p etc. too.
       :keymap project-prefix-map)