1 /* Implements elisp-programmable dialog boxes -- MS Windows interface.
2 Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru>
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not in FSF. */
24 Initially written by kkm, May 1998
31 #include "console-msw.h"
36 /* List containing all dialog data structures of currently popped up
37 dialogs. Each item is a cons of frame object and a vector of
38 callbacks for buttons in the dialog, in order */
39 static Lisp_Object Vdialog_data_list;
41 /* DLUs per character metrics */
42 #define X_DLU_PER_CHAR 4
43 #define Y_DLU_PER_CHAR 8
48 All buttons have height of 15 DLU. The minimum width for a button is 32 DLU,
49 but it can be expanded to accommodate its text, so the width is calculated as
50 8 DLU per button plus 4 DLU per character.
51 max (32, 6 * text_length). The factor of six is rather empirical, but it
52 works better than 8 which comes from the definition of a DLU. Buttons are
53 spaced with 6 DLU gap. Minimum distance from the button to the left or right
54 dialog edges is 6 DLU, and the distance between the dialog bottom edge and
58 #define X_MIN_BUTTON 32
59 #define X_BUTTON_MARGIN 8
61 #define X_BUTTON_SPACING 6
62 #define X_BUTTON_FROM_EDGE 6
63 #define Y_BUTTON_FROM_EDGE 7
68 Text distance from left and right edges is the same as for buttons, and the
69 top margin is 11 DLU. The static control has height of 2 DLU per control
70 plus 8 DLU per each line of text. Distance between the bottom edge of the
71 control and the button row is 15 DLU. Minimum width of the static control
72 is 100 DLU, thus giving minimum dialog weight of 112 DLU. Maximum width is
73 300 DLU, and, if the text is wider than that, the text is wrapped on the
74 next line. Each character in the text is considered 4 DLU wide.
77 #define X_MIN_TEXT 100
78 #define X_AVE_TEXT 200
79 #define X_MAX_TEXT 300
80 #define X_TEXT_FROM_EDGE X_BUTTON_FROM_EDGE
81 #define Y_TEXT_FROM_EDGE 11
82 #define Y_TEXT_MARGIN 2
83 #define Y_TEXT_FROM_BUTTON 15
85 #define X_MIN_TEXT_CHAR (X_MIN_TEXT / X_DLU_PER_CHAR)
86 #define X_AVE_TEXT_CHAR (X_AVE_TEXT / X_DLU_PER_CHAR)
87 #define X_MAX_TEXT_CHAR (X_MAX_TEXT / X_DLU_PER_CHAR)
92 First we calculate the minimum width of the button row, excluding "from
93 edge" distances. Note that the static control text can be narrower than
94 X_AVE_TEXT only if both text and button row are narrower than that (so,
95 even if text *can* be wrapped into 2 rows narrower than ave width, it is not
96 done). Let WBR denote the width of the button row.
98 Next, the width of the static field is determined.
99 First, if all lines of text fit into max (WBR, X_MAX_TEXT), the width of the
100 control is the same as the width of the longest line.
101 Second, if all lines of text are narrower than X_MIN_TEXT, then width of
102 the control is set to X_MIN_TEXT.
103 Otherwise, width is set to max(WBR, X_AVE_TEXT). In this case, line wrapping will
106 If width of the text control is larger than that of the button row, then the
107 latter is centered across the dialog, by giving it extra edge
108 margins. Otherwise, minimal margins are given to the button row.
111 #define ID_ITEM_BIAS 32
113 /* Dialog procedure */
115 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
120 SetWindowLong (hwnd, DWL_USER, l_param);
126 VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
127 Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
133 Lisp_Object fn, arg, data;
134 VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
136 assert (w_param >= ID_ITEM_BIAS
137 && w_param < XVECTOR_LENGTH (XCDR (data)) + ID_ITEM_BIAS);
139 get_gui_callback (XVECTOR_DATA (XCDR (data)) [w_param - ID_ITEM_BIAS],
141 mswindows_enqueue_misc_user_event (XCAR (data), fn, arg);
143 DestroyWindow (hwnd);
153 /* Helper function which converts the supplied string STRING into Unicode and
154 pushes it at the end of DYNARR */
156 push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string)
158 Extbyte *mbcs_string;
159 Charcount length = XSTRING_CHAR_LENGTH (string);
162 TO_EXTERNAL_FORMAT (LISP_STRING, string,
163 C_STRING_ALLOCA, mbcs_string,
165 uni_string = alloca_array (WCHAR, length + 1);
166 length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
167 uni_string, sizeof(WCHAR) * (length + 1));
168 Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
171 /* Helper function which converts the supplied string STRING into Unicode and
172 pushes it at the end of DYNARR */
174 push_bufbyte_string_as_unicode (unsigned_char_dynarr* dynarr, Bufbyte *string,
177 Extbyte *mbcs_string;
178 Charcount length = bytecount_to_charcount (string, len);
181 TO_EXTERNAL_FORMAT (C_STRING, string,
182 C_STRING_ALLOCA, mbcs_string,
184 uni_string = alloca_array (WCHAR, length + 1);
185 length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
186 uni_string, sizeof(WCHAR) * (length + 1));
187 Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
190 /* Given button TEXT, return button width in DLU */
192 button_width (Lisp_Object text)
194 unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
195 return max (X_MIN_BUTTON, width);
198 /* Unwind protection routine frees a dynarr opaqued into arg */
200 free_dynarr_opaque_ptr (Lisp_Object arg)
202 Dynarr_free (get_opaque_ptr (arg));
207 #define ALIGN_TEMPLATE \
209 unsigned int slippage = Dynarr_length (template) & 3; \
211 Dynarr_add_many (template, &zeroes, slippage); \
215 mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc)
217 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
218 unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
219 unsigned int button_row_width = 0;
220 unsigned int text_width, text_height;
222 int unbind_count = specpdl_depth ();
223 record_unwind_protect (free_dynarr_opaque_ptr,
224 make_opaque_ptr (dialog_items));
225 record_unwind_protect (free_dynarr_opaque_ptr,
226 make_opaque_ptr (template));
228 /* A big NO NEED to GCPRO gui_items stored in the array: they are just
229 pointers into DESC list, which is GC-protected by the caller */
231 /* Parse each item in the dialog into gui_item structs, and stuff a dynarr
232 of these. Calculate button row width in this loop too */
234 Lisp_Object item_cons;
236 EXTERNAL_LIST_LOOP (item_cons, XCDR (desc))
238 if (!NILP (XCAR (item_cons)))
240 Lisp_Object gitem = gui_parse_item_keywords (XCAR (item_cons));
241 Dynarr_add (dialog_items, gitem);
242 button_row_width += button_width (XGUI_ITEM (gitem)->name)
246 if (Dynarr_length (dialog_items) == 0)
247 signal_simple_error ("Dialog descriptor provides no active items", desc);
248 button_row_width -= X_BUTTON_MARGIN;
251 /* Determine the final width layout */
253 Bufbyte *p = XSTRING_DATA (XCAR (desc));
254 Charcount string_max = 0, this_length = 0;
257 Emchar ch = charptr_emchar (p);
260 if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
262 string_max = max (this_length, string_max);
268 if (ch == (Emchar)'\0')
272 if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
273 text_width = X_AVE_TEXT;
274 else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
275 text_width = X_MIN_TEXT;
277 text_width = string_max * X_DLU_PER_CHAR;
278 text_width = max (text_width, button_row_width);
281 /* Now calculate the height for the text control */
283 Bufbyte *p = XSTRING_DATA (XCAR (desc));
284 Charcount break_at = text_width / X_DLU_PER_CHAR;
285 Charcount char_pos = 0;
289 while ((ch = charptr_emchar (p)) != (Emchar)'\0')
292 char_pos += ch != (Emchar)'\n';
293 if (ch == (Emchar)'\n' || char_pos == break_at)
299 text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
302 /* Ok, now we are ready to stuff the dialog template and lay out controls */
305 DLGITEMTEMPLATE item_tem;
307 const unsigned int zeroes = 0;
308 const unsigned int ones = 0xFFFFFFFF;
309 const WORD static_class_id = 0x0082;
310 const WORD button_class_id = 0x0080;
312 /* Create and stuff in DLGTEMPLATE header */
313 dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
314 | WS_CAPTION | WS_POPUP | WS_VISIBLE);
315 dlg_tem.dwExtendedStyle = 0;
316 dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
319 dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
320 dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
321 + Y_BUTTON + Y_BUTTON_FROM_EDGE);
322 Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
324 /* We want no menu and standard class */
325 Dynarr_add_many (template, &zeroes, 4);
327 /* And the third is the dialog title. "XEmacs" as long as we do not supply
328 one in descriptor. Note that the string must be in Unicode. */
329 Dynarr_add_many (template, L"XEmacs", 14);
331 /* We want standard dialog font */
332 Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
334 /* Next add text control. */
335 item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
336 item_tem.dwExtendedStyle = 0;
337 item_tem.x = X_TEXT_FROM_EDGE;
338 item_tem.y = Y_TEXT_FROM_EDGE;
339 item_tem.cx = text_width;
340 item_tem.cy = text_height;
341 item_tem.id = 0xFFFF;
344 Dynarr_add_many (template, &item_tem, sizeof (item_tem));
346 /* Right after class id follows */
347 Dynarr_add_many (template, &ones, 2);
348 Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
350 /* Next thing to add is control text, as Unicode string */
351 push_lisp_string_as_unicode (template, XCAR (desc));
353 /* Specify 0 length creation data */
354 Dynarr_add_many (template, &zeroes, 2);
356 /* Now it's the button time */
357 item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
358 item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
359 ? (text_width - button_row_width) / 2
361 item_tem.cy = Y_BUTTON;
362 item_tem.dwExtendedStyle = 0;
364 for (i = 0; i < Dynarr_length (dialog_items); ++i)
366 Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
367 Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
369 item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
370 | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
371 item_tem.cx = button_width (pgui_item->name);
372 /* Item ids are indices into dialog_items plus offset, to avoid having
373 items by reserved ids (IDOK, IDCANCEL) */
374 item_tem.id = i + ID_ITEM_BIAS;
377 Dynarr_add_many (template, &item_tem, sizeof (item_tem));
379 /* Right after 0xFFFF and class id atom follows */
380 Dynarr_add_many (template, &ones, 2);
381 Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
383 /* Next thing to add is control text, as Unicode string */
385 Lisp_Object ctext = pgui_item->name;
387 Bufbyte *trans = (Bufbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3);
390 memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1);
392 mswindows_translate_menu_or_dialog_item (trans,
393 XSTRING_LENGTH (ctext),
394 2 * XSTRING_LENGTH (ctext) + 3,
397 push_bufbyte_string_as_unicode (template, trans, translen);
400 /* Specify 0 length creation data. */
401 Dynarr_add_many (template, &zeroes, 2);
403 item_tem.x += item_tem.cx + X_BUTTON_SPACING;
407 /* Now the Windows dialog structure is ready. We need to prepare a
408 data structure for the new dialog, which will contain callbacks
409 and the frame for these callbacks. This structure has to be
410 GC-protected. The data structure itself is a cons of frame object
411 and a vector of callbacks; for the protection reasons it is put
412 into a statically protected list. */
414 Lisp_Object frame, vector, dialog_data;
417 XSETFRAME (frame, f);
418 vector = make_vector (Dynarr_length (dialog_items), Qunbound);
419 dialog_data = Fcons (frame, vector);
420 for (i = 0; i < Dynarr_length (dialog_items); i++)
421 XVECTOR_DATA (vector) [i] =
422 XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
424 /* Woof! Everything is ready. Pop pop pop in now! */
425 if (!CreateDialogIndirectParam (NULL,
426 (LPDLGTEMPLATE) Dynarr_atp (template, 0),
427 FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
428 (LPARAM) LISP_TO_VOID (dialog_data)))
429 /* Something went wrong creating the dialog */
430 signal_simple_error ("System error creating dialog", desc);
432 Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
435 /* Cease protection and free dynarrays */
436 unbind_to (unbind_count, Qnil);
440 console_type_create_dialog_mswindows (void)
442 CONSOLE_HAS_METHOD (mswindows, popup_dialog_box);
446 vars_of_dialog_mswindows (void)
448 Vdialog_data_list = Qnil;
449 staticpro (&Vdialog_data_list);