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   TO_EXTERNAL_FORMAT (LISP_STRING, string,
 163                       C_STRING_ALLOCA, mbcs_string,
 164                       Qnative);
 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);
 169 }
 170
 171 /* Given button TEXT, return button width in DLU */
 172 static unsigned int
 173 button_width (Lisp_Object text)
 174 {
 175   unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text);
 176   return max (X_MIN_BUTTON, width);
 177 }
 178
 179 /* Unwind protection routine frees a dynarr opaqued into arg */
 180 static Lisp_Object
 181 free_dynarr_opaque_ptr (Lisp_Object arg)
 182 {
 183   Dynarr_free (get_opaque_ptr (arg));
 184   return arg;
 185 }
 186
 187
 188 #define ALIGN_TEMPLATE                                  \
 189 {                                                       \
 190   unsigned int slippage = Dynarr_length (template) & 3; \
 191   if (slippage)                                         \
 192     Dynarr_add_many (template, &zeroes, slippage);      \
 193 }
 194
 195 static void
 196 mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc)
 197 {
 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;
 202
 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));
 208
 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 */
 211
 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 */
 214   {
 215     Lisp_Object item_cons;
 216
 217     EXTERNAL_LIST_LOOP (item_cons, XCDR (desc))
 218       {
 219         if (!NILP (XCAR (item_cons)))
 220           {
 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)
 224               + X_BUTTON_MARGIN;
 225           }
 226       }
 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;
 230   }
 231
 232   /* Determine the final width layout */
 233   {
 234     Bufbyte *p = XSTRING_DATA (XCAR (desc));
 235     Charcount string_max = 0, this_length = 0;
 236     while (1)
 237       {
 238         Emchar ch = charptr_emchar (p);
 239         INC_CHARPTR (p);
 240
 241         if (ch == (Emchar)'\n' || ch == (Emchar)'\0')
 242           {
 243             string_max = max (this_length, string_max);
 244             this_length = 0;
 245           }
 246         else
 247           ++this_length;
 248
 249         if (ch == (Emchar)'\0')
 250           break;
 251       }
 252
 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;
 257     else
 258       text_width = string_max * X_DLU_PER_CHAR;
 259     text_width = max (text_width, button_row_width);
 260   }
 261
 262   /* Now calculate the height for the text control */
 263   {
 264     Bufbyte *p = XSTRING_DATA (XCAR (desc));
 265     Charcount break_at = text_width / X_DLU_PER_CHAR;
 266     Charcount char_pos = 0;
 267     int num_lines = 1;
 268     Emchar ch;
 269
 270     while ((ch = charptr_emchar (p)) != (Emchar)'\0')
 271       {
 272         INC_CHARPTR (p);
 273         char_pos += ch != (Emchar)'\n';
 274         if (ch == (Emchar)'\n' || char_pos == break_at)
 275           {
 276             ++num_lines;
 277             char_pos = 0;
 278           }
 279       }
 280     text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines;
 281   }
 282
 283   /* Ok, now we are ready to stuff the dialog template and lay out controls */
 284   {
 285     DLGTEMPLATE dlg_tem;
 286     DLGITEMTEMPLATE item_tem;
 287     int i;
 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;
 292
 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;
 298     dlg_tem.x = 0;
 299     dlg_tem.y = 0;
 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));
 304
 305     /* We want no menu and standard class */
 306     Dynarr_add_many (template, &zeroes, 4);
 307
 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);
 311
 312     /* We want standard dialog font */
 313     Dynarr_add_many (template, L"\x08MS Shell Dlg", 28);
 314
 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;
 323
 324     ALIGN_TEMPLATE;
 325     Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 326
 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));
 330
 331     /* Next thing to add is control text, as Unicode string */
 332     push_lisp_string_as_unicode (template, XCAR (desc));
 333
 334     /* Specify 0 length creation data */
 335     Dynarr_add_many (template, &zeroes, 2);
 336
 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
 341                                        : 0);
 342     item_tem.cy = Y_BUTTON;
 343     item_tem.dwExtendedStyle = 0;
 344
 345     for (i = 0; i < Dynarr_length (dialog_items); ++i)
 346       {
 347         Lisp_Object* gui_item = Dynarr_atp (dialog_items, i);
 348         Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item);
 349
 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;
 356
 357         ALIGN_TEMPLATE;
 358         Dynarr_add_many (template, &item_tem, sizeof (item_tem));
 359
 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));
 363
 364         /* Next thing to add is control text, as Unicode string */
 365         push_lisp_string_as_unicode (template, pgui_item->name);
 366
 367         /* Specify 0 length creation data. */
 368         Dynarr_add_many (template, &zeroes, 2);
 369
 370         item_tem.x += item_tem.cx + X_BUTTON_SPACING;
 371       }
 372   }
 373
 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. */
 380   {
 381     Lisp_Object frame, vector, dialog_data;
 382     int i;
 383
 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;
 389
 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);
 397
 398     Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list);
 399   }
 400
 401   /* Cease protection and free dynarrays */
 402   unbind_to (unbind_count, Qnil);
 403 }
 404
 405 void
 406 console_type_create_dialog_mswindows (void)
 407 {
 408   CONSOLE_HAS_METHOD (mswindows, popup_dialog_box);
 409 }
 410
 411 void
 412 vars_of_dialog_mswindows (void)
 413 {
 414   Vdialog_data_list = Qnil;
 415   staticpro (&Vdialog_data_list);
 416 }