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

   1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs)
   2    Copyright (C) 1995 Board of Trustees, University of Illinois.
   3    Copyright (C) 1995, 1996 Ben Wing.
   4    Copyright (C) 1995 Sun Microsystems, Inc.
   5    Copyright (C) 1998 Free Software Foundation, Inc.
   6
   7 This file is part of XEmacs.
   8
   9 XEmacs is free software; you can redistribute it and/or modify it
  10 under the terms of the GNU General Public License as published by the
  11 Free Software Foundation; either version 2, or (at your option) any
  12 later version.
  13
  14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with XEmacs; see the file COPYING.  If not, write to
  21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 Boston, MA 02111-1307, USA.  */
  23
  24 /* Synched up with: Not in FSF. */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28 #include "gui.h"
  29 #include "elhash.h"
  30 #include "bytecode.h"
  31
  32 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
  33 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence;
  34 Lisp_Object Q_accelerator, Q_label, Q_callback;
  35 Lisp_Object Qtoggle, Qradio;
  36
  37 #ifdef HAVE_POPUPS
  38
  39 /* count of menus/dboxes currently up */
  40 int popup_up_p;
  41
  42 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
  43 Return t if a popup menu or dialog box is up, nil otherwise.
  44 See `popup-menu' and `popup-dialog-box'.
  45 */
  46        ())
  47 {
  48   return popup_up_p ? Qt : Qnil;
  49 }
  50 #endif /* HAVE_POPUPS */
  51
  52 int
  53 separator_string_p (CONST char *s)
  54 {
  55   CONST char *p;
  56   char first;
  57
  58   if (!s || s[0] == '\0')
  59     return 0;
  60   first = s[0];
  61   if (first != '-' && first != '=')
  62     return 0;
  63   for (p = s; *p == first; p++)
  64     ;
  65
  66   return (*p == '!' || *p == ':' || *p == '\0');
  67 }
  68
  69 /* Massage DATA to find the correct function and argument.  Used by
  70    popup_selection_callback() and the msw code. */
  71 void
  72 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
  73 {
  74   if (SYMBOLP (data)
  75       || (COMPILED_FUNCTIONP (data)
  76           && XCOMPILED_FUNCTION (data)->flags.interactivep)
  77       || (EQ (XCAR (data), Qlambda)
  78           && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
  79     {
  80       *fn = Qcall_interactively;
  81       *arg = data;
  82     }
  83   else if (CONSP (data))
  84     {
  85       *fn = Qeval;
  86       *arg = data;
  87     }
  88   else
  89     {
  90       *fn = Qeval;
  91       *arg = list3 (Qsignal,
  92                     list2 (Qquote, Qerror),
  93                     list2 (Qquote, list2 (build_translated_string
  94                                           ("illegal callback"),
  95                                           data)));
  96     }
  97 }
  98
  99 /*
 100  * Initialize the gui_item structure by setting all (GC-protected)
 101  * fields to their default values. The defaults are t for :active and
 102  * :included values, and nil for others.
 103  */
 104 void
 105 gui_item_init (struct gui_item *pgui_item)
 106 {
 107   pgui_item->name     = Qnil;
 108   pgui_item->callback = Qnil;
 109   pgui_item->suffix   = Qnil;
 110   pgui_item->active   = Qt;
 111   pgui_item->included = Qt;
 112   pgui_item->config   = Qnil;
 113   pgui_item->filter   = Qnil;
 114   pgui_item->style    = Qnil;
 115   pgui_item->selected = Qnil;
 116   pgui_item->keys     = Qnil;
 117 }
 118
 119 /*
 120  * Add a value VAL associated with keyword KEY into PGUI_ITEM
 121  * structure. If KEY is not a keyword, or is an unknown keyword, then
 122  * error is signaled.
 123  */
 124 void
 125 gui_item_add_keyval_pair (struct gui_item *pgui_item,
 126                           Lisp_Object key, Lisp_Object val,
 127                           Error_behavior errb)
 128 {
 129   if (!KEYWORDP (key))
 130     signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name);
 131
 132   if      (EQ (key, Q_suffix))   pgui_item->suffix   = val;
 133   else if (EQ (key, Q_active))   pgui_item->active   = val;
 134   else if (EQ (key, Q_included)) pgui_item->included = val;
 135   else if (EQ (key, Q_config))   pgui_item->config   = val;
 136   else if (EQ (key, Q_filter))   pgui_item->filter   = val;
 137   else if (EQ (key, Q_style))    pgui_item->style    = val;
 138   else if (EQ (key, Q_selected)) pgui_item->selected = val;
 139   else if (EQ (key, Q_keys))     pgui_item->keys     = val;
 140   else if (EQ (key, Q_callback))         pgui_item->callback     = val;
 141   else if (EQ (key, Q_key_sequence)) ;   /* ignored for FSF compatability */
 142   else if (EQ (key, Q_label)) ;   /* ignored for 21.0 implement in 21.2  */
 143   else if (ERRB_EQ (errb, ERROR_ME))
 144     signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name);
 145 }
 146
 147 /*
 148  * ITEM is a lisp vector, describing a menu item or a button. The
 149  * function extracts the description of the item into the PGUI_ITEM
 150  * structure.
 151  */
 152 static void
 153 gui_parse_item_keywords_internal (Lisp_Object item, struct gui_item *pgui_item,
 154                                   Error_behavior errb)
 155 {
 156   int length, plist_p, start;
 157   Lisp_Object *contents;
 158
 159   CHECK_VECTOR (item);
 160   length = XVECTOR_LENGTH (item);
 161   contents = XVECTOR_DATA (item);
 162
 163   if (length < 1)
 164     signal_simple_error ("GUI item descriptors must be at least 1 elts long", item);
 165
 166   /* length 1:                  [ "name" ]
 167      length 2:          [ "name" callback ]
 168      length 3:          [ "name" callback active-p ]
 169                    or   [ "name" keyword  value  ]
 170      length 4:          [ "name" callback active-p suffix ]
 171                    or   [ "name" callback keyword  value  ]
 172      length 5+:         [ "name" callback [ keyword value ]+ ]
 173                    or   [ "name" [ keyword value ]+ ]
 174   */
 175   plist_p = (length > 2 && (KEYWORDP (contents [1])
 176                             || KEYWORDP (contents [2])));
 177
 178   pgui_item->name = contents [0];
 179   if (length > 1 && !KEYWORDP (contents [1]))
 180     {
 181       pgui_item->callback = contents [1];
 182       start = 2;
 183     }
 184   else
 185     start =1;
 186
 187   if (!plist_p && length > 2)
 188     /* the old way */
 189     {
 190       pgui_item->active = contents [2];
 191       if (length == 4)
 192         pgui_item->suffix = contents [3];
 193     }
 194   else
 195     /* the new way */
 196     {
 197       int i;
 198       if ((length - start) & 1)
 199         signal_simple_error (
 200                 "GUI item descriptor has an odd number of keywords and values",
 201                              item);
 202
 203       for (i = start; i < length;)
 204         {
 205           Lisp_Object key = contents [i++];
 206           Lisp_Object val = contents [i++];
 207           gui_item_add_keyval_pair (pgui_item, key, val, errb);
 208         }
 209     }
 210 }
 211
 212 void
 213 gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item)
 214 {
 215   gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME);
 216 }
 217
 218 void
 219 gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item)
 220 {
 221   gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME_NOT);
 222 }
 223
 224 /*
 225  * Decide whether a GUI item is active by evaluating its :active form
 226  * if any
 227  */
 228 int
 229 gui_item_active_p (CONST struct gui_item *pgui_item)
 230 {
 231   /* This function can call lisp */
 232
 233   /* Shortcut to avoid evaluating Qt each time */
 234   return (EQ (pgui_item->active, Qt)
 235           || !NILP (Feval (pgui_item->active)));
 236 }
 237
 238 /*
 239  * Decide whether a GUI item is selected by evaluating its :selected form
 240  * if any
 241  */
 242 int
 243 gui_item_selected_p (CONST struct gui_item *pgui_item)
 244 {
 245   /* This function can call lisp */
 246
 247   /* Shortcut to avoid evaluating Qt each time */
 248   return (EQ (pgui_item->selected, Qt)
 249           || !NILP (Feval (pgui_item->selected)));
 250 }
 251
 252 /*
 253  * Decide whether a GUI item is included by evaluating its :included
 254  * form if given, and testing its :config form against supplied CONFLIST
 255  * configuration variable
 256  */
 257 int
 258 gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist)
 259 {
 260   /* This function can call lisp */
 261
 262   /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
 263   if (!EQ (pgui_item->included, Qt)
 264       && NILP (Feval (pgui_item->included)))
 265     return 0;
 266
 267   /* Do :config if conflist is given */
 268   if (!NILP (conflist) && !NILP (pgui_item->config)
 269       && NILP (Fmemq (pgui_item->config, conflist)))
 270     return 0;
 271
 272   return 1;
 273 }
 274
 275 static DOESNT_RETURN
 276 signal_too_long_error (Lisp_Object name)
 277 {
 278   signal_simple_error ("GUI item produces too long displayable string", name);
 279 }
 280
 281 #ifdef HAVE_WINDOW_SYSTEM
 282 /*
 283  * Format "left flush" display portion of an item into BUF, guarded by
 284  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 285  * null character, so actual maximum size of buffer consumed is
 286  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 287  * signaled.
 288  * Return value is the offset to the terminating null character into the
 289  * buffer.
 290  */
 291 unsigned int
 292 gui_item_display_flush_left  (CONST struct gui_item *pgui_item,
 293                               char* buf, Bytecount buf_len)
 294 {
 295   char *p = buf;
 296   Bytecount len;
 297
 298   /* Copy item name first */
 299   CHECK_STRING (pgui_item->name);
 300   len = XSTRING_LENGTH (pgui_item->name);
 301   if (len > buf_len)
 302     signal_too_long_error (pgui_item->name);
 303   memcpy (p, XSTRING_DATA (pgui_item->name), len);
 304   p += len;
 305
 306   /* Add space and suffix, if there is a suffix.
 307    * If suffix is not string evaluate it */
 308   if (!NILP (pgui_item->suffix))
 309     {
 310       Lisp_Object suffix = pgui_item->suffix;
 311       /* Shortcut to avoid evaluating suffix each time */
 312       if (!STRINGP (suffix))
 313         {
 314           suffix = Feval (suffix);
 315           CHECK_STRING (suffix);
 316         }
 317
 318       len = XSTRING_LENGTH (suffix);
 319       if (p + len + 1 > buf + buf_len)
 320         signal_too_long_error (pgui_item->name);
 321       *(p++) = ' ';
 322       memcpy (p, XSTRING_DATA (suffix), len);
 323       p += len;
 324     }
 325   *p = '\0';
 326   return p - buf;
 327 }
 328
 329 /*
 330  * Format "right flush" display portion of an item into BUF, guarded by
 331  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 332  * null character, so actual maximum size of buffer consumed is
 333  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 334  * signaled.
 335  * Return value is the offset to the terminating null character into the
 336  * buffer.
 337  */
 338 unsigned int
 339 gui_item_display_flush_right (CONST struct gui_item *pgui_item,
 340                               char* buf, Bytecount buf_len)
 341 {
 342   *buf = 0;
 343
 344   /* Have keys? */
 345   if (!menubar_show_keybindings)
 346     return 0;
 347
 348   /* Try :keys first */
 349   if (!NILP (pgui_item->keys))
 350     {
 351       CHECK_STRING (pgui_item->keys);
 352       if (XSTRING_LENGTH (pgui_item->keys) > buf_len)
 353         signal_too_long_error (pgui_item->name);
 354       strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys));
 355       return XSTRING_LENGTH (pgui_item->keys);
 356     }
 357
 358   /* See if we can derive keys out of callback symbol */
 359   if (SYMBOLP (pgui_item->callback))
 360     {
 361       char buf2 [1024];
 362       Bytecount len;
 363
 364       where_is_to_char (pgui_item->callback, buf2);
 365       len = strlen (buf2);
 366       if (len > buf_len)
 367         signal_too_long_error (pgui_item->name);
 368       strcpy (buf, buf2);
 369       return len;
 370     }
 371
 372   /* No keys - no right flush display */
 373   return 0;
 374 }
 375 #endif /* HAVE_WINDOW_SYSTEM */
 376
 377 Lisp_Object
 378 mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object))
 379 {
 380   markobj (p->name);
 381   markobj (p->callback);
 382   markobj (p->suffix);
 383   markobj (p->active);
 384   markobj (p->included);
 385   markobj (p->config);
 386   markobj (p->filter);
 387   markobj (p->style);
 388   markobj (p->selected);
 389   markobj (p->keys);
 390
 391   return Qnil;
 392 }
 393
 394 int
 395 gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot)
 396 {
 397   int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0));
 398   int id = GUI_ITEM_ID_BITS (hashid, slot);
 399   while (!NILP (Fgethash (make_int (id),
 400                           hashtable, Qnil)))
 401     {
 402       id = GUI_ITEM_ID_BITS (id + 1, slot);
 403     }
 404   return id;
 405 }
 406
 407 void
 408 syms_of_gui (void)
 409 {
 410   defkeyword (&Q_active,   ":active");
 411   defkeyword (&Q_suffix,   ":suffix");
 412   defkeyword (&Q_keys,     ":keys");
 413   defkeyword (&Q_key_sequence,":key-sequence");
 414   defkeyword (&Q_style,    ":style");
 415   defkeyword (&Q_selected, ":selected");
 416   defkeyword (&Q_filter,   ":filter");
 417   defkeyword (&Q_config,   ":config");
 418   defkeyword (&Q_included, ":included");
 419   defkeyword (&Q_accelerator, ":accelerator");
 420   defkeyword (&Q_label, ":label");
 421   defkeyword (&Q_callback, ":callback");
 422
 423   defsymbol (&Qtoggle, "toggle");
 424   defsymbol (&Qradio, "radio");
 425
 426 #ifdef HAVE_POPUPS
 427   DEFSUBR (Fpopup_up_p);
 428 #endif
 429 }
 430
 431 void
 432 vars_of_gui (void)
 433 {
 434 }