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