diff options
-rw-r--r-- | .emacs.d/init.el | 135 | ||||
-rw-r--r-- | .emacs.d/site-lisp/transient-cycles.el | 72 |
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 |