`tool-bar-add-item', `tool-bar-add-item-from-menu' and related
functions.")
+(defvar secondary-tool-bar-map nil
+ "Optional secondary keymap for the tool bar.
+
+If non-nil, tool bar items defined within this map are displayed
+in a line below the tool bar if the `tool-bar-position' frame
+parameter is set to `top', and above the tool bar it is set to
+`bottom'.")
+
(global-set-key [tool-bar]
`(menu-item ,(purecopy "tool bar") ignore
:filter tool-bar-make-keymap))
(defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
-(defun tool-bar--cache-key ()
+(defsubst tool-bar--cache-key ()
(cons (frame-terminal) (sxhash-eq tool-bar-map)))
+(defsubst tool-bar--secondary-cache-key ()
+ (cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
+
(defun tool-bar--flush-cache ()
"Remove all cached entries that refer to the current `tool-bar-map'."
(let ((id (sxhash-eq tool-bar-map))
+ (secondary-id (and secondary-tool-bar-map
+ (sxhash-eq secondary-tool-bar-map)))
(entries nil))
(maphash (lambda (k _)
- (when (equal (cdr k) id)
+ (when (or (equal (cdr k) id)
+ (equal (cdr k) secondary-id))
(push k entries)))
tool-bar-keymap-cache)
(dolist (k entries)
(defun tool-bar-make-keymap (&optional _ignore)
"Generate an actual keymap from `tool-bar-map'.
+If `secondary-tool-bar-map' is non-nil, take it into account as well.
Its main job is to figure out which images to use based on the display's
color capability and based on the available image libraries."
- (or (gethash (tool-bar--cache-key) tool-bar-keymap-cache)
- (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache)
- (tool-bar-make-keymap-1))))
-
-(defun tool-bar-make-keymap-1 ()
- "Generate an actual keymap from `tool-bar-map', without caching."
+ (let* ((key (tool-bar--cache-key))
+ (base-keymap
+ (or (gethash key tool-bar-keymap-cache)
+ (setf (gethash key tool-bar-keymap-cache)
+ (tool-bar-make-keymap-1))))
+ (secondary-keymap
+ (and secondary-tool-bar-map
+ (or (gethash (tool-bar--secondary-cache-key)
+ tool-bar-keymap-cache)
+ (setf (gethash (tool-bar--secondary-cache-key)
+ tool-bar-keymap-cache)
+ (tool-bar-make-keymap-1
+ secondary-tool-bar-map))))))
+ (if secondary-keymap
+ (or (ignore-errors
+ (progn
+ ;; Determine the value of the `tool-bar-position' frame
+ ;; parameter.
+ (let ((position (frame-parameter nil 'tool-bar-position)))
+ (cond ((eq position 'top)
+ ;; Place `base-keymap' above `secondary-keymap'.
+ (append base-keymap (list (list (gensym)
+ 'menu-item
+ "" 'ignore
+ :wrap t))
+ (cdr secondary-keymap)))
+ ((eq position 'bottom)
+ ;; Place `secondary-keymap' above `base-keymap'.
+ (append secondary-keymap (list (list (gensym)
+ 'menu-item
+ "" 'ignore
+ :wrap t))
+ (cdr base-keymap)))
+ ;; If the tool bar position isn't known, don't
+ ;; display the secondary keymap at all.
+ (t base-keymap)))))
+ ;; If combining both keymaps fails, return the base
+ ;; keymap.
+ base-keymap)
+ base-keymap)))
+
+(defun tool-bar-make-keymap-1 (&optional map)
+ "Generate an actual keymap from `tool-bar-map', without caching.
+MAP is either a keymap to use as a source for menu items, or nil,
+in which case the value of `tool-bar-map' is used instead."
(mapcar (lambda (bind)
(let (image-exp plist)
(when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
bind))
(plist-put plist :image image))))
bind))
- tool-bar-map))
+ (or map tool-bar-map)))
;;;###autoload
(defun tool-bar-add-item (icon def key &rest props)
(modify-all-frames-parameters
(list (cons 'tool-bar-position val))))))
+\f
+
+;; Modifier mode.
+;; This displays a small tool bar containing modifier keys
+;; above or below the main tool bar itself.
+
+(declare-function set-text-conversion-style "textconv.c")
+
+;; These functions are very similar to their counterparts in
+;; simple.el, but allow combining multiple modifier buttons together.
+
+(defun tool-bar-apply-modifiers (event modifiers)
+ "Apply the specified list of MODIFIERS to EVENT.
+MODIFIERS must be a list containing only the symbols `alt',
+`super', `hyper', `shift', `control' and `meta'.
+Return EVENT with the specified modifiers applied."
+ (dolist (modifier modifiers)
+ (cond
+ ((eq modifier 'alt)
+ (setq event (event-apply-modifier event 'alt 22 "A-")))
+ ((eq modifier 'super)
+ (setq event (event-apply-modifier event 'super 23 "s-")))
+ ((eq modifier 'hyper)
+ (setq event (event-apply-modifier event 'hyper 24 "H-")))
+ ((eq modifier 'shift)
+ (setq event (event-apply-modifier event 'shift 25 "S-")))
+ ((eq modifier 'control)
+ (setq event (event-apply-modifier event 'control 26 "C-")))
+ ((eq modifier 'meta)
+ (setq event (event-apply-modifier event 'meta 27 "M-")))))
+ event)
+
+(defvar overriding-text-conversion-style)
+
+(defun tool-bar-event-apply-alt-modifier (_ignore-prompt)
+ "Like `event-apply-alt-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(alt)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(defun tool-bar-event-apply-super-modifier (_ignore-prompt)
+ "Like `event-apply-super-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(super)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(defun tool-bar-event-apply-hyper-modifier (_ignore-prompt)
+ "Like `event-apply-hyper-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(hyper)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(defun tool-bar-event-apply-shift-modifier (_ignore-prompt)
+ "Like `event-apply-shift-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(shift)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(defun tool-bar-event-apply-control-modifier (_ignore-prompt)
+ "Like `event-apply-control-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(control)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(defun tool-bar-event-apply-meta-modifier (_ignore-prompt)
+ "Like `event-apply-meta-modifier'.
+However, take additional modifier tool bar items into account;
+apply any extra modifiers bound to subsequent `tool-bar' events."
+ ;; Save the previously used text conversion style.
+ (let ((old-text-conversion-style text-conversion-style))
+ ;; Disable text conversion.
+ (when (fboundp 'set-text-conversion-style)
+ (set-text-conversion-style nil))
+ (unwind-protect
+ (progn
+ ;; Display the on screen keyboard.
+ (frame-toggle-on-screen-keyboard nil nil)
+ (let* ((modifiers '(meta)) event1
+ (overriding-text-conversion-style nil)
+ (event (read-event)))
+ ;; Combine any more modifier key presses.
+ (while (eq event 'tool-bar)
+ (setq event1 (event-basic-type (read-event)))
+ ;; Reject unknown tool bar events.
+ (unless (memq event1 '(alt super hyper shift control meta))
+ (user-error "Unknown tool-bar event %s" event1))
+ ;; If `event' is the name of a modifier key, apply that
+ ;; modifier key as well.
+ (unless (memq event1 modifiers)
+ (push event1 modifiers))
+ ;; Read another event.
+ (setq event (read-event)))
+ ;; EVENT is a keyboard event to which the specified list of
+ ;; modifier keys should be applied.
+ (vector (tool-bar-apply-modifiers event modifiers))))
+ ;; Re-enable text conversion if necessary.
+ (unless (or (not (fboundp 'set-text-conversion-style))
+ (eq old-text-conversion-style text-conversion-style))
+ (set-text-conversion-style old-text-conversion-style)))))
+
+(define-minor-mode modifier-bar-mode
+ "Toggle display of the modifier bar.
+
+When enabled, a small tool bar will be displayed next to the tool
+bar containing items bound to
+`tool-bar-event-apply-control-modifier' and its related commands,
+which see."
+ :init-value nil
+ :global t
+ :group 'tool-bar
+ (if modifier-bar-mode
+ (progn
+ (setq secondary-tool-bar-map
+ ;; The commands specified in the menu items here are not
+ ;; used. Instead, Emacs relies on each of the tool bar
+ ;; events being specified in `input-decode-map'.
+ `(keymap (control menu-item "Control Key"
+ event-apply-control-modifier
+ :help "Add Control modifier to the following event"
+ :image ,(tool-bar--image-expression "ctrl"))
+ (shift menu-item "Shift Key"
+ event-apply-shift-modifier
+ :help "Add Shift modifier to the following event"
+ :image ,(tool-bar--image-expression "shift"))
+ (meta menu-item "Meta Key"
+ event-apply-meta-modifier
+ :help "Add Meta modifier to the following event"
+ :image ,(tool-bar--image-expression "meta"))
+ (alt menu-item "Alt Key"
+ event-apply-alt-modifier
+ :help "Add Alt modifier to the following event"
+ :image ,(tool-bar--image-expression "alt"))
+ (super menu-item "Super Key"
+ event-apply-super-modifier
+ :help "Add Super modifier to the following event"
+ :image ,(tool-bar--image-expression "super"))
+ (hyper menu-item "Hyper Key"
+ event-apply-hyper-modifier
+ :help "Add Hyper modifier to the following event"
+ :image ,(tool-bar--image-expression "hyper"))))
+ (define-key input-decode-map [tool-bar control]
+ #'tool-bar-event-apply-control-modifier)
+ (define-key input-decode-map [tool-bar shift]
+ #'tool-bar-event-apply-shift-modifier)
+ (define-key input-decode-map [tool-bar meta]
+ #'tool-bar-event-apply-meta-modifier)
+ (define-key input-decode-map [tool-bar alt]
+ #'tool-bar-event-apply-alt-modifier)
+ (define-key input-decode-map [tool-bar super]
+ #'tool-bar-event-apply-super-modifier)
+ (define-key input-decode-map [tool-bar hyper]
+ #'tool-bar-event-apply-hyper-modifier))
+ (setq secondary-tool-bar-map nil))
+ (force-mode-line-update t))
(provide 'tool-bar)
/* Set F->desired_tool_bar_string to a Lisp string representing frame
F's desired tool-bar contents. F->tool_bar_items must have
- been set up previously by calling prepare_menu_bars. */
+ been set up previously by calling prepare_menu_bars.
+
+ Also set F->tool_bar_wraps_p to whether or not the tool bar
+ contains explicit line breaking items. */
static void
build_desired_tool_bar_string (struct frame *f)
size_needed = f->n_tool_bar_items;
/* Reuse f->desired_tool_bar_string, if possible. */
+
if (size < size_needed || NILP (f->desired_tool_bar_string))
- fset_desired_tool_bar_string
- (f, Fmake_string (make_fixnum (size_needed), make_fixnum (' '), Qnil));
+ /* Don't initialize the contents of this string yet, as they will
+ be set within the loop below. */
+ fset_desired_tool_bar_string (f, make_uninit_string (size_needed));
else
{
AUTO_LIST4 (props, Qdisplay, Qnil, Qmenu_item, Qnil);
props, f->desired_tool_bar_string);
}
+ f->tool_bar_wraps_p = false;
+
/* Put a `display' property on the string for the images to display,
put a `menu_item' property on tool-bar items with a value that
is the index of the item in F's tool-bar item vector. */
bool selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
int hmargin, vmargin, relief, idx, end;
+ if (!NILP (PROP (TOOL_BAR_ITEM_WRAP)))
+ {
+ /* This is a line wrap. Instead of building a tool bar
+ item, display a new line character instead. */
+ SSET (f->desired_tool_bar_string, i, '\n');
+
+ /* Set F->tool_bar_wraps_p. This tells redisplay_tool_bar
+ to allow individual rows to be different heights. */
+ f->tool_bar_wraps_p = true;
+ continue;
+ }
+
+ /* Replace this with a space character. */
+ SSET (f->desired_tool_bar_string, i, ' ');
+
/* If image is a vector, choose the image according to the
button state. */
image = PROP (TOOL_BAR_ITEM_IMAGES);
props, f->desired_tool_bar_string);
#undef PROP
}
+
+ /* Now replace each character between i and the end of the tool bar
+ string with spaces, to prevent stray newlines from accumulating
+ when the number of tool bar items decreases. `size' is 0 if the
+ tool bar string is new, but in that case the string will have
+ been completely initialized anyway. */
+
+ for (; i < size; ++i)
+ /* Replace this with a space character. */
+ SSET (f->desired_tool_bar_string, i, ' ');
}
If HEIGHT is -1, we are counting needed tool-bar lines, so don't
count a final empty row in case the tool-bar width exactly matches
the window width.
-*/
+
+ HEIGHT may also be -1 if there is an explicit line wrapping item
+ inside the tool bar; in that case, allow individual rows of the
+ tool bar to differ in height. */
static void
display_tool_bar_line (struct it *it, int height)
++i;
}
- /* Stop at line end. */
+ /* Stop at the end of the iterator, and move to the next line
+ upon a '\n' appearing in the tool bar string. Tool bar
+ strings may contain multiple new line characters when
+ explicit wrap items are encountered. */
+
if (ITERATOR_AT_END_OF_LINE_P (it))
+ {
+ reseat_at_next_visible_line_start (it, false);
+ break;
+ }
+
+ if (ITERATOR_AT_END_P (it))
break;
set_iterator_to_next (it, true);
last->left_box_line_p = true;
/* Make line the desired height and center it vertically. */
- if ((height -= it->max_ascent + it->max_descent) > 0)
+ if (height != -1
+ && (height -= it->max_ascent + it->max_descent) > 0)
{
/* Don't add more than one line height. */
height %= FRAME_LINE_HEIGHT (it->f);
/* Value is the number of pixels needed to make all tool-bar items of
frame F visible. The actual number of glyph rows needed is
returned in *N_ROWS if non-NULL. */
+
static int
tool_bar_height (struct frame *f, int *n_rows, bool pixelwise)
{
struct window *w;
struct it it;
struct glyph_row *row;
+ bool change_height_p;
+ change_height_p = false;
f->tool_bar_redisplayed = true;
/* If frame hasn't a tool-bar window or if it is zero-height, don't
border = 0;
rows = f->n_tool_bar_rows;
- height = max (1, (it.last_visible_y - border) / rows);
- extra = it.last_visible_y - border - height * rows;
- while (it.current_y < it.last_visible_y)
+ if (f->tool_bar_wraps_p)
{
- int h = 0;
- if (extra > 0 && rows-- > 0)
+ /* If the tool bar contains explicit line wrapping items,
+ don't force each row to have a fixed height. */
+
+ while (!ITERATOR_AT_END_P (&it))
+ display_tool_bar_line (&it, -1);
+
+ /* Because changes to individual tool bar items may now
+ change the height of the tool bar, adjust the height of
+ the tool bar window if it is different from the tool bar
+ height in any way. */
+
+ if (it.current_y != it.last_visible_y)
+ change_height_p = true;
+ }
+ else
+ {
+ height = max (1, (it.last_visible_y - border) / rows);
+ extra = it.last_visible_y - border - height * rows;
+
+ while (it.current_y < it.last_visible_y)
{
- h = (extra + rows - 1) / rows;
- extra -= h;
+ int h = 0;
+ if (extra > 0 && rows-- > 0)
+ {
+ h = (extra + rows - 1) / rows;
+ extra -= h;
+ }
+
+ display_tool_bar_line (&it, height + h);
}
- display_tool_bar_line (&it, height + h);
}
}
else
if (!NILP (Vauto_resize_tool_bars))
{
- bool change_height_p = false;
-
/* If we couldn't display everything, change the tool-bar's
height if there is room for more. */
if (IT_STRING_CHARPOS (it) < it.end_charpos)
projects / emacs.git / commitdiff