1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00

* lisp/tab-bar.el: Use alist-get instead of (cdr (assq ...))

* lisp/tab-bar.el (tab-bar-mode): Bind s-0 to tab-bar-switch-to-recent-tab.
This commit is contained in:
Juri Linkov 2019-12-23 00:55:38 +02:00
parent 5e3670b685
commit d7eb4955eb

View File

@ -144,6 +144,8 @@ Possible modifiers are `control', `meta', `shift', `hyper', `super' and
(if tab-bar-mode (if tab-bar-mode
(progn (progn
(when tab-bar-select-tab-modifiers (when tab-bar-select-tab-modifiers
(global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
'tab-bar-switch-to-recent-tab)
(dotimes (i 9) (dotimes (i 9)
(global-set-key (vector (append tab-bar-select-tab-modifiers (global-set-key (vector (append tab-bar-select-tab-modifiers
(list (+ i 1 ?0)))) (list (+ i 1 ?0))))
@ -405,7 +407,7 @@ Return its existing value or a new value."
`((current-tab `((current-tab
menu-item menu-item
,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
(cdr (assq 'name tab)) (alist-get 'name tab)
(or (and tab-bar-close-button-show (or (and tab-bar-close-button-show
(not (eq tab-bar-close-button-show (not (eq tab-bar-close-button-show
'non-selected)) 'non-selected))
@ -417,14 +419,14 @@ Return its existing value or a new value."
`((,(intern (format "tab-%i" i)) `((,(intern (format "tab-%i" i))
menu-item menu-item
,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
(cdr (assq 'name tab)) (alist-get 'name tab)
(or (and tab-bar-close-button-show (or (and tab-bar-close-button-show
(not (eq tab-bar-close-button-show (not (eq tab-bar-close-button-show
'selected)) 'selected))
tab-bar-close-button) "")) tab-bar-close-button) ""))
'face 'tab-bar-tab-inactive) 'face 'tab-bar-tab-inactive)
,(or ,(or
(cdr (assq 'binding tab)) (alist-get 'binding tab)
`(lambda () `(lambda ()
(interactive) (interactive)
(tab-bar-select-tab ,i))) (tab-bar-select-tab ,i)))
@ -432,7 +434,7 @@ Return its existing value or a new value."
`((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
menu-item "" menu-item ""
,(or ,(or
(cdr (assq 'close-binding tab)) (alist-get 'close-binding tab)
`(lambda () `(lambda ()
(interactive) (interactive)
(tab-bar-close-tab ,i))))))) (tab-bar-close-tab ,i)))))))
@ -464,12 +466,12 @@ Return its existing value or a new value."
(defun tab-bar--tab (&optional frame) (defun tab-bar--tab (&optional frame)
(let* ((tab (assq 'current-tab (frame-parameter frame 'tabs))) (let* ((tab (assq 'current-tab (frame-parameter frame 'tabs)))
(tab-explicit-name (cdr (assq 'explicit-name tab))) (tab-explicit-name (alist-get 'explicit-name tab))
(bl (seq-filter #'buffer-live-p (frame-parameter frame 'buffer-list))) (bl (seq-filter #'buffer-live-p (frame-parameter frame 'buffer-list)))
(bbl (seq-filter #'buffer-live-p (frame-parameter frame 'buried-buffer-list)))) (bbl (seq-filter #'buffer-live-p (frame-parameter frame 'buried-buffer-list))))
`(tab `(tab
(name . ,(if tab-explicit-name (name . ,(if tab-explicit-name
(cdr (assq 'name tab)) (alist-get 'name tab)
(funcall tab-bar-tab-name-function))) (funcall tab-bar-tab-name-function)))
(explicit-name . ,tab-explicit-name) (explicit-name . ,tab-explicit-name)
(time . ,(float-time)) (time . ,(float-time))
@ -487,10 +489,10 @@ Return its existing value or a new value."
;; necessary when switching tabs, otherwise the destination tab ;; necessary when switching tabs, otherwise the destination tab
;; inherit the current tab's `explicit-name` parameter. ;; inherit the current tab's `explicit-name` parameter.
(let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs)))) (let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs))))
(tab-explicit-name (cdr (assq 'explicit-name tab)))) (tab-explicit-name (alist-get 'explicit-name tab)))
`(current-tab `(current-tab
(name . ,(if tab-explicit-name (name . ,(if tab-explicit-name
(cdr (assq 'name tab)) (alist-get 'name tab)
(funcall tab-bar-tab-name-function))) (funcall tab-bar-tab-name-function)))
(explicit-name . ,tab-explicit-name)))) (explicit-name . ,tab-explicit-name))))
@ -504,7 +506,7 @@ Return its existing value or a new value."
(defun tab-bar--tab-index-by-name (name &optional tabs frame) (defun tab-bar--tab-index-by-name (name &optional tabs frame)
(seq-position (or tabs (funcall tab-bar-tabs-function frame)) (seq-position (or tabs (funcall tab-bar-tabs-function frame))
name (lambda (a b) (equal (cdr (assq 'name a)) b)))) name (lambda (a b) (equal (alist-get 'name a) b))))
(defun tab-bar--tab-index-recent (nth &optional tabs frame) (defun tab-bar--tab-index-recent (nth &optional tabs frame)
(let* ((tabs (or tabs (funcall tab-bar-tabs-function frame))) (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame)))
@ -514,7 +516,7 @@ Return its existing value or a new value."
(defun tab-bar--tabs-recent (&optional tabs frame) (defun tab-bar--tabs-recent (&optional tabs frame)
(let* ((tabs (or tabs (funcall tab-bar-tabs-function frame)))) (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame))))
(seq-sort-by (lambda (tab) (cdr (assq 'time tab))) #'> (seq-sort-by (lambda (tab) (alist-get 'time tab)) #'>
(seq-remove (lambda (tab) (seq-remove (lambda (tab)
(eq (car tab) 'current-tab)) (eq (car tab) 'current-tab))
tabs)))) tabs))))
@ -538,8 +540,8 @@ to the numeric argument. ARG counts from 1."
(unless (eq from-index to-index) (unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab)) (let* ((from-tab (tab-bar--tab))
(to-tab (nth to-index tabs)) (to-tab (nth to-index tabs))
(wc (cdr (assq 'wc to-tab))) (wc (alist-get 'wc to-tab))
(ws (cdr (assq 'ws to-tab)))) (ws (alist-get 'ws to-tab)))
;; During the same session, use window-configuration to switch ;; During the same session, use window-configuration to switch
;; tabs, because window-configurations are more reliable ;; tabs, because window-configurations are more reliable
@ -549,11 +551,11 @@ to the numeric argument. ARG counts from 1."
;; so restore its saved window-state. ;; so restore its saved window-state.
(cond (cond
((window-configuration-p wc) ((window-configuration-p wc)
(let ((wc-point (cdr (assq 'wc-point to-tab))) (let ((wc-point (alist-get 'wc-point to-tab))
(wc-bl (seq-filter #'buffer-live-p (cdr (assq 'wc-bl to-tab)))) (wc-bl (seq-filter #'buffer-live-p (alist-get 'wc-bl to-tab)))
(wc-bbl (seq-filter #'buffer-live-p (cdr (assq 'wc-bbl to-tab)))) (wc-bbl (seq-filter #'buffer-live-p (alist-get 'wc-bbl to-tab)))
(wc-history-back (cdr (assq 'wc-history-back to-tab))) (wc-history-back (alist-get 'wc-history-back to-tab))
(wc-history-forward (cdr (assq 'wc-history-forward to-tab)))) (wc-history-forward (alist-get 'wc-history-forward to-tab)))
(set-window-configuration wc) (set-window-configuration wc)
@ -573,11 +575,11 @@ to the numeric argument. ARG counts from 1."
(when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl)) (when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl))
(puthash (selected-frame) (puthash (selected-frame)
(and (window-configuration-p (cdr (assq 'wc (car wc-history-back)))) (and (window-configuration-p (alist-get 'wc (car wc-history-back)))
wc-history-back) wc-history-back)
tab-bar-history-back) tab-bar-history-back)
(puthash (selected-frame) (puthash (selected-frame)
(and (window-configuration-p (cdr (assq 'wc (car wc-history-forward)))) (and (window-configuration-p (alist-get 'wc (car wc-history-forward)))
wc-history-forward) wc-history-forward)
tab-bar-history-forward))) tab-bar-history-forward)))
@ -626,7 +628,7 @@ to the numeric argument. ARG counts from 1."
"Switch to the tab by NAME." "Switch to the tab by NAME."
(interactive (interactive
(let* ((recent-tabs (mapcar (lambda (tab) (let* ((recent-tabs (mapcar (lambda (tab)
(cdr (assq 'name tab))) (alist-get 'name tab))
(tab-bar--tabs-recent)))) (tab-bar--tabs-recent))))
(list (completing-read "Switch to tab by name (default recent): " (list (completing-read "Switch to tab by name (default recent): "
recent-tabs nil nil nil nil recent-tabs)))) recent-tabs nil nil nil nil recent-tabs))))
@ -908,7 +910,7 @@ for the last tab on a frame is determined by
(interactive (interactive
(list (completing-read "Close tab by name: " (list (completing-read "Close tab by name: "
(mapcar (lambda (tab) (mapcar (lambda (tab)
(cdr (assq 'name tab))) (alist-get 'name tab))
(funcall tab-bar-tabs-function))))) (funcall tab-bar-tabs-function)))))
(tab-bar-close-tab (1+ (tab-bar--tab-index-by-name name)))) (tab-bar-close-tab (1+ (tab-bar--tab-index-by-name name))))
@ -947,14 +949,14 @@ for the last tab on a frame is determined by
(interactive) (interactive)
;; Pop out closed tabs that were on already deleted frames ;; Pop out closed tabs that were on already deleted frames
(while (and tab-bar-closed-tabs (while (and tab-bar-closed-tabs
(not (frame-live-p (cdr (assq 'frame (car tab-bar-closed-tabs)))))) (not (frame-live-p (alist-get 'frame (car tab-bar-closed-tabs)))))
(pop tab-bar-closed-tabs)) (pop tab-bar-closed-tabs))
(if tab-bar-closed-tabs (if tab-bar-closed-tabs
(let* ((closed (pop tab-bar-closed-tabs)) (let* ((closed (pop tab-bar-closed-tabs))
(frame (cdr (assq 'frame closed))) (frame (alist-get 'frame closed))
(index (cdr (assq 'index closed))) (index (alist-get 'index closed))
(tab (cdr (assq 'tab closed)))) (tab (alist-get 'tab closed)))
(unless (eq frame (selected-frame)) (unless (eq frame (selected-frame))
(select-frame-set-input-focus frame)) (select-frame-set-input-focus frame))
@ -978,7 +980,7 @@ function `tab-bar-tab-name-function'."
(interactive (interactive
(let* ((tabs (funcall tab-bar-tabs-function)) (let* ((tabs (funcall tab-bar-tabs-function))
(tab-index (or current-prefix-arg (1+ (tab-bar--current-tab-index tabs)))) (tab-index (or current-prefix-arg (1+ (tab-bar--current-tab-index tabs))))
(tab-name (cdr (assq 'name (nth (1- tab-index) tabs))))) (tab-name (alist-get 'name (nth (1- tab-index) tabs))))
(list (read-from-minibuffer (list (read-from-minibuffer
"New name for tab (leave blank for automatic naming): " "New name for tab (leave blank for automatic naming): "
nil nil nil nil tab-name) nil nil nil nil tab-name)
@ -992,8 +994,8 @@ function `tab-bar-tab-name-function'."
(tab-new-name (if tab-explicit-name (tab-new-name (if tab-explicit-name
name name
(funcall tab-bar-tab-name-function)))) (funcall tab-bar-tab-name-function))))
(setf (cdr (assq 'name tab-to-rename)) tab-new-name (setf (alist-get 'name tab-to-rename) tab-new-name
(cdr (assq 'explicit-name tab-to-rename)) tab-explicit-name) (alist-get 'explicit-name tab-to-rename) tab-explicit-name)
(force-mode-line-update) (force-mode-line-update)
(unless tab-bar-mode (unless tab-bar-mode
@ -1006,7 +1008,7 @@ function `tab-bar-tab-name-function'."
(interactive (interactive
(let ((tab-name (completing-read "Rename tab by name: " (let ((tab-name (completing-read "Rename tab by name: "
(mapcar (lambda (tab) (mapcar (lambda (tab)
(cdr (assq 'name tab))) (alist-get 'name tab))
(funcall tab-bar-tabs-function))))) (funcall tab-bar-tabs-function)))))
(list tab-name (read-from-minibuffer (list tab-name (read-from-minibuffer
"New name for tab (leave blank for automatic naming): " "New name for tab (leave blank for automatic naming): "
@ -1059,8 +1061,8 @@ function `tab-bar-tab-name-function'."
(interactive) (interactive)
(setq tab-bar-history-omit t) (setq tab-bar-history-omit t)
(let* ((history (pop (gethash (selected-frame) tab-bar-history-back))) (let* ((history (pop (gethash (selected-frame) tab-bar-history-back)))
(wc (cdr (assq 'wc history))) (wc (alist-get 'wc history))
(wc-point (cdr (assq 'wc-point history)))) (wc-point (alist-get 'wc-point history)))
(if (window-configuration-p wc) (if (window-configuration-p wc)
(progn (progn
(puthash (selected-frame) (puthash (selected-frame)
@ -1076,8 +1078,8 @@ function `tab-bar-tab-name-function'."
(interactive) (interactive)
(setq tab-bar-history-omit t) (setq tab-bar-history-omit t)
(let* ((history (pop (gethash (selected-frame) tab-bar-history-forward))) (let* ((history (pop (gethash (selected-frame) tab-bar-history-forward)))
(wc (cdr (assq 'wc history))) (wc (alist-get 'wc history))
(wc-point (cdr (assq 'wc-point history)))) (wc-point (alist-get 'wc-point history)))
(if (window-configuration-p wc) (if (window-configuration-p wc)
(progn (progn
(puthash (selected-frame) (puthash (selected-frame)
@ -1175,8 +1177,8 @@ For more information, see the function `tab-switcher'."
(eq (car tab) 'current-tab)) (eq (car tab) 'current-tab))
(funcall tab-bar-tabs-function))) (funcall tab-bar-tabs-function)))
;; Sort by recency ;; Sort by recency
(tabs (sort tabs (lambda (a b) (< (cdr (assq 'time b)) (tabs (sort tabs (lambda (a b) (< (alist-get 'time b)
(cdr (assq 'time a))))))) (alist-get 'time a))))))
(with-current-buffer (get-buffer-create (with-current-buffer (get-buffer-create
(format " *Tabs*<%s>" (or (frame-parameter nil 'window-id) (format " *Tabs*<%s>" (or (frame-parameter nil 'window-id)
(frame-parameter nil 'name)))) (frame-parameter nil 'name))))
@ -1192,7 +1194,7 @@ For more information, see the function `tab-switcher'."
(format "%s %s\n" (format "%s %s\n"
(make-string tab-switcher-column ?\040) (make-string tab-switcher-column ?\040)
(propertize (propertize
(cdr (assq 'name tab)) (alist-get 'name tab)
'mouse-face 'highlight 'mouse-face 'highlight
'help-echo "mouse-2: select this window configuration")) 'help-echo "mouse-2: select this window configuration"))
'tab tab))) 'tab tab)))
@ -1393,7 +1395,7 @@ selected frame and no others."
(lambda (tab) (lambda (tab)
(when (if (eq (car tab) 'current-tab) (when (if (eq (car tab) 'current-tab)
(get-buffer-window buffer frame) (get-buffer-window buffer frame)
(let* ((state (cdr (assq 'ws tab))) (let* ((state (alist-get 'ws tab))
(buffers (when state (buffers (when state
(window-state-buffers state)))) (window-state-buffers state))))
(or (or