ckBind.c

   1 /*
   2  * ckBind.c --
   3  *
   4  *      This file provides procedures that associate Tcl commands
   5  *      with events or sequences of events.
   6  *
   7  * Copyright (c) 1989-1994 The Regents of the University of California.
   8  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
   9  * Copyright (c) 1995 Christian Werner
  10  *
  11  * See the file "license.terms" for information on usage and redistribution
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  */
  14
  15 #include "ckPort.h"
  16 #include "ck.h"
  17
  18 /*
  19  * The structure below represents a binding table.  A binding table
  20  * represents a domain in which event bindings may occur.  It includes
  21  * a space of objects relative to which events occur (usually windows,
  22  * but not always), a history of recent events in the domain, and
  23  * a set of mappings that associate particular Tcl commands with sequences
  24  * of events in the domain.  Multiple binding tables may exist at once,
  25  * either because there are multiple applications open, or because there
  26  * are multiple domains within an application with separate event
  27  * bindings for each (for example, each canvas widget has a separate
  28  * binding table for associating events with the items in the canvas).
  29  *
  30  * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
  31  * below 30.  To see this, consider a triple mouse button click while
  32  * the Shift key is down (and auto-repeating).  There may be as many
  33  * as 3 auto-repeat events after each mouse button press or release
  34  * (see the first large comment block within Ck_BindEvent for more on
  35  * this), for a total of 20 events to cover the three button presses
  36  * and two intervening releases.  If you reduce EVENT_BUFFER_SIZE too
  37  * much, shift multi-clicks will be lost.
  38  *
  39  */
  40
  41 #define EVENT_BUFFER_SIZE 30
  42 typedef struct BindingTable {
  43     CkEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
  44                                          * (higher indices are for more recent
  45                                          * events). */
  46     int detailRing[EVENT_BUFFER_SIZE];  /* "Detail" information (keycodes for
  47                                          * each entry in eventRing. */
  48     int curEvent;                       /* Index in eventRing of most recent
  49                                          * event.  Newer events have higher
  50                                          * indices. */
  51     Tcl_HashTable patternTable;         /* Used to map from an event to a list
  52                                          * of patterns that may match that
  53                                          * event.  Keys are PatternTableKey
  54                                          * structs, values are (PatSeq *). */
  55     Tcl_HashTable objectTable;          /* Used to map from an object to a list
  56                                          * of patterns associated with that
  57                                          * object.  Keys are ClientData,
  58                                          * values are (PatSeq *). */
  59     Tcl_Interp *interp;                 /* Interpreter in which commands are
  60                                          * executed. */
  61 } BindingTable;
  62
  63 /*
  64  * Structures of the following form are used as keys in the patternTable
  65  * for a binding table:
  66  */
  67
  68 typedef struct PatternTableKey {
  69     ClientData object;          /* Identifies object (or class of objects)
  70                                  * relative to which event occurred.  For
  71                                  * example, in the widget binding table for
  72                                  * an application this is the path name of
  73                                  * a widget, or a widget class, or "all". */
  74     int type;                   /* Type of event. */
  75     int detail;                 /* Additional information, such as
  76                                  * keycode, or 0 if nothing
  77                                  * additional.*/
  78 } PatternTableKey;
  79
  80 /*
  81  * The following structure defines a pattern, which is matched
  82  * against events as part of the process of converting events
  83  * into Tcl commands.
  84  */
  85
  86 typedef struct Pattern {
  87     int eventType;              /* Type of event. */
  88     int detail;                 /* Additional information that must
  89                                  * match event.  Normally this is 0,
  90                                  * meaning no additional information
  91                                  * must match. For keystrokes this
  92                                  * is the keycode. Keycode 0 means
  93                                  * any keystroke, keycode -1 means
  94                                  * control keystroke. */
  95 } Pattern;
  96
  97 /*
  98  * The structure below defines a pattern sequence, which consists
  99  * of one or more patterns.  In order to trigger, a pattern
 100  * sequence must match the most recent X events (first pattern
 101  * to most recent event, next pattern to next event, and so on).
 102  */
 103
 104 typedef struct PatSeq {
 105     int numPats;                /* Number of patterns in sequence
 106                                  * (usually 1). */
 107     char *command;              /* Command to invoke when this
 108                                  * pattern sequence matches (malloc-ed). */
 109     struct PatSeq *nextSeqPtr;
 110                                 /* Next in list of all pattern
 111                                  * sequences that have the same
 112                                  * initial pattern.  NULL means
 113                                  * end of list. */
 114     Tcl_HashEntry *hPtr;        /* Pointer to hash table entry for
 115                                  * the initial pattern.  This is the
 116                                  * head of the list of which nextSeqPtr
 117                                  * forms a part. */
 118     ClientData object;          /* Identifies object with which event is
 119                                  * associated (e.g. window). */
 120     struct PatSeq *nextObjPtr;
 121                                 /* Next in list of all pattern
 122                                  * sequences for the same object
 123                                  * (NULL for end of list).  Needed to
 124                                  * implement Tk_DeleteAllBindings. */
 125     Pattern pats[1];            /* Array of "numPats" patterns.  Only
 126                                  * one element is declared here but
 127                                  * in actuality enough space will be
 128                                  * allocated for "numPats" patterns.
 129                                  * To match, pats[0] must match event
 130                                  * n, pats[1] must match event n-1,
 131                                  * etc. */
 132 } PatSeq;
 133
 134 typedef struct {
 135     char *name;                         /* Name of keysym. */
 136     KeySym value;                       /* Numeric identifier for keysym. */
 137     char *tiname;                       /* Terminfo name of keysym. */
 138 } KeySymInfo;
 139 static KeySymInfo keyArray[] = {
 140 #include "ks_names.h"
 141     {(char *) NULL, 0}
 142 };
 143 static Tcl_HashTable keySymTable;       /* Hashed form of above structure. */
 144 static Tcl_HashTable revKeySymTable;    /* Ditto, reversed. */
 145
 146 static int initialized = 0;
 147
 148 /*
 149  * This module also keeps a hash table mapping from event names
 150  * to information about those events.  The structure, an array
 151  * to use to initialize the hash table, and the hash table are
 152  * all defined below.
 153  */
 154
 155 typedef struct {
 156     char *name;                 /* Name of event. */
 157     int type;                   /* Event type for X, such as
 158                                  * ButtonPress. */
 159     int eventMask;              /* Mask bits for this event type. */
 160 } EventInfo;
 161
 162 static EventInfo eventArray[] = {
 163     {"Expose",          CK_EV_EXPOSE,           CK_EV_EXPOSE},
 164     {"FocusIn",         CK_EV_FOCUSIN,          CK_EV_FOCUSIN},
 165     {"FocusOut",        CK_EV_FOCUSOUT,         CK_EV_FOCUSOUT},
 166     {"Key",             CK_EV_KEYPRESS,         CK_EV_KEYPRESS},
 167     {"KeyPress",        CK_EV_KEYPRESS,         CK_EV_KEYPRESS},
 168     {"Control",         CK_EV_KEYPRESS,         CK_EV_KEYPRESS},
 169     {"Destroy",         CK_EV_DESTROY,          CK_EV_DESTROY},
 170     {"Map",             CK_EV_MAP,              CK_EV_MAP},
 171     {"Unmap",           CK_EV_UNMAP,            CK_EV_UNMAP},
 172     {"Button",          CK_EV_MOUSE_DOWN,       CK_EV_MOUSE_DOWN},
 173     {"ButtonPress",     CK_EV_MOUSE_DOWN,       CK_EV_MOUSE_DOWN},
 174     {"ButtonRelease",   CK_EV_MOUSE_UP,         CK_EV_MOUSE_UP},
 175     {"BarCode",         CK_EV_BARCODE,          CK_EV_BARCODE},
 176     {(char *) NULL,     0,                      0}
 177 };
 178 static Tcl_HashTable eventTable;
 179
 180 /*
 181  * Prototypes for local procedures defined in this file:
 182  */
 183
 184 static void             ExpandPercents _ANSI_ARGS_((CkWindow *winPtr,
 185                             char *before, CkEvent *eventPtr, KeySym keySym,
 186                             Tcl_DString *dsPtr));
 187 static PatSeq *         FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
 188                             BindingTable *bindPtr, ClientData object,
 189                             char *eventString, int create));
 190 static char *           GetField _ANSI_ARGS_((char *p, char *copy, int size));
 191 static PatSeq *         MatchPatterns _ANSI_ARGS_((BindingTable *bindPtr,
 192                             PatSeq *psPtr));
 193 \f
 194 /*
 195  *--------------------------------------------------------------
 196  *
 197  * Ck_CreateBindingTable --
 198  *
 199  *      Set up a new domain in which event bindings may be created.
 200  *
 201  * Results:
 202  *      The return value is a token for the new table, which must
 203  *      be passed to procedures like Ck_CreateBinding.
 204  *
 205  * Side effects:
 206  *      Memory is allocated for the new table.
 207  *
 208  *--------------------------------------------------------------
 209  */
 210
 211 Ck_BindingTable
 212 Ck_CreateBindingTable(interp)
 213     Tcl_Interp *interp;         /* Interpreter to associate with the binding
 214                                  * table:  commands are executed in this
 215                                  * interpreter. */
 216 {
 217     BindingTable *bindPtr;
 218     int i;
 219
 220     /*
 221      * If this is the first time a binding table has been created,
 222      * initialize the global data structures.
 223      */
 224
 225     if (!initialized) {
 226         Tcl_HashEntry *hPtr;
 227         EventInfo *eiPtr;
 228         KeySymInfo *kPtr;
 229         int dummy;
 230
 231         Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
 232         Tcl_InitHashTable(&revKeySymTable, TCL_ONE_WORD_KEYS);
 233         for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
 234             hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
 235             Tcl_SetHashValue(hPtr, (char *) kPtr);
 236             hPtr = Tcl_CreateHashEntry(&revKeySymTable, (char *) kPtr->value,
 237                 &dummy);
 238             Tcl_SetHashValue(hPtr, (char *) kPtr);
 239         }
 240         Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
 241         for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
 242             hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
 243             Tcl_SetHashValue(hPtr, eiPtr);
 244         }
 245         initialized = 1;
 246     }
 247
 248     /*
 249      * Create and initialize a new binding table.
 250      */
 251
 252     bindPtr = (BindingTable *) ckalloc(sizeof (BindingTable));
 253     for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
 254         bindPtr->eventRing[i].type = -1;
 255     }
 256     bindPtr->curEvent = 0;
 257     Tcl_InitHashTable(&bindPtr->patternTable,
 258             sizeof(PatternTableKey)/sizeof(int));
 259     Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
 260     bindPtr->interp = interp;
 261     return (Ck_BindingTable) bindPtr;
 262 }
 263 \f
 264 /*
 265  *--------------------------------------------------------------
 266  *
 267  * Ck_DeleteBindingTable --
 268  *
 269  *      Destroy a binding table and free up all its memory.
 270  *      The caller should not use bindingTable again after
 271  *      this procedure returns.
 272  *
 273  * Results:
 274  *      None.
 275  *
 276  * Side effects:
 277  *      Memory is freed.
 278  *
 279  *--------------------------------------------------------------
 280  */
 281
 282 void
 283 Ck_DeleteBindingTable(bindingTable)
 284     Ck_BindingTable bindingTable;       /* Token for the binding table to
 285                                          * destroy. */
 286 {
 287     BindingTable *bindPtr = (BindingTable *) bindingTable;
 288     PatSeq *psPtr, *nextPtr;
 289     Tcl_HashEntry *hPtr;
 290     Tcl_HashSearch search;
 291
 292     /*
 293      * Find and delete all of the patterns associated with the binding
 294      * table.
 295      */
 296
 297     for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
 298             hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 299         for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
 300                 psPtr != NULL; psPtr = nextPtr) {
 301             nextPtr = psPtr->nextSeqPtr;
 302             ckfree((char *) psPtr->command);
 303             ckfree((char *) psPtr);
 304         }
 305     }
 306
 307     /*
 308      * Clean up the rest of the information associated with the
 309      * binding table.
 310      */
 311
 312     Tcl_DeleteHashTable(&bindPtr->patternTable);
 313     Tcl_DeleteHashTable(&bindPtr->objectTable);
 314     ckfree((char *) bindPtr);
 315 }
 316 \f
 317 /*
 318  *--------------------------------------------------------------
 319  *
 320  * Ck_CreateBinding --
 321  *
 322  *      Add a binding to a binding table, so that future calls to
 323  *      Ck_BindEvent may execute the command in the binding.
 324  *
 325  * Results:
 326  *      The return value is TCL_ERROR if an error occurred while setting
 327  *      up the binding.  In this case, an error message will be
 328  *      left in interp->result.  If all went well then the return
 329  *      value is TCL_OK.
 330  *
 331  * Side effects:
 332  *      The new binding may cause future calls to Ck_BindEvent to
 333  *      behave differently than they did previously.
 334  *
 335  *--------------------------------------------------------------
 336  */
 337
 338 int
 339 Ck_CreateBinding(interp, bindingTable, object, eventString, command, append)
 340     Tcl_Interp *interp;                 /* Used for error reporting. */
 341     Ck_BindingTable bindingTable;       /* Table in which to create binding. */
 342     ClientData object;                  /* Token for object with which binding
 343                                          * is associated. */
 344     char *eventString;                  /* String describing event sequence
 345                                          * that triggers binding. */
 346     char *command;                      /* Contains Tcl command to execute
 347                                          * when binding triggers. */
 348     int append;                         /* 0 means replace any existing
 349                                          * binding for eventString;  1 means
 350                                          * append to that binding. */
 351 {
 352     BindingTable *bindPtr = (BindingTable *) bindingTable;
 353     PatSeq *psPtr;
 354
 355     psPtr = FindSequence(interp, bindPtr, object, eventString, 1);
 356     if (psPtr == NULL)
 357         return TCL_ERROR;
 358     if (append && (psPtr->command != NULL)) {
 359         int length;
 360         char *new;
 361
 362         length = strlen(psPtr->command) + strlen(command) + 2;
 363         new = (char *) ckalloc((unsigned) length);
 364         sprintf(new, "%s\n%s", psPtr->command, command);
 365         ckfree((char *) psPtr->command);
 366         psPtr->command = new;
 367     } else {
 368         if (psPtr->command != NULL) {
 369             ckfree((char *) psPtr->command);
 370         }
 371         psPtr->command = (char *) ckalloc((unsigned) (strlen(command) + 1));
 372         strcpy(psPtr->command, command);
 373     }
 374     return TCL_OK;
 375 }
 376 \f
 377 /*
 378  *--------------------------------------------------------------
 379  *
 380  * Ck_DeleteBinding --
 381  *
 382  *      Remove an event binding from a binding table.
 383  *
 384  * Results:
 385  *      The result is a standard Tcl return value.  If an error
 386  *      occurs then interp->result will contain an error message.
 387  *
 388  * Side effects:
 389  *      The binding given by object and eventString is removed
 390  *      from bindingTable.
 391  *
 392  *--------------------------------------------------------------
 393  */
 394
 395 int
 396 Ck_DeleteBinding(interp, bindingTable, object, eventString)
 397     Tcl_Interp *interp;                 /* Used for error reporting. */
 398     Ck_BindingTable bindingTable;       /* Table in which to delete binding. */
 399     ClientData object;                  /* Token for object with which binding
 400                                          * is associated. */
 401     char *eventString;                  /* String describing event sequence
 402                                          * that triggers binding. */
 403 {
 404     BindingTable *bindPtr = (BindingTable *) bindingTable;
 405     register PatSeq *psPtr, *prevPtr;
 406     Tcl_HashEntry *hPtr;
 407
 408     psPtr = FindSequence(interp, bindPtr, object, eventString, 0);
 409     if (psPtr == NULL) {
 410         Tcl_ResetResult(interp);
 411         return TCL_OK;
 412     }
 413
 414     /*
 415      * Unlink the binding from the list for its object, then from the
 416      * list for its pattern.
 417      */
 418
 419     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
 420     if (hPtr == NULL) {
 421         panic("Ck_DeleteBinding couldn't find object table entry");
 422     }
 423     prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
 424     if (prevPtr == psPtr) {
 425         Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
 426     } else {
 427         for ( ; ; prevPtr = prevPtr->nextObjPtr) {
 428             if (prevPtr == NULL) {
 429                 panic("Ck_DeleteBinding couldn't find on object list");
 430             }
 431             if (prevPtr->nextObjPtr == psPtr) {
 432                 prevPtr->nextObjPtr = psPtr->nextObjPtr;
 433                 break;
 434             }
 435         }
 436     }
 437     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
 438     if (prevPtr == psPtr) {
 439         if (psPtr->nextSeqPtr == NULL) {
 440             Tcl_DeleteHashEntry(psPtr->hPtr);
 441         } else {
 442             Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
 443         }
 444     } else {
 445         for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
 446             if (prevPtr == NULL) {
 447                 panic("Tk_DeleteBinding couldn't find on hash chain");
 448             }
 449             if (prevPtr->nextSeqPtr == psPtr) {
 450                 prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
 451                 break;
 452             }
 453         }
 454     }
 455     ckfree((char *) psPtr->command);
 456     ckfree((char *) psPtr);
 457     return TCL_OK;
 458 }
 459 \f
 460 /*
 461  *--------------------------------------------------------------
 462  *
 463  * Ck_GetBinding --
 464  *
 465  *      Return the command associated with a given event string.
 466  *
 467  * Results:
 468  *      The return value is a pointer to the command string
 469  *      associated with eventString for object in the domain
 470  *      given by bindingTable.  If there is no binding for
 471  *      eventString, or if eventString is improperly formed,
 472  *      then NULL is returned and an error message is left in
 473  *      interp->result.  The return value is semi-static:  it
 474  *      will persist until the binding is changed or deleted.
 475  *
 476  * Side effects:
 477  *      None.
 478  *
 479  *--------------------------------------------------------------
 480  */
 481
 482 char *
 483 Ck_GetBinding(interp, bindingTable, object, eventString)
 484     Tcl_Interp *interp;                 /* Interpreter for error reporting. */
 485     Ck_BindingTable bindingTable;       /* Table in which to look for
 486                                          * binding. */
 487     ClientData object;                  /* Token for object with which binding
 488                                          * is associated. */
 489     char *eventString;                  /* String describing event sequence
 490                                          * that triggers binding. */
 491 {
 492     BindingTable *bindPtr = (BindingTable *) bindingTable;
 493     PatSeq *psPtr;
 494
 495     psPtr = FindSequence(interp, bindPtr, object, eventString, 0);
 496     if (psPtr == NULL) {
 497         return NULL;
 498     }
 499     return psPtr->command;
 500 }
 501 \f
 502 /*
 503  *--------------------------------------------------------------
 504  *
 505  * Ck_GetAllBindings --
 506  *
 507  *      Return a list of event strings for all the bindings
 508  *      associated with a given object.
 509  *
 510  * Results:
 511  *      There is no return value.  Interp->result is modified to
 512  *      hold a Tcl list with one entry for each binding associated
 513  *      with object in bindingTable.  Each entry in the list
 514  *      contains the event string associated with one binding.
 515  *
 516  * Side effects:
 517  *      None.
 518  *
 519  *--------------------------------------------------------------
 520  */
 521
 522 void
 523 Ck_GetAllBindings(interp, bindingTable, object)
 524     Tcl_Interp *interp;                 /* Interpreter returning result or
 525                                          * error. */
 526     Ck_BindingTable bindingTable;       /* Table in which to look for
 527                                          * bindings. */
 528     ClientData object;                  /* Token for object. */
 529
 530 {
 531     BindingTable *bindPtr = (BindingTable *) bindingTable;
 532     register PatSeq *psPtr;
 533     register Pattern *patPtr;
 534     Tcl_HashEntry *hPtr;
 535     Tcl_DString ds;
 536     char c, buffer[10];
 537     int patsLeft;
 538     register EventInfo *eiPtr;
 539
 540     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
 541     if (hPtr == NULL) {
 542         return;
 543     }
 544     Tcl_DStringInit(&ds);
 545     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
 546             psPtr = psPtr->nextObjPtr) {
 547         Tcl_DStringTrunc(&ds, 0);
 548
 549         /*
 550          * For each binding, output information about each of the
 551          * patterns in its sequence.  The order of the patterns in
 552          * the sequence is backwards from the order in which they
 553          * must be output.
 554          */
 555
 556         for (patsLeft = psPtr->numPats,
 557                 patPtr = &psPtr->pats[psPtr->numPats - 1];
 558                 patsLeft > 0; patsLeft--, patPtr--) {
 559
 560             /*
 561              * Check for button presses.
 562              */
 563
 564             if ((patPtr->eventType == CK_EV_MOUSE_DOWN)
 565                     && (patPtr->detail != 0)) {
 566                 sprintf(buffer, "<%d>", patPtr->detail);
 567                 Tcl_DStringAppend(&ds, buffer, -1);
 568                 continue;
 569             }
 570
 571             /*
 572              * Check for simple case of an ASCII character.
 573              */
 574
 575             if ((patPtr->eventType == CK_EV_KEYPRESS)
 576                     && (patPtr->detail < 128)
 577                     && isprint((unsigned char) patPtr->detail)
 578                     && (patPtr->detail != '<')
 579                     && (patPtr->detail != ' ')) {
 580                 c = patPtr->detail;
 581                 Tcl_DStringAppend(&ds, &c, 1);
 582                 continue;
 583             }
 584
 585             /*
 586              * It's a more general event specification.  First check
 587              * event type, then keysym or button detail.
 588              */
 589
 590             Tcl_DStringAppend(&ds, "<", 1);
 591
 592             for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
 593                 if (eiPtr->type == patPtr->eventType) {
 594                     if (patPtr->eventType == CK_EV_KEYPRESS &&
 595                         patPtr->detail == -1) {
 596                         Tcl_DStringAppend(&ds, "Control", -1);
 597                         goto endPat;
 598                     }
 599                     if (patPtr->eventType == CK_EV_KEYPRESS &&
 600                         patPtr->detail > 0 && patPtr->detail < 0x20) {
 601                         char *string;
 602
 603                         string = CkKeysymToString((KeySym) patPtr->detail, 0);
 604                         if (string == NULL) {
 605                             sprintf(buffer, "Control-%c",
 606                                 patPtr->detail + 0x40);
 607                             string = buffer;
 608                         }
 609                         Tcl_DStringAppend(&ds, string, -1);
 610                         goto endPat;
 611                     }
 612                     Tcl_DStringAppend(&ds, eiPtr->name, -1);
 613                     if (patPtr->detail != 0) {
 614                         Tcl_DStringAppend(&ds, "-", 1);
 615                     }
 616                     break;
 617                 }
 618             }
 619
 620             if (patPtr->detail != 0) {
 621                 if (patPtr->eventType == CK_EV_KEYPRESS) {
 622                     char *string;
 623
 624                     string = CkKeysymToString((KeySym) patPtr->detail, 0);
 625                     if (string != NULL) {
 626                         Tcl_DStringAppend(&ds, string, -1);
 627                     }
 628                 } else {
 629                     sprintf(buffer, "%d", patPtr->detail);
 630                     Tcl_DStringAppend(&ds, buffer, -1);
 631                 }
 632             }
 633 endPat:
 634             Tcl_DStringAppend(&ds, ">", 1);
 635         }
 636         Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
 637     }
 638     Tcl_DStringFree(&ds);
 639 }
 640 \f
 641 /*
 642  *--------------------------------------------------------------
 643  *
 644  * Ck_DeleteAllBindings --
 645  *
 646  *      Remove all bindings associated with a given object in a
 647  *      given binding table.
 648  *
 649  * Results:
 650  *      All bindings associated with object are removed from
 651  *      bindingTable.
 652  *
 653  * Side effects:
 654  *      None.
 655  *
 656  *--------------------------------------------------------------
 657  */
 658
 659 void
 660 Ck_DeleteAllBindings(bindingTable, object)
 661     Ck_BindingTable bindingTable;       /* Table in which to delete
 662                                          * bindings. */
 663     ClientData object;                  /* Token for object. */
 664 {
 665     BindingTable *bindPtr = (BindingTable *) bindingTable;
 666     PatSeq *psPtr, *prevPtr;
 667     PatSeq *nextPtr;
 668     Tcl_HashEntry *hPtr;
 669
 670     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
 671     if (hPtr == NULL) {
 672         return;
 673     }
 674     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
 675             psPtr = nextPtr) {
 676         nextPtr  = psPtr->nextObjPtr;
 677
 678         /*
 679          * Be sure to remove each binding from its hash chain in the
 680          * pattern table.  If this is the last pattern in the chain,
 681          * then delete the hash entry too.
 682          */
 683
 684         prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
 685         if (prevPtr == psPtr) {
 686             if (psPtr->nextSeqPtr == NULL) {
 687                 Tcl_DeleteHashEntry(psPtr->hPtr);
 688             } else {
 689                 Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
 690             }
 691         } else {
 692             for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
 693                 if (prevPtr == NULL) {
 694                     panic("Ck_DeleteAllBindings couldn't find on hash chain");
 695                 }
 696                 if (prevPtr->nextSeqPtr == psPtr) {
 697                     prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
 698                     break;
 699                 }
 700             }
 701         }
 702         ckfree((char *) psPtr->command);
 703         ckfree((char *) psPtr);
 704     }
 705     Tcl_DeleteHashEntry(hPtr);
 706 }
 707 \f
 708 /*
 709  *--------------------------------------------------------------
 710  *
 711  * Ck_BindEvent --
 712  *
 713  *      This procedure is invoked to process an event.  The
 714  *      event is added to those recorded for the binding table.
 715  *      Then each of the objects at *objectPtr is checked in
 716  *      order to see if it has a binding that matches the recent
 717  *      events.  If so, that binding is invoked and the rest of
 718  *      objects are skipped.
 719  *
 720  * Results:
 721  *      None.
 722  *
 723  * Side effects:
 724  *      Depends on the command associated with the matching
 725  *      binding.
 726  *
 727  *--------------------------------------------------------------
 728  */
 729
 730 void
 731 Ck_BindEvent(bindingTable, eventPtr, winPtr, numObjects, objectPtr)
 732     Ck_BindingTable bindingTable;       /* Table in which to look for
 733                                          * bindings. */
 734     CkEvent *eventPtr;                  /* What actually happened. */
 735     CkWindow *winPtr;                   /* Window where event occurred. */
 736     int numObjects;                     /* Number of objects at *objectPtr. */
 737     ClientData *objectPtr;              /* Array of one or more objects
 738                                          * to check for a matching binding. */
 739 {
 740     BindingTable *bindPtr = (BindingTable *) bindingTable;
 741     CkMainInfo *mainPtr;
 742     CkEvent *ringPtr;
 743     PatSeq *matchPtr;
 744     PatternTableKey key;
 745     Tcl_HashEntry *hPtr;
 746     int detail, code;
 747     Tcl_Interp *interp;
 748     Tcl_DString scripts, savedResult;
 749     char *p, *end;
 750
 751     /*
 752      * Add the new event to the ring of saved events for the
 753      * binding table.
 754      */
 755
 756     bindPtr->curEvent++;
 757     if (bindPtr->curEvent >= EVENT_BUFFER_SIZE)
 758         bindPtr->curEvent = 0;
 759     ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
 760     memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof (CkEvent));
 761     detail = 0;
 762     bindPtr->detailRing[bindPtr->curEvent] = 0;
 763     if (ringPtr->type == CK_EV_KEYPRESS)
 764         detail = ringPtr->key.keycode;
 765     else if (ringPtr->type == CK_EV_MOUSE_DOWN ||
 766         ringPtr->type == CK_EV_MOUSE_UP)
 767         detail = ringPtr->mouse.button;
 768     bindPtr->detailRing[bindPtr->curEvent] = detail;
 769
 770     /*
 771      * Loop over all the objects, finding the binding script for each
 772      * one.  Append all of the binding scripts, with %-sequences expanded,
 773      * to "scripts", with null characters separating the scripts for
 774      * each object.
 775      */
 776
 777     Tcl_DStringInit(&scripts);
 778     for ( ; numObjects > 0; numObjects--, objectPtr++) {
 779
 780         /*
 781          * Match the new event against those recorded in the
 782          * pattern table, saving the longest matching pattern.
 783          * For events with details (key events) first
 784          * look for a binding for the specific key or button.
 785          * If none is found, then look for a binding for all
 786          * control-keys (detail of -1, if the keycode is a control
 787          * character), else look for a binding for all keys
 788          * (detail of 0).
 789          */
 790
 791         matchPtr = NULL;
 792         key.object = *objectPtr;
 793         key.type = ringPtr->type;
 794         key.detail = detail;
 795         hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
 796         if (hPtr != NULL) {
 797             matchPtr = MatchPatterns(bindPtr,
 798                     (PatSeq *) Tcl_GetHashValue(hPtr));
 799         }
 800         if (ringPtr->type == CK_EV_KEYPRESS && detail > 0 && detail < 0x20 &&
 801             matchPtr == NULL) {
 802             key.detail = -1;
 803             hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
 804             if (hPtr != NULL) {
 805                 matchPtr = MatchPatterns(bindPtr,
 806                         (PatSeq *) Tcl_GetHashValue(hPtr));
 807             }
 808         }
 809         if (detail != 0 && matchPtr == NULL) {
 810             key.detail = 0;
 811             hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
 812             if (hPtr != NULL) {
 813                 matchPtr = MatchPatterns(bindPtr,
 814                         (PatSeq *) Tcl_GetHashValue(hPtr));
 815             }
 816         }
 817
 818         if (matchPtr != NULL) {
 819             ExpandPercents(winPtr, matchPtr->command, eventPtr,
 820                     (KeySym) detail, &scripts);
 821             Tcl_DStringAppend(&scripts, "", 1);
 822         }
 823     }
 824
 825     /*
 826      * Now go back through and evaluate the script for each object,
 827      * in order, dealing with "break" and "continue" exceptions
 828      * appropriately.
 829      *
 830      * There are two tricks here:
 831      * 1. Bindings can be invoked from in the middle of Tcl commands,
 832      *    where interp->result is significant (for example, a widget
 833      *    might be deleted because of an error in creating it, so the
 834      *    result contains an error message that is eventually going to
 835      *    be returned by the creating command).  To preserve the result,
 836      *    we save it in a dynamic string.
 837      * 2. The binding's action can potentially delete the binding,
 838      *    so bindPtr may not point to anything valid once the action
 839      *    completes.  Thus we have to save bindPtr->interp in a
 840      *    local variable in order to restore the result.
 841      * 3. When the screen changes, must invoke a Tcl script to update
 842      *    Tcl level information such as tkPriv.
 843      */
 844
 845     mainPtr = winPtr->mainPtr;
 846     interp = bindPtr->interp;
 847     Tcl_DStringInit(&savedResult);
 848     Tcl_DStringGetResult(interp, &savedResult);
 849     p = Tcl_DStringValue(&scripts);
 850     end = p + Tcl_DStringLength(&scripts);
 851     while (p != end) {
 852         Tcl_AllowExceptions(interp);
 853         code = Tcl_GlobalEval(interp, p);
 854         if (code != TCL_OK) {
 855             if (code == TCL_CONTINUE) {
 856                 /*
 857                  * Do nothing:  just go on to the next script.
 858                  */
 859             } else if (code == TCL_BREAK) {
 860                 break;
 861             } else {
 862                 Tcl_AddErrorInfo(interp, "\n    (command bound to event)");
 863                 Tk_BackgroundError(interp);
 864                 break;
 865             }
 866         }
 867
 868         /*
 869          * Skip over the current script and its terminating null character.
 870          */
 871
 872         while (*p != 0) {
 873             p++;
 874         }
 875         p++;
 876     }
 877     Tcl_DStringResult(interp, &savedResult);
 878     Tcl_DStringFree(&scripts);
 879 }
 880 \f
 881 /*
 882  *----------------------------------------------------------------------
 883  *
 884  * FindSequence --
 885  *
 886  *      Find the entry in a binding table that corresponds to a
 887  *      particular pattern string, and return a pointer to that
 888  *      entry.
 889  *
 890  * Results:
 891  *      The return value is normally a pointer to the PatSeq
 892  *      in patternTable that corresponds to eventString.  If an error
 893  *      was found while parsing eventString, or if "create" is 0 and
 894  *      no pattern sequence previously existed, then NULL is returned
 895  *      and interp->result contains a message describing the problem.
 896  *      If no pattern sequence previously existed for eventString, then
 897  *      a new one is created with a NULL command field.  In a successful
 898  *      return, *maskPtr is filled in with a mask of the event types
 899  *      on which the pattern sequence depends.
 900  *
 901  * Side effects:
 902  *      A new pattern sequence may be created.
 903  *
 904  *----------------------------------------------------------------------
 905  */
 906
 907 static PatSeq *
 908 FindSequence(interp, bindPtr, object, eventString, create)
 909     Tcl_Interp *interp;         /* Interpreter to use for error
 910                                  * reporting. */
 911     BindingTable *bindPtr;      /* Table to use for lookup. */
 912     ClientData object;          /* Token for object(s) with which binding
 913                                  * is associated. */
 914     char *eventString;          /* String description of pattern to
 915                                  * match on.  See user documentation
 916                                  * for details. */
 917     int create;                 /* 0 means don't create the entry if
 918                                  * it doesn't already exist.   Non-zero
 919                                  * means create. */
 920
 921 {
 922     Pattern pats[EVENT_BUFFER_SIZE];
 923     int numPats, isCtrl;
 924     register char *p;
 925     register Pattern *patPtr;
 926     register PatSeq *psPtr;
 927     register Tcl_HashEntry *hPtr;
 928 #define FIELD_SIZE 48
 929     char field[FIELD_SIZE];
 930     int new;
 931     size_t sequenceSize;
 932     unsigned long eventMask;
 933     PatternTableKey key;
 934
 935     /*
 936      *-------------------------------------------------------------
 937      * Step 1: parse the pattern string to produce an array
 938      * of Patterns.  The array is generated backwards, so
 939      * that the lowest-indexed pattern corresponds to the last
 940      * event that must occur.
 941      *-------------------------------------------------------------
 942      */
 943
 944     p = eventString;
 945     eventMask = 0;
 946     for (numPats = 0, patPtr = &pats[EVENT_BUFFER_SIZE-1];
 947             numPats < EVENT_BUFFER_SIZE;
 948             numPats++, patPtr--) {
 949         patPtr->eventType = -1;
 950         patPtr->detail = 0;
 951         while (isspace((unsigned char) *p)) {
 952             p++;
 953         }
 954         if (*p == '\0') {
 955             break;
 956         }
 957
 958         /*
 959          * Handle simple ASCII characters.
 960          */
 961
 962         if (*p != '<') {
 963             char string[2];
 964
 965             patPtr->eventType = CK_EV_KEYPRESS;
 966             string[0] = *p;
 967             string[1] = 0;
 968             patPtr->detail = CkStringToKeysym(string);
 969             if (patPtr->detail == NoSymbol) {
 970                 if (isprint((unsigned char) *p)) {
 971                     patPtr->detail = *p;
 972                 } else {
 973                     sprintf(interp->result,
 974                             "bad ASCII character 0x%x", (unsigned char) *p);
 975                     return NULL;
 976                 }
 977             }
 978             p++;
 979             continue;
 980         }
 981
 982         p++;
 983
 984         /*
 985          * Abbrevated button press event.
 986          */
 987
 988         if (isdigit((unsigned char) *p) && p[1] == '>') {
 989             register EventInfo *eiPtr;
 990
 991             hPtr = Tcl_FindHashEntry(&eventTable, "ButtonPress");
 992             eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
 993             patPtr->eventType = eiPtr->type;
 994             eventMask |= eiPtr->eventMask;
 995             patPtr->detail = *p - '0';
 996             p += 2;
 997             continue;
 998         }
 999
1000         /*
1001          * A fancier event description.  Must consist of
1002          * 1. open angle bracket.
1003          * 2. optional event name.
1004          * 3. an option keysym name.  Either this or
1005          *    item 2 *must* be present;  if both are present
1006          *    then they are separated by spaces or dashes.
1007          * 4. a close angle bracket.
1008          */
1009
1010         isCtrl = 0;
1011         p = GetField(p, field, FIELD_SIZE);
1012         hPtr = Tcl_FindHashEntry(&eventTable, field);
1013         if (hPtr != NULL) {
1014             register EventInfo *eiPtr;
1015
1016             eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
1017             patPtr->eventType = eiPtr->type;
1018             eventMask |= eiPtr->eventMask;
1019             isCtrl = strcmp(eiPtr->name, "Control") == 0;
1020             if (isCtrl) {
1021                 patPtr->detail = -1;
1022             }
1023             while ((*p == '-') || isspace((unsigned char) *p)) {
1024                 p++;
1025             }
1026             p = GetField(p, field, FIELD_SIZE);
1027         }
1028         if (*field != '\0') {
1029             if (patPtr->eventType == CK_EV_MOUSE_DOWN ||
1030                 patPtr->eventType == CK_EV_MOUSE_UP) {
1031                 if (!isdigit((unsigned char) *field) && field[1] != '\0') {
1032                     Tcl_AppendResult(interp, "bad mouse button \"",
1033                         field, "\"", (char *) NULL);
1034                     return NULL;
1035                 }
1036                 patPtr->detail = field[0] - '0';
1037                 goto closeAngle;
1038             }
1039
1040             patPtr->detail = CkStringToKeysym(field);
1041             if (patPtr->detail == NoSymbol) {
1042 badKeySym:
1043                 Tcl_AppendResult(interp, "bad event type or keysym \"",
1044                         field, "\"", (char *) NULL);
1045                 return NULL;
1046             } else if (patPtr->eventType == CK_EV_KEYPRESS && isCtrl) {
1047                 patPtr->detail -= 0x40;
1048                 if (patPtr->detail >= 0x20)
1049                     patPtr->detail -= 0x20;
1050                 if (patPtr->detail < 0 || patPtr->detail >= 0x20)
1051                     goto badKeySym;
1052             }
1053             if (patPtr->eventType == -1) {
1054                 patPtr->eventType = CK_EV_KEYPRESS;
1055             } else if (patPtr->eventType != CK_EV_KEYPRESS) {
1056                 Tcl_AppendResult(interp, "specified keysym \"", field,
1057                         "\" for non-key event", (char *) NULL);
1058                 return NULL;
1059             }
1060         } else if (patPtr->eventType == -1) {
1061             interp->result = "no event type or keysym";
1062             return NULL;
1063         }
1064         while ((*p == '-') || isspace((unsigned char) *p)) {
1065             p++;
1066         }
1067 closeAngle:
1068         if (*p != '>') {
1069             interp->result = "missing \">\" in binding";
1070             return NULL;
1071         }
1072         p++;
1073
1074     }
1075
1076     /*
1077      *-------------------------------------------------------------
1078      * Step 2: find the sequence in the binding table if it exists,
1079      * and add a new sequence to the table if it doesn't.
1080      *-------------------------------------------------------------
1081      */
1082
1083     if (numPats == 0) {
1084         interp->result = "no events specified in binding";
1085         return NULL;
1086     }
1087     patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
1088     key.object = object;
1089     key.type = patPtr->eventType;
1090     key.detail = patPtr->detail;
1091     hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (char *) &key, &new);
1092     sequenceSize = numPats*sizeof(Pattern);
1093     if (!new) {
1094         for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
1095                 psPtr = psPtr->nextSeqPtr) {
1096             if ((numPats == psPtr->numPats)
1097                     && (memcmp((char *) patPtr, (char *) psPtr->pats,
1098                     sequenceSize) == 0)) {
1099                 goto done;
1100             }
1101         }
1102     }
1103     if (!create) {
1104         if (new) {
1105             Tcl_DeleteHashEntry(hPtr);
1106         }
1107         Tcl_AppendResult(interp, "no binding exists for \"",
1108                 eventString, "\"", (char *) NULL);
1109         return NULL;
1110     }
1111     psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
1112             + (numPats-1)*sizeof(Pattern)));
1113     psPtr->numPats = numPats;
1114     psPtr->command = NULL;
1115     psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
1116     psPtr->hPtr = hPtr;
1117     Tcl_SetHashValue(hPtr, psPtr);
1118
1119     /*
1120      * Link the pattern into the list associated with the object.
1121      */
1122
1123     psPtr->object = object;
1124     hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new);
1125     if (new) {
1126         psPtr->nextObjPtr = NULL;
1127     } else {
1128         psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
1129     }
1130     Tcl_SetHashValue(hPtr, psPtr);
1131
1132     memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
1133
1134 done:
1135     return psPtr;
1136 }
1137 \f
1138 /*
1139  *----------------------------------------------------------------------
1140  *
1141  * GetField --
1142  *
1143  *      Used to parse pattern descriptions.  Copies up to
1144  *      size characters from p to copy, stopping at end of
1145  *      string, space, "-", ">", or whenever size is
1146  *      exceeded.
1147  *
1148  * Results:
1149  *      The return value is a pointer to the character just
1150  *      after the last one copied (usually "-" or space or
1151  *      ">", but could be anything if size was exceeded).
1152  *      Also places NULL-terminated string (up to size
1153  *      character, including NULL), at copy.
1154  *
1155  * Side effects:
1156  *      None.
1157  *
1158  *----------------------------------------------------------------------
1159  */
1160
1161 static char *
1162 GetField(p, copy, size)
1163     register char *p;           /* Pointer to part of pattern. */
1164     register char *copy;        /* Place to copy field. */
1165     int size;                   /* Maximum number of characters to
1166                                  * copy. */
1167 {
1168     while ((*p != '\0') && !isspace((unsigned char) *p) && (*p != '>')
1169             && (*p != '-') && (size > 1)) {
1170         *copy = *p;
1171         p++;
1172         copy++;
1173         size--;
1174     }
1175     *copy = '\0';
1176     return p;
1177 }
1178 \f
1179 /*
1180  *----------------------------------------------------------------------
1181  *
1182  * MatchPatterns --
1183  *
1184  *      Given a list of pattern sequences and a list of
1185  *      recent events, return a pattern sequence that matches
1186  *      the event list.
1187  *
1188  * Results:
1189  *      The return value is NULL if no pattern matches the
1190  *      recent events from bindPtr.  If one or more patterns
1191  *      matches, then the longest (or most specific) matching
1192  *      pattern is returned.
1193  *
1194  * Side effects:
1195  *      None.
1196  *
1197  *----------------------------------------------------------------------
1198  */
1199
1200 static PatSeq *
1201 MatchPatterns(bindPtr, psPtr)
1202     BindingTable *bindPtr;      /* Information about binding table, such
1203                                  * as ring of recent events. */
1204     register PatSeq *psPtr;     /* List of pattern sequences. */
1205 {
1206     register PatSeq *bestPtr = NULL;
1207
1208     /*
1209      * Iterate over all the pattern sequences.
1210      */
1211
1212     for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
1213         register CkEvent *eventPtr;
1214         register Pattern *patPtr;
1215         CkWindow *winPtr;
1216         int *detailPtr;
1217         int patCount, ringCount;
1218
1219         /*
1220          * Iterate over all the patterns in a sequence to be
1221          * sure that they all match.
1222          */
1223
1224         eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
1225         detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
1226         winPtr = eventPtr->any.winPtr;
1227         patPtr = psPtr->pats;
1228         patCount = psPtr->numPats;
1229         ringCount = EVENT_BUFFER_SIZE;
1230         while (patCount > 0) {
1231             if (ringCount <= 0) {
1232                 goto nextSequence;
1233             }
1234             if (eventPtr->any.type != patPtr->eventType) {
1235                 if (patPtr->eventType == CK_EV_KEYPRESS)
1236                     goto nextEvent;
1237             }
1238             if (eventPtr->any.winPtr != winPtr)
1239                 goto nextSequence;
1240
1241             /*
1242              * Note: it's important for the keysym check to go before
1243              * the modifier check, so we can ignore unwanted modifier
1244              * keys before choking on the modifier check.
1245              */
1246
1247             if ((patPtr->detail != 0) && (patPtr->detail != -1)
1248                     && (patPtr->detail != *detailPtr))
1249                 goto nextSequence;
1250
1251             if ((patPtr->detail == -1) && (*detailPtr >= 0x20))
1252                 goto nextSequence;
1253
1254             patPtr++;
1255             patCount--;
1256             nextEvent:
1257             if (eventPtr == bindPtr->eventRing) {
1258                 eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
1259                 detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
1260             } else {
1261                 eventPtr--;
1262                 detailPtr--;
1263             }
1264             ringCount--;
1265         }
1266
1267         /*
1268          * This sequence matches.  If we've already got another match,
1269          * pick whichever is most specific.
1270          */
1271
1272         if (bestPtr != NULL) {
1273             register Pattern *patPtr2;
1274             int i;
1275
1276             if (psPtr->numPats != bestPtr->numPats) {
1277                 if (bestPtr->numPats > psPtr->numPats) {
1278                     goto nextSequence;
1279                 } else {
1280                     goto newBest;
1281                 }
1282             }
1283             for (i = 0, patPtr = psPtr->pats, patPtr2 = bestPtr->pats;
1284                     i < psPtr->numPats; i++, patPtr++, patPtr2++) {
1285                 if (patPtr->detail != patPtr2->detail) {
1286                     if (patPtr->detail == -1 && patPtr2->detail == 0) {
1287                         goto newBest;
1288                     } else if (patPtr->detail == 0 || patPtr->detail == -1) {
1289                         goto nextSequence;
1290                     } else {
1291                         goto newBest;
1292                     }
1293                 }
1294             }
1295             goto nextSequence;  /* Tie goes to newest pattern. */
1296         }
1297         newBest:
1298         bestPtr = psPtr;
1299
1300         nextSequence: continue;
1301     }
1302     return bestPtr;
1303 }
1304 \f
1305 /*
1306  *--------------------------------------------------------------
1307  *
1308  * ExpandPercents --
1309  *
1310  *      Given a command and an event, produce a new command
1311  *      by replacing % constructs in the original command
1312  *      with information from the X event.
1313  *
1314  * Results:
1315  *      The new expanded command is appended to the dynamic string
1316  *      given by dsPtr.
1317  *
1318  * Side effects:
1319  *      None.
1320  *
1321  *--------------------------------------------------------------
1322  */
1323
1324 static void
1325 ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
1326     CkWindow *winPtr;           /* Window where event occurred:  needed to
1327                                  * get input context. */
1328     register char *before;      /* Command containing percent
1329                                  * expressions to be replaced. */
1330     register CkEvent *eventPtr; /* Event containing information
1331                                  * to be used in % replacements. */
1332     KeySym keySym;              /* KeySym: only relevant for
1333                                  * CK_EV_KEYPRESS events). */
1334     Tcl_DString *dsPtr;         /* Dynamic string in which to append
1335                                  * new command. */
1336 {
1337     int spaceNeeded, cvtFlags;  /* Used to substitute string as proper Tcl
1338                                  * list element. */
1339     int number;
1340 #define NUM_SIZE 40
1341     char *string, *string2;
1342     char numStorage[NUM_SIZE+1];
1343
1344     while (1) {
1345         /*
1346          * Find everything up to the next % character and append it
1347          * to the result string.
1348          */
1349
1350         for (string = before; (*string != 0) && (*string != '%'); string++) {
1351             /* Empty loop body. */
1352         }
1353         if (string != before) {
1354             Tcl_DStringAppend(dsPtr, before, string-before);
1355             before = string;
1356         }
1357         if (*before == 0) {
1358             break;
1359         }
1360
1361         /*
1362          * There's a percent sequence here.  Process it.
1363          */
1364
1365         number = 0;
1366         string = "??";
1367         switch (before[1]) {
1368             case 'k':
1369                 number = eventPtr->key.keycode;
1370                 goto doNumber;
1371             case 'A':
1372                 if (eventPtr->type == CK_EV_KEYPRESS) {
1373                     int numChars = 0;
1374
1375                     if ((eventPtr->key.keycode & ~0xff) == 0 &&
1376                         eventPtr->key.keycode != 0) {
1377 #if CK_USE_UTF
1378                         char c = eventPtr->key.keycode;
1379                         int numc = 0;
1380
1381                         Tcl_ExternalToUtf(NULL, winPtr->mainPtr->isoEncoding,
1382                                           &c, 1, 0, NULL,
1383                                           numStorage + numChars,
1384                                           sizeof (numStorage) - numChars,
1385                                           NULL, &numc, NULL);
1386                         numChars += numc;
1387 #else
1388                         numStorage[numChars++] = eventPtr->key.keycode;
1389 #endif
1390                     }
1391                     numStorage[numChars] = '\0';
1392                     string = numStorage;
1393                 } else if (eventPtr->type == CK_EV_BARCODE) {
1394                     string = CkGetBarcodeData(winPtr->mainPtr);
1395                     if (string == NULL) {
1396                         numStorage[0] = '\0';
1397                         string = numStorage;
1398                     }
1399                 }
1400                 goto doString;
1401             case 'K':
1402                 if (eventPtr->type == CK_EV_KEYPRESS) {
1403                     char *name;
1404
1405                     name = CkKeysymToString(keySym, 1);
1406                     if (name != NULL) {
1407                         string = name;
1408                     }
1409                 }
1410                 goto doString;
1411             case 'N':
1412                 number = (int) keySym;
1413                 goto doNumber;
1414             case 'W':
1415                 if (Tcl_FindHashEntry(&winPtr->mainPtr->winTable,
1416                     (char *) eventPtr->any.winPtr) != NULL) {
1417                     string = eventPtr->any.winPtr->pathName;
1418                 } else {
1419                     string = "??";
1420                 }
1421                 goto doString;
1422             case 'x':
1423                 if (eventPtr->type == CK_EV_MOUSE_UP ||
1424                     eventPtr->type == CK_EV_MOUSE_DOWN) {
1425                     number = eventPtr->mouse.x;
1426                 }
1427                 goto doNumber;
1428             case 'y':
1429                 if (eventPtr->type == CK_EV_MOUSE_UP ||
1430                     eventPtr->type == CK_EV_MOUSE_DOWN) {
1431                     number = eventPtr->mouse.y;
1432                 }
1433                 goto doNumber;
1434             case 'b':
1435                 if (eventPtr->type == CK_EV_MOUSE_UP ||
1436                     eventPtr->type == CK_EV_MOUSE_DOWN) {
1437                     number = eventPtr->mouse.button;
1438                 }
1439                 goto doNumber;
1440             case 'X':
1441                 if (eventPtr->type == CK_EV_MOUSE_UP ||
1442                     eventPtr->type == CK_EV_MOUSE_DOWN) {
1443                     number = eventPtr->mouse.rootx;
1444                 }
1445                 goto doNumber;
1446             case 'Y':
1447                 if (eventPtr->type == CK_EV_MOUSE_UP ||
1448                     eventPtr->type == CK_EV_MOUSE_DOWN) {
1449                     number = eventPtr->mouse.rooty;
1450                 }
1451                 goto doNumber;
1452             default:
1453                 numStorage[0] = before[1];
1454                 numStorage[1] = '\0';
1455                 string = numStorage;
1456                 goto doString;
1457         }
1458
1459         doNumber:
1460         sprintf(numStorage, "%d", number);
1461         string = numStorage;
1462
1463         doString:
1464         spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
1465         string2 = ckalloc(spaceNeeded + 1);
1466         spaceNeeded = Tcl_ConvertElement(string, string2,
1467                 cvtFlags | TCL_DONT_USE_BRACES);
1468         Tcl_DStringAppend(dsPtr, string2, -1);
1469         ckfree((char *) string2);
1470         before += 2;
1471     }
1472 }
1473 \f
1474 /*
1475  *----------------------------------------------------------------------
1476  *
1477  * CkStringToKeysym --
1478  *
1479  *      This procedure finds the keysym associated with a given keysym
1480  *      name.
1481  *
1482  * Results:
1483  *      The return value is the keysym that corresponds to name, or
1484  *      NoSymbol if there is no such keysym.
1485  *
1486  * Side effects:
1487  *      None.
1488  *
1489  *----------------------------------------------------------------------
1490  */
1491
1492 KeySym
1493 CkStringToKeysym(name)
1494     char *name;                 /* Name of a keysym. */
1495 {
1496     Tcl_HashEntry *hPtr;
1497
1498     hPtr = Tcl_FindHashEntry(&keySymTable, name);
1499     if (hPtr != NULL) {
1500         return ((KeySymInfo *) Tcl_GetHashValue(hPtr))->value;
1501     }
1502     return NoSymbol;
1503 }
1504 \f
1505 /*
1506  *----------------------------------------------------------------------
1507  *
1508  * CkKeysymToString --
1509  *
1510  *      This procedure finds the keysym name associated with a given
1511  *      keysym.
1512  *
1513  * Results:
1514  *      The return value is the keysym name that corresponds to name,
1515  *      or NoSymbol if there is no name.
1516  *
1517  * Side effects:
1518  *      None.
1519  *
1520  *----------------------------------------------------------------------
1521  */
1522
1523 char *
1524 CkKeysymToString(keySym, printControl)
1525     KeySym keySym;
1526     int printControl;
1527 {
1528     Tcl_HashEntry *hPtr;
1529     static char buffer[64];
1530
1531     hPtr = Tcl_FindHashEntry(&revKeySymTable, (char *) keySym);
1532     if (hPtr != NULL) {
1533         return ((KeySymInfo *) Tcl_GetHashValue(hPtr))->name;
1534     }
1535     if (printControl && keySym >= 0x00 && keySym < 0x20) {
1536         keySym += 0x40;
1537         sprintf(buffer, "Control-%c", keySym);
1538         return buffer;
1539     }
1540     return printControl ? "NoSymbol" : NULL;
1541 }
1542 \f
1543 /*
1544  *----------------------------------------------------------------------
1545  *
1546  * CkTermHasKey --
1547  *
1548  *      This procedure checks if the terminal has a key for given keysym.
1549  *
1550  * Results:
1551  *      TCL_OK or TCL_ERROR, a string is left in interp->result.
1552  *
1553  * Side effects:
1554  *      None.
1555  *
1556  *----------------------------------------------------------------------
1557  */
1558
1559 int
1560 CkTermHasKey(interp, name)
1561     Tcl_Interp *interp;         /* Interpreter used for result. */
1562     char *name;                 /* Name of a keysym. */
1563 {
1564 #if !defined(__WIN32__) && !defined(DJGPP)
1565     Tcl_HashEntry *hPtr;
1566     char *tiname, *tivalue;
1567     extern char *tigetstr();
1568 #endif
1569     char buf[8];
1570
1571     if (strncmp("Control-", name, 8) == 0) {
1572         if (sscanf(name, "Control-%7s", buf) != 1 || strlen(buf) != 1)
1573             goto error;
1574         if (buf[0] < 'A' && buf[0] > 'z')
1575             goto error;
1576         interp->result = "1";
1577         return TCL_OK;
1578     }
1579 #if defined(__WIN32__) || defined(DJGPP)
1580     interp->result = "1";
1581     return TCL_OK;
1582 #else
1583     hPtr = Tcl_FindHashEntry(&keySymTable, name);
1584     if (hPtr != NULL) {
1585 tifind:
1586         tiname = ((KeySymInfo *) Tcl_GetHashValue(hPtr))->tiname;
1587         if (tiname == NULL || ((tivalue = tigetstr(tiname)) != NULL &&
1588             tivalue != (char *) -1))
1589             interp->result = "1";
1590         else
1591             interp->result = "0";
1592         return TCL_OK;
1593     }
1594     if (strlen(name) == 1) {
1595         if (name[0] > 0x01 && name[0] < ' ') {
1596             interp->result = "1";
1597             return TCL_OK;
1598         }
1599         hPtr = Tcl_FindHashEntry(&revKeySymTable, (char *)
1600             ((int) ((unsigned char) name[0])));
1601         if (hPtr != NULL)
1602             goto tifind;
1603     }
1604 #endif
1605 error:
1606     Tcl_AppendResult(interp, "invalid key symbol \"", name,
1607         "\"", (char *) NULL);
1608     return TCL_ERROR;
1609 }
1610 \f
1611 /*
1612  *----------------------------------------------------------------------
1613  *
1614  * CkAllKeyNames --
1615  *
1616  *      This procedure returns a list of all key names.
1617  *
1618  * Results:
1619  *      Always TCL_OK and list in interp->result.
1620  *
1621  * Side effects:
1622  *      None.
1623  *
1624  *----------------------------------------------------------------------
1625  */
1626
1627 int
1628 CkAllKeyNames(interp)
1629     Tcl_Interp *interp;         /* Interpreter used for result. */
1630 {
1631     KeySymInfo *kPtr;
1632     int i;
1633
1634     for (i = 0x01; i < ' '; i++) {
1635         unsigned code;
1636         char buf[16];
1637
1638         code = i + 'A' - 1;
1639         sprintf(buf, "Control-%c", tolower(code));
1640         Tcl_AppendElement(interp, buf);
1641     }
1642     for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
1643         Tcl_AppendElement(interp, kPtr->name);
1644     }
1645     return TCL_OK;
1646 }