aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/isearch.el3
-rw-r--r--lisp/menu-bar.el80
-rw-r--r--lisp/tmm.el63
3 files changed, 87 insertions, 59 deletions
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 0879f948cff..c3d5ff2d313 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -54,7 +54,6 @@
54;;; Code: 54;;; Code:
55 55
56(eval-when-compile (require 'cl-lib)) 56(eval-when-compile (require 'cl-lib))
57(declare-function tmm-menubar-keymap "tmm.el")
58 57
59;; Some additional options and constants. 58;; Some additional options and constants.
60 59
@@ -505,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys."
505 (require 'tmm) 504 (require 'tmm)
506 (run-hooks 'menu-bar-update-hook) 505 (run-hooks 'menu-bar-update-hook)
507 (let ((command nil)) 506 (let ((command nil))
508 (let ((menu-bar (tmm-menubar-keymap))) 507 (let ((menu-bar (menu-bar-keymap)))
509 (with-isearch-suspended 508 (with-isearch-suspended
510 (setq command (let ((isearch-mode t)) ; Show bindings from 509 (setq command (let ((isearch-mode t)) ; Show bindings from
511 ; `isearch-mode-map' in 510 ; `isearch-mode-map' in
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index da4ad9799bd..8690569ac0a 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2663,6 +2663,86 @@ If FRAME is nil or not given, use the selected frame."
2663 2663
2664(global-set-key [f10] 'menu-bar-open) 2664(global-set-key [f10] 'menu-bar-open)
2665 2665
2666(defun menu-bar-open-mouse (event)
2667 "Open the menu bar for the menu item clicked on by the mouse.
2668EVENT should be a mouse down or click event.
2669
2670Also see `menu-bar-open', which this calls.
2671This command is to be used when you click the mouse in the menubar."
2672 (interactive "e")
2673 (let* ((x-position (car (posn-x-y (event-start event))))
2674 (menu-bar-item-cons (menu-bar-item-at-x x-position)))
2675 (menu-bar-open nil
2676 (if menu-bar-item-cons
2677 (cdr menu-bar-item-cons)
2678 0))))
2679
2680(defun menu-bar-keymap ()
2681 "Return the current menu-bar keymap.
2682
2683The ordering of the return value respects `menu-bar-final-items'."
2684 (let ((menu-bar '())
2685 (menu-end '()))
2686 (map-keymap
2687 (lambda (key binding)
2688 (let ((pos (seq-position menu-bar-final-items key))
2689 (menu-item (cons key binding)))
2690 (if pos
2691 ;; If KEY is the name of an item that we want to put
2692 ;; last, store it separately with explicit ordering for
2693 ;; sorting.
2694 (push (cons pos menu-item) menu-end)
2695 (push menu-item menu-bar))))
2696 (lookup-key (menu-bar-current-active-maps) [menu-bar]))
2697 `(keymap ,@(nreverse menu-bar)
2698 ,@(mapcar #'cdr (sort menu-end
2699 (lambda (a b)
2700 (< (car a) (car b))))))))
2701
2702(defun menu-bar-current-active-maps ()
2703 "Return the current active maps in the order the menu bar displays them.
2704This value does not take into account `menu-bar-final-items' as that applies
2705per-item."
2706 ;; current-active-maps returns maps in the order local then
2707 ;; global. The menu bar displays items in the opposite order.
2708 (cons 'keymap (nreverse (current-active-maps))))
2709
2710(defun menu-bar-item-at-x (x-position)
2711 "Return a cons of the form (KEY . X) for a menu item.
2712The returned X is the left X coordinate for that menu item.
2713
2714X-POSITION is the X coordinate being queried. If nothing is clicked on,
2715returns nil."
2716 (let ((column 0)
2717 (menu-bar (menu-bar-keymap))
2718 prev-key
2719 prev-column
2720 found)
2721 (catch 'done
2722 (map-keymap
2723 (lambda (key binding)
2724 (when (> column x-position)
2725 (setq found t)
2726 (throw 'done nil))
2727 (setq prev-key key)
2728 (pcase binding
2729 ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
2730 `(menu-item ,name ,_cmd ;Extended menu item.
2731 . ,(and props
2732 (guard (let ((visible
2733 (plist-get props :visible)))
2734 (or (null visible)
2735 (eval visible)))))))
2736 (setq prev-column column
2737 column (+ column (length name) 1)))))
2738 menu-bar)
2739 ;; Check the last menu item.
2740 (when (> column x-position)
2741 (setq found t)))
2742 (if found
2743 (cons prev-key prev-column)
2744 nil)))
2745
2666(defun buffer-menu-open () 2746(defun buffer-menu-open ()
2667 "Start key navigation of the buffer menu. 2747 "Start key navigation of the buffer menu.
2668This is the keyboard interface to \\[mouse-buffer-menu]." 2748This is the keyboard interface to \\[mouse-buffer-menu]."
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 0e83f427f5f..fc02fd57907 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -42,28 +42,6 @@
42(defvar tmm-next-shortcut-digit) 42(defvar tmm-next-shortcut-digit)
43(defvar tmm-table-undef) 43(defvar tmm-table-undef)
44 44
45(defun tmm-menubar-keymap ()
46 "Return the current menu-bar keymap.
47
48The ordering of the return value respects `menu-bar-final-items'."
49 (let ((menu-bar '())
50 (menu-end '()))
51 (map-keymap
52 (lambda (key binding)
53 (let ((pos (seq-position menu-bar-final-items key))
54 (menu-item (cons key binding)))
55 (if pos
56 ;; If KEY is the name of an item that we want to put
57 ;; last, store it separately with explicit ordering for
58 ;; sorting.
59 (push (cons pos menu-item) menu-end)
60 (push menu-item menu-bar))))
61 (tmm-get-keybind [menu-bar]))
62 `(keymap ,@(nreverse menu-bar)
63 ,@(mapcar #'cdr (sort menu-end
64 (lambda (a b)
65 (< (car a) (car b))))))))
66
67;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) 45;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
68;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) 46;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
69 47
@@ -79,33 +57,12 @@ to invoke `tmm-menubar' instead, customize the variable
79`tty-menu-open-use-tmm' to a non-nil value." 57`tty-menu-open-use-tmm' to a non-nil value."
80 (interactive) 58 (interactive)
81 (run-hooks 'menu-bar-update-hook) 59 (run-hooks 'menu-bar-update-hook)
82 ;; Obey menu-bar-final-items; put those items last. 60 (let ((menu-bar (menu-bar-keymap))
83 (let ((menu-bar (tmm-menubar-keymap)) 61 (menu-bar-item-cons (and x-position
84 menu-bar-item) 62 (menu-bar-item-at-x x-position))))
85 (if x-position 63 (tmm-prompt menu-bar
86 (let ((column 0) 64 nil
87 prev-key) 65 (and menu-bar-item-cons (car menu-bar-item-cons)))))
88 (catch 'done
89 (map-keymap
90 (lambda (key binding)
91 (when (> column x-position)
92 (setq menu-bar-item prev-key)
93 (throw 'done nil))
94 (setq prev-key key)
95 (pcase binding
96 ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
97 `(menu-item ,name ,_cmd ;Extended menu item.
98 . ,(and props
99 (guard (let ((visible
100 (plist-get props :visible)))
101 (or (null visible)
102 (eval visible)))))))
103 (setq column (+ column (length name) 1)))))
104 menu-bar)
105 ;; Check the last menu item.
106 (when (> column x-position)
107 (setq menu-bar-item prev-key)))))
108 (tmm-prompt menu-bar nil menu-bar-item)))
109 66
110;;;###autoload 67;;;###autoload
111(defun tmm-menubar-mouse (event) 68(defun tmm-menubar-mouse (event)
@@ -525,14 +482,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
525 (or (assoc str tmm-km-list) 482 (or (assoc str tmm-km-list)
526 (push (cons str (cons event km)) tmm-km-list)))))) 483 (push (cons str (cons event km)) tmm-km-list))))))
527 484
528(defun tmm-get-keybind (keyseq)
529 "Return the current binding of KEYSEQ, merging prefix definitions.
530If KEYSEQ is a prefix key that has local and global bindings,
531we merge them into a single keymap which shows the proper order of the menu.
532However, for the menu bar itself, the value does not take account
533of `menu-bar-final-items'."
534 (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq))
535
536(provide 'tmm) 485(provide 'tmm)
537 486
538;;; tmm.el ends here 487;;; tmm.el ends here