util/src/TclTk/blt2.5/generic/bltDebug.c

   1
   2 /*
   3  * bltDebug.c --
   4  *
   5  * Copyright 1993-1998 Lucent Technologies, Inc.
   6  *
   7  * Permission to use, copy, modify, and distribute this software and
   8  * its documentation for any purpose and without fee is hereby
   9  * granted, provided that the above copyright notice appear in all
  10  * copies and that both that the copyright notice and warranty
  11  * disclaimer appear in supporting documentation, and that the names
  12  * of Lucent Technologies any of their entities not be used in
  13  * advertising or publicity pertaining to distribution of the software
  14  * without specific, written prior permission.
  15  *
  16  * Lucent Technologies disclaims all warranties with regard to this
  17  * software, including all implied warranties of merchantability and
  18  * fitness.  In no event shall Lucent Technologies be liable for any
  19  * special, indirect or consequential damages or any damages
  20  * whatsoever resulting from loss of use, data or profits, whether in
  21  * an action of contract, negligence or other tortuous action, arising
  22  * out of or in connection with the use or performance of this
  23  * software.
  24  */
  25
  26 #include "bltInt.h"
  27
  28 #ifndef NO_BLTDEBUG
  29
  30 #ifdef TIME_WITH_SYS_TIME
  31 #include <sys/time.h>
  32 #include <time.h>
  33 #else
  34 #ifdef HAVE_SYS_TIME_H
  35 #include <sys/time.h>
  36 #else
  37 #include <time.h>
  38 #endif /* HAVE_SYS_TIME_H */
  39 #endif /* TIME_WITH_SYS_TIME */
  40
  41 #include "bltChain.h"
  42 static Blt_Chain watchChain;
  43
  44 static Tcl_CmdTraceProc DebugProc;
  45 static Tcl_CmdProc DebugCmd;
  46
  47 typedef struct {
  48     char *pattern;
  49     char *name;
  50 } WatchInfo;
  51
  52 static WatchInfo *
  53 GetWatch(name)
  54     char *name;
  55 {
  56     Blt_ChainLink *linkPtr;
  57     char c;
  58     WatchInfo *infoPtr;
  59
  60     c = name[0];
  61     for (linkPtr = Blt_ChainFirstLink(&watchChain); linkPtr != NULL;
  62         linkPtr = Blt_ChainNextLink(linkPtr)) {
  63         infoPtr = Blt_ChainGetValue(linkPtr);
  64         if ((infoPtr->name[0] == c) && (strcmp(name, infoPtr->name) == 0)) {
  65             return infoPtr;
  66         }
  67     }
  68     linkPtr = Blt_ChainAllocLink(sizeof(WatchInfo));
  69     infoPtr = Blt_ChainGetValue(linkPtr);
  70     infoPtr->name = Blt_Strdup(name);
  71     Blt_ChainLinkAfter(&watchChain, linkPtr, (Blt_ChainLink *)NULL);
  72     return infoPtr;
  73 }
  74
  75 static void
  76 DeleteWatch(watchName)
  77     char *watchName;
  78 {
  79     Blt_ChainLink *linkPtr;
  80     char c;
  81     WatchInfo *infoPtr;
  82
  83     c = watchName[0];
  84     for (linkPtr = Blt_ChainFirstLink(&watchChain); linkPtr != NULL;
  85         linkPtr = Blt_ChainNextLink(linkPtr)) {
  86         infoPtr = Blt_ChainGetValue(linkPtr);
  87         if ((infoPtr->name[0] == c) &&
  88             (strcmp(infoPtr->name, watchName) == 0)) {
  89             Blt_Free(infoPtr->name);
  90             Blt_ChainDeleteLink(&watchChain, linkPtr);
  91             return;
  92         }
  93     }
  94 }
  95
  96 /*ARGSUSED*/
  97 static void
  98 DebugProc(clientData, interp, level, command, proc, cmdClientData,
  99     argc, argv)
 100     ClientData clientData;      /* Not used. */
 101     Tcl_Interp *interp;         /* Not used. */
 102     int level;                  /* Current level */
 103     char *command;              /* Command before substitution */
 104     Tcl_CmdProc *proc;          /* Not used. */
 105     ClientData cmdClientData;   /* Not used. */
 106     int argc;
 107     char **argv;                /* Command after parsing, but before
 108                                  * evaluation */
 109 {
 110     static unsigned char traceStack[200];
 111     register int i;
 112     char *string;
 113     Tcl_Channel errChannel;
 114     Tcl_DString dString;
 115     char prompt[200];
 116     register char *p;
 117     char *lineStart;
 118     int count;
 119
 120     /* This is pretty crappy, but there's no way to trigger stack pops */
 121     for (i = level + 1; i < 200; i++) {
 122         traceStack[i] = 0;
 123     }
 124     if (Blt_ChainGetLength(&watchChain) > 0) {
 125         WatchInfo *infoPtr;
 126         int found;
 127         Blt_ChainLink *linkPtr;
 128
 129         found = FALSE;
 130         for (linkPtr = Blt_ChainFirstLink(&watchChain); linkPtr != NULL;
 131             linkPtr = Blt_ChainNextLink(linkPtr)) {
 132             infoPtr = Blt_ChainGetValue(linkPtr);
 133             if (Tcl_StringMatch(argv[0], infoPtr->name)) {
 134                 found = TRUE;
 135                 break;
 136             }
 137         }
 138         if ((found) && (level < 200)) {
 139             traceStack[level] = 1;
 140             traceStack[level + 1] = 1;
 141         }
 142         if ((level >= 200) || (!traceStack[level])) {
 143             return;
 144         }
 145     }
 146     /*
 147      * Use stderr channel, for compatibility with systems that don't have a
 148      * tty (like WIN32).  In reality, it doesn't make a difference since
 149      * Tk's Win32 console can't handle large streams of data anyways.
 150      */
 151     errChannel = Tcl_GetStdChannel(TCL_STDERR);
 152     if (errChannel == NULL) {
 153         Tcl_AppendResult(interp, "can't get stderr channel", (char *)NULL);
 154         Tcl_BackgroundError(interp);
 155         return;
 156     }
 157     Tcl_DStringInit(&dString);
 158
 159     sprintf(prompt, "%-2d-> ", level);
 160     p = command;
 161     /* Skip leading spaces in command line. */
 162     while(isspace(UCHAR(*p))) {
 163         p++;
 164     }
 165     lineStart = p;
 166     count = 0;
 167     for (/* empty */; *p != '\0'; /* empty */) {
 168         if (*p == '\n') {
 169             if (count > 0) {
 170                 Tcl_DStringAppend(&dString, "     ", -1);
 171             } else {
 172                 Tcl_DStringAppend(&dString, prompt, -1);
 173             }
 174             Tcl_DStringAppend(&dString, lineStart, p - lineStart);
 175             Tcl_DStringAppend(&dString, "\n", -1);
 176             p++;
 177             lineStart = p;
 178             count++;
 179             if (count > 6) {
 180                 break;
 181             }
 182         } else {
 183             p++;
 184         }
 185     }
 186     while (isspace(UCHAR(*lineStart))) {
 187         lineStart++;
 188     }
 189     if (lineStart < p) {
 190         if (count > 0) {
 191             Tcl_DStringAppend(&dString, "     ", -1);
 192         } else {
 193             Tcl_DStringAppend(&dString, prompt, -1);
 194         }
 195         Tcl_DStringAppend(&dString, lineStart, p - lineStart);
 196         if (count <= 6) {
 197             Tcl_DStringAppend(&dString, "\n", -1);
 198         }
 199     }
 200     if (count > 6) {
 201         Tcl_DStringAppend(&dString, "     ...\n", -1);
 202     }
 203     string = Tcl_Merge(argc, argv);
 204     lineStart = string;
 205     sprintf(prompt, "  <- ");
 206     count = 0;
 207     for (p = string; *p != '\0'; /* empty */) {
 208         if (*p == '\n') {
 209             if (count > 0) {
 210                 Tcl_DStringAppend(&dString, "     ", -1);
 211             } else {
 212                 Tcl_DStringAppend(&dString, prompt, -1);
 213             }
 214             count++;
 215             Tcl_DStringAppend(&dString, lineStart, p - lineStart);
 216             Tcl_DStringAppend(&dString, "\n", -1);
 217             p++;
 218             lineStart = p;
 219             if (count > 6) {
 220                 break;
 221             }
 222         } else {
 223             p++;
 224         }
 225     }
 226     if (lineStart < p) {
 227         if (count > 0) {
 228             Tcl_DStringAppend(&dString, "     ", -1);
 229         } else {
 230             Tcl_DStringAppend(&dString, prompt, -1);
 231         }
 232         Tcl_DStringAppend(&dString, lineStart, p - lineStart);
 233         if (count <= 6) {
 234             Tcl_DStringAppend(&dString, "\n", -1);
 235         }
 236     }
 237     if (count > 6) {
 238         Tcl_DStringAppend(&dString, "      ...\n", -1);
 239     }
 240     Tcl_DStringAppend(&dString, "\n", -1);
 241     Blt_Free(string);
 242     Tcl_Write(errChannel, (char *)Tcl_DStringValue(&dString), -1);
 243     Tcl_Flush(errChannel);
 244     Tcl_DStringFree(&dString);
 245 }
 246
 247 /*ARGSUSED*/
 248 static int
 249 DebugCmd(clientData, interp, argc, argv)
 250     ClientData clientData;      /* Not used. */
 251     Tcl_Interp *interp;
 252     int argc;
 253     char **argv;
 254 {
 255     static Tcl_Trace token;
 256     static int level;
 257     int newLevel;
 258     char c;
 259     int length;
 260     WatchInfo *infoPtr;
 261     Blt_ChainLink *linkPtr;
 262     register int i;
 263
 264     if (argc == 1) {
 265         Tcl_SetResult(interp, Blt_Itoa(level), TCL_VOLATILE);
 266         return TCL_OK;
 267     }
 268     c = argv[1][0];
 269     length = strlen(argv[1]);
 270     if ((c == 'w') && (strncmp(argv[1], "watch", length) == 0)) {
 271         /* Add patterns of command names to watch to the chain */
 272         for (i = 2; i < argc; i++) {
 273             GetWatch(argv[i]);
 274         }
 275     } else if ((c == 'i') && (strncmp(argv[1], "ignore", length) == 0)) {
 276         for (i = 2; i < argc; i++) {
 277             DeleteWatch(argv[i]);
 278         }
 279     } else {
 280         goto levelTest;
 281     }
 282     /* Return the current watch patterns */
 283     for (linkPtr = Blt_ChainFirstLink(&watchChain); linkPtr != NULL;
 284         linkPtr = Blt_ChainNextLink(linkPtr)) {
 285         infoPtr = Blt_ChainGetValue(linkPtr);
 286         Tcl_AppendElement(interp, infoPtr->name);
 287     }
 288     return TCL_OK;
 289
 290   levelTest:
 291     if (Tcl_GetBoolean(interp, argv[1], &newLevel) == TCL_OK) {
 292         if (newLevel > 0) {
 293             newLevel = 10000;   /* Max out the level */
 294         }
 295     } else if (Tcl_GetInt(interp, argv[1], &newLevel) == TCL_OK) {
 296         if (newLevel < 0) {
 297             newLevel = 0;
 298         }
 299     } else {
 300         return TCL_ERROR;
 301     }
 302     if (token != 0) {
 303         Tcl_DeleteTrace(interp, token);
 304     }
 305     if (newLevel > 0) {
 306         token = Tcl_CreateTrace(interp, newLevel, DebugProc, (ClientData)0);
 307     }
 308     level = newLevel;
 309     Tcl_SetResult(interp, Blt_Itoa(level), TCL_VOLATILE);
 310     return TCL_OK;
 311 }
 312
 313 int
 314 Blt_DebugInit(interp)
 315     Tcl_Interp *interp;
 316 {
 317     static Blt_CmdSpec cmdSpec =
 318     {"bltdebug", DebugCmd,};
 319
 320     Blt_ChainInit(&watchChain);
 321     if (Blt_InitCmd(interp, "blt", &cmdSpec) == NULL) {
 322         return TCL_ERROR;
 323     }
 324     return TCL_OK;
 325 }
 326
 327 #endif /* NO_BLTDEBUG */