git.chise.org Git - chise/xemacs-chise.git.1/blob - src/glyphs-widget.c

   1 /* Widget-specific glyph objects.
   2    Copyright (C) 1998, 1999 Andy Piper.
   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 /* written by Andy Piper <andy@xemacs.org> */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27 #include "lstream.h"
  28 #include "console.h"
  29 #include "device.h"
  30 #include "faces.h"
  31 #include "glyphs.h"
  32 #include "objects.h"
  33 #include "bytecode.h"
  34 #include "window.h"
  35 #include "buffer.h"
  36 #include "frame.h"
  37 #include "insdel.h"
  38 #include "opaque.h"
  39
  40 DEFINE_IMAGE_INSTANTIATOR_FORMAT (button);
  41 DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo_box);
  42 Lisp_Object Qcombo_box;
  43 DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit_field);
  44 Lisp_Object Qedit_field;
  45 DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar);
  46 Lisp_Object Qscrollbar;
  47 DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget);
  48 DEFINE_IMAGE_INSTANTIATOR_FORMAT (label);
  49 Lisp_Object Qlabel;
  50 DEFINE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge);
  51 Lisp_Object Qprogress_gauge;
  52 DEFINE_IMAGE_INSTANTIATOR_FORMAT (tree_view);
  53 Lisp_Object Qtree_view;
  54 DEFINE_IMAGE_INSTANTIATOR_FORMAT (tab_control);
  55 Lisp_Object Qtab_control;
  56 DEFINE_IMAGE_INSTANTIATOR_FORMAT (layout);
  57 Lisp_Object Qlayout;
  58
  59 Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items;
  60 Lisp_Object Q_image, Q_text, Q_percent, Q_orientation, Q_justify, Q_border;
  61 Lisp_Object Qetched_in, Qetched_out, Qbevel_in, Qbevel_out;
  62
  63 #define WIDGET_BORDER_HEIGHT 4
  64 #define WIDGET_BORDER_WIDTH 4
  65
  66 #ifdef DEBUG_WIDGETS
  67 int debug_widget_instances;
  68 #endif
  69
  70 /* TODO:
  71    - more complex controls.
  72    - tooltips for controls.
  73  */
  74
  75 /* In windows normal windows work in pixels, dialog boxes work in
  76    dialog box units. Why? sigh. We could reuse the metrics for dialogs
  77    if this were not the case. As it is we have to position things
  78    pixel wise. I'm not even sure that X has this problem at least for
  79    buttons in groups. */
  80 Lisp_Object
  81 widget_face_font_info (Lisp_Object domain, Lisp_Object face,
  82                        int *height, int *width)
  83 {
  84   Lisp_Object font_instance = FACE_FONT (face, domain, Vcharset_ascii);
  85
  86   if (height)
  87     *height = XFONT_INSTANCE (font_instance)->height;
  88   if (width)
  89     *width = XFONT_INSTANCE (font_instance)->width;
  90
  91   return font_instance;
  92 }
  93
  94 void
  95 widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face,
  96                                  int th, int tw,
  97                                  int* height, int* width)
  98 {
  99   int ch=0, cw=0;
 100   widget_face_font_info (domain, face, &ch, &cw);
 101   if (height)
 102     *height = th * ch + 2 * WIDGET_BORDER_HEIGHT;
 103   if (width)
 104     *width = tw * cw + 2 * WIDGET_BORDER_WIDTH;
 105 }
 106
 107 static int
 108 widget_possible_dest_types (void)
 109 {
 110   return IMAGE_WIDGET_MASK;
 111 }
 112
 113 static void
 114 check_valid_glyph_or_instantiator (Lisp_Object data)
 115 {
 116   Lisp_Object glyph = data;
 117   if (SYMBOLP (data))
 118     glyph = XSYMBOL (data)->value;
 119
 120   if (IMAGE_INSTANCEP (glyph))
 121     CHECK_IMAGE_INSTANCE (glyph);
 122   else if (!CONSP (glyph) && !VECTORP (glyph))
 123     CHECK_BUFFER_GLYPH (glyph);
 124 }
 125
 126 static void
 127 check_valid_orientation (Lisp_Object data)
 128 {
 129   if (!EQ (data, Qhorizontal)
 130       &&
 131       !EQ (data, Qvertical))
 132     signal_simple_error ("unknown orientation for layout", data);
 133 }
 134
 135 static void
 136 check_valid_justification (Lisp_Object data)
 137 {
 138   if (!EQ (data, Qleft) && !EQ (data, Qright) && !EQ (data, Qcenter))
 139     signal_simple_error ("unknown justification for layout", data);
 140 }
 141
 142 static void
 143 check_valid_border (Lisp_Object data)
 144 {
 145   if (!EQ (data, Qt) && !EQ (data, Qetched_in) && !EQ (data, Qetched_out)
 146       && !EQ (data, Qbevel_in) && !EQ (data, Qbevel_out)
 147       && !GLYPHP (data) && !VECTORP (data))
 148     signal_simple_error ("unknown border style for layout", data);
 149 }
 150
 151 static void
 152 check_valid_anything (Lisp_Object data)
 153 {
 154 }
 155
 156 static void
 157 check_valid_callback (Lisp_Object data)
 158 {
 159     if (!SYMBOLP (data)
 160         && !COMPILED_FUNCTIONP (data)
 161         && !CONSP (data))
 162     {
 163         signal_simple_error (":callback must be a function or expression", data);
 164     }
 165 }
 166
 167 static void
 168 check_valid_symbol (Lisp_Object data)
 169 {
 170     CHECK_SYMBOL (data);
 171 }
 172
 173 static void
 174 check_valid_string_or_vector (Lisp_Object data)
 175 {
 176     if (!STRINGP (data) && !VECTORP (data))
 177         signal_simple_error (":descriptor must be a string or a vector", data);
 178 }
 179
 180 void
 181 check_valid_item_list_1 (Lisp_Object items)
 182 {
 183   Lisp_Object rest;
 184
 185   CHECK_LIST (items);
 186   EXTERNAL_LIST_LOOP (rest, items)
 187     {
 188       if (STRINGP (XCAR (rest)))
 189         CHECK_STRING (XCAR (rest));
 190       else if (VECTORP (XCAR (rest)))
 191         gui_parse_item_keywords (XCAR (rest));
 192       else if (LISTP (XCAR (rest)))
 193         check_valid_item_list_1 (XCAR (rest));
 194       else
 195         signal_simple_error ("Items must be vectors, lists or strings", items);
 196     }
 197 }
 198
 199 static void
 200 check_valid_item_list (Lisp_Object data)
 201 {
 202   Lisp_Object items;
 203
 204   Fcheck_valid_plist (data);
 205   items = Fplist_get (data, Q_items, Qnil);
 206
 207   check_valid_item_list_1 (items);
 208 }
 209
 210 static void
 211 check_valid_glyph_or_instantiator_list (Lisp_Object data)
 212 {
 213   Lisp_Object rest;
 214
 215   CHECK_LIST (data);
 216   EXTERNAL_LIST_LOOP (rest, data)
 217     {
 218       check_valid_glyph_or_instantiator (XCAR (rest));
 219     }
 220 }
 221
 222 static Lisp_Object
 223 glyph_instantiator_to_glyph (Lisp_Object sym)
 224 {
 225   /* This function calls lisp. */
 226   Lisp_Object glyph = sym;
 227   struct gcpro gcpro1;
 228
 229   GCPRO1 (glyph);
 230   /* if we have a symbol get at the actual data */
 231   if (SYMBOLP (glyph))
 232     glyph = XSYMBOL (glyph)->value;
 233
 234   if (CONSP (glyph))
 235     glyph = Feval (glyph);
 236
 237   /* Be really helpful to the user. */
 238   if (VECTORP (glyph))
 239     {
 240       glyph = call1 (intern ("make-glyph"), glyph);
 241     }
 242
 243   /* substitute the new glyph */
 244   RETURN_UNGCPRO (glyph);
 245 }
 246
 247 static void
 248 substitute_keyword_value (Lisp_Object inst, Lisp_Object key, Lisp_Object val)
 249 {
 250   int i;
 251   /* substitute the new glyph */
 252   for (i = 0; i < XVECTOR_LENGTH (inst); i++)
 253     {
 254       if (EQ (key, XVECTOR_DATA (inst)[i]))
 255         {
 256           XVECTOR_DATA (inst)[i+1] = val;
 257           break;
 258         }
 259     }
 260 }
 261
 262 /* wire widget property invocations to specific widgets ...  The
 263  problem we are solving here is that when instantiators get converted
 264  to instances they lose some type information (they just become
 265  subwindows or widgets for example). For widgets we need to preserve
 266  this type information so that we can do widget specific operations on
 267  the instances. This is encoded in the widget type
 268  field. widget_property gets invoked by decoding the primary type
 269  (Qwidget), widget property then invokes based on the secondary type
 270  (Qedit_field for example). It is debatable that we should wire things in this
 271  generalised way rather than treating widgets specially in
 272  image_instance_property. */
 273 static Lisp_Object
 274 widget_property (Lisp_Object image_instance, Lisp_Object prop)
 275 {
 276   struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
 277   struct image_instantiator_methods* meths;
 278
 279   /* first see if its a general property ... */
 280   if (!NILP (Fplist_member (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop)))
 281     return Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, Qnil);
 282
 283   /* .. then try device specific methods ... */
 284   meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
 285                                    IMAGE_INSTANCE_WIDGET_TYPE (ii),
 286                                    ERROR_ME_NOT);
 287   if (meths && HAS_IIFORMAT_METH_P (meths, property))
 288     return IIFORMAT_METH (meths, property, (image_instance, prop));
 289   /* ... then format specific methods ... */
 290   meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii),
 291                                    ERROR_ME_NOT);
 292   if (meths && HAS_IIFORMAT_METH_P (meths, property))
 293     return IIFORMAT_METH (meths, property, (image_instance, prop));
 294   /* ... then fail */
 295   return Qunbound;
 296 }
 297
 298 static Lisp_Object
 299 widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val)
 300 {
 301   struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
 302   struct image_instantiator_methods* meths;
 303   Lisp_Object ret;
 304
 305   /* try device specific methods first ... */
 306   meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
 307                                    IMAGE_INSTANCE_WIDGET_TYPE (ii),
 308                                    ERROR_ME_NOT);
 309   if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
 310       &&
 311       !UNBOUNDP (ret =
 312                  IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
 313     {
 314       return ret;
 315     }
 316   /* ... then format specific methods ... */
 317   meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii),
 318                                    ERROR_ME_NOT);
 319   if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
 320       &&
 321       !UNBOUNDP (ret =
 322                  IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
 323     {
 324       return ret;
 325     }
 326   /* we didn't do any device specific properties, so shove the property in our plist */
 327   IMAGE_INSTANCE_WIDGET_PROPS (ii)
 328     = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val);
 329   return val;
 330 }
 331
 332 static void
 333 widget_validate (Lisp_Object instantiator)
 334 {
 335   Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor);
 336
 337   if (NILP (desc))
 338     signal_simple_error ("Must supply :descriptor", instantiator);
 339
 340   if (VECTORP (desc))
 341     gui_parse_item_keywords (desc);
 342
 343   if (!NILP (find_keyword_in_vector (instantiator, Q_width))
 344       && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width)))
 345     signal_simple_error ("Must supply only one of :width and :pixel-width", instantiator);
 346
 347   if (!NILP (find_keyword_in_vector (instantiator, Q_height))
 348              && !NILP (find_keyword_in_vector (instantiator, Q_pixel_height)))
 349     signal_simple_error ("Must supply only one of :height and :pixel-height", instantiator);
 350 }
 351
 352 static void
 353 combo_box_validate (Lisp_Object instantiator)
 354 {
 355   widget_validate (instantiator);
 356   if (NILP (find_keyword_in_vector (instantiator, Q_properties)))
 357     signal_simple_error ("Must supply item list", instantiator);
 358 }
 359
 360 /* we need to convert things like glyphs to images, eval expressions
 361    etc.*/
 362 static Lisp_Object
 363 widget_normalize (Lisp_Object inst, Lisp_Object console_type)
 364 {
 365   /* This function can call lisp */
 366   Lisp_Object glyph = find_keyword_in_vector (inst, Q_image);
 367
 368   /* we need to eval glyph if its an expression, we do this for the
 369      same reasons we normalize file to data. */
 370   if (!NILP (glyph))
 371     {
 372       substitute_keyword_value (inst, Q_image, glyph_instantiator_to_glyph (glyph));
 373     }
 374
 375   return inst;
 376 }
 377
 378 static void
 379 initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type)
 380 {
 381   /*  initialize_subwindow_image_instance (ii);*/
 382   IMAGE_INSTANCE_WIDGET_TYPE (ii) = type;
 383   IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil;
 384   IMAGE_INSTANCE_WIDGET_FACE (ii) = Vwidget_face;
 385   IMAGE_INSTANCE_WIDGET_ITEMS (ii) = allocate_gui_item ();
 386 }
 387
 388 /* Instantiate a button widget. Unfortunately instantiated widgets are
 389    particular to a frame since they need to have a parent. It's not
 390    like images where you just select the image into the context you
 391    want to display it in and BitBlt it. So image instances can have a
 392    many-to-one relationship with things you see, whereas widgets can
 393    only be one-to-one (i.e. per frame) */
 394 void
 395 widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator,
 396                       Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 397                       int dest_mask, Lisp_Object domain, int default_textheight,
 398                       int default_pixheight, int default_textwidth)
 399 {
 400   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
 401   Lisp_Object face = find_keyword_in_vector (instantiator, Q_face);
 402   Lisp_Object height = find_keyword_in_vector (instantiator, Q_height);
 403   Lisp_Object width = find_keyword_in_vector (instantiator, Q_width);
 404   Lisp_Object pixwidth = find_keyword_in_vector (instantiator, Q_pixel_width);
 405   Lisp_Object pixheight = find_keyword_in_vector (instantiator, Q_pixel_height);
 406   Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor);
 407   Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image);
 408   Lisp_Object props = find_keyword_in_vector (instantiator, Q_properties);
 409   int pw=0, ph=0, tw=0, th=0;
 410
 411   /* this just does pixel type sizing */
 412   subwindow_instantiate (image_instance, instantiator, pointer_fg, pointer_bg,
 413                          dest_mask, domain);
 414
 415   if (!(dest_mask & IMAGE_WIDGET_MASK))
 416     incompatible_image_types (instantiator, dest_mask, IMAGE_WIDGET_MASK);
 417
 418   initialize_widget_image_instance (ii, XVECTOR_DATA (instantiator)[0]);
 419
 420   /* retrieve the fg and bg colors */
 421   if (!NILP (face))
 422     IMAGE_INSTANCE_WIDGET_FACE (ii) = Fget_face (face);
 423
 424   /* data items for some widgets */
 425   IMAGE_INSTANCE_WIDGET_PROPS (ii) = props;
 426
 427   /* retrieve the gui item information. This is easy if we have been
 428      provided with a vector, more difficult if we have just been given
 429      keywords */
 430   if (STRINGP (desc) || NILP (desc))
 431     {
 432       /* big cheat - we rely on the fact that a gui item looks like an instantiator */
 433       IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
 434         gui_parse_item_keywords_no_errors (instantiator);
 435       IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc;
 436     }
 437   else
 438     IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
 439       gui_parse_item_keywords_no_errors (desc);
 440
 441   /* parse more gui items out of the properties */
 442   if (!NILP (props))
 443     {
 444       Lisp_Object items = Fplist_get (props, Q_items, Qnil);
 445       if (!NILP (items))
 446         IMAGE_INSTANCE_WIDGET_ITEMS (ii) =
 447           Fcons (IMAGE_INSTANCE_WIDGET_ITEMS (ii),
 448                  parse_gui_item_tree_children (items));
 449     }
 450
 451   /* normalize size information */
 452   if (!NILP (width))
 453     tw = XINT (width);
 454   if (!NILP (height))
 455     th = XINT (height);
 456   if (!NILP (pixwidth))
 457     pw = XINT (pixwidth);
 458   if (!NILP (pixheight))
 459     ph = XINT (pixheight);
 460
 461   /* for a widget with an image pick up the dimensions from that */
 462   if (!NILP (glyph))
 463     {
 464       if (!pw && !tw)
 465         pw = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain)
 466           + 2 * WIDGET_BORDER_WIDTH;
 467       if (!ph && !th)
 468         ph = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain)
 469           + 2 * WIDGET_BORDER_HEIGHT;
 470     }
 471
 472   /* if we still don' t have sizes, guess from text size */
 473   if (!tw && !pw)
 474     {
 475       if (default_textwidth)
 476         tw = default_textwidth;
 477       else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
 478         tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii));
 479     }
 480
 481   if (!th && !ph)
 482     {
 483       if (default_textheight)
 484         th = default_textheight;
 485       else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
 486         th = 1;
 487       else
 488         ph = default_pixheight;
 489     }
 490
 491   if (tw !=0 || th !=0)
 492     widget_text_to_pixel_conversion (domain,
 493                                      IMAGE_INSTANCE_WIDGET_FACE (ii),
 494                                      th, tw, th ? &ph : 0, tw ? &pw : 0);
 495
 496   IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw;
 497   IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph;
 498 #ifdef DEBUG_WIDGETS
 499   debug_widget_instances++;
 500   stderr_out ("instantiated ");
 501   debug_print (instantiator);
 502   stderr_out ("%d widgets instantiated\n", debug_widget_instances);
 503 #endif
 504 }
 505
 506 static void
 507 widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
 508                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 509                     int dest_mask, Lisp_Object domain)
 510 {
 511   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
 512                                pointer_bg, dest_mask, domain, 1, 0, 0);
 513 }
 514
 515 /* tree-view generic instantiation - get the height right */
 516 static void
 517 tree_view_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
 518                        Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 519                        int dest_mask, Lisp_Object domain)
 520 {
 521   Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties),
 522                                  Q_items, Qnil);
 523   int len;
 524   GET_LIST_LENGTH (data, len);
 525   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
 526                         pointer_bg, dest_mask, domain, len + 1, 0, 0);
 527 }
 528
 529 static void
 530 tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
 531                  Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 532                  int dest_mask, Lisp_Object domain)
 533 {
 534   Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties),
 535                                  Q_items, Qnil);
 536   Lisp_Object rest;
 537   int len = 0;
 538
 539   LIST_LOOP (rest, data)
 540     {
 541       len += 3;                 /* some bias */
 542       if (STRINGP (XCAR (rest)))
 543         len += XSTRING_LENGTH (XCAR (rest));
 544       else if (VECTORP (XCAR (rest)))
 545         {
 546           Lisp_Object gui = gui_parse_item_keywords (XCAR (rest));
 547           len += XSTRING_LENGTH (XGUI_ITEM (gui)->name);
 548         }
 549     }
 550
 551   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
 552                         pointer_bg, dest_mask, domain, 0, 0, len);
 553 }
 554
 555 /* Instantiate a static control */
 556 static void
 557 static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
 558                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 559                     int dest_mask, Lisp_Object domain)
 560 {
 561   widget_instantiate_1 (image_instance, instantiator, pointer_fg,
 562                         pointer_bg, dest_mask, domain, 0, 4, 0);
 563 }
 564
 565 \f
 566 /*****************************************************************************
 567  *                              widget layout                               *
 568  *****************************************************************************/
 569 static int
 570 layout_possible_dest_types (void)
 571 {
 572   return IMAGE_LAYOUT_MASK;
 573 }
 574
 575 /* we need to convert things like glyphs to images, eval expressions
 576    etc.*/
 577 static Lisp_Object
 578 layout_normalize (Lisp_Object inst, Lisp_Object console_type)
 579 {
 580   /* This function can call lisp */
 581   Lisp_Object items = find_keyword_in_vector (inst, Q_items);
 582   Lisp_Object border = find_keyword_in_vector (inst, Q_border);
 583   /* we need to eval glyph if its an expression, we do this for the
 584      same reasons we normalize file to data. */
 585   if (!NILP (items))
 586     {
 587       Lisp_Object rest;
 588       LIST_LOOP (rest, items)
 589         {
 590           /* substitute the new glyph */
 591           Fsetcar (rest, glyph_instantiator_to_glyph (XCAR (rest)));
 592         }
 593     }
 594   /* normalize the border spec. */
 595   if (VECTORP (border) || CONSP (border))
 596     {
 597       substitute_keyword_value (inst, Q_border, glyph_instantiator_to_glyph (border));
 598     }
 599   return inst;
 600 }
 601
 602 /* Instantiate a layout widget. Sizing commentary: we have a number of
 603    problems that we would like to address. Some consider some of these
 604    more important than others. Currently size information is
 605    determined at instantiation time and is then fixed forever
 606    after. Generally this is not what we want. Users want size to be
 607    "big enough" to accommodate whatever they are trying to show and
 608    this is dependent on text length, lines, font metrics etc. Of
 609    course these attributes can change dynamically and so the size
 610    should changed dynamically also. Only in a few limited cases should
 611    the size be fixed and remain fixed. Of course this actually means
 612    that we don't really want to specifiy the size *at all* for most
 613    widgets - we want it to be discovered dynamically. Thus we can
 614    envisage the following scenarios:
 615
 616    1. A button is sized to accommodate its text, the text changes and the
 617    button should change size also.
 618
 619    2. A button is given an explicit size. Its size should never change.
 620
 621    3. Layout is put inside an area. The size of the area changes, the
 622    layout should change with it.
 623
 624    4. A button grows to accommodate additional text. The whitespace
 625    around it should be modified to cope with the new layout
 626    requirements.
 627
 628    5. A button grows. The area surrounding it should grow also if
 629    possible.
 630
 631    What metrics are important?
 632    1. Actual width and height.
 633
 634    2. Whether the width and height are what the widget actually wants, or
 635    whether it can grow or shrink.
 636
 637    Text glyphs are particularly troublesome since their metrics depend
 638    on the context in which they are being viewed. For instance they
 639    can appear differently depending on the window face, frame face or
 640    glyph face. All other glyphs are essentially fixed in
 641    appearance. Perhaps the problem is that text glyphs are cached on a
 642    device basis like most other glyphs. Instead they should be cached
 643    per-window and then the instance would be fixed and we wouldn't
 644    have to mess around with font metrics and the rest. */
 645 static void
 646 layout_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
 647                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
 648                     int dest_mask, Lisp_Object domain)
 649 {
 650   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
 651   Lisp_Object rest, device = IMAGE_INSTANCE_DEVICE (ii);
 652   Lisp_Object frame = FW_FRAME (domain);
 653   Lisp_Object items = find_keyword_in_vector (instantiator, Q_items);
 654   Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
 655   Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
 656   Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation);
 657   Lisp_Object justify = find_keyword_in_vector (instantiator, Q_justify);
 658   Lisp_Object border = find_keyword_in_vector (instantiator, Q_border);
 659   Lisp_Object children = Qnil;
 660   int pw = 0, ph = 0, x, y, maxph = 0, maxpw = 0, nitems = 0,
 661     horiz_spacing, vert_spacing, ph_adjust = 0;
 662
 663   if (NILP (frame))
 664     signal_simple_error ("No selected frame", device);
 665
 666   if (!(dest_mask & IMAGE_LAYOUT_MASK))
 667     incompatible_image_types (instantiator, dest_mask, IMAGE_LAYOUT_MASK);
 668
 669   if (NILP (orient))
 670     orient = Qvertical;
 671
 672   if (EQ (border, Qt))
 673     border = Qetched_in;
 674
 675   ii->data = 0;
 676   IMAGE_INSTANCE_TYPE (ii) = IMAGE_LAYOUT;
 677   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
 678   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
 679   IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
 680   IMAGE_INSTANCE_LAYOUT_BORDER (ii) = border;
 681
 682   /* normalize size information */
 683   if (!NILP (width))
 684     pw = XINT (width);
 685   if (!NILP (height))
 686     ph = XINT (height);
 687
 688   /* flip through the items to work out how much stuff we have to display */
 689   LIST_LOOP (rest, items)
 690     {
 691       Lisp_Object glyph = XCAR (rest);
 692       int gheight = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain);
 693       int gwidth = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain);
 694       nitems ++;
 695       if (EQ (orient, Qhorizontal))
 696         {
 697           maxph = max (maxph, gheight);
 698           maxpw += gwidth;
 699         }
 700       else if (EQ (orient, Qvertical))
 701         {
 702           maxpw = max (maxpw, gwidth);
 703           maxph += gheight;
 704         }
 705     }
 706
 707   /* work out spacing between items and bounds of the layout */
 708   if (!pw)
 709     {
 710       /* No user provided width so we just do default spacing. */
 711       horiz_spacing = WIDGET_BORDER_WIDTH * 2;
 712       if (EQ (orient, Qhorizontal))
 713         pw = maxpw + (nitems + 1) * horiz_spacing;
 714       else
 715         pw = maxpw + 2 * horiz_spacing;
 716     }
 717   else if (pw < maxpw)
 718     /* The user wants a smaller space than the largest item, so we
 719        just provide default spacing and will let the output routines
 720        clip.. */
 721     horiz_spacing = WIDGET_BORDER_WIDTH * 2;
 722   else if (EQ (orient, Qhorizontal))
 723     /* We have a larger area to display in so distribute the space
 724        evenly. */
 725     horiz_spacing = (pw - maxpw) / (nitems + 1);
 726   else
 727     horiz_spacing = (pw - maxpw) / 2;
 728
 729   /* Do the border now so that we can adjust the layout. */
 730   if (GLYPHP (border))
 731     {
 732       /* We are going to be sneaky here and add the border text as
 733          just another child, the layout and output routines don't know
 734          this and will just display at the offsets we prescribe. */
 735       Lisp_Object bglyph = glyph_image_instance (border, domain, ERROR_ME, 1);
 736
 737       children = Fcons (bglyph, children);
 738       XIMAGE_INSTANCE_XOFFSET (bglyph) = 10; /* Really, what should this be? */
 739       XIMAGE_INSTANCE_YOFFSET (bglyph) = 0;
 740
 741       ph_adjust = (glyph_height (border, Qnil, DEFAULT_INDEX, domain) / 2);
 742       IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (ph_adjust);
 743     }
 744
 745   /* Work out vertical spacings. */
 746   if (!ph)
 747     {
 748       vert_spacing = WIDGET_BORDER_HEIGHT * 2;
 749       if (EQ (orient, Qvertical))
 750         ph = maxph + (nitems + 1) * vert_spacing + ph_adjust;
 751       else
 752         ph = maxph + 2 * vert_spacing + ph_adjust;
 753     }
 754   else if (ph < maxph)
 755     vert_spacing = WIDGET_BORDER_HEIGHT * 2;
 756   else if (EQ (orient, Qvertical))
 757     vert_spacing = (ph - (maxph + ph_adjust)) / (nitems + 1);
 758   else
 759     vert_spacing = (ph - (maxph + ph_adjust)) / 2;
 760
 761   y = vert_spacing + ph_adjust;
 762   x = horiz_spacing;
 763
 764   /* Now flip through putting items where we want them, paying
 765      attention to justification. */
 766   LIST_LOOP (rest, items)
 767     {
 768       /* make sure the image is instantiated */
 769       Lisp_Object glyph = XCAR (rest);
 770       Lisp_Object gii = glyph_image_instance (glyph, domain, ERROR_ME, 1);
 771       int gwidth = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain);
 772       int gheight = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain);
 773
 774       children = Fcons (gii, children);
 775
 776       if (EQ (orient, Qhorizontal))
 777         {
 778           if (EQ (justify, Qright))
 779             y = ph - (gheight + vert_spacing);
 780           else if (EQ (justify, Qcenter))
 781             y = (ph - gheight) / 2;
 782         }
 783       else if (EQ (orient, Qvertical))
 784         {
 785           if (EQ (justify, Qright))
 786             x = pw - (gwidth + horiz_spacing);
 787           else if (EQ (justify, Qcenter))
 788             x = (pw - gwidth) / 2;
 789         }
 790
 791       XIMAGE_INSTANCE_XOFFSET (gii) = x;
 792       XIMAGE_INSTANCE_YOFFSET (gii) = y;
 793
 794       if (EQ (orient, Qhorizontal))
 795         {
 796           x += (gwidth + horiz_spacing);
 797         }
 798       else if (EQ (orient, Qvertical))
 799         {
 800           y += (gheight + vert_spacing);
 801         }
 802     }
 803
 804   IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = children;
 805   assert (pw && ph);
 806   IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw;
 807   IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph;
 808 }
 809
 810 \f
 811 /************************************************************************/
 812 /*                            initialization                            */
 813 /************************************************************************/
 814
 815 void
 816 syms_of_glyphs_widget (void)
 817 {
 818   defkeyword (&Q_descriptor, ":descriptor");
 819   defkeyword (&Q_height, ":height");
 820   defkeyword (&Q_width, ":width");
 821   defkeyword (&Q_properties, ":properties");
 822   defkeyword (&Q_items, ":items");
 823   defkeyword (&Q_image, ":image");
 824   defkeyword (&Q_percent, ":percent");
 825   defkeyword (&Q_text, ":text");
 826   defkeyword (&Q_orientation, ":orientation");
 827   defkeyword (&Q_justify, ":justify");
 828   defkeyword (&Q_border, ":border");
 829
 830   defsymbol (&Qetched_in, "etched-in");
 831   defsymbol (&Qetched_out, "etched-out");
 832   defsymbol (&Qbevel_in, "bevel-in");
 833   defsymbol (&Qbevel_out, "bevel-out");
 834 }
 835
 836 void
 837 image_instantiator_format_create_glyphs_widget (void)
 838 {
 839 #define VALID_GUI_KEYWORDS(type) \
 840   IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_active, check_valid_anything); \
 841   IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything);                \
 842   IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string);            \
 843   IIFORMAT_VALID_KEYWORD (type, Q_style, check_valid_symbol);           \
 844   IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_selected, check_valid_anything); \
 845   IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything);                \
 846   IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol);          \
 847   IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything);      \
 848   IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string);    \
 849   IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string);             \
 850   IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything);         \
 851   IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback, check_valid_callback); \
 852   IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_descriptor, check_valid_string_or_vector)
 853
 854 #define VALID_WIDGET_KEYWORDS(type) \
 855   IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int);              \
 856   IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int);             \
 857   IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int);        \
 858   IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int);       \
 859   IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face)
 860
 861   /* we only do this for properties */
 862   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget");
 863   IIFORMAT_HAS_METHOD (widget, property);
 864   IIFORMAT_HAS_METHOD (widget, set_property);
 865
 866   /* widget image-instantiator types - buttons */
 867   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button");
 868   IIFORMAT_HAS_SHARED_METHOD (button, validate, widget);
 869   IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget);
 870   IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget);
 871   IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget);
 872   IIFORMAT_VALID_KEYWORD (button,
 873                           Q_image, check_valid_glyph_or_instantiator);
 874   VALID_WIDGET_KEYWORDS (button);
 875   VALID_GUI_KEYWORDS (button);
 876
 877   /* edit fields */
 878   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit_field, "edit-field");
 879   IIFORMAT_HAS_SHARED_METHOD (edit_field, validate, widget);
 880   IIFORMAT_HAS_SHARED_METHOD (edit_field, possible_dest_types, widget);
 881   IIFORMAT_HAS_SHARED_METHOD (edit_field, instantiate, widget);
 882   VALID_WIDGET_KEYWORDS (edit_field);
 883   VALID_GUI_KEYWORDS (edit_field);
 884
 885   /* combo box */
 886   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo_box, "combo-box");
 887   IIFORMAT_HAS_METHOD (combo_box, validate);
 888   IIFORMAT_HAS_SHARED_METHOD (combo_box, possible_dest_types, widget);
 889   VALID_GUI_KEYWORDS (combo_box);
 890
 891   IIFORMAT_VALID_KEYWORD (combo_box, Q_width, check_valid_int);
 892   IIFORMAT_VALID_KEYWORD (combo_box, Q_height, check_valid_int);
 893   IIFORMAT_VALID_KEYWORD (combo_box, Q_pixel_width, check_valid_int);
 894   IIFORMAT_VALID_KEYWORD (combo_box, Q_face, check_valid_face);
 895   IIFORMAT_VALID_KEYWORD (combo_box, Q_properties, check_valid_item_list);
 896
 897   /* scrollbar */
 898   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (scrollbar, "scrollbar");
 899   IIFORMAT_HAS_SHARED_METHOD (scrollbar, validate, widget);
 900   IIFORMAT_HAS_SHARED_METHOD (scrollbar, possible_dest_types, widget);
 901   IIFORMAT_HAS_SHARED_METHOD (scrollbar, instantiate, widget);
 902   VALID_GUI_KEYWORDS (scrollbar);
 903
 904   IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int);
 905   IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int);
 906   IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face);
 907
 908   /* progress guage */
 909   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge, "progress-gauge");
 910   IIFORMAT_HAS_SHARED_METHOD (progress_gauge, validate, widget);
 911   IIFORMAT_HAS_SHARED_METHOD (progress_gauge, possible_dest_types, widget);
 912   IIFORMAT_HAS_SHARED_METHOD (progress_gauge, instantiate, widget);
 913   VALID_WIDGET_KEYWORDS (progress_gauge);
 914   VALID_GUI_KEYWORDS (progress_gauge);
 915
 916   /* tree view */
 917   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tree_view, "tree-view");
 918   IIFORMAT_HAS_SHARED_METHOD (tree_view, validate, combo_box);
 919   IIFORMAT_HAS_SHARED_METHOD (tree_view, possible_dest_types, widget);
 920   IIFORMAT_HAS_METHOD (tree_view, instantiate);
 921   VALID_WIDGET_KEYWORDS (tree_view);
 922   VALID_GUI_KEYWORDS (tree_view);
 923   IIFORMAT_VALID_KEYWORD (tree_view, Q_properties, check_valid_item_list);
 924
 925   /* tab control */
 926   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tab_control, "tab-control");
 927   IIFORMAT_HAS_SHARED_METHOD (tab_control, validate, combo_box);
 928   IIFORMAT_HAS_SHARED_METHOD (tab_control, possible_dest_types, widget);
 929   IIFORMAT_HAS_METHOD (tab_control, instantiate);
 930   VALID_WIDGET_KEYWORDS (tab_control);
 931   VALID_GUI_KEYWORDS (tab_control);
 932   IIFORMAT_VALID_KEYWORD (tab_control, Q_properties, check_valid_item_list);
 933
 934   /* labels */
 935   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label");
 936   IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget);
 937   IIFORMAT_HAS_SHARED_METHOD (label, instantiate, static);
 938   VALID_WIDGET_KEYWORDS (label);
 939   IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string);
 940
 941   /* layout */
 942   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (layout, "layout");
 943   IIFORMAT_HAS_METHOD (layout, possible_dest_types);
 944   IIFORMAT_HAS_METHOD (layout, instantiate);
 945   IIFORMAT_HAS_METHOD (layout, normalize);
 946   IIFORMAT_VALID_KEYWORD (layout, Q_pixel_width, check_valid_int);
 947   IIFORMAT_VALID_KEYWORD (layout, Q_pixel_height, check_valid_int);
 948   IIFORMAT_VALID_KEYWORD (layout, Q_orientation, check_valid_orientation);
 949   IIFORMAT_VALID_KEYWORD (layout, Q_justify, check_valid_justification);
 950   IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border);
 951   IIFORMAT_VALID_KEYWORD (layout, Q_items,
 952                           check_valid_glyph_or_instantiator_list);
 953 }
 954
 955 void
 956 reinit_vars_of_glyphs_widget (void)
 957 {
 958 #ifdef DEBUG_WIDGETS
 959   debug_widget_instances = 0;
 960 #endif
 961 }
 962
 963 void
 964 vars_of_glyphs_widget (void)
 965 {
 966   reinit_vars_of_glyphs_widget ();
 967 }