summaryrefslogtreecommitdiff
path: root/tcl/generic/tkOption.c
diff options
context:
space:
mode:
Diffstat (limited to 'tcl/generic/tkOption.c')
-rw-r--r--tcl/generic/tkOption.c1634
1 files changed, 0 insertions, 1634 deletions
diff --git a/tcl/generic/tkOption.c b/tcl/generic/tkOption.c
deleted file mode 100644
index 2decd353971..00000000000
--- a/tcl/generic/tkOption.c
+++ /dev/null
@@ -1,1634 +0,0 @@
-/*
- * tkOption.c --
- *
- * This module contains procedures to manage the option
- * database, which allows various strings to be associated
- * with windows either by name or by class or both.
- *
- * Copyright (c) 1990-1994 The Regents of the University of California.
- * 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$
- */
-
-#include "tkPort.h"
-#include "tkInt.h"
-
-/*
- * The option database is stored as one tree for each main window.
- * Each name or class field in an option is associated with a node or
- * leaf of the tree. For example, the options "x.y.z" and "x.y*a"
- * each correspond to three nodes in the tree; they share the nodes
- * "x" and "x.y", but have different leaf nodes. One of the following
- * structures exists for each node or leaf in the option tree. It is
- * actually stored as part of the parent node, and describes a particular
- * child of the parent.
- *
- * The structure of the option db tree is a little confusing. There are
- * four different kinds of nodes in the tree:
- * interior class nodes
- * interior name nodes
- * leaf class nodes
- * leaf name nodes
- *
- * All interior nodes refer to _window_ classes and names; all leaf nodes
- * refer to _option_ classes and names. When looking for a particular option,
- * therefore, you must compare interior node values to corresponding window
- * values, and compare leaf node values to corresponding option values.
- *
- * The tree is actually stored in a collection of arrays; there is one each
- * combination of WILDCARD/EXACT and CLASS/NAME and NODE/LEAF. The NODE arrays
- * contain the interior nodes of the tree; each element has a pointer to an
- * array of elements which are the leaves of the tree. The LEAF arrays, rather
- * than holding the leaves of the tree, hold a cached subset of the option
- * database, consisting of the values of all defined options for a single
- * window, and some additional information about each ancestor of the window
- * (since some options may be inherited from a parent), all the way back to the
- * root window.
- *
- * Each time a call is made to Tk_GetOption, Tk will attempt to use the cached
- * information to satisfy the lookup. If the call is for a window other than
- * that for which options are currently cached, the portion of the cache that
- * contains information for common ancestors of the two windows is retained and
- * the remainder is discarded and rebuilt with new information for the new
- * window.
- */
-
-typedef struct Element {
- Tk_Uid nameUid; /* Name or class from one element of
- * an option spec. */
- union {
- struct ElArray *arrayPtr; /* If this is an intermediate node,
- * a pointer to a structure describing
- * the remaining elements of all
- * options whose prefixes are the
- * same up through this element. */
- Tk_Uid valueUid; /* For leaf nodes, this is the string
- * value of the option. */
- } child;
- int priority; /* Used to select among matching
- * options. Includes both the
- * priority level and a serial #.
- * Greater value means higher
- * priority. Irrelevant except in
- * leaf nodes. */
- int flags; /* OR-ed combination of bits. See
- * below for values. */
-} Element;
-
-/*
- * Flags in Element structures:
- *
- * CLASS - Non-zero means this element refers to a class,
- * Zero means this element refers to a name.
- * NODE - Zero means this is a leaf element (the child
- * field is a value, not a pointer to another node).
- * One means this is a node element.
- * WILDCARD - Non-zero means this there was a star in the
- * original specification just before this element.
- * Zero means there was a dot.
- */
-
-#define TYPE_MASK 0x7
-
-#define CLASS 0x1
-#define NODE 0x2
-#define WILDCARD 0x4
-
-#define EXACT_LEAF_NAME 0x0
-#define EXACT_LEAF_CLASS 0x1
-#define EXACT_NODE_NAME 0x2
-#define EXACT_NODE_CLASS 0x3
-#define WILDCARD_LEAF_NAME 0x4
-#define WILDCARD_LEAF_CLASS 0x5
-#define WILDCARD_NODE_NAME 0x6
-#define WILDCARD_NODE_CLASS 0x7
-
-/*
- * The following structure is used to manage a dynamic array of
- * Elements. These structures are used for two purposes: to store
- * the contents of a node in the option tree, and for the option
- * stacks described below.
- */
-
-typedef struct ElArray {
- int arraySize; /* Number of elements actually
- * allocated in the "els" array. */
- int numUsed; /* Number of elements currently in
- * use out of els. */
- Element *nextToUse; /* Pointer to &els[numUsed]. */
- Element els[1]; /* Array of structures describing
- * children of this node. The
- * array will actually contain enough
- * elements for all of the children
- * (and even a few extras, perhaps).
- * This must be the last field in
- * the structure. */
-} ElArray;
-
-#define EL_ARRAY_SIZE(numEls) ((unsigned) (sizeof(ElArray) \
- + ((numEls)-1)*sizeof(Element)))
-#define INITIAL_SIZE 5
-
-/*
- * In addition to the option tree, which is a relatively static structure,
- * there are eight additional structures called "stacks", which are used
- * to speed up queries into the option database. The stack structures
- * are designed for the situation where an individual widget makes repeated
- * requests for its particular options. The requests differ only in
- * their last name/class, so during the first request we extract all
- * the options pertaining to the particular widget and save them in a
- * stack-like cache; subsequent requests for the same widget can search
- * the cache relatively quickly. In fact, the cache is a hierarchical
- * one, storing a list of relevant options for this widget and all of
- * its ancestors up to the application root; hence the name "stack".
- *
- * Each of the eight stacks consists of an array of Elements, ordered in
- * terms of levels in the window hierarchy. All the elements relevant
- * for the top-level widget appear first in the array, followed by all
- * those from the next-level widget on the path to the current widget,
- * etc. down to those for the current widget.
- *
- * Cached information is divided into eight stacks according to the
- * CLASS, NODE, and WILDCARD flags. Leaf and non-leaf information is
- * kept separate to speed up individual probes (non-leaf information is
- * only relevant when building the stacks, but isn't relevant when
- * making probes; similarly, only non-leaf information is relevant
- * when the stacks are being extended to the next widget down in the
- * widget hierarchy). Wildcard elements are handled separately from
- * "exact" elements because once they appear at a particular level in
- * the stack they remain active for all deeper levels; exact elements
- * are only relevant at a particular level. For example, when searching
- * for options relevant in a particular window, the entire wildcard
- * stacks get checked, but only the portions of the exact stacks that
- * pertain to the window's parent. Lastly, name and class stacks are
- * kept separate because different search keys are used when searching
- * them; keeping them separate speeds up the searches.
- */
-
-#define NUM_STACKS 8
-
-/*
- * One of the following structures is used to keep track of each
- * level in the stacks.
- */
-
-typedef struct StackLevel {
- TkWindow *winPtr; /* Window corresponding to this stack
- * level. */
- int bases[NUM_STACKS]; /* For each stack, index of first
- * element on stack corresponding to
- * this level (used to restore "numUsed"
- * fields when popping out of a level. */
-} StackLevel;
-
-typedef struct ThreadSpecificData {
- int initialized; /* 0 means the ThreadSpecific Data structure
- * for the current thread needs to be
- * initialized. */
- ElArray *stacks[NUM_STACKS];
- TkWindow *cachedWindow;
- /* Lowest-level window currently
- * loaded in stacks at present.
- * NULL means stacks have never
- * been used, or have been
- * invalidated because of a change
- * to the database. */
- /*
- * Information about all of the stack levels that are currently
- * active. This array grows dynamically to become as large as needed.
- */
-
- StackLevel *levels; /* Array describing current stack. */
- int numLevels; /* Total space allocated. */
- int curLevel; /* Highest level currently in use. Note:
- * curLevel is never 0! (I don't remember
- * why anymore...) */
- /*
- * The variable below is a serial number for all options entered into
- * the database so far. It increments on each addition to the option
- * database. It is used in computing option priorities, so that the
- * most recent entry wins when choosing between options at the same
- * priority level.
- */
-
- int serial;
- Element defaultMatch; /* Special "no match" Element to use as
- * default for searches.*/
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * Forward declarations for procedures defined in this file:
- */
-
-static int AddFromString _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string, int priority));
-static void ClearOptionTree _ANSI_ARGS_((ElArray *arrayPtr));
-static ElArray * ExtendArray _ANSI_ARGS_((ElArray *arrayPtr,
- Element *elPtr));
-static void ExtendStacks _ANSI_ARGS_((ElArray *arrayPtr,
- int leaf));
-static int GetDefaultOptions _ANSI_ARGS_((Tcl_Interp *interp,
- TkWindow *winPtr));
-static ElArray * NewArray _ANSI_ARGS_((int numEls));
-static void OptionThreadExitProc _ANSI_ARGS_((
- ClientData clientData));
-static void OptionInit _ANSI_ARGS_((TkMainInfo *mainPtr));
-static int ParsePriority _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-static int ReadOptionFile _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *fileName, int priority));
-static void SetupStacks _ANSI_ARGS_((TkWindow *winPtr, int leaf));
-
-/*
- *--------------------------------------------------------------
- *
- * Tk_AddOption --
- *
- * Add a new option to the option database.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Information is added to the option database.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tk_AddOption(tkwin, name, value, priority)
- Tk_Window tkwin; /* Window token; option will be associated
- * with main window for this window. */
- CONST char *name; /* Multi-element name of option. */
- CONST char *value; /* String value for option. */
- int priority; /* Overall priority level to use for
- * this option, such as TK_USER_DEFAULT_PRIO
- * or TK_INTERACTIVE_PRIO. Must be between
- * 0 and TK_MAX_PRIO. */
-{
- TkWindow *winPtr = ((TkWindow *) tkwin)->mainPtr->winPtr;
- register ElArray **arrayPtrPtr;
- register Element *elPtr;
- Element newEl;
- register CONST char *p;
- CONST char *field;
- int count, firstField, length;
-#define TMP_SIZE 100
- char tmp[TMP_SIZE+1];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- if (winPtr->mainPtr->optionRootPtr == NULL) {
- OptionInit(winPtr->mainPtr);
- }
- tsdPtr->cachedWindow = NULL; /* Invalidate the cache. */
-
- /*
- * Compute the priority for the new element, including both the
- * overall level and the serial number (to disambiguate with the
- * level).
- */
-
- if (priority < 0) {
- priority = 0;
- } else if (priority > TK_MAX_PRIO) {
- priority = TK_MAX_PRIO;
- }
- newEl.priority = (priority << 24) + tsdPtr->serial;
- tsdPtr->serial++;
-
- /*
- * Parse the option one field at a time.
- */
-
- arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
- p = name;
- for (firstField = 1; ; firstField = 0) {
-
- /*
- * Scan the next field from the name and convert it to a Tk_Uid.
- * Must copy the field before calling Tk_Uid, so that a terminating
- * NULL may be added without modifying the source string.
- */
-
- if (*p == '*') {
- newEl.flags = WILDCARD;
- p++;
- } else {
- newEl.flags = 0;
- }
- field = p;
- while ((*p != 0) && (*p != '.') && (*p != '*')) {
- p++;
- }
- length = p - field;
- if (length > TMP_SIZE) {
- length = TMP_SIZE;
- }
- strncpy(tmp, field, (size_t) length);
- tmp[length] = 0;
- newEl.nameUid = Tk_GetUid(tmp);
- if (isupper(UCHAR(*field))) {
- newEl.flags |= CLASS;
- }
-
- if (*p != 0) {
-
- /*
- * New element will be a node. If this option can't possibly
- * apply to this main window, then just skip it. Otherwise,
- * add it to the parent, if it isn't already there, and descend
- * into it.
- */
-
- newEl.flags |= NODE;
- if (firstField && !(newEl.flags & WILDCARD)
- && (newEl.nameUid != winPtr->nameUid)
- && (newEl.nameUid != winPtr->classUid)) {
- return;
- }
- for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
- ; elPtr++, count--) {
- if (count == 0) {
- newEl.child.arrayPtr = NewArray(5);
- *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
- arrayPtrPtr = &((*arrayPtrPtr)->nextToUse[-1].child.arrayPtr);
- break;
- }
- if ((elPtr->nameUid == newEl.nameUid)
- && (elPtr->flags == newEl.flags)) {
- arrayPtrPtr = &(elPtr->child.arrayPtr);
- break;
- }
- }
- if (*p == '.') {
- p++;
- }
- } else {
-
- /*
- * New element is a leaf. Add it to the parent, if it isn't
- * already there. If it exists already, keep whichever value
- * has highest priority.
- */
-
- newEl.child.valueUid = Tk_GetUid(value);
- for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
- ; elPtr++, count--) {
- if (count == 0) {
- *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
- return;
- }
- if ((elPtr->nameUid == newEl.nameUid)
- && (elPtr->flags == newEl.flags)) {
- if (elPtr->priority < newEl.priority) {
- elPtr->priority = newEl.priority;
- elPtr->child.valueUid = newEl.child.valueUid;
- }
- return;
- }
- }
- }
- }
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tk_GetOption --
- *
- * Retrieve an option from the option database.
- *
- * Results:
- * The return value is the value specified in the option
- * database for the given name and class on the given
- * window. If there is nothing specified in the database
- * for that option, then NULL is returned.
- *
- * Side effects:
- * The internal caches used to speed up option mapping
- * may be modified, if this tkwin is different from the
- * last tkwin used for option retrieval.
- *
- *--------------------------------------------------------------
- */
-
-Tk_Uid
-Tk_GetOption(tkwin, name, className)
- Tk_Window tkwin; /* Token for window that option is
- * associated with. */
- CONST char *name; /* Name of option. */
- CONST char *className; /* Class of option. NULL means there
- * is no class for this option: just
- * check for name. */
-{
- Tk_Uid nameId, classId = NULL;
- char *masqName;
- register Element *elPtr, *bestPtr;
- register int count;
- StackLevel *levelPtr;
- int stackDepth[NUM_STACKS];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- /*
- * Note: no need to call OptionInit here: it will be done by
- * the SetupStacks call below (squeeze out those nanoseconds).
- */
-
- if (tkwin != (Tk_Window) tsdPtr->cachedWindow) {
- SetupStacks((TkWindow *) tkwin, 1);
- }
-
- /*
- * Get a default "best" match.
- */
-
- bestPtr = &tsdPtr->defaultMatch;
-
- /*
- * For megawidget support, we want to have some widget options masquerade
- * as options for other widgets. For example, a combobox has a button in
- * it; this button ought to pick up the *Button.background, etc., options.
- * But because the class of the widget is Combobox, our normal search
- * won't get that option.
- *
- * To work around this, the option name field syntax was extended to allow
- * for a "." in the name; if this character occurs in the name, then it
- * indicates that this name contains a new window class and an option name,
- * ie, "Button.foreground". If we see this form in the name field, we
- * query the option database directly (since the option stacks will not
- * have the information we need).
- */
-
- masqName = strchr(name, (int)'.');
- if (masqName != NULL) {
- /*
- * This option is masquerading with a different window class.
- * Search the stack to the depth it was before the current window's
- * information was pushed (the value for which is stored in the bases
- * field).
- */
- levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
- nameId = Tk_GetUid(masqName+1);
- for (count = 0; count < NUM_STACKS; count++) {
- stackDepth[count] = levelPtr->bases[count];
- }
- } else {
- /*
- * No option masquerading here. Just use the current level to get the
- * stack depths.
- */
- nameId = Tk_GetUid(name);
- for (count = 0; count < NUM_STACKS; count++) {
- stackDepth[count] = tsdPtr->stacks[count]->numUsed;
- }
- }
-
- /*
- * Probe the stacks for matches.
- */
-
- for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els,
- count = stackDepth[EXACT_LEAF_NAME]; count > 0;
- elPtr++, count--) {
- if ((elPtr->nameUid == nameId)
- && (elPtr->priority > bestPtr->priority)) {
- bestPtr = elPtr;
- }
- }
- for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els,
- count = stackDepth[WILDCARD_LEAF_NAME]; count > 0;
- elPtr++, count--) {
- if ((elPtr->nameUid == nameId)
- && (elPtr->priority > bestPtr->priority)) {
- bestPtr = elPtr;
- }
- }
-
- if (className != NULL) {
- classId = Tk_GetUid(className);
- for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els,
- count = stackDepth[EXACT_LEAF_CLASS]; count > 0;
- elPtr++, count--) {
- if ((elPtr->nameUid == classId)
- && (elPtr->priority > bestPtr->priority)) {
- bestPtr = elPtr;
- }
- }
- for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els,
- count = stackDepth[WILDCARD_LEAF_CLASS]; count > 0;
- elPtr++, count--) {
- if ((elPtr->nameUid == classId)
- && (elPtr->priority > bestPtr->priority)) {
- bestPtr = elPtr;
- }
- }
- }
-
- /*
- * If this option was masquerading with a different window class,
- * probe the option database now. Note that this will be inefficient
- * if the option database is densely populated, or if the widget has many
- * masquerading options.
- */
-
- if (masqName != NULL) {
- char *masqClass;
- Tk_Uid nodeId, winClassId, winNameId;
- unsigned int classNameLength;
- register Element *nodePtr, *leafPtr;
- static int searchOrder[] = { EXACT_NODE_NAME,
- WILDCARD_NODE_NAME,
- EXACT_NODE_CLASS,
- WILDCARD_NODE_CLASS,
- -1 };
- int *currentPtr, currentStack, leafCount;
-
- /*
- * Extract the masquerade class name from the name field.
- */
-
- classNameLength = (unsigned int)(masqName - name);
- masqClass = (char *)ckalloc(classNameLength + 1);
- strncpy(masqClass, name, classNameLength);
- masqClass[classNameLength] = '\0';
-
- winClassId = Tk_GetUid(masqClass);
- ckfree(masqClass);
- winNameId = ((TkWindow *)tkwin)->nameUid;
-
- levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
-
- for (currentPtr = searchOrder; *currentPtr != -1; currentPtr++) {
- currentStack = *currentPtr;
- nodePtr = tsdPtr->stacks[currentStack]->els;
- count = levelPtr->bases[currentStack];
-
- /*
- * For wildcard stacks, check all entries; for non-wildcard
- * stacks, only check things that matched in the parent.
- */
-
- if (!(currentStack & WILDCARD)) {
- nodePtr += levelPtr[-1].bases[currentStack];
- count -= levelPtr[-1].bases[currentStack];
- }
-
- if (currentStack && CLASS) {
- nodeId = winClassId;
- } else {
- nodeId = winNameId;
- }
-
- for ( ; count > 0; nodePtr++, count--) {
- if (nodePtr->nameUid == nodeId) {
- leafPtr = nodePtr->child.arrayPtr->els;
- leafCount = nodePtr->child.arrayPtr->numUsed;
- for ( ; leafCount > 0; leafPtr++, leafCount--) {
- if (leafPtr->flags & CLASS && className != NULL) {
- if (leafPtr->nameUid == classId &&
- leafPtr->priority > bestPtr->priority) {
- bestPtr = leafPtr;
- }
- } else {
- if (leafPtr->nameUid == nameId &&
- leafPtr->priority > bestPtr->priority) {
- bestPtr = leafPtr;
- }
- }
- }
- }
- }
- }
- }
-
- return bestPtr->child.valueUid;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tk_OptionObjCmd --
- *
- * This procedure is invoked to process the "option" Tcl command.
- * See the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *--------------------------------------------------------------
- */
-
-int
-Tk_OptionObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of Tcl_Obj arguments. */
- Tcl_Obj *CONST objv[]; /* Tcl_Obj arguments. */
-{
- Tk_Window tkwin = (Tk_Window) clientData;
- int index, result;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- static CONST char *optionCmds[] = {
- "add", "clear", "get", "readfile", NULL
- };
-
- enum optionVals {
- OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE
- };
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "cmd arg ?arg ...?");
- return TCL_ERROR;
- }
-
- result = Tcl_GetIndexFromObj(interp, objv[1], optionCmds, "option", 0,
- &index);
- if (result != TCL_OK) {
- return result;
- }
-
- result = TCL_OK;
- switch ((enum optionVals) index) {
- case OPTION_ADD: {
- int priority;
- if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 2, objv, "pattern value ?priority?");
- return TCL_ERROR;
- }
-
- if (objc == 4) {
- priority = TK_INTERACTIVE_PRIO;
- } else {
- priority = ParsePriority(interp, Tcl_GetString(objv[4]));
- if (priority < 0) {
- return TCL_ERROR;
- }
- }
- Tk_AddOption(tkwin, Tcl_GetString(objv[2]),
- Tcl_GetString(objv[3]), priority);
- break;
- }
-
- case OPTION_CLEAR: {
- TkMainInfo *mainPtr;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "");
- return TCL_ERROR;
- }
- mainPtr = ((TkWindow *) tkwin)->mainPtr;
- if (mainPtr->optionRootPtr != NULL) {
- ClearOptionTree(mainPtr->optionRootPtr);
- mainPtr->optionRootPtr = NULL;
- }
- tsdPtr->cachedWindow = NULL;
- break;
- }
-
- case OPTION_GET: {
- Tk_Window window;
- Tk_Uid value;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "window name class");
- return TCL_ERROR;
- }
- window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
- if (window == NULL) {
- return TCL_ERROR;
- }
- value = Tk_GetOption(window, Tcl_GetString(objv[3]),
- Tcl_GetString(objv[4]));
- if (value != NULL) {
- Tcl_SetResult(interp, (char *)value, TCL_STATIC);
- }
- break;
- }
-
- case OPTION_READFILE: {
- int priority;
-
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "fileName ?priority?");
- return TCL_ERROR;
- }
-
- if (objc == 4) {
- priority = ParsePriority(interp, Tcl_GetString(objv[3]));
- if (priority < 0) {
- return TCL_ERROR;
- }
- } else {
- priority = TK_INTERACTIVE_PRIO;
- }
- result = ReadOptionFile(interp, tkwin, Tcl_GetString(objv[2]),
- priority);
- break;
- }
- }
- return result;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TkOptionDeadWindow --
- *
- * This procedure is called whenever a window is deleted.
- * It cleans up any option-related stuff associated with
- * the window.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Option-related resources are freed. See code below
- * for details.
- *
- *--------------------------------------------------------------
- */
-
-void
-TkOptionDeadWindow(winPtr)
- register TkWindow *winPtr; /* Window to be cleaned up. */
-{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- /*
- * If this window is in the option stacks, then clear the stacks.
- */
-
- if (winPtr->optionLevel != -1) {
- int i;
-
- for (i = 1; i <= tsdPtr->curLevel; i++) {
- tsdPtr->levels[i].winPtr->optionLevel = -1;
- }
- tsdPtr->curLevel = -1;
- tsdPtr->cachedWindow = NULL;
- }
-
- /*
- * If this window was a main window, then delete its option
- * database.
- */
-
- if ((winPtr->mainPtr != NULL) && (winPtr->mainPtr->winPtr == winPtr)
- && (winPtr->mainPtr->optionRootPtr != NULL)) {
- ClearOptionTree(winPtr->mainPtr->optionRootPtr);
- winPtr->mainPtr->optionRootPtr = NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkOptionClassChanged --
- *
- * This procedure is invoked when a window's class changes. If
- * the window is on the option cache, this procedure flushes
- * any information for the window, since the new class could change
- * what is relevant.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The option cache may be flushed in part or in whole.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TkOptionClassChanged(winPtr)
- TkWindow *winPtr; /* Window whose class changed. */
-{
- int i, j, *basePtr;
- ElArray *arrayPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- if (winPtr->optionLevel == -1) {
- return;
- }
-
- /*
- * Find the lowest stack level that refers to this window, then
- * flush all of the levels above the matching one.
- */
-
- for (i = 1; i <= tsdPtr->curLevel; i++) {
- if (tsdPtr->levels[i].winPtr == winPtr) {
- for (j = i; j <= tsdPtr->curLevel; j++) {
- tsdPtr->levels[j].winPtr->optionLevel = -1;
- }
- tsdPtr->curLevel = i-1;
- basePtr = tsdPtr->levels[i].bases;
- for (j = 0; j < NUM_STACKS; j++) {
- arrayPtr = tsdPtr->stacks[j];
- arrayPtr->numUsed = basePtr[j];
- arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
- }
- if (tsdPtr->curLevel <= 0) {
- tsdPtr->cachedWindow = NULL;
- } else {
- tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr;
- }
- break;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParsePriority --
- *
- * Parse a string priority value.
- *
- * Results:
- * The return value is the integer priority level corresponding
- * to string, or -1 if string doesn't point to a valid priority level.
- * In this case, an error message is left in the interp's result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParsePriority(interp, string)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- char *string; /* Describes a priority level, either
- * symbolically or numerically. */
-{
- int priority, c;
- size_t length;
-
- c = string[0];
- length = strlen(string);
- if ((c == 'w')
- && (strncmp(string, "widgetDefault", length) == 0)) {
- return TK_WIDGET_DEFAULT_PRIO;
- } else if ((c == 's')
- && (strncmp(string, "startupFile", length) == 0)) {
- return TK_STARTUP_FILE_PRIO;
- } else if ((c == 'u')
- && (strncmp(string, "userDefault", length) == 0)) {
- return TK_USER_DEFAULT_PRIO;
- } else if ((c == 'i')
- && (strncmp(string, "interactive", length) == 0)) {
- return TK_INTERACTIVE_PRIO;
- } else {
- char *end;
-
- priority = strtoul(string, &end, 0);
- if ((end == string) || (*end != 0) || (priority < 0)
- || (priority > 100)) {
- Tcl_AppendResult(interp, "bad priority level \"", string,
- "\": must be widgetDefault, startupFile, userDefault, ",
- "interactive, or a number between 0 and 100",
- (char *) NULL);
- return -1;
- }
- }
- return priority;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AddFromString --
- *
- * Given a string containing lines in the standard format for
- * X resources (see other documentation for details on what this
- * is), parse the resource specifications and enter them as options
- * for tkwin's main window.
- *
- * Results:
- * The return value is a standard Tcl return code. In the case of
- * an error in parsing string, TCL_ERROR will be returned and an
- * error message will be left in the interp's result. The memory at
- * string is totally trashed by this procedure. If you care about
- * its contents, make a copy before calling here.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-AddFromString(interp, tkwin, string, priority)
- Tcl_Interp *interp; /* Interpreter to use for reporting results. */
- Tk_Window tkwin; /* Token for window: options are entered
- * for this window's main window. */
- char *string; /* String containing option specifiers. */
- int priority; /* Priority level to use for options in
- * this string, such as TK_USER_DEFAULT_PRIO
- * or TK_INTERACTIVE_PRIO. Must be between
- * 0 and TK_MAX_PRIO. */
-{
- register char *src, *dst;
- char *name, *value;
- int lineNum;
-
- src = string;
- lineNum = 1;
- while (1) {
-
- /*
- * Skip leading white space and empty lines and comment lines, and
- * check for the end of the spec.
- */
-
- while ((*src == ' ') || (*src == '\t')) {
- src++;
- }
- if ((*src == '#') || (*src == '!')) {
- do {
- src++;
- if ((src[0] == '\\') && (src[1] == '\n')) {
- src += 2;
- lineNum++;
- }
- } while ((*src != '\n') && (*src != 0));
- }
- if (*src == '\n') {
- src++;
- lineNum++;
- continue;
- }
- if (*src == '\0') {
- break;
- }
-
- /*
- * Parse off the option name, collapsing out backslash-newline
- * sequences of course.
- */
-
- dst = name = src;
- while (*src != ':') {
- if ((*src == '\0') || (*src == '\n')) {
- char buf[32 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "missing colon on line %d", lineNum);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- return TCL_ERROR;
- }
- if ((src[0] == '\\') && (src[1] == '\n')) {
- src += 2;
- lineNum++;
- } else {
- *dst = *src;
- dst++;
- src++;
- }
- }
-
- /*
- * Eliminate trailing white space on the name, and null-terminate
- * it.
- */
-
- while ((dst != name) && ((dst[-1] == ' ') || (dst[-1] == '\t'))) {
- dst--;
- }
- *dst = '\0';
-
- /*
- * Skip white space between the name and the value.
- */
-
- src++;
- while ((*src == ' ') || (*src == '\t')) {
- src++;
- }
- if (*src == '\0') {
- char buf[32 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "missing value on line %d", lineNum);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- return TCL_ERROR;
- }
-
- /*
- * Parse off the value, squeezing out backslash-newline sequences
- * along the way.
- */
-
- dst = value = src;
- while (*src != '\n') {
- if (*src == '\0') {
- char buf[32 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "missing newline on line %d", lineNum);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- return TCL_ERROR;
- }
- if ((src[0] == '\\') && (src[1] == '\n')) {
- src += 2;
- lineNum++;
- } else {
- *dst = *src;
- dst++;
- src++;
- }
- }
- *dst = 0;
-
- /*
- * Enter the option into the database.
- */
-
- Tk_AddOption(tkwin, name, value, priority);
- src++;
- lineNum++;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReadOptionFile --
- *
- * Read a file of options ("resources" in the old X terminology)
- * and load them into the option database.
- *
- * Results:
- * The return value is a standard Tcl return code. In the case of
- * an error in parsing string, TCL_ERROR will be returned and an
- * error message will be left in the interp's result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ReadOptionFile(interp, tkwin, fileName, priority)
- Tcl_Interp *interp; /* Interpreter to use for reporting results. */
- Tk_Window tkwin; /* Token for window: options are entered
- * for this window's main window. */
- char *fileName; /* Name of file containing options. */
- int priority; /* Priority level to use for options in
- * this file, such as TK_USER_DEFAULT_PRIO
- * or TK_INTERACTIVE_PRIO. Must be between
- * 0 and TK_MAX_PRIO. */
-{
- CONST char *realName;
- char *buffer;
- int result, bufferSize;
- Tcl_Channel chan;
- Tcl_DString newName;
-
- /*
- * Prevent file system access in a safe interpreter.
- */
-
- if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "can't read options from a file in a",
- " safe interpreter", (char *) NULL);
- return TCL_ERROR;
- }
-
- realName = Tcl_TranslateFileName(interp, fileName, &newName);
- if (realName == NULL) {
- return TCL_ERROR;
- }
- chan = Tcl_OpenFileChannel(interp, realName, "r", 0);
- Tcl_DStringFree(&newName);
- if (chan == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't open \"", fileName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Compute size of file by seeking to the end of the file. This will
- * overallocate if we are performing CRLF translation.
- */
-
- bufferSize = (int) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_END);
- (void) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET);
-
- if (bufferSize < 0) {
- Tcl_AppendResult(interp, "error seeking to end of file \"",
- fileName, "\":", Tcl_PosixError(interp), (char *) NULL);
- Tcl_Close(NULL, chan);
- return TCL_ERROR;
-
- }
- buffer = (char *) ckalloc((unsigned) bufferSize+1);
- bufferSize = Tcl_Read(chan, buffer, bufferSize);
- if (bufferSize < 0) {
- Tcl_AppendResult(interp, "error reading file \"", fileName, "\":",
- Tcl_PosixError(interp), (char *) NULL);
- Tcl_Close(NULL, chan);
- return TCL_ERROR;
- }
- Tcl_Close(NULL, chan);
- buffer[bufferSize] = 0;
- result = AddFromString(interp, tkwin, buffer, priority);
- ckfree(buffer);
- return result;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * NewArray --
- *
- * Create a new ElArray structure of a given size.
- *
- * Results:
- * The return value is a pointer to a properly initialized
- * element array with "numEls" space. The array is marked
- * as having no active elements.
- *
- * Side effects:
- * Memory is allocated.
- *
- *--------------------------------------------------------------
- */
-
-static ElArray *
-NewArray(numEls)
- int numEls; /* How many elements of space to allocate. */
-{
- register ElArray *arrayPtr;
-
- arrayPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(numEls));
- arrayPtr->arraySize = numEls;
- arrayPtr->numUsed = 0;
- arrayPtr->nextToUse = arrayPtr->els;
- return arrayPtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * ExtendArray --
- *
- * Add a new element to an array, extending the array if
- * necessary.
- *
- * Results:
- * The return value is a pointer to the new array, which
- * will be different from arrayPtr if the array got expanded.
- *
- * Side effects:
- * Memory may be allocated or freed.
- *
- *--------------------------------------------------------------
- */
-
-static ElArray *
-ExtendArray(arrayPtr, elPtr)
- register ElArray *arrayPtr; /* Array to be extended. */
- register Element *elPtr; /* Element to be copied into array. */
-{
- /*
- * If the current array has filled up, make it bigger.
- */
-
- if (arrayPtr->numUsed >= arrayPtr->arraySize) {
- register ElArray *newPtr;
-
- newPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(2*arrayPtr->arraySize));
- newPtr->arraySize = 2*arrayPtr->arraySize;
- newPtr->numUsed = arrayPtr->numUsed;
- newPtr->nextToUse = &newPtr->els[newPtr->numUsed];
- memcpy((VOID *) newPtr->els, (VOID *) arrayPtr->els,
- (arrayPtr->arraySize*sizeof(Element)));
- ckfree((char *) arrayPtr);
- arrayPtr = newPtr;
- }
-
- *arrayPtr->nextToUse = *elPtr;
- arrayPtr->nextToUse++;
- arrayPtr->numUsed++;
- return arrayPtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * SetupStacks --
- *
- * Arrange the stacks so that they cache all the option
- * information for a particular window.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The stacks are modified to hold information for tkwin
- * and all its ancestors in the window hierarchy.
- *
- *--------------------------------------------------------------
- */
-
-static void
-SetupStacks(winPtr, leaf)
- TkWindow *winPtr; /* Window for which information is to
- * be cached. */
- int leaf; /* Non-zero means this is the leaf
- * window being probed. Zero means this
- * is an ancestor of the desired leaf. */
-{
- int level, i, *iPtr;
- register StackLevel *levelPtr;
- register ElArray *arrayPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- /*
- * The following array defines the order in which the current
- * stacks are searched to find matching entries to add to the
- * stacks. Given the current priority-based scheme, the order
- * below is no longer relevant; all that matters is that an
- * element is on the list *somewhere*. The ordering is a relic
- * of the old days when priorities were determined differently.
- */
-
- static int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME,
- EXACT_NODE_CLASS, EXACT_NODE_NAME, -1};
-
- if (winPtr->mainPtr->optionRootPtr == NULL) {
- OptionInit(winPtr->mainPtr);
- }
-
- /*
- * Step 1: make sure that options are cached for this window's
- * parent.
- */
-
- if (winPtr->parentPtr != NULL) {
- level = winPtr->parentPtr->optionLevel;
- if ((level == -1) || (tsdPtr->cachedWindow == NULL)) {
- SetupStacks(winPtr->parentPtr, 0);
- level = winPtr->parentPtr->optionLevel;
- }
- level++;
- } else {
- level = 1;
- }
-
- /*
- * Step 2: pop extra unneeded information off the stacks and
- * mark those windows as no longer having cached information.
- */
-
- if (tsdPtr->curLevel >= level) {
- while (tsdPtr->curLevel >= level) {
- tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1;
- tsdPtr->curLevel--;
- }
- levelPtr = &tsdPtr->levels[level];
- for (i = 0; i < NUM_STACKS; i++) {
- arrayPtr = tsdPtr->stacks[i];
- arrayPtr->numUsed = levelPtr->bases[i];
- arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
- }
- }
- tsdPtr->curLevel = winPtr->optionLevel = level;
-
- /*
- * Step 3: if the root database information isn't loaded or
- * isn't valid, initialize level 0 of the stack from the
- * database root (this only happens if winPtr is a main window).
- */
-
- if ((tsdPtr->curLevel == 1)
- && ((tsdPtr->cachedWindow == NULL)
- || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) {
- for (i = 0; i < NUM_STACKS; i++) {
- arrayPtr = tsdPtr->stacks[i];
- arrayPtr->numUsed = 0;
- arrayPtr->nextToUse = arrayPtr->els;
- }
- ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
- }
-
- /*
- * Step 4: create a new stack level; grow the level array if
- * we've run out of levels. Clear the stacks for EXACT_LEAF_NAME
- * and EXACT_LEAF_CLASS (anything that was there is of no use
- * any more).
- */
-
- if (tsdPtr->curLevel >= tsdPtr->numLevels) {
- StackLevel *newLevels;
-
- newLevels = (StackLevel *) ckalloc((unsigned)
- (tsdPtr->numLevels*2*sizeof(StackLevel)));
- memcpy((VOID *) newLevels, (VOID *) tsdPtr->levels,
- (tsdPtr->numLevels*sizeof(StackLevel)));
- ckfree((char *) tsdPtr->levels);
- tsdPtr->numLevels *= 2;
- tsdPtr->levels = newLevels;
- }
- levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
- levelPtr->winPtr = winPtr;
- arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME];
- arrayPtr->numUsed = 0;
- arrayPtr->nextToUse = arrayPtr->els;
- arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS];
- arrayPtr->numUsed = 0;
- arrayPtr->nextToUse = arrayPtr->els;
- for (i = 0; i < NUM_STACKS; i++) {
- levelPtr->bases[i] = tsdPtr->stacks[i]->numUsed;
- }
- /*
- * Step 5: scan the current stack level looking for matches to this
- * window's name or class; where found, add new information to the
- * stacks.
- */
-
- for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
- register Element *elPtr;
- int count;
- Tk_Uid id;
-
- i = *iPtr;
- if (i & CLASS) {
- id = winPtr->classUid;
- } else {
- id = winPtr->nameUid;
- }
- elPtr = tsdPtr->stacks[i]->els;
- count = levelPtr->bases[i];
-
- /*
- * For wildcard stacks, check all entries; for non-wildcard
- * stacks, only check things that matched in the parent.
- */
-
- if (!(i & WILDCARD)) {
- elPtr += levelPtr[-1].bases[i];
- count -= levelPtr[-1].bases[i];
- }
- for ( ; count > 0; elPtr++, count--) {
- if (elPtr->nameUid != id) {
- continue;
- }
- ExtendStacks(elPtr->child.arrayPtr, leaf);
- }
- }
- tsdPtr->cachedWindow = winPtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * ExtendStacks --
- *
- * Given an element array, copy all the elements from the
- * array onto the system stacks (except for irrelevant leaf
- * elements).
- *
- * Results:
- * None.
- *
- * Side effects:
- * The option stacks are extended.
- *
- *--------------------------------------------------------------
- */
-
-static void
-ExtendStacks(arrayPtr, leaf)
- ElArray *arrayPtr; /* Array of elements to copy onto stacks. */
- int leaf; /* If zero, then don't copy exact leaf
- * elements. */
-{
- register int count;
- register Element *elPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
- count > 0; elPtr++, count--) {
- if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
- continue;
- }
- tsdPtr->stacks[elPtr->flags] = ExtendArray(
- tsdPtr->stacks[elPtr->flags], elPtr);
- }
-}
-
-/*
- *--------------------------------------------------------------
- *
- * OptionThreadExitProc --
- *
- * Free data structures for option handling.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Option-related data structures get freed.
- *
- *--------------------------------------------------------------
- */
-
-static void
-OptionThreadExitProc(clientData)
- ClientData clientData; /* not used */
-{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- if (tsdPtr->initialized) {
- int i;
- for (i = 0; i < NUM_STACKS; i++) {
- ckfree((char *) tsdPtr->stacks[i]);
- }
- ckfree((char *) tsdPtr->levels);
- tsdPtr->initialized = 0;
- }
-}
-
-/*
- *--------------------------------------------------------------
- *
- * OptionInit --
- *
- * Initialize data structures for option handling.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Option-related data structures get initialized.
- *
- *--------------------------------------------------------------
- */
-
-static void
-OptionInit(mainPtr)
- register TkMainInfo *mainPtr; /* Top-level information about
- * window that isn't initialized
- * yet. */
-{
- int i;
- Tcl_Interp *interp;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- Element *defaultMatchPtr = &tsdPtr->defaultMatch;
-
- /*
- * First, once-only initialization.
- */
-
- if (tsdPtr->initialized == 0) {
- tsdPtr->initialized = 1;
- tsdPtr->cachedWindow = NULL;
- tsdPtr->numLevels = 5;
- tsdPtr->curLevel = -1;
- tsdPtr->serial = 0;
-
- tsdPtr->levels = (StackLevel *) ckalloc((unsigned)
- (5*sizeof(StackLevel)));
- for (i = 0; i < NUM_STACKS; i++) {
- tsdPtr->stacks[i] = NewArray(10);
- tsdPtr->levels[0].bases[i] = 0;
- }
-
- defaultMatchPtr->nameUid = NULL;
- defaultMatchPtr->child.valueUid = NULL;
- defaultMatchPtr->priority = -1;
- defaultMatchPtr->flags = 0;
- Tcl_CreateThreadExitHandler(OptionThreadExitProc, NULL);
- }
-
- /*
- * Then, per-main-window initialization. Create and delete dummy
- * interpreter for message logging.
- */
-
- mainPtr->optionRootPtr = NewArray(20);
- interp = Tcl_CreateInterp();
- (void) GetDefaultOptions(interp, mainPtr->winPtr);
- Tcl_DeleteInterp(interp);
-}
-
-/*
- *--------------------------------------------------------------
- *
- * ClearOptionTree --
- *
- * This procedure is called to erase everything in a
- * hierarchical option database.
- *
- * Results:
- * None.
- *
- * Side effects:
- * All the options associated with arrayPtr are deleted,
- * along with all option subtrees. The space pointed to
- * by arrayPtr is freed.
- *
- *--------------------------------------------------------------
- */
-
-static void
-ClearOptionTree(arrayPtr)
- ElArray *arrayPtr; /* Array of options; delete everything
- * referred to recursively by this. */
-{
- register Element *elPtr;
- int count;
-
- for (count = arrayPtr->numUsed, elPtr = arrayPtr->els; count > 0;
- count--, elPtr++) {
- if (elPtr->flags & NODE) {
- ClearOptionTree(elPtr->child.arrayPtr);
- }
- }
- ckfree((char *) arrayPtr);
-}
-
-/*
- *--------------------------------------------------------------
- *
- * GetDefaultOptions --
- *
- * This procedure is invoked to load the default set of options
- * for a window.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Options are added to those for winPtr's main window. If
- * there exists a RESOURCE_MANAGER proprety for winPtr's
- * display, that is used. Otherwise, the .Xdefaults file in
- * the user's home directory is used.
- *
- *--------------------------------------------------------------
- */
-
-static int
-GetDefaultOptions(interp, winPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- TkWindow *winPtr; /* Fetch option defaults for main window
- * associated with this. */
-{
- char *regProp;
- int result, actualFormat;
- unsigned long numItems, bytesAfter;
- Atom actualType;
-
- /*
- * Try the RESOURCE_MANAGER property on the root window first.
- */
-
- regProp = NULL;
- result = XGetWindowProperty(winPtr->display,
- RootWindow(winPtr->display, 0),
- XA_RESOURCE_MANAGER, 0, 100000,
- False, XA_STRING, &actualType, &actualFormat,
- &numItems, &bytesAfter, (unsigned char **) &regProp);
-
- if ((result == Success) && (actualType == XA_STRING)
- && (actualFormat == 8)) {
- result = AddFromString(interp, (Tk_Window) winPtr, regProp,
- TK_USER_DEFAULT_PRIO);
- XFree(regProp);
- return result;
- }
-
- /*
- * No luck there. Try a .Xdefaults file in the user's home
- * directory.
- */
-
- if (regProp != NULL) {
- XFree(regProp);
- }
- result = ReadOptionFile(interp, (Tk_Window) winPtr, "~/.Xdefaults",
- TK_USER_DEFAULT_PRIO);
- return result;
-}