emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/android 8ed8f08ed2f: Implement a tool bar containing modifier ke


From: Po Lu
Subject: feature/android 8ed8f08ed2f: Implement a tool bar containing modifier keys
Date: Tue, 4 Jul 2023 04:40:51 -0400 (EDT)

branch: feature/android
commit 8ed8f08ed2ff297754d6db83983d3f8f2822c599
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Implement a tool bar containing modifier keys
    
    * doc/emacs/frames.texi (Tool Bars): Describe modifier bars.
    * doc/lispref/keymaps.texi (Extended Menu Items, Tool Bar):
    Document changes to tool bar menu item handling and secondary
    tool bars.
    * etc/NEWS: Announce changes.
    * lisp/simple.el (event-apply-modifier): Correctly apply Ctrl
    and Shift modifiers to lower case ASCII key events that already
    have other modifiers applied.
    * lisp/tool-bar.el (tool-bar--cache-key)
    (tool-bar--secondary-cache-key): New defsubsts.
    (tool-bar--flush-cache): Flush secondary tool bar cache.
    (tool-bar-make-keymap): Include secondary tool bar if necessary.
    (tool-bar-make-keymap-1): New arg MAP.  Generate a keymap for
    that map if specified, else default to tool-bar-map.
    (set-text-conversion-style, tool-bar-apply-modifiers)
    (overriding-text-conversion-style)
    (tool-bar-event-apply-alt-modifier)
    (tool-bar-event-apply-super-modifier)
    (tool-bar-event-apply-hyper-modifier)
    (tool-bar-event-apply-shift-modifier)
    (tool-bar-event-apply-control-modifier)
    (tool-bar-event-apply-meta-modifier, modifier-bar-mode): New
    functions.
    * src/dispextern.h (enum tool_bar_item_idx): Add
    TOOL_BAR_ITEM_WRAP.
    * src/frame.c (make_frame): Clear new field `tool_bar_wraps_p'.
    * src/frame.h (struct frame): New field `tool_bar_wraps_p'.
    * src/keyboard.c (parse_tool_bar_item): Handle QCwrap properties
    in tool bar menu items.
    (syms_of_keyboard): New defsym QCwrap.
    * src/xdisp.c (build_desired_tool_bar_string): Clear
    f->tool_bar_wraps_p and set it appropriately.  Insert new line
    characters in the tool bar string upon encountering a wrap
    character.
    (display_tool_bar_line): Stop at EOB, not line end.  Reseat on
    the next line upon encountering EOL characters.
    (redisplay_tool_bar): Allow rows to be different heights if
    explicit new lines are present upon the tool bar string.
---
 doc/emacs/frames.texi    |  15 ++
 doc/lispref/keymaps.texi |  16 ++
 etc/NEWS                 |  10 ++
 etc/images/alt.pbm       | Bin 0 -> 85 bytes
 etc/images/ctrl.pbm      | Bin 0 -> 104 bytes
 etc/images/hyper.pbm     | Bin 0 -> 123 bytes
 etc/images/meta.pbm      | Bin 0 -> 104 bytes
 etc/images/shift.pbm     | Bin 0 -> 117 bytes
 etc/images/super.pbm     | Bin 0 -> 123 bytes
 lisp/simple.el           |  40 +++--
 lisp/tool-bar.el         | 376 +++++++++++++++++++++++++++++++++++++++++++++--
 src/dispextern.h         |   6 +-
 src/frame.c              |   1 +
 src/frame.h              |   4 +
 src/keyboard.c           |  42 +++++-
 src/xdisp.c              | 100 +++++++++++--
 16 files changed, 570 insertions(+), 40 deletions(-)

diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 4e09c1c3f67..a968c2a97c5 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1333,6 +1333,21 @@ Parameters,,, elisp, The Emacs Lisp Reference Manual}.  
On macOS the
 tool bar is hidden when the frame is put into fullscreen, but can be
 displayed by moving the mouse pointer to the top of the screen.
 
+@vindex modifier-bar-mode
+@findex modifier-bar-mode
+@cindex displaying modifier keys in the tool bar
+@cindex mode, Modifier Bar
+@cindex Modifier Bar
+  Keyboards often lack one or more of the modifier keys that Emacs
+might want to use, making it difficult or impossible to input key
+sequences that contain them.  Emacs can optionally display a list of
+buttons that act as substitutes for modifier keys within the tool bar;
+these buttons are also referred to as the ``modifier bar''.  Clicking
+an icon within the modifier bar will cause a modifier key to be
+applied to the next keyboard event that is read.  The modifier bar is
+displayed when the global minor mode @code{modifier-bar-mode} is
+enabled; to do so, type @kbd{M-x modifier-bar-mode}.
+
 @node Tab Bars
 @section Tab Bars
 @cindex tab bar mode
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 6d07ad5be2c..a33806ad1cf 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2578,6 +2578,12 @@ function should return the binding to use instead.
 Emacs can call this function at any time that it does redisplay or
 operates on menu data structures, so you should write it so it can
 safely be called at any time.
+
+@item :wrap @var{wrap-p}
+If @var{wrap-p} is non-nil inside a tool bar, the menu item is not
+displayed, but instead causes subsequent items to be displayed on a
+new line.  This is not supported when Emacs uses the GTK+ or Nextstep
+toolkits.
 @end table
 
 @node Menu Separators
@@ -3084,6 +3090,16 @@ specifies the local map to make the definition in.  The 
argument
 @code{tool-bar-add-item-from-menu}.
 @end defun
 
+@vindex secondary-tool-bar-map
+In addition to the tool bar items defined in @code{tool-bar-map},
+Emacs also supports displaying an additional row of ``secondary'' tool
+bar items specified in the keymap @code{secondary-tool-bar-map}.
+These items are normally displayed below those defined within
+@code{tool-bar-map} if the tool bar is positioned at the top of its
+frame, but are displayed above them if the tool bar is positioned at
+the bottom (@pxref{Layout Parameters}.)  They are not displayed if the
+tool bar is positioned at the left or right of a frame.
+
 @defvar auto-resize-tool-bars
 If this variable is non-@code{nil}, the tool bar automatically resizes to
 show all defined tool bar items---but not larger than a quarter of the
diff --git a/etc/NEWS b/etc/NEWS
index 2237e08b68d..30523a08903 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -104,6 +104,11 @@ plus, minus, check-mark, start, etc.
 The 'tool-bar-position' frame parameter can be set to 'bottom' on all
 window systems other than Nextstep.
 
++++
+** New global minor mode 'modifier-bar-mode'.
+When this minor mode is enabled, buttons representing modifier keys
+are displayed along the tool bar.
+
 
 * Editing Changes in Emacs 30.1
 
@@ -566,6 +571,11 @@ directory-local variables as safe.
 
 ** New variable 'inhibit-auto-fill' to temporarily prevent auto-fill.
 
++++
+** New variable 'secondary-tool-bar-map'.
+If non-nil, this variable contains a keymap of menu items that are
+displayed along tool bar items inside 'tool-bar-map'.
+
 ** Functions and variables to transpose sexps
 
 +++
diff --git a/etc/images/alt.pbm b/etc/images/alt.pbm
new file mode 100644
index 00000000000..7d12a48b552
Binary files /dev/null and b/etc/images/alt.pbm differ
diff --git a/etc/images/ctrl.pbm b/etc/images/ctrl.pbm
new file mode 100644
index 00000000000..c3ff817dc7a
Binary files /dev/null and b/etc/images/ctrl.pbm differ
diff --git a/etc/images/hyper.pbm b/etc/images/hyper.pbm
new file mode 100644
index 00000000000..fdb79c2f3a9
Binary files /dev/null and b/etc/images/hyper.pbm differ
diff --git a/etc/images/meta.pbm b/etc/images/meta.pbm
new file mode 100644
index 00000000000..4d4c55c85c7
Binary files /dev/null and b/etc/images/meta.pbm differ
diff --git a/etc/images/shift.pbm b/etc/images/shift.pbm
new file mode 100644
index 00000000000..53128f56d96
Binary files /dev/null and b/etc/images/shift.pbm differ
diff --git a/etc/images/super.pbm b/etc/images/super.pbm
new file mode 100644
index 00000000000..aa126755f99
Binary files /dev/null and b/etc/images/super.pbm differ
diff --git a/lisp/simple.el b/lisp/simple.el
index 4ddede53a14..d78407e05bb 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10271,18 +10271,34 @@ SYMBOL is the name of this modifier, as a symbol.
 LSHIFTBY is the numeric value of this modifier, in keyboard events.
 PREFIX is the string that represents this modifier in an event type symbol."
   (if (numberp event)
-      (cond ((eq symbol 'control)
-            (if (<= 64 (upcase event) 95)
-                (- (upcase event) 64)
-              (logior (ash 1 lshiftby) event)))
-           ((eq symbol 'shift)
-             ;; FIXME: Should we also apply this "upcase" behavior of shift
-             ;; to non-ascii letters?
-            (if (<= ?a (downcase event) ?z)
-                (upcase event)
-              (logior (ash 1 lshiftby) event)))
-           (t
-            (logior (ash 1 lshiftby) event)))
+      ;; Use the base event to determine how the control and shift
+      ;; modifiers should be applied.
+      (let* ((base-event (event-basic-type event)))
+        (cond ((eq symbol 'control)
+              (if (<= 64 (upcase base-event) 95)
+                   ;; Apply the control modifier...
+                  (logior (- (upcase base-event) 64)
+                           ;; ... and any additional modifiers
+                           ;; specified in the original event...
+                           (logand event (logior ?\M-\0 ?\C-\0 ?\S-\0
+                                                ?\H-\0 ?\s-\0 ?\A-\0))
+                           ;; ... including any shift modifier that
+                           ;; `event-basic-type' may have removed.
+                           (if (<= ?A event ?Z) ?\S-\0 0))
+                (logior (ash 1 lshiftby) event)))
+             ((eq symbol 'shift)
+               ;; FIXME: Should we also apply this "upcase" behavior of shift
+               ;; to non-ascii letters?
+              (if (<= ?a base-event ?z)
+                   ;; Apply the Shift modifier.
+                  (logior (upcase base-event)
+                           ;; ... and any additional modifiers
+                           ;; specified in the original event.
+                           (logand event (logior ?\M-\0 ?\C-\0 ?\S-\0
+                                                ?\H-\0 ?\s-\0 ?\A-\0)))
+                (logior (ash 1 lshiftby) event)))
+             (t
+              (logior (ash 1 lshiftby) event))))
     (if (memq symbol (event-modifiers event))
        event
       (let ((event-type (if (symbolp event) event (car event))))
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 1a0faf3a584..aeab21f61a0 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -83,6 +83,14 @@ buffer-locally and add the items you want to it with
 `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))
@@ -91,15 +99,21 @@ functions.")
 
 (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)
@@ -107,14 +121,54 @@ functions.")
 
 (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)
@@ -136,7 +190,7 @@ color capability and based on the available image 
libraries."
                                        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)
@@ -322,6 +376,310 @@ Customize `tool-bar-mode' if you want to show or hide the 
tool bar."
             (modify-all-frames-parameters
              (list (cons 'tool-bar-position val))))))
 
+
+
+;; 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)
 
diff --git a/src/dispextern.h b/src/dispextern.h
index 402972d33d9..cf67121809f 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3364,9 +3364,13 @@ enum tool_bar_item_idx
   /* If we shall show the label only below the icon and not beside it.  */
   TOOL_BAR_ITEM_VERT_ONLY,
 
+  /* Whether or not this tool bar item is hidden and should cause
+     subsequent items to be displayed on a new line.  */
+  TOOL_BAR_ITEM_WRAP,
+
   /* Sentinel = number of slots in tool_bar_items occupied by one
      tool-bar item.  */
-  TOOL_BAR_ITEM_NSLOTS
+  TOOL_BAR_ITEM_NSLOTS,
 };
 
 
diff --git a/src/frame.c b/src/frame.c
index 65711106671..35881ce6de1 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -986,6 +986,7 @@ make_frame (bool mini_p)
   f->last_tab_bar_item = -1;
 #ifndef HAVE_EXT_TOOL_BAR
   f->last_tool_bar_item = -1;
+  f->tool_bar_wraps_p = false;
 #endif
 #ifdef NS_IMPL_COCOA
   f->ns_appearance = ns_appearance_system_default;
diff --git a/src/frame.h b/src/frame.h
index 8142dec456b..8ed9c0f37d8 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -344,6 +344,10 @@ struct frame
   /* Set to true to minimize tool-bar height even when
      auto-resize-tool-bar is set to grow-only.  */
   bool_bf minimize_tool_bar_window_p : 1;
+
+  /* Whether or not the tool bar contains a ``new line'' item.  If
+     true, tool bar rows will be allowed to differ in height.  */
+  bool_bf tool_bar_wraps_p : 1;
 #endif
 
 #ifdef HAVE_EXT_TOOL_BAR
diff --git a/src/keyboard.c b/src/keyboard.c
index 19fdbd11724..b33fbf8f155 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -9325,7 +9325,13 @@ set_prop (ptrdiff_t idx, Lisp_Object val)
 
    - `:label LABEL-STRING'.
 
-   A text label to show with the tool bar button if labels are enabled.  */
+   A text label to show with the tool bar button if labels are
+   enabled.
+
+   - `:wrap WRAP'
+
+   WRAP specifies whether to hide this item but display subsequent
+   tool bar items on a new line.  */
 
 static bool
 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
@@ -9333,7 +9339,15 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
   Lisp_Object filter = Qnil;
   Lisp_Object caption;
   int i;
-  bool have_label = false;
+  bool have_label;
+#ifndef HAVE_EXT_TOOL_BAR
+  bool is_wrap;
+#endif /* HAVE_EXT_TOOL_BAR */
+
+  have_label = false;
+#ifndef HAVE_EXT_TOOL_BAR
+  is_wrap = false;
+#endif /* HAVE_EXT_TOOL_BAR */
 
   /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
      Rule out items that aren't lists, don't start with
@@ -9469,6 +9483,20 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
       else if (EQ (ikey, QCrtl))
         /* ':rtl STRING' */
        set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
+      else if (EQ (ikey, QCwrap))
+       {
+#ifndef HAVE_EXT_TOOL_BAR
+         /* This specifies whether the tool bar item should be hidden
+            but cause subsequent items to be displayed on a new
+            line.  */
+         set_prop (TOOL_BAR_ITEM_WRAP, value);
+         is_wrap = !NILP (value);
+#else /* HAVE_EXT_TOOL_BAR */
+         /* Line wrapping isn't supported on builds utilizing
+            external tool bars.  */
+         return false;
+#endif /* !HAVE_EXT_TOOL_BAR */
+       }
     }
 
 
@@ -9529,6 +9557,15 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
   if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
     return 0;
 
+
+#ifndef HAVE_EXT_TOOL_BAR
+  /* If the menu item is actually a line wrap, make sure it isn't
+     visible or enabled.  */
+
+  if (is_wrap)
+    set_prop (TOOL_BAR_ITEM_ENABLED_P, Qnil);
+#endif /* !HAVE_EXT_TOOL_BAR */
+
   /* If there is a key binding, add it to the help, which will be
      displayed as a tooltip for this entry. */
   Lisp_Object binding = PROP (TOOL_BAR_ITEM_BINDING);
@@ -12482,6 +12519,7 @@ syms_of_keyboard (void)
   DEFSYM (Qhelp_echo, "help-echo");
   DEFSYM (Qhelp_echo_inhibit_substitution, "help-echo-inhibit-substitution");
   DEFSYM (QCrtl, ":rtl");
+  DEFSYM (QCwrap, ":wrap");
 
   staticpro (&item_properties);
   item_properties = Qnil;
diff --git a/src/xdisp.c b/src/xdisp.c
index 43c628b73d8..d09116b3fb5 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -15000,7 +15000,10 @@ update_tool_bar (struct frame *f, bool save_match_data)
 
 /* 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)
@@ -15022,9 +15025,11 @@ 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);
@@ -15032,6 +15037,8 @@ build_desired_tool_bar_string (struct frame *f)
                               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.  */
@@ -15044,6 +15051,21 @@ build_desired_tool_bar_string (struct frame *f)
       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);
@@ -15155,6 +15177,16 @@ build_desired_tool_bar_string (struct frame *f)
                            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, ' ');
 }
 
 
@@ -15168,7 +15200,10 @@ build_desired_tool_bar_string (struct frame *f)
    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)
@@ -15232,8 +15267,18 @@ 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);
@@ -15260,7 +15305,8 @@ display_tool_bar_line (struct it *it, int height)
     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);
@@ -15294,6 +15340,7 @@ display_tool_bar_line (struct it *it, int height)
 /* 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)
 {
@@ -15371,7 +15418,9 @@ redisplay_tool_bar (struct frame *f)
   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
@@ -15455,18 +15504,39 @@ redisplay_tool_bar (struct frame *f)
        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
@@ -15482,8 +15552,6 @@ redisplay_tool_bar (struct frame *f)
 
   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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]