tab-bar.el 64.5 KB
Newer Older
1
;;; tab-bar.el --- frame-local tabs with named persistent window configurations -*- lexical-binding: t; -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

;; Author: Juri Linkov <juri@linkov.net>
;; Keywords: frames tabs
;; Maintainer: emacs-devel@gnu.org

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

26
;; Provides `tab-bar-mode' to control display of the tab bar and
27 28 29 30 31 32 33 34 35 36
;; bindings for the global tab bar.

;; The normal global binding for [tab-bar] (below) uses the value of
;; `tab-bar-map' as the actual keymap to define the tab bar.  Modes
;; may either bind items under the [tab-bar] prefix key of the local
;; map to add to the global bar or may set `tab-bar-map'
;; buffer-locally to override it.

;;; Code:

37 38 39
(eval-when-compile
  (require 'cl-lib)
  (require 'seq))
40

41 42

(defgroup tab-bar nil
43
  "Frame-local tabs."
44 45 46 47 48 49 50 51 52 53
  :group 'convenience
  :version "27.1")

(defgroup tab-bar-faces nil
  "Faces used in the tab bar."
  :group 'tab-bar
  :group 'faces
  :version "27.1")

(defface tab-bar
Juri Linkov's avatar
Juri Linkov committed
54
  '((((class color) (min-colors 88))
55
     :inherit variable-pitch
56 57
     :background "grey85"
     :foreground "black")
Juri Linkov's avatar
Juri Linkov committed
58
    (((class mono))
59 60 61
     :background "grey")
    (t
     :inverse-video t))
62 63 64 65 66
  "Tab bar face."
  :version "27.1"
  :group 'tab-bar-faces)

(defface tab-bar-tab
67 68 69
  '((default
      :inherit tab-bar)
    (((class color) (min-colors 88))
70
     :box (:line-width 1 :style released-button))
71
    (t
72
     :inverse-video nil))
73 74 75 76 77
  "Tab bar face for selected tab."
  :version "27.1"
  :group 'tab-bar-faces)

(defface tab-bar-tab-inactive
78 79 80 81
  '((default
      :inherit tab-bar-tab)
    (((class color) (min-colors 88))
     :background "grey75")
82
    (t
83
     :inverse-video t))
84 85 86 87
  "Tab bar face for non-selected tab."
  :version "27.1"
  :group 'tab-bar-faces)

88 89

(defcustom tab-bar-select-tab-modifiers '()
90 91 92 93 94
  "List of modifier keys for selecting a tab by its index digit.
Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
`alt'.  To help you to select a tab by its number, you can customize
`tab-bar-tab-hints' that will show tab numbers alongside the tab name."
  :type '(set :tag "Tab selection modifier keys"
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
              (const control)
              (const meta)
              (const shift)
              (const hyper)
              (const super)
              (const alt))
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         ;; Reenable the tab-bar with new keybindings
         (tab-bar-mode -1)
         (tab-bar-mode 1))
  :group 'tab-bar
  :version "27.1")

110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125

(define-minor-mode tab-bar-mode
  "Toggle the tab bar in all graphical frames (Tab Bar mode)."
  :global t
  ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
  :variable tab-bar-mode
  (let ((val (if tab-bar-mode 1 0)))
    (dolist (frame (frame-list))
      (set-frame-parameter frame 'tab-bar-lines val))
    ;; If the user has given `default-frame-alist' a `tab-bar-lines'
    ;; parameter, replace it.
    (if (assq 'tab-bar-lines default-frame-alist)
        (setq default-frame-alist
              (cons (cons 'tab-bar-lines val)
                    (assq-delete-all 'tab-bar-lines
                                     default-frame-alist)))))
126

127 128
  (when (and tab-bar-mode tab-bar-new-button
             (not (get-text-property 0 'display tab-bar-new-button)))
129
    ;; This file is pre-loaded so only here we can use the right data-directory:
130 131 132 133 134 135
    (add-text-properties 0 (length tab-bar-new-button)
                         `(display (image :type xpm
                                          :file "tabs/new.xpm"
                                          :margin (2 . 0)
                                          :ascent center))
                         tab-bar-new-button))
136

137 138
  (when (and tab-bar-mode tab-bar-close-button
             (not (get-text-property 0 'display tab-bar-close-button)))
139
    ;; This file is pre-loaded so only here we can use the right data-directory:
140 141 142 143 144 145
    (add-text-properties 0 (length tab-bar-close-button)
                         `(display (image :type xpm
                                          :file "tabs/close.xpm"
                                          :margin (2 . 0)
                                          :ascent center))
                         tab-bar-close-button))
146

147 148 149
  (if tab-bar-mode
      (progn
        (when tab-bar-select-tab-modifiers
150 151
          (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
                          'tab-bar-switch-to-recent-tab)
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
          (dotimes (i 9)
            (global-set-key (vector (append tab-bar-select-tab-modifiers
                                            (list (+ i 1 ?0))))
                            'tab-bar-select-tab)))
        ;; Don't override user customized key bindings
        (unless (global-key-binding [(control tab)])
          (global-set-key [(control tab)] 'tab-next))
        (unless (global-key-binding [(control shift tab)])
          (global-set-key [(control shift tab)] 'tab-previous))
        (unless (global-key-binding [(control shift iso-lefttab)])
          (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
    ;; Unset only keys bound by tab-bar
    (when (eq (global-key-binding [(control tab)]) 'tab-next)
      (global-unset-key [(control tab)]))
    (when (eq (global-key-binding [(control shift tab)]) 'tab-previous)
      (global-unset-key [(control shift tab)]))
    (when (eq (global-key-binding [(control shift iso-lefttab)]) 'tab-previous)
      (global-unset-key [(control shift iso-lefttab)]))))
170

171
(defun tab-bar-handle-mouse (event)
172 173
  "Text-mode emulation of switching tabs on the tab bar.
This command is used when you click the mouse in the tab bar
174 175 176 177 178 179 180 181
on a console which has no window system but does have a mouse."
  (interactive "e")
  (let* ((x-position (car (posn-x-y (event-start event))))
         (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps))) [tab-bar]))
         (column 0))
    (when x-position
      (unless (catch 'done
                (map-keymap
182
                 (lambda (key binding)
183 184
                   (when (eq (car-safe binding) 'menu-item)
                     (when (> (+ column (length (nth 1 binding))) x-position)
185 186 187 188 189
                       (if (get-text-property (- x-position column) 'close-tab (nth 1 binding))
                           (let* ((close-key (vector (intern (format "C-%s" key))))
                                  (close-def (lookup-key keymap close-key)))
                             (when close-def
                               (call-interactively close-def)))
190
                         (call-interactively (nth 2 binding)))
191
                       (throw 'done t))
192
                     (setq column (+ column (length (nth 1 binding))))))
193 194
                 keymap))
        ;; Clicking anywhere outside existing tabs will add a new tab
Juri Linkov's avatar
Juri Linkov committed
195
        (tab-bar-new-tab)))))
196

197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225
;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
(defun toggle-tab-bar-mode-from-frame (&optional arg)
  "Toggle tab bar on or off, based on the status of the current frame.
See `tab-bar-mode' for more information."
  (interactive (list (or current-prefix-arg 'toggle)))
  (if (eq arg 'toggle)
      (tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1))
    (tab-bar-mode arg)))

(defvar tab-bar-map (make-sparse-keymap)
  "Keymap for the tab bar.
Define this locally to override the global tab bar.")

(global-set-key [tab-bar]
                `(menu-item ,(purecopy "tab bar") ignore
                            :filter tab-bar-make-keymap))

(defconst tab-bar-keymap-cache (make-hash-table :weakness t :test 'equal))

(defun tab-bar-make-keymap (&optional _ignore)
  "Generate an actual keymap from `tab-bar-map'.
Its main job is to show tabs in the tab bar."
  (if (= 1 (length tab-bar-map))
      (tab-bar-make-keymap-1)
    (let ((key (cons (frame-terminal) tab-bar-map)))
      (or (gethash key tab-bar-keymap-cache)
          (puthash key tab-bar-map tab-bar-keymap-cache)))))


226 227 228 229 230 231 232 233
(defcustom tab-bar-show t
  "Defines when to show the tab bar.
If t, enable `tab-bar-mode' automatically on using the commands that
create new window configurations (e.g. `tab-new').
If the value is `1', then hide the tab bar when it has only one tab,
and show it again once more tabs are created.
If nil, always keep the tab bar hidden.  In this case it's still
possible to use persistent named window configurations by relying on
234
keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc."
235 236 237 238 239 240 241 242
  :type '(choice (const :tag "Always" t)
                 (const :tag "When more than one tab" 1)
                 (const :tag "Never" nil))
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         (tab-bar-mode
          (if (or (eq val t)
243 244
                  (and (natnump val)
                       (> (length (funcall tab-bar-tabs-function)) val)))
245 246 247 248
              1 -1)))
  :group 'tab-bar
  :version "27.1")

Juri Linkov's avatar
Juri Linkov committed
249 250 251 252 253
(defcustom tab-bar-new-tab-choice t
  "Defines what to show in a new tab.
If t, start a new tab with the current buffer, i.e. the buffer
that was current before calling the command that adds a new tab
(this is the same what `make-frame' does by default).
254
If the value is a string, use it as a buffer name to switch to
255 256 257
if such buffer exists, or switch to a buffer visiting the file or
directory that the string specifies.  If the value is a function,
call it with no arguments and switch to the buffer that it returns.
Juri Linkov's avatar
Juri Linkov committed
258 259 260
If nil, duplicate the contents of the tab that was active
before calling the command that adds a new tab."
  :type '(choice (const     :tag "Current buffer" t)
261
                 (string    :tag "Buffer" "*scratch*")
Juri Linkov's avatar
Juri Linkov committed
262 263 264 265 266 267
                 (directory :tag "Directory" :value "~/")
                 (file      :tag "File" :value "~/.emacs")
                 (function  :tag "Function")
                 (const     :tag "Duplicate tab" nil))
  :group 'tab-bar
  :version "27.1")
268

269
(defcustom tab-bar-new-button-show t
Eli Zaretskii's avatar
Eli Zaretskii committed
270 271
  "If non-nil, show the \"New tab\" button in the tab bar.
When this is nil, you can create new tabs with \\[tab-new]."
272 273 274 275 276 277 278 279
  :type 'boolean
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

280
(defvar tab-bar-new-button " + "
281 282
  "Button for creating a new tab.")

Juri Linkov's avatar
Juri Linkov committed
283 284 285 286 287 288 289 290 291 292
(defcustom tab-bar-close-button-show t
  "Defines where to show the close tab button.
If t, show the close tab button on all tabs.
If `selected', show it only on the selected tab.
If `non-selected', show it only on non-selected tab.
If nil, don't show it at all."
  :type '(choice (const :tag "On all tabs" t)
                 (const :tag "On selected tab" selected)
                 (const :tag "On non-selected tabs" non-selected)
                 (const :tag "None" nil))
293
  :initialize 'custom-initialize-default
Juri Linkov's avatar
Juri Linkov committed
294
  :set (lambda (sym val)
295
         (set-default sym val)
Juri Linkov's avatar
Juri Linkov committed
296 297 298 299 300
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

(defvar tab-bar-close-button
301
  (propertize " x"
302
              'close-tab t
303 304
              :help "Click to close tab")
  "Button for closing the clicked tab.")
305

306 307 308 309 310 311
(defvar tab-bar-back-button " < "
  "Button for going back in tab history.")

(defvar tab-bar-forward-button " > "
  "Button for going forward in tab history.")

312 313
(defcustom tab-bar-tab-hints nil
  "Show absolute numbers on tabs in the tab bar before the tab name.
314 315
This helps to select the tab by its number using `tab-bar-select-tab'
and `tab-bar-select-tab-modifiers'."
316 317 318 319 320 321 322 323
  :type 'boolean
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

324 325
(defvar tab-bar-separator nil
  "String that delimits tabs.")
Juri Linkov's avatar
Juri Linkov committed
326 327


328
(defcustom tab-bar-tab-name-function #'tab-bar-tab-name-current
Juri Linkov's avatar
Juri Linkov committed
329 330
  "Function to get a tab name.
Function gets no arguments.
331 332 333
The choice is between displaying only the name of the current buffer
in the tab name (default), or displaying the names of all buffers
from all windows in the window configuration."
334 335 336 337
  :type '(choice (const :tag "Selected window buffer"
                        tab-bar-tab-name-current)
                 (const :tag "Selected window buffer with window count"
                        tab-bar-tab-name-current-with-count)
338 339
                 (const :tag "Truncated buffer name"
                        tab-bar-tab-name-truncated)
340 341
                 (const :tag "All window buffers"
                        tab-bar-tab-name-all)
342 343 344 345 346 347 348 349
                 (function  :tag "Function"))
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

350 351
(defun tab-bar-tab-name-current ()
  "Generate tab name from the buffer of the selected window."
352
  (buffer-name (window-buffer (minibuffer-selected-window))))
353 354

(defun tab-bar-tab-name-current-with-count ()
355 356
  "Generate tab name from the buffer of the selected window.
Also add the number of windows in the window configuration."
357 358
  (let ((count (length (window-list-1 nil 'nomini)))
        (name (window-buffer (minibuffer-selected-window))))
359
    (if (> count 1)
360 361
        (format "%s (%d)" name count)
      (format "%s" name))))
Juri Linkov's avatar
Juri Linkov committed
362

363
(defun tab-bar-tab-name-all ()
364
  "Generate tab name from buffers of all windows."
Juri Linkov's avatar
Juri Linkov committed
365 366 367 368 369
  (mapconcat #'buffer-name
             (delete-dups (mapcar #'window-buffer
                                  (window-list-1 (frame-first-window)
                                                 'nomini)))
             ", "))
370

371 372 373 374 375 376 377 378
(defcustom tab-bar-tab-name-truncated-max 20
  "Maximum length of the tab name from the current buffer.
Effective when `tab-bar-tab-name-function' is customized
to `tab-bar-tab-name-truncated'."
  :type 'integer
  :group 'tab-bar
  :version "27.1")

379
(defvar tab-bar-tab-name-ellipsis nil)
380 381 382 383

(defun tab-bar-tab-name-truncated ()
  "Generate tab name from the buffer of the selected window.
Truncate it to the length specified by `tab-bar-tab-name-truncated-max'.
384
Append ellipsis `tab-bar-tab-name-ellipsis' in this case."
385 386 387 388 389
  (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
        (ellipsis (cond
                   (tab-bar-tab-name-ellipsis)
                   ((char-displayable-p ?) "…")
                   ("..."))))
390 391 392 393
    (if (< (length tab-name) tab-bar-tab-name-truncated-max)
        tab-name
      (propertize (truncate-string-to-width
                   tab-name tab-bar-tab-name-truncated-max nil nil
394
                   ellipsis)
395 396
                  'help-echo tab-name))))

397

398 399
(defvar tab-bar-tabs-function #'tab-bar-tabs
  "Function to get a list of tabs to display in the tab bar.
400 401 402
This function should have one optional argument FRAME,
defaulting to the selected frame when nil.
It should return a list of alists with parameters
403
that include at least the element (name . TAB-NAME).
404
For example, \\='((tab (name . \"Tab 1\")) (current-tab (name . \"Tab 2\")))
405 406
By default, use function `tab-bar-tabs'.")

407
(defun tab-bar-tabs (&optional frame)
408 409
  "Return a list of tabs belonging to the selected frame.
Ensure the frame parameter `tabs' is pre-populated.
410
Update the current tab name when it exists.
411
Return its existing value or a new value."
412
  (let ((tabs (frame-parameter frame 'tabs)))
413 414 415 416 417 418 419 420 421
    (if tabs
        (let* ((current-tab (assq 'current-tab tabs))
               (current-tab-name (assq 'name current-tab))
               (current-tab-explicit-name (assq 'explicit-name current-tab)))
          (when (and current-tab-name
                     current-tab-explicit-name
                     (not (cdr current-tab-explicit-name)))
            (setf (cdr current-tab-name)
                  (funcall tab-bar-tab-name-function))))
Juri Linkov's avatar
Juri Linkov committed
422
      ;; Create default tabs
423
      (setq tabs (list (tab-bar--current-tab)))
424
      (set-frame-parameter frame 'tabs tabs))
425 426
    tabs))

427

428 429
(defun tab-bar-make-keymap-1 ()
  "Generate an actual keymap from `tab-bar-map', without caching."
430 431
  (let* ((separator (or tab-bar-separator (if window-system " " "|")))
         (i 0)
432
         (tabs (funcall tab-bar-tabs-function)))
433
    (append
434
     '(keymap (mouse-1 . tab-bar-handle-mouse))
435 436 437 438 439 440 441 442 443
     (when tab-bar-history-mode
       `((sep-history-back menu-item ,separator ignore)
         (history-back
          menu-item ,tab-bar-back-button tab-bar-history-back
          :help "Click to go back in tab history")
         (sep-history-forward menu-item ,separator ignore)
         (history-forward
          menu-item ,tab-bar-forward-button tab-bar-history-forward
          :help "Click to go forward in tab history")))
444 445 446
     (mapcan
      (lambda (tab)
        (setq i (1+ i))
447
        (append
448
         `((,(intern (format "sep-%i" i)) menu-item ,separator ignore))
449 450 451 452
         (cond
          ((eq (car tab) 'current-tab)
           `((current-tab
              menu-item
453
              ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
454
                                   (alist-get 'name tab)
Juri Linkov's avatar
Juri Linkov committed
455 456 457 458
                                   (or (and tab-bar-close-button-show
                                            (not (eq tab-bar-close-button-show
                                                     'non-selected))
                                            tab-bar-close-button) ""))
459 460 461 462 463 464
                           'face 'tab-bar-tab)
              ignore
              :help "Current tab")))
          (t
           `((,(intern (format "tab-%i" i))
              menu-item
465
              ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
466
                                   (alist-get 'name tab)
Juri Linkov's avatar
Juri Linkov committed
467 468 469 470
                                   (or (and tab-bar-close-button-show
                                            (not (eq tab-bar-close-button-show
                                                     'selected))
                                            tab-bar-close-button) ""))
471
                           'face 'tab-bar-tab-inactive)
Juri Linkov's avatar
Juri Linkov committed
472
              ,(or
473
                (alist-get 'binding tab)
474 475 476
                `(lambda ()
                   (interactive)
                   (tab-bar-select-tab ,i)))
477 478 479
              :help "Click to visit tab"))))
         `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
            menu-item ""
Juri Linkov's avatar
Juri Linkov committed
480
            ,(or
481
              (alist-get 'close-binding tab)
482 483 484 485
              `(lambda ()
                 (interactive)
                 (tab-bar-close-tab ,i)))))))
      tabs)
486 487 488
     `((sep-add-tab menu-item ,separator ignore))
     (when (and tab-bar-new-button-show tab-bar-new-button)
       `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab
489
                  :help "New tab"))))))
490 491


492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510
;; Some window-configuration parameters don't need to be persistent.
;; Don't save to the desktop file such tab parameters that are saved
;; as "Unprintable entity" so can't be used after restoring the desktop.
;; Actually tab-bar-select-tab already can handle unprintable entities,
;; but it's better not to waste the desktop file with useless data.
(defun frameset-filter-tabs (current _filtered _parameters saving)
  (if saving
      (mapcar (lambda (current)
                (if (consp current)
                    (seq-reduce (lambda (current param)
                                  (assq-delete-all param current))
                                '(wc wc-point wc-bl wc-bbl wc-history-back wc-history-forward)
                                (copy-sequence current))
                  current))
              current)
    current))

(push '(tabs . frameset-filter-tabs) frameset-filter-alist)

511 512
(defun tab-bar--tab (&optional frame)
  (let* ((tab (assq 'current-tab (frame-parameter frame 'tabs)))
513
         (tab-explicit-name (alist-get 'explicit-name tab))
514 515
         (bl  (seq-filter #'buffer-live-p (frame-parameter frame 'buffer-list)))
         (bbl (seq-filter #'buffer-live-p (frame-parameter frame 'buried-buffer-list))))
516 517
    `(tab
      (name . ,(if tab-explicit-name
518
                   (alist-get 'name tab)
519 520
                 (funcall tab-bar-tab-name-function)))
      (explicit-name . ,tab-explicit-name)
521
      (time . ,(float-time))
522
      (ws . ,(window-state-get
523
              (frame-root-window (or frame (selected-frame))) 'writable))
524
      (wc . ,(current-window-configuration))
525 526 527
      (wc-point . ,(point-marker))
      (wc-bl . ,bl)
      (wc-bbl . ,bbl)
528 529
      (wc-history-back . ,(gethash (or frame (selected-frame)) tab-bar-history-back))
      (wc-history-forward . ,(gethash (or frame (selected-frame)) tab-bar-history-forward)))))
530

531
(defun tab-bar--current-tab (&optional tab frame)
532 533 534
  ;; `tab` here is an argument meaning 'use tab as template'. This is
  ;; necessary when switching tabs, otherwise the destination tab
  ;; inherit the current tab's `explicit-name` parameter.
535
  (let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs))))
536
         (tab-explicit-name (alist-get 'explicit-name tab)))
537 538
    `(current-tab
      (name . ,(if tab-explicit-name
539
                   (alist-get 'name tab)
540 541
                 (funcall tab-bar-tab-name-function)))
      (explicit-name . ,tab-explicit-name))))
542

543 544
(defun tab-bar--current-tab-index (&optional tabs frame)
  (seq-position (or tabs (funcall tab-bar-tabs-function frame))
545
                'current-tab (lambda (a b) (eq (car a) b))))
546

547 548 549
(defun tab-bar--tab-index (tab &optional tabs frame)
  (seq-position (or tabs (funcall tab-bar-tabs-function frame))
                tab #'eq))
550

551 552
(defun tab-bar--tab-index-by-name (name &optional tabs frame)
  (seq-position (or tabs (funcall tab-bar-tabs-function frame))
553
                name (lambda (a b) (equal (alist-get 'name a) b))))
554

555 556
(defun tab-bar--tab-index-recent (nth &optional tabs frame)
  (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame)))
557
         (sorted-tabs (tab-bar--tabs-recent tabs frame))
558 559 560
         (tab (nth (1- nth) sorted-tabs)))
    (tab-bar--tab-index tab tabs)))

561 562
(defun tab-bar--tabs-recent (&optional tabs frame)
  (let* ((tabs (or tabs (funcall tab-bar-tabs-function frame))))
563
    (seq-sort-by (lambda (tab) (alist-get 'time tab)) #'>
564 565 566 567
                 (seq-remove (lambda (tab)
                               (eq (car tab) 'current-tab))
                             tabs))))

568 569 570

(defun tab-bar-select-tab (&optional arg)
  "Switch to the tab by its absolute position ARG in the tab bar.
571 572 573 574
When this command is bound to a numeric key (with a prefix or modifier key
using `tab-bar-select-tab-modifiers'), calling it without an argument
will translate its bound numeric key to the numeric argument.
ARG counts from 1."
575 576 577 578 579 580 581
  (interactive "P")
  (unless (integerp arg)
    (let ((key (event-basic-type last-command-event)))
      (setq arg (if (and (characterp key) (>= key ?1) (<= key ?9))
                    (- key ?0)
                  1))))

582
  (let* ((tabs (funcall tab-bar-tabs-function))
583 584 585 586 587
         (from-index (tab-bar--current-tab-index tabs))
         (to-index (1- (max 1 (min arg (length tabs))))))
    (unless (eq from-index to-index)
      (let* ((from-tab (tab-bar--tab))
             (to-tab (nth to-index tabs))
588 589
             (wc (alist-get 'wc to-tab))
             (ws (alist-get 'ws to-tab)))
590 591 592 593 594 595 596

        ;; During the same session, use window-configuration to switch
        ;; tabs, because window-configurations are more reliable
        ;; (they keep references to live buffers) than window-states.
        ;; But after restoring tabs from a previously saved session,
        ;; its value of window-configuration is unreadable,
        ;; so restore its saved window-state.
597 598
        (cond
         ((window-configuration-p wc)
599 600 601 602 603
          (let ((wc-point (alist-get 'wc-point to-tab))
                (wc-bl  (seq-filter #'buffer-live-p (alist-get 'wc-bl to-tab)))
                (wc-bbl (seq-filter #'buffer-live-p (alist-get 'wc-bbl to-tab)))
                (wc-history-back (alist-get 'wc-history-back to-tab))
                (wc-history-forward (alist-get 'wc-history-forward to-tab)))
604

605
            (set-window-configuration wc)
606 607 608 609 610 611 612 613 614

            ;; set-window-configuration does not restore the value of
            ;; point in the current buffer, so restore it separately.
            (when (and (markerp wc-point)
                       (marker-buffer wc-point)
                       ;; FIXME: After dired-revert, marker relocates to 1.
                       ;; window-configuration restores point to global point
                       ;; in this dired buffer, not to its window point,
                       ;; but this is slightly better than 1.
615
                       ;; Maybe better to save dired-filename in each window?
616 617 618
                       (not (eq 1 (marker-position wc-point))))
              (goto-char wc-point))

619 620
            (when wc-bl  (set-frame-parameter nil 'buffer-list wc-bl))
            (when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl))
621 622

            (puthash (selected-frame)
623
                     (and (window-configuration-p (alist-get 'wc (car wc-history-back)))
624 625 626
                          wc-history-back)
                     tab-bar-history-back)
            (puthash (selected-frame)
627
                     (and (window-configuration-p (alist-get 'wc (car wc-history-forward)))
628 629 630 631
                          wc-history-forward)
                     tab-bar-history-forward)))

         (ws
632
          (window-state-put ws (frame-root-window (selected-frame)) 'safe)))
633

634 635
        (setq tab-bar-history-omit t)

636 637
        (when from-index
          (setf (nth from-index tabs) from-tab))
638 639 640 641
        (setf (nth to-index tabs) (tab-bar--current-tab (nth to-index tabs)))

        (unless tab-bar-mode
          (message "Selected tab '%s'" (alist-get 'name to-tab))))
642

643
      (force-mode-line-update))))
644

645
(defun tab-bar-switch-to-next-tab (&optional arg)
646 647
  "Switch to ARGth next tab."
  (interactive "p")
648 649
  (unless (integerp arg)
    (setq arg 1))
650
  (let* ((tabs (funcall tab-bar-tabs-function))
651 652 653 654 655 656 657 658 659 660 661
         (from-index (or (tab-bar--current-tab-index tabs) 0))
         (to-index (mod (+ from-index arg) (length tabs))))
    (tab-bar-select-tab (1+ to-index))))

(defun tab-bar-switch-to-prev-tab (&optional arg)
  "Switch to ARGth previous tab."
  (interactive "p")
  (unless (integerp arg)
    (setq arg 1))
  (tab-bar-switch-to-next-tab (- arg)))

662 663 664 665 666 667 668 669 670 671
(defun tab-bar-switch-to-recent-tab (&optional arg)
  "Switch to ARGth most recently visited tab."
  (interactive "p")
  (unless (integerp arg)
    (setq arg 1))
  (let ((tab-index (tab-bar--tab-index-recent arg)))
    (if tab-index
        (tab-bar-select-tab (1+ tab-index))
      (message "No more recent tabs"))))

672
(defun tab-bar-switch-to-tab (name)
673 674 675 676
  "Switch to the tab by NAME.
Default values are tab names sorted by recency, so you can use \
\\<minibuffer-local-map>\\[next-history-element]
to get the name of the last visited tab, the second last, and so on."
677 678
  (interactive
   (let* ((recent-tabs (mapcar (lambda (tab)
679
                                 (alist-get 'name tab))
680 681 682
                               (tab-bar--tabs-recent))))
     (list (completing-read "Switch to tab by name (default recent): "
                            recent-tabs nil nil nil nil recent-tabs))))
683
  (tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0))))
684

685 686
(defalias 'tab-bar-select-tab-by-name 'tab-bar-switch-to-tab)

687

688 689
(defun tab-bar-move-tab-to (to-index &optional from-index)
  "Move tab from FROM-INDEX position to new position at TO-INDEX.
690 691 692 693
FROM-INDEX defaults to the current tab index.
FROM-INDEX and TO-INDEX count from 1."
  (interactive "P")
  (let* ((tabs (funcall tab-bar-tabs-function))
694 695
         (from-index (or from-index (1+ (tab-bar--current-tab-index tabs))))
         (from-tab (nth (1- from-index) tabs))
696
         (to-index (max 0 (min (1- (or to-index 1)) (1- (length tabs))))))
697 698
    (setq tabs (delq from-tab tabs))
    (cl-pushnew from-tab (nthcdr to-index tabs))
699 700
    (set-frame-parameter nil 'tabs tabs)
    (force-mode-line-update)))
701 702 703 704 705 706 707 708

(defun tab-bar-move-tab (&optional arg)
  "Move the current tab ARG positions to the right.
If a negative ARG, move the current tab ARG positions to the left."
  (interactive "p")
  (let* ((tabs (funcall tab-bar-tabs-function))
         (from-index (or (tab-bar--current-tab-index tabs) 0))
         (to-index (mod (+ from-index arg) (length tabs))))
709
    (tab-bar-move-tab-to (1+ to-index) (1+ from-index))))
710

711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734
(defun tab-bar-move-tab-to-frame (arg &optional from-frame from-index to-frame to-index)
  "Move tab from FROM-INDEX position to new position at TO-INDEX.
FROM-INDEX defaults to the current tab index.
FROM-INDEX and TO-INDEX count from 1.
FROM-FRAME specifies the source frame and defaults to the selected frame.
TO-FRAME specifies the target frame and defaults the next frame.
Interactively, ARG selects the ARGth different frame to move to."
  (interactive "P")
  (unless from-frame
    (setq from-frame (selected-frame)))
  (unless to-frame
    (dotimes (_ (prefix-numeric-value arg))
      (setq to-frame (next-frame to-frame))))
  (unless (eq from-frame to-frame)
    (let* ((from-tabs (funcall tab-bar-tabs-function from-frame))
           (from-index (or from-index (1+ (tab-bar--current-tab-index from-tabs))))
           (from-tab (nth (1- from-index) from-tabs))
           (to-tabs (funcall tab-bar-tabs-function to-frame))
           (to-index (max 0 (min (1- (or to-index 1)) (1- (length to-tabs))))))
      (cl-pushnew (assq-delete-all
                   'wc (if (eq (car from-tab) 'current-tab)
                           (tab-bar--tab from-frame)
                         from-tab))
                  (nthcdr to-index to-tabs))
735 736 737 738
      (with-selected-frame from-frame
        (let ((inhibit-message t) ; avoid message about deleted tab
              tab-bar-closed-tabs)
          (tab-bar-close-tab from-index)))
739 740 741
      (set-frame-parameter to-frame 'tabs to-tabs)
      (force-mode-line-update t))))

742

Juri Linkov's avatar
Juri Linkov committed
743
(defcustom tab-bar-new-tab-to 'right
744 745 746 747
  "Defines where to create a new tab.
If `leftmost', create as the first tab.
If `left', create to the left from the current tab.
If `right', create to the right from the current tab.
748 749 750
If `rightmost', create as the last tab.
If the value is a function, it should return a number as a position
on the tab bar specifying where to insert a new tab."
751 752 753
  :type '(choice (const :tag "First tab" leftmost)
                 (const :tag "To the left" left)
                 (const :tag "To the right" right)
754 755
                 (const :tag "Last tab" rightmost)
                 (function :tag "Function"))
Juri Linkov's avatar
Juri Linkov committed
756
  :group 'tab-bar
757 758
  :version "27.1")

759 760 761 762 763 764 765 766 767
(defcustom tab-bar-tab-post-open-functions nil
  "List of functions to call after creating a new tab.
The current tab is supplied as an argument. Any modifications
made to the tab argument will be applied after all functions are
called."
  :type '(repeat function)
  :group 'tab-bar
  :version "27.1")

768 769 770
(defun tab-bar-new-tab-to (&optional to-index)
  "Add a new tab at the absolute position TO-INDEX.
TO-INDEX counts from 1.  If no TO-INDEX is specified, then add
771 772 773 774
a new tab at the position specified by `tab-bar-new-tab-to'.

After the tab is created, the hooks in
`tab-bar-tab-post-open-functions' are run."
775
  (interactive "P")
776
  (let* ((tabs (funcall tab-bar-tabs-function))
777 778 779
         (from-index (tab-bar--current-tab-index tabs))
         (from-tab (tab-bar--tab)))

Juri Linkov's avatar
Juri Linkov committed
780 781
    (when tab-bar-new-tab-choice
      (delete-other-windows)
782 783 784
      ;; Create a new window to get rid of old window parameters
      ;; (e.g. prev/next buffers) of old window.
      (split-window) (delete-window)
Juri Linkov's avatar
Juri Linkov committed
785 786 787 788 789 790 791 792
      (let ((buffer
             (if (functionp tab-bar-new-tab-choice)
                 (funcall tab-bar-new-tab-choice)
               (if (stringp tab-bar-new-tab-choice)
                   (or (get-buffer tab-bar-new-tab-choice)
                       (find-file-noselect tab-bar-new-tab-choice))))))
        (when (buffer-live-p buffer)
          (switch-to-buffer buffer))))
793 794 795 796

    (when from-index
      (setf (nth from-index tabs) from-tab))
    (let ((to-tab (tab-bar--current-tab))
797 798 799 800
          (to-index (or (if to-index (1- to-index))
                        (pcase tab-bar-new-tab-to
                          ('leftmost 0)
                          ('rightmost (length tabs))
801
                          ('left (or from-index 1))
802 803 804
                          ('right (1+ (or from-index 0)))
                          ((pred functionp)
                           (funcall tab-bar-new-tab-to))))))
805 806
      (setq to-index (max 0 (min (or to-index 0) (length tabs))))
      (cl-pushnew to-tab (nthcdr to-index tabs))
807

808 809
      (when (eq to-index 0)
        ;; pushnew handles the head of tabs but not frame-parameter
810 811 812 813
        (set-frame-parameter nil 'tabs tabs))

      (run-hook-with-args 'tab-bar-tab-post-open-functions
                          (nth to-index tabs)))
814 815 816 817 818 819

    (when (and (not tab-bar-mode)
               (or (eq tab-bar-show t)
                   (and (natnump tab-bar-show)
                        (> (length tabs) tab-bar-show))))
      (tab-bar-mode 1))
820 821 822

    (force-mode-line-update)
    (unless tab-bar-mode
823
      (message "Added new tab at %s" tab-bar-new-tab-to))))
824

825 826 827 828 829 830 831 832 833 834 835 836
(defun tab-bar-new-tab (&optional arg)
  "Create a new tab ARG positions to the right.
If a negative ARG, create a new tab ARG positions to the left.
If ARG is zero, create a new tab in place of the current tab."
  (interactive "P")
  (if arg
      (let* ((tabs (funcall tab-bar-tabs-function))
             (from-index (or (tab-bar--current-tab-index tabs) 0))
             (to-index (+ from-index (prefix-numeric-value arg))))
        (tab-bar-new-tab-to (1+ to-index)))
    (tab-bar-new-tab-to)))

837

838 839 840
(defvar tab-bar-closed-tabs nil
  "A list of closed tabs to be able to undo their closing.")

841
(defcustom tab-bar-close-tab-select 'recent
842 843
  "Defines what tab to select after closing the specified tab.
If `left', select the adjacent left tab.
844 845
If `right', select the adjacent right tab.
If `recent', select the most recently visited tab."
846
  :type '(choice (const :tag "Select left tab" left)
847 848
                 (const :tag "Select right tab" right)
                 (const :tag "Select recent tab" recent))
Juri Linkov's avatar
Juri Linkov committed
849
  :group 'tab-bar
850 851
  :version "27.1")

852 853 854
(defcustom tab-bar-close-last-tab-choice nil
  "Defines what to do when the last tab is closed.
If nil, do nothing and show a message, like closing the last window or frame.
855 856
If `delete-frame', delete the containing frame, as a web browser would do.
If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in the frame.
857 858
If the value is a function, call that function with the tab to be closed as an argument."
  :type '(choice (const    :tag "Do nothing and show message" nil)
859 860
                 (const    :tag "Close the containing frame" delete-frame)
                 (const    :tag "Disable tab-bar-mode" tab-bar-mode-disable)
861 862 863 864
                 (function :tag "Function"))
  :group 'tab-bar
  :version "27.1")

865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882
(defcustom tab-bar-tab-prevent-close-functions nil
  "List of functions to call to determine whether to close a tab.
The tab to be closed and a boolean indicating whether or not it
is the only tab in the frame are supplied as arguments. If any
function returns a non-nil value, the tab will not be closed."
  :type '(repeat function)
  :group 'tab-bar
  :version "27.1")

(defcustom tab-bar-tab-pre-close-functions nil
  "List of functions to call before closing a tab.
The tab to be closed and a boolean indicating whether or not it
is the only tab in the frame are supplied as arguments,
respectively."
  :type '(repeat function)
  :group 'tab-bar
  :version "27.1")

883 884 885 886 887 888 889 890
(defun tab-bar-close-tab (&optional arg to-index)
  "Close the tab specified by its absolute position ARG.
If no ARG is specified, then close the current tab and switch
to the tab specified by `tab-bar-close-tab-select'.
ARG counts from 1.
Optional TO-INDEX could be specified to override the value of
`tab-bar-close-tab-select' programmatically with a position
of an existing tab to select after closing the current tab.
891 892 893 894 895 896 897 898
TO-INDEX counts from 1.

The functions in `tab-bar-tab-prevent-close-functions' will be
run to determine whether or not to close the tab.
Just before the tab is closed, the functions in
`tab-bar-tab-pre-close-functions' will be run.  The base behavior
for the last tab on a frame is determined by
`tab-bar-close-last-tab-choice'."
899
  (interactive "P")
900
  (let* ((tabs (funcall tab-bar-tabs-function))
901
         (current-index (tab-bar--current-tab-index tabs))
902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931
         (close-index (if (integerp arg) (1- arg) current-index))
         (last-tab-p (= 1 (length tabs)))
         (prevent-close (run-hook-with-args-until-success
                         'tab-bar-tab-prevent-close-functions
                         (nth close-index tabs)
                         last-tab-p)))

    (unless prevent-close
      (run-hook-with-args 'tab-bar-tab-pre-close-functions
                          (nth close-index tabs)
                          last-tab-p)

      (if last-tab-p
          (pcase tab-bar-close-last-tab-choice
            ('nil
             (user-error "Attempt to delete the sole tab in a frame"))
            ('delete-frame
             (delete-frame))
            ('tab-bar-mode-disable
             (tab-bar-mode -1))
            ((pred functionp)
             ;; Give the handler function the full extent of the tab's
             ;; data, not just it's name and explicit-name flag.
             (funcall tab-bar-close-last-tab-choice (tab-bar--tab))))

        ;; More than one tab still open
        (when (eq current-index close-index)
          ;; Select another tab before deleting the current tab
          (let ((to-index (or (if to-index (1- to-index))
                              (pcase tab-bar-close-tab-select
932
                                ('left (1- (if (< current-index 1) 2 current-index)))
933 934 935 936 937
                                ('right (if (> (length tabs) (1+ current-index))
                                            (1+ current-index)
                                          (1- current-index)))
                                ('recent (tab-bar--tab-index-recent 1 tabs))))))
            (setq to-index (max 0 (min (or to-index 0) (1- (length tabs)))))
938 939
            (let ((inhibit-message t)) ; avoid message about selected tab
              (tab-bar-select-tab (1+ to-index)))
940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955
            ;; Re-read tabs after selecting another tab
            (setq tabs (funcall tab-bar-tabs-function))))

        (let ((close-tab (nth close-index tabs)))
          (push `((frame . ,(selected-frame))
                  (index . ,close-index)
                  (tab . ,(if (eq (car close-tab) 'current-tab)
                              (tab-bar--tab)
                            close-tab)))
                tab-bar-closed-tabs)
          (set-frame-parameter nil 'tabs (delq close-tab tabs)))

        (when (and tab-bar-mode
                   (and (natnump tab-bar-show)
                        (<= (length tabs) tab-bar-show)))
          (tab-bar-mode -1))
956

957 958 959
        (force-mode-line-update)
        (unless tab-bar-mode
          (message "Deleted tab and switched to %s" tab-bar-close-tab-select))))))
960 961 962

(defun tab-bar-close-tab-by-name (name)
  "Close the tab by NAME."
963 964 965
  (interactive
   (list (completing-read "Close tab by name: "
                          (mapcar (lambda (tab)
966
                                    (alist-get 'name tab))
967
                                  (funcall tab-bar-tabs-function)))))
968
  (tab-bar-close-tab (1+ (tab-bar--tab-index-by-name name))))
969

970
(defun tab-bar-close-other-tabs ()
971 972
  "Close all tabs on the selected frame, except the selected one."
  (interactive)
973
  (let* ((tabs (funcall tab-bar-tabs-function))
974 975
         (current-index (tab-bar--current-tab-index tabs)))
    (when current-index
976
      (dotimes (index (length tabs))
977 978 979 980 981 982 983
        (unless (or (eq index current-index)
                    (run-hook-with-args-until-success
                     'tab-bar-tab-prevent-close-functions
                     (nth index tabs)
                     ; last-tab-p logically can't ever be true if we
                     ; make it this far
                     nil))
984 985 986
          (push `((frame . ,(selected-frame))
                  (index . ,index)
                  (tab . ,(nth index tabs)))
987 988
                tab-bar-closed-tabs)
          (run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index tabs) nil)))
989
      (set-frame-parameter nil 'tabs (list (nth current-index tabs)))
990

991 992 993 994
      (when (and tab-bar-mode
                 (and (natnump tab-bar-show)
                      (<= 1 tab-bar-show)))
        (tab-bar-mode -1))
995 996 997

      (force-mode-line-update)
      (unless tab-bar-mode
998 999
        (message "Deleted all other tabs")))))

1000 1001 1002 1003 1004
(defun tab-bar-undo-close-tab ()
  "Restore the last closed tab."
  (interactive)
  ;; Pop out closed tabs that were on already deleted frames
  (while (and tab-bar-closed-tabs
1005
              (not (frame-live-p (alist-get 'frame (car tab-bar-closed-tabs)))))
1006 1007 1008 1009
    (pop tab-bar-closed-tabs))

  (if tab-bar-closed-tabs
      (let* ((closed (pop tab-bar-closed-tabs))
1010 1011 1012
             (frame (alist-get 'frame closed))
             (index (alist-get 'index closed))
             (tab (alist-get 'tab closed)))
1013 1014 1015
        (unless (eq frame (selected-frame))
          (select-frame-set-input-focus frame))

1016
        (let ((tabs (funcall tab-bar-tabs-function)))
1017 1018 1019 1020 1021 1022 1023 1024 1025
          (setq index (max 0 (min index (length tabs))))
          (cl-pushnew tab (nthcdr index tabs))
          (when (eq index 0)
            ;; pushnew handles the head of tabs but not frame-parameter
            (set-frame-parameter nil 'tabs tabs))
          (tab-bar-select-tab (1+ index))))

    (message "No more closed tabs to undo")))