summaryrefslogtreecommitdiffstats
path: root/generic/tkUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkUtil.c')
-rw-r--r--generic/tkUtil.c156
1 files changed, 145 insertions, 11 deletions
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 547fd16..3124f68 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -6,16 +6,30 @@
* a focus highlight.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkUtil.c,v 1.2 1998/09/14 18:23:20 stanton Exp $
+ * RCS: @(#) $Id: tkUtil.c,v 1.3 1999/04/16 01:51:24 stanton Exp $
*/
#include "tkInt.h"
#include "tkPort.h"
+
+/*
+ * The structure below defines the implementation of the "statekey"
+ * Tcl object, used for quickly finding a mapping in a TkStateMap.
+ */
+
+static Tcl_ObjType stateKeyType = {
+ "statekey", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */
+};
+
/*
*----------------------------------------------------------------------
@@ -132,7 +146,7 @@ Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
* took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the
* desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
* *intPtr is filled in with the number of lines to move (may be
- * negative); if TK_SCROLL_ERROR, interp->result contains an
+ * negative); if TK_SCROLL_ERROR, the interp's result contains an
* error message.
*
* Side effects:
@@ -197,6 +211,85 @@ Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfoObj --
+ *
+ * This procedure is invoked to parse "xview" and "yview"
+ * scrolling commands for widgets using the new scrolling
+ * command syntax ("moveto" or "scroll" options).
+ *
+ * Results:
+ * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
+ * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether
+ * the command was successfully parsed and what form the command
+ * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the
+ * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
+ * *intPtr is filled in with the number of lines to move (may be
+ * negative); if TK_SCROLL_ERROR, the interp's result contains an
+ * error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ int objc; /* # arguments for command. */
+ Tcl_Obj *CONST objv[]; /* Arguments for command. */
+ double *dblPtr; /* Filled in with argument "moveto"
+ * option, if any. */
+ int *intPtr; /* Filled in with number of pages
+ * or lines to scroll, if any. */
+{
+ int c;
+ size_t length;
+ char *arg2, *arg4;
+
+ arg2 = Tcl_GetString(objv[2]);
+ length = strlen(arg2);
+ c = arg2[0];
+ if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ return TK_SCROLL_MOVETO;
+ } else if ((c == 's')
+ && (strncmp(arg2, "scroll", length) == 0)) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages");
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ arg4 = Tcl_GetString(objv[4]);
+ length = (strlen(arg4));
+ c = arg4[0];
+ if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) {
+ return TK_SCROLL_PAGES;
+ } else if ((c == 'u')
+ && (strncmp(arg4, "units", length) == 0)) {
+ return TK_SCROLL_UNITS;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", arg4,
+ "\": must be units or pages", (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ }
+ Tcl_AppendResult(interp, "unknown option \"", arg2,
+ "\": must be moveto or scroll", (char *) NULL);
+ return TK_SCROLL_ERROR;
+}
+
+/*
*---------------------------------------------------------------------------
*
* TkComputeAnchor --
@@ -310,7 +403,7 @@ TkFindStateString(mapPtr, numKey)
* Returns the numKey associated with the last element (the NULL
* string one) in the table if strKey was not equal to any of the
* string keys in the table. In that case, an error message is
- * also left in interp->result (if interp is not NULL).
+ * also left in the interp's result (if interp is not NULL).
*
* Side effects.
* None.
@@ -319,29 +412,70 @@ TkFindStateString(mapPtr, numKey)
*/
int
-TkFindStateNum(interp, field, mapPtr, strKey)
+TkFindStateNum(interp, option, mapPtr, strKey)
Tcl_Interp *interp; /* Interp for error reporting. */
- CONST char *field; /* String to use when constructing error. */
+ CONST char *option; /* String to use when constructing error. */
CONST TkStateMap *mapPtr; /* Lookup table. */
CONST char *strKey; /* String to try to find in lookup table. */
{
CONST TkStateMap *mPtr;
- if (mapPtr->strKey == NULL) {
- panic("TkFindStateNum: no choices in lookup table");
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(strKey, mPtr->strKey) == 0) {
+ return mPtr->numKey;
+ }
+ }
+ if (interp != NULL) {
+ mPtr = mapPtr;
+ Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
+ "\": must be ", mPtr->strKey, (char *) NULL);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
+ }
+ }
+ return mPtr->numKey;
+}
+
+int
+TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ Tcl_Obj *optionPtr; /* String to use when constructing error. */
+ CONST TkStateMap *mapPtr; /* Lookup table. */
+ Tcl_Obj *keyPtr; /* String key to find in lookup table. */
+{
+ CONST TkStateMap *mPtr;
+ CONST char *key;
+ CONST Tcl_ObjType *typePtr;
+
+ if ((keyPtr->typePtr == &stateKeyType)
+ && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
+ return (int) keyPtr->internalRep.twoPtrValue.ptr2;
}
+ key = Tcl_GetStringFromObj(keyPtr, NULL);
for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
- if (strcmp(strKey, mPtr->strKey) == 0) {
+ if (strcmp(key, mPtr->strKey) == 0) {
+ typePtr = keyPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(keyPtr);
+ }
+ keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
+ keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
+ keyPtr->typePtr = &stateKeyType;
return mPtr->numKey;
}
}
if (interp != NULL) {
mPtr = mapPtr;
- Tcl_AppendResult(interp, "bad ", field, " value \"", strKey,
+ Tcl_AppendResult(interp, "bad ",
+ Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key,
"\": must be ", mPtr->strKey, (char *) NULL);
for (mPtr++; mPtr->strKey != NULL; mPtr++) {
- Tcl_AppendResult(interp, ", ", mPtr->strKey, (char *) NULL);
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
}
}
return mPtr->numKey;
generated by cgit v0.12 at 2024-11-01 17:53:16 (GMT)