about summary refs log tree commit diff stats
path: root/lisp/+tab-bar.el
blob: 1ee76061d38e1729818eacbf87304b97c5a735bd (plain)
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
;;; +tab-bar.el -*- lexical-binding: t; -*-

;;; Commentary:

;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use
;; Emacs 27 on my Windows machine.  Thus, the code in this file.

;;; Code:

(require 'tab-bar)


;; Common

(defun +tab-bar-misc-info ()
  "Display `mode-line-misc-info', formatted for the tab-bar."
  `((global menu-item ,(string-trim-right
                        (format-mode-line mode-line-misc-info))
            ignore)))

(defvar +tab-bar-show-original nil
  "Original value of `tab-bar-show'.")

(defun +tab-bar-basename ()
  "Generate the tab name from the basename of the buffer of the
  selected window."
  (let* ((tab-file-name (buffer-file-name (window-buffer (minibuffer-selected-window)))))
    (if tab-file-name
        (file-name-nondirectory tab-file-name)
      (+tab-bar-tab-name-truncated-left))))

(defun +tab-bar-tab-name-truncated-left ()
  "Generate the tab name from the buffer of the selected window.
This is just like `tab-bar-tab-name-truncated', but truncates the
name to the left."
  (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
        (ellipsis (cond
                   (tab-bar-tab-name-ellipsis)
                   ((char-displayable-p ?…) "…")
                   ("...")))
        (l-ell (length ellipsis))
        (l-name (length tab-name)))
    (if (< (length tab-name) tab-bar-tab-name-truncated-max)
        tab-name
      (propertize (concat
                   (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
                     ellipsis)
                   (truncate-string-to-width tab-name l-name
                    (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
                  'help-echo tab-name))))


;; Emacs 27

(defun +tab-bar-misc-info-27 (output &rest _)
  "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27.
This is :filter-return advice for `tab-bar-make-keymap-1'."
  (let* ((reserve (length (format-mode-line mode-line-misc-info)))
         (str (propertize " "
                          'display `(space :align-to (- right (- 0 right-margin)
                                                        ,reserve)))))
    (prog1 (append output
             `((align-right menu-item ,str nil))
             (+tab-bar-misc-info)))))


;; Emacs 28

(defvar +tab-bar-format-original nil
  "Original value of `tab-bar-format'.")

(defun +tab-bar-misc-info-28 ()
  "Display `mode-line-misc-info', right-aligned, on Emacs 28."
  (append (unless (memq 'tab-bar-format-align-right tab-bar-format)
            '(tab-bar-format-align-right))
          '(+tab-bar-misc-info)))



(define-minor-mode +tab-bar-misc-info-mode
  "Show the `mode-line-misc-info' in the `tab-bar'."
  :lighter ""
  :global t
  (if +tab-bar-misc-info-mode
      (progn                            ; Enable
        (setq +tab-bar-show-original tab-bar-show)
        (cond
         ((boundp 'tab-bar-format)       ; Emacs 28
          (setq +tab-bar-format-original tab-bar-format)
          (unless (memq '+tab-bar-misc-info tab-bar-format)
            (setq tab-bar-format
                  (append tab-bar-format (+tab-bar-misc-info-28)))))
         ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
          (advice-add 'tab-bar-make-keymap-1 :filter-return
                      '+tab-bar-misc-info-27)))
        (setq tab-bar-show t))
    (progn                              ; Disable
      (setq tab-bar-show +tab-bar-show-original)
      (cond
       ((boundp 'tab-bar-format)        ; Emacs 28
        (setq tab-bar-format +tab-bar-format-original))
       ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
        (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))



(provide '+tab-bar)
;;; +tab-bar.el ends here