/* 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;
}