|
0
|
1 ;; Dialog-box support.
|
|
|
2 ;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 ;; This file is part of XEmacs.
|
|
|
5
|
|
|
6 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
7 ;; under the terms of the GNU General Public License as published by
|
|
|
8 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
9 ;; any later version.
|
|
|
10
|
|
|
11 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
14 ;; General Public License for more details.
|
|
|
15
|
|
|
16 ;; You should have received a copy of the GNU General Public License
|
|
16
|
17 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
18 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
19 ;; Boston, MA 02111-1307, USA.
|
|
0
|
20
|
|
|
21 ;;; Synched up with: Not in FSF.
|
|
|
22
|
|
|
23 (defun yes-or-no-p-dialog-box (prompt)
|
|
|
24 "Ask user a \"y or n\" question with a popup dialog box.
|
|
|
25 Returns t if answer is \"yes\".
|
|
|
26 Takes one argument, which is the string to display to ask the question."
|
|
|
27 (let ((echo-keystrokes 0)
|
|
|
28 event)
|
|
|
29 (popup-dialog-box
|
|
|
30 ;; "Non-violent language please!" says Robin.
|
|
|
31 (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t])))
|
|
|
32 ; (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t])))
|
|
|
33 (catch 'ynp-done
|
|
|
34 (while t
|
|
|
35 (setq event (next-command-event event))
|
|
|
36 (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes))
|
|
|
37 (throw 'ynp-done t))
|
|
|
38 ((and (misc-user-event-p event) (eq (event-object event) 'no))
|
|
|
39 (throw 'ynp-done nil))
|
|
|
40 ((and (misc-user-event-p event)
|
|
|
41 (or (eq (event-object event) 'abort)
|
|
|
42 (eq (event-object event) 'menu-no-selection-hook)))
|
|
|
43 (signal 'quit nil))
|
|
|
44 ((button-release-event-p event) ;; don't beep twice
|
|
|
45 nil)
|
|
|
46 (t
|
|
|
47 (beep)
|
|
|
48 (message "please answer the dialog box")))))))
|
|
|
49
|
|
|
50 (defun yes-or-no-p-maybe-dialog-box (prompt)
|
|
|
51 "Ask user a yes-or-no question. Return t if answer is yes.
|
|
|
52 The question is asked with a dialog box or the minibuffer, as appropriate.
|
|
|
53 Takes one argument, which is the string to display to ask the question.
|
|
|
54 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
|
|
|
55 The user must confirm the answer with RET,
|
|
|
56 and can edit it until it as been confirmed."
|
|
|
57 (if (should-use-dialog-box-p)
|
|
|
58 (yes-or-no-p-dialog-box prompt)
|
|
|
59 (yes-or-no-p-minibuf prompt)))
|
|
|
60
|
|
|
61 (defun y-or-n-p-maybe-dialog-box (prompt)
|
|
|
62 "Ask user a \"y or n\" question. Return t if answer is \"y\".
|
|
|
63 Takes one argument, which is the string to display to ask the question.
|
|
|
64 The question is asked with a dialog box or the minibuffer, as appropriate.
|
|
|
65 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
|
|
|
66 No confirmation of the answer is requested; a single character is enough.
|
|
|
67 Also accepts Space to mean yes, or Delete to mean no."
|
|
|
68 (if (should-use-dialog-box-p)
|
|
|
69 (yes-or-no-p-dialog-box prompt)
|
|
|
70 (y-or-n-p-minibuf prompt)))
|
|
|
71
|
|
|
72 (if (fboundp 'popup-dialog-box)
|
|
|
73 (progn
|
|
|
74 (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box)
|
|
|
75 (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box)))
|
|
|
76
|
|
|
77 ;; this is call-compatible with the horribly-named FSF Emacs function
|
|
|
78 ;; `x-popup-dialog'. I refuse to use that name.
|
|
|
79 (defun get-dialog-box-response (position contents)
|
|
|
80 ;; by Stig@hackvan.com
|
|
|
81 ;; modified by pez@atlantic2.sbi.com
|
|
|
82 "Pop up a dialog box and return user's selection.
|
|
|
83 POSITION specifies which frame to use.
|
|
|
84 This is normally an event or a window or frame.
|
|
|
85 If POSITION is t or nil, it means to use the frame the mouse is on.
|
|
|
86 The dialog box appears in the middle of the specified frame.
|
|
|
87
|
|
|
88 CONTENTS specifies the alternatives to display in the dialog box.
|
|
|
89 It is a list of the form (TITLE ITEM1 ITEM2...).
|
|
|
90 Each ITEM is a cons cell (STRING . VALUE).
|
|
|
91 The return value is VALUE from the chosen item.
|
|
|
92
|
|
|
93 An ITEM may also be just a string--that makes a nonselectable item.
|
|
|
94 An ITEM may also be nil--that means to put all preceding items
|
|
|
95 on the left of the dialog box and all following items on the right."
|
|
|
96 (cond
|
|
|
97 ((eventp position)
|
|
|
98 (select-frame (event-frame position)))
|
|
|
99 ((framep position)
|
|
|
100 (select-frame position))
|
|
|
101 ((windowp position)
|
|
|
102 (select-window position)))
|
|
|
103 (let ((dbox (cons (car contents)
|
|
|
104 (mapcar #'(lambda (x)
|
|
|
105 (cond
|
|
|
106 ((null x)
|
|
|
107 nil)
|
|
|
108 ((stringp x)
|
|
|
109 `[,x 'ignore nil]) ;this will never get
|
|
|
110 ;selected
|
|
|
111 (t
|
|
|
112 `[,(car x) (throw 'result ',(cdr x)) t])))
|
|
|
113 (cdr contents))
|
|
|
114 )))
|
|
|
115 (catch 'result
|
|
|
116 (popup-dialog-box dbox)
|
|
|
117 (dispatch-event (next-command-event)))))
|
|
|
118
|
|
|
119 (defun message-box (fmt &rest args)
|
|
|
120 "Display a message, in a dialog box if possible.
|
|
|
121 If the selected device has no dialog-box support, use the echo area.
|
|
|
122 The arguments are the same as to `format'.
|
|
|
123
|
|
|
124 If the only argument is nil, clear any existing message; let the
|
|
|
125 minibuffer contents show."
|
|
|
126 (if (and (null fmt) (null args))
|
|
|
127 (progn
|
|
|
128 (clear-message nil)
|
|
|
129 nil)
|
|
|
130 (let ((str (apply 'format fmt args)))
|
|
|
131 (if (device-on-window-system-p)
|
|
|
132 (get-dialog-box-response nil (list str (cons "OK" t)))
|
|
|
133 (display-message 'message str))
|
|
|
134 str)))
|
|
|
135
|
|
|
136 (defun message-or-box (fmt &rest args)
|
|
|
137 "Display a message in a dialog box or in the echo area.\n\
|
|
|
138 If this command was invoked with the mouse, use a dialog box.\n\
|
|
|
139 Otherwise, use the echo area.
|
|
|
140 The arguments are the same as to `format'.
|
|
|
141
|
|
|
142 If the only argument is nil, clear any existing message; let the
|
|
|
143 minibuffer contents show."
|
|
|
144 (if (should-use-dialog-box-p)
|
|
|
145 (apply 'message-box fmt args)
|
|
|
146 (apply 'message fmt args)))
|
