tab-bar.el 51.5 KB
Newer Older
1
;;; tab-bar.el --- frame-local tabs with named persistent window configurations -*- lexical-binding: t; -*-
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

;; Copyright (C) 2019 Free Software Foundation, Inc.

;; 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
54
  '((((type x w32 ns) (class color))
55
     :inherit variable-pitch
56 57
     :background "grey85"
     :foreground "black")
58
    (((type x) (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 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108

(defcustom tab-bar-select-tab-modifiers '()
  "List of key modifiers for selecting a tab by its index digit.
Possible modifiers are `control', `meta', `shift', `hyper', `super' and
`alt'."
  :type '(set :tag "Tab selection key modifiers"
              (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")

109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124

(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)))))
125 126 127

  (when (and tab-bar-mode (not (get-text-property 0 'display tab-bar-new-button)))
    ;; This file is pre-loaded so only here we can use the right data-directory:
128 129 130 131 132 133
    (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))
134 135 136

  (when (and tab-bar-mode (not (get-text-property 0 'display tab-bar-close-button)))
    ;; This file is pre-loaded so only here we can use the right data-directory:
137 138 139 140 141 142
    (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))
143

144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
  (if tab-bar-mode
      (progn
        (when tab-bar-select-tab-modifiers
          (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)]))))
165

166
(defun tab-bar-handle-mouse (event)
167 168
  "Text-mode emulation of switching tabs on the tab bar.
This command is used when you click the mouse in the tab bar
169 170 171 172 173 174 175 176 177 178 179
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
                 (lambda (_key binding)
                   (when (eq (car-safe binding) 'menu-item)
                     (when (> (+ column (length (nth 1 binding))) x-position)
180
                       ;; TODO: handle close
181
                       (unless (get-text-property (- x-position column) 'close-tab (nth 1 binding))
182
                         (call-interactively (nth 2 binding)))
183
                       (throw 'done t))
184
                     (setq column (+ column (length (nth 1 binding))))))
185 186
                 keymap))
        ;; Clicking anywhere outside existing tabs will add a new tab
Juri Linkov's avatar
Juri Linkov committed
187
        (tab-bar-new-tab)))))
188

189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
;; 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)))))


218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
(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
keyboard commands `tab-list', `tab-new', `tab-close', `tab-next', etc."
  :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)
235 236
                  (and (natnump val)
                       (> (length (funcall tab-bar-tabs-function)) val)))
237 238 239 240
              1 -1)))
  :group 'tab-bar
  :version "27.1")

Juri Linkov's avatar
Juri Linkov committed
241 242 243 244 245
(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).
246 247 248 249
If the value is a string, use it as a buffer name switch to a buffer
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
250 251 252
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)
253
                 (string    :tag "Buffer" "*scratch*")
Juri Linkov's avatar
Juri Linkov committed
254 255 256 257 258 259
                 (directory :tag "Directory" :value "~/")
                 (file      :tag "File" :value "~/.emacs")
                 (function  :tag "Function")
                 (const     :tag "Duplicate tab" nil))
  :group 'tab-bar
  :version "27.1")
260

261
(defvar tab-bar-new-button " + "
262 263
  "Button for creating a new tab.")

Juri Linkov's avatar
Juri Linkov committed
264 265 266 267 268 269 270 271 272 273
(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))
274
  :initialize 'custom-initialize-default
Juri Linkov's avatar
Juri Linkov committed
275
  :set (lambda (sym val)
276
         (set-default sym val)
Juri Linkov's avatar
Juri Linkov committed
277 278 279 280 281
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

(defvar tab-bar-close-button
282
  (propertize " x"
283
              'close-tab t
284 285
              :help "Click to close tab")
  "Button for closing the clicked tab.")
286

287 288 289 290 291 292
(defvar tab-bar-back-button " < "
  "Button for going back in tab history.")

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

293 294 295 296 297 298 299 300 301 302 303
(defcustom tab-bar-tab-hints nil
  "Show absolute numbers on tabs in the tab bar before the tab name.
This helps to select the tab by its number using `tab-bar-select-tab'."
  :type 'boolean
  :initialize 'custom-initialize-default
  :set (lambda (sym val)
         (set-default sym val)
         (force-mode-line-update))
  :group 'tab-bar
  :version "27.1")

Juri Linkov's avatar
Juri Linkov committed
304 305 306
(defvar tab-bar-separator nil)


307
(defcustom tab-bar-tab-name-function #'tab-bar-tab-name-current
Juri Linkov's avatar
Juri Linkov committed
308 309
  "Function to get a tab name.
Function gets no arguments.
310 311 312
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."
313 314 315 316 317 318
  :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)
                 (const :tag "All window buffers"
                        tab-bar-tab-name-all)
319 320 321 322 323 324 325 326
                 (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")

327 328
(defun tab-bar-tab-name-current ()
  "Generate tab name from the buffer of the selected window."
329
  (buffer-name (window-buffer (minibuffer-selected-window))))
330 331

(defun tab-bar-tab-name-current-with-count ()
332 333
  "Generate tab name from the buffer of the selected window.
Also add the number of windows in the window configuration."
334 335
  (let ((count (length (window-list-1 nil 'nomini)))
        (name (window-buffer (minibuffer-selected-window))))
336
    (if (> count 1)
337 338
        (format "%s (%d)" name count)
      (format "%s" name))))
Juri Linkov's avatar
Juri Linkov committed
339

340
(defun tab-bar-tab-name-all ()
341
  "Generate tab name from buffers of all windows."
Juri Linkov's avatar
Juri Linkov committed
342 343 344 345 346
  (mapconcat #'buffer-name
             (delete-dups (mapcar #'window-buffer
                                  (window-list-1 (frame-first-window)
                                                 'nomini)))
             ", "))
347

348

349 350 351 352
(defvar tab-bar-tabs-function #'tab-bar-tabs
  "Function to get a list of tabs to display in the tab bar.
This function should return a list of alists with parameters
that include at least the element (name . TAB-NAME).
353
For example, \\='((tab (name . \"Tab 1\")) (current-tab (name . \"Tab 2\")))
354 355
By default, use function `tab-bar-tabs'.")

356 357 358
(defun tab-bar-tabs ()
  "Return a list of tabs belonging to the selected frame.
Ensure the frame parameter `tabs' is pre-populated.
359
Update the current tab name when it exists.
360 361
Return its existing value or a new value."
  (let ((tabs (frame-parameter nil 'tabs)))
362 363 364 365 366 367 368 369 370
    (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
371
      ;; Create default tabs
372
      (setq tabs (list (tab-bar--current-tab)))
373 374 375
      (set-frame-parameter nil 'tabs tabs))
    tabs))

376

377 378
(defun tab-bar-make-keymap-1 ()
  "Generate an actual keymap from `tab-bar-map', without caching."
379 380
  (let* ((separator (or tab-bar-separator (if window-system " " "|")))
         (i 0)
381
         (tabs (funcall tab-bar-tabs-function)))
382
    (append
383
     '(keymap (mouse-1 . tab-bar-handle-mouse))
384 385 386 387 388 389 390 391 392
     (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")))
393 394 395
     (mapcan
      (lambda (tab)
        (setq i (1+ i))
396
        (append
397
         `((,(intern (format "sep-%i" i)) menu-item ,separator ignore))
398 399 400 401
         (cond
          ((eq (car tab) 'current-tab)
           `((current-tab
              menu-item
402 403
              ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
                                   (cdr (assq 'name tab))
Juri Linkov's avatar
Juri Linkov committed
404 405 406 407
                                   (or (and tab-bar-close-button-show
                                            (not (eq tab-bar-close-button-show
                                                     'non-selected))
                                            tab-bar-close-button) ""))
408 409 410 411 412 413
                           'face 'tab-bar-tab)
              ignore
              :help "Current tab")))
          (t
           `((,(intern (format "tab-%i" i))
              menu-item
414 415
              ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
                                   (cdr (assq 'name tab))
Juri Linkov's avatar
Juri Linkov committed
416 417 418 419
                                   (or (and tab-bar-close-button-show
                                            (not (eq tab-bar-close-button-show
                                                     'selected))
                                            tab-bar-close-button) ""))
420
                           'face 'tab-bar-tab-inactive)
Juri Linkov's avatar
Juri Linkov committed
421 422
              ,(or
                (cdr (assq 'binding tab))
423 424 425
                `(lambda ()
                   (interactive)
                   (tab-bar-select-tab ,i)))
426 427 428
              :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
429 430
            ,(or
              (cdr (assq 'close-binding tab))
431 432 433 434
              `(lambda ()
                 (interactive)
                 (tab-bar-close-tab ,i)))))))
      tabs)
Juri Linkov's avatar
Juri Linkov committed
435
     (when tab-bar-new-button
436
       `((sep-add-tab menu-item ,separator ignore)
Juri Linkov's avatar
Juri Linkov committed
437
         (add-tab menu-item ,tab-bar-new-button tab-bar-new-tab
438
                  :help "New tab"))))))
439 440


441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459
;; 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)

460
(defun tab-bar--tab ()
461
  (let* ((tab (assq 'current-tab (frame-parameter nil 'tabs)))
462 463 464
         (tab-explicit-name (cdr (assq 'explicit-name tab)))
         (bl  (seq-filter #'buffer-live-p (frame-parameter nil 'buffer-list)))
         (bbl (seq-filter #'buffer-live-p (frame-parameter nil 'buried-buffer-list))))
465 466 467 468 469 470
    `(tab
      (name . ,(if tab-explicit-name
                   (cdr (assq 'name tab))
                 (funcall tab-bar-tab-name-function)))
      (explicit-name . ,tab-explicit-name)
      (time . ,(time-convert nil 'integer))
471 472
      (ws . ,(window-state-get
              (frame-root-window (selected-frame)) 'writable))
473
      (wc . ,(current-window-configuration))
474 475 476 477
      (wc-point . ,(point-marker))
      (wc-bl . ,bl)
      (wc-bbl . ,bbl)
      (wc-history-back . ,(gethash (selected-frame) tab-bar-history-back))
478
      (wc-history-forward . ,(gethash (selected-frame) tab-bar-history-forward)))))
479 480 481 482 483 484 485 486 487 488 489 490

(defun tab-bar--current-tab (&optional tab)
  ;; `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.
  (let* ((tab (or tab (assq 'current-tab (frame-parameter nil 'tabs))))
         (tab-explicit-name (cdr (assq 'explicit-name tab))))
    `(current-tab
      (name . ,(if tab-explicit-name
                   (cdr (assq 'name tab))
                 (funcall tab-bar-tab-name-function)))
      (explicit-name . ,tab-explicit-name))))
491 492

(defun tab-bar--current-tab-index (&optional tabs)
493 494
  (seq-position (or tabs (funcall tab-bar-tabs-function))
                'current-tab (lambda (a b) (eq (car a) b))))
495

496
(defun tab-bar--tab-index (tab &optional tabs)
497 498
  (seq-position (or tabs (funcall tab-bar-tabs-function))
                tab))
499 500

(defun tab-bar--tab-index-by-name (name &optional tabs)
501 502
  (seq-position (or tabs (funcall tab-bar-tabs-function))
                name (lambda (a b) (equal (cdr (assq 'name a)) b))))
503

504 505 506 507 508 509 510 511 512 513
(defun tab-bar--tab-index-recent (nth &optional tabs)
  (let* ((tabs (or tabs (funcall tab-bar-tabs-function)))
         (sorted-tabs
          (seq-sort-by (lambda (tab) (cdr (assq 'time tab))) #'>
                       (seq-remove (lambda (tab)
                                     (eq (car tab) 'current-tab))
                                   tabs)))
         (tab (nth (1- nth) sorted-tabs)))
    (tab-bar--tab-index tab tabs)))

514 515 516 517 518 519 520 521 522 523 524 525 526

(defun tab-bar-select-tab (&optional arg)
  "Switch to the tab by its absolute position ARG in the tab bar.
When this command is bound to a numeric key (with a prefix or modifier),
calling it without an argument will translate its bound numeric key
to the numeric argument.  ARG counts from 1."
  (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))))

527
  (let* ((tabs (funcall tab-bar-tabs-function))
528 529 530 531 532 533
         (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))
             (wc (cdr (assq 'wc to-tab)))
534
             (ws (cdr (assq 'ws to-tab))))
535 536 537 538 539 540 541

        ;; 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.
542 543 544 545 546 547 548 549
        (cond
         ((window-configuration-p wc)
          (let ((wc-point (cdr (assq 'wc-point to-tab)))
                (wc-bl  (seq-filter #'buffer-live-p (cdr (assq 'wc-bl to-tab))))
                (wc-bbl (seq-filter #'buffer-live-p (cdr (assq 'wc-bbl to-tab))))
                (wc-history-back (cdr (assq 'wc-history-back to-tab)))
                (wc-history-forward (cdr (assq 'wc-history-forward to-tab))))

550
            (set-window-configuration wc)
551 552 553 554 555 556 557 558 559

            ;; 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.
560
                       ;; Maybe better to save dired-filename in each window?
561 562 563
                       (not (eq 1 (marker-position wc-point))))
              (goto-char wc-point))

564 565
            (when wc-bl  (set-frame-parameter nil 'buffer-list wc-bl))
            (when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl))
566 567 568 569 570 571 572 573 574 575 576

            (puthash (selected-frame)
                     (and (window-configuration-p (cdr (assq 'wc (car wc-history-back))))
                          wc-history-back)
                     tab-bar-history-back)
            (puthash (selected-frame)
                     (and (window-configuration-p (cdr (assq 'wc (car wc-history-forward))))
                          wc-history-forward)
                     tab-bar-history-forward)))

         (ws
577
          (window-state-put ws (frame-root-window (selected-frame)) 'safe)))
578

579 580
        (setq tab-bar-history-omit t)

581 582
        (when from-index
          (setf (nth from-index tabs) from-tab))
583
        (setf (nth to-index tabs) (tab-bar--current-tab (nth to-index tabs))))
584

585
      (force-mode-line-update))))
586

587
(defun tab-bar-switch-to-next-tab (&optional arg)
588 589
  "Switch to ARGth next tab."
  (interactive "p")
590 591
  (unless (integerp arg)
    (setq arg 1))
592
  (let* ((tabs (funcall tab-bar-tabs-function))
593 594 595 596 597 598 599 600 601 602 603
         (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)))

604 605 606 607 608 609 610 611 612 613
(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"))))

614 615 616 617 618
(defun tab-bar-switch-to-tab (name)
  "Switch to the tab by NAME."
  (interactive (list (completing-read "Switch to tab by name: "
                                      (mapcar (lambda (tab)
                                                (cdr (assq 'name tab)))
619
                                              (funcall tab-bar-tabs-function)))))
620
  (tab-bar-select-tab (1+ (tab-bar--tab-index-by-name name))))
621

622 623
(defalias 'tab-bar-select-tab-by-name 'tab-bar-switch-to-tab)

624

625 626
(defun tab-bar-move-tab-to (to-index &optional from-index)
  "Move tab from FROM-INDEX position to new position at TO-INDEX.
627 628 629 630
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))
631 632
         (from-index (or from-index (1+ (tab-bar--current-tab-index tabs))))
         (from-tab (nth (1- from-index) tabs))
633
         (to-index (max 0 (min (1- (or to-index 1)) (1- (length tabs))))))
634 635
    (setq tabs (delq from-tab tabs))
    (cl-pushnew from-tab (nthcdr to-index tabs))
636 637
    (set-frame-parameter nil 'tabs tabs)
    (force-mode-line-update)))
638 639 640 641 642 643 644 645

(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))))
646
    (tab-bar-move-tab-to (1+ to-index) (1+ from-index))))
647

648

Juri Linkov's avatar
Juri Linkov committed
649
(defcustom tab-bar-new-tab-to 'right
650 651 652 653 654 655 656 657 658
  "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.
If `rightmost', create as the last tab."
  :type '(choice (const :tag "First tab" leftmost)
                 (const :tag "To the left" left)
                 (const :tag "To the right" right)
                 (const :tag "Last tab" rightmost))
Juri Linkov's avatar
Juri Linkov committed
659
  :group 'tab-bar
660 661
  :version "27.1")

662 663 664 665 666
(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
a new tab at the position specified by `tab-bar-new-tab-to'."
  (interactive "P")
667
  (let* ((tabs (funcall tab-bar-tabs-function))
668 669 670
         (from-index (tab-bar--current-tab-index tabs))
         (from-tab (tab-bar--tab)))

Juri Linkov's avatar
Juri Linkov committed
671 672
    (when tab-bar-new-tab-choice
      (delete-other-windows)
673 674 675
      ;; 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
676 677 678 679 680 681 682 683
      (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))))
684 685 686 687

    (when from-index
      (setf (nth from-index tabs) from-tab))
    (let ((to-tab (tab-bar--current-tab))
688 689 690 691 692 693
          (to-index (or (if to-index (1- to-index))
                        (pcase tab-bar-new-tab-to
                          ('leftmost 0)
                          ('rightmost (length tabs))
                          ('left (1- (or from-index 1)))
                          ('right (1+ (or from-index 0)))))))
694 695 696 697 698 699 700 701 702 703 704
      (setq to-index (max 0 (min (or to-index 0) (length tabs))))
      (cl-pushnew to-tab (nthcdr to-index tabs))
      (when (eq to-index 0)
        ;; pushnew handles the head of tabs but not frame-parameter
        (set-frame-parameter nil 'tabs tabs)))

    (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))
705 706 707

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

710 711 712 713 714 715 716 717 718 719 720 721
(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)))

722

723 724 725
(defvar tab-bar-closed-tabs nil
  "A list of closed tabs to be able to undo their closing.")

726
(defcustom tab-bar-close-tab-select 'recent
727 728
  "Defines what tab to select after closing the specified tab.
If `left', select the adjacent left tab.
729 730
If `right', select the adjacent right tab.
If `recent', select the most recently visited tab."
731
  :type '(choice (const :tag "Select left tab" left)
732 733
                 (const :tag "Select right tab" right)
                 (const :tag "Select recent tab" recent))
Juri Linkov's avatar
Juri Linkov committed
734
  :group 'tab-bar
735 736
  :version "27.1")

737 738 739
(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.
740 741
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.
742 743
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)
744 745
                 (const    :tag "Close the containing frame" delete-frame)
                 (const    :tag "Disable tab-bar-mode" tab-bar-mode-disable)
746 747 748 749
                 (function :tag "Function"))
  :group 'tab-bar
  :version "27.1")

750 751 752 753 754 755 756 757 758 759
(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.
TO-INDEX counts from 1."
  (interactive "P")
760
  (let* ((tabs (funcall tab-bar-tabs-function))
761 762
         (current-index (tab-bar--current-tab-index tabs))
         (close-index (if (integerp arg) (1- arg) current-index)))
763
    (if (= 1 (length tabs))
764 765 766 767 768 769 770 771 772 773 774 775 776
        (pcase tab-bar-close-last-tab-choice
          ('nil
           (signal '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
777
      (when (eq current-index close-index)
778
        ;; Select another tab before deleting the current tab
779 780 781 782 783
        (let ((to-index (or (if to-index (1- to-index))
                            (pcase tab-bar-close-tab-select
                              ('left (1- current-index))
                              ('right (if (> (length tabs) (1+ current-index))
                                          (1+ current-index)
784 785
                                        (1- current-index)))
                              ('recent (tab-bar--tab-index-recent 1 tabs))))))
786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807
          (setq to-index (max 0 (min (or to-index 0) (1- (length tabs)))))
          (tab-bar-select-tab (1+ to-index))
          ;; 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))

      (force-mode-line-update)
      (unless tab-bar-mode
        (message "Deleted tab and switched to %s" tab-bar-close-tab-select)))))
808 809 810 811 812 813

(defun tab-bar-close-tab-by-name (name)
  "Close the tab by NAME."
  (interactive (list (completing-read "Close tab by name: "
                                      (mapcar (lambda (tab)
                                                (cdr (assq 'name tab)))
814
                                              (funcall tab-bar-tabs-function)))))
815
  (tab-bar-close-tab (1+ (tab-bar--tab-index-by-name name))))
816

817
(defun tab-bar-close-other-tabs ()
818 819
  "Close all tabs on the selected frame, except the selected one."
  (interactive)
820
  (let* ((tabs (funcall tab-bar-tabs-function))
821 822
         (current-index (tab-bar--current-tab-index tabs)))
    (when current-index
823 824 825 826 827 828
      (dotimes (index (length tabs))
        (unless (eq index current-index)
          (push `((frame . ,(selected-frame))
                  (index . ,index)
                  (tab . ,(nth index tabs)))
                tab-bar-closed-tabs)))
829
      (set-frame-parameter nil 'tabs (list (nth current-index tabs)))
830

831 832 833 834
      (when (and tab-bar-mode
                 (and (natnump tab-bar-show)
                      (<= 1 tab-bar-show)))
        (tab-bar-mode -1))
835 836 837

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

840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865
(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
              (not (frame-live-p (cdr (assq 'frame (car tab-bar-closed-tabs))))))
    (pop tab-bar-closed-tabs))

  (if tab-bar-closed-tabs
      (let* ((closed (pop tab-bar-closed-tabs))
             (frame (cdr (assq 'frame closed)))
             (index (cdr (assq 'index closed)))
             (tab (cdr (assq 'tab closed))))
        (unless (eq frame (selected-frame))
          (select-frame-set-input-focus frame))

        (let ((tabs (tab-bar-tabs)))
          (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")))

866

867 868 869 870 871 872
(defun tab-bar-rename-tab (name &optional arg)
  "Rename the tab specified by its absolute position ARG.
If no ARG is specified, then rename the current tab.
ARG counts from 1.
If NAME is the empty string, then use the automatic name
function `tab-bar-tab-name-function'."
873 874 875 876
  (interactive
   (let* ((tabs (funcall tab-bar-tabs-function))
          (tab-index (or current-prefix-arg (1+ (tab-bar--current-tab-index tabs))))
          (tab-name (cdr (assq 'name (nth (1- tab-index) tabs)))))
877 878 879
     (list (read-from-minibuffer
            "New name for tab (leave blank for automatic naming): "
            nil nil nil nil tab-name)
880
           current-prefix-arg)))
881
  (let* ((tabs (funcall tab-bar-tabs-function))
882 883 884 885 886 887 888 889 890
         (tab-index (if arg
                        (1- (max 0 (min arg (length tabs))))
                      (tab-bar--current-tab-index tabs)))
         (tab-to-rename (nth tab-index tabs))
         (tab-explicit-name (> (length name) 0))
         (tab-new-name (if tab-explicit-name
                           name
                         (funcall tab-bar-tab-name-function))))
    (setf (cdr (assq 'name tab-to-rename)) tab-new-name
891
          (cdr (assq 'explicit-name tab-to-rename)) tab-explicit-name)
892 893 894

    (force-mode-line-update)
    (unless tab-bar-mode
895 896 897 898 899 900
      (message "Renamed tab to '%s'" tab-new-name))))

(defun tab-bar-rename-tab-by-name (tab-name new-name)
  "Rename the tab named TAB-NAME.
If NEW-NAME is the empty string, then use the automatic name
function `tab-bar-tab-name-function'."
901 902 903 904 905
  (interactive
   (let ((tab-name (completing-read "Rename tab by name: "
                                    (mapcar (lambda (tab)
                                              (cdr (assq 'name tab)))
                                            (funcall tab-bar-tabs-function)))))
906 907 908
     (list tab-name (read-from-minibuffer
                     "New name for tab (leave blank for automatic naming): "
                     nil nil nil nil tab-name))))
909
  (tab-bar-rename-tab new-name (1+ (tab-bar--tab-index-by-name tab-name))))
910

911 912 913

;;; Tab history mode

914
(defvar tab-bar-history-limit 10
915 916
  "The number of history elements to keep.")

917 918 919 920 921 922 923 924 925
(defvar tab-bar-history-omit nil
  "When non-nil, omit window-configuration changes from the current command.")

(defvar tab-bar-history-back (make-hash-table)
  "History of back changes in every tab per frame.")

(defvar tab-bar-history-forward (make-hash-table)
  "History of forward changes in every tab per frame.")

926
(defvar tab-bar-history-old nil
927 928
  "Window configuration before the current command.")

929
(defvar tab-bar-history-old-minibuffer-depth 0
930
  "Minibuffer depth before the current command.")
931

932
(defun tab-bar-history--pre-change ()
933
  (setq tab-bar-history-old-minibuffer-depth (minibuffer-depth))
934
  ;; Store wc before possibly entering the minibuffer
935 936
  (when (zerop tab-bar-history-old-minibuffer-depth)
    (setq tab-bar-history-old
937 938
          `((wc . ,(current-window-configuration))
            (wc-point . ,(point-marker))))))
939

940
(defun tab-bar--history-change ()
941
  (when (and (not tab-bar-history-omit)
942
             tab-bar-history-old
943
             ;; Store wc before possibly entering the minibuffer
944
             (zerop tab-bar-history-old-minibuffer-depth))
945
    (puthash (selected-frame)
946
             (seq-take (cons tab-bar-history-old
947 948 949
                             (gethash (selected-frame) tab-bar-history-back))
                       tab-bar-history-limit)
             tab-bar-history-back))
950 951 952 953 954 955
  (when tab-bar-history-omit
    (setq tab-bar-history-omit nil)))

(defun tab-bar-history-back ()
  (interactive)
  (setq tab-bar-history-omit t)
956 957 958
  (let* ((history (pop (gethash (selected-frame) tab-bar-history-back)))
         (wc (cdr (assq 'wc history)))
         (wc-point (cdr (assq 'wc-point history))))
959 960 961
    (if (window-configuration-p wc)
        (progn
          (puthash (selected-frame)
962
                   (cons tab-bar-history-old
963
                         (gethash (selected-frame) tab-bar-history-forward))
964 965 966 967
                   tab-bar-history-forward)
          (set-window-configuration wc)
          (when (and (markerp wc-point) (marker-buffer wc-point))
            (goto-char wc-point)))
968 969 970 971 972
      (message "No more tab back history"))))

(defun tab-bar-history-forward ()
  (interactive)
  (setq tab-bar-history-omit t)
973 974 975
  (let* ((history (pop (gethash (selected-frame) tab-bar-history-forward)))
         (wc (cdr (assq 'wc history)))
         (wc-point (cdr (assq 'wc-point history))))
976 977 978
    (if (window-configuration-p wc)
        (progn
          (puthash (selected-frame)
979
                   (cons tab-bar-history-old
980
                         (gethash (selected-frame) tab-bar-history-back))
981 982 983 984
                   tab-bar-history-back)
          (set-window-configuration wc)
          (when (and (markerp wc-point) (marker-buffer wc-point))
            (goto-char wc-point)))
985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008
      (message "No more tab forward history"))))

(define-minor-mode tab-bar-history-mode
  "Toggle tab history mode for the tab bar."
  :global t
  (if tab-bar-history-mode
      (progn
        (when (and tab-bar-mode (not (get-text-property 0 'display tab-bar-back-button)))
          ;; This file is pre-loaded so only here we can use the right data-directory:
          (add-text-properties 0 (length tab-bar-back-button)
                               `(display (image :type xpm
                                                :file "tabs/left-arrow.xpm"
                                                :margin (2 . 0)
                                                :ascent center))
                               tab-bar-back-button))
        (when (and tab-bar-mode (not (get-text-property 0 'display tab-bar-forward-button)))
          ;; This file is pre-loaded so only here we can use the right data-directory:
          (add-text-properties 0 (length tab-bar-forward-button)
                               `(display (image :type xpm
                                                :file "tabs/right-arrow.xpm"
                                                :margin (2 . 0)
                                                :ascent center))
                               tab-bar-forward-button))

1009 1010 1011 1012
        (add-hook 'pre-command-hook 'tab-bar-history--pre-change)
        (add-hook 'window-configuration-change-hook 'tab-bar--history-change))
    (remove-hook 'pre-command-hook 'tab-bar-history--pre-change)
    (remove-hook 'window-configuration-change-hook 'tab-bar--history-change)))
1013

1014

1015
;;; Short aliases
1016

1017
(defalias 'tab-new         'tab-bar-new-tab)
1018
(defalias 'tab-new-to      'tab-bar-new-tab-to)
1019
(defalias 'tab-close       'tab-bar-close-tab)
1020
(defalias 'tab-close-other 'tab-bar-close-other-tabs)
1021
(defalias 'tab-undo        'tab-bar-undo-close-tab)
1022 1023 1024
(defalias 'tab-select      'tab-bar-select-tab)
(defalias 'tab-next        'tab-bar-switch-to-next-tab)
(defalias 'tab-previous    'tab-bar-switch-to-prev-tab)
1025
(defalias 'tab-recent      'tab-bar-switch-to-recent-tab)
1026
(defalias 'tab-move        'tab-bar-move-tab)
1027
(defalias 'tab-move-to     'tab-bar-move-tab-to)
1028 1029
(defalias 'tab-rename      'tab-bar-rename-tab)
(defalias 'tab-list        'tab-bar-list)
1030 1031 1032


;;; Non-graphical access to frame-local tabs (named window configurations)
1033 1034 1035 1036

(defun tab-bar-list ()
  "Display a list of named window configurations.
The list is displayed in the buffer `*Tabs*'.
1037 1038
It's placed in the center of the frame to resemble a window list
displayed by a window switcher in some window managers on Alt+Tab.
1039 1040 1041 1042 1043

In this list of window configurations you can delete or select them.
Type ? after invocation to get help on commands available.
Type q to remove the list of window configurations from the display.

1044
The first column shows `D' for a window configuration you have
1045 1046 1047 1048
marked for deletion."
  (interactive)
  (let ((dir default-directory)
        (minibuf (minibuffer-selected-window)))
1049
    (let ((tab-bar-show nil)) ; don't enable tab-bar-mode if it's disabled
Juri Linkov's avatar
Juri Linkov committed
1050
      (tab-bar-new-tab))
1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068
    ;; Handle the case when it's called in the active minibuffer.
    (when minibuf (select-window (minibuffer-selected-window)))
    (delete-other-windows)
    ;; Create a new window to replace the existing one, to not break the
    ;; window parameters (e.g. prev/next buffers) of the window just saved
    ;; to the window configuration.  So when a saved window is restored,
    ;; its parameters left intact.
    (split-window) (delete-window)
    (let ((switch-to-buffer-preserve-window-point nil))
      (switch-to-buffer (tab-bar-list-noselect)))
    (setq default-directory dir))
  (message "Commands: d, x; RET; q to quit; ? for help."))

(defun tab-bar-list-noselect ()
  "Create and return a buffer with a list of window configurations.
The list is displayed in a buffer named `*Tabs*'.

For more information, see the function `tab-bar-list'."
1069 1070 1071
  (let* ((tabs (seq-remove (lambda (tab)
                             (eq (car tab) 'current-tab))
                           (funcall tab-bar-tabs-function)))
1072 1073 1074 1075 1076 1077
         ;; Sort by recency
         (tabs (sort tabs (lambda (a b) (< (cdr (assq 'time b))
                                           (cdr (assq 'time a)))))))
    (with-current-buffer (get-buffer-create
                          (format " *Tabs*<%s>" (or (frame-parameter nil 'window-id)
                                                    (frame-parameter nil 'name))))
1078
      (setq buffer-read-only nil)
1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099
      (erase-buffer)
      (tab-bar-list-mode)
      ;; Vertical alignment to the center of the frame
      (insert-char ?\n (/ (- (frame-height) (length tabs) 1) 2))
      ;; Horizontal alignment to the center of the frame
      (setq tab-bar-list-column (- (/ (frame-width) 2) 15))
      (dolist (tab tabs)
        (insert (propertize
                 (format "%s %s\n"
                         (make-string tab-bar-list-column ?\040)
                         (propertize
                          (cdr (assq 'name tab))
                          'mouse-face 'highlight
                          'help-echo "mouse-2: select this window configuration"))
                 'tab tab)))
      (goto-char (point-min))
      (goto-char (or (next-single-property-change (point) 'tab) (point-min)))
      (when (> (length tabs) 1)
        (tab-bar-list-next-line))
      (move-to-column tab-bar-list-column)
      (set-buffer-modified-p nil)
1100
      (setq buffer-read-only t)
1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139
      (current-buffer))))

(defvar tab-bar-list-column 3)
(make-variable-buffer-local 'tab-bar-list-column)

(defvar tab-bar-list-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map t)
    (define-key map "q"    'quit-window)
    (define-key map "\C-m" 'tab-bar-list-select)
    (define-key map "d"    'tab-bar-list-delete)
    (define-key map "k"    'tab-bar-list-delete)
    (define-key map "\C-d" 'tab-bar-list-delete-backwards)
    (define-key map "\C-k" 'tab-bar-list-delete)
    (define-key map "x"    'tab-bar-list-execute)
    (define-key map " "    'tab-bar-list-next-line)
    (define-key map "n"    'tab-bar-list-next-line)
    (define-key map "p"    'tab-bar-list-prev-line)
    (define-key map "\177" 'tab-bar-list-backup-unmark)
    (define-key map "?"    'describe-mode)
    (define-key map "u"    'tab-bar-list-unmark)
    (define-key map [mouse-2] 'tab-bar-list-mouse-select)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap for `tab-bar-list-mode' buffers.")

(define-derived-mode tab-bar-list-mode nil "Window Configurations"
  "Major mode for selecting a window configuration.
Each line describes one window configuration in Emacs.
Letters do not insert themselves; instead, they are commands.
\\<tab-bar-list-mode-map>
\\[tab-bar-list-mouse-select] -- select window configuration you click on.
\\[tab-bar-list-select] -- select current line's window configuration.
\\[tab-bar-list-delete] -- mark that window configuration to be deleted, and move down.
\\[tab-bar-list-delete-backwards] -- mark that window configuration to be deleted, and move up.
\\[tab-bar-list-execute] -- delete marked window configurations.
\\[tab-bar-list-unmark] -- remove all kinds of marks from current line.
  With prefix argument, also move up one line.
\\[tab-bar-list-backup-unmark] -- back up a line and remove marks."
1140
  (setq truncate-lines t))
1141 1142 1143 1144

(defun tab-bar-list-current-tab (error-if-non-existent-p)
  "Return window configuration described by this line of the list."
  (let* ((where (save-excursion
Juri Linkov's avatar
Juri Linkov committed
1145 1146 1147
                  (beginning-of-line)
                  (+ 2 (point) tab-bar-list-column)))
         (tab (and (not (eobp)) (get-text-property where 'tab))))
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212
    (or tab
        (if error-if-non-existent-p
            (user-error "No window configuration on this line")
          nil))))

(defun tab-bar-list-next-line (&optional arg)
  (interactive)
  (forward-line arg)
  (beginning-of-line)
  (move-to-column tab-bar-list-column))

(defun tab-bar-list-prev-line (&optional arg)
  (interactive)
  (forward-line (- arg))
  (beginning-of-line)
  (move-to-column tab-bar-list-column))

(defun tab-bar-list-unmark (&optional backup)
  "Cancel all requested operations on window configuration on this line and move down.
Optional prefix arg means move up."
  (interactive "P")
  (beginning-of-line)
  (move-to-column tab-bar-list-column)
  (let* ((buffer-read-only nil))
    (delete-char 1)
    (insert " "))
  (forward-line (if backup -1 1))
  (move-to-column tab-bar-list-column))

(defun tab-bar-list-backup-unmark ()
  "Move up and cancel all requested operations on window configuration on line above."
  (interactive)
  (forward-line -1)
  (tab-bar-list-unmark)
  (forward-line -1)
  (move-to-column tab-bar-list-column))

(defun tab-bar-list-delete (&optional arg)
  "Mark window configuration on this line to be deleted by \\<tab-bar-list-mode-map>\\[tab-bar-list-execute] command.
Prefix arg is how many window configurations to delete.
Negative arg means delete backwards."
  (interactive "p")
  (let ((buffer-read-only nil))
    (if (or (null arg) (= arg 0))
        (setq arg 1))
    (while (> arg 0)
      (delete-char 1)
      (insert ?D)
      (forward-line 1)
      (setq arg (1- arg)))
    (while (< arg 0)
      (delete-char 1)
      (insert ?D)
      (forward-line -1)
      (setq arg (1+ arg)))
    (move-to-column tab-bar-list-column)))

(defun tab-bar-list-delete-backwards (&optional arg)
  "Mark window configuration on this line to be deleted by \\<tab-bar-list-mode-map>\\[tab-bar-list-execute] command.
Then move up one line.  Prefix arg means move that many lines."
  (interactive "p")
  (tab-bar-list-delete (- (or arg 1))))

(defun tab-bar-list-delete-from-list (tab)
  "Delete the window configuration from both lists."
1213
  (set-frame-parameter nil 'tabs (delq tab (funcall tab-bar-tabs-function))))
1214 1215 1216 1217 1218 1219 1220 1221 1222 1223

(defun tab-bar-list-execute ()
  "Delete window configurations marked with \\<tab-bar-list-mode-map>\\[tab-bar-list-delete] commands."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((buffer-read-only nil))
      (while (re-search-forward
              (format "^%sD" (make-string tab-bar-list-column ?\040))
              nil t)
Juri Linkov's avatar
Juri Linkov committed
1224 1225 1226
        (forward-char -1)
        (let ((tab (tab-bar-list-current-tab nil)))
          (when tab
1227 1228 1229 1230 1231
            (tab-bar-list-delete-from-list tab)
            (beginning-of-line)
            (delete-region (point) (progn (forward-line 1) (point))))))))
  (beginning-of-line)
  (move-to-column tab-bar-list-column)
1232
  (force-mode-line-update))
1233 1234 1235 1236 1237 1238

(defun tab-bar-list-select ()
  "Select this line's window configuration.
This command deletes and replaces all the previously existing windows
in the selected frame."
  (interactive)
1239
  (let* ((to-tab (tab-bar-list-current-tab t)))
1240 1241
    (kill-buffer (current-buffer))
    ;; Delete the current window configuration
1242
    (tab-bar-close-tab nil (1+ (tab-bar--tab-index to-tab)))))
1243 1244 1245 1246 1247 1248 1249 1250

(defun tab-bar-list-mouse-select (event)
  "Select the window configuration whose line you click on."
  (interactive "e")
  (set-buffer (window-buffer (posn-window (event-end event))))
  (goto-char (posn-point (event-end event)))
  (tab-bar-list-select))

1251 1252 1253 1254 1255 1256

(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
  "Switch to buffer BUFFER-OR-NAME in another tab.
Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab."
  (interactive
   (list (read-buffer-to-switch "Switch to buffer in other tab: ")))
1257 1258
  (let ((tab-bar-new-tab-choice t))
    (tab-bar-new-tab))
1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269
  (delete-other-windows)
  (switch-to-buffer buffer-or-name norecord))

(defun find-file-other-tab (filename &optional wildcards)
  "Edit file FILENAME, in another tab.
Like \\[find-file-other-frame] (which see), but creates a new tab."
  (interactive
   (find-file-read-args "Find file in other tab: "
                        (confirm-nonexistent-file-or-buffer)))
  (let ((value (find-file-noselect filename nil nil wildcards)))
    (if (listp value)
Juri Linkov's avatar
Juri Linkov committed
1270 1271 1272 1273 1274
        (progn
          (setq value (nreverse value))
          (switch-to-buffer-other-tab (car value))
          (mapc 'switch-to-buffer (cdr value))
          value)
1275 1276
      (switch-to-buffer-other-tab value))))

1277 1278 1279 1280 1281 1282 1283 1284
(define-key tab-prefix-map "2" 'tab-new)
(define-key tab-prefix-map "1" 'tab-close-other)
(define-key tab-prefix-map "0" 'tab-close)
(define-key tab-prefix-map "o" 'tab-next)
(define-key tab-prefix-map "b" 'switch-to-buffer-other-tab)
(define-key tab-prefix-map "f" 'find-file-other-tab)
(define-key tab-prefix-map "\C-f" 'find-file-other-tab)
(define-key tab-prefix-map "r" 'tab-rename)
1285 1286 1287 1288 1289


(provide 'tab-bar)

;;; tab-bar.el ends here