annotate lisp/dialog.el @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents 685b588e92d8
children 42375619fa45
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
1 ;;; dialog.el --- Dialog-box support for XEmacs
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
2
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
4 ;; Copyright (C) 2000, 2002 Ben Wing.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
5
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
7 ;; Keywords: extensions, internal, dumped
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
8
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
10
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
14 ;; any later version.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
15
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
19 ;; General Public License for more details.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
20
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
24 ;; Boston, MA 02111-1307, USA.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
25
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
26 ;;; Synched up with: Not in FSF.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
27
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
28 ;;; Authorship: Mostly written or rewritten by Ben Wing; some old old stuff
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
29 ;;; that underlies some current code was written by JWZ.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
30
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
31 ;;; Commentary:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
32
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
33 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
34
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
35 ;; Dialog boxes are non-modal at the C level, but made modal at the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
36 ;; Lisp level via hacks in functions such as yes-or-no-p-dialog-box
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
37 ;; below. Perhaps there should be truly modal dialog boxes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
38 ;; implemented at the C level for safety. All code using dialog boxes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
39 ;; should be careful to assume that the environment, for example the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
40 ;; current buffer, might be completely different after returning from
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
41 ;; yes-or-no-p-dialog-box, but such code is difficult to write and test.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
42
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
43 ;;; Code:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
44 (defun yes-or-no-p-dialog-box (prompt)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
45 "Ask user a yes-or-no question with a popup dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
46 Return t if the answer is \"yes\".
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
47 Takes one argument, which is the string to display to ask the question."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
48 (save-selected-frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
49 (make-dialog-box 'question
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
50 :question prompt
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
51 :modal t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
52 :buttons '(["Yes" (dialog-box-finish t)]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
53 ["No" (dialog-box-finish nil)]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
54 nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
55 ["Cancel" (dialog-box-cancel)]))))
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
56
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
57 ;; FSF has a similar function `x-popup-dialog'.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
58 (defun get-dialog-box-response (position contents)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
59 "Pop up a dialog box and return user's selection.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
60 POSITION specifies which frame to use.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
61 This is normally an event or a window or frame.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
62 If POSITION is t or nil, it means to use the frame the mouse is on.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
63 The dialog box appears in the middle of the specified frame.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
64
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
65 CONTENTS specifies the alternatives to display in the dialog box.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
66 It is a list of the form (TITLE ITEM1 ITEM2...).
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
67 Each ITEM is a cons cell (STRING . VALUE).
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
68 The return value is VALUE from the chosen item.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
69
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
70 An ITEM may also be just a string--that makes a nonselectable item.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
71 An ITEM may also be nil--that means to put all preceding items
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
72 on the left of the dialog box and all following items on the right."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
73 (cond
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
74 ((eventp position)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
75 (select-frame (event-frame position)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
76 ((framep position)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
77 (select-frame position))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
78 ((windowp position)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
79 (select-window position)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
80 (make-dialog-box 'question
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
81 :question (car contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
82 :modal t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
83 :buttons
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
84 (mapcar #'(lambda (x)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
85 (cond
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
86 ((null x)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
87 nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
88 ((stringp x)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
89 ;;this will never get selected
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
90 `[,x 'ignore nil])
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
91 (t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
92 `[,(car x) (dialog-box-finish ',(cdr x)) t])))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
93 (cdr contents))))
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
94
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
95 (defun get-user-response (position question answers)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
96 "Ask a question and get a response from the user, in minibuffer or dialog box.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
97 POSITION specifies which frame to use.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
98 This is normally an event or a window or frame.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
99 If POSITION is t or nil, it means to use the frame the mouse is on.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
100 The dialog box appears in the middle of the specified frame.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
101
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
102 QUESTION is the question to ask (it should end with a question mark followed
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
103 by a space).
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
104
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
105 ANSWERS are the possible answers. It is a list; each item looks like
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
106
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
107 (KEY BUTTON-TEXT RESPONSE)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
108
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
109 where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
110 text to be displayed in a dialog box button (you should put %_ in it to
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
111 indicate the accelerator), and RESPONSE is a value (typically a symbol)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
112 to be returned if the user selects this response. KEY should be either a
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
113 single character or a string; which one you use needs to be consistent for
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
114 all responses and determines whether the user responds by hitting a single
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
115 key or typing in a string and hitting ENTER.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
116
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
117 An item may also be just a string--that makes a nonselectable item in the
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
118 dialog box and is ignored in the minibuffer.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
119
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
120 An item may also be nil -- that means to put all preceding items
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
121 on the left of the dialog box and all following items on the right; ignored
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
122 in the minibuffer."
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
123 (if (should-use-dialog-box-p)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
124 (get-dialog-box-response
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
125 position
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
126 (cons question
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
127 (mapcar #'(lambda (x)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
128 (cond
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
129 ((null x) nil)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
130 ((stringp x) x)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
131 (t (cons (second x) (third x)))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
132 answers)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
133 (save-excursion
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
134 (let* ((answers (remove-if-not #'consp answers))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
135 (possible
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
136 (gettext
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
137 (flet ((car-to-string-if (x)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
138 (setq x (car x))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
139 (if (stringp x) x (char-to-string x))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
140 (concat (mapconcat #'car-to-string-if
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
141 (butlast answers) ", ") " or "
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
142 (car-to-string-if (car (last answers)))))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
143 (question (gettext question))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
144 (p (format "%s(%s) " question possible)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
145 (block nil
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
146 (if (stringp (caar answers))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
147 ;; based on yes-or-no-p.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
148 (while t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
149 (let* ((ans (downcase (read-string p nil t))) ;no history
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
150 (res (member* ans answers :test #'equal :key #'car)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
151 (if res (return (third (car res)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
152 (ding nil 'yes-or-no-p)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
153 (discard-input)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
154 (message "Please answer %s." possible)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
155 (sleep-for 2))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
156 ;; based on y-or-n-p.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
157 (save-excursion
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
158 (let* ((pre "") event)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
159 (while t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
160 (if (let ((cursor-in-echo-area t)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
161 (inhibit-quit t))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
162 (message "%s%s(%s) " pre question possible)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
163 (setq event (next-command-event event))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
164 (condition-case nil
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
165 (prog1
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
166 (or quit-flag (eq 'keyboard-quit
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
167 (key-binding event)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
168 (setq quit-flag nil))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
169 (wrong-type-argument t)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
170 (progn
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
171 (message "%s%s(%s) %s" pre question possible
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
172 (single-key-description event))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
173 (setq quit-flag nil)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
174 (signal 'quit '())))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
175 (let* ((keys (events-to-keys (vector event)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
176 (def (lookup-key query-replace-map keys)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
177 (cond
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
178 ; ((eq def 'skip)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
179 ; (message "%s%sNo" question possible)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
180 ; (return nil))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
181 ; ((eq def 'act)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
182 ; (message "%s%sYes" question possible)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
183 ; (return t))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
184 ((eq def 'recenter)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
185 (recenter))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
186 ((or (eq def 'quit) (eq def 'exit-prefix))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
187 (signal 'quit '()))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
188 ((button-release-event-p event) ; ignore them
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
189 nil)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
190 (t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
191 (let ((res (member* (event-to-character event) answers
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
192 :key #'car)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
193 (if res (return (third (car res)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
194 (message "%s%s(%s) %s" pre question possible
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
195 (single-key-description event))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
196 (ding nil 'y-or-n-p)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
197 (discard-input)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
198 (if (= (length pre) 0)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
199 (setq pre (format "Please answer %s. "
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
200 ;; 17 parens! a record in
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
201 ;; our lisp code.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
202 possible)))))))))))))))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
203
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 673
diff changeset
204
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
205 (defun message-box (fmt &rest args)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
206 "Display a message, in a dialog box if possible.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
207 If the selected device has no dialog-box support, use the echo area.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
208 The arguments are the same as to `format'.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
210 If the only argument is nil, clear any existing message; let the
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
211 minibuffer contents show."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
212 (if (and (null fmt) (null args))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
213 (progn
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
214 (clear-message nil)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
215 nil)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
216 (let ((str (apply 'format fmt args)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
217 (if (device-on-window-system-p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
218 (get-dialog-box-response nil (list str (cons "%_OK" t)))
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
219 (display-message 'message str))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
220 str)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
221
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
222 (defun message-or-box (fmt &rest args)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
223 "Display a message in a dialog box or in the echo area.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
224 If this command was invoked with the mouse, use a dialog box.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
225 Otherwise, use the echo area.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
226 The arguments are the same as to `format'.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
227
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
228 If the only argument is nil, clear any existing message; let the
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
229 minibuffer contents show."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
230 (if (should-use-dialog-box-p)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
231 (apply 'message-box fmt args)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
232 (apply 'message fmt args)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
233
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
234 (defun make-dialog-box (type &rest cl-keys)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
235 "Pop up a dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
236 TYPE is a symbol, the type of dialog box. Remaining arguments are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
237 keyword-value pairs, specifying the particular characteristics of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
238 dialog box. The allowed keywords are particular to each type, but
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
239 some standard keywords are common to many types:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
240
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
241 :title
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
242 The title of the dialog box's window.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
243
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
244 :modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
245 If true, indicates that XEmacs will wait until the user is \"done\"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
246 with the dialog box (usually, this means that a response has been
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
247 given). Typically, the response is returned. NOTE: Some dialog
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
248 boxes are always modal. If the dialog box is modal, `make-dialog-box'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
249 returns immediately. The return value will be either nil or a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
250 dialog box handle of some sort, e.g. a frame for type `general'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
251
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
252 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
253
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
254 Recognized types are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
255
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
256 general
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
257 A dialog box consisting of an XEmacs glyph, typically a `layout'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
258 widget specifying a dialog box arrangement. This is the most
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
259 general and powerful dialog box type, but requires more work than
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
260 the other types below.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
261
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
262 question
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
263 A simple dialog box that displays a question and contains one or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
264 more user-defined buttons to specify possible responses. (This is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
265 compatible with the old built-in dialog boxes formerly specified
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
266 using `popup-dialog-box'.)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
267
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
268 file
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
269 A file dialog box, of the type typically used in the window system
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
270 XEmacs is running on.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
271
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
272 color
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
273 A color picker.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
274
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
275 find
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
276 A find dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
277
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
278 font
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
279 A font chooser.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
280
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
281 print
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
282 A dialog box used when printing (e.g. number of pages, printer).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
283
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
284 page-setup
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
285 A dialog box for setting page options (e.g. margins) for printing.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
286
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
287 replace
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
288 A find/replace dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
289
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
290 mswindows-message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
291 An MS Windows-specific standard dialog box type similar to `question'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
292
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
293 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
294
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
295 For type `general':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
296
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
297 This type creates a frame and puts the specified widget layout in it.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
298 \(Currently this is done by eliminating all areas but the gutter and placing
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
299 the layout there; but this is an implementation detail and may change.)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
300
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
301 The keywords allowed for `general' are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
302
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
303 :spec
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
304 The widget spec -- anything that can be passed to `make-glyph'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
305 :title
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
306 The title of the frame.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
307 :parent
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
308 The frame is made a child of this frame (defaults to the selected frame).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
309 :properties
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
310 Additional properties of the frame, as well as `dialog-frame-plist'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
311
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
312 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
313
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
314 For type `question':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
315
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
316 The keywords allowed are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
317
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
318 :modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
319 t or nil. When t, the dialog box callback should exit the dialog box
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
320 using the functions `dialog-box-finish' or `dialog-box-cancel'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
321 :title
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
322 The title of the frame.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
323 :question
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
324 A string, the question.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
325 :buttons
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
326 A list, describing the buttons below the question. Each of these is a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
327 vector, the syntax of which is essentially the same as that of popup menu
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
328 items. They may have any of the following forms:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
329
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
330 [ \"name\" callback <active-p> ]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
331 [ \"name\" callback <active-p> \"suffix\" ]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
332 [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
333
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
334 The name is the string to display on the button; it is filtered through the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
335 resource database, so it is possible for resources to override what string
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
336 is actually displayed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
337
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
338 Accelerators can be indicated in the string by putting the sequence
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
339 \"%_\" before the character corresponding to the key that will invoke
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
340 the button. Uppercase and lowercase accelerators are equivalent. The
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
341 sequence \"%%\" is also special, and is translated into a single %.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
342
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
343 If the `callback' of a button is a symbol, then it must name a command.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
344 It will be invoked with `call-interactively'. If it is a list, then it is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
345 evaluated with `eval'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
346
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
347 One (and only one) of the buttons may be `nil'. This marker means that all
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
348 following buttons should be flushright instead of flushleft.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
349
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
350 Though the keyword/value syntax is supported for dialog boxes just as in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
351 popup menus, the only keyword which is both meaningful and fully implemented
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
352 for dialog box buttons is `:active'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
353
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
354 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
355
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
356 For type `file':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
357
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
358 The keywords allowed are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
359
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
360 :initial-filename
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
361 The initial filename to be placed in the dialog box (defaults to nothing).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
362 :initial-directory
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
363 The initial directory to be selected in the dialog box (defaults to the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
364 current buffer's `default-directory).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
365 :filter-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
366 A list of (filter-desc filter ...)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
367 :title
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
368 The title of the dialog box (defaults to \"Open\").
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
369 :allow-multi-select t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
370 :create-prompt-on-nonexistent t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
371 :overwrite-prompt t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
372 :file-must-exist t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
373 :no-network-button t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
374 :no-read-only-return t or nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
375
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
376 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
377
673
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
378 For type `directory':
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
379
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
380 The keywords allowed are
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
381
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
382 :initial-directory
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
383 The initial directory to be selected in the dialog box (defaults to the
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
384 current buffer's `default-directory).
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
385 :title
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
386 The title of the dialog box (defaults to \"Open\").
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
387
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
388 ---------------------------------------------------------------------------
685b588e92d8 [xemacs-hg @ 2001-10-30 05:13:26 by andyp]
andyp
parents: 629
diff changeset
389
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
390 For type `print':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
391
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
392 This invokes the Windows standard Print dialog.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
393 This dialog is usually invoked when the user selects the Print command.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
394 After the user presses OK, the program should start actual printout.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
395
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
396 The keywords allowed are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
397
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
398 :device
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
399 An 'msprinter device.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
400 :print-settings
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
401 A printer settings object.
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
402 :allow-selection
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
403 t or nil -- whether the \"Selection\" button is enabled (defaults to nil).
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
404 :allow-pages
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
405 t or nil -- whether the \"Pages\" button and associated edit controls
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
406 are enabled (defaults to t).
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
407 :selected-page-button
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
408 `all', `selection', or `pages' -- which page button is initially
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
409 selected.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
410
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
411 Exactly one of :device and :print-settings must be given.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
412
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
413 The function brings up the Print dialog, where the user can
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
414 select a different printer and/or change printer options. Connection
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
415 name can change as a result of selecting a different printer device. If
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
416 a device is specified, then changes are stored into the settings object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
417 currently selected into that printer. If a settings object is supplied,
629
a6c89d799f00 [xemacs-hg @ 2001-07-15 08:18:59 by adrian]
adrian
parents: 510
diff changeset
418 then changes are recorded into it, and, it is selected into a
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
419 printer, then changes are propagated to that printer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
420 too.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
421
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
422 Return value is nil if the user has canceled the dialog. Otherwise, it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
423 is a new plist, with the following properties:
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
424 name Printer device name, even if unchanged by the user.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
425 from-page First page to print, 1-based. Returned if
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
426 `selected-page-button' is `pages'.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
427 user, then this value is not included in the plist.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
428 to-page Last page to print, inclusive, 1-based. Returned if
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
429 `selected-page-button' is `pages'.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
430 copies Number of copies to print. Always returned.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
431 selected-page-button Which page button was selected (`all', `selection',
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
432 or `pages').
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
433
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
434 The DEVICE is destroyed and an error is signaled in case of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
435 initialization problem with the new printer.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
436
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
437 See also the `page-setup' dialog box type.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
438
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
439 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
440
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
441 For type `page-setup':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
443 This invokes the Windows standard Page Setup dialog.
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
444 This dialog is usually invoked in response to the Page Setup command,
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
445 and used to choose such parameters as page orientation, print margins
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
446 etc. Note that this dialog contains the \"Printer\" button, which
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
447 invokes the Printer Setup dialog so that the user can update the
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
448 printer options or even select a different printer as well.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
449
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
450 The keywords allowed are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
451
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
452 :device
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
453 An 'msprinter device.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
454 :print-settings
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
455 A printer settings object.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
456 :properties
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
457 A plist of job properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
458
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
459 Exactly one of these keywords must be given.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
460
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
461 The function brings up the Page Setup dialog, where the user
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
462 can select a different printer and/or change printer options.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
463 Connection name can change as a result of selecting a different printer
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
464 device. If a device is specified, then changes are stored into the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
465 settings object currently selected into that printer. If a settings
629
a6c89d799f00 [xemacs-hg @ 2001-07-15 08:18:59 by adrian]
adrian
parents: 510
diff changeset
466 object is supplied, then changes are recorded into it, and, it is
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
467 selected into a printer, then changes are propagated to that printer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
468 too.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
469
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
470 :properties specifies a plist of job properties;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
471 see `default-msprinter-frame-plist' for the complete list. The plist
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
472 is used to initialize the dialog.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
473
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
474 Return value is nil if the user has canceled the dialog. Otherwise,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
475 it is a new plist, containing the new list of properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
476
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
477 NOTE: The margin properties (returned by this function) are *NOT* stored
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
478 into the print-settings or device object.
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 502
diff changeset
479
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
480 The DEVICE is destroyed and an error is signaled in case of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
481 initialization problem with the new printer.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
482
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
483 See also the `print' dialog box type.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
484
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
485 ---------------------------------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
486
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
487 For type `mswindows-message':
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
488
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
489 The keywords allowed are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
490
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
491 :title
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
492 The title of the dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
493 :message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
494 The string to display.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
495 :flags
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
496 A symbol or list of symbols:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
497
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
498 -- To specify the buttons in the message box:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
499
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
500 abortretryignore
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
501 The message box contains three push buttons: Abort, Retry, and Ignore.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
502 ok
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
503 The message box contains one push button: OK. This is the default.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
504 okcancel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
505 The message box contains two push buttons: OK and Cancel.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
506 retrycancel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
507 The message box contains two push buttons: Retry and Cancel.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
508 yesno
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
509 The message box contains two push buttons: Yes and No.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
510 yesnocancel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
511 The message box contains three push buttons: Yes, No, and Cancel.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
512
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
513
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
514 -- To display an icon in the message box:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
515
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
516 iconexclamation, iconwarning
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
517 An exclamation-point icon appears in the message box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
518 iconinformation, iconasterisk
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
519 An icon consisting of a lowercase letter i in a circle appears in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
520 the message box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
521 iconquestion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
522 A question-mark icon appears in the message box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
523 iconstop, iconerror, iconhand
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
524 A stop-sign icon appears in the message box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
525
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
526
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
527 -- To indicate the default button:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
528
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
529 defbutton1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
530 The first button is the default button. This is the default.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
531 defbutton2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
532 The second button is the default button.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
533 defbutton3
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
534 The third button is the default button.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
535 defbutton4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
536 The fourth button is the default button.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
537
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
538
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
539 -- To indicate the modality of the dialog box:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
540
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
541 applmodal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
542 The user must respond to the message box before continuing work in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
543 the window identified by the hWnd parameter. However, the user can
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
544 move to the windows of other applications and work in those windows.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
545 Depending on the hierarchy of windows in the application, the user
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
546 may be able to move to other windows within the application. All
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
547 child windows of the parent of the message box are automatically
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
548 disabled, but popup windows are not. This is the default.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
549 systemmodal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
550 Same as applmodal except that the message box has the WS_EX_TOPMOST
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
551 style. Use system-modal message boxes to notify the user of serious,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
552 potentially damaging errors that require immediate attention (for
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
553 example, running out of memory). This flag has no effect on the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
554 user's ability to interact with windows other than those associated
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
555 with hWnd.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
556 taskmodal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
557 Same as applmodal except that all the top-level windows belonging to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
558 the current task are disabled if the hWnd parameter is NULL. Use
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
559 this flag when the calling application or library does not have a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
560 window handle available but still needs to prevent input to other
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
561 windows in the current application without suspending other
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
562 applications.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
563
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
564
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
565 In addition, you can specify the following flags:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
566
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
567 default-desktop-only
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
568 The desktop currently receiving input must be a default desktop;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
569 otherwise, the function fails. A default desktop is one an
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
570 application runs on after the user has logged on.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
571 help
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
572 Adds a Help button to the message box. Choosing the Help button or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
573 pressing F1 generates a Help event.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
574 right
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
575 The text is right-justified.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
576 rtlreading
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
577 Displays message and caption text using right-to-left reading order
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
578 on Hebrew and Arabic systems.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
579 setforeground
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
580 The message box becomes the foreground window. Internally, Windows
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
581 calls the SetForegroundWindow function for the message box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
582 topmost
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
583 The message box is created with the WS_EX_TOPMOST window style.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
584 service-notification
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
585 Windows NT only: The caller is a service notifying the user of an
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
586 event. The function displays a message box on the current active
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
587 desktop, even if there is no user logged on to the computer. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
588 this flag is set, the hWnd parameter must be NULL. This is so the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
589 message box can appear on a desktop other than the desktop
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
590 corresponding to the hWnd.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
591
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
592
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
593 The return value is one of the following menu-item values returned by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
594 the dialog box:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
595
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
596 abort
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
597 Abort button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
598 cancel
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
599 Cancel button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
600 ignore
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
601 Ignore button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
602 no
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
603 No button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
604 ok
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
605 OK button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
606 retry
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
607 Retry button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
608 yes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
609 Yes button was selected.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
610
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
611 If a message box has a Cancel button, the function returns the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
612 `cancel' value if either the ESC key is pressed or the Cancel button
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
613 is selected. If the message box has no Cancel button, pressing ESC has
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
614 no effect."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
615 (flet ((dialog-box-modal-loop (thunk)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
616 (let* ((frames (frame-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
617 (result
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
618 ;; ok, this is extremely tricky. normally a modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
619 ;; dialog will pop itself down using (dialog-box-finish)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
620 ;; or (dialog-box-cancel), which throws back to this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
621 ;; catch. but question dialog boxes pop down themselves
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
622 ;; regardless, so a badly written question dialog box
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
623 ;; that does not use (dialog-box-finish) could seriously
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
624 ;; wedge us. furthermore, we disable all other frames
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
625 ;; in order to implement modality; we need to restore
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
626 ;; them before the dialog box is destroyed, because
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
627 ;; otherwise windows at least will notice that no top-
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
628 ;; level window can have the focus and will shift the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
629 ;; focus to a different app, raising it and obscuring us.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
630 ;; so we create `delete-dialog-box-hook', which is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
631 ;; called right *before* the dialog box gets destroyed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
632 ;; here, we put a hook on it, and when it's our dialog
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
633 ;; box and not someone else's that's being destroyed,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
634 ;; we reenable all the frames and remove the hook.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
635 ;; BUT ... we still have to deal with exiting the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
636 ;; modal loop in case it doesn't happen before us.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
637 ;; we can't do this until after the callbacks for this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
638 ;; dialog box get executed, and that doesn't happen until
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
639 ;; after the dialog box is destroyed. so to keep things
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
640 ;; synchronous, we enqueue an eval event, which goes into
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
641 ;; the same queue as the misc-user events encapsulating
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
642 ;; the dialog callbacks and will go after it (because
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
643 ;; destroying the dialog box happens after processing
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
644 ;; its selection). if the dialog boxes are written
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
645 ;; properly, we don't see this eval event, because we've
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
646 ;; already exited our modal loop. (Thus, we make sure the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
647 ;; function given in this eval event is actually defined
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
648 ;; and does nothing.) If we do see it, though, we know
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
649 ;; that we encountered a badly written dialog box and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
650 ;; need to exit now. Currently we just return nil, but
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
651 ;; maybe we should signal an error or issue a warning.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
652 (catch 'internal-dialog-box-finish
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
653 (let ((id (eval thunk))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
654 (sym (gensym)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
655 (fset sym
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
656 `(lambda (did)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
657 (when (eq ',id did)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
658 (mapc 'enable-frame ',frames)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
659 (enqueue-eval-event
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
660 'internal-make-dialog-box-exit did)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
661 (remove-hook 'delete-dialog-box-hook
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
662 ',sym))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
663 (add-hook 'delete-dialog-box-hook sym)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
664 (mapc 'disable-frame frames)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
665 (block nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
666 (while t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
667 (let ((event (next-event)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
668 (if (and (eval-event-p event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
669 (eq (event-function event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
670 'internal-make-dialog-box-exit)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
671 (eq (event-object event) id))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
672 (return '(nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
673 (dispatch-event event)))))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
674 (if (listp result)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
675 (car result)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
676 (signal 'quit nil)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
677 (case type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
678 (general
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
679 (cl-parsing-keywords
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
680 ((:title "XEmacs")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
681 (:parent (selected-frame))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
682 :modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
683 :properties
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
684 :spec)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
685 ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
686 (flet ((create-dialog-box-frame ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
687 (let* ((ftop (frame-property cl-parent 'top))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
688 (fleft (frame-property cl-parent 'left))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
689 (fwidth (frame-pixel-width cl-parent))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
690 (fheight (frame-pixel-height cl-parent))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
691 (fonth (font-height (face-font 'default)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
692 (fontw (font-width (face-font 'default)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
693 (cl-properties (append cl-properties
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
694 dialog-frame-plist))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
695 (dfheight (plist-get cl-properties 'height))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
696 (dfwidth (plist-get cl-properties 'width))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
697 (unmapped (plist-get cl-properties
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
698 'initially-unmapped))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
699 (gutter-spec cl-spec)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
700 (name (or (plist-get cl-properties 'name) "XEmacs"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
701 (frame nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
702 (plist-remprop cl-properties 'initially-unmapped)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
703 ;; allow the user to just provide a glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
704 (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
705 (setq gutter-spec (copy-sequence "\n"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
706 (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
707 cl-spec)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
708 ;; under FVWM at least, if I don't specify the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
709 ;; initial position, it ends up always at (0, 0).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
710 ;; xwininfo doesn't tell me that there are any
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
711 ;; program-specified position hints, so it must be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
712 ;; an FVWM bug. So just be smashing and position in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
713 ;; the center of the selected frame.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
714 (setq frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
715 (make-frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
716 (append cl-properties
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
717 `(popup
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
718 ,cl-parent initially-unmapped t
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
719 menubar-visible-p nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
720 has-modeline-p nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
721 default-toolbar-visible-p nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
722 top-gutter-visible-p t
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
723 top-gutter-height ,(* dfheight fonth)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
724 top-gutter ,gutter-spec
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
725 minibuffer none
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
726 name ,name
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
727 modeline-shadow-thickness 0
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
728 vertical-scrollbar-visible-p nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
729 horizontal-scrollbar-visible-p nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
730 unsplittable t
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
731 left ,(+ fleft (- (/ fwidth 2)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
732 (/ (* dfwidth
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
733 fontw)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
734 2)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
735 top ,(+ ftop (- (/ fheight 2)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
736 (/ (* dfheight
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
737 fonth)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
738 2)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
739 (set-face-foreground 'modeline [default foreground] frame)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
740 (set-face-background 'modeline [default background] frame)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
741 (unless unmapped (make-frame-visible frame))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
742 (let ((newbuf (generate-new-buffer " *dialog box*")))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
743 (set-buffer-dedicated-frame newbuf frame)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
744 (set-frame-property frame 'dialog-box-buffer newbuf)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
745 (set-window-buffer (frame-root-window frame) newbuf)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
746 (with-current-buffer newbuf
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
747 (set (make-local-variable 'frame-title-format)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
748 cl-title)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
749 (add-local-hook 'delete-frame-hook
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
750 #'(lambda (frame)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
751 (kill-buffer
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
752 (frame-property
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
753 frame
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
754 'dialog-box-buffer))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
755 frame)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
756 (if cl-modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
757 (dialog-box-modal-loop '(create-dialog-box-frame))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
758 (create-dialog-box-frame)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
759 (question
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
760 (cl-parsing-keywords
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
761 ((:modal nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
762 t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
763 (remf cl-keys :modal)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
764 (if cl-modal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
765 (dialog-box-modal-loop `(make-dialog-box-internal ',type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
766 ',cl-keys))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
767 (make-dialog-box-internal type cl-keys))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
768 (t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
769 (make-dialog-box-internal type cl-keys)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
770
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
771 (defun dialog-box-finish (result)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
772 "Exit a modal dialog box, returning RESULT.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
773 This is meant to be executed from a dialog box callback function."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
774 (throw 'internal-dialog-box-finish (list result)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
775
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
776 (defun dialog-box-cancel ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
777 "Cancel a modal dialog box.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
778 This is meant to be executed from a dialog box callback function."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
779 (throw 'internal-dialog-box-finish 'cancel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
780
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
781 ;; an eval event, used as a trigger inside of the dialog modal loop.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
782 (defun internal-make-dialog-box-exit (did)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
783 nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
784
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
785 (make-obsolete 'popup-dialog-box 'make-dialog-box)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
786 (defun popup-dialog-box (desc)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
787 "Obsolete equivalent of (make-dialog-box 'question ...).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
788
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
789 \(popup-dialog-box (QUESTION BUTTONS ...)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
790
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
791 is equivalent to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
792
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
793 \(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
794 (check-argument-type 'stringp (car desc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
795 (or (consp (cdr desc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
796 (error 'syntax-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
797 "Dialog descriptor must supply at least one button"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
798 desc))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
799 (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 209
diff changeset
800
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
801 ;;; dialog.el ends here