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