(popup-dialog-box): New function.

diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el
index 395d2d36ede5f56ea6dd65365ef363a406e81710..afc8f1ae386cacfb0a24947187e4803d5392c768 100644 (file)
--- a/lisp/emacs-lisp/lmenu.el
+++ b/lisp/emacs-lisp/lmenu.el
@@ -146,6 +146,56 @@ The syntax, more precisely:
           (if (keymapp cmd)
               (setq menu cmd)
             (call-interactively cmd))))))
+
+(defun popup-dialog-box (data)
+  "Pop up a dialog box.
+A dialog box description is a list.
+
+ - The first element of the list is a string to display in the dialog box.
+ - The rest of the elements are descriptions of the dialog box's buttons.
+   Each one is a vector of three elements:
+   - The first element is the text of the button.
+   - The second element is the `callback'.
+   - The third element is t or nil, whether this button is selectable.
+
+If the `callback' of a button is a symbol, then it must name a command.
+It will be invoked with `call-interactively'.  If it is a list, then it is
+evaluated with `eval'.
+
+One (and only one) of the buttons may be `nil'.  This marker means that all
+following buttons should be flushright instead of flushleft.
+
+The syntax, more precisely:
+
+   form                :=  <something to pass to `eval'>
+   command     :=  <a symbol or string, to pass to `call-interactively'>
+   callback    :=  command | form
+   active-p    :=  <t, nil, or a form to evaluate to decide whether this
+                   button should be selectable>
+   name                :=  <string>
+   partition   :=  'nil'
+   button      :=  '['  name callback active-p ']'
+   dialog      :=  '(' name [ button ]+ [ partition [ button ]+ ] ')'"
+  (let ((name (car data))
+       (tail (cdr data))
+       converted
+       choice)
+    (while tail
+      (if (null (car tail))
+         (setq converted (cons nil converted))
+       (let ((item (aref (car tail) 0))
+             (callback (aref (car tail) 1))
+             (enable (aref (car tail) 2)))
+         (setq converted
+               (cons (if enable (cons item callback) item)
+                     converted))))
+      (setq tail (cdr tail)))
+    (setq choice (x-popup-dialog t (cons name (nreverse converted))))
+    (setq meaning (assq choice converted))
+    (if meaning
+       (if (symbolp (cdr meaning))
+           (call-interactively (cdr meaning))
+         (eval (cdr meaning))))))
 \f
 ;; This is empty because the usual elements of the menu bar 
 ;; are provided by menu-bar.el instead.