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