Function: popup-menu

popup-menu is a byte-compiled function defined in menu-bar.el.gz.

Signature

(popup-menu MENU &optional POSITION PREFIX FROM-MENU-BAR)

Documentation

Popup the given menu and call the selected option.

MENU can be a keymap, an easymenu-style menu or a list of keymaps as for x-popup-menu. The menu is shown at the place where POSITION specifies. For the form of POSITION, see popup-menu-normalize-position. PREFIX is the prefix argument (if any) to pass to the command. FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus.

Aliases

semantic-popup-menu (obsolete since 27.1)

Source Code

;; Defined in /usr/src/emacs/lisp/menu-bar.el.gz
(defun popup-menu (menu &optional position prefix from-menu-bar)
  "Popup the given menu and call the selected option.
MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
`x-popup-menu'.
The menu is shown at the place where POSITION specifies.
For the form of POSITION, see `popup-menu-normalize-position'.
PREFIX is the prefix argument (if any) to pass to the command.
FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
  (let* ((map (cond
	       ((keymapp menu) menu)
	       ((and (listp menu) (keymapp (car menu))) menu)
               ((not (listp menu)) nil)
	       (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
			 (filter (when (symbolp map)
				   (plist-get (get map 'menu-prop) :filter))))
		    (if filter (funcall filter (symbol-function map)) map)))))
	 (frame (selected-frame))
	 event cmd)
    (if from-menu-bar
	(let* ((xy (posn-x-y position))
	       (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy))))
	  (setq position (list menu-symbol (list frame '(menu-bar)
						 xy 0))))
      (setq position (popup-menu-normalize-position position)))
    ;; The looping behavior was taken from lmenu's popup-menu-popup
    (while (and map (setq event
			  ;; map could be a prefix key, in which case
			  ;; we need to get its function cell
			  ;; definition.
			  (x-popup-menu position (indirect-function map))))
      ;; Strangely x-popup-menu returns a list.
      ;; mouse-major-mode-menu was using a weird:
      ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
      (setq cmd
	    (cond
	     ((and from-menu-bar
		   (consp event)
		   (numberp (car event))
		   (numberp (cdr event)))
	      (let ((x (car event))
		    (y (cdr event))
		    menu-symbol)
		(setq menu-symbol (menu-bar-menu-at-x-y x y))
		(setq position (list menu-symbol (list frame '(menu-bar)
						 event 0)))
		(setq map
		      (key-binding (vector 'menu-bar menu-symbol)))))
	     ((and (not (keymapp map)) (listp map))
	      ;; We were given a list of keymaps.  Search them all
	      ;; in sequence until a first binding is found.
	      (let ((mouse-click (apply 'vector event))
		    binding)
		(while (and map (null binding))
		  (setq binding (lookup-key-ignore-too-long (car map) mouse-click))
		  (setq map (cdr map)))
                binding))
	     (t
	      ;; We were given a single keymap.
	      (lookup-key map (apply 'vector event)))))
      ;; Clear out echoing, which perhaps shows a prefix arg.
      (message "")
      ;; Maybe try again but with the submap.
      (setq map (if (keymapp cmd) cmd)))
    ;; If the user did not cancel by refusing to select,
    ;; and if the result is a command, run it.
    (when (and (null map) (commandp cmd))
      (setq prefix-arg prefix)
      ;; `setup-specified-language-environment', for instance,
      ;; expects this to be set from a menu keymap.
      (setq last-command-event (car (last event)))
      ;; mouse-major-mode-menu was using `command-execute' instead.
      (call-interactively cmd))))