--- /dev/null
+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)
--- /dev/null
+/* XPM */
+static char * close_xpm[] = {
+"9 9 4 1",
+" c None",
+". c #CCCCCC",
+"+ c #000000",
+"@ c #808080",
+" ..... ",
+" ....... ",
+"..+@.@+..",
+"..@+@+@..",
+"...@+@...",
+"..@+@+@..",
+"..+@.@+..",
+" ....... ",
+" ..... "};
--- /dev/null
+/* XPM */
+static char * new_xpm[] = {
+"9 9 4 1",
+" c None",
+". c #BFBFBF",
+"+ c #808080",
+"@ c #000000",
+".........",
+"....+....",
+"....@....",
+"....@....",
+".+@@@@@+.",
+"....@....",
+"....@....",
+"....+....",
+"........."};
: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)
+
\f
(define-minor-mode tab-bar-mode
"Toggle the tab bar in all graphical frames (Tab Bar mode)."
(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."
(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)))))
(puthash key tab-bar-map tab-bar-keymap-cache)))))
\f
-(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."
(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"))))))
\f
(defun tab-bar-read-tab-name (prompt)
(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
: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)
+
+\f
(defvar tab-line-tab-map
(let ((map (make-sparse-keymap)))
(define-key map [tab-line mouse-1] 'tab-line-select-tab)
map)
"Local keymap to close `tab-line-mode' window tabs.")
+\f
(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.")
\f
(defun tab-line-tab-name (buffer &optional buffers)
(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)))))
\f
(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))))
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
#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. */
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);
{
/* 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);
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. */
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;
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;
}
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);
/* 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? */
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;
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;
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;
}
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;
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. */
{
#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);
projects / emacs.git / commitdiff