Mercurial > hg > xemacs-beta

comparison src/dialog-msw.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 /* Implements elisp-programmable dialog boxes -- MS Windows interface. 1 /* Implements elisp-programmable dialog boxes -- MS Windows interface.
2 Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru> 2 Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru>
3 Copyright (C) 2000 Ben Wing.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
31 #include "console-msw.h" 32 #include "console-msw.h"
32 #include "frame.h" 33 #include "frame.h"
33 #include "gui.h" 34 #include "gui.h"
34 #include "opaque.h" 35 #include "opaque.h"
35 36
37 #include <cderr.h>
38 #include <commdlg.h>
39
40 Lisp_Object Qdialog_box_error;
41
42 static Lisp_Object Q_initial_directory;
43 static Lisp_Object Q_initial_filename;
44 static Lisp_Object Q_filter_list;
45 static Lisp_Object Q_title;
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
36 /* List containing all dialog data structures of currently popped up 53 /* List containing all dialog data structures of currently popped up
37 dialogs. Each item is a cons of frame object and a vector of 54 dialogs. */
38 callbacks for buttons in the dialog, in order */
39 static Lisp_Object Vdialog_data_list; 55 static Lisp_Object Vdialog_data_list;
56
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;
40 61
41 /* DLUs per character metrics */ 62 /* DLUs per character metrics */
42 #define X_DLU_PER_CHAR 4 63 #define X_DLU_PER_CHAR 4
43 #define Y_DLU_PER_CHAR 8 64 #define Y_DLU_PER_CHAR 8
44 65
107 latter is centered across the dialog, by giving it extra edge 128 latter is centered across the dialog, by giving it extra edge
108 margins. Otherwise, minimal margins are given to the button row. 129 margins. Otherwise, minimal margins are given to the button row.
109 */ 130 */
110 131
111 #define ID_ITEM_BIAS 32 132 #define ID_ITEM_BIAS 32
133
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 {
152 if (IsDialogMessage (XMSWINDOWS_DIALOG_ID (data)->hwnd, msg))
153 return 1;
154 }
155
156 {
157 LIST_LOOP_2 (popup, Vpopup_frame_list)
158 {
159 HWND hwnd = FRAME_MSWINDOWS_HANDLE (XFRAME (popup));
160 if (IsDialogMessage (hwnd, msg))
161 return 1;
162 }
163 }
164 return 0;
165 }
166
167 static Lisp_Object
168 mark_mswindows_dialog_id (Lisp_Object obj)
169 {
170 struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj);
171 mark_object (data->frame);
172 return data->callbacks;
173 }
174
175 DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id,
176 mark_mswindows_dialog_id, 0, 0, 0, 0, 0,
177 struct mswindows_dialog_id);
112 178
113 /* Dialog procedure */ 179 /* Dialog procedure */
114 static BOOL CALLBACK 180 static BOOL CALLBACK
115 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param) 181 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
116 { 182 {
129 break; 195 break;
130 196
131 case WM_COMMAND: 197 case WM_COMMAND:
132 { 198 {
133 Lisp_Object fn, arg, data; 199 Lisp_Object fn, arg, data;
200 struct mswindows_dialog_id *did;
201
134 VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER)); 202 VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
135 203 did = XMSWINDOWS_DIALOG_ID (data);
136 assert (w_param >= ID_ITEM_BIAS 204 if (w_param != IDCANCEL) /* user pressed escape */
137 && w_param < XVECTOR_LENGTH (XCDR (data)) + ID_ITEM_BIAS); 205 {
138 206 assert (w_param >= ID_ITEM_BIAS
139 get_gui_callback (XVECTOR_DATA (XCDR (data)) [w_param - ID_ITEM_BIAS], 207 && w_param
140 &fn, &arg); 208 < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS);
141 mswindows_enqueue_misc_user_event (XCAR (data), fn, arg); 209
210 get_gui_callback (XVECTOR_DATA (did->callbacks)
211 [w_param - ID_ITEM_BIAS],
212 &fn, &arg);
213 mswindows_enqueue_misc_user_event (did->frame, fn, arg);
214 }
215 else
216 mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks,
217 Qmenu_no_selection_hook);
218 /* #### need to error-protect! will do so when i merge in
219 my working ws */
220 va_run_hook_with_args (Qdelete_dialog_box_hook, 1, data);
142 221
143 DestroyWindow (hwnd); 222 DestroyWindow (hwnd);
144 } 223 }
145 break; 224 break;
146 225
166 length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1, 245 length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
167 uni_string, sizeof(WCHAR) * (length + 1)); 246 uni_string, sizeof(WCHAR) * (length + 1));
168 Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length); 247 Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
169 } 248 }
170 249
250 /* Helper function which converts the supplied string STRING into Unicode and
251 pushes it at the end of DYNARR */
252 static void
253 push_bufbyte_string_as_unicode (unsigned_char_dynarr* dynarr, Bufbyte *string,
254 Bytecount len)
255 {
256 Extbyte *mbcs_string;
257 Charcount length = bytecount_to_charcount (string, len);
258 LPWSTR uni_string;
259
260 TO_EXTERNAL_FORMAT (C_STRING, string,
261 C_STRING_ALLOCA, mbcs_string,
262 Qnative);
263 uni_string = alloca_array (WCHAR, length + 1);
264 length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
265 uni_string, sizeof(WCHAR) * (length + 1));
266 Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
267 }
268
171 /* Given button TEXT, return button width in DLU */ 269 /* Given button TEXT, return button width in DLU */
172 static unsigned int 270 static unsigned int
173 button_width (Lisp_Object text) 271 button_width (Lisp_Object text)
174 { 272 {
175 unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text); 273 unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
190 unsigned int slippage = Dynarr_length (template) & 3; \ 288 unsigned int slippage = Dynarr_length (template) & 3; \
191 if (slippage) \ 289 if (slippage) \
192 Dynarr_add_many (template, &zeroes, slippage); \ 290 Dynarr_add_many (template, &zeroes, slippage); \
193 } 291 }
194 292
195 static void 293 static struct
196 mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc) 294 {
295 int errmess;
296 char *errname;
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
332 static Lisp_Object
333 handle_file_dialog_box (struct frame *f, Lisp_Object keys)
334 {
335 OPENFILENAME ofn;
336 char fnbuf[8000];
337
338 xzero (ofn);
339 ofn.lStructSize = sizeof (ofn);
340 ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
341 ofn.lpstrFile = fnbuf;
342 ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE;
343 xetcscpy (fnbuf, XETEXT (""));
344
345 LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
346 ofn.lpstrInitialDir);
347
348 {
349 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
350 {
351 if (EQ (key, Q_initial_filename))
352 {
353 Extbyte *fnout;
354
355 CHECK_STRING (value);
356 LOCAL_FILE_FORMAT_TO_TSTR (value, fnout);
357 xetcscpy (fnbuf, fnout);
358 }
359 else if (EQ (key, Q_title))
360 {
361 CHECK_STRING (value);
362 LISP_STRING_TO_EXTERNAL (value, ofn.lpstrTitle, Qmswindows_tstr);
363 }
364 else if (EQ (key, Q_initial_directory))
365 LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
366 ofn.lpstrInitialDir);
367 else if (EQ (key, Q_file_must_exist))
368 {
369 if (!NILP (value))
370 ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
371 else
372 ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST);
373 }
374 else
375 syntax_error ("Unrecognized file-dialog keyword", key);
376 }
377 }
378
379 if (!GetOpenFileName (&ofn))
380 {
381 DWORD err = CommDlgExtendedError ();
382 if (!err)
383 {
384 while (1)
385 signal_quit ();
386 }
387 else
388 {
389 int i;
390
391 for (i = 0; i < countof (common_dialog_errors); i++)
392 {
393 if (common_dialog_errors[i].errmess == err)
394 signal_type_error (Qdialog_box_error,
395 "Creating file-dialog-box",
396 build_string
397 (common_dialog_errors[i].errname));
398 }
399
400 signal_type_error (Qdialog_box_error,
401 "Unknown common dialog box error???",
402 make_int (err));
403 }
404 }
405
406 return tstr_to_local_file_format (ofn.lpstrFile);
407 }
408
409 static Lisp_Object
410 handle_question_dialog_box (struct frame *f, Lisp_Object keys)
197 { 411 {
198 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object); 412 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
199 unsigned_char_dynarr *template = Dynarr_new (unsigned_char); 413 unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
200 unsigned int button_row_width = 0; 414 unsigned int button_row_width = 0;
201 unsigned int text_width, text_height; 415 unsigned int text_width, text_height;
416 Lisp_Object question = Qnil, title = Qnil;
202 417
203 int unbind_count = specpdl_depth (); 418 int unbind_count = specpdl_depth ();
204 record_unwind_protect (free_dynarr_opaque_ptr, 419 record_unwind_protect (free_dynarr_opaque_ptr,
205 make_opaque_ptr (dialog_items)); 420 make_opaque_ptr (dialog_items));
206 record_unwind_protect (free_dynarr_opaque_ptr, 421 record_unwind_protect (free_dynarr_opaque_ptr,
207 make_opaque_ptr (template)); 422 make_opaque_ptr (template));
208 423
209 /* A big NO NEED to GCPRO gui_items stored in the array: they are just 424 /* A big NO NEED to GCPRO gui_items stored in the array: they are just
210 pointers into DESC list, which is GC-protected by the caller */ 425 pointers into KEYS list, which is GC-protected by the caller */
211 426
212 /* Parse each item in the dialog into gui_item structs, and stuff a dynarr
213 of these. Calculate button row width in this loop too */
214 { 427 {
215 Lisp_Object item_cons; 428 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
216
217 EXTERNAL_LIST_LOOP (item_cons, XCDR (desc))
218 { 429 {
219 if (!NILP (XCAR (item_cons))) 430 if (EQ (key, Q_question))
220 { 431 {
221 Lisp_Object gitem = gui_parse_item_keywords (XCAR (item_cons)); 432 CHECK_STRING (value);
222 Dynarr_add (dialog_items, gitem); 433 question = value;
223 button_row_width += button_width (XGUI_ITEM (gitem)->name) 434 }
224 + X_BUTTON_MARGIN; 435 else if (EQ (key, Q_title))
225 } 436 {
437 CHECK_STRING (value);
438 title = value;
439 }
440 else if (EQ (key, Q_buttons))
441 {
442 Lisp_Object item_cons;
443
444 /* Parse each item in the dialog into gui_item structs,
445 and stuff a dynarr of these. Calculate button row width
446 in this loop too */
447 EXTERNAL_LIST_LOOP (item_cons, value)
448 {
449 if (!NILP (XCAR (item_cons)))
450 {
451 Lisp_Object gitem =
452 gui_parse_item_keywords (XCAR (item_cons));
453 Dynarr_add (dialog_items, gitem);
454 button_row_width += button_width (XGUI_ITEM (gitem)->name)
455 + X_BUTTON_MARGIN;
456 }
457 }
458
459 button_row_width -= X_BUTTON_MARGIN;
460 }
461 else
462 syntax_error ("Unrecognized question-dialog keyword", key);
226 } 463 }
227 if (Dynarr_length (dialog_items) == 0)
228 signal_simple_error ("Dialog descriptor provides no active items", desc);
229 button_row_width -= X_BUTTON_MARGIN;
230 } 464 }
465
466 if (Dynarr_length (dialog_items) == 0)
467 syntax_error ("Dialog descriptor provides no buttons", keys);
468
469 if (NILP (question))
470 syntax_error ("Dialog descriptor provides no question", keys);
231 471
232 /* Determine the final width layout */ 472 /* Determine the final width layout */
233 { 473 {
234 Bufbyte *p = XSTRING_DATA (XCAR (desc)); 474 Bufbyte *p = XSTRING_DATA (question);
235 Charcount string_max = 0, this_length = 0; 475 Charcount string_max = 0, this_length = 0;
236 while (1) 476 while (1)
237 { 477 {
238 Emchar ch = charptr_emchar (p); 478 Emchar ch = charptr_emchar (p);
239 INC_CHARPTR (p); 479 INC_CHARPTR (p);
259 text_width = max (text_width, button_row_width); 499 text_width = max (text_width, button_row_width);
260 } 500 }
261 501
262 /* Now calculate the height for the text control */ 502 /* Now calculate the height for the text control */
263 { 503 {
264 Bufbyte *p = XSTRING_DATA (XCAR (desc)); 504 Bufbyte *p = XSTRING_DATA (question);
265 Charcount break_at = text_width / X_DLU_PER_CHAR; 505 Charcount break_at = text_width / X_DLU_PER_CHAR;
266 Charcount char_pos = 0; 506 Charcount char_pos = 0;
267 int num_lines = 1; 507 int num_lines = 1;
268 Emchar ch; 508 Emchar ch;
269 509
270 while ((ch = charptr_emchar (p)) != (Emchar)'\0') 510 while ((ch = charptr_emchar (p)) != (Emchar) '\0')
271 { 511 {
272 INC_CHARPTR (p); 512 INC_CHARPTR (p);
273 char_pos += ch != (Emchar)'\n'; 513 char_pos += ch != (Emchar) '\n';
274 if (ch == (Emchar)'\n' || char_pos == break_at) 514 if (ch == (Emchar) '\n' || char_pos == break_at)
275 { 515 {
276 ++num_lines; 516 ++num_lines;
277 char_pos = 0; 517 char_pos = 0;
278 } 518 }
279 } 519 }
303 Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem)); 543 Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
304 544
305 /* We want no menu and standard class */ 545 /* We want no menu and standard class */
306 Dynarr_add_many (template, &zeroes, 4); 546 Dynarr_add_many (template, &zeroes, 4);
307 547
308 /* And the third is the dialog title. "XEmacs" as long as we do not supply 548 /* And the third is the dialog title. "XEmacs" unless one is supplied.
309 one in descriptor. Note that the string must be in Unicode. */ 549 Note that the string must be in Unicode. */
310 Dynarr_add_many (template, L"XEmacs", 14); 550 if (NILP (title))
551 Dynarr_add_many (template, L"XEmacs", 14);
552 else
553 push_lisp_string_as_unicode (template, title);
311 554
312 /* We want standard dialog font */ 555 /* We want standard dialog font */
313 Dynarr_add_many (template, L"\x08MS Shell Dlg", 28); 556 Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
314 557
315 /* Next add text control. */ 558 /* Next add text control. */
327 /* Right after class id follows */ 570 /* Right after class id follows */
328 Dynarr_add_many (template, &ones, 2); 571 Dynarr_add_many (template, &ones, 2);
329 Dynarr_add_many (template, &static_class_id, sizeof (static_class_id)); 572 Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
330 573
331 /* Next thing to add is control text, as Unicode string */ 574 /* Next thing to add is control text, as Unicode string */
332 push_lisp_string_as_unicode (template, XCAR (desc)); 575 push_lisp_string_as_unicode (template, question);
333 576
334 /* Specify 0 length creation data */ 577 /* Specify 0 length creation data */
335 Dynarr_add_many (template, &zeroes, 2); 578 Dynarr_add_many (template, &zeroes, 2);
336 579
337 /* Now it's the button time */ 580 /* Now it's the button time */
360 /* Right after 0xFFFF and class id atom follows */ 603 /* Right after 0xFFFF and class id atom follows */
361 Dynarr_add_many (template, &ones, 2); 604 Dynarr_add_many (template, &ones, 2);
362 Dynarr_add_many (template, &button_class_id, sizeof (button_class_id)); 605 Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
363 606
364 /* Next thing to add is control text, as Unicode string */ 607 /* Next thing to add is control text, as Unicode string */
365 push_lisp_string_as_unicode (template, pgui_item->name); 608 {
609 Lisp_Object ctext = pgui_item->name;
610 Emchar accel_unused;
611 Bufbyte *trans = (Bufbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3);
612 Bytecount translen;
613
614 memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
615 translen =
616 mswindows_translate_menu_or_dialog_item (trans,
617 XSTRING_LENGTH (ctext),
618 2 * XSTRING_LENGTH (ctext) + 3,
619 &accel_unused,
620 ctext);
621 push_bufbyte_string_as_unicode (template, trans, translen);
622 }
366 623
367 /* Specify 0 length creation data. */ 624 /* Specify 0 length creation data. */
368 Dynarr_add_many (template, &zeroes, 2); 625 Dynarr_add_many (template, &zeroes, 2);
369 626
370 item_tem.x += item_tem.cx + X_BUTTON_SPACING; 627 item_tem.x += item_tem.cx + X_BUTTON_SPACING;
371 } 628 }
372 } 629 }
373 630
374 /* Now the Windows dialog structure is ready. We need to prepare a 631 /* Now the Windows dialog structure is ready. We need to prepare a
375 data structure for the new dialog, which will contain callbacks 632 data structure for the new dialog, which will contain callbacks
376 and the frame for these callbacks. This structure has to be 633 and the frame for these callbacks. This structure has to be
377 GC-protected. The data structure itself is a cons of frame object 634 GC-protected and thus it is put into a statically protected
378 and a vector of callbacks; for the protection reasons it is put 635 list. */
379 into a statically protected list. */
380 { 636 {
381 Lisp_Object frame, vector, dialog_data; 637 Lisp_Object dialog_data;
382 int i; 638 int i;
639 struct mswindows_dialog_id *did =
640 alloc_lcrecord_type (struct mswindows_dialog_id,
641 &lrecord_mswindows_dialog_id);
642
643 XSETMSWINDOWS_DIALOG_ID (dialog_data, did);
644
645 did->frame = wrap_frame (f);
646 did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound);
647 for (i = 0; i < Dynarr_length (dialog_items); i++)
648 XVECTOR_DATA (did->callbacks) [i] =
649 XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
383 650
384 XSETFRAME (frame, f);
385 vector = make_vector (Dynarr_length (dialog_items), Qunbound);
386 dialog_data = Fcons (frame, vector);
387 for (i = 0; i < Dynarr_length (dialog_items); i++)
388 XVECTOR_DATA (vector) [i] = XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
389
390 /* Woof! Everything is ready. Pop pop pop in now! */ 651 /* Woof! Everything is ready. Pop pop pop in now! */
391 if (!CreateDialogIndirectParam (NULL, 652 did->hwnd =
392 (LPDLGTEMPLATE) Dynarr_atp (template, 0), 653 CreateDialogIndirectParam (NULL,
393 FRAME_MSWINDOWS_HANDLE (f), dialog_proc, 654 (LPDLGTEMPLATE) Dynarr_atp (template, 0),
394 (LPARAM) LISP_TO_VOID (dialog_data))) 655 FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
656 (LPARAM) LISP_TO_VOID (dialog_data));
657 if (!did->hwnd)
395 /* Something went wrong creating the dialog */ 658 /* Something went wrong creating the dialog */
396 signal_simple_error ("System error creating dialog", desc); 659 signal_type_error (Qdialog_box_error, "Creating dialog", keys);
397 660
398 Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list); 661 Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
662
663 /* Cease protection and free dynarrays */
664 unbind_to (unbind_count, Qnil);
665 return dialog_data;
399 } 666 }
400 667 }
401 /* Cease protection and free dynarrays */ 668
402 unbind_to (unbind_count, Qnil); 669 static Lisp_Object
670 mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type,
671 Lisp_Object keys)
672 {
673 if (EQ (type, Qfile))
674 return handle_file_dialog_box (f, keys);
675 else if (EQ (type, Qquestion))
676 return handle_question_dialog_box (f, keys);
677 else if (EQ (type, Qprint))
678 return mswindows_handle_print_dialog_box (f, keys);
679 else if (EQ (type, Qpage_setup))
680 return mswindows_handle_page_setup_dialog_box (f, keys);
681 else if (EQ (type, Qprint_setup))
682 return mswindows_handle_print_setup_dialog_box (f, keys);
683 else
684 signal_type_error (Qunimplemented, "Dialog box type", type);
685 return Qnil;
403 } 686 }
404 687
405 void 688 void
406 console_type_create_dialog_mswindows (void) 689 console_type_create_dialog_mswindows (void)
407 { 690 {
408 CONSOLE_HAS_METHOD (mswindows, popup_dialog_box); 691 CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal);
692 }
693
694 void
695 syms_of_dialog_mswindows (void)
696 {
697 INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id);
698
699 DEFKEYWORD (Q_initial_directory);
700 DEFKEYWORD (Q_initial_filename);
701 DEFKEYWORD (Q_filter_list);
702 DEFKEYWORD (Q_title);
703 DEFKEYWORD (Q_allow_multi_select);
704 DEFKEYWORD (Q_create_prompt_on_nonexistent);
705 DEFKEYWORD (Q_overwrite_prompt);
706 DEFKEYWORD (Q_file_must_exist);
707 DEFKEYWORD (Q_no_network_button);
708 DEFKEYWORD (Q_no_read_only_return);
709
710 /* Errors */
711 DEFERROR_STANDARD (Qdialog_box_error, Qinvalid_operation);
409 } 712 }
410 713
411 void 714 void
412 vars_of_dialog_mswindows (void) 715 vars_of_dialog_mswindows (void)
413 { 716 {
717 Vpopup_frame_list = Qnil;
718 staticpro (&Vpopup_frame_list);
719
414 Vdialog_data_list = Qnil; 720 Vdialog_data_list = Qnil;
415 staticpro (&Vdialog_data_list); 721 staticpro (&Vdialog_data_list);
416 } 722
723 DEFVAR_LISP ("default-file-dialog-filter-alist",
724 &Vdefault_file_dialog_filter_alist /*
725 */ );
726 Vdefault_file_dialog_filter_alist =
727 list5 (Fcons (build_string ("Text Files"), build_string ("*.txt")),
728 Fcons (build_string ("C Files"), build_string ("*.c;*.h")),
729 Fcons (build_string ("Elisp Files"), build_string ("*.el")),
730 Fcons (build_string ("HTML Files"), build_string ("*.html;*.html")),
731 Fcons (build_string ("All Files"), build_string ("*.*")));
732 }