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

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