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 }