291 lines
12 KiB
EmacsLisp
291 lines
12 KiB
EmacsLisp
;;; +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)
|
||
|
||
(defface +tab-bar-extra
|
||
'((t :inherit (tab-bar font-lock-comment-face)))
|
||
"Tab bar face for extra information, like the menu-bar and time."
|
||
:group 'basic-faces)
|
||
|
||
|
||
;; Common
|
||
|
||
(defun +tab-bar-misc-info ()
|
||
"Display `mode-line-misc-info', formatted for the tab-bar."
|
||
`((misc-info menu-item ,(string-trim-right
|
||
(format-mode-line mode-line-misc-info))
|
||
ignore)))
|
||
|
||
(defun +tab-bar-tracking-mode ()
|
||
"Display `tracking-mode-line-buffers' in the tab-bar."
|
||
;; TODO: write something to convert a mode-line construct to a tab-bar
|
||
;; construct.
|
||
(when tracking-mode
|
||
(cl-loop for i from 0 below (length tracking-mode-line-buffers)
|
||
as item = (nth i tracking-mode-line-buffers)
|
||
collect (append (list (intern (format "tracking-mode-line-%s" i))
|
||
'menu-item
|
||
(format-mode-line item))
|
||
(if-let ((keymap (plist-get item 'keymap)))
|
||
(list (alist-get 'down-mouse-1 (cdadr keymap)))
|
||
(list #'ignore))
|
||
(when-let ((help (plist-get item 'help-echo)))
|
||
(list :help help))))))
|
||
|
||
(defun +tab-bar-date ()
|
||
"Display `display-time-string' in the tab-bar."
|
||
(when display-time-mode
|
||
`((date-time-string menu-item
|
||
,(propertize display-time-string
|
||
'face 'font-lock-comment-face)
|
||
ignore
|
||
:help (discord-date-string)))))
|
||
|
||
(defcustom +tab-bar-emms-max-length 24
|
||
"Maximum length of `+tab-bar-emms'."
|
||
:type 'number)
|
||
|
||
(defun +tab-bar-emms ()
|
||
"Display EMMS now playing information."
|
||
(when (and emms-mode-line-mode
|
||
emms-player-playing-p)
|
||
(let ((now-playing (+string-truncate (emms-mode-line-playlist-current)
|
||
(- +tab-bar-emms-max-length 2))))
|
||
`((emms-now-playing menu-item
|
||
,(concat "{" now-playing "}" " ")
|
||
emms-pause
|
||
:help ,(emms-mode-line-playlist-current))))))
|
||
|
||
(defun +tab-bar-bongo ()
|
||
"Display Bongo now playing information."
|
||
(when-let ((modep bongo-mode-line-indicator-mode)
|
||
(buf (cl-some (lambda (b)
|
||
(with-current-buffer b
|
||
(when-let* ((modep (derived-mode-p 'bongo-playlist-mode))
|
||
(bongo-playlist-buffer b)
|
||
(playingp (bongo-playing-p)))
|
||
b)))
|
||
(buffer-list))))
|
||
`((bongo-now-playing menu-item
|
||
,(concat "{"
|
||
(let ((bongo-field-separator ""))
|
||
(+string-truncate (replace-regexp-in-string
|
||
"\\(.*\\)\\(.*\\)\\(.*\\)"
|
||
"\\1: \\3"
|
||
(bongo-formatted-infoset))
|
||
(- +tab-bar-emms-max-length 2)))
|
||
"}")
|
||
(lambda () (interactive)
|
||
(let ((bongo-playlist-buffer
|
||
;; XXX: I'm sure this is terribly inefficient
|
||
(cl-some (lambda (b)
|
||
(with-current-buffer b
|
||
(when-let* ((modep (derived-mode-p
|
||
'bongo-playlist-mode))
|
||
(bongo-playlist-buffer b)
|
||
(playingp (bongo-playing-p)))
|
||
b)))
|
||
(buffer-list))))
|
||
(with-bongo-playlist-buffer
|
||
(bongo-pause/resume))))
|
||
:help ,(funcall bongo-header-line-function)))))
|
||
|
||
(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)))))
|
||
(concat " "
|
||
(if tab-file-name
|
||
(file-name-nondirectory tab-file-name)
|
||
(+tab-bar-tab-name-truncated-left)))))
|
||
|
||
;;; FIXME this doesn't work...
|
||
;; (defvar +tab-bar-tab-min-width 8
|
||
;; "Minimum width of a tab on the tab bar.")
|
||
|
||
;; (defvar +tab-bar-tab-max-width 24
|
||
;; "Maximum width of a tab on the tab bar.")
|
||
|
||
;; (defun +tab-bar-fluid-calculate-width ()
|
||
;; "Calculate the width of each tab in the tab-bar."
|
||
;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
|
||
;; (tab-bar-avail-width (frame-width))
|
||
;; (tab-bar-tab-count (length (tab-bar-tabs)))
|
||
;; (tab-bar-close-button-char-width 1)
|
||
;; (tab-bar-add-tab-button-char-width 1)
|
||
;; (tab-bar-total-width
|
||
;; (length (mapconcat
|
||
;; (lambda (el)
|
||
;; (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
|
||
;; (substring-no-properties (eval str))))
|
||
;; tab-bar-list)))
|
||
;; (tab-bar-total-tab-width
|
||
;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
|
||
;; tab-bar-add-tab-button-char-width
|
||
;; (length (mapconcat
|
||
;; (lambda (el)
|
||
;; (substring-no-properties (alist-get 'name el)))
|
||
;; (tab-bar-tabs)))))
|
||
;; (tab-bar-total-nontab-width (- tab-bar-total-width
|
||
;; tab-bar-total-tab-width)))
|
||
;; (min +tab-bar-tab-max-width
|
||
;; (max +tab-bar-tab-min-width
|
||
;; (/ (- tab-bar-avail-width
|
||
;; tab-bar-total-tab-width
|
||
;; tab-bar-total-nontab-width)
|
||
;; tab-bar-tab-count)))))
|
||
|
||
;; (defun +tab-bar-fluid-width ()
|
||
;; "Generate the tab name to fluidly fit in the given space."
|
||
;; (let* ((tab-file-name (buffer-file-name (window-buffer
|
||
;; (minibuffer-selected-window)))))
|
||
;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
|
||
;; (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))))
|
||
|
||
|
||
;;; Menu bar
|
||
;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el
|
||
|
||
(defun +tab-bar-menu-bar (event)
|
||
"Pop up the same menu as displayed by the menu bar.
|
||
Used by `tab-bar-format-menu-bar'."
|
||
(interactive "e")
|
||
(let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t))))
|
||
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
||
(map-keymap (lambda (key binding)
|
||
(when (consp binding)
|
||
(define-key-after menu (vector key)
|
||
(copy-sequence binding))))
|
||
(menu-bar-keymap))
|
||
(popup-menu menu event)))
|
||
|
||
(defcustom +tab-bar-menu-bar-icon " Emacs "
|
||
"The string to use for the tab-bar menu icon."
|
||
:type 'string)
|
||
|
||
(defun +tab-bar-format-menu-bar ()
|
||
"Produce the Menu button for the tab bar that shows the menu bar."
|
||
`((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra)
|
||
+tab-bar-menu-bar :help "Menu Bar")))
|
||
|
||
|
||
;;; Tab bar format tabs
|
||
|
||
(require 'el-patch)
|
||
(el-patch-feature tab-bar)
|
||
(with-eval-after-load 'tab-bar
|
||
(el-patch-defun tab-bar--format-tab (tab i)
|
||
"Format TAB using its index I and return the result as a keymap."
|
||
(append
|
||
(el-patch-remove
|
||
`((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
|
||
(cond
|
||
((eq (car tab) 'current-tab)
|
||
`((current-tab
|
||
menu-item
|
||
,(funcall tab-bar-tab-name-format-function tab i)
|
||
ignore
|
||
:help "Current tab")))
|
||
(t
|
||
`((,(intern (format "tab-%i" i))
|
||
menu-item
|
||
,(funcall tab-bar-tab-name-format-function tab i)
|
||
,(alist-get 'binding tab)
|
||
:help "Click to visit tab"))))
|
||
(when (alist-get 'close-binding tab)
|
||
`((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
|
||
menu-item ""
|
||
,(alist-get 'close-binding tab)))))))
|
||
|
||
|
||
;; 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
|