/* this is called for tag comparisons in marclib.c */ int tagcmp(char *pattern, char *string) { char marctagbuffer[4]; strncpy(marctagbuffer,string,3); marctagbuffer[3] = '\0'; return(Tcl_StringMatch(marctagbuffer,pattern)); }
void TnmListFromTable(TnmTable *table, Tcl_Obj *listPtr, char *pattern) { for (; table->value; table++) { if (pattern && !Tcl_StringMatch(table->value, pattern)) { continue; } Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, Tcl_NewStringObj(table->value, -1)); } }
void Dci_ListDump(Tcl_Interp *interp, Dci_List *listPtr, char *pattern, int values) { char *key; int i; for (i = 0; i < listPtr->nelem; ++i) { key = Dci_ListKey(listPtr, i); if (pattern == NULL || Tcl_StringMatch(key, pattern)) { Tcl_AppendElement(interp, key); if (values) { Tcl_AppendElement(interp, Dci_ListValue(listPtr, i)); } } } }
void TnmListFromList(Tcl_Obj *objPtr, Tcl_Obj *listPtr, char *pattern) { int i, objc, code; Tcl_Obj **objv; code = Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv); if (code != TCL_OK) return; for (i = 0; i < objc; i++) { char *s = Tcl_GetStringFromObj(objv[i], NULL); if (pattern && !Tcl_StringMatch(s, pattern)) { continue; } Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, objv[i]); } }
int Tcl_StringMatch( register unsigned char *string /* String. */ , register unsigned char *pattern /* Pattern, which may contain * special characters. */ ) { char c2; while (1) { /* See if we're at the end of both the pattern and the string. * If so, we succeeded. If we're at the end of the pattern * but not at the end of the string, we failed. */ if (*pattern == 0) { if (*string == 0) { return 1; } else { return 0; } } if ((*string == 0) && (*pattern != '*')) { return 0; } /* Check for a "*" as the next pattern character. It matches * any substring. We handle this by calling ourselves * recursively for each postfix of string, until either we * match or we reach the end of the string. */ if (*pattern == '*') { pattern += 1; if (*pattern == 0) { return 1; } while (1) { if (Tcl_StringMatch(string, pattern)) { return 1; } if (*string == 0) { return 0; } string += 1; } } /* Check for a "?" as the next pattern character. It matches * any single character. */ if (*pattern == '?') { goto thisCharOK; } /* Check for a "[" as the next pattern character. It is followed * by a list of characters that are acceptable, or by a range * (two characters separated by "-"). */ if (*pattern == '[') { pattern += 1; while (1) { if ((*pattern == ']') || (*pattern == 0)) { return 0; } if (*pattern == *string) { break; } if (pattern[1] == '-') { c2 = pattern[2]; if (c2 == 0) { return 0; } if ((*pattern <= *string) && (c2 >= *string)) { break; } if ((*pattern >= *string) && (c2 <= *string)) { break; } pattern += 2; } pattern += 1; } while ((*pattern != ']') && (*pattern != 0)) { pattern += 1; } goto thisCharOK; } /* If the next pattern character is '/', just strip off the '/' * so we do exact matching on the character that follows. */ if (*pattern == '\\') { pattern += 1; if (*pattern == 0) { return 0; } } /* There's no special character. Just make sure that the next * characters of each string match. */ if (*pattern != *string) { return 0; } thisCharOK: pattern += 1; string += 1; } }
int Tk_BusyObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window tkwin = clientData; Tcl_HashTable *busyTablePtr = &((TkWindow *) tkwin)->mainPtr->busyTable; Busy *busyPtr; Tcl_Obj *objPtr; int index, result = TCL_OK; static const char *const optionStrings[] = { "cget", "configure", "current", "forget", "hold", "status", NULL }; enum options { BUSY_CGET, BUSY_CONFIGURE, BUSY_CURRENT, BUSY_FORGET, BUSY_HOLD, BUSY_STATUS }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "options ?arg arg ...?"); return TCL_ERROR; } /* * [tk busy <window>] command shortcut. */ if (Tcl_GetString(objv[1])[0] == '.') { if (objc%2 == 1) { Tcl_WrongNumArgs(interp, 1, objv, "window ?option value ...?"); return TCL_ERROR; } return HoldBusy(busyTablePtr, interp, objv[1], objc-2, objv+2); } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case BUSY_CGET: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "window option"); return TCL_ERROR; } busyPtr = GetBusy(interp, busyTablePtr, objv[2]); if (busyPtr == NULL) { return TCL_ERROR; } Tcl_Preserve(busyPtr); objPtr = Tk_GetOptionValue(interp, (char *) busyPtr, busyPtr->optionTable, objv[3], busyPtr->tkBusy); if (objPtr == NULL) { result = TCL_ERROR; } else { Tcl_SetObjResult(interp, objPtr); } Tcl_Release(busyPtr); return result; case BUSY_CONFIGURE: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "window ?option? ?value ...?"); return TCL_ERROR; } busyPtr = GetBusy(interp, busyTablePtr, objv[2]); if (busyPtr == NULL) { return TCL_ERROR; } Tcl_Preserve(busyPtr); if (objc <= 4) { objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr, busyPtr->optionTable, (objc == 4) ? objv[3] : NULL, busyPtr->tkBusy); if (objPtr == NULL) { result = TCL_ERROR; } else { Tcl_SetObjResult(interp, objPtr); } } else { result = ConfigureBusy(interp, busyPtr, objc-3, objv+3); } Tcl_Release(busyPtr); return result; case BUSY_CURRENT: { Tcl_HashEntry *hPtr; Tcl_HashSearch cursor; const char *pattern = (objc == 3 ? Tcl_GetString(objv[2]) : NULL); objPtr = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL; hPtr = Tcl_NextHashEntry(&cursor)) { busyPtr = Tcl_GetHashValue(hPtr); if (pattern == NULL || Tcl_StringMatch(Tk_PathName(busyPtr->tkRef), pattern)) { Tcl_ListObjAppendElement(interp, objPtr, TkNewWindowObj(busyPtr->tkRef)); } } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } case BUSY_FORGET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } busyPtr = GetBusy(interp, busyTablePtr, objv[2]); if (busyPtr == NULL) { return TCL_ERROR; } TkpHideBusyWindow(busyPtr); Tcl_EventuallyFree(busyPtr, DestroyBusy); return TCL_OK; case BUSY_HOLD: if (objc < 3 || objc%2 != 1) { Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?"); return TCL_ERROR; } return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3); case BUSY_STATUS: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( GetBusy(interp, busyTablePtr, objv[2]) != NULL)); return TCL_OK; } Tcl_Panic("unhandled option: %d", index); return TCL_ERROR; /* Unreachable */ }
/* ARGSUSED */ int Tcl_CaseCmd( void *dummy /* Not used. */ , Tcl_Interp *interp /* Current interpreter. */ , int argc /* Number of arguments. */ , unsigned char **argv /* Argument strings. */ ) { int i, result; int body; unsigned char *string; int caseArgc, splitArgs; unsigned char **caseArgv; if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " string ?in? patList body ... ?default body?\"", 0); return TCL_ERROR; } string = argv[1]; body = -1; if (strcmp(argv[2], (unsigned char*) "in") == 0) { i = 3; } else { i = 2; } caseArgc = argc - i; caseArgv = argv + i; /* * If all of the pattern/command pairs are lumped into a single * argument, split them out again. */ splitArgs = 0; if (caseArgc == 1) { result = Tcl_SplitList(interp, caseArgv[0], &caseArgc, &caseArgv); if (result != TCL_OK) { return result; } splitArgs = 1; } for (i = 0; i < caseArgc; i += 2) { int patArgc, j; unsigned char **patArgv; register unsigned char *p; if (i == (caseArgc-1)) { interp->result = (unsigned char*) "extra case pattern with no body"; result = TCL_ERROR; goto cleanup; } /* * Check for special case of single pattern (no list) with * no backslash sequences. */ for (p = caseArgv[i]; *p != 0; p++) { if (isspace(*p) || (*p == '\\')) { break; } } if (*p == 0) { if ((*caseArgv[i] == 'd') && (strcmp(caseArgv[i], (unsigned char*) "default") == 0)) { body = i+1; } if (Tcl_StringMatch(string, caseArgv[i])) { body = i+1; goto match; } continue; } /* * Break up pattern lists, then check each of the patterns * in the list. */ result = Tcl_SplitList(interp, caseArgv[i], &patArgc, &patArgv); if (result != TCL_OK) { goto cleanup; } for (j = 0; j < patArgc; j++) { if (Tcl_StringMatch(string, patArgv[j])) { body = i+1; break; } } mem_free (patArgv); if (j < patArgc) { break; } } match: if (body != -1) { result = Tcl_Eval(interp, caseArgv[body], 0, 0); if (result == TCL_ERROR) { unsigned char msg[100]; snprintf(msg, sizeof (msg), "\n (\"%.50s\" arm line %d)", caseArgv[body-1], interp->errorLine); Tcl_AddErrorInfo(interp, msg); } goto cleanup; } /* * Nothing matched: return nothing. */ result = TCL_OK; cleanup: if (splitArgs) { mem_free (caseArgv); } return result; }