git.chise.org Git - chise/xemacs-chise.git.1/blob - 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 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
  53 /* List containing all dialog data structures of currently popped up
  54    dialogs. */
  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;
  61
  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
 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);
 178
 179 /* Dialog procedure */
 180 static BOOL CALLBACK
 181 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
 182 {
 183   switch (msg)
 184     {
 185     case WM_INITDIALOG:
 186       SetWindowLong (hwnd, DWL_USER, l_param);
 187       break;
 188
 189     case WM_DESTROY:
 190       {
 191         Lisp_Object data;
 192         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 193         Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
 194       }
 195       break;
 196
 197     case WM_COMMAND:
 198       {
 199         Lisp_Object fn, arg, data;
 200         struct mswindows_dialog_id *did;
 201
 202         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 203         did = XMSWINDOWS_DIALOG_ID (data);
 204         if (w_param != IDCANCEL) /* user pressed escape */
 205           {
 206             assert (w_param >= ID_ITEM_BIAS
 207                     && w_param
 208                     < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS);
 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);
 221
 222         DestroyWindow (hwnd);
 223       }
 224       break;
 225
 226     default:
 227       return FALSE;
 228     }
 229   return TRUE;
 230 }
 231
 232 /* Helper function which converts the supplied string STRING into Unicode and
 233    pushes it at the end of DYNARR */
 234 static void
 235 push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string)
 236 {
 237   Extbyte *mbcs_string;
 238   Charcount length = XSTRING_CHAR_LENGTH (string);
 239   LPWSTR uni_string;
 240
 241   TO_EXTERNAL_FORMAT (LISP_STRING, string,
 242                       C_STRING_ALLOCA, mbcs_string,
 243                       Qnative);
 244   uni_string = alloca_array (WCHAR, length + 1);
 245   length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
 246                                 uni_string, sizeof(WCHAR) * (length + 1));
 247   Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
 248 }
 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
 269 /* Given button TEXT, return button width in DLU */
 270 static unsigned int
 271 button_width (Lisp_Object text)
 272 {
 273   unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
 274   return max (X_MIN_BUTTON, width);
 275 }
 276
 277 /* Unwind protection routine frees a dynarr opaqued into arg */
 278 static Lisp_Object
 279 free_dynarr_opaque_ptr (Lisp_Object arg)
 280 {
 281   Dynarr_free (get_opaque_ptr (arg));
 282   return arg;
 283 }
 284
 285
 286 #define ALIGN_TEMPLATE                                  \
 287 {                                                       \
 288   unsigned int slippage = Dynarr_length (template) & 3; \
 289   if (slippage)                                         \
 290     Dynarr_add_many (template, &zeroes, slippage);      \
 291 }
 292
 293 static struct
 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)
 411 {
 412   Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
 413   unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
 414   unsigned int button_row_width = 0;
 415   unsigned int text_width, text_height;
 416   Lisp_Object question = Qnil, title = Qnil;
 417
 418   int unbind_count = specpdl_depth ();
 419   record_unwind_protect (free_dynarr_opaque_ptr,
 420                          make_opaque_ptr (dialog_items));
 421   record_unwind_protect (free_dynarr_opaque_ptr,
 422                          make_opaque_ptr (template));
 423
 424   /* A big NO NEED to GCPRO gui_items stored in the array: they are just
 425      pointers into KEYS list, which is GC-protected by the caller */
 426
 427   {
 428     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 429       {
 430         if (EQ (key, Q_question))
 431           {
 432             CHECK_STRING (value);
 433             question = value;
 434           }
 435         else if (EQ (key, Q_title))
 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);
 463       }
 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);
 471
 472   /* Determine the final width layout */
 473   {
 474     Bufbyte *p = XSTRING_DATA (question);
 475     Charcount string_max = 0, this_length = 0;
 476     while (1)
 477       {
 478         Emchar ch = charptr_emchar (p);
 479         INC_CHARPTR (p);
 480
 481         if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
 482           {
 483             string_max = max (this_length, string_max);
 484             this_length = 0;
 485           }
 486         else
 487           ++this_length;
 488
 489         if (ch == (Emchar)'\0')
 490           break;
 491       }
 492
 493     if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
 494       text_width = X_AVE_TEXT;
 495     else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
 496       text_width = X_MIN_TEXT;
 497     else
 498       text_width = string_max * X_DLU_PER_CHAR;
 499     text_width = max (text_width, button_row_width);
 500   }
 501
 502   /* Now calculate the height for the text control */
 503   {
 504     Bufbyte *p = XSTRING_DATA (question);
 505     Charcount break_at = text_width / X_DLU_PER_CHAR;
 506     Charcount char_pos = 0;
 507     int num_lines = 1;
 508     Emchar ch;
 509
 510     while ((ch = charptr_emchar (p)) != (Emchar) '\0')
 511       {
 512         INC_CHARPTR (p);
 513         char_pos += ch != (Emchar) '\n';
 514         if (ch == (Emchar) '\n' || char_pos == break_at)
 515           {
 516             ++num_lines;
 517             char_pos = 0;
 518           }
 519       }
 520     text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
 521   }
 522
 523   /* Ok, now we are ready to stuff the dialog template and lay out controls */
 524   {
 525     DLGTEMPLATE dlg_tem;
 526     DLGITEMTEMPLATE item_tem;
 527     int i;
 528     const unsigned int zeroes = 0;
 529     const unsigned int ones = 0xFFFFFFFF;
 530     const WORD static_class_id = 0x0082;
 531     const WORD button_class_id = 0x0080;
 532
 533     /* Create and stuff in DLGTEMPLATE header */
 534     dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
 535                      | WS_CAPTION | WS_POPUP | WS_VISIBLE);
 536     dlg_tem.dwExtendedStyle = 0;
 537     dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
 538     dlg_tem.x = 0;
 539     dlg_tem.y = 0;
 540     dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
 541     dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
 542                   + Y_BUTTON + Y_BUTTON_FROM_EDGE);
 543     Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
 544
 545     /* We want no menu and standard class */
 546     Dynarr_add_many (template, &zeroes, 4);
 547
 548     /* And the third is the dialog title. "XEmacs" unless one is supplied.
 549        Note that the string must be in Unicode. */
 550     if (NILP (title))
 551       Dynarr_add_many (template, L"XEmacs", 14);
 552     else
 553       push_lisp_string_as_unicode (template, title);
 554
 555     /* We want standard dialog font */
 556     Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
 557
 558     /* Next add text control. */
 559     item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
 560     item_tem.dwExtendedStyle = 0;
 561     item_tem.x = X_TEXT_FROM_EDGE;
 562     item_tem.y = Y_TEXT_FROM_EDGE;
 563     item_tem.cx = text_width;
 564     item_tem.cy = text_height;
 565     item_tem.id = 0xFFFF;
 566
 567     ALIGN_TEMPLATE;
 568     Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 569
 570     /* Right after class id follows */
 571     Dynarr_add_many (template, &ones, 2);
 572     Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
 573
 574     /* Next thing to add is control text, as Unicode string */
 575     push_lisp_string_as_unicode (template, question);
 576
 577     /* Specify 0 length creation data */
 578     Dynarr_add_many (template, &zeroes, 2);
 579
 580     /* Now it's the button time */
 581     item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
 582     item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
 583                                        ? (text_width - button_row_width) / 2
 584                                        : 0);
 585     item_tem.cy = Y_BUTTON;
 586     item_tem.dwExtendedStyle = 0;
 587
 588     for (i = 0; i < Dynarr_length (dialog_items); ++i)
 589       {
 590         Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
 591         Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
 592
 593         item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
 594                           | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
 595         item_tem.cx = button_width (pgui_item->name);
 596         /* Item ids are indices into dialog_items plus offset, to avoid having
 597            items by reserved ids (IDOK, IDCANCEL) */
 598         item_tem.id = i + ID_ITEM_BIAS;
 599
 600         ALIGN_TEMPLATE;
 601         Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 602
 603         /* Right after 0xFFFF and class id atom follows */
 604         Dynarr_add_many (template, &ones, 2);
 605         Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
 606
 607         /* Next thing to add is control text, as Unicode string */
 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         }
 623
 624         /* Specify 0 length creation data. */
 625         Dynarr_add_many (template, &zeroes, 2);
 626
 627         item_tem.x += item_tem.cx + X_BUTTON_SPACING;
 628       }
 629   }
 630
 631   /* Now the Windows dialog structure is ready. We need to prepare a
 632      data structure for the new dialog, which will contain callbacks
 633      and the frame for these callbacks.  This structure has to be
 634      GC-protected and thus it is put into a statically protected
 635      list. */
 636   {
 637     Lisp_Object dialog_data;
 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;
 650
 651     /* Woof! Everything is ready. Pop pop pop in now! */
 652     did->hwnd =
 653       CreateDialogIndirectParam (NULL,
 654                                  (LPDLGTEMPLATE) Dynarr_atp (template, 0),
 655                                  FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
 656                                  (LPARAM) LISP_TO_VOID (dialog_data));
 657     if (!did->hwnd)
 658       /* Something went wrong creating the dialog */
 659       signal_type_error (Qdialog_box_error, "Creating dialog", keys);
 660
 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;
 666   }
 667 }
 668
 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;
 686 }
 687
 688 void
 689 console_type_create_dialog_mswindows (void)
 690 {
 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);
 712 }
 713
 714 void
 715 vars_of_dialog_mswindows (void)
 716 {
 717   Vpopup_frame_list = Qnil;
 718   staticpro (&Vpopup_frame_list);
 719
 720   Vdialog_data_list = Qnil;
 721   staticpro (&Vdialog_data_list);
 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 }