attempt to extract transient-cycles-tab-bar-mode

2 files changed, 80 insertions, 127 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 4cfb4c41..2360c4b8 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -88,86 +88,6 @@ there is nothing already typed that should be wrapped."
 		  `((with-eval-after-load ,file ,@key ,@abbrev))
 		`(,@key ,@abbrev))))))
 
-(defmacro spw/bind-command-with-cycling
-    (bindings generator &optional on-exit map cycle-backward-key cycle-forward-key)
-  (list 'spw/bind-command-with-cycling*
-	(spw/expand-binding-pairs bindings)
-	`(lambda (_ignore)
-	   ,generator)
-	`(lambda ()
-	   ,on-exit)
-	map
-	cycle-backward-key
-	cycle-forward-key))
-
-(cl-defmacro spw/bind-command-with-ret-val-cycling
-    (bindings
-     &optional
-     (generator '(spw/buffer-ring-cycle-lambda))
-     on-exit
-     map)
-  (list 'spw/bind-command-with-cycling*
-	(spw/expand-binding-pairs bindings)
-	`(lambda (ret-val)
-	   ,generator)
-	`(lambda ()
-	   ,on-exit)
-	map))
-
-(defun spw/expand-binding-pairs (bindings)
-  (macroexp-quote
-   (mapcar (lambda (binding)
-	     (cond
-	      ((and (vectorp binding) (eq 'remap (aref binding 0)))
-	       (cons binding (aref binding 1)))
-	      (t
-	       binding)))
-	   (if (or (vectorp bindings) (not (listp (cdr bindings))))
-	       (list bindings)
-	     bindings))))
-
-(cl-defmacro spw/buffer-ring-cycle-lambda
-    (&optional
-     (ring '(spw/buffer-siblings-ring ret-val))
-     (action '(switch-to-buffer buffer nil t))
-     &key
-     (start 0))
-  `(when-let ((buffers ,ring)
-	      (buffers-pos ,start))
-     (lambda (count)
-       (interactive "p")
-       (setq buffers-pos (+ count buffers-pos))
-       (let ((buffer (ring-ref buffers buffers-pos)))
-	 ,action))))
-
-(defun spw/bind-command-with-cycling*
-    (bindings generator &optional on-exit map cycle-backward-key cycle-forward-key)
-  (dolist (binding bindings)
-    (let* ((cmd (symbol-name (cdr binding)))
-	   (binding-fn (intern (concat (if (string-prefix-p "spw/" cmd)
-					   cmd (concat "spw/" cmd))
-				       "-with-transient-cycling"))))
-      (fset binding-fn
-	    (lambda ()
-	      (interactive)
-	      (let ((ret-val (call-interactively (cdr binding))))
-		(when-let ((cycling-function (funcall generator ret-val))
-			   (tmap (make-sparse-keymap)))
-		  (define-key
-		    tmap
-		    (or cycle-backward-key [up])
-		    (lambda (count)
-		      (interactive "p")
-		      (funcall cycling-function (* -1 count))))
-		  ;; Might be useful to bind C-c k in the transient map to
-		  ;; kill the current buffer and cycle one step.
-		  (define-key
-		   tmap (or cycle-forward-key [down]) cycling-function)
-		  (set-transient-map tmap t on-exit)))))
-      (if map
-	  (define-key map (car binding) binding-fn)
-	(global-set-key (car binding) binding-fn)))))
-
 (defun spw/get-wm ()
   (if (string= (getenv "XDG_SESSION_TYPE") "wayland")
       (getenv "XDG_CURRENT_DESKTOP")
@@ -370,6 +290,7 @@ something which should happen just once."
  '(tab-bar-show 1)
  '(tool-bar-mode nil)
  '(transient-cycles-buffer-siblings-mode t)
+ '(transient-cycles-tab-bar-mode t)
  '(transient-cycles-window-buffers-mode t)
  '(transient-mark-mode nil)
  '(uniquify-buffer-name-style 'post-forward nil (uniquify))
@@ -1152,53 +1073,13 @@ keys (e.g. the use of the left and right arrow keys in
 
 (diminish 'eldoc-mode)
 
-;; this makes C-x t o like my (customised) C-x o
-(defun spw/tabs-without-current ()
-  (cl-remove 'current-tab (funcall tab-bar-tabs-function) :key #'car))
-(let (recent-tab-old-time)
-  (defun spw/tab-bar-switch-with-record (fn &rest args)
-    (interactive)
-    (when-let ((tabs (spw/tabs-without-current)))
-      ;; If the most recent tab is not the one we end up at after exiting the
-      ;; transient map, we will want to set that tab's time back to what it
-      ;; was before we changed tabs, as if we had never selected it.  So
-      ;; record that info so we can do that.
-      (setq recent-tab-old-time
-	    (apply #'min (mapcar (lambda (tab) (alist-get 'time tab)) tabs)))
-      (apply fn args)))
-  (defun spw/tab-prev (n)
-    (interactive "p")
-    (spw/tab-next (* -1 n)))
-  (defun spw/tab-bar-switch-to-recent-tab ()
-    (interactive)
-    (spw/tab-bar-switch-with-record #'tab-bar-switch-to-recent-tab))
-  (defun spw/tab-next (n)
-    (interactive "p")
-    (spw/tab-bar-switch-with-record #'tab-bar-switch-to-next-tab n))
-  (spw/bind-command-with-cycling
-   (([?\C-c ?t left] . spw/tab-prev)
-    ([?\C-c ?t ?o] . spw/tab-bar-switch-to-recent-tab)
-    ([remap tab-next] . spw/tab-bar-switch-to-recent-tab)
-    ([?\C-c ?t right] . spw/tab-next))
-   (lambda (count)
-     (interactive "p")
-     ;; We are moving away from the current tab, so restore its time as if we
-     ;; had never selected it, and store the time of the tab we're moving to
-     ;; in case we need to do that a second time.
-     (let ((next-tab-old-time
-	    (let* ((tabs (funcall tab-bar-tabs-function))
-		   (current-index
-		    (cl-position 'current-tab (mapcar #'car tabs)))
-		   (new-index (mod (+ current-index count)
-				   (length tabs))))
-	      (alist-get 'time (nth new-index tabs)))))
-       (tab-bar-switch-to-next-tab count)
-       (setf (alist-get 'time
-			(car (cl-sort (spw/tabs-without-current)
-				      #'>
-				      :key (lambda (t) (alist-get 'time t)))))
-	     recent-tab-old-time)
-       (setq recent-tab-old-time next-tab-old-time)))))
+;; Thanks to `transient-cycles-tab-bar-mode', this makes C-x t o like my
+;; (rebound) C-x o.
+(define-key tab-prefix-map "o" #'tab-bar-switch-to-recent-tab)
+(define-key tab-prefix-map "O" nil)	; easy to hit by accident
+
+(define-key tab-prefix-map [left] #'tab-previous)
+(define-key tab-prefix-map [right] #'tab-next)
 
 (when (executable-find "bash")
   (setq shell-file-name "bash")
diff --git a/.emacs.d/site-lisp/transient-cycles.el b/.emacs.d/site-lisp/transient-cycles.el
index f03df062..d51b4125 100644
--- a/.emacs.d/site-lisp/transient-cycles.el
+++ b/.emacs.d/site-lisp/transient-cycles.el
@@ -474,6 +474,78 @@ since then.  Otherwise, call `previous-buffer'."
 	     (setq param (* -1 count))))
 	  (t (previous-buffer)))))
 
+(defvar transient-cycles-tab-bar-mode-map (make-sparse-keymap)
+  "Keymap for `transient-cycles-tab-bar-mode'.")
+
+;;;###autoload
+(define-minor-mode transient-cycles-tab-bar-mode
+    "Augment \\[tab-previous], \\[tab-next] and
+\\[tab-bar-switch-to-recent-tab] with transient cycling.  After
+running those commands, you can use
+`transient-cycles-tab-bar-cycle-backwards-key' and
+`transient-cycles-tab-bar-cycle-forwards-key' to move forwards
+and backwards in the list of tabs.  When transient cycling
+completes, tab access times will be as though you had moved
+directly from the first tab to the final tab."
+  :lighter nil :keymap transient-cycles-tab-bar-mode-map :global t
+  :group 'transient-cycles)
+
+(defcustom transient-cycles-tab-bar-cycle-backwards-key [left]
+  "Key to cycle backwards in the transient maps set by commands
+augmented by `transient-cycles-tab-bar-mode'."
+  :type 'key-sequence
+  :group 'transient-cycles)
+
+(defcustom transient-cycles-tab-bar-cycle-forwards-key [right]
+  "Key to cycle forwards in the transient maps set by commands
+augmented by `transient-cycles-tab-bar-mode'."
+  :type 'key-sequence
+  :group 'transient-cycles)
+
+(transient-cycles-define-commands (recent-tab-old-time)
+  (([remap tab-previous] (count)
+     (setq recent-tab-old-time (transient-cycles--nth-tab-time (* -1 count)))
+     (tab-previous count))
+
+   ;; `tab-bar-switch-to-recent-tab' does not have a binding by default but
+   ;; establish a remapping so that the user can easily access the transient
+   ;; cycling variant simply by adding a binding for the original command.
+   ([remap tab-bar-switch-to-recent-tab] (count)
+     (setq recent-tab-old-time
+	   (cl-loop for tab in (funcall tab-bar-tabs-function)
+		 unless (eq 'current-tab (car tab))
+		 minimize (cdr (assq 'time tab))))
+     (tab-bar-switch-to-recent-tab count))
+
+   ([remap tab-next] (count)
+     (setq recent-tab-old-time (transient-cycles--nth-tab-time count))
+     (tab-next count)))
+
+  (lambda (_ignore)
+    (lambda (count)
+      ;; We are moving away from the current tab, so restore its time as if
+      ;; we had never selected it, and store the time of the tab we're
+      ;; moving to in case we need to do this again.
+      (let ((next-tab-old-time (transient-cycles--nth-tab-time count)))
+	(tab-bar-switch-to-next-tab count)
+	(cl-loop with max
+	      for tab in (funcall tab-bar-tabs-function)
+	      for tab-time = (assq 'time tab)
+	      when (and (not (eq 'current-tab (car tab)))
+			(or (not max) (> (cdr tab-time) (cdr max))))
+	      do (setq max tab-time)
+	      finally (setcdr max recent-tab-old-time))
+	(setq recent-tab-old-time next-tab-old-time))))
+  :keymap transient-cycles-tab-bar-mode-map
+  :cycle-forwards-key transient-cycles-tab-bar-cycle-forwards-key
+  :cycle-backwards-key transient-cycles-tab-bar-cycle-backwards-key)
+
+(defun transient-cycles--nth-tab-time (n)
+  (let* ((tabs (funcall tab-bar-tabs-function))
+	 (current-index (cl-position 'current-tab tabs :key #'car))
+	 (new-index (mod (+ n current-index) (length tabs))))
+    (alist-get 'time (nth new-index tabs))))
+
 (provide 'transient-cycles)
 
 ;;; transient-cycles.el ends here