;; Popup choice menus

(defvar popup-choice-menu-result nil)
(defvar popup-choice-menu-done nil)

(defun popup-choice-menu-callback (&optional choice)
  (setq popup-choice-menu-result choice
	popup-choice-menu-done t))

(add-hook 'menu-no-selection-hook 'popup-choice-menu-callback)

(defun popup-choice-menu (alist &optional title)
  "Popup a menu of choices, specified by an ALIST of format

\(\(<label1> . <choice1>\) 
 \(<label2> . <choice2>\)
  ... \)

The <choice-i> may be nil, in which case the <label i> are used as
choice.  The function waits until the menu has been popped down,
returning the result of the choice, or nil if there wasn't any.  An
optional argument TITLE can be given as the title string of the choice
menu."

  (or title (setq title "Choice"))
  (setq popup-choice-menu-done nil)

  ;; compute the choice menu and pop it up
  (popup-menu 
   (nconc 
    (list "" title "---")
    (mapcar (function 
	     (lambda (entry)
	       (vector 
		(car entry) 
		(` (popup-choice-menu-callback 
		    '(, (or (cdr entry) (car entry)))))
		t)))
	    alist)))

   ;; wait for pop-down and result
   (let ((event (allocate-event)))
     (while (not popup-choice-menu-done)
       (next-event event)
       (dispatch-event event))
     (deallocate-event event))

   ;; the result has been set by the function
   ;; `popup-choice-menu-callback', either from within the menu or
   ;; from the `menu-no-selection-hook'
   popup-choice-menu-result)


;; (popup-choice-menu '(("A" . 1) ("B" . 2) ("C" . 3)))
;; (popup-choice-menu '(("A" ) ("B") ("C")))


