Source

dotfiles / emacs.d / tabbar.el

Full commit
   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 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
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 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
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 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
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 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
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
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
1140
1141
1142
1143
1144
1145
1146
1147
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
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
;;; tabbar.el --- Display a tab bar in the header line

;; Copyright (C) 2003 David Ponce

;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
;; Created: 25 February 2003
;; Keywords: convenience
;; Revision: $Id: tabbar.el,v 1.20 2003/06/05 08:15:49 ponced Exp $

(defconst tabbar-version "1.3")

;; This file is not part of GNU Emacs.

;; This program 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 2, or (at
;; your option) any later version.

;; This program 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 this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;; This library provides a minor mode to display tabs in the header
;; line.  It works only on GNU Emacs 21.
;;
;; M-x `tabbar-mode' toggle the display of the tab bar, globally.
;;
;; M-x `tabbar-local-mode' toggle the display of the tab bar, locally
;; in the current buffer, when the global mode in on.  This mode
;; permit to see the tab bar in a buffer where the header line is
;; already used by another mode (like `info' buffers).  That command
;; is particularly useful when it is given a keyboard shortcut, like
;; this:
;;
;;   (global-set-key [(control f10)] 'tabbar-local-mode)
;;
;; It is possible to navigate through tabs using commands (that is,
;; using the keyboard).  The main commands to cycle through tabs are:
;;
;; - `tabbar-forward' select the next available tab.
;; - `tabbar-backward' select the previous available tab.
;;
;; It is worth defining keys for them.  For example: 
;;
;;   (global-set-key [(control shift tab)] 'tabbar-backward)
;;   (global-set-key [(control tab)]       'tabbar-forward)
;;
;; The default cycle is to first try to select the tab just
;; after/before the selected tab.  If this is the last/first tab, then
;; the first/last tab of the next/previous group of tabs is selected.
;; That behavior is controlled by the `tabbar-cycling-scope' option.
;;
;; The following specialized commands can be useful too:
;;
;; - `tabbar-forward-tab'/`tabbar-backward-tab'
;;      Navigate through visible tabs only.
;;
;; - `tabbar-forward-group'/`tabbar-backward-group'
;;      Navigate through tab groups only.
;;
;; Core
;; ----
;;
;; The content of the tab bar is represented by an internal data
;; structure: a tab set.  A tab set is a collection of tabs,
;; identified by an unique name.  In a tab set, at any time, one and
;; only one tab is designated as selected within the tab set.
;;
;; A tab is a simple data structure giving: the value of the tab, and
;; a reference to its tab set container.  A tab value can be any Lisp
;; object, even if the most common value is probably a string.  Each
;; tab object is guaranteed to be unique.
;;
;; A tab set is displayed on the tab bar through a "view" defined by
;; the index of the leftmost tab shown.  Thus, it is possible to
;; scroll the tab bar horizontally, by changing the start index of the
;; tab set view.
;;
;; The visual representation of a tab set is a list a
;; `header-line-format' template elements.  Each template element is
;; the visual representation of a tab.  When the visual representation
;; of a tab is required, the function specified in the variable
;; `tabbar-tab-label-function' is called to obtain a label (a text
;; representation) for that tab.  Also, the function specified in the
;; variable `tabbar-help-on-tab-function' is called when the mouse is
;; on a tab.  That function is passed the tab and can return a help
;; string to display.  Finally, when a tab is selected by clicking on
;; it, the function specified in the variable
;; `tabbar-select-tab-function' is called with the mouse event
;; received, and the tab.
;;
;; To increase performance, the tab set automatically maintains its
;; visual representation in a cache.  As far as possible, that cache
;; is used to display the tab set, and refreshed only when necessary.
;;
;; Several tab sets can be maintained at the same time.  Only one is
;; displayed on the tab bar, it is obtained by calling the function
;; specified in the variable `tabbar-current-tabset-function'.
;;
;; A special tab set is maintained, that contains the list of
;; currently selected tabs, in existing tab sets.  For example, a such
;; tab set can be used to display a tab bar with a tab for each
;; created tab set, allowing to switch to another tab set by clicking
;; on the corresponding tab.
;;
;; Three buttons are displayed to the left, on the tab bar: the "home"
;; button, the "scroll left" and the "scroll right" buttons.  The
;; "home" button is a general purpose button used to change something
;; on the tab bar.  The scroll left and scroll right buttons are used
;; to scroll tabs horizontally.  The following variables are
;; available, for respectively the `home', `scroll-left' and
;; `scroll-right' value of `<button>':
;;
;; `tabbar-<button>-function'
;;    Specify a function called when clicking on the button.  The
;;    function is passed the mouse event received.
;;
;; `tabbar-<button>-help-function'
;;    Specify a function to obtain a help string displayed when the
;;    mouse is onto the button.  The function is called with no
;;    arguments.
;;
;; The appearance of tabs and buttons is also customizable (see the
;; code for more details).
;;
;; Buffer tabs
;; -----------
;;
;; The default tab bar implementation provided, displays buffers in
;; dedicated tabs.  Selecting a tab, switch (mouse-1), or pop
;; (mouse-2), to the buffer it contains.
;;
;; The list of buffers put in tabs is provided by the function
;; specified in the variable `tabbar-buffer-list-function'.  The
;; default function: `tabbar-buffer-list', excludes buffers whose name
;; starts with a space, when they are not visiting a file.
;;
;; Buffers are organized in groups, each one represented by a tab set.
;; A buffer can have no group, or belong to more than one group.  The
;; function specified by the variable `tabbar-buffer-groups-function'
;; is called for each buffer to obtain its groups.  The default
;; function provided: `tabbar-buffer-groups' organizes buffers
;; depending on their major mode (see that function for details).
;;
;; The "home" button toggles display of buffer groups on the tab bar,
;; allowing to easily choose another buffer group by clicking on its
;; tab.
;;
;; The scroll buttons permit to scroll tabs when some of them are
;; outside the tab bar visible area.

;;; History:
;;

;;; Code:

;;; Options
;;
(defgroup tabbar nil
  "Display a tab bar in the header line."
  :group 'convenience)

(defcustom tabbar-cycling-scope nil
  "*Specify the scope of cyclic navigation through tabs.
The following scopes are possible:

- `tabs'
    Navigate through visible tabs only.
- `groups'
    Navigate through tab groups only.
- default
    Navigate through visible tabs, then through tab groups."
  :group 'tabbar
  :type '(choice :tag "Cycle through..."
                 (const :tag "Visible Tabs Only" tabs)
                 (const :tag "Tab Groups Only" groups)
                 (const :tag "Visible Tabs then Tab Groups" nil)))

(defcustom tabbar-inhibit-functions
  '(tabbar-default-inhibit-function)
  "List of functions to be called before displaying the tab bar.
Those functions are called one by one, with no arguments, until one of
them returns a non-nil value, and thus, prevent to display the tab
bar."
  :group 'tabbar
  :type 'hook)

(defcustom tabbar-current-tabset-function
  'tabbar-buffer-tabs
  "Function called with no argument to obtain the current tab set.
This is the tab set displayed on the tab bar."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-tab-label-function
  'tabbar-buffer-tab-label
  "Function that obtains a tab label displayed on the tab bar.
The function is passed a tab and should return a string."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-select-tab-function
  'tabbar-buffer-select-tab
  "Function that select a tab.
The function is passed a mouse event and a tab, and should make it the
selected tab."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-help-on-tab-function
  'tabbar-buffer-help-on-tab
  "Function to obtain a help string for a tab.
The help string is displayed when the mouse is onto the button.  The
function is passed the tab and should return a help string or nil for
none."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-home-function
  'tabbar-buffer-toggle-group-mode
  "Function called when clicking on the tab bar home button.
The function is passed the mouse event received."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-home-help-function
  'tabbar-buffer-toggle-group-mode-help
  "Function to obtain a help string for the tab bar home button.
The help string is displayed when the mouse is onto the button.
The function is called with no arguments."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-scroll-left-function
  'tabbar-scroll-left
  "Function that scrolls tabs on left.
The function is passed the mouse event received when clicking on the
scroll left button.  It should scroll the current tab set."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-scroll-left-help-function
  'tabbar-scroll-left-help
  "Function to obtain a help string for the scroll left button.
The help string is displayed when the mouse is onto the button.
The function is called with no arguments."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-scroll-right-function
  'tabbar-scroll-right
  "Function that scrolls tabs on right.
The function is passed the mouse event received when clicking on the
scroll right button.  It should scroll the current tab set."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-scroll-right-help-function
  'tabbar-scroll-right-help
  "Function to obtain a help string for the scroll right button.
The help string is displayed when the mouse is onto the button.
The function is called with no arguments."
  :group 'tabbar
  :type 'function)

;;; Tab and tab set
;;
(defconst tabbar-tabsets-tabset-name "tabbar-tabsets-tabset"
  "Name of the special tab set of existing tab sets.")

(defsubst tabbar-make-tab (object tabset)
  "Return a new tab with value OBJECT.
TABSET is the tab set the tab belongs to."
  (cons object tabset))

(defsubst tabbar-tab-value (tab)
  "Return the value of tab TAB."
  (car tab))

(defsubst tabbar-tab-tabset (tab)
  "Return the tab set TAB belongs to."
  (cdr tab))

(defvar tabbar-tabsets nil
  "The tab sets store.")

(defvar tabbar-current-tabset nil
  "The tab set currently displayed on the tab bar.")
(make-variable-buffer-local 'tabbar-current-tabset)

(defvar tabbar-last-selected-tab nil
  "The last selected tab.")

(defsubst tabbar-free-tabsets-store ()
  "Free the tab set store."
  (setq tabbar-tabsets nil
        tabbar-current-tabset nil
        tabbar-last-selected-tab nil))

(defsubst tabbar-init-tabsets-store ()
  "Initialize the tab set store."
  (tabbar-free-tabsets-store)
  (setq tabbar-tabsets (make-vector 31 0)))

(defmacro tabbar-map-tabsets (function)
  "Apply FUNCTION to each existing tab set.
Return the list of the results."
  (let ((result (make-symbol "result"))
        (tabset (make-symbol "tabset")))
    `(let (,result)
       (mapatoms #'(lambda (,tabset)
                     (setq ,result
                           (cons (funcall ,function ,tabset)
                                 ,result)))
                 tabbar-tabsets)
       (nreverse ,result))))

(defun tabbar-make-tabset (name &rest objects)
  "Make a new tab set whose name is the string NAME.
It is initialized with tabs build from the list of OBJECTS."
  (let* ((tabset (intern name tabbar-tabsets))
         (tabs (mapcar #'(lambda (object)
                           (tabbar-make-tab object tabset))
                       objects)))
    (set tabset tabs)
    (put tabset 'select (car tabs))
    (put tabset 'start 0)
    tabset))

(defsubst tabbar-get-tabset (name)
  "Return the tab set whose name is the string NAME.
Return nil if not found."
  (intern-soft name tabbar-tabsets))

(defsubst tabbar-delete-tabset (tabset)
  "Delete the tab set TABSET.
That is, remove it from the tab sets store."
  (unintern tabset tabbar-tabsets))

(defsubst tabbar-tabs (tabset)
  "Return the list of tabs in TABSET."
  (symbol-value tabset))

(defsubst tabbar-tab-values (tabset)
  "Return the list of tab values in TABSET."
  (mapcar 'tabbar-tab-value (tabbar-tabs tabset)))

(defsubst tabbar-get-tab (object tabset)
  "Search for a tab with value OBJECT in TABSET.
Return the tab found, or nil if not found."
  (assoc object (tabbar-tabs tabset)))

(defsubst tabbar-member (tab tabset)
  "Return non-nil if TAB is in TABSET."
  (or (eq (tabbar-tab-tabset tab) tabset)
      (memq tab (tabbar-tabs tabset))))

(defsubst tabbar-template (tabset)
  "Return the template to display TABSET in the header line."
  (get tabset 'template))

(defsubst tabbar-set-template (tabset template)
  "Set the TABSET's header line format with TEMPLATE."
  (put tabset 'template template))

(defsubst tabbar-selected-tab (tabset)
  "Return the tab selected in TABSET."
  (get tabset 'select))

(defsubst tabbar-selected-value (tabset)
  "Return the value of the tab selected in TABSET."
  (tabbar-tab-value (tabbar-selected-tab tabset)))

(defsubst tabbar-selected-p (tab tabset)
  "Return non-nil if TAB is the selected tab in TABSET."
  (eq tab (tabbar-selected-tab tabset)))

(defsubst tabbar-select-tab (tab tabset)
  "Make TAB the selected tab in TABSET.
Does nothing if TAB is not found in TABSET.
Return TAB if selected, nil if not."
  (when (tabbar-member tab tabset)
    (or (tabbar-selected-p tab tabset)
        (tabbar-set-template tabset nil))
    (put tabset 'select tab)))

(defsubst tabbar-select-tab-value (object tabset)
  "Make the tab with value OBJECT, the selected tab in TABSET.
Does nothing if a tab with value OBJECT is not found in TABSET.
Return the tab selected, or nil if nothing was selected."
  (tabbar-select-tab (tabbar-get-tab object tabset) tabset))

(defsubst tabbar-start (tabset)
  "Return the index of the first tab in the TABSET's view."
  (get tabset 'start))

(defsubst tabbar-view (tabset)
  "Return the list of tabs in the TABSET's view."
  (nthcdr (tabbar-start tabset) (tabbar-tabs tabset)))

(defun tabbar-add-tab (tabset object &optional append)
  "Add to TABSET a tab with value OBJECT if there isn't one there yet.
If the tab is added, it is added at the beginning of the tab list,
unless the optional argument APPEND is non-nil, in which case it is
added at the end."
  (let ((tabs (tabbar-tabs tabset)))
    (if (tabbar-get-tab object tabset)
        tabs
      (let ((tab (tabbar-make-tab object tabset)))
        (tabbar-set-template tabset nil)
        (set tabset (if append
                        (append tabs (list tab))
                      (cons tab tabs)))))))

(defun tabbar-delete-tab (tab)
  "Remove TAB from its TABSET."
  (let* ((tabset (tabbar-tab-tabset tab))
         (tabs   (tabbar-tabs tabset)))
    (tabbar-set-template tabset nil)
    (when (eq tab (tabbar-selected-tab tabset))
      (tabbar-select-tab (car (or (cdr (memq tab tabs)) (last tabs)))
                         tabset))
    (set tabset (delq tab tabs))))

(defun tabbar-scroll (tabset count)
  "Scroll the TABSET's view of COUNT tabs.
If COUNT is positive move the view on right.  If COUNT is negative,
move the view on left."
  (let ((start (min (max 0 (+ (tabbar-start tabset) count))
                    (1- (length (tabbar-tabs tabset))))))
    (when (/= start (tabbar-start tabset))
      (tabbar-set-template tabset nil)
      (put tabset 'start start))))

(defun tabbar-tab-next (tabset tab &optional before)
  "Search in TABSET for the tab after TAB.
If optional argument BEFORE is non-nil, search for the tab before
TAB.  Return the tab found, or nil otherwise."
  (let* (last (tabs (tabbar-tabs tabset)))
    (while (and tabs (not (eq tab (car tabs))))
      (setq last (car tabs)
            tabs (cdr tabs)))
    (and tabs (if before last (nth 1 tabs)))))

(defun tabbar-current-tabset (&optional update)
  "Return the current tab set, that will be displayed on the tab bar.
If optional argument UPDATE is non-nil, call the user defined function
`tabbar-current-tabset-function' to obtain it.  Otherwise return the
current cached copy."
  (when (and update tabbar-current-tabset-function)
    (setq tabbar-current-tabset
          (funcall tabbar-current-tabset-function))
    (or tabbar-last-selected-tab
        (setq tabbar-last-selected-tab
              (tabbar-selected-tab tabbar-current-tabset))))
  tabbar-current-tabset)

(defun tabbar-get-tabsets-tabset ()
  "Return the tab set of selected tabs in existing tab sets."
  (let ((tabsets-tabset
         (or (tabbar-get-tabset tabbar-tabsets-tabset-name)
             (tabbar-make-tabset tabbar-tabsets-tabset-name))))
    (set tabsets-tabset
         (delq t
               (tabbar-map-tabsets
                #'(lambda (tabset)
                    (or (eq tabset tabsets-tabset)
                        (tabbar-selected-tab tabset))))))
    (tabbar-scroll tabsets-tabset 0)
    (tabbar-set-template tabsets-tabset nil)
    tabsets-tabset))

;;; Buttons and separators
;;
(defun tabbar-find-image (specs)
  "Find an image, choosing one of a list of image specifications.
SPECS is a list of image specifications.  See also `find-image'."
  (when (display-images-p)
    (condition-case nil
        (find-image specs)
      (error nil))))

(defconst tabbar-separator-widget
  '(cons (string)
         (repeat :tag "Image"
                 :extra-offset 2
                 (restricted-sexp :tag "Spec"
                                  :match-alternatives (listp))))
  "Widget for editing a tab bar separator.
A separator is specified as a pair (STRING . IMAGE) where STRING is a
string value, and IMAGE a list of image specifications.
If IMAGE is non-nil, try to use that image, else use STRING.
The value (\"\") hide separators.")

(defun tabbar-setup-separator (variable value)
  "Set VARIABLE with specification of tab separator in VALUE.
Initialize `VARIABLE-value' with the template element to use in header
line, to display a separator on the tab bar."
  (let ((text (intern (format "%s-value" variable)))
        (image (tabbar-find-image (cdr value))))
    (set text (propertize (if image " " (car value))
                          'face 'tabbar-separator-face
                          'display image))
    (custom-set-default variable value)
    ))

(defvar tabbar-separator-value nil
  "Text of the separator used between tabs.")

(defcustom tabbar-separator (list " ")
  "Separator used between tabs.
See the variable `tabbar-separator-widget' for details."
  :group 'tabbar
  :type tabbar-separator-widget
  :set 'tabbar-setup-separator)

(defconst tabbar-button-widget
  '(cons
    (cons :tag "Enabled"
          (string)
          (repeat :tag "Image"
                  :extra-offset 2
                  (restricted-sexp :tag "Spec"
                                   :match-alternatives (listp))))
    (cons :tag "Disabled"
          (string)
          (repeat :tag "Image"
                  :extra-offset 2
                  (restricted-sexp :tag "Spec"
                                   :match-alternatives (listp))))
    )
  "Widget for editing a tab bar button.
A button is specified as a pair (ENABLED-BUTTON . DISABLED-BUTTON),
where ENABLED-BUTTON and DISABLED-BUTTON specify the value used when
the button is respectively enabled and disabled.  Each button value is
a pair (STRING . IMAGE) where STRING is a string value, and IMAGE a
list of image specifications.
If IMAGE is non-nil, try to use that image, else use STRING.")

(defun tabbar-setup-button (variable value)
  "Set VARIABLE with the button specification in VALUE.
Initialize `VARIABLE-enable' and `VARIABLE-disable' with the template
elements to use in the header line, to respectively display an enabled
and a disabled button on the tab bar.
The variable `VARIABLE-keymap' must be set with the keymap used for the
enabled button.
The function `VARIABLE-help' must be defined to return the `help-echo'
string shown when the mouse is on the button."
  (let ((enabled  (intern (format "%s-enabled" variable)))
        (disabled (intern (format "%s-disabled" variable)))
        (keymap   (intern (format "%s-keymap" variable)))
        (help     (intern (format "%s-help" variable)))
        (image-en (tabbar-find-image (cdar value)))
        (image-di (tabbar-find-image (cddr value))))
    (set enabled (propertize (if image-en " " (caar value))
                             'display image-en
                             'face 'tabbar-button-face
                             'local-map (symbol-value keymap)
                             'help-echo help))
    (set disabled (propertize (if image-di " " (cadr value))
                              'display image-di
                              'face 'tabbar-button-face))
    (custom-set-default variable value)
    ))

(defun tabbar-make-button-keymap (callback)
  "Return a button keymap that call CALLBACK on mouse events.
CALLBACK is passed the received mouse event."
  (let ((keymap (make-sparse-keymap)))
    ;; Pass mouse-1, mouse-2 and mouse-3 events to CALLBACK.
    (define-key keymap [header-line down-mouse-1] 'ignore)
    (define-key keymap [header-line mouse-1] callback)
    (define-key keymap [header-line down-mouse-2] 'ignore)
    (define-key keymap [header-line mouse-2] callback)
    (define-key keymap [header-line down-mouse-3] 'ignore)
    (define-key keymap [header-line mouse-3] callback)
    keymap))

(defvar tabbar-home-button-enabled nil
  "Text of the enabled home button.")

(defvar tabbar-home-button-disabled nil
  "Text of the disabled home button.")

(defconst tabbar-home-button-keymap
  (tabbar-make-button-keymap 'tabbar-home-button-callback)
  "Keymap of the home button.")

(defun tabbar-home-button-callback (event)
  "Handle a mouse EVENT on the home button.
Call `tabbar-home-function'."
  (interactive "e")
  (when tabbar-home-function
    (save-selected-window
      (select-window (posn-window (event-start event)))
      (funcall tabbar-home-function event)
      (force-mode-line-update)
      (sit-for 0)
      )))

(defun tabbar-home-button-help (window object position)
  "Return a help string or nil for none, for the home button.
Call `tabbar-home-help-function'.
Arguments WINDOW, OBJECT and POSITION, are not used."
  (when tabbar-home-help-function
    (funcall tabbar-home-help-function)))

(defconst tabbar-home-button-enabled-image
  '((:type pbm :ascent center :data "\
P2
10 10
255
184 184 184 184 0 184 184 184 184 184 184 184 184 0 0 0 184 184 184 184
184 184 0 0 0 0 0 184 184 184 184 0 0 0 0 0 0 0 184 184 184 184 255 0 0
0 255 255 255 184 184 0 0 0 0 0 0 0 184 184 184 184 0 0 0 0 0 255 255 184
184 184 184 0 0 0 255 255 184 184 184 184 184 184 0 255 255 184 184 184
184 184 184 184 184 255 184 184 184 184
"))
  "Default image for the enabled home button.")

(defconst tabbar-home-button-disabled-image
  '((:type pbm :ascent center :data "\
P2
10 10
255
184 184 184 184 120 184 184 184 184 184 184 184 184 120 120 120 184 184
184 184 184 184 120 184 184 184 120 184 184 184 184 120 120 160 184 160
120 120 184 184 184 184 255 120 184 120 255 255 255 184 184 120 120 160
184 160 120 120 184 184 184 184 120 184 184 184 120 255 255 184 184 184
184 120 120 120 255 255 184 184 184 184 184 184 120 255 255 184 184 184
184 184 184 184 184 255 184 184 184 184
"))
  "Default image for the disabled home button.")

(defcustom tabbar-home-button
  (cons (cons "[o]" tabbar-home-button-enabled-image)
        (cons "[x]" tabbar-home-button-disabled-image))
  "The home button.
See the variable `tabbar-button-widget' for details."
  :group 'tabbar
  :type tabbar-button-widget
  :set 'tabbar-setup-button)

(defvar tabbar-scroll-left-button-enabled nil
  "Text of the enabled scroll left button.")

(defvar tabbar-scroll-left-button-disabled nil
  "Text of the disabled scroll left button.")

(defconst tabbar-scroll-left-button-keymap
  (tabbar-make-button-keymap 'tabbar-scroll-left-button-callback)
  "Keymap of the scroll left button.")

(defun tabbar-scroll-left-button-callback (event)
  "Handle a mouse EVENT on the scroll left button.
Call `tabbar-scroll-left-function'."
  (interactive "e")
  (when tabbar-scroll-left-function
    (save-selected-window
      (select-window (posn-window (event-start event)))
      (funcall tabbar-scroll-left-function event)
      (force-mode-line-update)
      (sit-for 0)
      )))

(defun tabbar-scroll-left-button-help (window object position)
  "Return a help string or nil for none, for the scroll left button.
Call `tabbar-scroll-left-help-function'.
Arguments WINDOW, OBJECT and POSITION, are not used."
  (when tabbar-scroll-left-help-function
    (funcall tabbar-scroll-left-help-function)))

(defconst tabbar-scroll-left-button-enabled-image
  '((:type pbm :ascent center :data "\
P2
8 10
255
184 184 184 184 184 184 184 184 184 184 184 184 184 0 184 184 184 184 184
184 0 0 255 184 184 184 184 0 0 0 255 184 184 184 0 0 0 0 255 184 184 184
184 0 0 0 255 184 184 184 184 184 0 0 255 184 184 184 184 184 184 0 255
184 184 184 184 184 184 184 255 184 184 184 184 184 184 184 184 184
"))
  "Default image for the enabled scroll left button.")

(defconst tabbar-scroll-left-button-disabled-image
  '((:type pbm :ascent center :data "\
P2
8 10
255
184 184 184 184 184 184 184 184 184 184 184 184 184 120 184 184 184 184
184 184 120 120 255 184 184 184 184 120 184 120 255 184 184 184 120 184
184 120 255 184 184 184 184 120 184 120 255 184 184 184 184 184 120 120
255 184 184 184 184 184 184 120 255 184 184 184 184 184 184 184 255 184
184 184 184 184 184 184 184 184
"))
  "Default image for the disabled scroll left button.")

(defcustom tabbar-scroll-left-button
  (cons (cons " <" tabbar-scroll-left-button-enabled-image)
        (cons " =" tabbar-scroll-left-button-disabled-image))
  "The scroll left button.
See the variable `tabbar-button-widget' for details."
  :group 'tabbar
  :type tabbar-button-widget
  :set 'tabbar-setup-button)

(defvar tabbar-scroll-right-button-enabled nil
  "Text of the enabled scroll right button.")

(defvar tabbar-scroll-right-button-disabled nil
  "Text of the disabled scroll right button.")

(defconst tabbar-scroll-right-button-keymap
  (tabbar-make-button-keymap 'tabbar-scroll-right-button-callback)
  "Keymap of the scroll right button.")

(defun tabbar-scroll-right-button-callback (event)
  "Handle a mouse EVENT on the scroll right button.
Call `tabbar-scroll-right-function'."
  (interactive "e")
  (when tabbar-scroll-right-function
    (save-selected-window
      (select-window (posn-window (event-start event)))
      (funcall tabbar-scroll-right-function event)
      (force-mode-line-update)
      (sit-for 0)
      )))

(defun tabbar-scroll-right-button-help (window object position)
  "Return a help string or nil for none, for the scroll right button.
Call `tabbar-scroll-right-help-function'.
Arguments WINDOW, OBJECT and POSITION, are not used."
  (when tabbar-scroll-right-help-function
    (funcall tabbar-scroll-right-help-function)))

(defconst tabbar-scroll-right-button-enabled-image
  '((:type pbm :ascent center :data "\
P2
8 10
255
184 184 184 184 184 184 184 184 184 0 184 184 184 184 184 184 184 0 0 184
184 184 184 184 184 0 0 0 184 184 184 184 184 0 0 0 0 184 184 184 184 0
0 0 255 255 184 184 184 0 0 255 255 184 184 184 184 0 255 255 184 184 184
184 184 184 255 184 184 184 184 184 184 184 184 184 184 184 184 184
"))
  "Default image for the enabled scroll right button.")

(defconst tabbar-scroll-right-button-disabled-image
  '((:type pbm :ascent center :data "\
P2
8 10
255
184 184 184 184 184 184 184 184 184 120 184 184 184 184 184 184 184 120
120 184 184 184 184 184 184 120 184 120 184 184 184 184 184 120 184 184
120 184 184 184 184 120 184 120 255 255 184 184 184 120 120 255 255 184
184 184 184 120 255 255 184 184 184 184 184 184 255 184 184 184 184 184
184 184 184 184 184 184 184 184
"))
  "Default image for the disabled scroll right button.")

(defcustom tabbar-scroll-right-button
  (cons (cons " >" tabbar-scroll-right-button-enabled-image)
        (cons " =" tabbar-scroll-right-button-disabled-image))
  "The scroll right button.
See the variable `tabbar-button-widget' for details."
  :group 'tabbar
  :type tabbar-button-widget
  :set 'tabbar-setup-button)

;;; Faces
;;
(defface tabbar-default-face
  '(
    (t
     (:inherit variable-pitch
               :height 0.8
               :foreground "gray60"
               :background "gray72"
               )
     )
    )
  "Default face used in the tab bar."
  :group 'tabbar)

(defface tabbar-unselected-face
  '(
    (t
     (:inherit tabbar-default-face
               :box (:line-width 2 :color "white" :style pressed-button)
               )
     )
    )
  "Face used for uselected tabs."
  :group 'tabbar)

(defface tabbar-selected-face
  '(
    (t
     (:inherit tabbar-default-face
               :box (:line-width 2 :color "white" :style released-button)
               :foreground "blue"
               )
     )
    )
  "Face used for the selected tab."
  :group 'tabbar)

(defface tabbar-separator-face
  '(
    (t
     (:inherit tabbar-default-face
               :height 0.2
               )
     )
    )
  "Face used for the select mode button."
  :group 'tabbar)

(defface tabbar-button-face
  '(
    (t
     (:inherit tabbar-default-face
               :box (:line-width 2 :color "white" :style released-button)
               :foreground "dark red"
               )
     )
    )
  "Face used for the select mode button."
  :group 'tabbar)

;;; Wrappers
;;
(defun tabbar-scroll-left (event)
  "On mouse EVENT, scroll current tab set on left."
  (when (eq (event-basic-type event) 'mouse-1)
    (tabbar-scroll (tabbar-current-tabset) -1)
    ))

(defun tabbar-scroll-left-help ()
  "Return the help string shown when mouse is onto the scroll left button."
  "mouse-1: scroll tabs left.")

(defun tabbar-scroll-right (event)
  "On mouse EVENT, scroll current tab set on right."
  (when (eq (event-basic-type event) 'mouse-1)
    (tabbar-scroll (tabbar-current-tabset) 1)
    ))

(defun tabbar-scroll-right-help ()
  "Return the help string shown when mouse is onto the scroll right button."
  "mouse-1: scroll tabs right.")

 ;; These functions can be called at compilation time.
(eval-and-compile
  
  (defun tabbar-make-select-tab-command (tab)
    "Return a command to handle TAB selection.
That command calls `tabbar-select-tab-function' with the received
mouse event and TAB."
    (let ((event (make-symbol "event")))
      `(lambda (,event)
         (interactive "e")
         (setq tabbar-last-selected-tab ,tab)
         (when tabbar-select-tab-function
           (select-window (posn-window (event-start ,event)))
           (funcall tabbar-select-tab-function ,event ,tab)
           (force-mode-line-update)
           (sit-for 0)))))

  (defun tabbar-make-help-on-tab-function (tab)
    "Return a function that return a help string on TAB.
That command calls `tabbar-help-on-tab-function' with TAB."
    (let ((window (make-symbol "window"))
          (object (make-symbol "object"))
          (position (make-symbol "position"))
          )
      `(lambda (,window ,object ,position)
         (when tabbar-help-on-tab-function
           (funcall tabbar-help-on-tab-function ,tab)))))

  )

(defun tabbar-line-element (tab)
  "Return an `header-line-format' template element from TAB.
Call `tabbar-tab-label-function' to obtain a label for TAB."
  (let* ((keymap (make-sparse-keymap))
         (qtab   (list 'quote tab))
         (select (tabbar-make-select-tab-command qtab))
         (help   (tabbar-make-help-on-tab-function qtab))
         (label  (if tabbar-tab-label-function
                     (funcall tabbar-tab-label-function tab)
                   tab)))
    ;; Call `tabbar-select-tab-function' on mouse events.
    (define-key keymap [header-line down-mouse-1] 'ignore)
    (define-key keymap [header-line mouse-1] select)
    (define-key keymap [header-line down-mouse-2] 'ignore)
    (define-key keymap [header-line mouse-2] select)
    (define-key keymap [header-line down-mouse-3] 'ignore)
    (define-key keymap [header-line mouse-3] select)
    ;; Return the tab followed by a separator.
    (list (propertize label 'local-map keymap 'help-echo help
                      'face (if (tabbar-selected-p
                                 tab(tabbar-current-tabset))
                                'tabbar-selected-face
                              'tabbar-unselected-face))
          tabbar-separator-value)))

(defun tabbar-line ()
  "Return the header line templates that represent the tab bar.
Call `tabbar-current-tabset-function' to obtain the current tab set to
display.  Then call `tabbar-line-element' on each tab in current tab
set's view to build a list of template elements for
`header-line-format'."
  (if (run-hook-with-args-until-success 'tabbar-inhibit-functions)
      (setq header-line-format nil)
    (let ((tabset (tabbar-current-tabset t))
          (padcolor (face-background 'tabbar-default-face)))
      (when tabset
        (list (format "%s%s%s"
                      (if tabbar-home-function
                          tabbar-home-button-enabled
                        tabbar-home-button-disabled)
                      (if (> (tabbar-start tabset) 0)
                          tabbar-scroll-left-button-enabled
                        tabbar-scroll-left-button-disabled)
                      (if (< (tabbar-start tabset)
                             (1- (length (tabbar-tabs tabset))))
                          tabbar-scroll-right-button-enabled
                        tabbar-scroll-right-button-disabled))
              tabbar-separator-value
              (or
               ;; If a cached template exists, use it.
               (tabbar-template tabset)
               ;; Otherwise use a refeshed value.
               (tabbar-set-template tabset
                                    (mapcar 'tabbar-line-element
                                            (tabbar-view tabset))))
              (propertize "%-" 'face (list :background padcolor
                                           :foreground padcolor))))
      )))

;;; Cyclic navigation through tabs
;;
(defsubst tabbar-make-mouse-event (&optional type)
  "Return a basic mouse event.
Optional argument TYPE is a mouse event type.  That is one of the
symbols `mouse-1', `mouse-2' or `mouse-3'.  The default is `mouse-1'."
  (list (or (memq type '(mouse-2 mouse-3)) 'mouse-1)
        (or (event-start nil) ;; Emacs 21.4
            (list (selected-window) (point) '(0 . 0) 0))))

(defmacro tabbar-click-on-tab (tab &optional type)
  "Simulate a mouse click event on tab TAB.
Optional argument TYPE is a mouse event type (see the function
`tabbar-make-mouse-event' for details)."
  `(,(tabbar-make-select-tab-command tab)
    (tabbar-make-mouse-event ,type)))

(defun tabbar-cycle (&optional backward)
  "Cycle to the next available tab.
If optional argument BACKWARD is non-nil, cycle to the previous tab
instead.
The scope of the cyclic navigation through tabs is specified by the
option `tabbar-cycling-scope'."
  (let ((tabset (tabbar-current-tabset t))
        selected tab)
    (when tabset
      (setq selected (tabbar-selected-tab tabset))
      (cond
       ;; Cycle through visible tabs only.
       ((eq tabbar-cycling-scope 'tabs)
        (setq tab (tabbar-tab-next tabset selected backward))
        ;; When there is no tab after/before the selected one, cycle
        ;; to the first/last visible tab.
        (unless tab
          (setq tabset (tabbar-tabs tabset)
                tab (car (if backward (last tabset) tabset))))
        )
       ;; Cycle through tab groups only.
       ((eq tabbar-cycling-scope 'groups)
        (setq tabset (tabbar-get-tabsets-tabset)
              tab (tabbar-tab-next tabset selected backward))
        ;; When there is no group after/before the selected one, cycle
        ;; to the first/last available group.
        (unless tab
          (setq tabset (tabbar-tabs tabset)
                tab (car (if backward (last tabset) tabset))))
        )
       (t
        ;; Cycle through visible tabs then tab groups.
        (setq tab (tabbar-tab-next tabset selected backward))
        ;; When there is no visible tab after/before the selected one,
        ;; cycle to the next/previous available group.
        (unless tab
          (setq tabset (tabbar-get-tabsets-tabset)
                tab (tabbar-tab-next tabset selected backward))
          ;; When there is no next/previous group, cycle to the
          ;; first/last available group.
          (unless tab
            (setq tabset (tabbar-tabs tabset)
                  tab (car (if backward (last tabset) tabset))))
          ;; Select the first/last visible tab of the new group.
          (setq tabset (tabbar-tabs (tabbar-tab-tabset tab))
                tab (car (if backward (last tabset) tabset))))
        ))
      (tabbar-click-on-tab tab))))

;;;###autoload
(defun tabbar-backward ()
  "Select the previous available tab.
Depend on the setting of the option `tabbar-cycling-scope'."
  (interactive)
  (tabbar-cycle t))

;;;###autoload
(defun tabbar-forward ()
  "Select the next available tab.
Depend on the setting of the option `tabbar-cycling-scope'."
  (interactive)
  (tabbar-cycle))

;;;###autoload
(defun tabbar-backward-group ()
  "Go to selected tab in the previous available group."
  (interactive)
  (let ((tabbar-cycling-scope 'groups))
    (tabbar-cycle t)))

;;;###autoload
(defun tabbar-forward-group ()
  "Go to selected tab in the next available group."
  (interactive)
  (let ((tabbar-cycling-scope 'groups))
    (tabbar-cycle)))

;;;###autoload
(defun tabbar-backward-tab ()
  "Select the previous visible tab."
  (interactive)
  (let ((tabbar-cycling-scope 'tabs))
    (tabbar-cycle t)))

;;;###autoload
(defun tabbar-forward-tab ()
  "Select the next visible tab."
  (interactive)
  (let ((tabbar-cycling-scope 'tabs))
    (tabbar-cycle)))

;;; Minor modes
;;
(defvar tabbar-old-global-hlf nil
  "Global value of the header line when entering tab bar mode.")

(defconst tabbar-header-line-format '(:eval (tabbar-line))
  "The tab bar header line format.")

;;;###autoload
(define-minor-mode tabbar-mode
  "Toggle display of a tab bar in the header line.
With prefix argument ARG, turn on if positive, otherwise off.
Returns non-nil if the new state is enabled."
  :global t
  :group 'tabbar
  (if tabbar-mode
;;; ON
      (unless (eq header-line-format tabbar-header-line-format)
        ;; Save current default value of `header-line-format'.
        (setq tabbar-old-global-hlf (default-value 'header-line-format))
        (add-hook 'kill-buffer-hook 'tabbar-buffer-kill-buffer-hook)
        (tabbar-init-tabsets-store)
        (setq-default header-line-format tabbar-header-line-format))
;;; OFF
    ;; Restore previous `header-line-format', if it has not changed.
    (when (eq (default-value 'header-line-format)
              tabbar-header-line-format)
      (setq-default header-line-format tabbar-old-global-hlf))
    (remove-hook 'kill-buffer-hook 'tabbar-buffer-kill-buffer-hook)
    (tabbar-free-tabsets-store)
    ;; Turn off locals tab bar mode
    (mapc #'(lambda (b)
              (with-current-buffer b
                (tabbar-local-mode -1)))
          (buffer-list))
    ))

(defvar tabbar-old-local-hlf nil
  "Local value of the header line when entering tab bar local mode.")
(make-variable-buffer-local 'tabbar-old-local-hlf)

;;;###autoload
(define-minor-mode tabbar-local-mode
  "Toggle local display of the tab bar.
With prefix argument ARG, turn on if positive, otherwise off.
Returns non-nil if the new state is enabled.
When on and tab bar global mode is on, if a buffer local value of
`header-line-format' exists, it is saved, then the local header line
is killed to show the tab bar.  When off, the saved local value of the
header line is restored, hiding the tab bar."
  :global nil
  :group 'tabbar
;;; ON
  (if tabbar-local-mode
      (if (and tabbar-mode (local-variable-p 'header-line-format)
               (not (local-variable-p 'tabbar-old-local-hlf)))
          (progn
            (setq tabbar-old-local-hlf header-line-format)
            (kill-local-variable 'header-line-format))
        (setq tabbar-local-mode nil))
;;; OFF
    (when (local-variable-p 'tabbar-old-local-hlf)
      (setq header-line-format tabbar-old-local-hlf)
      (kill-local-variable 'tabbar-old-local-hlf))
    ))

;;; Hooks
;;
(defun tabbar-default-inhibit-function ()
  "Inhibit display of the tab bar in specified windows.
That is dedicated windows, and `checkdoc' status windows."
  (or (window-dedicated-p (selected-window))
      (member (buffer-name)
              '(" *Checkdoc Status*"))))

(defun tabbar-buffer-kill-buffer-hook ()
  "Hook run just before actually killing a buffer.
In tab bar mode, try to switch to a buffer in the current tab bar,
after the current buffer has been killed.  Try first the buffer in tab
after the current one, then the buffer in tab before.  On success, put
the sibling buffer in front of the buffer list, so it will be selected
first."
  (and tabbar-mode
       (eq tabbar-current-tabset-function 'tabbar-buffer-tabs)
       (eq (current-buffer) (window-buffer (selected-window)))
       (let ((bl (tabbar-tab-values (tabbar-current-tabset)))
             (bn (buffer-name))
             found sibling)
         (while (and bl (not found))
           (if (equal bn (car bl))
               (setq found t)
             (setq sibling (car bl)))
           (setq bl (cdr bl)))
         (when (setq sibling (or (car bl) sibling))
           ;; Move sibling buffer in front of the buffer list.
           (save-current-buffer
             (switch-to-buffer sibling))))))

;;; Buffer tabs
;;
(defcustom tabbar-buffer-list-function
  'tabbar-buffer-list
  "*Function that returns the list of buffers to show in tabs.
That function is called with no arguments and must return a list of
buffers."
  :group 'tabbar
  :type 'function)

(defcustom tabbar-buffer-groups-function
  'tabbar-buffer-groups
  "*Function that gives the group names a buffer belongs to.
That function is passed a buffer and must return a list of group
names, or nil if the buffer has no group.
Notice that it is better that a buffer belongs to one group."
  :group 'tabbar
  :type 'function)

(defun tabbar-buffer-list ()
  "Return the list of buffers to show in tabs.
Exclude buffers whose name starts with a space, when they are not
visiting a file."
  (delq t
        (mapcar #'(lambda (b)
                    (cond
                     ((buffer-file-name b) b)
                     ((char-equal ?\  (aref (buffer-name b) 0)))
                     (b)))
                (buffer-list))))

(defun tabbar-buffer-groups (buffer)
  "Return the list of group names BUFFER belongs to.
Return only one group for each buffer."
  (with-current-buffer (get-buffer buffer)
    (cond
     ((or (get-buffer-process (current-buffer))
          (memq major-mode
                '(comint-mode compilation-mode)))
      '("Process")
      )
     ((member (buffer-name)
              '("*scratch*" "*Messages*"))
      '("Common")
      )
     ((eq major-mode 'dired-mode)
      '("Dired")
      )
     ((memq major-mode
            '(help-mode apropos-mode Info-mode Man-mode))
      '("Help")
      )
     ((memq major-mode
            '(rmail-mode
              rmail-edit-mode vm-summary-mode vm-mode mail-mode
              mh-letter-mode mh-show-mode mh-folder-mode
              gnus-summary-mode message-mode gnus-group-mode
              gnus-article-mode score-mode gnus-browse-killed-mode))
      '("Mail")
      )
     (t
      (list
       (if (and (stringp mode-name) (string-match "[^ ]" mode-name))
           mode-name
         (symbol-name major-mode)))
      )
     )))

;;; Group buffers in tab sets.
;;
(defun tabbar-buffer-cleanup-tabsets (buffers)
  "Remove obsolete tabs from existing tab sets.
That is tabs whose value is a killed buffer or a buffer not in
BUFFERS.  Delete tab sets that no more contain tabs."
  (mapc 'tabbar-delete-tabset
        (tabbar-map-tabsets
         #'(lambda (tabset)
             (mapc #'(lambda (tab)
                       (let ((b (get-buffer (tabbar-tab-value tab))))
                         (unless (and b (memq b buffers))
                           (tabbar-delete-tab tab))))
                   (tabbar-tabs tabset))
             (unless (tabbar-tabs tabset)
               tabset)))))

(defun tabbar-buffer-update-groups ()
  "Update group of buffers.
Return the the first group where the current buffer is."
  ;; Ensure that the current buffer will always have a tab!
  (let ((buffers (cons (current-buffer)
                       (funcall tabbar-buffer-list-function)))
        current-group)
    (mapc
     #'(lambda (buffer)
         (let* ((name (buffer-name buffer))
                (groups (funcall tabbar-buffer-groups-function name)))
           (when (eq buffer (current-buffer))
             (setq current-group (car groups)))
           (mapc #'(lambda (group)
                     (let ((tabset (tabbar-get-tabset group)))
                       (if tabset
                           (tabbar-add-tab tabset name t)
                         (tabbar-make-tabset group name))))
                 groups)))
     buffers)
    (tabbar-buffer-cleanup-tabsets buffers)
    current-group))

;;; Tab bar callbacks
;;
(defvar tabbar-buffer-group-mode nil
  "Display tabs for group of buffers, when non-nil.")
(make-variable-buffer-local 'tabbar-buffer-group-mode)

(defun tabbar-buffer-tabs ()
  "Return the buffers to display on the tab bar, in a tab set."
  (let ((group (tabbar-buffer-update-groups))
        (buffer (buffer-name))
        tabset curtab)
    (if tabbar-buffer-group-mode
        (progn
          (setq tabset (tabbar-get-tabsets-tabset)
                curtab (tabbar-selected-tab (tabbar-current-tabset)))
          (unless (and (equal buffer (tabbar-tab-value curtab))
                       (tabbar-select-tab curtab tabset))
            (tabbar-select-tab-value buffer tabset)))
      (setq tabset (tabbar-tab-tabset tabbar-last-selected-tab))
      (unless (and tabset (tabbar-get-tab buffer tabset))
        (setq tabset (tabbar-get-tabset group)))
      (tabbar-select-tab-value buffer tabset))
    tabset))

(defun tabbar-buffer-tab-label (tab)
  "Return the label to display TAB.
Must be a valid `header-line-format' template element."
  (if tabbar-buffer-group-mode
      (format "[%s]" (tabbar-tab-tabset tab))
    (format " %s " (tabbar-tab-value tab))))

(defun tabbar-buffer-help-on-tab (tab)
  "Return the help string shown when mouse is onto TAB."
  (if tabbar-buffer-group-mode
      "mouse-1: switch to selected tab in group"
    "\
mouse-1: switch to buffer, \
mouse-2: pop to buffer, \
mouse-3: delete other windows"
    ))

(defun tabbar-buffer-select-tab (event tab)
  "On mouse EVENT, select TAB."
  (let ((mouse-button (event-basic-type event))
        (buffer (tabbar-tab-value tab)))
    (cond
     ((eq mouse-button 'mouse-1)
      (switch-to-buffer buffer))
     ((eq mouse-button 'mouse-2)
      (pop-to-buffer buffer t))
     ((eq mouse-button 'mouse-3)
      (delete-other-windows)))
    ;; Disable group mode.
    (setq tabbar-buffer-group-mode nil)
    ))

(defun tabbar-buffer-toggle-group-mode (event)
  "On mouse EVENT, toggle group mode.
When enabled, display tabs for group of buffers, instead of buffer
tabs."
  (setq tabbar-buffer-group-mode (not tabbar-buffer-group-mode)))

(defun tabbar-buffer-toggle-group-mode-help ()
  "Return the help string shown when mouse is onto the toggle button."
  (if tabbar-buffer-group-mode
      "mouse-1: show buffers in selected group"
    "mouse-1: show groups of buffers"
    ))

(provide 'tabbar)

;;; tabbar.el ends here