src/dialog-msw.c

   1 /* Implements elisp-programmable dialog boxes -- MS Windows interface.
   2    Copyright (C) 1998 Kirill M. Katsnelson <kkm@kis.ru>
   3
   4 This file is part of XEmacs.
   5
   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
   9 later version.
  10
  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
  14 for more details.
  15
  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.  */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 /* Author:
  24    Initially written by kkm, May 1998
  25 */
  26
  27 #include <config.h>
  28 #include "lisp.h"
  29
  30 #include "buffer.h"
  31 #include "console-msw.h"
  32 #include "frame.h"
  33 #include "gui.h"
  34 #include "opaque.h"
  35
  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;
  40
  41 /* DLUs per character metrics */
  42 #define X_DLU_PER_CHAR       4
  43 #define Y_DLU_PER_CHAR       8
  44
  45 /*
  46   Button metrics
  47   --------------
  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
  55   buttons is 7 DLU.
  56 */
  57
  58 #define X_MIN_BUTTON        32
  59 #define X_BUTTON_MARGIN      8
  60 #define Y_BUTTON            15
  61 #define X_BUTTON_SPACING     6
  62 #define X_BUTTON_FROM_EDGE   6
  63 #define Y_BUTTON_FROM_EDGE   7
  64
  65 /*
  66    Text field metrics
  67    ------------------
  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.
  75 */
  76
  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
  84
  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)
  88
  89 /*
  90   Layout algorithm
  91   ----------------
  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.
  97
  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
 104   happen.
 105
 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.
 109 */
 110
 111 #define ID_ITEM_BIAS 32
 112
 113 typedef struct gui_item struct_gui_item;
 114 typedef struct
 115 {
 116   Dynarr_declare (struct gui_item);
 117 } struct_gui_item_dynarr;
 118
 119 /* Dialog procedure */
 120 static BOOL CALLBACK
 121 dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param)
 122 {
 123   switch (msg)
 124     {
 125     case WM_INITDIALOG:
 126       SetWindowLong (hwnd, DWL_USER, l_param);
 127       break;
 128
 129     case WM_DESTROY:
 130       {
 131         Lisp_Object data;
 132         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 133         Vdialog_data_list = delq_no_quit (data, Vdialog_data_list);
 134       }
 135       break;
 136
 137     case WM_COMMAND:
 138       {
 139         Lisp_Object fn, arg, data;
 140         VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER));
 141
 142         assert (w_param >= ID_ITEM_BIAS
 143                 && w_param < XVECTOR_LENGTH (XCDR (data)) + ID_ITEM_BIAS);
 144
 145         get_gui_callback (XVECTOR_DATA (XCDR (data)) [w_param - ID_ITEM_BIAS],
 146                           &fn, &arg);
 147         mswindows_enqueue_misc_user_event (XCAR (data), fn, arg);
 148
 149         DestroyWindow (hwnd);
 150       }
 151       break;
 152
 153     default:
 154       return FALSE;
 155     }
 156   return TRUE;
 157 }
 158
 159 /* Helper function which converts the supplied string STRING into Unicode and
 160    pushes it at the end of DYNARR */
 161 static void
 162 push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string)
 163 {
 164   Extbyte *mbcs_string;
 165   Charcount length = XSTRING_CHAR_LENGTH (string);
 166   LPWSTR uni_string;
 167
 168   GET_C_CHARPTR_EXT_DATA_ALLOCA (XSTRING_DATA (string),
 169                                  FORMAT_OS, mbcs_string);
 170   uni_string = alloca_array (WCHAR, length + 1);
 171   length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1,
 172                                 uni_string, sizeof(WCHAR) * (length + 1));
 173   Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length);
 174 }
 175
 176 /* Given button TEXT, return button width in DLU */
 177 static unsigned int
 178 button_width (Lisp_Object text)
 179 {
 180   unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
 181   return max (X_MIN_BUTTON, width);
 182 }
 183
 184 /* Unwind protection routine frees a dynarr opaqued into arg */
 185 static Lisp_Object
 186 free_dynarr_opaque_ptr (Lisp_Object arg)
 187 {
 188   Dynarr_free (get_opaque_ptr (arg));
 189   return arg;
 190 }
 191
 192
 193 #define ALIGN_TEMPLATE                                  \
 194 {                                                       \
 195   unsigned int slippage = Dynarr_length (template) & 3; \
 196   if (slippage)                                         \
 197     Dynarr_add_many (template, &zeroes, slippage);      \
 198 }
 199
 200 static void
 201 mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc)
 202 {
 203   struct_gui_item_dynarr *dialog_items = Dynarr_new (struct_gui_item);
 204   unsigned_char_dynarr *template = Dynarr_new (unsigned_char);
 205   unsigned int button_row_width = 0;
 206   unsigned int text_width, text_height;
 207
 208   int unbind_count = specpdl_depth ();
 209   record_unwind_protect (free_dynarr_opaque_ptr,
 210                          make_opaque_ptr (dialog_items));
 211   record_unwind_protect (free_dynarr_opaque_ptr,
 212                          make_opaque_ptr (template));
 213
 214   /* A big NO NEED to GCPRO gui_items stored in the array: they are just
 215      pointers into DESC list, which is GC-protected by the caller */
 216
 217   /* Parse each item in the dialog into gui_item structs, and stuff a dynarr
 218      of these. Calculate button row width in this loop too */
 219   {
 220     Lisp_Object item_cons;
 221
 222     EXTERNAL_LIST_LOOP (item_cons, XCDR (desc))
 223       {
 224         if (!NILP (XCAR (item_cons)))
 225           {
 226             struct gui_item gitem;
 227             gui_item_init (&gitem);
 228             gui_parse_item_keywords (XCAR (item_cons), &gitem);
 229             Dynarr_add (dialog_items, gitem);
 230             button_row_width += button_width (gitem.name) + X_BUTTON_MARGIN;
 231           }
 232       }
 233     if (Dynarr_length (dialog_items) == 0)
 234       signal_simple_error ("Dialog descriptor provides no active items", desc);
 235     button_row_width -= X_BUTTON_MARGIN;
 236   }
 237
 238   /* Determine the final width layout */
 239   {
 240     Bufbyte *p = XSTRING_DATA (XCAR (desc));
 241     Charcount string_max = 0, this_length = 0;
 242     while (1)
 243       {
 244         Emchar ch = charptr_emchar (p);
 245         INC_CHARPTR (p);
 246
 247         if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
 248           {
 249             string_max = max (this_length, string_max);
 250             this_length = 0;
 251           }
 252         else
 253           ++this_length;
 254
 255         if (ch == (Emchar)'\0')
 256           break;
 257       }
 258
 259     if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width))
 260       text_width = X_AVE_TEXT;
 261     else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT)
 262       text_width = X_MIN_TEXT;
 263     else
 264       text_width = string_max * X_DLU_PER_CHAR;
 265     text_width = max (text_width, button_row_width);
 266   }
 267
 268   /* Now calculate the height for the text control */
 269   {
 270     Bufbyte *p = XSTRING_DATA (XCAR (desc));
 271     Charcount break_at = text_width / X_DLU_PER_CHAR;
 272     Charcount char_pos = 0;
 273     int num_lines = 1;
 274     Emchar ch;
 275
 276     while ((ch = charptr_emchar (p)) != (Emchar)'\0')
 277       {
 278         INC_CHARPTR (p);
 279         char_pos += ch != (Emchar)'\n';
 280         if (ch == (Emchar)'\n' || char_pos == break_at)
 281           {
 282             ++num_lines;
 283             char_pos = 0;
 284           }
 285       }
 286     text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
 287   }
 288
 289   /* Ok, now we are ready to stuff the dialog template and lay out controls */
 290   {
 291     DLGTEMPLATE dlg_tem;
 292     DLGITEMTEMPLATE item_tem;
 293     int i;
 294     const unsigned int zeroes = 0;
 295     const unsigned int ones = 0xFFFFFFFF;
 296     const WORD static_class_id = 0x0082;
 297     const WORD button_class_id = 0x0080;
 298
 299     /* Create and stuff in DLGTEMPLATE header */
 300     dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT
 301                      | WS_CAPTION | WS_POPUP | WS_VISIBLE);
 302     dlg_tem.dwExtendedStyle = 0;
 303     dlg_tem.cdit = Dynarr_length (dialog_items) + 1;
 304     dlg_tem.x = 0;
 305     dlg_tem.y = 0;
 306     dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE;
 307     dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON
 308                   + Y_BUTTON + Y_BUTTON_FROM_EDGE);
 309     Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem));
 310
 311     /* We want no menu and standard class */
 312     Dynarr_add_many (template, &zeroes, 4);
 313
 314     /* And the third is the dialog title. "XEmacs" as long as we do not supply
 315        one in descriptor. Note that the string must be in Unicode. */
 316     Dynarr_add_many (template, L"XEmacs", 14);
 317
 318     /* We want standard dialog font */
 319     Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
 320
 321     /* Next add text control. */
 322     item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX;
 323     item_tem.dwExtendedStyle = 0;
 324     item_tem.x = X_TEXT_FROM_EDGE;
 325     item_tem.y = Y_TEXT_FROM_EDGE;
 326     item_tem.cx = text_width;
 327     item_tem.cy = text_height;
 328     item_tem.id = 0xFFFF;
 329
 330     ALIGN_TEMPLATE;
 331     Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 332
 333     /* Right after class id follows */
 334     Dynarr_add_many (template, &ones, 2);
 335     Dynarr_add_many (template, &static_class_id, sizeof (static_class_id));
 336
 337     /* Next thing to add is control text, as Unicode string */
 338     push_lisp_string_as_unicode (template, XCAR (desc));
 339
 340     /* Specify 0 length creation data */
 341     Dynarr_add_many (template, &zeroes, 2);
 342
 343     /* Now it's the button time */
 344     item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON;
 345     item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width
 346                                        ? (text_width - button_row_width) / 2
 347                                        : 0);
 348     item_tem.cy = Y_BUTTON;
 349     item_tem.dwExtendedStyle = 0;
 350
 351     for (i = 0; i < Dynarr_length (dialog_items); ++i)
 352       {
 353         struct gui_item *pgui_item = Dynarr_atp (dialog_items, i);
 354
 355         item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON
 356                           | (gui_item_active_p (pgui_item) ? 0 : WS_DISABLED));
 357         item_tem.cx = button_width (pgui_item->name);
 358         /* Item ids are indices into dialog_items plus offset, to avoid having
 359            items by reserved ids (IDOK, IDCANCEL) */
 360         item_tem.id = i + ID_ITEM_BIAS;
 361
 362         ALIGN_TEMPLATE;
 363         Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 364
 365         /* Right after 0xFFFF and class id atom follows */
 366         Dynarr_add_many (template, &ones, 2);
 367         Dynarr_add_many (template, &button_class_id, sizeof (button_class_id));
 368
 369         /* Next thing to add is control text, as Unicode string */
 370         push_lisp_string_as_unicode (template, pgui_item->name);
 371
 372         /* Specify 0 length creation data. */
 373         Dynarr_add_many (template, &zeroes, 2);
 374
 375         item_tem.x += item_tem.cx + X_BUTTON_SPACING;
 376       }
 377   }
 378
 379   /* Now the Windows dialog structure is ready. We need to prepare a
 380      data structure for the new dialog, which will contain callbacks
 381      and the frame for these callbacks. This structure has to be
 382      GC-protected. The data structure itself is a cons of frame object
 383      and a vector of callbacks; for the protection reasons it is put
 384      into a statically protected list. */
 385   {
 386     Lisp_Object frame, vector, dialog_data;
 387     int i;
 388
 389     XSETFRAME (frame, f);
 390     vector = make_vector (Dynarr_length (dialog_items), Qunbound);
 391     dialog_data = Fcons (frame, vector);
 392     for (i = 0; i < Dynarr_length (dialog_items); i++)
 393       XVECTOR_DATA (vector) [i] = Dynarr_atp (dialog_items, i)->callback;
 394
 395     /* Woof! Everything is ready. Pop pop pop in now! */
 396     if (!CreateDialogIndirectParam (NULL,
 397                                     (LPDLGTEMPLATE) Dynarr_atp (template, 0),
 398                                     FRAME_MSWINDOWS_HANDLE (f), dialog_proc,
 399                                     (LPARAM) LISP_TO_VOID (dialog_data)))
 400       /* Something went wrong creating the dialog */
 401       signal_simple_error ("System error creating dialog", desc);
 402
 403     Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
 404   }
 405
 406   /* Cease protection and free dynarrays */
 407   unbind_to (unbind_count, Qnil);
 408 }
 409
 410 void
 411 console_type_create_dialog_mswindows (void)
 412 {
 413   CONSOLE_HAS_METHOD (mswindows, popup_dialog_box);
 414 }
 415
 416 void
 417 vars_of_dialog_mswindows (void)
 418 {
 419   Vdialog_data_list = Qnil;
 420   staticpro (&Vdialog_data_list);
 421 }