Mercurial > hg > xemacs-beta
annotate src/dialog-msw.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Fri, 03 Jun 2011 18:40:57 +0100 |
parents | 308d34e9f07d |
children | 56144c8593a8 |
rev | line source |
---|---|
428 | 1 /* Implements elisp-programmable dialog boxes -- MS Windows interface. |
2 Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru> | |
4967 | 3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2010 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
428 | 8 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
10 option) any later version. |
428 | 11 |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5169
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 19 |
20 /* Synched up with: Not in FSF. */ | |
21 | |
771 | 22 /* This file essentially Mule-ized (except perhaps some Unicode splitting). |
23 5-2000. */ | |
24 | |
428 | 25 /* Author: |
26 Initially written by kkm, May 1998 | |
27 */ | |
28 | |
29 #include <config.h> | |
30 #include "lisp.h" | |
31 | |
32 #include "buffer.h" | |
872 | 33 #include "frame-impl.h" |
428 | 34 #include "gui.h" |
35 #include "opaque.h" | |
36 | |
872 | 37 #include "console-msw-impl.h" |
38 | |
771 | 39 #include "sysfile.h" |
442 | 40 |
41 Lisp_Object Qdialog_box_error; | |
42 | |
43 static Lisp_Object Q_initial_directory; | |
44 static Lisp_Object Q_initial_filename; | |
45 static Lisp_Object Q_filter_list; | |
46 static Lisp_Object Q_allow_multi_select; | |
47 static Lisp_Object Q_create_prompt_on_nonexistent; | |
48 static Lisp_Object Q_overwrite_prompt; | |
49 static Lisp_Object Q_file_must_exist; | |
50 static Lisp_Object Q_no_network_button; | |
51 static Lisp_Object Q_no_read_only_return; | |
52 | |
428 | 53 /* List containing all dialog data structures of currently popped up |
442 | 54 dialogs. */ |
428 | 55 static Lisp_Object Vdialog_data_list; |
56 | |
442 | 57 /* List of popup frames wanting keyboard traversal handled */ |
58 static Lisp_Object Vpopup_frame_list; | |
59 | |
60 Lisp_Object Vdefault_file_dialog_filter_alist; | |
61 | |
428 | 62 /* DLUs per character metrics */ |
63 #define X_DLU_PER_CHAR 4 | |
64 #define Y_DLU_PER_CHAR 8 | |
65 | |
66 /* | |
67 Button metrics | |
68 -------------- | |
69 All buttons have height of 15 DLU. The minimum width for a button is 32 DLU, | |
70 but it can be expanded to accommodate its text, so the width is calculated as | |
71 8 DLU per button plus 4 DLU per character. | |
72 max (32, 6 * text_length). The factor of six is rather empirical, but it | |
73 works better than 8 which comes from the definition of a DLU. Buttons are | |
74 spaced with 6 DLU gap. Minimum distance from the button to the left or right | |
75 dialog edges is 6 DLU, and the distance between the dialog bottom edge and | |
76 buttons is 7 DLU. | |
77 */ | |
78 | |
79 #define X_MIN_BUTTON 32 | |
80 #define X_BUTTON_MARGIN 8 | |
81 #define Y_BUTTON 15 | |
82 #define X_BUTTON_SPACING 6 | |
83 #define X_BUTTON_FROM_EDGE 6 | |
84 #define Y_BUTTON_FROM_EDGE 7 | |
85 | |
86 /* | |
87 Text field metrics | |
88 ------------------ | |
89 Text distance from left and right edges is the same as for buttons, and the | |
90 top margin is 11 DLU. The static control has height of 2 DLU per control | |
91 plus 8 DLU per each line of text. Distance between the bottom edge of the | |
92 control and the button row is 15 DLU. Minimum width of the static control | |
93 is 100 DLU, thus giving minimum dialog weight of 112 DLU. Maximum width is | |
94 300 DLU, and, if the text is wider than that, the text is wrapped on the | |
95 next line. Each character in the text is considered 4 DLU wide. | |
96 */ | |
97 | |
98 #define X_MIN_TEXT 100 | |
99 #define X_AVE_TEXT 200 | |
100 #define X_MAX_TEXT 300 | |
101 #define X_TEXT_FROM_EDGE X_BUTTON_FROM_EDGE | |
102 #define Y_TEXT_FROM_EDGE 11 | |
103 #define Y_TEXT_MARGIN 2 | |
104 #define Y_TEXT_FROM_BUTTON 15 | |
105 | |
106 #define X_MIN_TEXT_CHAR (X_MIN_TEXT / X_DLU_PER_CHAR) | |
107 #define X_AVE_TEXT_CHAR (X_AVE_TEXT / X_DLU_PER_CHAR) | |
108 #define X_MAX_TEXT_CHAR (X_MAX_TEXT / X_DLU_PER_CHAR) | |
109 | |
110 /* | |
111 Layout algorithm | |
112 ---------------- | |
113 First we calculate the minimum width of the button row, excluding "from | |
114 edge" distances. Note that the static control text can be narrower than | |
115 X_AVE_TEXT only if both text and button row are narrower than that (so, | |
116 even if text *can* be wrapped into 2 rows narrower than ave width, it is not | |
117 done). Let WBR denote the width of the button row. | |
118 | |
119 Next, the width of the static field is determined. | |
120 First, if all lines of text fit into max (WBR, X_MAX_TEXT), the width of the | |
121 control is the same as the width of the longest line. | |
122 Second, if all lines of text are narrower than X_MIN_TEXT, then width of | |
123 the control is set to X_MIN_TEXT. | |
124 Otherwise, width is set to max(WBR, X_AVE_TEXT). In this case, line wrapping will | |
125 happen. | |
126 | |
127 If width of the text control is larger than that of the button row, then the | |
128 latter is centered across the dialog, by giving it extra edge | |
129 margins. Otherwise, minimal margins are given to the button row. | |
130 */ | |
131 | |
132 #define ID_ITEM_BIAS 32 | |
133 | |
442 | 134 void |
135 mswindows_register_popup_frame (Lisp_Object frame) | |
136 { | |
137 Vpopup_frame_list = Fcons (frame, Vpopup_frame_list); | |
138 } | |
139 | |
140 void | |
141 mswindows_unregister_popup_frame (Lisp_Object frame) | |
142 { | |
143 Vpopup_frame_list = delq_no_quit (frame, Vpopup_frame_list); | |
144 } | |
145 | |
146 /* Dispatch message to any dialog boxes. Return non-zero if dispatched. */ | |
147 int | |
148 mswindows_is_dialog_msg (MSG *msg) | |
149 { | |
150 LIST_LOOP_2 (data, Vdialog_data_list) | |
151 { | |
771 | 152 if (qxeIsDialogMessage (XMSWINDOWS_DIALOG_ID (data)->hwnd, msg)) |
442 | 153 return 1; |
154 } | |
155 | |
156 { | |
157 LIST_LOOP_2 (popup, Vpopup_frame_list) | |
158 { | |
159 HWND hwnd = FRAME_MSWINDOWS_HANDLE (XFRAME (popup)); | |
444 | 160 /* This is a windows feature that allows dialog type |
161 processing to be applied to standard windows containing | |
162 controls. */ | |
771 | 163 if (qxeIsDialogMessage (hwnd, msg)) |
442 | 164 return 1; |
165 } | |
166 } | |
167 return 0; | |
168 } | |
169 | |
1204 | 170 static const struct memory_description mswindows_dialog_id_description [] = { |
934 | 171 { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, frame) }, |
172 { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, callbacks) }, | |
173 { XD_END } | |
174 }; | |
175 | |
442 | 176 static Lisp_Object |
177 mark_mswindows_dialog_id (Lisp_Object obj) | |
178 { | |
179 struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj); | |
180 mark_object (data->frame); | |
181 return data->callbacks; | |
182 } | |
183 | |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
184 DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("mswindows-dialog-id", |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
185 mswindows_dialog_id, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
186 mark_mswindows_dialog_id, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
187 mswindows_dialog_id_description, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
5117
diff
changeset
|
188 struct mswindows_dialog_id); |
442 | 189 |
428 | 190 /* Dialog procedure */ |
191 static BOOL CALLBACK | |
192 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param) | |
193 { | |
194 switch (msg) | |
195 { | |
196 case WM_INITDIALOG: | |
771 | 197 qxeSetWindowLong (hwnd, DWL_USER, l_param); |
428 | 198 break; |
199 | |
200 case WM_DESTROY: | |
201 { | |
202 Lisp_Object data; | |
5013 | 203 data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER)); |
428 | 204 Vdialog_data_list = delq_no_quit (data, Vdialog_data_list); |
205 } | |
206 break; | |
207 | |
208 case WM_COMMAND: | |
209 { | |
210 Lisp_Object fn, arg, data; | |
442 | 211 struct mswindows_dialog_id *did; |
212 | |
5013 | 213 data = GET_LISP_FROM_VOID ((void *) qxeGetWindowLong (hwnd, DWL_USER)); |
442 | 214 did = XMSWINDOWS_DIALOG_ID (data); |
215 if (w_param != IDCANCEL) /* user pressed escape */ | |
216 { | |
217 assert (w_param >= ID_ITEM_BIAS | |
647 | 218 && (EMACS_INT) w_param |
442 | 219 < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS); |
220 | |
221 get_gui_callback (XVECTOR_DATA (did->callbacks) | |
222 [w_param - ID_ITEM_BIAS], | |
223 &fn, &arg); | |
224 mswindows_enqueue_misc_user_event (did->frame, fn, arg); | |
225 } | |
226 else | |
227 mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks, | |
228 Qmenu_no_selection_hook); | |
853 | 229 va_run_hook_with_args_trapping_problems |
1333 | 230 (Qdialog, Qdelete_dialog_box_hook, 1, data, 0); |
428 | 231 |
232 DestroyWindow (hwnd); | |
233 } | |
234 break; | |
235 | |
236 default: | |
237 return FALSE; | |
238 } | |
239 return TRUE; | |
240 } | |
241 | |
242 /* Helper function which converts the supplied string STRING into Unicode and | |
243 pushes it at the end of DYNARR */ | |
244 static void | |
771 | 245 push_lisp_string_as_unicode (unsigned_char_dynarr *dynarr, Lisp_Object string) |
428 | 246 { |
771 | 247 int length; |
248 Extbyte *uni_string; | |
428 | 249 |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
250 LISP_STRING_TO_SIZED_EXTERNAL (string, uni_string, length, |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
251 Qmswindows_unicode); |
771 | 252 Dynarr_add_many (dynarr, uni_string, length); |
253 Dynarr_add (dynarr, '\0'); | |
254 Dynarr_add (dynarr, '\0'); | |
442 | 255 } |
256 | |
428 | 257 /* Given button TEXT, return button width in DLU */ |
647 | 258 static int |
428 | 259 button_width (Lisp_Object text) |
260 { | |
771 | 261 /* !!#### do Japanese chars count as two? */ |
262 int width = | |
263 X_DLU_PER_CHAR * | |
867 | 264 ibyte_string_displayed_columns (XSTRING_DATA (text), |
771 | 265 XSTRING_LENGTH (text)); |
428 | 266 return max (X_MIN_BUTTON, width); |
267 } | |
268 | |
269 /* Unwind protection routine frees a dynarr opaqued into arg */ | |
270 static Lisp_Object | |
271 free_dynarr_opaque_ptr (Lisp_Object arg) | |
272 { | |
273 Dynarr_free (get_opaque_ptr (arg)); | |
274 return arg; | |
275 } | |
276 | |
707 | 277 /* Unwind protection decrements dialog count */ |
278 static Lisp_Object | |
2286 | 279 dialog_popped_down (Lisp_Object UNUSED (arg)) |
707 | 280 { |
281 popup_up_p--; | |
771 | 282 return Qnil; |
707 | 283 } |
284 | |
428 | 285 |
647 | 286 #define ALIGN_TEMPLATE \ |
287 { \ | |
288 int slippage = Dynarr_length (template_) & 3; \ | |
289 if (slippage) \ | |
290 Dynarr_add_many (template_, &zeroes, slippage); \ | |
428 | 291 } |
292 | |
442 | 293 static struct |
294 { | |
647 | 295 DWORD errmess; |
4932 | 296 const Ascbyte *errname; |
442 | 297 } common_dialog_errors[] = |
298 { | |
299 { CDERR_DIALOGFAILURE, "CDERR_DIALOGFAILURE" }, | |
300 { CDERR_FINDRESFAILURE, "CDERR_FINDRESFAILURE" }, | |
301 { CDERR_INITIALIZATION, "CDERR_INITIALIZATION" }, | |
302 { CDERR_LOADRESFAILURE, "CDERR_LOADRESFAILURE" }, | |
303 { CDERR_LOADSTRFAILURE, "CDERR_LOADSTRFAILURE" }, | |
304 { CDERR_LOCKRESFAILURE, "CDERR_LOCKRESFAILURE" }, | |
305 { CDERR_MEMALLOCFAILURE, "CDERR_MEMALLOCFAILURE" }, | |
306 { CDERR_MEMLOCKFAILURE, "CDERR_MEMLOCKFAILURE" }, | |
307 { CDERR_NOHINSTANCE, "CDERR_NOHINSTANCE" }, | |
308 { CDERR_NOHOOK, "CDERR_NOHOOK" }, | |
309 { CDERR_NOTEMPLATE, "CDERR_NOTEMPLATE" }, | |
310 { CDERR_REGISTERMSGFAIL, "CDERR_REGISTERMSGFAIL" }, | |
311 { CDERR_STRUCTSIZE, "CDERR_STRUCTSIZE" }, | |
312 { PDERR_CREATEICFAILURE, "PDERR_CREATEICFAILURE" }, | |
313 { PDERR_DEFAULTDIFFERENT, "PDERR_DEFAULTDIFFERENT" }, | |
314 { PDERR_DNDMMISMATCH, "PDERR_DNDMMISMATCH" }, | |
315 { PDERR_GETDEVMODEFAIL, "PDERR_GETDEVMODEFAIL" }, | |
316 { PDERR_INITFAILURE, "PDERR_INITFAILURE" }, | |
317 { PDERR_LOADDRVFAILURE, "PDERR_LOADDRVFAILURE" }, | |
318 { PDERR_NODEFAULTPRN, "PDERR_NODEFAULTPRN" }, | |
319 { PDERR_NODEVICES, "PDERR_NODEVICES" }, | |
320 { PDERR_PARSEFAILURE, "PDERR_PARSEFAILURE" }, | |
321 { PDERR_PRINTERNOTFOUND, "PDERR_PRINTERNOTFOUND" }, | |
322 { PDERR_RETDEFFAILURE, "PDERR_RETDEFFAILURE" }, | |
323 { PDERR_SETUPFAILURE, "PDERR_SETUPFAILURE" }, | |
324 { CFERR_MAXLESSTHANMIN, "CFERR_MAXLESSTHANMIN" }, | |
325 { CFERR_NOFONTS, "CFERR_NOFONTS" }, | |
326 { FNERR_BUFFERTOOSMALL, "FNERR_BUFFERTOOSMALL" }, | |
327 { FNERR_INVALIDFILENAME, "FNERR_INVALIDFILENAME" }, | |
328 { FNERR_SUBCLASSFAILURE, "FNERR_SUBCLASSFAILURE" }, | |
329 { FRERR_BUFFERLENGTHZERO, "FRERR_BUFFERLENGTHZERO" }, | |
330 }; | |
331 | |
771 | 332 struct param_data |
333 { | |
334 Extbyte *fname; | |
335 Extbyte *unknown_fname; | |
673 | 336 int validate; |
337 }; | |
338 | |
339 static int | |
340 CALLBACK handle_directory_proc (HWND hwnd, UINT msg, | |
341 LPARAM lParam, LPARAM lpData) | |
342 { | |
4854 | 343 Extbyte szDir[PATH_MAX_TCHAR]; |
771 | 344 struct param_data *pd = (struct param_data *) lpData; |
673 | 345 |
771 | 346 switch (msg) |
347 { | |
348 case BFFM_INITIALIZED: | |
349 /* WParam is TRUE since you are passing a path. | |
350 It would be FALSE if you were passing a pidl. */ | |
351 qxeSendMessage (hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) pd->fname); | |
352 break; | |
353 | |
354 case BFFM_SELCHANGED: | |
355 /* Set the status window to the currently selected path. */ | |
356 if (qxeSHGetPathFromIDList ((LPITEMIDLIST) lParam, szDir)) | |
357 qxeSendMessage (hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) szDir); | |
358 break; | |
359 | |
360 case BFFM_VALIDATEFAILED: | |
361 if (pd->validate) | |
362 return TRUE; | |
363 else | |
2421 | 364 pd->unknown_fname = qxetcsdup ((Extbyte *) lParam); |
771 | 365 break; |
366 | |
367 default: | |
368 break; | |
673 | 369 } |
370 return 0; | |
371 } | |
372 | |
373 static Lisp_Object | |
374 handle_directory_dialog_box (struct frame *f, Lisp_Object keys) | |
375 { | |
376 Lisp_Object ret = Qnil; | |
771 | 377 BROWSEINFOW bi; |
673 | 378 LPITEMIDLIST pidl; |
379 LPMALLOC pMalloc; | |
380 struct param_data pd; | |
771 | 381 |
382 xzero (pd); | |
383 xzero (bi); | |
384 | |
385 bi.lParam = (LPARAM) &pd; | |
673 | 386 bi.hwndOwner = FRAME_MSWINDOWS_HANDLE (f); |
387 bi.pszDisplayName = 0; | |
388 bi.pidlRoot = 0; | |
771 | 389 bi.ulFlags = |
390 BIF_RETURNONLYFSDIRS | BIF_STATUSTEXT | BIF_EDITBOX | BIF_NEWDIALOGSTYLE; | |
673 | 391 bi.lpfn = handle_directory_proc; |
771 | 392 |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
393 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_ascstring (""), Qnil), |
771 | 394 pd.fname); |
395 | |
673 | 396 { |
397 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) | |
398 { | |
399 if (EQ (key, Q_title)) | |
400 { | |
401 CHECK_STRING (value); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
402 bi.lpszTitle = (XELPTSTR) LISP_STRING_TO_TSTR (value); |
673 | 403 } |
404 else if (EQ (key, Q_initial_directory)) | |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
405 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil), |
673 | 406 pd.fname); |
407 else if (EQ (key, Q_initial_filename)) | |
408 ; /* do nothing */ | |
409 else if (EQ (key, Q_file_must_exist)) | |
410 { | |
771 | 411 if (!NILP (value)) |
412 { | |
413 pd.validate = TRUE; | |
414 bi.ulFlags |= BIF_VALIDATE; | |
415 } | |
673 | 416 else |
417 bi.ulFlags &= ~BIF_VALIDATE; | |
418 } | |
419 else | |
420 invalid_constant ("Unrecognized directory-dialog keyword", key); | |
421 } | |
422 } | |
771 | 423 |
424 if (SHGetMalloc (&pMalloc) == NOERROR) | |
673 | 425 { |
771 | 426 pidl = qxeSHBrowseForFolder (&bi); |
427 if (pidl) | |
428 { | |
4854 | 429 Extbyte *szDir = alloca_extbytes (PATH_MAX_TCHAR); |
771 | 430 |
431 if (qxeSHGetPathFromIDList (pidl, szDir)) | |
432 ret = tstr_to_local_file_format (szDir); | |
433 | |
434 XECOMCALL1 (pMalloc, Free, pidl); | |
435 XECOMCALL0 (pMalloc, Release); | |
436 return ret; | |
673 | 437 } |
771 | 438 else if (pd.unknown_fname != 0) |
439 { | |
440 ret = tstr_to_local_file_format (pd.unknown_fname); | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
441 xfree (pd.unknown_fname); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
442 pd.unknown_fname = 0; |
771 | 443 } |
707 | 444 else while (1) |
445 signal_quit (); | |
673 | 446 } |
447 else | |
448 signal_error (Qdialog_box_error, | |
449 "Unable to create folder browser", | |
450 make_int (0)); | |
451 return ret; | |
452 } | |
453 | |
442 | 454 static Lisp_Object |
455 handle_file_dialog_box (struct frame *f, Lisp_Object keys) | |
456 { | |
771 | 457 OPENFILENAMEW ofn; |
458 Extbyte fnbuf[8000]; | |
673 | 459 |
442 | 460 xzero (ofn); |
461 ofn.lStructSize = sizeof (ofn); | |
673 | 462 ofn.Flags = OFN_EXPLORER; |
442 | 463 ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f); |
771 | 464 ofn.lpstrFile = (XELPTSTR) fnbuf; |
442 | 465 ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE; |
2421 | 466 qxetcscpy (fnbuf, XETEXT ("")); |
771 | 467 |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
468 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_ascstring (""), |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
469 Qnil), |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
470 ofn.lpstrInitialDir); |
771 | 471 |
442 | 472 { |
473 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) | |
474 { | |
475 if (EQ (key, Q_initial_filename)) | |
476 { | |
477 Extbyte *fnout; | |
771 | 478 |
442 | 479 CHECK_STRING (value); |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
480 LISP_LOCAL_FILE_FORMAT_TO_TSTR (value, fnout); |
2421 | 481 qxetcscpy (fnbuf, fnout); |
442 | 482 } |
483 else if (EQ (key, Q_title)) | |
484 { | |
485 CHECK_STRING (value); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
486 ofn.lpstrTitle = (XELPTSTR) LISP_STRING_TO_TSTR (value); |
442 | 487 } |
488 else if (EQ (key, Q_initial_directory)) | |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
489 LISP_LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil), |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
490 ofn.lpstrInitialDir); |
442 | 491 else if (EQ (key, Q_file_must_exist)) |
492 { | |
493 if (!NILP (value)) | |
494 ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST; | |
495 else | |
496 ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST); | |
497 } | |
498 else | |
563 | 499 invalid_constant ("Unrecognized file-dialog keyword", key); |
442 | 500 } |
501 } | |
771 | 502 |
503 if (!qxeGetOpenFileName (&ofn)) | |
442 | 504 { |
505 DWORD err = CommDlgExtendedError (); | |
506 if (!err) | |
507 { | |
508 while (1) | |
509 signal_quit (); | |
510 } | |
511 else | |
512 { | |
513 int i; | |
771 | 514 |
442 | 515 for (i = 0; i < countof (common_dialog_errors); i++) |
516 { | |
517 if (common_dialog_errors[i].errmess == err) | |
563 | 518 signal_error (Qdialog_box_error, |
519 "Creating file-dialog-box", | |
771 | 520 build_msg_string |
563 | 521 (common_dialog_errors[i].errname)); |
442 | 522 } |
771 | 523 |
563 | 524 signal_error (Qdialog_box_error, |
525 "Unknown common dialog box error???", | |
526 make_int (err)); | |
442 | 527 } |
528 } | |
771 | 529 |
530 return tstr_to_local_file_format ((Extbyte *) ofn.lpstrFile); | |
442 | 531 } |
532 | |
533 static Lisp_Object | |
534 handle_question_dialog_box (struct frame *f, Lisp_Object keys) | |
428 | 535 { |
536 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object); | |
593 | 537 unsigned_char_dynarr *template_ = Dynarr_new (unsigned_char); |
647 | 538 int button_row_width = 0; |
539 int text_width, text_height; | |
442 | 540 Lisp_Object question = Qnil, title = Qnil; |
771 | 541 |
428 | 542 int unbind_count = specpdl_depth (); |
543 record_unwind_protect (free_dynarr_opaque_ptr, | |
544 make_opaque_ptr (dialog_items)); | |
545 record_unwind_protect (free_dynarr_opaque_ptr, | |
593 | 546 make_opaque_ptr (template_)); |
771 | 547 |
428 | 548 /* A big NO NEED to GCPRO gui_items stored in the array: they are just |
442 | 549 pointers into KEYS list, which is GC-protected by the caller */ |
771 | 550 |
428 | 551 { |
442 | 552 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys) |
428 | 553 { |
442 | 554 if (EQ (key, Q_question)) |
555 { | |
556 CHECK_STRING (value); | |
557 question = value; | |
558 } | |
559 else if (EQ (key, Q_title)) | |
560 { | |
561 CHECK_STRING (value); | |
562 title = value; | |
563 } | |
564 else if (EQ (key, Q_buttons)) | |
428 | 565 { |
442 | 566 /* Parse each item in the dialog into gui_item structs, |
567 and stuff a dynarr of these. Calculate button row width | |
568 in this loop too */ | |
2367 | 569 EXTERNAL_LIST_LOOP_2 (item, value) |
442 | 570 { |
2367 | 571 if (!NILP (item)) |
442 | 572 { |
2367 | 573 Lisp_Object gitem = gui_parse_item_keywords (item); |
442 | 574 Dynarr_add (dialog_items, gitem); |
575 button_row_width += button_width (XGUI_ITEM (gitem)->name) | |
576 + X_BUTTON_MARGIN; | |
577 } | |
578 } | |
771 | 579 |
442 | 580 button_row_width -= X_BUTTON_MARGIN; |
428 | 581 } |
442 | 582 else |
563 | 583 invalid_constant ("Unrecognized question-dialog keyword", key); |
428 | 584 } |
585 } | |
771 | 586 |
442 | 587 if (Dynarr_length (dialog_items) == 0) |
563 | 588 sferror ("Dialog descriptor provides no buttons", keys); |
771 | 589 |
442 | 590 if (NILP (question)) |
563 | 591 sferror ("Dialog descriptor provides no question", keys); |
771 | 592 |
428 | 593 /* Determine the final width layout */ |
594 { | |
867 | 595 Ibyte *p = XSTRING_DATA (question); |
428 | 596 Charcount string_max = 0, this_length = 0; |
597 while (1) | |
598 { | |
867 | 599 Ichar ch = itext_ichar (p); |
600 INC_IBYTEPTR (p); | |
428 | 601 |
867 | 602 if (ch == (Ichar)'\n' || ch == (Ichar)'\0') |
428 | 603 { |
604 string_max = max (this_length, string_max); | |
605 this_length = 0; | |
606 } | |
607 else | |
608 ++this_length; | |
771 | 609 |
867 | 610 if (ch == (Ichar)'\0') |
428 | 611 break; |
612 } | |
771 | 613 |
428 | 614 if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width)) |
615 text_width = X_AVE_TEXT; | |
616 else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT) | |
617 text_width = X_MIN_TEXT; | |
618 else | |
619 text_width = string_max * X_DLU_PER_CHAR; | |
620 text_width = max (text_width, button_row_width); | |
621 } | |
622 | |
623 /* Now calculate the height for the text control */ | |
624 { | |
867 | 625 Ibyte *p = XSTRING_DATA (question); |
428 | 626 Charcount break_at = text_width / X_DLU_PER_CHAR; |
627 Charcount char_pos = 0; | |
628 int num_lines = 1; | |
867 | 629 Ichar ch; |
428 | 630 |
867 | 631 while ((ch = itext_ichar (p)) != (Ichar) '\0') |
428 | 632 { |
867 | 633 INC_IBYTEPTR (p); |
634 char_pos += ch != (Ichar) '\n'; | |
635 if (ch == (Ichar) '\n' || char_pos == break_at) | |
428 | 636 { |
637 ++num_lines; | |
638 char_pos = 0; | |
639 } | |
640 } | |
641 text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines; | |
642 } | |
771 | 643 |
428 | 644 /* Ok, now we are ready to stuff the dialog template and lay out controls */ |
645 { | |
646 DLGTEMPLATE dlg_tem; | |
647 DLGITEMTEMPLATE item_tem; | |
648 int i; | |
649 const unsigned int zeroes = 0; | |
650 const unsigned int ones = 0xFFFFFFFF; | |
651 const WORD static_class_id = 0x0082; | |
652 const WORD button_class_id = 0x0080; | |
771 | 653 |
428 | 654 /* Create and stuff in DLGTEMPLATE header */ |
771 | 655 dlg_tem.style = (DS_CENTER | DS_MODALFRAME |
428 | 656 | WS_CAPTION | WS_POPUP | WS_VISIBLE); |
657 dlg_tem.dwExtendedStyle = 0; | |
658 dlg_tem.cdit = Dynarr_length (dialog_items) + 1; | |
659 dlg_tem.x = 0; | |
660 dlg_tem.y = 0; | |
661 dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE; | |
662 dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON | |
663 + Y_BUTTON + Y_BUTTON_FROM_EDGE); | |
593 | 664 Dynarr_add_many (template_, &dlg_tem, sizeof (dlg_tem)); |
771 | 665 |
428 | 666 /* We want no menu and standard class */ |
593 | 667 Dynarr_add_many (template_, &zeroes, 4); |
771 | 668 |
442 | 669 /* And the third is the dialog title. "XEmacs" unless one is supplied. |
670 Note that the string must be in Unicode. */ | |
671 if (NILP (title)) | |
593 | 672 Dynarr_add_many (template_, L"XEmacs", 14); |
442 | 673 else |
593 | 674 push_lisp_string_as_unicode (template_, title); |
771 | 675 |
428 | 676 /* Next add text control. */ |
677 item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX; | |
678 item_tem.dwExtendedStyle = 0; | |
679 item_tem.x = X_TEXT_FROM_EDGE; | |
680 item_tem.y = Y_TEXT_FROM_EDGE; | |
681 item_tem.cx = text_width; | |
682 item_tem.cy = text_height; | |
683 item_tem.id = 0xFFFF; | |
771 | 684 |
428 | 685 ALIGN_TEMPLATE; |
593 | 686 Dynarr_add_many (template_, &item_tem, sizeof (item_tem)); |
771 | 687 |
428 | 688 /* Right after class id follows */ |
593 | 689 Dynarr_add_many (template_, &ones, 2); |
690 Dynarr_add_many (template_, &static_class_id, sizeof (static_class_id)); | |
771 | 691 |
428 | 692 /* Next thing to add is control text, as Unicode string */ |
593 | 693 push_lisp_string_as_unicode (template_, question); |
771 | 694 |
428 | 695 /* Specify 0 length creation data */ |
593 | 696 Dynarr_add_many (template_, &zeroes, 2); |
771 | 697 |
428 | 698 /* Now it's the button time */ |
699 item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON; | |
700 item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width | |
701 ? (text_width - button_row_width) / 2 | |
702 : 0); | |
703 item_tem.cy = Y_BUTTON; | |
704 item_tem.dwExtendedStyle = 0; | |
771 | 705 |
428 | 706 for (i = 0; i < Dynarr_length (dialog_items); ++i) |
707 { | |
771 | 708 Lisp_Object *gui_item = Dynarr_atp (dialog_items, i); |
440 | 709 Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item); |
771 | 710 |
428 | 711 item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON |
1913 | 712 | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED)); |
428 | 713 item_tem.cx = button_width (pgui_item->name); |
714 /* Item ids are indices into dialog_items plus offset, to avoid having | |
715 items by reserved ids (IDOK, IDCANCEL) */ | |
716 item_tem.id = i + ID_ITEM_BIAS; | |
771 | 717 |
428 | 718 ALIGN_TEMPLATE; |
593 | 719 Dynarr_add_many (template_, &item_tem, sizeof (item_tem)); |
771 | 720 |
428 | 721 /* Right after 0xFFFF and class id atom follows */ |
593 | 722 Dynarr_add_many (template_, &ones, 2); |
723 Dynarr_add_many (template_, &button_class_id, | |
724 sizeof (button_class_id)); | |
771 | 725 |
428 | 726 /* Next thing to add is control text, as Unicode string */ |
442 | 727 { |
867 | 728 Ichar accel_unused; |
771 | 729 |
730 push_lisp_string_as_unicode | |
731 (template_, | |
732 mswindows_translate_menu_or_dialog_item | |
733 (pgui_item->name, &accel_unused)); | |
442 | 734 } |
771 | 735 |
428 | 736 /* Specify 0 length creation data. */ |
593 | 737 Dynarr_add_many (template_, &zeroes, 2); |
771 | 738 |
428 | 739 item_tem.x += item_tem.cx + X_BUTTON_SPACING; |
740 } | |
741 } | |
771 | 742 |
428 | 743 /* Now the Windows dialog structure is ready. We need to prepare a |
744 data structure for the new dialog, which will contain callbacks | |
442 | 745 and the frame for these callbacks. This structure has to be |
746 GC-protected and thus it is put into a statically protected | |
747 list. */ | |
428 | 748 { |
749 int i; | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
750 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (mswindows_dialog_id); |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
751 struct mswindows_dialog_id *did = XMSWINDOWS_DIALOG_ID (obj); |
771 | 752 |
442 | 753 did->frame = wrap_frame (f); |
754 did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound); | |
755 for (i = 0; i < Dynarr_length (dialog_items); i++) | |
756 XVECTOR_DATA (did->callbacks) [i] = | |
757 XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; | |
428 | 758 |
759 /* Woof! Everything is ready. Pop pop pop in now! */ | |
442 | 760 did->hwnd = |
771 | 761 qxeCreateDialogIndirectParam (NULL, |
4967 | 762 (LPDLGTEMPLATE) Dynarr_begin (template_), |
771 | 763 FRAME_MSWINDOWS_HANDLE (f), dialog_proc, |
5125 | 764 (LPARAM) STORE_LISP_IN_VOID (obj)); |
442 | 765 if (!did->hwnd) |
428 | 766 /* Something went wrong creating the dialog */ |
563 | 767 signal_error (Qdialog_box_error, "Creating dialog", keys); |
771 | 768 |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
769 Vdialog_data_list = Fcons (obj, Vdialog_data_list); |
771 | 770 |
442 | 771 /* Cease protection and free dynarrays */ |
771 | 772 unbind_to (unbind_count); |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
773 return obj; |
428 | 774 } |
442 | 775 } |
428 | 776 |
442 | 777 static Lisp_Object |
778 mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type, | |
779 Lisp_Object keys) | |
780 { | |
707 | 781 int unbind_count = specpdl_depth (); |
782 record_unwind_protect (dialog_popped_down, Qnil); | |
783 popup_up_p++; | |
819 | 784 |
442 | 785 if (EQ (type, Qfile)) |
771 | 786 return unbind_to_1 (unbind_count, handle_file_dialog_box (f, keys)); |
673 | 787 else if (EQ (type, Qdirectory)) |
771 | 788 return unbind_to_1 (unbind_count, handle_directory_dialog_box (f, keys)); |
442 | 789 else if (EQ (type, Qquestion)) |
771 | 790 return unbind_to_1 (unbind_count, handle_question_dialog_box (f, keys)); |
442 | 791 else if (EQ (type, Qprint)) |
771 | 792 return unbind_to_1 (unbind_count, |
793 mswindows_handle_print_dialog_box (f, keys)); | |
442 | 794 else if (EQ (type, Qpage_setup)) |
771 | 795 return unbind_to_1 (unbind_count, |
796 mswindows_handle_page_setup_dialog_box (f, keys)); | |
442 | 797 else |
563 | 798 signal_error (Qunimplemented, "Dialog box type", type); |
442 | 799 return Qnil; |
428 | 800 } |
801 | |
802 void | |
803 console_type_create_dialog_mswindows (void) | |
804 { | |
442 | 805 CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal); |
806 } | |
807 | |
808 void | |
809 syms_of_dialog_mswindows (void) | |
810 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
811 INIT_LISP_OBJECT (mswindows_dialog_id); |
771 | 812 |
442 | 813 DEFKEYWORD (Q_initial_directory); |
814 DEFKEYWORD (Q_initial_filename); | |
815 DEFKEYWORD (Q_filter_list); | |
816 DEFKEYWORD (Q_title); | |
817 DEFKEYWORD (Q_allow_multi_select); | |
818 DEFKEYWORD (Q_create_prompt_on_nonexistent); | |
819 DEFKEYWORD (Q_overwrite_prompt); | |
820 DEFKEYWORD (Q_file_must_exist); | |
821 DEFKEYWORD (Q_no_network_button); | |
822 DEFKEYWORD (Q_no_read_only_return); | |
771 | 823 |
442 | 824 /* Errors */ |
563 | 825 DEFERROR_STANDARD (Qdialog_box_error, Qgui_error); |
428 | 826 } |
827 | |
828 void | |
829 vars_of_dialog_mswindows (void) | |
830 { | |
442 | 831 Vpopup_frame_list = Qnil; |
832 staticpro (&Vpopup_frame_list); | |
771 | 833 |
428 | 834 Vdialog_data_list = Qnil; |
835 staticpro (&Vdialog_data_list); | |
771 | 836 |
442 | 837 DEFVAR_LISP ("default-file-dialog-filter-alist", |
838 &Vdefault_file_dialog_filter_alist /* | |
771 | 839 */ ); |
442 | 840 Vdefault_file_dialog_filter_alist = |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
841 list5 (Fcons (build_defer_string ("Text Files"), build_ascstring ("*.txt")), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
842 Fcons (build_defer_string ("C Files"), build_ascstring ("*.c;*.h")), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
843 Fcons (build_defer_string ("Elisp Files"), build_ascstring ("*.el")), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
844 Fcons (build_defer_string ("HTML Files"), build_ascstring ("*.html;*.html")), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
845 Fcons (build_defer_string ("All Files"), build_ascstring ("*.*"))); |
428 | 846 } |