* [Patch] Fix Source-Navigator X-Ref on Tcl8.3.
@ 2002-02-01 17:57 Ian Roxborough
2002-02-04 13:25 ` Mo DeJong
0 siblings, 1 reply; 2+ messages in thread
From: Ian Roxborough @ 2002-02-01 17:57 UTC (permalink / raw)
To: insight; +Cc: sourcenav
[-- Attachment #1: Type: text/plain, Size: 558 bytes --]
Hi,
this is a heads up for a large libgui patch I'm going to
checkin soon. This doesn't actually touch any code that
Insight uses, but if you see any strange build problems with
libgui, it's probably my fault.
ChangeLog:
* src/tkCanvEdge.c (CreateEdge, EdgeCoords, ConfigureEdge):
Objectify functions to use Tcl_Obj instead of char**.
* src/tkGraphCanvas.c: Cut and paste parts of the new
Tcl8.3 tagsearch code in to replace old. Rewrite much
of the code to use the new tagsearch features.
I've sent the patch as an attachment on this email.
Ian.
[-- Attachment #2: libgui.patch --]
[-- Type: application/octet-stream, Size: 42814 bytes --]
Index: tkCanvEdge.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tkCanvEdge.c,v
retrieving revision 1.3
diff -u -2 -r1.3 tkCanvEdge.c
--- tkCanvEdge.c 1998/08/14 01:16:57 1.3
+++ tkCanvEdge.c 2002/02/01 23:58:23
@@ -140,10 +140,10 @@
static int ConfigureEdge _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj **ObjArgv, int flags));
static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
EdgeItem *edgePtr));
static int CreateEdge _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj **ObjArgv));
static void DeleteEdge _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
@@ -153,5 +153,5 @@
static int EdgeCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj **ObjArgv));
static int EdgeToArea _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double *rectPtr));
@@ -250,5 +250,5 @@
DeleteEdge, /* deleteProc */
DisplayEdge, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
EdgeToPoint, /* pointProc */
EdgeToArea, /* areaProc */
@@ -301,5 +301,5 @@
static int
-CreateEdge(interp, canvas, itemPtr, argc, argv)
+CreateEdge(interp, canvas, itemPtr, argc, ObjArgv)
Tcl_Interp *interp; /* Interpreter for error reporting. */
Tk_Canvas canvas; /* Canvas to hold new item. */
@@ -307,6 +307,7 @@
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing edge. */
+ Tcl_Obj **ObjArgv; /* Arguments describing edge. */
{
+ char **argv;
EdgeItem *edgePtr = (EdgeItem *) itemPtr;
int i;
@@ -371,6 +372,15 @@
* start with a digit or a minus sign followed by a digit.
*/
-
+
+ /* TODO: tidy up for loop, we shouldn't need to do
+ * ckalloc and Tcl_GetString, should we?
+ */
+
+ /*
+ * FIXME: memory leak here.
+ */
+ argv = (char**) ckalloc(argc * sizeof(char**));
for (i = 4; i < (argc-1); i+=2) {
+ argv[i]=Tcl_GetString(ObjArgv[i]);
if ((!isdigit(UCHAR(argv[i][0]))) &&
((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) {
@@ -378,10 +388,11 @@
}
}
- if (EdgeCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+
+ if (EdgeCoords(interp, canvas, itemPtr, i, ObjArgv) != TCL_OK) {
goto error;
}
- if (ConfigureEdge(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ if (ConfigureEdge(interp, canvas, itemPtr, argc-i, ObjArgv+i, 0) == TCL_OK) {
return TCL_OK;
- }
+ }
error:
@@ -409,5 +420,5 @@
static int
-EdgeCoords(interp, canvas, itemPtr, argc, argv)
+EdgeCoords(interp, canvas, itemPtr, argc, ObjArgv)
Tcl_Interp *interp; /* Used for error reporting. */
Tk_Canvas canvas; /* Canvas containing item. */
@@ -416,5 +427,5 @@
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj **ObjArgv; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
@@ -464,5 +475,5 @@
}
for (i = argc-1; i >= 0; i--) {
- if (Tk_CanvasGetCoord(interp, canvas, argv[i], &edgePtr->coordPtr[i])
+ if (Tk_CanvasGetCoord(interp, canvas, Tcl_GetString(ObjArgv[i]), &edgePtr->coordPtr[i])
!= TCL_OK) {
return TCL_ERROR;
@@ -511,10 +522,10 @@
static int
-ConfigureEdge(interp, canvas, itemPtr, argc, argv, flags)
+ConfigureEdge(interp, canvas, itemPtr, argc, ObjArgv, flags)
Tcl_Interp *interp; /* Used for error reporting. */
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Edge item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj **ObjArgv; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
@@ -528,8 +539,14 @@
Tk_Window tkwin;
Tk_3DBorder bgBorder;
+ char **argv;
+ int loopcount;
tkwin = Tk_CanvasTkwin(canvas);
bgBorder = ((TkCanvas *) canvas)->bgBorder;
+ argv = (char**) ckalloc(argc * sizeof(char**));
+ for (loopcount = 0 ; loopcount < argc ; loopcount++) {
+ argv[loopcount] = Tcl_GetString( ObjArgv[loopcount] );
+ }
if (Tk_ConfigureWidget(interp, tkwin,
configSpecs, argc, argv,
Index: tkGraphCanvas.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tkGraphCanvas.c,v
retrieving revision 1.4
diff -u -2 -r1.4 tkGraphCanvas.c
--- tkGraphCanvas.c 1999/03/05 19:05:57 1.4
+++ tkGraphCanvas.c 2002/02/01 23:58:27
@@ -7,5 +7,35 @@
extern Tk_ItemType tkEdgeType;
+/*
+ * To support Tcl/Tk8.3 correctly we must support the new type of
+ * TagSearch.
+ */
+
+#ifndef USE_OLD_TAG_SEARCH
+ #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 3)
+ #define USE_OLD_TAG_SEARCH 1
+ #endif
+#endif
+
+#undef USE_OLD_TAG_SEARCH
+
+#ifndef USE_OLD_TAG_SEARCH
+/*
+ * Uids for operands in compiled advanced tag search expressions
+ * Initialization is done by InitCanvas()
+ */
+static Tk_Uid allUid = NULL;
+static Tk_Uid currentUid = NULL;
+static Tk_Uid andUid = NULL;
+static Tk_Uid orUid = NULL;
+static Tk_Uid xorUid = NULL;
+static Tk_Uid parenUid = NULL;
+static Tk_Uid negparenUid = NULL;
+static Tk_Uid endparenUid = NULL;
+static Tk_Uid tagvalUid = NULL;
+static Tk_Uid negtagvalUid = NULL;
+#else /* USE_OLD_TAG_SEARCH */
static Tk_Uid allUid = NULL;
+#endif /* USE_OLD_TAG_SEARCH */
typedef struct Layout_Graph Layout_Graph;
@@ -55,8 +85,10 @@
};
+
/*
* See tkCanvas.h for key data structures used to implement canvases.
*/
+#ifdef USE_OLD_TAG_SEARCH
/*
* The structure defined below is used to keep track of a tag search
@@ -77,7 +109,67 @@
} TagSearch;
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ * The structure defined below is used to keep track of a tag search
+ * in progress. No field should be accessed by anyone other than
+ * TagSearchScan, TagSearchFirst, TagSearchNext,
+ * TagSearchScanExpr, TagSearchEvalExpr,
+ * TagSearchExprInit, TagSearchExprDestroy,
+ * TagSearchDestroy.
+ * (
+ * Not quite accurate: the TagSearch structure is also accessed from:
+ * CanvasWidgetCmd, FindItems, RelinkItems
+ * The only instances of the structure are owned by:
+ * CanvasWidgetCmd
+ * CanvasWidgetCmd is the only function that calls:
+ * FindItems, RelinkItems
+ * CanvasWidgetCmd, FindItems, RelinkItems, are the only functions that call
+ * TagSearch*
+ * )
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ Tk_Item *lastPtr; /* The item right before the currentPtr
+ * is tracked so if the currentPtr is
+ * deleted we don't have to start from the
+ * beginning. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+ int type; /* search type */
+ int id; /* item id for searches by id */
+
+ char *string; /* tag expression string */
+ int stringIndex; /* current position in string scan */
+ int stringLength; /* length of tag expression string */
+
+ char *rewritebuffer; /* tag string (after removing escapes) */
+ unsigned int rewritebufferAllocated; /* available space for rewrites */
+
+ TagSearchExpr *expr; /* compiled tag expression */
+} TagSearch;
+#endif /* USE_OLD_TAG_SEARCH */
+
+#ifdef USE_OLD_TAG_SEARCH
static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
char *tag, TagSearch *searchPtr));
+#else /* USE_OLD_TAG_SEARCH */
+static void TagSearchExprInit _ANSI_ARGS_ ((
+ TagSearchExpr **exprPtrPtr));
+static void TagSearchExprDestroy _ANSI_ARGS_((TagSearchExpr *expr));
+static void TagSearchDestroy _ANSI_ARGS_((TagSearch *searchPtr));
+static int TagSearchScan _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Obj *tagObj, TagSearch **searchPtrPtr));
+static int TagSearchScanExpr _ANSI_ARGS_((Tcl_Interp *interp,
+ TagSearch *searchPtr, TagSearchExpr *expr));
+static int TagSearchEvalExpr _ANSI_ARGS_((TagSearchExpr *expr,
+ Tk_Item *itemPtr));
+static Tk_Item * TagSearchFirst _ANSI_ARGS_((TagSearch *searchPtr));
+static Tk_Item * TagSearchNext _ANSI_ARGS_((TagSearch *searchPtr));
+#endif /* USE_OLD_TAG_SEARCH */
+
+
static Tcl_HashTable * graph_table _ANSI_ARGS_((Tcl_Interp *interp));
@@ -184,4 +276,5 @@
char y4[TCL_DOUBLE_SPACE];
char* argv[8];
+ Tcl_Obj* argvObj[8]; int loopcount;
Layout_Graph *graph=GetGraphLayoutII(canvasPtr, interp);
@@ -232,8 +325,12 @@
}
}
+
Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
+ for (loopcount = 0 ; loopcount < 8 ; loopcount++) {
+ argvObj[loopcount] = Tcl_NewStringObj(argv[loopcount], -1);
+ }
(void)(*iPtr->typePtr->coordProc)(interp, (Tk_Canvas) canvasPtr, iPtr,
/* argc-3, argv+3); 08nov95 wmt */
- argc, argv);
+ argc, argvObj);
Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
return TCL_OK;
@@ -338,5 +435,5 @@
Tcl_HashEntry *entry;
- entry = Tcl_FindHashEntry(graph_table(interp), (char *)canvCmd->clientData);
+ entry = Tcl_FindHashEntry(graph_table(interp), (char *)canvCmd->objClientData);
if (entry)
return (Layout_Graph *)Tcl_GetHashValue(entry);
@@ -372,6 +469,8 @@
if (createcanvasgraph(interp, canvCmd, graph) != TCL_OK)
return TCL_ERROR;
+ /* newitem = Tcl_CreateHashEntry(graph_table(interp),
+ (char *)(canvCmd->objClientData), &new);*/
newitem = Tcl_CreateHashEntry(graph_table(interp),
- (char *)(canvCmd->clientData), &new);
+ (char *)(canvCmd->objClientData), &new);
Tcl_SetHashValue(newitem, (ClientData) *graph);
}
@@ -402,5 +501,5 @@
Tcl_CmdInfo canvCmd;
size_t length;
- int c, i;
+ int c, i, result;
Layout_Graph *graph;
TkCanvas *canvasPtr;
@@ -419,6 +518,6 @@
return TCL_ERROR;
}
- canvasPtr = (TkCanvas *)(canvCmd.clientData);
-
+ canvasPtr = (TkCanvas *) (canvCmd.objClientData);
+ canvasPtr->hotPtr = NULL;
c = argv[2][0];
length = strlen(argv[2]);
@@ -437,8 +536,26 @@
for (i = 3; i < argc; i++) {
Tk_Item *itemPtr;
+#ifdef USE_OLD_TAG_SEARCH
TagSearch search;
+#else /* USE_OLD_TAG_SEARCH */
+ TagSearch *searchPtr = NULL;
+ Tcl_Obj *tagObj = NULL;
+ TagSearch *searchPtrTmp = NULL;
+ /* Allocated by first TagSearchScan
+ * Freed by TagSearchDestroy */
+#endif /* USE_OLD_TAG_SEARCH */
/* Loop through all the items */
+#ifdef USE_OLD_TAG_SEARCH
for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ tagObj = Tcl_NewStringObj(argv[i],-1);
+ if ((result = TagSearchScan(canvasPtr, tagObj, &searchPtr)) != TCL_OK) {
+ goto done;
+ }
+
+ for (itemPtr = TagSearchFirst(searchPtr);
+ itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
char* nm = itemPtr->typePtr->name;
/* create a new edge or node */
@@ -446,4 +563,6 @@
char* fname;
char* tname;
+ Tcl_Obj* fnametagObj;
+ Tcl_Obj* tnametagObj;
Tk_Item* f;
Tk_Item* t;
@@ -452,7 +571,21 @@
goto error;
/* find the from and to node pItems */
+#ifdef USE_OLD_TAG_SEARCH
f = StartTagSearch(canvasPtr, fname, &search);
t = StartTagSearch(canvasPtr, tname, &search);
- ckfree(fname); ckfree(tname);
+#else /* USE_OLD_TAG_SEARCH */
+ fnametagObj = Tcl_NewStringObj(fname,-1);
+ if (TagSearchScan(canvasPtr, fnametagObj, &searchPtrTmp) != TCL_OK) {
+ goto done;
+ }
+ f = TagSearchFirst(searchPtrTmp);
+ tnametagObj = Tcl_NewStringObj(tname,-1);
+ if (TagSearchScan(canvasPtr, tnametagObj, &searchPtrTmp) != TCL_OK) {
+ goto done;
+ }
+ t = TagSearchFirst(searchPtrTmp);
+
+#endif /* USE_OLD_TAG_SEARCH */
+ ckfree(fname); ckfree(tname);
if(LayoutCreateEdge(graph,
(pItem)itemPtr,
@@ -526,5 +659,5 @@
Tcl_HashEntry *entry;
entry = Tcl_FindHashEntry(graph_table(interp),
- (char *)(canvCmd.clientData));
+ (char *)(canvCmd.objClientData));
LayoutFreeGraph(graph);
@@ -623,11 +756,23 @@
char* nm;
Tk_Item *itemPtr;
+#ifdef USE_OLD_TAG_SEARCH
TagSearch search;
+#else /* USE_OLD_TAG_SEARCH */
+ Tcl_Obj* tagObj;
+ TagSearch *searchPtr = NULL;
+#endif /* USE_OLD_TAG_SEARCH */
Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
if(!graph) goto done;
for (i = 3; i < argc; i++) {
+#ifdef USE_OLD_TAG_SEARCH
for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
itemPtr != NULL; itemPtr = NextItem(&search)) {
+#else /* USE_OLD_TAG_SEARCH */
+ tagObj = Tcl_NewStringObj(argv[i],-1);
+ TagSearchScan(canvasPtr, tagObj, &searchPtr);
+ for (itemPtr = TagSearchFirst(searchPtr); itemPtr != NULL;
+ itemPtr = TagSearchNext(searchPtr)) {
+#endif /* USE_OLD_TAG_SEARCH */
nm = itemPtr->typePtr->name;
/* delete a new edge or node */
@@ -694,4 +839,7 @@
}
\f
+
+#ifdef USE_OLD_TAG_SEARCH
+
/*
*--------------------------------------------------------------
@@ -739,5 +887,5 @@
searchPtr->canvasPtr = canvasPtr;
searchPtr->searchOver = 0;
-
+
/*
* Find the first matching item in one of several ways. If the tag
@@ -892,2 +1040,858 @@
return NULL;
}
+
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprInit --
+ *
+ * This procedure allocates and initializes one TagSearchExpr struct.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprInit(exprPtrPtr)
+TagSearchExpr **exprPtrPtr;
+{
+ TagSearchExpr* expr = *exprPtrPtr;
+
+ if (! expr) {
+ expr = (TagSearchExpr *) ckalloc(sizeof(TagSearchExpr));
+ expr->allocated = 0;
+ expr->uids = NULL;
+ expr->next = NULL;
+ }
+ expr->uid = NULL;
+ expr->index = 0;
+ expr->length = 0;
+ *exprPtrPtr = expr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprDestroy --
+ *
+ * This procedure destroys one TagSearchExpr structure.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprDestroy(expr)
+ TagSearchExpr *expr;
+{
+ if (expr) {
+ if (expr->uids) {
+ ckfree((char *)expr->uids);
+ }
+ ckfree((char *)expr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScan --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a tag that matches
+ * the tagOrId expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return items
+ * that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScan(canvasPtr, tagObj, searchPtrPtr)
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ Tcl_Obj *tagObj; /* string giving tag value. */
+ TagSearch **searchPtrPtr; /* Record describing tag search;
+ * will be initialized here. */
+{
+ char *tag = Tcl_GetStringFromObj(tagObj,NULL);
+ int i;
+ TagSearch *searchPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ if (*searchPtrPtr) {
+ searchPtr = *searchPtrPtr;
+ } else {
+ /* Allocate primary search struct on first call */
+ *searchPtrPtr = searchPtr = (TagSearch *) ckalloc(sizeof(TagSearch));
+ searchPtr->expr = NULL;
+
+ /* Allocate buffer for rewritten tags (after de-escaping) */
+ searchPtr->rewritebufferAllocated = 100;
+ searchPtr->rewritebuffer =
+ ckalloc(searchPtr->rewritebufferAllocated);
+ }
+ TagSearchExprInit(&(searchPtr->expr));
+
+ /* How long is the tagOrId ? */
+ searchPtr->stringLength = strlen(tag);
+
+ /* Make sure there is enough buffer to hold rewritten tags */
+ if ((unsigned int)searchPtr->stringLength >=
+ searchPtr->rewritebufferAllocated) {
+ searchPtr->rewritebufferAllocated = searchPtr->stringLength + 100;
+ searchPtr->rewritebuffer =
+ ckrealloc(searchPtr->rewritebuffer,
+ searchPtr->rewritebufferAllocated);
+ }
+
+ /* Initialize search */
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+ searchPtr->type = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (searchPtr->stringLength && isdigit(UCHAR(*tag))) {
+ char *end;
+
+ searchPtr->id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ searchPtr->type = 1;
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * For all other tags and tag expressions convert to a UID.
+ * This UID is kept forever, but this should be thought of
+ * as a cache rather than as a memory leak.
+ */
+ searchPtr->expr->uid = Tk_GetUid(tag);
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Pre-scan tag for at least one unquoted "&&" "||" "^" "!"
+ * if not found then use string as simple tag
+ */
+ for (i = 0; i < searchPtr->stringLength ; i++) {
+ if (tag[i] == '"') {
+ i++;
+ for ( ; i < searchPtr->stringLength; i++) {
+ if (tag[i] == '\\') {
+ i++;
+ continue;
+ }
+ if (tag[i] == '"') {
+ break;
+ }
+ }
+ } else {
+ if ((tag[i] == '&' && tag[i+1] == '&')
+ || (tag[i] == '|' && tag[i+1] == '|')
+ || (tag[i] == '^')
+ || (tag[i] == '!')) {
+ searchPtr->type = 4;
+ break;
+ }
+ }
+ }
+
+ searchPtr->string = tag;
+ searchPtr->stringIndex = 0;
+ if (searchPtr->type == 4) {
+ /*
+ * an operator was found in the prescan, so
+ * now compile the tag expression into array of Tk_Uid
+ * flagging any syntax errors found
+ */
+ if (TagSearchScanExpr(canvasPtr->interp, searchPtr, searchPtr->expr) != TCL_OK) {
+ /* Syntax error in tag expression */
+ /* Result message set by TagSearchScanExpr */
+ return TCL_ERROR;
+ }
+ searchPtr->expr->length = searchPtr->expr->index;
+ } else {
+ if (searchPtr->expr->uid == allUid) {
+ /*
+ * All items match.
+ */
+ searchPtr->type = 2;
+ } else {
+ /*
+ * Optimized single-tag search
+ */
+ searchPtr->type = 3;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchDestroy --
+ *
+ * This procedure destroys any dynamic structures that
+ * may have been allocated by TagSearchScan.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchDestroy(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ if (searchPtr) {
+ TagSearchExprDestroy(searchPtr->expr);
+ ckfree((char *)searchPtr->rewritebuffer);
+ ckfree((char *)searchPtr);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScanExpr --
+ *
+ * This recursive procedure is called to scan a tag expression
+ * and compile it into an array of Tk_Uids.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * was successfully scanned (syntax).
+ * The information at *searchPtr is initialized
+ * such that a call to TagSearchFirst, followed by
+ * successive calls to TagSearchNext will return items
+ * that match tag.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchScanExpr(interp, searchPtr, expr)
+ Tcl_Interp *interp; /* Current interpreter. */
+ TagSearch *searchPtr; /* Search data */
+ TagSearchExpr *expr; /* compiled expression result */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int found_tag; /* One or more tags found */
+ int found_endquote; /* For quoted tag string parsing */
+ int negate_result; /* Pending negation of next tag value */
+ char *tag; /* tag from tag expression string */
+ char c;
+
+ negate_result = 0;
+ found_tag = 0;
+ looking_for_tag = 1;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+
+ if (expr->allocated == expr->index) {
+ expr->allocated += 15;
+ if (expr->uids) {
+ expr->uids =
+ (Tk_Uid *) ckrealloc((char *)(expr->uids),
+ (expr->allocated)*sizeof(Tk_Uid));
+ } else {
+ expr->uids =
+ (Tk_Uid *) ckalloc((expr->allocated)*sizeof(Tk_Uid));
+ }
+ }
+
+ if (looking_for_tag) {
+
+ switch (c) {
+ case ' ' : /* ignore unquoted whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '!' : /* negate next tag or subexpr */
+ if (looking_for_tag > 1) {
+ Tcl_AppendResult(interp,
+ "Too many '!' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ looking_for_tag++;
+ negate_result = 1;
+ break;
+
+ case '(' : /* scan (negated) subexpr recursively */
+ if (negate_result) {
+ expr->uids[expr->index++] = negparenUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = parenUid;
+ }
+ if (TagSearchScanExpr(interp, searchPtr, expr) != TCL_OK) {
+ /* Result string should be already set
+ * by nested call to tag_expr_scan() */
+ return TCL_ERROR;
+ }
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '"' : /* quoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ found_endquote = 0;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c == '\\') {
+ c = searchPtr->string[searchPtr->stringIndex++];
+ }
+ if (c == '"') {
+ found_endquote = 1;
+ break;
+ }
+ *tag++ = c;
+ }
+ if (! found_endquote) {
+ Tcl_AppendResult(interp,
+ "Missing endquote in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (! (tag - searchPtr->rewritebuffer)) {
+ Tcl_AppendResult(interp,
+ "Null quoted tag string in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ *tag++ = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ break;
+
+ case '&' : /* illegal chars when looking for tag */
+ case '|' :
+ case '^' :
+ case ')' :
+ Tcl_AppendResult(interp,
+ "Unexpected operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+
+ default : /* unquoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = tagvalUid;
+ }
+ tag = searchPtr->rewritebuffer;
+ *tag++ = c;
+ /* copy rest of tag, including any embedded whitespace */
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex];
+ if (c == '!' || c == '&' || c == '|' || c == '^'
+ || c == '(' || c == ')' || c == '"') {
+ break;
+ }
+ *tag++ = c;
+ searchPtr->stringIndex++;
+ }
+ /* remove trailing whitespace */
+ while (1) {
+ c = *--tag;
+ /* there must have been one non-whitespace char,
+ * so this will terminate */
+ if (c != ' ' && c != '\t' && c != '\n' && c != '\r') {
+ break;
+ }
+ }
+ *++tag = '\0';
+ expr->uids[expr->index++] =
+ Tk_GetUid(searchPtr->rewritebuffer);
+ looking_for_tag = 0;
+ found_tag = 1;
+ }
+
+ } else { /* ! looking_for_tag */
+
+ switch (c) {
+ case ' ' : /* ignore whitespace */
+ case '\t' :
+ case '\n' :
+ case '\r' :
+ break;
+
+ case '&' : /* AND operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '&') {
+ Tcl_AppendResult(interp,
+ "Singleton '&' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = andUid;
+ looking_for_tag = 1;
+ break;
+
+ case '|' : /* OR operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '|') {
+ Tcl_AppendResult(interp,
+ "Singleton '|' in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = orUid;
+ looking_for_tag = 1;
+ break;
+
+ case '^' : /* XOR operator */
+ expr->uids[expr->index++] = xorUid;
+ looking_for_tag = 1;
+ break;
+
+ case ')' : /* end subexpression */
+ expr->uids[expr->index++] = endparenUid;
+ goto breakwhile;
+
+ default : /* syntax error */
+ Tcl_AppendResult(interp,
+ "Invalid boolean operator in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ breakwhile:
+ if (found_tag && ! looking_for_tag) {
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "Missing tag in tag search expression",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchEvalExpr --
+ *
+ * This recursive procedure is called to eval a tag expression.
+ *
+ * Results:
+ * The return value indicates if the tagOrId expression
+ * successfully matched the tags of the current item.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TagSearchEvalExpr(expr, itemPtr)
+ TagSearchExpr *expr; /* Search expression */
+ Tk_Item *itemPtr; /* Item being test for match */
+{
+ int looking_for_tag; /* When true, scanner expects
+ * next char(s) to be a tag,
+ * else operand expected */
+ int negate_result; /* Pending negation of next tag value */
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+ int count;
+ int result; /* Value of expr so far */
+ int parendepth;
+
+ result = 0; /* just to keep the compiler quiet */
+
+ negate_result = 0;
+ looking_for_tag = 1;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (looking_for_tag) {
+ if (uid == tagvalUid) {
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == negtagvalUid) {
+ negate_result = ! negate_result;
+/*
+ * assert(expr->index < expr->length);
+ */
+ uid = expr->uids[expr->index++];
+ result = 0;
+ /*
+ * set result 1 if tag is found in item's tags
+ */
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ result = 1;
+ break;
+ }
+ }
+
+ } else if (uid == parenUid) {
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+
+ } else if (uid == negparenUid) {
+ negate_result = ! negate_result;
+ /*
+ * evaluate subexpressions with recursion
+ */
+ result = TagSearchEvalExpr(expr, itemPtr);
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ if (negate_result) {
+ result = ! result;
+ negate_result = 0;
+ }
+ looking_for_tag = 0;
+ } else { /* ! looking_for_tag */
+ if (((uid == andUid) && (!result)) || ((uid == orUid) && result)) {
+ /*
+ * short circuit expression evaluation
+ *
+ * if result before && is 0, or result before || is 1,
+ * then the expression is decided and no further
+ * evaluation is needed.
+ */
+
+ parendepth = 0;
+ while (expr->index < expr->length) {
+ uid = expr->uids[expr->index++];
+ if (uid == tagvalUid || uid == negtagvalUid) {
+ expr->index++;
+ continue;
+ }
+ if (uid == parenUid || uid == negparenUid) {
+ parendepth++;
+ continue;
+ }
+ if (uid == endparenUid) {
+ parendepth--;
+ if (parendepth < 0) {
+ break;
+ }
+ }
+ }
+ return result;
+
+ } else if (uid == xorUid) {
+ /*
+ * if the previous result was 1
+ * then negate the next result
+ */
+ negate_result = result;
+
+ } else if (uid == endparenUid) {
+ return result;
+/*
+ * } else {
+ * assert(0);
+ */
+ }
+ looking_for_tag = 1;
+ }
+ }
+/*
+ * assert(! looking_for_tag);
+ */
+ return result;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchFirst --
+ *
+ * This procedure is called to get the first item
+ * item that matches a preestablished search predicate
+ * that was set by TagSearchScan.
+ *
+ * Results:
+ * The return value is a pointer to the first item, or NULL
+ * if there is no such item. The information at *searchPtr
+ * is updated such that successive calls to TagSearchNext
+ * will return successive items.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchFirst(searchPtr)
+ TagSearch *searchPtr; /* Record describing tag search */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /* short circuit impossible searches for null tags */
+ if (searchPtr->stringLength == 0) {
+ return NULL;
+ }
+
+ /*
+ * Find the first matching item in one of several ways. If the tag
+ * is a number then it selects the single item with the matching
+ * identifier. In this case see if the item being requested is the
+ * hot item, in which case the search can be skipped.
+ */
+
+ if (searchPtr->type == 1) {
+ Tcl_HashEntry *entryPtr;
+
+ itemPtr = searchPtr->canvasPtr->hotPtr;
+ lastPtr = searchPtr->canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != searchPtr->id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ entryPtr = NULL;
+ entryPtr = Tcl_FindHashEntry(&searchPtr->canvasPtr->idTable,
+ (char *) searchPtr->id);
+
+ if (entryPtr != NULL) {
+ itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ searchPtr->canvasPtr->hotPtr = itemPtr;
+ searchPtr->canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = searchPtr->canvasPtr->firstItemPtr;
+ return searchPtr->canvasPtr->firstItemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ } else {
+
+ /*
+ * None of the above. Search for an item matching the tag expression.
+ */
+
+ for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchNext --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after TagSearchFirst has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag expr specified to TagSearchScan, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchNext(searchPtr)
+ TagSearch *searchPtr; /* Record describing search in
+ * progress. */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid uid, *tagPtr;
+ int count;
+
+ /*
+ * Find next item in list (this may not actually be a suitable
+ * one to return), and return if there are no items left.
+ */
+
+ lastPtr = searchPtr->lastPtr;
+ if (lastPtr == NULL) {
+ itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ } else {
+ itemPtr = lastPtr->nextPtr;
+ }
+ if ((itemPtr == NULL) || (searchPtr->searchOver)) {
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+ if (itemPtr != searchPtr->currentPtr) {
+ /*
+ * The structure of the list has changed. Probably the
+ * previously-returned item was removed from the list.
+ * In this case, don't advance lastPtr; just return
+ * its new successor (i.e. do nothing here).
+ */
+ } else {
+ lastPtr = itemPtr;
+ itemPtr = lastPtr->nextPtr;
+ }
+
+ if (searchPtr->type == 2) {
+
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == 3) {
+
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+
+ /*
+ * Else.... evaluate tag expression
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+#endif /* USE_OLD_TAG_SEARCH */
+
+
+
+
+
+
+
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch] Fix Source-Navigator X-Ref on Tcl8.3.
2002-02-01 17:57 [Patch] Fix Source-Navigator X-Ref on Tcl8.3 Ian Roxborough
@ 2002-02-04 13:25 ` Mo DeJong
0 siblings, 0 replies; 2+ messages in thread
From: Mo DeJong @ 2002-02-04 13:25 UTC (permalink / raw)
To: sourcenav; +Cc: insight
On Fri, 1 Feb 2002 16:20:55 -0800
Ian Roxborough <irox@redhat.com> wrote:
> Hi,
>
> this is a heads up for a large libgui patch I'm going to
> checkin soon. This doesn't actually touch any code that
> Insight uses, but if you see any strange build problems with
> libgui, it's probably my fault.
I tested this patch out and it seems to be working just fine.
I can finally use the xref and include tools again with the
CVS version.
cheers
Mo
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2002-02-02 1:57 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2002-02-01 17:57 [Patch] Fix Source-Navigator X-Ref on Tcl8.3 Ian Roxborough
2002-02-04 13:25 ` Mo DeJong
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).