Commit 39255b9b authored by Juri Linkov's avatar Juri Linkov

Improve customizability and better tab separators.

* lisp/tab-bar.el (tab-bar-tabs-function): New defvar.

* lisp/tab-line.el (tab-line-tab-name-function)
(tab-line-tabs-function): New defvars.
parent ab2f42ca
Pipeline #3260 passed with stage
in 54 minutes and 11 seconds
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
static char * close_xpm[] = { static char * close_xpm[] = {
"9 9 4 1", "9 9 4 1",
" c None", " c None",
". c #CCCCCC", ". c #BFBFBF",
"+ c #000000", "+ c #000000",
"@ c #808080", "@ c #808080",
" ..... ", " ..... ",
......
;;; tab-bar.el --- frame-local tab bar with named persistent window configurations -*- lexical-binding: t; -*- ;;; tab-bar.el --- frame-local tabs with named persistent window configurations -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Free Software Foundation, Inc. ;; Copyright (C) 2019 Free Software Foundation, Inc.
...@@ -23,7 +23,7 @@ ...@@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;; Provides `tab-bar-mode' to control display of the tab-bar and ;; Provides `tab-bar-mode' to control display of the tab bar and
;; bindings for the global tab bar. ;; bindings for the global tab bar.
;; The normal global binding for [tab-bar] (below) uses the value of ;; The normal global binding for [tab-bar] (below) uses the value of
...@@ -36,7 +36,7 @@ ...@@ -36,7 +36,7 @@
(defgroup tab-bar nil (defgroup tab-bar nil
"Frame-local tab bar." "Frame-local tabs."
:group 'convenience :group 'convenience
:version "27.1") :version "27.1")
...@@ -79,13 +79,6 @@ ...@@ -79,13 +79,6 @@
:version "27.1" :version "27.1"
:group 'tab-bar-faces) :group 'tab-bar-faces)
(defface tab-bar-separator
'((t
:inverse-video nil))
"Tab bar face for separator."
:version "27.1"
:group 'tab-bar-faces)
(define-minor-mode tab-bar-mode (define-minor-mode tab-bar-mode
"Toggle the tab bar in all graphical frames (Tab Bar mode)." "Toggle the tab bar in all graphical frames (Tab Bar mode)."
...@@ -108,8 +101,8 @@ ...@@ -108,8 +101,8 @@
(global-set-key [(control tab)] 'tab-bar-switch-to-next-tab))) (global-set-key [(control tab)] 'tab-bar-switch-to-next-tab)))
(defun tab-bar-handle-mouse (event) (defun tab-bar-handle-mouse (event)
"Text-mode emulation of switching tabs on the tab-bar. "Text-mode emulation of switching tabs on the tab bar.
This command is used when you click the mouse in the tab-bar This command is used when you click the mouse in the tab bar
on a console which has no window system but does have a mouse." on a console which has no window system but does have a mouse."
(interactive "e") (interactive "e")
(let* ((x-position (car (posn-x-y (event-start event)))) (let* ((x-position (car (posn-x-y (event-start event))))
...@@ -159,8 +152,7 @@ Its main job is to show tabs in the tab bar." ...@@ -159,8 +152,7 @@ Its main job is to show tabs in the tab bar."
(puthash key tab-bar-map tab-bar-keymap-cache))))) (puthash key tab-bar-map tab-bar-keymap-cache)))))
(defvar tab-bar-separator (defvar tab-bar-separator nil)
(propertize " " 'face 'tab-bar-separator))
(defvar tab-bar-button-new (defvar tab-bar-button-new
(propertize " + " (propertize " + "
...@@ -173,7 +165,7 @@ Its main job is to show tabs in the tab bar." ...@@ -173,7 +165,7 @@ Its main job is to show tabs in the tab bar."
"Button for creating a new tab.") "Button for creating a new tab.")
(defvar tab-bar-button-close (defvar tab-bar-button-close
(propertize "x" (propertize " x"
'display `(image :type xpm 'display `(image :type xpm
:file ,(expand-file-name :file ,(expand-file-name
"images/tabs/close.xpm" "images/tabs/close.xpm"
...@@ -188,9 +180,16 @@ Its main job is to show tabs in the tab bar." ...@@ -188,9 +180,16 @@ Its main job is to show tabs in the tab bar."
"Generate tab name in the context of the selected frame." "Generate tab name in the context of the selected frame."
(mapconcat (mapconcat
(lambda (w) (buffer-name (window-buffer w))) (lambda (w) (buffer-name (window-buffer w)))
(window-list) (window-list-1 (frame-first-window) 'nomini)
", ")) ", "))
(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).
For example, '((tab (name . \"Tab 1\")) (current-tab (name . \"Tab 2\")))
By default, use function `tab-bar-tabs'.")
(defun tab-bar-tabs () (defun tab-bar-tabs ()
"Return a list of tabs belonging to the selected frame. "Return a list of tabs belonging to the selected frame.
Ensure the frame parameter `tabs' is pre-populated. Ensure the frame parameter `tabs' is pre-populated.
...@@ -203,13 +202,15 @@ Return its existing value or a new value." ...@@ -203,13 +202,15 @@ Return its existing value or a new value."
(defun tab-bar-make-keymap-1 () (defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching." "Generate an actual keymap from `tab-bar-map', without caching."
(let ((i 0)) (let ((separator (or tab-bar-separator (if window-system " " "|")))
(i 0))
(append (append
'(keymap (mouse-1 . tab-bar-handle-mouse)) '(keymap (mouse-1 . tab-bar-handle-mouse))
(mapcan (mapcan
(lambda (tab) (lambda (tab)
(setq i (1+ i)) (setq i (1+ i))
(append (append
`((,(intern (format "sep-%i" i)) menu-item ,separator ignore))
(cond (cond
((eq (car tab) 'current-tab) ((eq (car tab) 'current-tab)
`((current-tab `((current-tab
...@@ -233,13 +234,11 @@ Return its existing value or a new value." ...@@ -233,13 +234,11 @@ Return its existing value or a new value."
menu-item "" menu-item ""
,(lambda () ,(lambda ()
(interactive) (interactive)
(tab-bar-close-tab tab)))) (tab-bar-close-tab tab))))))
(when (and (stringp tab-bar-separator) (funcall tab-bar-tabs-function))
(> (length tab-bar-separator) 0))
`((,(intern (format "sep-%i" i)) menu-item ,tab-bar-separator ignore)))))
(tab-bar-tabs))
(when tab-bar-button-new (when tab-bar-button-new
`((add-tab menu-item ,tab-bar-button-new tab-bar-add-tab `((sep-add-tab menu-item ,separator ignore)
(add-tab menu-item ,tab-bar-button-new tab-bar-add-tab
:help "New tab")))))) :help "New tab"))))))
......
;;; tab-line.el --- window-local tab line with window buffers -*- lexical-binding: t; -*- ;;; tab-line.el --- window-local tabs with window buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Free Software Foundation, Inc. ;; Copyright (C) 2019 Free Software Foundation, Inc.
...@@ -31,7 +31,7 @@ ...@@ -31,7 +31,7 @@
(defgroup tab-line nil (defgroup tab-line nil
"Window-local tab line." "Window-local tabs."
:group 'convenience :group 'convenience
:version "27.1") :version "27.1")
...@@ -70,7 +70,7 @@ ...@@ -70,7 +70,7 @@
:background "grey75") :background "grey75")
(t (t
:inverse-video t)) :inverse-video t))
"Tab line face for non-selected tabs." "Tab line face for non-selected tab."
:version "27.1" :version "27.1"
:group 'tab-line-faces) :group 'tab-line-faces)
...@@ -82,7 +82,7 @@ ...@@ -82,7 +82,7 @@
(defface tab-line-close-highlight (defface tab-line-close-highlight
'((t :foreground "red")) '((t :foreground "red"))
"Tab line face for highlighting." "Tab line face for highlighting of the close button."
:version "27.1" :version "27.1"
:group 'tab-line-faces) :group 'tab-line-faces)
...@@ -90,11 +90,10 @@ ...@@ -90,11 +90,10 @@
(defvar tab-line-tab-map (defvar tab-line-tab-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [tab-line mouse-1] 'tab-line-select-tab) (define-key map [tab-line mouse-1] 'tab-line-select-tab)
(define-key map [tab-line mouse-2] 'tab-line-select-tab) (define-key map [tab-line mouse-2] 'tab-line-close-tab)
(define-key map [tab-line mouse-4] 'tab-line-switch-to-prev-tab) (define-key map [tab-line mouse-4] 'tab-line-switch-to-prev-tab)
(define-key map [tab-line mouse-5] 'tab-line-switch-to-next-tab) (define-key map [tab-line mouse-5] 'tab-line-switch-to-next-tab)
(define-key map "\C-m" 'tab-line-select-tab) (define-key map "\C-m" 'tab-line-select-tab)
(define-key map [follow-link] 'mouse-face)
map) map)
"Local keymap for `tab-line-mode' window tabs.") "Local keymap for `tab-line-mode' window tabs.")
...@@ -103,7 +102,6 @@ ...@@ -103,7 +102,6 @@
(define-key map [tab-line mouse-1] 'tab-line-add-tab) (define-key map [tab-line mouse-1] 'tab-line-add-tab)
(define-key map [tab-line mouse-2] 'tab-line-add-tab) (define-key map [tab-line mouse-2] 'tab-line-add-tab)
(define-key map "\C-m" 'tab-line-add-tab) (define-key map "\C-m" 'tab-line-add-tab)
(define-key map [follow-link] 'mouse-face)
map) map)
"Local keymap to add `tab-line-mode' window tabs.") "Local keymap to add `tab-line-mode' window tabs.")
...@@ -111,12 +109,11 @@ ...@@ -111,12 +109,11 @@
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [tab-line mouse-1] 'tab-line-close-tab) (define-key map [tab-line mouse-1] 'tab-line-close-tab)
(define-key map [tab-line mouse-2] 'tab-line-close-tab) (define-key map [tab-line mouse-2] 'tab-line-close-tab)
(define-key map [follow-link] 'mouse-face)
map) map)
"Local keymap to close `tab-line-mode' window tabs.") "Local keymap to close `tab-line-mode' window tabs.")
(defvar tab-line-separator " ") (defvar tab-line-separator nil)
(defvar tab-line-tab-name-ellipsis (defvar tab-line-tab-name-ellipsis
(if (char-displayable-p ?) "…" "...")) (if (char-displayable-p ?) "…" "..."))
...@@ -135,7 +132,7 @@ ...@@ -135,7 +132,7 @@
"Button for creating a new tab.") "Button for creating a new tab.")
(defvar tab-line-button-close (defvar tab-line-button-close
(propertize "x" (propertize " x"
'display `(image :type xpm 'display `(image :type xpm
:file ,(expand-file-name :file ,(expand-file-name
"images/tabs/close.xpm" "images/tabs/close.xpm"
...@@ -148,9 +145,16 @@ ...@@ -148,9 +145,16 @@
"Button for closing the clicked tab.") "Button for closing the clicked tab.")
(defvar tab-line-tab-name-function #'tab-line-tab-name
"Function to get a tab name.
Function gets two arguments: tab to get name for and a list of tabs
to display. By default, use function `tab-line-tab-name'.")
(defun tab-line-tab-name (buffer &optional buffers) (defun tab-line-tab-name (buffer &optional buffers)
"Generate tab name from BUFFER. "Generate tab name from BUFFER.
Reduce tab width proportionally to space taken by other tabs." Reduce tab width proportionally to space taken by other tabs.
This function can be overridden by changing the default value of the
variable `tab-line-tab-name-function'."
(let ((tab-name (buffer-name buffer)) (let ((tab-name (buffer-name buffer))
(limit (when buffers (limit (when buffers
(max 1 (- (/ (window-width) (length buffers)) 3))))) (max 1 (- (/ (window-width) (length buffers)) 3)))))
...@@ -161,10 +165,22 @@ Reduce tab width proportionally to space taken by other tabs." ...@@ -161,10 +165,22 @@ Reduce tab width proportionally to space taken by other tabs."
'help-echo tab-name)))) 'help-echo tab-name))))
(defvar tab-line-tabs-limit 15 (defvar tab-line-tabs-limit 15
"Maximum number of buffer tabs displayed in the window tab-line.") "Maximum number of buffer tabs displayed in the tab line.")
(defun tab-line-tabs (&optional window) (defvar tab-line-tabs-function #'tab-line-tabs
(let* ((buffer (window-buffer window)) "Function to get a list of tabs to display in the tab line.
This function should return either a list of buffers whose names will
be displayed, or just a list of strings to display in the tab line.
By default, use function `tab-line-tabs'.")
(defun tab-line-tabs ()
"Return a list of tabs that should be displayed in the tab line.
By default returns a list of window buffers, i.e. buffers previously
shown in the same window where the tab line is displayed.
This list can be overridden by changing the default value of the
variable `tab-line-tabs-function'."
(let* ((window (selected-window))
(buffer (window-buffer window))
(next-buffers (seq-remove (lambda (b) (eq b buffer)) (next-buffers (seq-remove (lambda (b) (eq b buffer))
(window-next-buffers window))) (window-next-buffers window)))
(next-buffers (seq-filter #'buffer-live-p next-buffers)) (next-buffers (seq-filter #'buffer-live-p next-buffers))
...@@ -191,25 +207,26 @@ Reduce tab width proportionally to space taken by other tabs." ...@@ -191,25 +207,26 @@ Reduce tab width proportionally to space taken by other tabs."
(defun tab-line-format () (defun tab-line-format ()
"Template for displaying tab line for selected window." "Template for displaying tab line for selected window."
(let* ((window (selected-window)) (let* ((window (selected-window))
(buffer (window-buffer window)) (selected-buffer (window-buffer window))
(buffer-tabs (tab-line-tabs window))) (tabs (funcall tab-line-tabs-function))
(separator (or tab-line-separator (if window-system " " "|"))))
(append (append
(mapcar (mapcar
(lambda (b) (lambda (tab)
(concat (concat
(or tab-line-separator "") separator
(apply 'propertize (concat (propertize (apply 'propertize (concat (propertize
(tab-line-tab-name b buffer-tabs) (funcall tab-line-tab-name-function tab tabs)
'keymap tab-line-tab-map) 'keymap tab-line-tab-map)
tab-line-button-close) tab-line-button-close)
`( `(
buffer ,b tab ,tab
face ,(if (eq b buffer) face ,(if (eq tab selected-buffer)
'tab-line-tab 'tab-line-tab
'tab-line-tab-inactive) 'tab-line-tab-inactive)
mouse-face tab-line-highlight)))) mouse-face tab-line-highlight))))
buffer-tabs) tabs)
(list (concat tab-line-separator tab-line-button-new))))) (list (concat separator tab-line-button-new)))))
(defun tab-line-add-tab (&optional e) (defun tab-line-add-tab (&optional e)
...@@ -227,7 +244,7 @@ using the `previous-buffer' command." ...@@ -227,7 +244,7 @@ using the `previous-buffer' command."
(interactive "e") (interactive "e")
(let* ((posnp (event-start e)) (let* ((posnp (event-start e))
(window (posn-window posnp)) (window (posn-window posnp))
(buffer (get-pos-property 1 'buffer (car (posn-string posnp)))) (buffer (get-pos-property 1 'tab (car (posn-string posnp))))
(window-buffer (window-buffer window)) (window-buffer (window-buffer window))
(next-buffers (seq-remove (lambda (b) (eq b window-buffer)) (next-buffers (seq-remove (lambda (b) (eq b window-buffer))
(window-next-buffers window))) (window-next-buffers window)))
...@@ -260,7 +277,7 @@ using the `previous-buffer' command." ...@@ -260,7 +277,7 @@ using the `previous-buffer' command."
(interactive "e") (interactive "e")
(let* ((posnp (event-start e)) (let* ((posnp (event-start e))
(window (posn-window posnp)) (window (posn-window posnp))
(buffer (get-pos-property 1 'buffer (car (posn-string posnp))))) (buffer (get-pos-property 1 'tab (car (posn-string posnp)))))
(with-selected-window window (with-selected-window window
(if (eq buffer (current-buffer)) (if (eq buffer (current-buffer))
(bury-buffer) (bury-buffer)
......
...@@ -12764,7 +12764,7 @@ build_desired_tab_bar_string (struct frame *f) ...@@ -12764,7 +12764,7 @@ build_desired_tab_bar_string (struct frame *f)
caption = Qnil; caption = Qnil;
/* Prepare F->desired_tab_bar_string. Make a new string. */ /* Prepare F->desired_tab_bar_string. Make a new string. */
fset_desired_tab_bar_string (f, build_string (" ")); fset_desired_tab_bar_string (f, build_string (""));
/* Put a `display' property on the string for the captions to display, /* Put a `display' property on the string for the captions to display,
put a `menu_item' property on tab-bar items with a value that put a `menu_item' property on tab-bar items with a value that
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment