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 "bytecode.h"           /* for struct Lisp_Compiled_Function */
  30
  31 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
  32 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence;
  33 Lisp_Object Q_accelerator, Q_label;
  34 Lisp_Object Qtoggle, Qradio;
  35
  36 #ifdef HAVE_POPUPS
  37
  38 /* count of menus/dboxes currently up */
  39 int popup_up_p;
  40
  41 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
  42 Return t if a popup menu or dialog box is up, nil otherwise.
  43 See `popup-menu' and `popup-dialog-box'.
  44 */
  45        ())
  46 {
  47   return popup_up_p ? Qt : Qnil;
  48 }
  49
  50 int
  51 separator_string_p (CONST char *s)
  52 {
  53   CONST char *p;
  54   char first;
  55
  56   if (!s || s[0] == '\0')
  57     return 0;
  58   first = s[0];
  59   if (first != '-' && first != '=')
  60     return 0;
  61   for (p = s; *p == first; p++)
  62     ;
  63
  64   return (*p == '!' || *p == ':' || *p == '\0');
  65 }
  66
  67 /* Massage DATA to find the correct function and argument.  Used by
  68    popup_selection_callback() and the msw code. */
  69 void
  70 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
  71 {
  72   if (SYMBOLP (data)
  73       || (COMPILED_FUNCTIONP (data)
  74           && XCOMPILED_FUNCTION (data)->flags.interactivep)
  75       || (EQ (XCAR (data), Qlambda)
  76           && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
  77     {
  78       *fn = Qcall_interactively;
  79       *arg = data;
  80     }
  81   else if (CONSP (data))
  82     {
  83       *fn = Qeval;
  84       *arg = data;
  85     }
  86   else
  87     {
  88       *fn = Qeval;
  89       *arg = list3 (Qsignal,
  90                     list2 (Qquote, Qerror),
  91                     list2 (Qquote, list2 (build_translated_string
  92                                           ("illegal callback"),
  93                                           data)));
  94     }
  95 }
  96
  97 /*
  98  * Initialize the gui_item structure by setting all (GC-protected)
  99  * fields to their default values. The defaults are t for :active and
 100  * :included values, and nil for others.
 101  */
 102 void
 103 gui_item_init (struct gui_item *pgui_item)
 104 {
 105   pgui_item->name     = Qnil;
 106   pgui_item->callback = Qnil;
 107   pgui_item->suffix   = Qnil;
 108   pgui_item->active   = Qt;
 109   pgui_item->included = Qt;
 110   pgui_item->config   = Qnil;
 111   pgui_item->filter   = Qnil;
 112   pgui_item->style    = Qnil;
 113   pgui_item->selected = Qnil;
 114   pgui_item->keys     = Qnil;
 115 }
 116
 117 /*
 118  * Add a value VAL associated with keyword KEY into PGUI_ITEM
 119  * structure. If KEY is not a keyword, or is an unknown keyword, then
 120  * error is signaled.
 121  */
 122 void
 123 gui_item_add_keyval_pair (struct gui_item *pgui_item,
 124                           Lisp_Object key, Lisp_Object val)
 125 {
 126   if (!KEYWORDP (key))
 127     signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name);
 128
 129   if      (EQ (key, Q_suffix))   pgui_item->suffix   = val;
 130   else if (EQ (key, Q_active))   pgui_item->active   = val;
 131   else if (EQ (key, Q_included)) pgui_item->included = val;
 132   else if (EQ (key, Q_config))   pgui_item->config   = val;
 133   else if (EQ (key, Q_filter))   pgui_item->filter   = val;
 134   else if (EQ (key, Q_style))    pgui_item->style    = val;
 135   else if (EQ (key, Q_selected)) pgui_item->selected = val;
 136   else if (EQ (key, Q_keys))     pgui_item->keys     = val;
 137   else if (EQ (key, Q_key_sequence)) ;   /* ignored for FSF compatability */
 138   else if (EQ (key, Q_label)) ;   /* ignored for 21.0 implement in 21.2  */
 139   else
 140     signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name);
 141 }
 142
 143 /*
 144  * ITEM is a lisp vector, describing a menu item or a button. The
 145  * function extracts the description of the item into the PGUI_ITEM
 146  * structure.
 147  */
 148 void
 149 gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item)
 150 {
 151   int length, plist_p;
 152   Lisp_Object *contents;
 153
 154   CHECK_VECTOR (item);
 155   length = XVECTOR_LENGTH (item);
 156   contents = XVECTOR_DATA (item);
 157
 158   if (length < 2)
 159     signal_simple_error ("GUI item descriptors must be at least 2 elts long", item);
 160
 161   /* length 2:          [ "name" callback ]
 162      length 3:          [ "name" callback active-p ]
 163      length 4:          [ "name" callback active-p suffix ]
 164                    or   [ "name" callback keyword  value  ]
 165      length 5+:         [ "name" callback [ keyword value ]+ ]
 166   */
 167   plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2])));
 168
 169   pgui_item->name = contents [0];
 170   pgui_item->callback = contents [1];
 171
 172   if (!plist_p && length > 2)
 173     /* the old way */
 174     {
 175       pgui_item->active = contents [2];
 176       if (length == 4)
 177         pgui_item->suffix = contents [3];
 178     }
 179   else
 180     /* the new way */
 181     {
 182       int i;
 183       if (length & 1)
 184         signal_simple_error (
 185                 "GUI item descriptor has an odd number of keywords and values",
 186                              item);
 187
 188       for (i = 2; i < length;)
 189         {
 190           Lisp_Object key = contents [i++];
 191           Lisp_Object val = contents [i++];
 192           gui_item_add_keyval_pair (pgui_item, key, val);
 193         }
 194     }
 195 }
 196
 197 /*
 198  * Decide whether a GUI item is active by evaluating its :active form
 199  * if any
 200  */
 201 int
 202 gui_item_active_p (CONST struct gui_item *pgui_item)
 203 {
 204   /* This function can call lisp */
 205
 206   /* Shortcut to avoid evaluating Qt each time */
 207   return (EQ (pgui_item->active, Qt)
 208           || !NILP (Feval (pgui_item->active)));
 209 }
 210
 211 /*
 212  * Decide whether a GUI item is included by evaluating its :included
 213  * form if given, and testing its :config form against supplied CONFLIST
 214  * configuration variable
 215  */
 216 int
 217 gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist)
 218 {
 219   /* This function can call lisp */
 220
 221   /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
 222   if (!EQ (pgui_item->included, Qt)
 223       && NILP (Feval (pgui_item->included)))
 224     return 0;
 225
 226   /* Do :config if conflist is given */
 227   if (!NILP (conflist) && !NILP (pgui_item->config)
 228       && NILP (Fmemq (pgui_item->config, conflist)))
 229     return 0;
 230
 231   return 1;
 232 }
 233
 234 static DOESNT_RETURN
 235 signal_too_long_error (Lisp_Object name)
 236 {
 237   signal_simple_error ("GUI item produces too long displayable string", name);
 238 }
 239
 240 /*
 241  * Format "left flush" display portion of an item into BUF, guarded by
 242  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 243  * null character, so actual maximum size of buffer consumed is
 244  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 245  * signaled.
 246  * Return value is the offset to the terminating null character into the
 247  * buffer.
 248  */
 249 unsigned int
 250 gui_item_display_flush_left  (CONST struct gui_item *pgui_item,
 251                               char* buf, Bytecount buf_len)
 252 {
 253   char *p = buf;
 254   Bytecount len;
 255
 256   /* Copy item name first */
 257   CHECK_STRING (pgui_item->name);
 258   len = XSTRING_LENGTH (pgui_item->name);
 259   if (len > buf_len)
 260     signal_too_long_error (pgui_item->name);
 261   memcpy (p, XSTRING_DATA (pgui_item->name), len);
 262   p += len;
 263
 264   /* Add space and suffix, if there is a suffix.
 265    * If suffix is not string evaluate it */
 266   if (!NILP (pgui_item->suffix))
 267     {
 268       Lisp_Object suffix = pgui_item->suffix;
 269       /* Shortcut to avoid evaluating suffix each time */
 270       if (!STRINGP (suffix))
 271         {
 272           suffix = Feval (suffix);
 273           CHECK_STRING (suffix);
 274         }
 275
 276       len = XSTRING_LENGTH (suffix);
 277       if (p + len + 1 > buf + buf_len)
 278         signal_too_long_error (pgui_item->name);
 279       *(p++) = ' ';
 280       memcpy (p, XSTRING_DATA (suffix), len);
 281       p += len;
 282     }
 283   *p = '\0';
 284   return p - buf;
 285 }
 286
 287 /*
 288  * Format "right flush" display portion of an item into BUF, guarded by
 289  * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
 290  * null character, so actual maximum size of buffer consumed is
 291  * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
 292  * signaled.
 293  * Return value is the offset to the terminating null character into the
 294  * buffer.
 295  */
 296 unsigned int
 297 gui_item_display_flush_right (CONST struct gui_item *pgui_item,
 298                               char* buf, Bytecount buf_len)
 299 {
 300   *buf = 0;
 301
 302   /* Have keys? */
 303   if (!menubar_show_keybindings)
 304     return 0;
 305
 306   /* Try :keys first */
 307   if (!NILP (pgui_item->keys))
 308     {
 309       CHECK_STRING (pgui_item->keys);
 310       if (XSTRING_LENGTH (pgui_item->keys) > buf_len)
 311         signal_too_long_error (pgui_item->name);
 312       strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys));
 313       return XSTRING_LENGTH (pgui_item->keys);
 314     }
 315
 316   /* See if we can derive keys out of callback symbol */
 317   if (SYMBOLP (pgui_item->callback))
 318     {
 319       char buf2 [1024];
 320       Bytecount len;
 321
 322       where_is_to_char (pgui_item->callback, buf2);
 323       len = strlen (buf2);
 324       if (len > buf_len)
 325         signal_too_long_error (pgui_item->name);
 326       strcpy (buf, buf2);
 327       return len;
 328     }
 329
 330   /* No keys - no right flush display */
 331   return 0;
 332 }
 333
 334 #endif /* HAVE_POPUPS */
 335
 336 void
 337 syms_of_gui (void)
 338 {
 339   defkeyword (&Q_active,   ":active");
 340   defkeyword (&Q_suffix,   ":suffix");
 341   defkeyword (&Q_keys,     ":keys");
 342   defkeyword (&Q_key_sequence,":key-sequence");
 343   defkeyword (&Q_style,    ":style");
 344   defkeyword (&Q_selected, ":selected");
 345   defkeyword (&Q_filter,   ":filter");
 346   defkeyword (&Q_config,   ":config");
 347   defkeyword (&Q_included, ":included");
 348   defkeyword (&Q_accelerator, ":accelerator");
 349   defkeyword (&Q_label, ":label");
 350
 351   defsymbol (&Qtoggle, "toggle");
 352   defsymbol (&Qradio, "radio");
 353
 354 #ifdef HAVE_POPUPS
 355   DEFSUBR (Fpopup_up_p);
 356 #endif
 357 }
 358
 359 void
 360 vars_of_gui (void)
 361 {
 362 }