* Merged 8.1 branch into the main trunk

FossilOrigin-Name: 1120dc4257448ed1955333e682de48e2940cc741

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;