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 /* Given button TEXT, return button width in DLU */
173 button_width (Lisp_Object text)
175 unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
176 return max (X_MIN_BUTTON, width);
179 /* Unwind protection routine frees a dynarr opaqued into arg */
181 free_dynarr_opaque_ptr (Lisp_Object arg)
183 Dynarr_free (get_opaque_ptr (arg));
188 #define ALIGN_TEMPLATE \
190 unsigned int slippage = Dynarr_length (template) & 3; \
192 Dynarr_add_many (template, &zeroes, slippage); \
196 mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc)
198 Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object);
199 unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
200 unsigned int button_row_width = 0;
201 unsigned int text_width, text_height;
203 int unbind_count = specpdl_depth ();
204 record_unwind_protect (free_dynarr_opaque_ptr,
205 make_opaque_ptr (dialog_items));
206 record_unwind_protect (free_dynarr_opaque_ptr,
207 make_opaque_ptr (template));
209 /* A big NO NEED to GCPRO gui_items stored in the array: they are just
210 pointers into DESC list, which is GC-protected by the caller */
212 /* Parse each item in the dialog into gui_item structs, and stuff a dynarr
213 of these. Calculate button row width in this loop too */
215 Lisp_Object item_cons;
217 EXTERNAL_LIST_LOOP (item_cons, XCDR (desc))
219 if (!NILP (XCAR (item_cons)))
221 Lisp_Object gitem = gui_parse_item_keywords (XCAR (item_cons));
222 Dynarr_add (dialog_items, gitem);
223 button_row_width += button_width (XGUI_ITEM (gitem)->name)
227 if (Dynarr_length (dialog_items) == 0)
228 signal_simple_error ("Dialog descriptor provides no active items", desc);
229 button_row_width -= X_BUTTON_MARGIN;
232 /* Determine the final width layout */
234 Bufbyte *p = XSTRING_DATA (XCAR (desc));
235 Charcount string_max = 0, this_length = 0;
238 Emchar ch = charptr_emchar (p);
241 if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
243 string_max = max (this_length, string_max);
249 if (ch == (Emchar)'\0')
253 if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
254 text_width = X_AVE_TEXT;
255 else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
256 text_width = X_MIN_TEXT;
258 text_width = string_max * X_DLU_PER_CHAR;
259 text_width = max (text_width, button_row_width);
262 /* Now calculate the height for the text control */
264 Bufbyte *p = XSTRING_DATA (XCAR (desc));
265 Charcount break_at = text_width / X_DLU_PER_CHAR;
266 Charcount char_pos = 0;
270 while ((ch = charptr_emchar (p)) != (Emchar)'\0')
273 char_pos += ch != (Emchar)'\n';
274 if (ch == (Emchar)'\n' || char_pos == break_at)
280 text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
283 /* Ok, now we are ready to stuff the dialog template and lay out controls */
286 DLGITEMTEMPLATE item_tem;
288 const unsigned int zeroes = 0;
289 const unsigned int ones = 0xFFFFFFFF;
290 const WORD static_class_id = 0x0082;
291 const WORD button_class_id = 0x0080;
293 /* Create and stuff in DLGTEMPLATE header */
294 dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
295 | WS_CAPTION | WS_POPUP | WS_VISIBLE);
296 dlg_tem.dwExtendedStyle = 0;
297 dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
300 dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
301 dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
302 + Y_BUTTON + Y_BUTTON_FROM_EDGE);
303 Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
305 /* We want no menu and standard class */
306 Dynarr_add_many (template, &zeroes, 4);
308 /* And the third is the dialog title. "XEmacs" as long as we do not supply
309 one in descriptor. Note that the string must be in Unicode. */
310 Dynarr_add_many (template, L"XEmacs", 14);
312 /* We want standard dialog font */
313 Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
315 /* Next add text control. */
316 item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
317 item_tem.dwExtendedStyle = 0;
318 item_tem.x = X_TEXT_FROM_EDGE;
319 item_tem.y = Y_TEXT_FROM_EDGE;
320 item_tem.cx = text_width;
321 item_tem.cy = text_height;
322 item_tem.id = 0xFFFF;
325 Dynarr_add_many (template, &item_tem, sizeof (item_tem));
327 /* Right after class id follows */
328 Dynarr_add_many (template, &ones, 2);
329 Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
331 /* Next thing to add is control text, as Unicode string */
332 push_lisp_string_as_unicode (template, XCAR (desc));
334 /* Specify 0 length creation data */
335 Dynarr_add_many (template, &zeroes, 2);
337 /* Now it's the button time */
338 item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
339 item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
340 ? (text_width - button_row_width) / 2
342 item_tem.cy = Y_BUTTON;
343 item_tem.dwExtendedStyle = 0;
345 for (i = 0; i < Dynarr_length (dialog_items); ++i)
347 Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
348 Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
350 item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
351 | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED));
352 item_tem.cx = button_width (pgui_item->name);
353 /* Item ids are indices into dialog_items plus offset, to avoid having
354 items by reserved ids (IDOK, IDCANCEL) */
355 item_tem.id = i + ID_ITEM_BIAS;
358 Dynarr_add_many (template, &item_tem, sizeof (item_tem));
360 /* Right after 0xFFFF and class id atom follows */
361 Dynarr_add_many (template, &ones, 2);
362 Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
364 /* Next thing to add is control text, as Unicode string */
365 push_lisp_string_as_unicode (template, pgui_item->name);
367 /* Specify 0 length creation data. */
368 Dynarr_add_many (template, &zeroes, 2);
370 item_tem.x += item_tem.cx + X_BUTTON_SPACING;
374 /* Now the Windows dialog structure is ready. We need to prepare a
375 data structure for the new dialog, which will contain callbacks
376 and the frame for these callbacks. This structure has to be
377 GC-protected. The data structure itself is a cons of frame object
378 and a vector of callbacks; for the protection reasons it is put
379 into a statically protected list. */
381 Lisp_Object frame, vector, dialog_data;
384 XSETFRAME (frame, f);
385 vector = make_vector (Dynarr_length (dialog_items), Qunbound);
386 dialog_data = Fcons (frame, vector);
387 for (i = 0; i < Dynarr_length (dialog_items); i++)
388 XVECTOR_DATA (vector) [i] = XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback;
390 /* Woof! Everything is ready. Pop pop pop in now! */
391 if (!CreateDialogIndirectParam (NULL,
392 (LPDLGTEMPLATE) Dynarr_atp (template, 0),
393 FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
394 (LPARAM) LISP_TO_VOID (dialog_data)))
395 /* Something went wrong creating the dialog */
396 signal_simple_error ("System error creating dialog", desc);
398 Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
401 /* Cease protection and free dynarrays */
402 unbind_to (unbind_count, Qnil);
406 console_type_create_dialog_mswindows (void)
408 CONSOLE_HAS_METHOD (mswindows, popup_dialog_box);
412 vars_of_dialog_mswindows (void)
414 Vdialog_data_list = Qnil;
415 staticpro (&Vdialog_data_list);