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 /* Unwind protection decrements dialog count */
 289 static Lisp_Object
 290 dialog_popped_down (Lisp_Object arg)
 291 {
 292   popup_up_p--;
 293   return Qnil;
 294 }
 295
 296
 297 #define ALIGN_TEMPLATE                                  \
 298 {                                                       \
 299   unsigned int slippage = Dynarr_length (template) & 3; \
 300   if (slippage)                                         \
 301     Dynarr_add_many (template, &zeroes, slippage);      \
 302 }
 303
 304 static struct
 305 {
 306   int errmess;
 307   char *errname;
 308 } common_dialog_errors[] =
 309 {
 310   { CDERR_DIALOGFAILURE, "CDERR_DIALOGFAILURE" },
 311   { CDERR_FINDRESFAILURE, "CDERR_FINDRESFAILURE" },
 312   { CDERR_INITIALIZATION, "CDERR_INITIALIZATION" },
 313   { CDERR_LOADRESFAILURE, "CDERR_LOADRESFAILURE" },
 314   { CDERR_LOADSTRFAILURE, "CDERR_LOADSTRFAILURE" },
 315   { CDERR_LOCKRESFAILURE, "CDERR_LOCKRESFAILURE" },
 316   { CDERR_MEMALLOCFAILURE, "CDERR_MEMALLOCFAILURE" },
 317   { CDERR_MEMLOCKFAILURE, "CDERR_MEMLOCKFAILURE" },
 318   { CDERR_NOHINSTANCE, "CDERR_NOHINSTANCE" },
 319   { CDERR_NOHOOK, "CDERR_NOHOOK" },
 320   { CDERR_NOTEMPLATE, "CDERR_NOTEMPLATE" },
 321   { CDERR_REGISTERMSGFAIL, "CDERR_REGISTERMSGFAIL" },
 322   { CDERR_STRUCTSIZE, "CDERR_STRUCTSIZE" },
 323   { PDERR_CREATEICFAILURE, "PDERR_CREATEICFAILURE" },
 324   { PDERR_DEFAULTDIFFERENT, "PDERR_DEFAULTDIFFERENT" },
 325   { PDERR_DNDMMISMATCH, "PDERR_DNDMMISMATCH" },
 326   { PDERR_GETDEVMODEFAIL, "PDERR_GETDEVMODEFAIL" },
 327   { PDERR_INITFAILURE, "PDERR_INITFAILURE" },
 328   { PDERR_LOADDRVFAILURE, "PDERR_LOADDRVFAILURE" },
 329   { PDERR_NODEFAULTPRN, "PDERR_NODEFAULTPRN" },
 330   { PDERR_NODEVICES, "PDERR_NODEVICES" },
 331   { PDERR_PARSEFAILURE, "PDERR_PARSEFAILURE" },
 332   { PDERR_PRINTERNOTFOUND, "PDERR_PRINTERNOTFOUND" },
 333   { PDERR_RETDEFFAILURE, "PDERR_RETDEFFAILURE" },
 334   { PDERR_SETUPFAILURE, "PDERR_SETUPFAILURE" },
 335   { CFERR_MAXLESSTHANMIN, "CFERR_MAXLESSTHANMIN" },
 336   { CFERR_NOFONTS, "CFERR_NOFONTS" },
 337   { FNERR_BUFFERTOOSMALL, "FNERR_BUFFERTOOSMALL" },
 338   { FNERR_INVALIDFILENAME, "FNERR_INVALIDFILENAME" },
 339   { FNERR_SUBCLASSFAILURE, "FNERR_SUBCLASSFAILURE" },
 340   { FRERR_BUFFERLENGTHZERO, "FRERR_BUFFERLENGTHZERO" },
 341 };
 342
 343 struct param_data {
 344   char* fname;
 345   char* unknown_fname;
 346   int validate;
 347 };
 348
 349 static int
 350 CALLBACK handle_directory_proc (HWND hwnd, UINT msg,
 351                                 LPARAM lParam, LPARAM lpData)
 352 {
 353   TCHAR szDir[MAX_PATH];
 354   struct param_data* pd = (struct param_data*)lpData;
 355
 356   switch(msg) {
 357   case BFFM_INITIALIZED:
 358     // WParam is TRUE since you are passing a path.
 359     // It would be FALSE if you were passing a pidl.
 360     SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)pd->fname);
 361     break;
 362
 363   case BFFM_SELCHANGED:
 364     // Set the status window to the currently selected path.
 365     if (SHGetPathFromIDList((LPITEMIDLIST) lParam, szDir)) {
 366       SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM)szDir);
 367     }
 368     break;
 369
 370   case BFFM_VALIDATEFAILED:
 371     if (pd->validate)
 372       return TRUE;
 373     else
 374       pd->unknown_fname = xstrdup((char*)lParam);
 375     break;
 376
 377   default:
 378     break;
 379   }
 380   return 0;
 381 }
 382
 383 static Lisp_Object
 384 handle_directory_dialog_box (struct frame *f, Lisp_Object keys)
 385 {
 386   Lisp_Object ret = Qnil;
 387   BROWSEINFO bi;
 388   LPITEMIDLIST pidl;
 389   LPMALLOC pMalloc;
 390   struct param_data pd;
 391
 392   xzero(pd);
 393   xzero(bi);
 394
 395   bi.lParam = (LPARAM)&pd;
 396   bi.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
 397   bi.pszDisplayName = 0;
 398   bi.pidlRoot = 0;
 399   bi.ulFlags = BIF_RETURNONLYFSDIRS | BIF_STATUSTEXT | BIF_EDITBOX;
 400   bi.lpfn = handle_directory_proc;
 401
 402   LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
 403                              (char*)pd.fname);
 404
 405   {
 406     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 407       {
 408         if (EQ (key, Q_title))
 409           {
 410             CHECK_STRING (value);
 411             LISP_STRING_TO_EXTERNAL (value, bi.lpszTitle, Qmswindows_tstr);
 412           }
 413         else if (EQ (key, Q_initial_directory))
 414           LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
 415                                      pd.fname);
 416         else if (EQ (key, Q_initial_filename))
 417           ;                     /* do nothing */
 418         else if (EQ (key, Q_file_must_exist))
 419           {
 420             if (!NILP (value)) {
 421               pd.validate = TRUE;
 422               bi.ulFlags |= BIF_VALIDATE;
 423             }
 424             else
 425               bi.ulFlags &= ~BIF_VALIDATE;
 426           }
 427         else
 428           syntax_error ("Unrecognized directory dialog keyword", key);
 429       }
 430   }
 431
 432   if (SHGetMalloc(&pMalloc) == NOERROR)
 433     {
 434       pidl = SHBrowseForFolder(&bi);
 435       if (pidl) {
 436         TCHAR* szDir = alloca (MAX_PATH);
 437
 438         if (SHGetPathFromIDList(pidl, szDir)) {
 439           ret = tstr_to_local_file_format (szDir);
 440         }
 441
 442         pMalloc->lpVtbl->Free(pMalloc, pidl);
 443         pMalloc->lpVtbl->Release(pMalloc);
 444         return ret;
 445       }
 446       else if (pd.unknown_fname != 0) {
 447         ret = tstr_to_local_file_format (pd.unknown_fname);
 448         xfree(pd.unknown_fname);
 449       }
 450       else while (1)
 451         signal_quit ();
 452     }
 453   else
 454     signal_type_error (Qdialog_box_error,
 455                        "Unable to create folder browser",
 456                        make_int (0));
 457   return ret;
 458 }
 459
 460 static Lisp_Object
 461 handle_file_dialog_box (struct frame *f, Lisp_Object keys)
 462 {
 463   OPENFILENAME ofn;
 464
 465   char fnbuf[8000];
 466
 467   xzero (ofn);
 468   ofn.lStructSize = sizeof (ofn);
 469   ofn.Flags = OFN_EXPLORER;
 470   ofn.hwndOwner = FRAME_MSWINDOWS_HANDLE (f);
 471   ofn.lpstrFile = fnbuf;
 472   ofn.nMaxFile = sizeof (fnbuf) / XETCHAR_SIZE;
 473   xetcscpy (fnbuf, XETEXT (""));
 474
 475   LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (build_string (""), Qnil),
 476                              ofn.lpstrInitialDir);
 477
 478   {
 479     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 480       {
 481         if (EQ (key, Q_initial_filename))
 482           {
 483             Extbyte *fnout;
 484
 485             CHECK_STRING (value);
 486             LOCAL_FILE_FORMAT_TO_TSTR (value, fnout);
 487             xetcscpy (fnbuf, fnout);
 488           }
 489         else if (EQ (key, Q_title))
 490           {
 491             CHECK_STRING (value);
 492             LISP_STRING_TO_EXTERNAL (value, ofn.lpstrTitle, Qmswindows_tstr);
 493           }
 494         else if (EQ (key, Q_initial_directory))
 495           LOCAL_FILE_FORMAT_TO_TSTR (Fexpand_file_name (value, Qnil),
 496                                      ofn.lpstrInitialDir);
 497         else if (EQ (key, Q_file_must_exist))
 498           {
 499             if (!NILP (value))
 500               ofn.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
 501             else
 502               ofn.Flags &= ~(OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST);
 503           }
 504         else
 505           syntax_error ("Unrecognized file-dialog keyword", key);
 506       }
 507   }
 508
 509   if (!GetOpenFileName (&ofn))
 510     {
 511       DWORD err = CommDlgExtendedError ();
 512       if (!err)
 513         {
 514           while (1)
 515             signal_quit ();
 516         }
 517       else
 518         {
 519           int i;
 520
 521           for (i = 0; i < countof (common_dialog_errors); i++)
 522             {
 523               if (common_dialog_errors[i].errmess == err)
 524                 signal_type_error (Qdialog_box_error,
 525                                    "Creating file-dialog-box",
 526                                    build_string
 527                                    (common_dialog_errors[i].errname));
 528             }
 529
 530           signal_type_error (Qdialog_box_error,
 531                              "Unknown common dialog box error???",
 532                              make_int (err));
 533         }
 534     }
 535
 536   return tstr_to_local_file_format (ofn.lpstrFile);
 537 }
 538
 539 static Lisp_Object
 540 handle_question_dialog_box (struct frame *f, Lisp_Object keys)
 541 {
 542   Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
 543   unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
 544   unsigned int button_row_width = 0;
 545   unsigned int text_width, text_height;
 546   Lisp_Object question = Qnil, title = Qnil;
 547
 548   int unbind_count = specpdl_depth ();
 549   record_unwind_protect (free_dynarr_opaque_ptr,
 550                          make_opaque_ptr (dialog_items));
 551   record_unwind_protect (free_dynarr_opaque_ptr,
 552                          make_opaque_ptr (template));
 553
 554   /* A big NO NEED to GCPRO gui_items stored in the array: they are just
 555      pointers into KEYS list, which is GC-protected by the caller */
 556
 557   {
 558     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, keys)
 559       {
 560         if (EQ (key, Q_question))
 561           {
 562             CHECK_STRING (value);
 563             question = value;
 564           }
 565         else if (EQ (key, Q_title))
 566           {
 567             CHECK_STRING (value);
 568             title = value;
 569           }
 570         else if (EQ (key, Q_buttons))
 571           {
 572             Lisp_Object item_cons;
 573
 574             /* Parse each item in the dialog into gui_item structs,
 575                and stuff a dynarr of these. Calculate button row width
 576                in this loop too */
 577             EXTERNAL_LIST_LOOP (item_cons, value)
 578               {
 579                 if (!NILP (XCAR (item_cons)))
 580                   {
 581                     Lisp_Object gitem =
 582                       gui_parse_item_keywords (XCAR (item_cons));
 583                     Dynarr_add (dialog_items, gitem);
 584                     button_row_width += button_width (XGUI_ITEM (gitem)->name)
 585                       + X_BUTTON_MARGIN;
 586                   }
 587               }
 588
 589             button_row_width -= X_BUTTON_MARGIN;
 590           }
 591         else
 592           syntax_error ("Unrecognized question-dialog keyword", key);
 593       }
 594   }
 595
 596   if (Dynarr_length (dialog_items) == 0)
 597     syntax_error ("Dialog descriptor provides no buttons", keys);
 598
 599   if (NILP (question))
 600     syntax_error ("Dialog descriptor provides no question", keys);
 601
 602   /* Determine the final width layout */
 603   {
 604     Bufbyte *p = XSTRING_DATA (question);
 605     Charcount string_max = 0, this_length = 0;
 606     while (1)
 607       {
 608         Emchar ch = charptr_emchar (p);
 609         INC_CHARPTR (p);
 610
 611         if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
 612           {
 613             string_max = max (this_length, string_max);
 614             this_length = 0;
 615           }
 616         else
 617           ++this_length;
 618
 619         if (ch == (Emchar)'\0')
 620           break;
 621       }
 622
 623     if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
 624       text_width = X_AVE_TEXT;
 625     else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
 626       text_width = X_MIN_TEXT;
 627     else
 628       text_width = string_max * X_DLU_PER_CHAR;
 629     text_width = max (text_width, button_row_width);
 630   }
 631
 632   /* Now calculate the height for the text control */
 633   {
 634     Bufbyte *p = XSTRING_DATA (question);
 635     Charcount break_at = text_width / X_DLU_PER_CHAR;
 636     Charcount char_pos = 0;
 637     int num_lines = 1;
 638     Emchar ch;
 639
 640     while ((ch = charptr_emchar (p)) != (Emchar) '\0')
 641       {
 642         INC_CHARPTR (p);
 643         char_pos += ch != (Emchar) '\n';
 644         if (ch == (Emchar) '\n' || char_pos == break_at)
 645           {
 646             ++num_lines;
 647             char_pos = 0;
 648           }
 649       }
 650     text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
 651   }
 652
 653   /* Ok, now we are ready to stuff the dialog template and lay out controls */
 654   {
 655     DLGTEMPLATE dlg_tem;
 656     DLGITEMTEMPLATE item_tem;
 657     int i;
 658     const unsigned int zeroes = 0;
 659     const unsigned int ones = 0xFFFFFFFF;
 660     const WORD static_class_id = 0x0082;
 661     const WORD button_class_id = 0x0080;
 662
 663     /* Create and stuff in DLGTEMPLATE header */
 664     dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
 665                      | WS_CAPTION | WS_POPUP | WS_VISIBLE);
 666     dlg_tem.dwExtendedStyle = 0;
 667     dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
 668     dlg_tem.x = 0;
 669     dlg_tem.y = 0;
 670     dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
 671     dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
 672                   + Y_BUTTON + Y_BUTTON_FROM_EDGE);
 673     Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
 674
 675     /* We want no menu and standard class */
 676     Dynarr_add_many (template, &zeroes, 4);
 677
 678     /* And the third is the dialog title. "XEmacs" unless one is supplied.
 679        Note that the string must be in Unicode. */
 680     if (NILP (title))
 681       Dynarr_add_many (template, L"XEmacs", 14);
 682     else
 683       push_lisp_string_as_unicode (template, title);
 684
 685     /* We want standard dialog font */
 686     Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
 687
 688     /* Next add text control. */
 689     item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
 690     item_tem.dwExtendedStyle = 0;
 691     item_tem.x = X_TEXT_FROM_EDGE;
 692     item_tem.y = Y_TEXT_FROM_EDGE;
 693     item_tem.cx = text_width;
 694     item_tem.cy = text_height;
 695     item_tem.id = 0xFFFF;
 696
 697     ALIGN_TEMPLATE;
 698     Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 699
 700     /* Right after class id follows */
 701     Dynarr_add_many (template, &ones, 2);
 702     Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
 703
 704     /* Next thing to add is control text, as Unicode string */
 705     push_lisp_string_as_unicode (template, question);
 706
 707     /* Specify 0 length creation data */
 708     Dynarr_add_many (template, &zeroes, 2);
 709
 710     /* Now it's the button time */
 711     item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
 712     item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
 713                                        ? (text_width - button_row_width) / 2
 714                                        : 0);
 715     item_tem.cy = Y_BUTTON;
 716     item_tem.dwExtendedStyle = 0;
 717
 718     for (i = 0; i < Dynarr_length (dialog_items); ++i)
 719       {
 720         Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
 721         Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
 722
 723         item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
 724                           | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
 725         item_tem.cx = button_width (pgui_item->name);
 726         /* Item ids are indices into dialog_items plus offset, to avoid having
 727            items by reserved ids (IDOK, IDCANCEL) */
 728         item_tem.id = i + ID_ITEM_BIAS;
 729
 730         ALIGN_TEMPLATE;
 731         Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 732
 733         /* Right after 0xFFFF and class id atom follows */
 734         Dynarr_add_many (template, &ones, 2);
 735         Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
 736
 737         /* Next thing to add is control text, as Unicode string */
 738         {
 739           Lisp_Object ctext = pgui_item->name;
 740           Emchar accel_unused;
 741           Bufbyte *trans = (Bufbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3);
 742           Bytecount translen;
 743
 744           memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
 745           translen =
 746             mswindows_translate_menu_or_dialog_item (trans,
 747                                                XSTRING_LENGTH (ctext),
 748                                                2 * XSTRING_LENGTH (ctext) + 3,
 749                                                &accel_unused,
 750                                                ctext);
 751           push_bufbyte_string_as_unicode (template, trans, translen);
 752         }
 753
 754         /* Specify 0 length creation data. */
 755         Dynarr_add_many (template, &zeroes, 2);
 756
 757         item_tem.x += item_tem.cx + X_BUTTON_SPACING;
 758       }
 759   }
 760
 761   /* Now the Windows dialog structure is ready. We need to prepare a
 762      data structure for the new dialog, which will contain callbacks
 763      and the frame for these callbacks.  This structure has to be
 764      GC-protected and thus it is put into a statically protected
 765      list. */
 766   {
 767     Lisp_Object dialog_data;
 768     int i;
 769     struct mswindows_dialog_id *did =
 770       alloc_lcrecord_type (struct mswindows_dialog_id,
 771                            &lrecord_mswindows_dialog_id);
 772
 773     XSETMSWINDOWS_DIALOG_ID (dialog_data, did);
 774
 775     did->frame = wrap_frame (f);
 776     did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound);
 777     for (i = 0; i < Dynarr_length (dialog_items); i++)
 778       XVECTOR_DATA (did->callbacks) [i] =
 779         XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
 780
 781     /* Woof! Everything is ready. Pop pop pop in now! */
 782     did->hwnd =
 783       CreateDialogIndirectParam (NULL,
 784                                  (LPDLGTEMPLATE) Dynarr_atp (template, 0),
 785                                  FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
 786                                  (LPARAM) LISP_TO_VOID (dialog_data));
 787     if (!did->hwnd)
 788       /* Something went wrong creating the dialog */
 789       signal_type_error (Qdialog_box_error, "Creating dialog", keys);
 790
 791     Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
 792
 793     /* Cease protection and free dynarrays */
 794     unbind_to (unbind_count, Qnil);
 795     return dialog_data;
 796   }
 797 }
 798
 799 static Lisp_Object
 800 mswindows_make_dialog_box_internal (struct frame* f, Lisp_Object type,
 801                                     Lisp_Object keys)
 802 {
 803   int unbind_count = specpdl_depth ();
 804   record_unwind_protect (dialog_popped_down, Qnil);
 805   popup_up_p++;
 806
 807   if (EQ (type, Qfile))
 808     return unbind_to (unbind_count, handle_file_dialog_box (f, keys));
 809   else if (EQ (type, Qdirectory))
 810     return unbind_to (unbind_count, handle_directory_dialog_box (f, keys));
 811   else if (EQ (type, Qquestion))
 812     return unbind_to (unbind_count, handle_question_dialog_box (f, keys));
 813   else if (EQ (type, Qprint))
 814     return unbind_to (unbind_count, mswindows_handle_print_dialog_box (f, keys));
 815   else if (EQ (type, Qpage_setup))
 816     return unbind_to (unbind_count,
 817                       mswindows_handle_page_setup_dialog_box (f, keys));
 818   else
 819     signal_type_error (Qunimplemented, "Dialog box type", type);
 820   return Qnil;
 821 }
 822
 823 void
 824 console_type_create_dialog_mswindows (void)
 825 {
 826   CONSOLE_HAS_METHOD (mswindows, make_dialog_box_internal);
 827 }
 828
 829 void
 830 syms_of_dialog_mswindows (void)
 831 {
 832   INIT_LRECORD_IMPLEMENTATION (mswindows_dialog_id);
 833
 834   DEFKEYWORD (Q_initial_directory);
 835   DEFKEYWORD (Q_initial_filename);
 836   DEFKEYWORD (Q_filter_list);
 837   DEFKEYWORD (Q_title);
 838   DEFKEYWORD (Q_allow_multi_select);
 839   DEFKEYWORD (Q_create_prompt_on_nonexistent);
 840   DEFKEYWORD (Q_overwrite_prompt);
 841   DEFKEYWORD (Q_file_must_exist);
 842   DEFKEYWORD (Q_no_network_button);
 843   DEFKEYWORD (Q_no_read_only_return);
 844
 845   /* Errors */
 846   DEFERROR_STANDARD (Qdialog_box_error, Qinvalid_operation);
 847 }
 848
 849 void
 850 vars_of_dialog_mswindows (void)
 851 {
 852   Vpopup_frame_list = Qnil;
 853   staticpro (&Vpopup_frame_list);
 854
 855   Vdialog_data_list = Qnil;
 856   staticpro (&Vdialog_data_list);
 857
 858   DEFVAR_LISP ("default-file-dialog-filter-alist",
 859                &Vdefault_file_dialog_filter_alist /*
 860 */ );
 861   Vdefault_file_dialog_filter_alist =
 862     list5 (Fcons (build_string ("Text Files"), build_string ("*.txt")),
 863            Fcons (build_string ("C Files"), build_string ("*.c;*.h")),
 864            Fcons (build_string ("Elisp Files"), build_string ("*.el")),
 865            Fcons (build_string ("HTML Files"), build_string ("*.html;*.html")),
 866            Fcons (build_string ("All Files"), build_string ("*.*")));
 867 }