Commit 6474abc3 authored by Juri Linkov's avatar Juri Linkov

Use images for new/close buttons in tab-bar and tab-line.

* etc/images/tabs/new.xpm:
* etc/images/tabs/close.xpm:
New files.

* lisp/tab-bar.el (tab-bar-separator): New face.
(tab-bar-separator, tab-bar-button-new, tab-bar-button-close):
Use display property with images in default values.

* lisp/tab-line.el (tab-line-button-new, tab-line-button-close):
Use display property with images in default values.

* src/xdisp.c (tab_bar_item_info): Add new arg close_p and set it
to the value of property `close' at charpos.
(get_tab_bar_item): Add new arg close_p.
(handle_tab_bar_click): Add ctrl_modifier when close_p is non-nil.
(Fdump_tab_bar_row): Fix crash for non-X builds.
parent 8d30e1bc
Pipeline #3142 passed with stage
in 53 minutes and 55 seconds
This directory contains icons for the Tabs user interface.
COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: close.xpm new.xpm
Author: Juri Linkov <juri@linkov.net>
Copyright (C) 2019 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
/* XPM */
static char * close_xpm[] = {
"9 9 4 1",
" c None",
". c #CCCCCC",
"+ c #000000",
"@ c #808080",
" ..... ",
" ....... ",
"..+@.@+..",
"..@+@+@..",
"...@+@...",
"..@+@+@..",
"..+@.@+..",
" ....... ",
" ..... "};
/* XPM */
static char * new_xpm[] = {
"9 9 4 1",
" c None",
". c #BFBFBF",
"+ c #808080",
"@ c #000000",
".........",
"....+....",
"....@....",
"....@....",
".+@@@@@+.",
"....@....",
"....@....",
"....+....",
"........."};
......@@ -47,37 +47,45 @@
:version "27.1")
(defface tab-bar
'((default
:box (:line-width 1 :style released-button)
:foreground "black"
:background "white")
(((type x w32 ns) (class color))
:background "grey75")
'((((type x w32 ns) (class color))
:height 1.1
:background "grey85"
:foreground "black")
(((type x) (class mono))
:background "grey"))
:background "grey")
(t
:inverse-video t))
"Tab bar face."
:version "27.1"
:group 'tab-bar-faces)
(defface tab-bar-tab
'((default
:inherit tab-bar-tab-inactive)
'((((class color) (min-colors 88))
:box (:line-width 1 :style released-button))
(t
:background "grey75"))
:inverse-video nil))
"Tab bar face for selected tab."
:version "27.1"
:group 'tab-bar-faces)
(defface tab-bar-tab-inactive
'((((class color) (min-colors 88))
:box (:line-width -15 :style pressed-button)
:background "grey60")
'((default
:inherit tab-bar-tab)
(((class color) (min-colors 88))
:background "grey75")
(t
:inherit highlight))
:inverse-video t))
"Tab bar face for non-selected tab."
:version "27.1"
: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
"Toggle the tab bar in all graphical frames (Tab Bar mode)."
......@@ -99,7 +107,7 @@
(global-set-key [(control shift tab)] 'tab-bar-switch-to-prev-tab)
(global-set-key [(control tab)] 'tab-bar-switch-to-next-tab)))
(defun tab-bar-mouse (event)
(defun tab-bar-handle-mouse (event)
"Text-mode emulation of switching tabs on 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."
......@@ -113,9 +121,11 @@ on a console which has no window system but does have a mouse."
(lambda (_key binding)
(when (eq (car-safe binding) 'menu-item)
(when (> (+ column (length (nth 1 binding))) x-position)
(call-interactively (nth 2 binding))
;; TODO: handle close
(unless (get-text-property (- x-position column) 'close (nth 1 binding))
(call-interactively (nth 2 binding)))
(throw 'done t))
(setq column (+ column (length (nth 1 binding)) 1))))
(setq column (+ column (length (nth 1 binding))))))
keymap))
;; Clicking anywhere outside existing tabs will add a new tab
(tab-bar-add-tab)))))
......@@ -149,9 +159,30 @@ Its main job is to show tabs in the tab bar."
(puthash key tab-bar-map tab-bar-keymap-cache)))))
(defvar tab-bar-separator " ")
(defvar tab-bar-tab-name-add nil)
(defvar tab-bar-tab-name-close nil)
(defvar tab-bar-separator
(propertize " " 'face 'tab-bar-separator))
(defvar tab-bar-button-new
(propertize " + "
'display `(image :type xpm
:file ,(expand-file-name
"images/tabs/new.xpm"
data-directory)
:margin (2 . 0)
:ascent center))
"Button for creating a new tab.")
(defvar tab-bar-button-close
(propertize "x"
'display `(image :type xpm
:file ,(expand-file-name
"images/tabs/close.xpm"
data-directory)
:margin (2 . 0)
:ascent center)
'close t
:help "Click to close tab")
"Button for closing the clicked tab.")
(defun tab-bar-tab-name ()
"Generate tab name in the context of the selected frame."
......@@ -172,54 +203,44 @@ Return its existing value or a new value."
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
;; Can't check for char-displayable-p in defvar
;; because this file is preloaded.
(unless tab-bar-tab-name-add
(setq tab-bar-tab-name-add
(if (char-displayable-p ?) "➕" "[+]")))
(unless tab-bar-tab-name-close
(setq tab-bar-tab-name-close
;; Need to add space after Unicode char on terminals
;; to avoid clobbering next char by wide Unicode char.
(if (char-displayable-p ?⮿) (if window-system "⮿" "⮿ ") "[x]")))
(let ((i 0))
(append
'(keymap (mouse-1 . tab-bar-mouse))
'(keymap (mouse-1 . tab-bar-handle-mouse))
(mapcan
(lambda (tab)
(setq i (1+ i))
(list (cond
((eq (car tab) 'current-tab)
`(current-tab
menu-item
,(propertize (cdr (assq 'name tab)) 'face 'tab-bar-tab)
ignore
:help "Current tab"))
(t
`(,(intern (format "tab-%i" i))
menu-item
,(propertize (cdr (assq 'name tab)) 'face 'tab-bar-tab-inactive)
,(lambda ()
(interactive)
(tab-bar-select-tab tab))
:help "Click to visit tab")))
`(,(intern (format "close-tab-%i" i))
menu-item
,(concat (propertize tab-bar-tab-name-close
'face (if (eq (car tab) 'current-tab)
'tab-bar-tab
'tab-bar-tab-inactive))
tab-bar-separator)
,(lambda ()
(interactive)
(tab-bar-close-tab tab))
:help "Click to close tab")))
(append
(cond
((eq (car tab) 'current-tab)
`((current-tab
menu-item
,(propertize (concat (cdr (assq 'name tab))
(or tab-bar-button-close ""))
'face 'tab-bar-tab)
ignore
:help "Current tab")))
(t
`((,(intern (format "tab-%i" i))
menu-item
,(propertize (concat (cdr (assq 'name tab))
(or tab-bar-button-close ""))
'face 'tab-bar-tab-inactive)
,(lambda ()
(interactive)
(tab-bar-select-tab tab))
:help "Click to visit tab"))))
`((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
menu-item ""
,(lambda ()
(interactive)
(tab-bar-close-tab tab))))
(when (and (stringp tab-bar-separator)
(> (length tab-bar-separator) 0))
`((,(intern (format "sep-%i" i)) menu-item ,tab-bar-separator ignore)))))
(tab-bar-tabs))
`((add-tab menu-item
,(propertize tab-bar-tab-name-add
'face 'tab-bar-tab-inactive)
tab-bar-add-tab
:help "Click to add tab")))))
(when tab-bar-button-new
`((add-tab menu-item ,tab-bar-button-new tab-bar-add-tab
:help "New tab"))))))
(defun tab-bar-read-tab-name (prompt)
......@@ -279,16 +300,16 @@ Return its existing value or a new value."
(setq tabs (cdr tabs)))
(force-window-update))))
(defun tab-bar-switch-to-prev-tab ()
"Switch to the previous tab."
(interactive)
(defun tab-bar-switch-to-prev-tab (&optional _arg)
"Switch to ARGth previous tab."
(interactive "p")
(let ((prev-tab (tab-bar-find-prev-tab)))
(when prev-tab
(tab-bar-select-tab (car prev-tab)))))
(defun tab-bar-switch-to-next-tab ()
"Switch to the next tab."
(interactive)
(defun tab-bar-switch-to-next-tab (&optional _arg)
"Switch to ARGth next tab."
(interactive "p")
(let* ((tabs (tab-bar-tabs))
(prev-tab (tab-bar-find-prev-tab tabs)))
(if prev-tab
......
......@@ -42,48 +42,51 @@
:version "27.1")
(defface tab-line
'((default :inherit header-line))
'((((type x w32 ns) (class color))
:background "grey85"
:foreground "black")
(((type x) (class mono))
:background "grey")
(t
:inverse-video t))
"Tab line face."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-highlight
'((default :inherit tab-line-tab))
"Tab line face for highlighting."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-close-highlight
'((t :foreground "red"))
"Tab line face for highlighting."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-tab
'((((class color) (min-colors 88))
:box (:line-width -1 :style pressed-button)
:background "white" :foreground "black")
:box (:line-width 1 :style released-button)
:background "grey85")
(t
:inverse-video t))
:inverse-video nil))
"Tab line face for selected tab."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-tab-inactive
'((default
:inherit tab-line)
(((class color) (min-colors 88) (background light))
:weight light
:box (:line-width -1 :color "grey75" :style released-button)
:foreground "grey20" :background "grey90")
(((class color) (min-colors 88) (background dark) )
:weight light
:box (:line-width -1 :color "grey40" :style released-button)
:foreground "grey80" :background "grey30"))
:inherit tab-line-tab)
(((class color) (min-colors 88))
:background "grey75")
(t
:inverse-video t))
"Tab line face for non-selected tabs."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-highlight
'((default :inherit tab-line-tab))
"Tab line face for highlighting."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-close-highlight
'((t :foreground "red"))
"Tab line face for highlighting."
:version "27.1"
:group 'tab-line-faces)
(defvar tab-line-tab-map
(let ((map (make-sparse-keymap)))
(define-key map [tab-line mouse-1] 'tab-line-select-tab)
......@@ -112,15 +115,37 @@
map)
"Local keymap to close `tab-line-mode' window tabs.")
(defvar tab-line-separator " ")
(defvar tab-line-tab-name-ellipsis
(if (char-displayable-p ?) "…" "..."))
(defvar tab-line-tab-name-add
(if (char-displayable-p ?) "➕" "[+]"))
(defvar tab-line-tab-name-close
;; Need to add space after Unicode char on terminals
;; to avoid clobbering next char by wide Unicode char.
(if (char-displayable-p ?⮿) (if window-system "⮿" "⮿ ") "[x]"))
(defvar tab-line-button-new
(propertize " + "
'display `(image :type xpm
:file ,(expand-file-name
"images/tabs/new.xpm"
data-directory)
:margin (2 . 0)
:ascent center)
'keymap tab-line-add-map
'mouse-face 'tab-line-highlight
'help-echo "Click to add tab")
"Button for creating a new tab.")
(defvar tab-line-button-close
(propertize "x"
'display `(image :type xpm
:file ,(expand-file-name
"images/tabs/close.xpm"
data-directory)
:margin (2 . 0)
:ascent center)
'keymap tab-line-tab-close-map
'mouse-face 'tab-line-close-highlight
'help-echo "Click to close tab")
"Button for closing the clicked tab.")
(defun tab-line-tab-name (buffer &optional buffers)
......@@ -171,39 +196,25 @@ Reduce tab width proportionally to space taken by other tabs."
(append
(mapcar
(lambda (b)
(format "%s%s%s"
tab-line-separator
(apply 'propertize (tab-line-tab-name b buffer-tabs)
`(
buffer ,b
face ,(if (eq b buffer)
'tab-line-tab
'tab-line-tab-inactive)
mouse-face tab-line-highlight
keymap ,tab-line-tab-map))
(apply 'propertize tab-line-tab-name-close
`(
help-echo "Click to close tab"
buffer ,b
face ,(if (eq b buffer)
'tab-line-tab
'tab-line-tab-inactive)
mouse-face tab-line-close-highlight
keymap ,tab-line-tab-close-map))))
(concat
(or tab-line-separator "")
(apply 'propertize (concat (propertize
(tab-line-tab-name b buffer-tabs)
'keymap tab-line-tab-map)
tab-line-button-close)
`(
buffer ,b
face ,(if (eq b buffer)
'tab-line-tab
'tab-line-tab-inactive)
mouse-face tab-line-highlight))))
buffer-tabs)
(list (format "%s%s"
tab-line-separator
(apply 'propertize tab-line-tab-name-add
`(
help-echo "Click to add tab"
face tab-line-tab-inactive
mouse-face tab-line-highlight
keymap ,tab-line-add-map)))))))
(list (concat tab-line-separator tab-line-button-new)))))
(defun tab-line-add-tab (&optional e)
(interactive "e")
(if window-system
(if window-system ; (display-popup-menus-p)
(mouse-buffer-menu e) ; like (buffer-menu-open)
;; tty menu doesn't support mouse clicks, so use tmm
(tmm-prompt (mouse-buffer-menu-keymap))))
......
......@@ -12666,7 +12666,6 @@ display_tab_bar (struct window *w)
struct it it;
Lisp_Object items;
int i;
bool has_menu_bar_p = FRAME_MENU_BAR_LINES (f) > 0;
/* Don't do all this for graphical frames. */
#ifdef HAVE_NTGUI
......@@ -12685,7 +12684,7 @@ display_tab_bar (struct window *w)
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
eassert (!FRAME_WINDOW_P (f));
init_iterator (&it, w, -1, -1, f->desired_matrix->rows + (has_menu_bar_p ? 1 : 0), TAB_BAR_FACE_ID);
init_iterator (&it, w, -1, -1, f->desired_matrix->rows + (FRAME_MENU_BAR_LINES (f) > 0 ? 1 : 0), TAB_BAR_FACE_ID);
it.first_visible_x = 0;
it.last_visible_x = FRAME_PIXEL_WIDTH (f);
#elif defined (HAVE_X_WINDOWS) /* X without toolkit. */
......@@ -12695,7 +12694,7 @@ display_tab_bar (struct window *w)
dummy window tab_bar_window. */
struct window *tab_w;
tab_w = XWINDOW (f->tab_bar_window);
init_iterator (&it, tab_w, -1, -1, tab_w->desired_matrix->rows + (has_menu_bar_p ? 1 : 0),
init_iterator (&it, tab_w, -1, -1, tab_w->desired_matrix->rows,
TAB_BAR_FACE_ID);
it.first_visible_x = 0;
it.last_visible_x = FRAME_PIXEL_WIDTH (f);
......@@ -12705,7 +12704,7 @@ display_tab_bar (struct window *w)
{
/* This is a TTY frame, i.e. character hpos/vpos are used as
pixel x/y. */
init_iterator (&it, w, -1, -1, f->desired_matrix->rows + (has_menu_bar_p ? 1 : 0),
init_iterator (&it, w, -1, -1, f->desired_matrix->rows + (FRAME_MENU_BAR_LINES (f) > 0 ? 1 : 0),
TAB_BAR_FACE_ID);
it.first_visible_x = 0;
it.last_visible_x = FRAME_COLS (f);
......@@ -12737,10 +12736,9 @@ display_tab_bar (struct window *w)
if (NILP (string))
break;
/* Display the item, pad with one space. */
if (it.current_x < it.last_visible_x)
display_string (NULL, string, Qnil, 0, 0, &it,
SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string));
SCHARS (string), 0, 0, STRING_MULTIBYTE (string));
}
/* Fill out the line with spaces. */
......@@ -13159,7 +13157,7 @@ redisplay_tab_bar (struct frame *f)
GLYPH doesn't display a tab-bar item. */
static bool
tab_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx)
tab_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx, bool *close_p)
{
Lisp_Object prop;
int charpos;
......@@ -13178,6 +13176,11 @@ tab_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx)
if (! FIXNUMP (prop))
return false;
*prop_idx = XFIXNUM (prop);
*close_p = !NILP (Fget_text_property (make_fixnum (charpos),
Qclose,
f->current_tab_bar_string));
return true;
}
......@@ -13194,7 +13197,7 @@ tab_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx)
static int
get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
int *hpos, int *vpos, int *prop_idx)
int *hpos, int *vpos, int *prop_idx, bool *close_p)
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tab_bar_window);
......@@ -13207,7 +13210,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
/* Get the start of this tab-bar item's properties in
f->tab_bar_items. */
if (!tab_bar_item_info (f, *glyph, prop_idx))
if (!tab_bar_item_info (f, *glyph, prop_idx, close_p))
return -1;
/* Is mouse on the highlighted item? */
......@@ -13238,6 +13241,7 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tab_bar_window);
int hpos, vpos, prop_idx;
bool close_p;
struct glyph *glyph;
Lisp_Object enabled_p;
int ts;
......@@ -13250,7 +13254,7 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
highlight, since tab-bar items are not highlighted in that
case. */
frame_to_window_pixel_xy (w, &x, &y);
ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx);
ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
if (ts == -1
|| (ts != 0 && !NILP (Vmouse_highlight)))
return;
......@@ -13294,7 +13298,7 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
event.kind = TAB_BAR_EVENT;
event.frame_or_window = frame;
event.arg = key;
event.modifiers = modifiers;
event.modifiers = close_p ? ctrl_modifier | modifiers : modifiers;
kbd_buffer_store_event (&event);
f->last_tab_bar_item = -1;
}
......@@ -13318,6 +13322,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y)
int i;
Lisp_Object enabled_p;
int prop_idx;
bool close_p;
enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
bool mouse_down_p;
int rc;
......@@ -13330,7 +13335,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y)
return;
}
rc = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx);
rc = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
if (rc < 0)
{
/* Not on tab-bar item. */
......@@ -20803,11 +20808,13 @@ do nothing. */)
{
#if defined (HAVE_WINDOW_SYSTEM)
struct frame *sf = SELECTED_FRAME ();
struct glyph_matrix *m = XWINDOW (sf->tab_bar_window)->current_matrix;
struct glyph_matrix *m = WINDOWP (sf->tab_bar_window)
? XWINDOW (sf->tab_bar_window)->current_matrix
: sf->current_matrix;
EMACS_INT vpos;
if (NILP (row))
vpos = 0;
vpos = WINDOWP (sf->tab_bar_window) ? 0 : FRAME_MENU_BAR_LINES (sf) > 0 ? 1 : 0;
else
{
CHECK_FIXNUM (row);
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