Mercurial > hg > xemacs-beta

comparison lisp/dialog.el @ 361:7347b34c275b r21-1-10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-10
author cvs
date Mon, 13 Aug 2007 10:58:40 +0200
parents 41ff10fd062f
children cc15677e0335
comparison
equal deleted inserted replaced
360:0f00b38cfccb 361:7347b34c275b
28 28
29 ;; This file is dumped with XEmacs (when dialog boxes are compiled in). 29 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
30 30
31 ;;; Code: 31 ;;; Code:
32 (defun yes-or-no-p-dialog-box (prompt) 32 (defun yes-or-no-p-dialog-box (prompt)
33 "Ask user a \"y or n\" question with a popup dialog box. 33 "Ask user a yes-or-no question with a popup dialog box.
34 Returns t if answer is \"yes\". 34 Return t if the answer is \"yes\".
35 Takes one argument, which is the string to display to ask the question." 35 Takes one argument, which is the string to display to ask the question."
36 (let ((echo-keystrokes 0) 36 (save-selected-frame
37 event) 37 (let ((echo-keystrokes 0)
38 (popup-dialog-box 38 event)
39 ;; "Non-violent language please!" says Robin. 39 (popup-dialog-box
40 (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t]))) 40 (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t])))
41 ; (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t]))) 41 (catch 'ynp-done
42 (catch 'ynp-done 42 (while t
43 (while t 43 (setq event (next-command-event event))
44 (setq event (next-command-event event)) 44 (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes))
45 (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes)) 45 (throw 'ynp-done t))
46 (throw 'ynp-done t)) 46 ((and (misc-user-event-p event) (eq (event-object event) 'no))
47 ((and (misc-user-event-p event) (eq (event-object event) 'no)) 47 (throw 'ynp-done nil))
48 (throw 'ynp-done nil)) 48 ((and (misc-user-event-p event)
49 ((and (misc-user-event-p event) 49 (or (eq (event-object event) 'abort)
50 (or (eq (event-object event) 'abort) 50 (eq (event-object event) 'menu-no-selection-hook)))
51 (eq (event-object event) 'menu-no-selection-hook))) 51 (signal 'quit nil))
52 (signal 'quit nil)) 52 ((button-release-event-p event);; don't beep twice
53 ((button-release-event-p event) ;; don't beep twice 53 nil)
54 nil) 54 (t
55 (t 55 (beep)
56 (beep) 56 (message "please answer the dialog box"))))))))
57 (message "please answer the dialog box")))))))
58 57
59 (defun yes-or-no-p-maybe-dialog-box (prompt) 58 (defun yes-or-no-p-maybe-dialog-box (prompt)
60 "Ask user a yes-or-no question. Return t if answer is yes. 59 "Ask user a yes-or-no question. Return t if answer is yes.
61 The question is asked with a dialog box or the minibuffer, as appropriate. 60 The question is asked with a dialog box or the minibuffer, as appropriate.
62 Takes one argument, which is the string to display to ask the question. 61 Takes one argument, which is the string to display to ask the question.