static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent)
{
Theme *themePtr = (Theme*)ckalloc(sizeof(Theme));
Tcl_HashEntry *entryPtr;
int unused;
themePtr->parentPtr = parent;
themePtr->enabledProc = ThemeEnabled;
themePtr->enabledData = NULL;
themePtr->cache = cache;
Tcl_InitHashTable(&themePtr->elementTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&themePtr->styleTable, TCL_STRING_KEYS);
/*
* Create root style "."
*/
entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused);
themePtr->rootStyle = NewStyle();
themePtr->rootStyle->styleName =
Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
themePtr->rootStyle->cache = themePtr->cache;
Tcl_SetHashValue(entryPtr, (ClientData)themePtr->rootStyle);
return themePtr;
}
static void
AtomInit(
TkDisplay *dispPtr)/* Display to initialize. */
{
Tcl_HashEntry *hPtr;
Atom atom;
dispPtr->atomInit = 1;
Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);
for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
const char *name;
int isNew;
hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
if (hPtr != NULL) {
continue;
}
name = atomNameArray[atom - 1];
hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
Tcl_SetHashValue(hPtr, atom);
name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom, &isNew);
Tcl_SetHashValue(hPtr, name);
}
}
TNPtr
tn_dup (TPtr dst, TNPtr src)
{
TNPtr dstn;
dstn = tn_new (dst, Tcl_GetString (src->name));
if (src->attr) {
int i, new;
Tcl_HashSearch hs;
Tcl_HashEntry* he;
Tcl_HashEntry* dhe;
CONST char* key;
Tcl_Obj* val;
dstn->attr = ALLOC (Tcl_HashTable);
Tcl_InitHashTable(dstn->attr, TCL_STRING_KEYS);
for(i = 0, he = Tcl_FirstHashEntry(src->attr, &hs);
he != NULL;
he = Tcl_NextHashEntry(&hs), i++) {
key = Tcl_GetHashKey (src->attr, he);
val = (Tcl_Obj*) Tcl_GetHashValue(he);
dhe = Tcl_CreateHashEntry(dstn->attr, key, &new);
Tcl_IncrRefCount (val);
Tcl_SetHashValue (dhe, (ClientData) val);
}
}
void
Nsf_PointerExit(Tcl_Interp *interp) {
nonnull_assert(interp != NULL);
NsfMutexLock(&pointerMutex);
if (--pointerTableRefCount == 0) {
if (RUNTIME_STATE(interp)->logSeverity == NSF_LOG_DEBUG) {
Tcl_HashSearch hSrch;
const Tcl_HashEntry *hPtr;
for (hPtr = Tcl_FirstHashEntry(pointerHashTablePtr, &hSrch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSrch)) {
const char *key = Tcl_GetHashKey(pointerHashTablePtr, hPtr);
const void *valuePtr = Tcl_GetHashValue(hPtr);
/*
* We can't use NsfLog here any more, since the Tcl procs are
* already deleted.
*/
fprintf(stderr, "Nsf_PointerExit: we have still an entry %s with value %p\n", key, valuePtr);
}
}
Tcl_DeleteHashTable(pointerHashTablePtr);
}
/*fprintf(stderr, "Nsf_PointerExit pointerTableRefCount == %d\n", pointerTableRefCount);*/
NsfMutexUnlock(&pointerMutex);
}
Atom
Tk_InternAtom(
Tk_Window tkwin, /* Window token; map name to atom for this
* window's display. */
const char *name) /* Name to turn into atom. */
{
TkDisplay *dispPtr;
Tcl_HashEntry *hPtr;
int isNew;
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (!dispPtr->atomInit) {
AtomInit(dispPtr);
}
hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
if (isNew) {
Tcl_HashEntry *hPtr2;
Atom atom;
atom = XInternAtom(dispPtr->display, name, False);
Tcl_SetHashValue(hPtr, atom);
hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, (char*) atom, &isNew);
Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr));
}
return (Atom) Tcl_GetHashValue(hPtr);
}
void Merge_RR_Hashes(member* prev_member, member *new_member)
{
Tcl_HashTable *prev_table = &prev_member->RR_Hash;
Tcl_HashTable *new_table = &new_member->RR_Hash;
Tcl_HashEntry *prev_entry, *new_entry;
Tcl_HashSearch the_search;
receiver_report *prev_info, *new_info;
int created;
new_entry = Tcl_FirstHashEntry(new_table, &the_search);
while (new_entry != NULL) {
prev_entry = Tcl_CreateHashEntry(prev_table,
Tcl_GetHashKey(new_table, new_entry),
&created);
if (created) {
prev_info = (receiver_report *) malloc(sizeof(receiver_report));
Tcl_SetHashValue(prev_entry, (ClientData) prev_info);
new_info = (receiver_report *) Tcl_GetHashValue(new_entry);
memcpy(prev_info, new_info, sizeof(receiver_report));
} else {
prev_info = (receiver_report *) Tcl_GetHashValue(prev_entry);
new_info = (receiver_report *) Tcl_GetHashValue(new_entry);
Merge_RRs(prev_info, new_info);
}
new_entry = Tcl_NextHashEntry(&the_search);
}
return;
}
void
XOTclProfilePrintTable(Tcl_HashTable* table) {
Tcl_HashEntry* topValueHPtr;
long int* topValue;
do {
Tcl_HashSearch hSrch;
Tcl_HashEntry* hPtr = table ?
Tcl_FirstHashEntry(table, &hSrch) : 0;
char* topKey = 0;
topValueHPtr = 0;
topValue = 0;
for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
long int *val = (long int*) Tcl_GetHashValue(hPtr);
if (val && (!topValue || (topValue && *val >= *topValue))) {
topValue = val;
topValueHPtr = hPtr;
topKey = Tcl_GetHashKey(table, hPtr);
}
}
if (topValueHPtr) {
fprintf(stderr, " %15ld %s\n", *topValue, topKey);
ckfree((char*) topValue);
Tcl_DeleteHashEntry(topValueHPtr);
}
} while (topValueHPtr);
}
static int StyleThemeCurrentCmd(
ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[])
{
StylePackageData *pkgPtr = clientData;
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr = NULL;
const char *name = NULL;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, "");
return TCL_ERROR;
}
entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search);
while (entryPtr != NULL) {
Theme *ptr = Tcl_GetHashValue(entryPtr);
if (ptr == pkgPtr->currentTheme) {
name = Tcl_GetHashKey(&pkgPtr->themeTable, entryPtr);
break;
}
entryPtr = Tcl_NextHashEntry(&search);
}
if (name == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"error: failed to get theme name", -1));
Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
return TCL_OK;
}
char *
ts_lua_hash_table_entry_key(Tcl_HashTable * ht_ptr, Tcl_HashEntry * entry_ptr)
{
char *tcl_key;
tcl_key = (char*) Tcl_GetHashKey((Tcl_HashTable *) ht_ptr, (Tcl_HashEntry *) entry_ptr);
return tcl_key;
}
const char *
Tk_NameOfImage(
Tk_ImageMaster imageMaster) /* Token for image. */
{
ImageMaster *masterPtr = (ImageMaster *) imageMaster;
if (masterPtr->hPtr == NULL) {
return NULL;
}
return Tcl_GetHashKey(masterPtr->tablePtr, masterPtr->hPtr);
}
Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
{
int isNew = 0;
Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
&tagTable->tags, tagName, &isNew);
if (isNew) {
tagName = Tcl_GetHashKey(&tagTable->tags, entryPtr);
Tcl_SetHashValue(entryPtr, NewTag(tagTable,tagName));
}
return Tcl_GetHashValue(entryPtr);
}
/*
* Syslog_ListHash - appends to interp result all the values of given
* hash table
*/
static void Syslog_ListHash(Tcl_Interp *interp,Tcl_HashTable *table)
{
Tcl_HashSearch *searchPtr=(Tcl_HashSearch *)
Tcl_Alloc(sizeof(Tcl_HashSearch));
Tcl_HashEntry *entry;
char separator[3]={' ',' ',0};
entry=Tcl_FirstHashEntry(table,searchPtr);
while (entry) {
Tcl_AppendResult(interp,separator,Tcl_GetHashKey(table,entry),NULL);
separator[0]=',';
entry=Tcl_NextHashEntry(searchPtr);
}
Tcl_Free((char *)searchPtr);
}
void
TnmAttrList(Tcl_HashTable *tablePtr, Tcl_Interp *interp)
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Tcl_Obj *listPtr, *elemObjPtr;
listPtr = Tcl_GetObjResult(interp);
entryPtr = Tcl_FirstHashEntry(tablePtr, &search);
while (entryPtr) {
elemObjPtr = Tcl_NewStringObj(Tcl_GetHashKey(tablePtr, entryPtr), -1);
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
entryPtr = Tcl_NextHashEntry(&search);
}
}
/* HashTableToDict --
* Helper routine. Converts a TCL_STRING_KEYS Tcl_HashTable
* with Tcl_Obj * entries into a dictionary.
*/
static Tcl_Obj* HashTableToDict(Tcl_HashTable *ht)
{
Tcl_HashSearch search;
Tcl_Obj *result = Tcl_NewListObj(0, NULL);
Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
while (entryPtr != NULL) {
Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
Tcl_Obj *valueObj = Tcl_GetHashValue(entryPtr);
Tcl_ListObjAppendElement(NULL, result, nameObj);
Tcl_ListObjAppendElement(NULL, result, valueObj);
entryPtr = Tcl_NextHashEntry(&search);
}
return result;
}
MODULE_SCOPE
int TtkEnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht)
{
Tcl_HashSearch search;
Tcl_Obj *result = Tcl_NewListObj(0, NULL);
Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
while (entryPtr != NULL) {
Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
Tcl_ListObjAppendElement(interp, result, nameObj);
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
Tk_Uid
Tk_GetUid(
const char *string) /* String to convert. */
{
int dummy;
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
if (!tsdPtr->initialized) {
Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
tsdPtr->initialized = 1;
}
return (Tk_Uid) Tcl_GetHashKey(tablePtr,
Tcl_CreateHashEntry(tablePtr, string, &dummy));
}
static int RemoveOneInactiveCart(void)
{
Tcl_HashSearch search;
Tcl_HashEntry *cartEntry;
CartObj *cart;
char *userId;
cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
for(cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
cartEntry != NULL; cartEntry = Tcl_NextHashEntry(&search)) {
cart = Tcl_GetHashValue(cartEntry);
if(cart->inactive) {
userId = Tcl_GetHashKey(cartTablePtr, cartEntry);
DoEmptyCart(userId, TRUE);
return TRUE;
}
}
return FALSE;
}
void
TnmAttrDump(Tcl_HashTable *tablePtr, char *name, Tcl_DString *dsPtr)
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
char *key, *value;
entryPtr = Tcl_FirstHashEntry(tablePtr, &search);
while (entryPtr != NULL) {
key = Tcl_GetHashKey(tablePtr, entryPtr);
value = (char *) Tcl_GetHashValue(entryPtr);
if (isupper(*key) || *key == ':') {
Tcl_DStringAppend(dsPtr, name, -1);
Tcl_DStringAppend(dsPtr, " attribute ", -1);
Tcl_DStringAppendElement(dsPtr, key);
Tcl_DStringAppendElement(dsPtr, value);
Tcl_DStringAppend(dsPtr, "\n", 1);
}
entryPtr = Tcl_NextHashEntry(&search);
}
}
/*
* Read the in-memory representation and write a snapshot file
* that captures it.
*/
static void WriteSnapshot(char *snpPath)
{
Tcl_HashSearch search;
Tcl_HashEntry *cartEntry;
ListOfString *items;
char *userId;
logFile = fopen(snpPath, "w");
assert(logFile != NULL);
cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
for(cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
cartEntry != NULL; cartEntry = Tcl_NextHashEntry(&search)) {
userId = Tcl_GetHashKey(cartTablePtr, cartEntry);
for(items = ((CartObj *) Tcl_GetHashValue(cartEntry))->items;
items != NULL; items = ListOfString_Tail(items)) {
WriteLog(LR_ADD_ITEM, userId, ListOfString_Head(items), FALSE);
}
}
fflush(logFile);
fsync(fileno(logFile));
fclose(logFile);
}
Ttk_ElementClass *Ttk_RegisterElement(
Tcl_Interp *interp, /* Where to leave error messages */
Ttk_Theme theme, /* Style engine providing the implementation. */
const char *name, /* Name of new element */
Ttk_ElementSpec *specPtr, /* Static template information */
void *clientData) /* application-specific data */
{
Ttk_ElementClass *elementClass;
Tcl_HashEntry *entryPtr;
int newEntry;
if (specPtr->version != TK_STYLE_VERSION_2) {
/* Version mismatch */
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Internal error: Ttk_RegisterElement (%s): invalid version",
name));
Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION",
NULL);
}
return 0;
}
entryPtr = Tcl_CreateHashEntry(&theme->elementTable, name, &newEntry);
if (!newEntry) {
if (interp) {
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Duplicate element %s", name));
Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL);
}
return 0;
}
name = Tcl_GetHashKey(&theme->elementTable, entryPtr);
elementClass = NewElementClass(name, specPtr, clientData);
Tcl_SetHashValue(entryPtr, elementClass);
return elementClass;
}
Tk_Style
Tk_CreateStyle(
const char *name, /* Name of the style to create. NULL or empty
* means the default system style. */
Tk_StyleEngine engine, /* The style engine. */
ClientData clientData) /* Private data passed as is to engine code. */
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr;
int newEntry;
Style *stylePtr;
/*
* Attempt to create a new entry in the style table.
*/
entryPtr = Tcl_CreateHashEntry(&tsdPtr->styleTable, (name?name:""),
&newEntry);
if (!newEntry) {
/*
* A style was already registered by that name.
*/
return NULL;
}
/*
* Allocate and intitialize a new style.
*/
stylePtr = ckalloc(sizeof(Style));
InitStyle(stylePtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
(engine!=NULL ? (StyleEngine*) engine : tsdPtr->defaultEnginePtr),
clientData);
Tcl_SetHashValue(entryPtr, stylePtr);
return (Tk_Style) stylePtr;
}
const char *
Tk_GetAtomName(
Tk_Window tkwin, /* Window token; map atom to name relative to
* this window's display. */
Atom atom) /* Atom whose name is wanted. */
{
TkDisplay *dispPtr;
Tcl_HashEntry *hPtr;
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (!dispPtr->atomInit) {
AtomInit(dispPtr);
}
hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
if (hPtr == NULL) {
const char *name;
Tk_ErrorHandler handler;
int isNew;
char *mustFree = NULL;
handler = Tk_CreateErrorHandler(dispPtr->display, BadAtom, -1, -1,
NULL, (ClientData) NULL);
name = mustFree = XGetAtomName(dispPtr->display, atom);
if (name == NULL) {
name = "?bad atom?";
}
Tk_DeleteErrorHandler(handler);
hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
Tcl_SetHashValue(hPtr, atom);
if (mustFree) {
XFree(mustFree);
}
name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom, &isNew);
Tcl_SetHashValue(hPtr, name);
}
return Tcl_GetHashValue(hPtr);
}
Tk_StyleEngine
Tk_RegisterStyleEngine(
const char *name, /* Name of the engine to create. NULL or empty
* means the default system engine. */
Tk_StyleEngine parent) /* The engine's parent. NULL means the default
* system engine. */
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr;
int newEntry;
StyleEngine *enginePtr;
/*
* Attempt to create a new entry in the engine table.
*/
entryPtr = Tcl_CreateHashEntry(&tsdPtr->engineTable,
(name != NULL ? name : ""), &newEntry);
if (!newEntry) {
/*
* An engine was already registered by that name.
*/
return NULL;
}
/*
* Allocate and intitialize a new engine.
*/
enginePtr = ckalloc(sizeof(StyleEngine));
InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr),
(StyleEngine *) parent);
Tcl_SetHashValue(entryPtr, enginePtr);
return (Tk_StyleEngine) enginePtr;
}
/*
* Ttk_GetStyle --
* Look up a Style from a Theme, create new style if not found.
*/
Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName)
{
Tcl_HashEntry *entryPtr;
int newStyle;
entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, styleName, &newStyle);
if (newStyle) {
Ttk_Style stylePtr = NewStyle();
const char *dot = strchr(styleName, '.');
if (dot) {
stylePtr->parentStyle = Ttk_GetStyle(themePtr, dot + 1);
} else {
stylePtr->parentStyle = themePtr->rootStyle;
}
stylePtr->styleName = Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
stylePtr->cache = stylePtr->parentStyle->cache;
Tcl_SetHashValue(entryPtr, (ClientData)stylePtr);
return stylePtr;
}
return (Style*)Tcl_GetHashValue(entryPtr);
}
static int
IvyApplicationListCmd(ClientData clientData,
Tcl_Interp *interp,
int argc,
const char **argv)
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # of args: \"",
argv[0], "\"", (char *) NULL);
return TCL_ERROR;
}
entry = Tcl_FirstHashEntry(&app_table, &search);
while (entry) {
Tcl_AppendElement(interp, Tcl_GetHashKey(&app_table, entry));
entry = Tcl_NextHashEntry(&search);
}
return TCL_OK;
}
int
TkTextMarkCmd(
register TkText *textPtr, /* Information about text widget. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
* parsed this command enough to know that
* objv[1] is "mark". */
{
Tcl_HashEntry *hPtr;
TkTextSegment *markPtr;
Tcl_HashSearch search;
TkTextIndex index;
const Tk_SegType *newTypePtr;
int optionIndex;
static const char *markOptionStrings[] = {
"gravity", "names", "next", "previous", "set", "unset", NULL
};
enum markOptions {
MARK_GRAVITY, MARK_NAMES, MARK_NEXT, MARK_PREVIOUS, MARK_SET,
MARK_UNSET
};
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], markOptionStrings, "mark option",
0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum markOptions) optionIndex) {
case MARK_GRAVITY: {
char c;
int length;
char *str;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?");
return TCL_ERROR;
}
str = Tcl_GetStringFromObj(objv[3],&length);
if (length == 6 && !strcmp(str, "insert")) {
markPtr = textPtr->insertMarkPtr;
} else if (length == 7 && !strcmp(str, "current")) {
markPtr = textPtr->currentMarkPtr;
} else {
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "there is no mark named \"",
Tcl_GetString(objv[3]), "\"", NULL);
return TCL_ERROR;
}
markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
}
if (objc == 4) {
if (markPtr->typePtr == &tkTextRightMarkType) {
Tcl_SetResult(interp, "right", TCL_STATIC);
} else {
Tcl_SetResult(interp, "left", TCL_STATIC);
}
return TCL_OK;
}
str = Tcl_GetStringFromObj(objv[4],&length);
c = str[0];
if ((c == 'l') && (strncmp(str, "left", (unsigned)length) == 0)) {
newTypePtr = &tkTextLeftMarkType;
} else if ((c == 'r') &&
(strncmp(str, "right", (unsigned)length) == 0)) {
newTypePtr = &tkTextRightMarkType;
} else {
Tcl_AppendResult(interp, "bad mark gravity \"", str,
"\": must be left or right", NULL);
return TCL_ERROR;
}
TkTextMarkSegToIndex(textPtr, markPtr, &index);
TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr);
markPtr->typePtr = newTypePtr;
TkBTreeLinkSegment(markPtr, &index);
break;
}
case MARK_NAMES:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
Tcl_AppendElement(interp, "insert");
Tcl_AppendElement(interp, "current");
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable,
&search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_AppendElement(interp,
Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr));
}
break;
case MARK_NEXT:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "index");
return TCL_ERROR;
}
return MarkFindNext(interp, textPtr, Tcl_GetString(objv[3]));
case MARK_PREVIOUS:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "index");
return TCL_ERROR;
}
return MarkFindPrev(interp, textPtr, Tcl_GetString(objv[3]));
case MARK_SET:
if (objc != 5) {
Tcl_WrongNumArgs(interp, 3, objv, "markName index");
return TCL_ERROR;
}
if (TkTextGetObjIndex(interp, textPtr, objv[4], &index) != TCL_OK) {
return TCL_ERROR;
}
TkTextSetMark(textPtr, Tcl_GetString(objv[3]), &index);
return TCL_OK;
case MARK_UNSET: {
int i;
for (i = 3; i < objc; i++) {
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable,
Tcl_GetString(objv[i]));
if (hPtr != NULL) {
markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
/*
* Special case not needed with peer widgets.
*/
if ((markPtr == textPtr->insertMarkPtr)
|| (markPtr == textPtr->currentMarkPtr)) {
continue;
}
TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr);
Tcl_DeleteHashEntry(hPtr);
ckfree((char *) markPtr);
}
}
break;
}
}
return TCL_OK;
}
static int
MarkFindPrev(
Tcl_Interp *interp, /* For error reporting */
TkText *textPtr, /* The widget */
const char *string) /* The starting index or mark name */
{
TkTextIndex index;
Tcl_HashEntry *hPtr;
register TkTextSegment *segPtr, *seg2Ptr, *prevPtr;
int offset;
if (!strcmp(string, "insert")) {
segPtr = textPtr->insertMarkPtr;
TkTextMarkSegToIndex(textPtr, segPtr, &index);
} else if (!strcmp(string, "current")) {
segPtr = textPtr->currentMarkPtr;
TkTextMarkSegToIndex(textPtr, segPtr, &index);
} else {
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, string);
if (hPtr != NULL) {
/*
* If given a mark name, return the previous mark in the list of
* segments, even if it happens to be at the same character
* position.
*/
segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
TkTextMarkSegToIndex(textPtr, segPtr, &index);
} else {
/*
* For non-mark name indices we do not return any marks that are
* right at the index.
*/
if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
return TCL_ERROR;
}
for (offset = 0, segPtr = index.linePtr->segPtr;
segPtr != NULL && offset < index.byteIndex;
offset += segPtr->size, segPtr = segPtr->nextPtr) {
/* Empty loop body */
}
}
}
while (1) {
/*
* segPtr points just past the first possible candidate, or at the
* begining of the line.
*/
for (prevPtr = NULL, seg2Ptr = index.linePtr->segPtr;
seg2Ptr != NULL && seg2Ptr != segPtr;
seg2Ptr = seg2Ptr->nextPtr) {
if (seg2Ptr->typePtr == &tkTextRightMarkType ||
seg2Ptr->typePtr == &tkTextLeftMarkType) {
prevPtr = seg2Ptr;
}
}
if (prevPtr != NULL) {
if (prevPtr == textPtr->currentMarkPtr) {
Tcl_SetResult(interp, "current", TCL_STATIC);
} else if (prevPtr == textPtr->insertMarkPtr) {
Tcl_SetResult(interp, "insert", TCL_STATIC);
} else if (prevPtr->body.mark.textPtr != textPtr) {
/*
* Ignore widget-specific marks for the other widgets.
*/
continue;
} else {
Tcl_SetResult(interp,
Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable,
prevPtr->body.mark.hPtr), TCL_STATIC);
}
return TCL_OK;
}
index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr);
if (index.linePtr == NULL) {
return TCL_OK;
}
segPtr = NULL;
}
}
int
TkTextWindowCmd(
register TkText *textPtr, /* Information about text widget. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
* parsed this command enough to know that
* objv[1] is "window". */
{
int optionIndex;
static const char *const windOptionStrings[] = {
"cget", "configure", "create", "names", NULL
};
enum windOptions {
WIND_CGET, WIND_CONFIGURE, WIND_CREATE, WIND_NAMES
};
register TkTextSegment *ewPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], windOptionStrings,
"window option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum windOptions) optionIndex) {
case WIND_CGET: {
TkTextIndex index;
TkTextSegment *ewPtr;
Tcl_Obj *objPtr;
TkTextEmbWindowClient *client;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 3, objv, "index option");
return TCL_ERROR;
}
if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
return TCL_ERROR;
}
ewPtr = TkTextIndexToSeg(&index, NULL);
if (ewPtr->typePtr != &tkTextEmbWindowType) {
Tcl_AppendResult(interp, "no embedded window at index \"",
Tcl_GetString(objv[3]), "\"", NULL);
return TCL_ERROR;
}
/*
* Copy over client specific value before querying.
*/
client = EmbWinGetClient(textPtr, ewPtr);
if (client != NULL) {
ewPtr->body.ew.tkwin = client->tkwin;
} else {
ewPtr->body.ew.tkwin = NULL;
}
objPtr = Tk_GetOptionValue(interp, (char *) &ewPtr->body.ew,
ewPtr->body.ew.optionTable, objv[4], textPtr->tkwin);
if (objPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
case WIND_CONFIGURE: {
TkTextIndex index;
TkTextSegment *ewPtr;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
return TCL_ERROR;
}
if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
return TCL_ERROR;
}
ewPtr = TkTextIndexToSeg(&index, NULL);
if (ewPtr->typePtr != &tkTextEmbWindowType) {
Tcl_AppendResult(interp, "no embedded window at index \"",
Tcl_GetString(objv[3]), "\"", NULL);
return TCL_ERROR;
}
if (objc <= 5) {
TkTextEmbWindowClient *client;
Tcl_Obj *objPtr;
/*
* Copy over client specific value before querying.
*/
client = EmbWinGetClient(textPtr, ewPtr);
if (client != NULL) {
ewPtr->body.ew.tkwin = client->tkwin;
} else {
ewPtr->body.ew.tkwin = NULL;
}
objPtr = Tk_GetOptionInfo(interp, (char *) &ewPtr->body.ew,
ewPtr->body.ew.optionTable, (objc == 5) ? objv[4] : NULL,
textPtr->tkwin);
if (objPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
} else {
TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
/*
* It's probably not true that all window configuration can change
* the line height, so we could be more efficient here and only
* call this when necessary.
*/
TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
return EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4);
}
}
case WIND_CREATE: {
TkTextIndex index;
int lineIndex;
TkTextEmbWindowClient *client;
int res;
/*
* Add a new window. Find where to put the new window, and mark that
* position for redisplay.
*/
if (objc < 4) {
Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
return TCL_ERROR;
}
if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
return TCL_ERROR;
}
/*
* Don't allow insertions on the last (dummy) line of the text.
*/
lineIndex = TkBTreeLinesTo(textPtr, index.linePtr);
if (lineIndex == TkBTreeNumLines(textPtr->sharedTextPtr->tree,
textPtr)) {
lineIndex--;
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
lineIndex, 1000000, &index);
}
/*
* Create the new window segment and initialize it.
*/
ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE);
ewPtr->typePtr = &tkTextEmbWindowType;
ewPtr->size = 1;
ewPtr->body.ew.sharedTextPtr = textPtr->sharedTextPtr;
ewPtr->body.ew.linePtr = NULL;
ewPtr->body.ew.tkwin = NULL;
ewPtr->body.ew.create = NULL;
ewPtr->body.ew.align = ALIGN_CENTER;
ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0;
ewPtr->body.ew.stretch = 0;
ewPtr->body.ew.optionTable = Tk_CreateOptionTable(interp, optionSpecs);
client = (TkTextEmbWindowClient *)
ckalloc(sizeof(TkTextEmbWindowClient));
client->next = NULL;
client->textPtr = textPtr;
client->tkwin = NULL;
client->chunkCount = 0;
client->displayed = 0;
client->parent = ewPtr;
ewPtr->body.ew.clients = client;
/*
* Link the segment into the text widget, then configure it (delete it
* again if the configuration fails).
*/
TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
TkBTreeLinkSegment(ewPtr, &index);
res = EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4);
client->tkwin = ewPtr->body.ew.tkwin;
if (res != TCL_OK) {
TkTextIndex index2;
TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);
TkBTreeDeleteIndexRange(textPtr->sharedTextPtr->tree, &index,
&index2);
return TCL_ERROR;
}
TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
break;
}
case WIND_NAMES: {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable,
&search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_AppendElement(interp,
Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr));
}
break;
}
}
return TCL_OK;
}
static int
CreateElement(
const char *name, /* Name of the element. */
int create) /* Boolean, whether the element is being
* created explicitly (being registered) or
* implicitly (by a derived element). */
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr, *engineEntryPtr;
Tcl_HashSearch search;
int newEntry, elementId, genericId = -1;
char *dot;
StyleEngine *enginePtr;
/*
* Find or create the element.
*/
entryPtr = Tcl_CreateHashEntry(&tsdPtr->elementTable, name, &newEntry);
if (!newEntry) {
elementId = PTR2INT(Tcl_GetHashValue(entryPtr));
if (create) {
tsdPtr->elements[elementId].created = 1;
}
return elementId;
}
/*
* The element didn't exist. If it's a derived element, find or create its
* generic element ID.
*/
dot = strchr(name, '.');
if (dot) {
genericId = CreateElement(dot+1, 0);
}
elementId = tsdPtr->nbElements++;
Tcl_SetHashValue(entryPtr, INT2PTR(elementId));
/*
* Reallocate element table.
*/
tsdPtr->elements = ckrealloc(tsdPtr->elements,
sizeof(Element) * tsdPtr->nbElements);
InitElement(tsdPtr->elements+elementId,
Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId,
genericId, create);
/*
* Reallocate style engines' element table.
*/
engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
while (engineEntryPtr != NULL) {
enginePtr = Tcl_GetHashValue(engineEntryPtr);
enginePtr->elements = ckrealloc(enginePtr->elements,
sizeof(StyledElement) * tsdPtr->nbElements);
InitStyledElement(enginePtr->elements+elementId);
engineEntryPtr = Tcl_NextHashEntry(&search);
}
return elementId;
}
weighted_result *se_tfidf_lucene (char *filename, char *indexname, char *insearchstring)
{
char *word_ptr, *norm_word_ptr;
float sumwt;
float ndocs;
int i, exists;
int tot_docs;
int tot_qterms;
int q_term_freq;
int dummy = 0;
int termidlist[100];
int proxtermidlist[100];
int proxtermlength[100];
int num_found_terms = 0;
char *searchstring = NULL;
Tcl_HashTable *hash_tab, hash_tab_data;
Tcl_HashEntry *entry;
Tcl_HashSearch hash_search;
Tcl_HashTable *q_hash_tab, q_hash_tab_data;
Tcl_HashEntry *q_entry;
Tcl_HashSearch q_hash_search;
Tcl_HashTable *stoplist_hash;
idx_result *index_result;
DB *index_db;
idx_list_entry *idx, *cf_getidx_entry();
long docid;
float docwt;
double log_odds;
int total_q_terms = 0;
int sum_q_terms = 0;
int index_type, morphed;
char *breakletters;
char *keywordletters = " \t\n`~!@$%^&*()_=|\\{[]};:'\",<>?/";
char *urlletters = " \t\n<>";
char *filenameletters = " \t\n<>";
int dist_ndocs = 0; /* see search_stat.h for more details on these */
int min_cf = 0;
int max_cf = 0;
int sum_entries = 0;
int min_entries = 0;
int max_entries = 0;
int n_stopwords = 0;
struct docsum{
int num_qterms;
double sum_wts;
double sum_IDF;
double avg_doclen;
double sum_tf;
double dnorm;
int doclen;
int min_tf;
int max_tf;
} *doc_wts;
double avg_doclen;
double avg_q_tf;
double avg_d_tf;
double qnorm;
double qtweight;
double dtweight;
weighted_result *wt_res, *ranked_res, *se_rank_docs();
char *lastptr;
double p1, p2, p3, p4, p5;
ranking_parameters *rank_parm;
/* these aren't really used at the present time... */
p1 = 0.0;
p2 = 0.0;
p3 = 0.0;
p4 = 0.0;
p5 = 0.0;
if (insearchstring == NULL)
return NULL;
else
searchstring = strdup(insearchstring);
/* Init the hash table for collecting query terms */
q_hash_tab = &q_hash_tab_data;
Tcl_InitHashTable(q_hash_tab,TCL_STRING_KEYS);
/* Init the hash table for collecting weights for each document */
hash_tab = &hash_tab_data;
Tcl_InitHashTable(hash_tab,TCL_ONE_WORD_KEYS);
index_db =
(DB *) cf_index_open(filename, indexname, INDEXFL);
if (index_db == NULL)
return (NULL);
idx = cf_getidx_entry(filename, indexname);
stoplist_hash = &idx->stopwords_hash;
index_type = idx->type;
for (rank_parm = idx->ranking_parameters; rank_parm != NULL; rank_parm = rank_parm->next_parm) {
if (rank_parm->type == 3) {
/* it is an Okapi parameter */
switch(rank_parm->id) {
case 1:
p1 = rank_parm->val;
break;
case 2:
p2 = rank_parm->val;
break;
case 3:
p3 = rank_parm->val;
break;
case 4:
p4 = rank_parm->val;
break;
case 5:
p5 = rank_parm->val;
break;
/* getting to here means that the defaults above are used */
}
}
}
if (index_type & URL_KEY) breakletters = urlletters;
else if (index_type & FILENAME_KEY) breakletters = filenameletters;
else breakletters = keywordletters;
/* get the total number of "documents": components or records indexed */
if (index_type & COMPONENT_INDEX) {
if (idx->comp_parent->comp_db == NULL) {
/* open up the component info index */
idx->comp_parent->comp_db = cf_component_open(idx->comp_parent->config_info->nickname,
idx->comp_parent->name);
}
ndocs = idx->comp_parent->max_component_id;
/* this is currently done VERY EXPENSIVELY and should be changed */
avg_doclen = se_get_avg_component_len(idx->comp_parent);
}
else {
ndocs = (float) cf_getnumdocs(filename);
/* get the average doclength for this database */
avg_doclen = se_get_avg_document_len(filename);
}
/* find first token */
word_ptr = strtok_r (searchstring, breakletters, &lastptr);
do { /* build the query elements */
norm_word_ptr =
normalize_key(word_ptr, idx, &dummy, 1);
if (norm_word_ptr != NULL) {
q_entry = Tcl_FindHashEntry(q_hash_tab,norm_word_ptr);
if (q_entry == NULL){
total_q_terms++;
sum_q_terms++;
Tcl_SetHashValue(
Tcl_CreateHashEntry(
q_hash_tab,
norm_word_ptr,
&exists),
(ClientData)1);
FREE(norm_word_ptr); /* this was allocated in normalize_key */
}
else {
q_term_freq = (int) Tcl_GetHashValue(q_entry);
q_term_freq++;
sum_q_terms++;
/* total_q_terms++; count only unique terms */
Tcl_SetHashValue(q_entry,
(ClientData)q_term_freq);
FREE(norm_word_ptr); /* this was allocated in normalize_key */
}
}
/* get the next word */
word_ptr = strtok_r (NULL, breakletters, &lastptr);
} while (word_ptr != NULL);
qnorm = (double)total_q_terms/(avg_doclen/10.0);
avg_q_tf = ((double)sum_q_terms + 1.0)/((double)total_q_terms + 1.0);
avg_d_tf = ((double)idx->GlobalData->tot_occur + 1.0) / ((double)idx->GlobalData->recptr + 1.0);
for (q_entry = Tcl_FirstHashEntry(q_hash_tab,&q_hash_search);
q_entry != NULL; q_entry = Tcl_NextHashEntry(&q_hash_search)) {
/* get the word/stem and it's frequency in the query from the hash tab */
word_ptr = (char *)Tcl_GetHashKey(q_hash_tab,q_entry);
q_term_freq = (int) Tcl_GetHashValue(q_entry);
qtweight = log((double)q_term_freq+1.0)/log(avg_q_tf+1.0);
/* find it in the index */
if (strchr(word_ptr,'#') != NULL)
index_result = se_gettrunc_idx(idx,word_ptr);
else
index_result = se_getterm_idx(idx,
word_ptr, 0 /* don't normalize twice.*/,
&n_stopwords);
if (index_result != NULL) {
double IDF;
if (num_found_terms < 100)
termidlist[num_found_terms++] = index_result->termid;
/* have the frequency information for this term, so we'll */
/* figure out the term weight */
sumwt = (float) index_result->tot_freq;
IDF = log((double)ndocs/((double)index_result->num_entries + 1.0));
if (min_cf == 0 || min_cf > index_result->tot_freq)
min_cf = index_result->tot_freq;
if (max_cf == 0 || max_cf < index_result->tot_freq)
max_cf = index_result->tot_freq;
sum_entries =+ index_result->num_entries;
if (min_entries == 0 || min_entries > index_result->num_entries)
min_entries = index_result->num_entries;
if (max_entries == 0 || max_entries < index_result->num_entries)
max_entries = index_result->num_entries;
for (i = 0; i < index_result->num_entries; i++) {
if (index_result->entries[i].record_no > 0) { /* forget deleted ones */
entry = Tcl_FindHashEntry(hash_tab,
(void *)index_result->entries[i].record_no);
if (entry == NULL){
doc_wts = CALLOC(struct docsum,1);
doc_wts->num_qterms = 1;
doc_wts->doclen = se_getdoclen(index_result->entries[i].record_no,
filename, idx);
doc_wts->dnorm = ((double)doc_wts->doclen/10.0)/(avg_doclen/10.0);
dtweight = log((double)index_result->entries[i].term_freq+1.0)/log(avg_d_tf + 1.0);
doc_wts->sum_wts = IDF * dtweight * qtweight;
doc_wts->min_tf = doc_wts->max_tf =
index_result->entries[i].term_freq;
doc_wts->sum_IDF = (double)IDF;
doc_wts->sum_tf = (double)index_result->entries[i].term_freq;
doc_wts->avg_doclen = (double)avg_doclen;
Tcl_SetHashValue(
Tcl_CreateHashEntry(
hash_tab,
(void *)index_result->entries[i].record_no,
&exists),
(ClientData)doc_wts);
}
else {
/* add to an existing doc entry */
doc_wts = (struct docsum *) Tcl_GetHashValue(entry);
doc_wts->num_qterms++;
dtweight = log((double)index_result->entries[i].term_freq)/log(avg_d_tf);
doc_wts->sum_wts += IDF * dtweight * qtweight;
if (doc_wts->min_tf > index_result->entries[i].term_freq)
doc_wts->min_tf = index_result->entries[i].term_freq;
if (doc_wts->max_tf < index_result->entries[i].term_freq)
doc_wts->max_tf = index_result->entries[i].term_freq;
}
}
