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         /* This is a windows feature that allows dialog type
 161            processing to be applied to standard windows containing
 162            controls. */
 163         if (IsDialogMessage (hwnd, msg))
 164           return 1;
 165       }
 166   }
 167   return 0;
 168 }
 169
 170 static Lisp_Object
 171 mark_mswindows_dialog_id (Lisp_Object obj)
 172 {
 173   struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj);
 174   mark_object (data->frame);
 175   return data->callbacks;
 176 }
 177
 178 DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id,
 179                                mark_mswindows_dialog_id, 0, 0, 0, 0, 0,
 180                                struct mswindows_dialog_id);
 181
 182 /* Dialog procedure */
 183 static BOOL CALLBACK
 184 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
 185 {
 186   switch (msg)
 187     {
 188     case WM_INITDIALOG:
 189       SetWindowLong (hwnd, DWL_USER, l_param);
 190       break;
 191
 192     case WM_DESTROY:
 193       {
 194         Lisp_Object data;
 195         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 196         Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
 197       }
 198       break;
 199
 200     case WM_COMMAND:
 201       {
 202         Lisp_Object fn, arg, data;
 203         struct mswindows_dialog_id *did;
 204
 205         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 206         did = XMSWINDOWS_DIALOG_ID (data);
 207         if (w_param != IDCANCEL) /* user pressed escape */
 208           {
 209             assert (w_param >= ID_ITEM_BIAS
 210                     && w_param
 211                     < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS);
 212
 213             get_gui_callback (XVECTOR_DATA (did->callbacks)
 214                               [w_param - ID_ITEM_BIAS],
 215                               &fn, &arg);
 216             mswindows_enqueue_misc_user_event (did->frame, fn, arg);
 217           }
 218         else
 219           mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks,
 220                                              Qmenu_no_selection_hook);
 221         /* #### need to error-protect!  will do so when i merge in
 222            my working ws */
 223         va_run_hook_with_args (Qdelete_dialog_box_hook, 1, data);
 224
 225         DestroyWindow (hwnd);
 226       }
 227       break;
 228
 229     default:
 230       return FALSE;
 231     }
 232   return TRUE;
 233 }
 234
 235 /* Helper function which converts the supplied string STRING into Unicode and
 236    pushes it at the end of DYNARR */
 237 static void
 238 push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string)
 239 {
 240   Extbyte *mbcs_string;
 241   Charcount length = XSTRING_CHAR_LENGTH (string);
 242   LPWSTR uni_string;
 243
 244   TO_EXTERNAL_FORMAT (LISP_STRING, string,
 245                       C_STRING_ALLOCA, mbcs_string,
 246                       Qnative);
 247   uni_string = alloca_array (WCHAR, length + 1);
 248   length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
 249                                 uni_string, sizeof(WCHAR) * (length + 1));
 250   Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
 251 }
 252
 253 /* Helper function which converts the supplied string STRING into Unicode and
 254    pushes it at the end of DYNARR */
 255 static void
 256 push_bufbyte_string_as_unicode (unsigned_char_dynarr* dynarr, Bufbyte *string,
 257                                 Bytecount len)
 258 {
 259   Extbyte *mbcs_string;
 260   Charcount length = bytecount_to_charcount (string, len);
 261   LPWSTR uni_string;
 262
 263   TO_EXTERNAL_FORMAT (C_STRING, string,
 264                       C_STRING_ALLOCA, mbcs_string,
 265                       Qnative);
 266   uni_string = alloca_array (WCHAR, length + 1);
 267   length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
 268                                 uni_string, sizeof(WCHAR) * (length + 1));
 269   Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
 270 }
 271
 272 /* Given button TEXT, return button width in DLU */
 273 static unsigned int
 274 button_width (Lisp_Object text)
 275 {
 276   unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
 277   return max (X_MIN_BUTTON, width);
 278 }
 279
 280 /* Unwind protection routine frees a dynarr opaqued into arg */
 281 static Lisp_Object
 282 free_dynarr_opaque_ptr (Lisp_Object arg)
 283 {
 284   Dynarr_free (get_opaque_ptr (arg));
 285   return arg;
 286 }
 287
 288
 289 #define ALIGN_TEMPLATE                                  \
 290 {                                                       \
 291   unsigned int slippage = Dynarr_length (template) & 3; \
 292   if (slippage)                                         \
 293     Dynarr_add_many (template, &zeroes, slippage);      \
 294 }
 295
 296 static struct
 297 {
 298   int errmess;
 299   char *errname;
 300 } common_dialog_errors[] =
 301 {
 302   { CDERR_DIALOGFAILURE, "CDERR_DIALOGFAILURE" },
 303   { CDERR_FINDRESFAILURE, "CDERR_FINDRESFAILURE" },
 304   { CDERR_INITIALIZATION, "CDERR_INITIALIZATION" },
 305   { CDERR_LOADRESFAILURE, "CDERR_LOADRESFAILURE" },
 306   { CDERR_LOADSTRFAILURE, "CDERR_LOADSTRFAILURE" },
 307   { CDERR_LOCKRESFAILURE, "CDERR_LOCKRESFAILURE" },
 308   { CDERR_MEMALLOCFAILURE, "CDERR_MEMALLOCFAILURE" },
 309   { CDERR_MEMLOCKFAILURE, "CDERR_MEMLOCKFAILURE" },
 310   { CDERR_NOHINSTANCE, "CDERR_NOHINSTANCE" },
 311   { CDERR_NOHOOK, "CDERR_NOHOOK" },
 312   { CDERR_NOTEMPLATE, "CDERR_NOTEMPLATE" },
 313   { CDERR_REGISTERMSGFAIL, "CDERR_REGISTERMSGFAIL" },
 314   { CDERR_STRUCTSIZE, "CDERR_STRUCTSIZE" },
 315   { PDERR_CREATEICFAILURE, "PDERR_CREATEICFAILURE" },
 316   { PDERR_DEFAULTDIFFERENT, "PDERR_DEFAULTDIFFERENT" },
 317   { PDERR_DNDMMISMATCH, "PDERR_DNDMMISMATCH" },
 318   { PDERR_GETDEVMODEFAIL, "PDERR_GETDEVMODEFAIL" },
 319   { PDERR_INITFAILURE, "PDERR_INITFAILURE" },
 320   { PDERR_LOADDRVFAILURE, "PDERR_LOADDRVFAILURE" },
 321   { PDERR_NODEFAULTPRN, "PDERR_NODEFAULTPRN" },
 322   { PDERR_NODEVICES, "PDERR_NODEVICES" },
 323   { PDERR_PARSEFAILURE, "PDERR_PARSEFAILURE" },
 324   { PDERR_PRINTERNOTFOUND, "PDERR_PRINTERNOTFOUND" },
 325   { PDERR_RETDEFFAILURE, "PDERR_RETDEFFAILURE" },
 326   { PDERR_SETUPFAILURE, "PDERR_SETUPFAILURE" },
 327   { CFERR_MAXLESSTHANMIN, "CFERR_MAXLESSTHANMIN" },
 328   { CFERR_NOFONTS, "CFERR_NOFONTS" },
 329   { FNERR_BUFFERTOOSMALL, "FNERR_BUFFERTOOSMALL" },
 330   { FNERR_INVALIDFILENAME, "FNERR_INVALIDFILENAME" },
 331   { FNERR_SUBCLASSFAILURE, "FNERR_SUBCLASSFAILURE" },
 332   { FRERR_BUFFERLENGTHZERO, "FRERR_BUFFERLENGTHZERO" },
 333 };
 334
 335 struct param_data {
 336   char* fname;
 337   char* unknown_fname;
 338   int validate;
 339 };
 340
 341 static int
 342 CALLBACK handle_directory_proc (HWND hwnd, UINT msg,
 343                                 LPARAM lParam, LPARAM lpData)
 344 {
 345   TCHAR szDir[MAX_PATH];
 346   struct param_data* pd = (struct param_data*)lpData;
 347
 348   switch(msg) {
 349   case BFFM_INITIALIZED:
 350     // WParam is TRUE since you are passing a path.
 351     // It would be FALSE if you were passing a pidl.
 352     SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)pd->fname);
 353     break;
 354
 355   case BFFM_SELCHANGED:
 356     // Set the status window to the currently selected path.
 357     if (SHGetPathFromIDList((LPITEMIDLIST) lParam, szDir)) {
 358       SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM)szDir);
 359     }
 360     break;
 361
 362   case BFFM_VALIDATEFAILED:
 363     if (pd->validate)
 364       return TRUE;
 365     else
 366       pd->unknown_fname = xstrdup((char*)lParam);
 367     break;
 368
 369   default:
 370     break;
 371   }
 372   return 0;
 373 }
 374
 375 static Lisp_Object
 376 handle_directory_dialog_box (struct frame *f, Lisp_Object keys)
 377 {
 378   Lisp_Object ret = Qnil;
 379   BROWSEINFO bi;
 380   LPITEMIDLIST pidl;
 381   LPMALLOC pMalloc;
 382   struct param_data pd;
 383
 384   xzero(pd);
 385   xzero(bi);
 386
 387   bi.lParam = (LPARAM)&pd;
 388   bi.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
 389   bi.pszDisplayName = 0;
 390   bi.pidlRoot = 0;
 391   bi.ulFlags = BIF_RETURNONLYFSDIRS | BIF_STATUSTEXT | BIF_EDITBOX;
 392   bi.lpfn = handle_directory_proc;
 393
 394   LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
 395                              (char*)pd.fname);
 396
 397   {
 398     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 399       {
 400         if (EQ (key, Q_title))
 401           {
 402             CHECK_STRING (value);
 403             LISP_STRING_TO_EXTERNAL (value, bi.lpszTitle, Qmswindows_tstr);
 404           }
 405         else if (EQ (key, Q_initial_directory))
 406           LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
 407                                      pd.fname);
 408         else if (EQ (key, Q_initial_filename))
 409           ;                     /* do nothing */
 410         else if (EQ (key, Q_file_must_exist))
 411           {
 412             if (!NILP (value)) {
 413               pd.validate = TRUE;
 414               bi.ulFlags |= BIF_VALIDATE;
 415             }
 416             else
 417               bi.ulFlags &= ~BIF_VALIDATE;
 418           }
 419         else
 420           syntax_error ("Unrecognized directory dialog keyword", key);
 421       }
 422   }
 423
 424   if (SHGetMalloc(&pMalloc) == NOERROR)
 425     {
 426       pidl = SHBrowseForFolder(&bi);
 427       if (pidl) {
 428         TCHAR* szDir = alloca (MAX_PATH);
 429
 430         if (SHGetPathFromIDList(pidl, szDir)) {
 431           ret = tstr_to_local_file_format (szDir);
 432         }
 433
 434         pMalloc->lpVtbl->Free(pMalloc, pidl);
 435         pMalloc->lpVtbl->Release(pMalloc);
 436         return ret;
 437       }
 438       else if (pd.unknown_fname != 0) {
 439         ret = tstr_to_local_file_format (pd.unknown_fname);
 440         xfree(pd.unknown_fname);
 441       }
 442
 443     }
 444   else
 445     signal_type_error (Qdialog_box_error,
 446                        "Unable to create folder browser",
 447                        make_int (0));
 448   return ret;
 449 }
 450
 451 static Lisp_Object
 452 handle_file_dialog_box (struct frame *f, Lisp_Object keys)
 453 {
 454   OPENFILENAME ofn;
 455
 456   char fnbuf[8000];
 457
 458   xzero (ofn);
 459   ofn.lStructSize = sizeof (ofn);
 460   ofn.Flags = OFN_EXPLORER;
 461   ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
 462   ofn.lpstrFile = fnbuf;
 463   ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE;
 464   xetcscpy (fnbuf, XETEXT (""));
 465
 466   LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
 467                              ofn.lpstrInitialDir);
 468
 469   {
 470     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 471       {
 472         if (EQ (key, Q_initial_filename))
 473           {
 474             Extbyte *fnout;
 475
 476             CHECK_STRING (value);
 477             LOCAL_FILE_FORMAT_TO_TSTR (value, fnout);
 478             xetcscpy (fnbuf, fnout);
 479           }
 480         else if (EQ (key, Q_title))
 481           {
 482             CHECK_STRING (value);
 483             LISP_STRING_TO_EXTERNAL (value, ofn.lpstrTitle, Qmswindows_tstr);
 484           }
 485         else if (EQ (key, Q_initial_directory))
 486           LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
 487                                      ofn.lpstrInitialDir);
 488         else if (EQ (key, Q_file_must_exist))
 489           {
 490             if (!NILP (value))
 491               ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
 492             else
 493               ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST);
 494           }
 495         else
 496           syntax_error ("Unrecognized file-dialog keyword", key);
 497       }
 498   }
 499
 500   if (!GetOpenFileName (&ofn))
 501     {
 502       DWORD err = CommDlgExtendedError ();
 503       if (!err)
 504         {
 505           while (1)
 506             signal_quit ();
 507         }
 508       else
 509         {
 510           int i;
 511
 512           for (i = 0; i < countof (common_dialog_errors); i++)
 513             {
 514               if (common_dialog_errors[i].errmess == err)
 515                 signal_type_error (Qdialog_box_error,
 516                                    "Creating file-dialog-box",
 517                                    build_string
 518                                    (common_dialog_errors[i].errname));
 519             }
 520
 521           signal_type_error (Qdialog_box_error,
 522                              "Unknown common dialog box error???",
 523                              make_int (err));
 524         }
 525     }
 526
 527   return tstr_to_local_file_format (ofn.lpstrFile);
 528 }
 529
 530 static Lisp_Object
 531 handle_question_dialog_box (struct frame *f, Lisp_Object keys)
 532 {
 533   Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
 534   unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
 535   unsigned int button_row_width = 0;
 536   unsigned int text_width, text_height;
 537   Lisp_Object question = Qnil, title = Qnil;
 538
 539   int unbind_count = specpdl_depth ();
 540   record_unwind_protect (free_dynarr_opaque_ptr,
 541                          make_opaque_ptr (dialog_items));
 542   record_unwind_protect (free_dynarr_opaque_ptr,
 543                          make_opaque_ptr (template));
 544
 545   /* A big NO NEED to GCPRO gui_items stored in the array: they are just
 546      pointers into KEYS list, which is GC-protected by the caller */
 547
 548   {
 549     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 550       {
 551         if (EQ (key, Q_question))
 552           {
 553             CHECK_STRING (value);
 554             question = value;
 555           }
 556         else if (EQ (key, Q_title))
 557           {
 558             CHECK_STRING (value);
 559             title = value;
 560           }
 561         else if (EQ (key, Q_buttons))
 562           {
 563             Lisp_Object item_cons;
 564
 565             /* Parse each item in the dialog into gui_item structs,
 566                and stuff a dynarr of these. Calculate button row width
 567                in this loop too */
 568             EXTERNAL_LIST_LOOP (item_cons, value)
 569               {
 570                 if (!NILP (XCAR (item_cons)))
 571                   {
 572                     Lisp_Object gitem =
 573                       gui_parse_item_keywords (XCAR (item_cons));
 574                     Dynarr_add (dialog_items, gitem);
 575                     button_row_width += button_width (XGUI_ITEM (gitem)->name)
 576                       + X_BUTTON_MARGIN;
 577                   }
 578               }
 579
 580             button_row_width -= X_BUTTON_MARGIN;
 581           }
 582         else
 583           syntax_error ("Unrecognized question-dialog keyword", key);
 584       }
 585   }
 586
 587   if (Dynarr_length (dialog_items) == 0)
 588     syntax_error ("Dialog descriptor provides no buttons", keys);
 589
 590   if (NILP (question))
 591     syntax_error ("Dialog descriptor provides no question", keys);
 592
 593   /* Determine the final width layout */
 594   {
 595     Bufbyte *p = XSTRING_DATA (question);
 596     Charcount string_max = 0, this_length = 0;
 597     while (1)
 598       {
 599         Emchar ch = charptr_emchar (p);
 600         INC_CHARPTR (p);
 601
 602         if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
 603           {
 604             string_max = max (this_length, string_max);
 605             this_length = 0;
 606           }
 607         else
 608           ++this_length;
 609
 610         if (ch == (Emchar)'\0')
 611           break;
 612       }
 613
 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   {
 625     Bufbyte *p = XSTRING_DATA (question);
 626     Charcount break_at = text_width / X_DLU_PER_CHAR;
 627     Charcount char_pos = 0;
 628     int num_lines = 1;
 629     Emchar ch;
 630
 631     while ((ch = charptr_emchar (p)) != (Emchar) '\0')
 632       {
 633         INC_CHARPTR (p);
 634         char_pos += ch != (Emchar) '\n';
 635         if (ch == (Emchar) '\n' || char_pos == break_at)
 636           {
 637             ++num_lines;
 638             char_pos = 0;
 639           }
 640       }
 641     text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
 642   }
 643
 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;
 653
 654     /* Create and stuff in DLGTEMPLATE header */
 655     dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
 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);
 664     Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
 665
 666     /* We want no menu and standard class */
 667     Dynarr_add_many (template, &zeroes, 4);
 668
 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))
 672       Dynarr_add_many (template, L"XEmacs", 14);
 673     else
 674       push_lisp_string_as_unicode (template, title);
 675
 676     /* We want standard dialog font */
 677     Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
 678
 679     /* Next add text control. */
 680     item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
 681     item_tem.dwExtendedStyle = 0;
 682     item_tem.x = X_TEXT_FROM_EDGE;
 683     item_tem.y = Y_TEXT_FROM_EDGE;
 684     item_tem.cx = text_width;
 685     item_tem.cy = text_height;
 686     item_tem.id = 0xFFFF;
 687
 688     ALIGN_TEMPLATE;
 689     Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 690
 691     /* Right after class id follows */
 692     Dynarr_add_many (template, &ones, 2);
 693     Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
 694
 695     /* Next thing to add is control text, as Unicode string */
 696     push_lisp_string_as_unicode (template, question);
 697
 698     /* Specify 0 length creation data */
 699     Dynarr_add_many (template, &zeroes, 2);
 700
 701     /* Now it's the button time */
 702     item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
 703     item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
 704                                        ? (text_width - button_row_width) / 2
 705                                        : 0);
 706     item_tem.cy = Y_BUTTON;
 707     item_tem.dwExtendedStyle = 0;
 708
 709     for (i = 0; i < Dynarr_length (dialog_items); ++i)
 710       {
 711         Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
 712         Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
 713
 714         item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
 715                           | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
 716         item_tem.cx = button_width (pgui_item->name);
 717         /* Item ids are indices into dialog_items plus offset, to avoid having
 718            items by reserved ids (IDOK, IDCANCEL) */
 719         item_tem.id = i + ID_ITEM_BIAS;
 720
 721         ALIGN_TEMPLATE;
 722         Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 723
 724         /* Right after 0xFFFF and class id atom follows */
 725         Dynarr_add_many (template, &ones, 2);
 726         Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
 727
 728         /* Next thing to add is control text, as Unicode string */
 729         {
 730           Lisp_Object ctext = pgui_item->name;
 731           Emchar accel_unused;
 732           Bufbyte *trans = (Bufbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3);
 733           Bytecount translen;
 734
 735           memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
 736           translen =
 737             mswindows_translate_menu_or_dialog_item (trans,
 738                                                XSTRING_LENGTH (ctext),
 739                                                2 * XSTRING_LENGTH (ctext) + 3,
 740                                                &accel_unused,
 741                                                ctext);
 742           push_bufbyte_string_as_unicode (template, trans, translen);
 743         }
 744
 745         /* Specify 0 length creation data. */
 746         Dynarr_add_many (template, &zeroes, 2);
 747
 748         item_tem.x += item_tem.cx + X_BUTTON_SPACING;
 749       }
 750   }
 751
 752   /* Now the Windows dialog structure is ready. We need to prepare a
 753      data structure for the new dialog, which will contain callbacks
 754      and the frame for these callbacks.  This structure has to be
 755      GC-protected and thus it is put into a statically protected
 756      list. */
 757   {
 758     Lisp_Object dialog_data;
 759     int i;
 760     struct mswindows_dialog_id *did =
 761       alloc_lcrecord_type (struct mswindows_dialog_id,
 762                            &lrecord_mswindows_dialog_id);
 763
 764     XSETMSWINDOWS_DIALOG_ID (dialog_data, did);
 765
 766     did->frame = wrap_frame (f);
 767     did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound);
 768     for (i = 0; i < Dynarr_length (dialog_items); i++)
 769       XVECTOR_DATA (did->callbacks) [i] =
 770         XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
 771
 772     /* Woof! Everything is ready. Pop pop pop in now! */
 773     did->hwnd =
 774       CreateDialogIndirectParam (NULL,
 775                                  (LPDLGTEMPLATE) Dynarr_atp (template, 0),
 776                                  FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
 777                                  (LPARAM) LISP_TO_VOID (dialog_data));
 778     if (!did->hwnd)
 779       /* Something went wrong creating the dialog */
 780       signal_type_error (Qdialog_box_error, "Creating dialog", keys);
 781
 782     Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
 783
 784     /* Cease protection and free dynarrays */
 785     unbind_to (unbind_count, Qnil);
 786     return dialog_data;
 787   }
 788 }
 789
 790 static Lisp_Object
 791 mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type,
 792                                     Lisp_Object keys)
 793 {
 794   if (EQ (type, Qfile))
 795     return handle_file_dialog_box (f, keys);
 796   else if (EQ (type, Qdirectory))
 797     return handle_directory_dialog_box (f, keys);
 798   else if (EQ (type, Qquestion))
 799     return handle_question_dialog_box (f, keys);
 800   else if (EQ (type, Qprint))
 801     return mswindows_handle_print_dialog_box (f, keys);
 802   else if (EQ (type, Qpage_setup))
 803     return mswindows_handle_page_setup_dialog_box (f, keys);
 804   else
 805     signal_type_error (Qunimplemented, "Dialog box type", type);
 806   return Qnil;
 807 }
 808
 809 void
 810 console_type_create_dialog_mswindows (void)
 811 {
 812   CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal);
 813 }
 814
 815 void
 816 syms_of_dialog_mswindows (void)
 817 {
 818   INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id);
 819
 820   DEFKEYWORD (Q_initial_directory);
 821   DEFKEYWORD (Q_initial_filename);
 822   DEFKEYWORD (Q_filter_list);
 823   DEFKEYWORD (Q_title);
 824   DEFKEYWORD (Q_allow_multi_select);
 825   DEFKEYWORD (Q_create_prompt_on_nonexistent);
 826   DEFKEYWORD (Q_overwrite_prompt);
 827   DEFKEYWORD (Q_file_must_exist);
 828   DEFKEYWORD (Q_no_network_button);
 829   DEFKEYWORD (Q_no_read_only_return);
 830
 831   /* Errors */
 832   DEFERROR_STANDARD (Qdialog_box_error, Qinvalid_operation);
 833 }
 834
 835 void
 836 vars_of_dialog_mswindows (void)
 837 {
 838   Vpopup_frame_list = Qnil;
 839   staticpro (&Vpopup_frame_list);
 840
 841   Vdialog_data_list = Qnil;
 842   staticpro (&Vdialog_data_list);
 843
 844   DEFVAR_LISP ("default-file-dialog-filter-alist",
 845                &Vdefault_file_dialog_filter_alist /*
 846 */ );
 847   Vdefault_file_dialog_filter_alist =
 848     list5 (Fcons (build_string ("Text Files"), build_string ("*.txt")),
 849            Fcons (build_string ("C Files"), build_string ("*.c;*.h")),
 850            Fcons (build_string ("Elisp Files"), build_string ("*.el")),
 851            Fcons (build_string ("HTML Files"), build_string ("*.html;*.html")),
 852            Fcons (build_string ("All Files"), build_string ("*.*")));
 853 }