void
TkDeleteAllImages(
TkMainInfo *mainPtr) /* Structure describing application that is
* going away. */
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
EventuallyDeleteImage(Tcl_GetHashValue(hPtr), 1);
}
Tcl_DeleteHashTable(&mainPtr->imageTable);
}
/*
*--------------------------------------------------------------
*
* Table_ClearHashTable --
* This procedure is invoked to clear a STRING_KEY hash table,
* freeing the string entries and then deleting the hash table.
* The hash table cannot be used after calling this, except to
* be freed or reinitialized.
*
* Results:
* Cached info will be lost.
*
* Side effects:
* Can cause redraw.
* See the user documentation.
*
*--------------------------------------------------------------
*/
void
Table_ClearHashTable(Tcl_HashTable *hashTblPtr)
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
char *value;
for (entryPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
value = (char *) Tcl_GetHashValue(entryPtr);
if (value != NULL) ckfree(value);
}
Tcl_DeleteHashTable(hashTblPtr);
}
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);
}
}
static AP_Result tcl_delete_all(AP_World *ignore)
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
for (entry = Tcl_FirstHashEntry(&tcl_interp_name_table, &search);
entry; entry = Tcl_NextHashEntry(&search)) {
Tcl_DeleteInterp(Tcl_GetHashValue(entry));
}
Tcl_DeleteHashTable(&tcl_interp_name_table);
Tcl_InitHashTable(&tcl_interp_name_table, TCL_STRING_KEYS);
return AP_SUCCESS;
}
/* 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;
}
void
Tfp_ArrayDestroy( Tfp_ArrayType *arr )
{
Tcl_HashEntry *p;
Tcl_HashSearch s;
if (arr->cleanProc != (Tfp_ArrayDeleteProc *) NULL) {
for (p = Tcl_FirstHashEntry( arr->table, &s ); p != (Tcl_HashEntry *) NULL;
p = Tcl_NextHashEntry( &s )) {
(*arr->cleanProc) ( Tcl_GetHashValue( p ) );
}
}
Tcl_DeleteHashTable( arr->table );
Tcl_Free( (char *) arr->table );
Tcl_Free( (char *) arr );
}
static Tcl_HashEntry *
ts_lua_hash_table_iterator_first(Tcl_HashTable *ht_ptr, Tcl_HashSearch * state_ptr)
{
Tcl_HashTable *tcl_ht_ptr;
Tcl_HashSearch *tcl_search_state_ptr;
Tcl_HashEntry *tcl_he_ptr;
Tcl_HashEntry *he_ptr;
tcl_ht_ptr = (Tcl_HashTable *) ht_ptr;
tcl_search_state_ptr = (Tcl_HashSearch *) state_ptr;
tcl_he_ptr = Tcl_FirstHashEntry(tcl_ht_ptr, tcl_search_state_ptr);
he_ptr = tcl_he_ptr;
return he_ptr;
}
static void
ChangeTagPriority(
TkText *textPtr, /* Information about text widget. */
TkTextTag *tagPtr, /* Tag whose priority is to be changed. */
int prio) /* New priority for tag. */
{
int low, high, delta;
register TkTextTag *tagPtr2;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
if (prio < 0) {
prio = 0;
}
if (prio >= textPtr->sharedTextPtr->numTags) {
prio = textPtr->sharedTextPtr->numTags-1;
}
if (prio == tagPtr->priority) {
return;
}
if (prio < tagPtr->priority) {
low = prio;
high = tagPtr->priority-1;
delta = 1;
} else {
low = tagPtr->priority+1;
high = prio;
delta = -1;
}
/*
* Adjust first the 'sel' tag, then all others from the hash table
*/
if ((textPtr->selTagPtr->priority >= low)
&& (textPtr->selTagPtr->priority <= high)) {
textPtr->selTagPtr->priority += delta;
}
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->tagTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
tagPtr2 = Tcl_GetHashValue(hPtr);
if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) {
tagPtr2->priority += delta;
}
}
tagPtr->priority = prio;
}
/**
* Detaches a registry database from the registry object. This does some cleanup
* for an attached registry, then detaches it. Allocated `reg_entry` objects are
* deleted here.
*
* @param [in] reg registry to detach from
* @param [out] errPtr on error, a description of the error that occurred
* @return true if success; false if failure
*/
int reg_detach(reg_registry* reg, reg_error* errPtr) {
sqlite3_stmt* stmt = NULL;
int result = 0;
char* query = "DETACH DATABASE registry";
if (!(reg->status & reg_attached)) {
reg_throw(errPtr,REG_MISUSE,"no database is attached to this registry");
return 0;
}
if (sqlite3_prepare(reg->db, query, -1, &stmt, NULL) == SQLITE_OK) {
int r;
reg_entry* entry;
Tcl_HashEntry* curr;
Tcl_HashSearch search;
/* XXX: Busy waiting, consider using sqlite3_busy_handler/timeout */
do {
sqlite3_step(stmt);
r = sqlite3_reset(stmt);
switch (r) {
case SQLITE_OK:
for (curr = Tcl_FirstHashEntry(®->open_entries, &search);
curr != NULL; curr = Tcl_NextHashEntry(&search)) {
entry = Tcl_GetHashValue(curr);
if (entry->proc) {
free(entry->proc);
}
free(entry);
}
Tcl_DeleteHashTable(®->open_entries);
reg->status &= ~reg_attached;
result = 1;
break;
case SQLITE_BUSY:
break;
default:
reg_sqlite_error(reg->db, errPtr, query);
break;
}
} while (r == SQLITE_BUSY);
} else {
reg_sqlite_error(reg->db, errPtr, query);
}
if (stmt) {
sqlite3_finalize(stmt);
}
return result;
}
static Tcl_HashEntry *
Nsf_PointerGetHptr(void *valuePtr) {
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSrch;
nonnull_assert(valuePtr != NULL);
for (hPtr = Tcl_FirstHashEntry(pointerHashTablePtr, &hSrch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSrch)) {
void *ptr = Tcl_GetHashValue(hPtr);
if (ptr == valuePtr) {
return hPtr;
}
}
return NULL;
}
static void
cleanup_interp(ClientData cdata, Tcl_Interp *interp)
{
Tcl_HashEntry* hashPtr;
Tcl_HashSearch search;
duk_context* ctx;
hashPtr = Tcl_FirstHashEntry(&DUKTCL_CDATA->table, &search);
while (hashPtr != NULL) {
ctx = (duk_context *) Tcl_GetHashValue(hashPtr);
Tcl_SetHashValue(hashPtr, (ClientData) NULL);
duk_destroy_heap(ctx);
hashPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&DUKTCL_CDATA->table);
ckfree((char *)DUKTCL_CDATA);
}
int DBus_MethodCleanup(Tcl_Interp *interp, Tcl_HashTable *members)
{
Tcl_HashEntry *memberPtr;
Tcl_HashSearch search;
Tcl_DBusMethodData *method;
for (memberPtr = Tcl_FirstHashEntry(members, &search);
memberPtr != NULL; memberPtr = Tcl_NextHashEntry(&search)) {
method = Tcl_GetHashValue(memberPtr);
if (method->interp == interp) {
Tcl_DecrRefCount(method->script);
ckfree((char *) method);
Tcl_DeleteHashEntry(memberPtr);
}
}
return Tcl_CheckHashEmpty(members);
}
void DBus_CheckProc(ClientData data, int flags)
{
DBusDispatchStatus dispatch;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DBusBus *dbus;
if (!(flags & TCL_IDLE_EVENTS)) return;
for (hPtr = Tcl_FirstHashEntry(&bus, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
/* Drain the message queue */
do
dispatch = dbus_connection_dispatch(dbus->conn);
while (dispatch == DBUS_DISPATCH_DATA_REMAINS);
}
}
/* ARGSUSED */
static void
TcpAcceptCallbacksDeleteProc(
ClientData clientData, /* Data which was passed when the assocdata
* was registered. */
Tcl_Interp *interp) /* Interpreter being deleted - not used. */
{
Tcl_HashTable *hTblPtr = clientData;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
ckfree((char *) hTblPtr);
}
static void
DeleteSpecCacheTable(
ClientData clientData,
Tcl_Interp *interp)
{
Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
for (entryPtr = Tcl_FirstHashEntry(tablePtr,&search); entryPtr != NULL;
entryPtr = Tcl_NextHashEntry(&search)) {
/*
* Someone else deallocates the Tk_Uids themselves.
*/
ckfree((char *) Tcl_GetHashValue(entryPtr));
}
Tcl_DeleteHashTable(tablePtr);
ckfree((char *) tablePtr);
}
static void remove_tag(register TkText * textPtr, Tcl_Interp * interp, char *text_widget, int del, char *idx1, char *idx2)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
TkTextTag *tagPtr;
int wargc;
char *wargv[10];
wargc = 0;
wargv[wargc++] = text_widget;
wargv[wargc++] = "tag";
wargv[wargc++] = "remove";
wargv[wargc++] = NULL;
wargv[wargc++] = idx1;
wargv[wargc++] = idx2;
for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
if(tagPtr == textPtr->selTagPtr) {
continue;
}
if(del == -1) { /* Should we delete all ? */
/* In Source-Navigator blanks are used in symbol
* definitions tags, highlighting tags don't contain
* any blanks.
*/
if(strchr(tagPtr->name, ' ')) {
wargv[2] = "delete";
wargv[3] = tagPtr->name;
wargc = 4;
} else {
wargv[2] = "remove";
wargv[3] = tagPtr->name;
wargc = 6;
}
} else {
wargv[3] = tagPtr->name;
}
TkTextTagCmd(textPtr, interp, wargc, wargv);
}
}
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);
}
}
//
// called by an exiting thread to notify the UI that it is exiting
// this is necessary so that the UI does not try to send a metrics
// menuing response to a dead tid
//
void
ParadynTkGUI::threadExiting( void )
{
thread_t tid = getRequestingThread();
Tcl_HashSearch *searchPtr = new Tcl_HashSearch;
Tcl_HashEntry *entry = Tcl_FirstHashEntry(&UIMMsgReplyTbl,searchPtr);
// check to see if there is an outstanding metrics menuing request
// for this thread, and if so, remove its entry from the table
while(entry){
UIMReplyRec *msgRec = (UIMReplyRec *)Tcl_GetHashValue(entry);
if(msgRec->tid == tid){
Tcl_DeleteHashEntry(entry);
if(searchPtr) delete searchPtr;
return;
}
entry = Tcl_NextHashEntry(searchPtr);
}
if(searchPtr) delete searchPtr;
}
void BoxVec::step1(double dbx, double dby, char*nm){
/*
pre: valid Tcl interpreter
post: bvhash (Hash table for box marker name searching) initialized
*/
Box *bp;
Box *minbp=NULL, *moveb=NULL;
double mindxy=DBL_MAX;
double mind =DBL_MAX;
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr=Tcl_FirstHashEntry(&bvhash, &search);
while(entryPtr!=NULL){
double dx, dy;
bp=(Box*)(entryPtr->clientData);
dx=bp->nearx(dbx);
dy=bp->neary(dby)*xhalo/yhalo;
if( dx < mindxy && fabs(dby-bp->midyc()) < bp->height()/2.0 ) {mindxy=dx; moveb=bp;}
if( dy < mindxy && fabs(dbx-bp->midxc()) < bp->width()/2.0 ) {mindxy=dy; moveb=bp;}
if( (dx=sqrt(dx*dx+dy*dy*xhalo*xhalo/yhalo/yhalo)) < mind) {mind=dx; minbp=bp;}
entryPtr=Tcl_NextHashEntry(&search);
}
if( mind<xhalo ){
option=RESIZEBOX;
curb=minbp;
curb->nearcorner(dbx,dby,xi,yi);
return;
} else if( mindxy<xhalo){
option=MOVEBOX;
curb=moveb;
} else {
option=NEWBOX;
}
pinx=(int)dbx;
piny=(int)dby;
}
void Ttk_FreeResourceCache(Ttk_ResourceCache cache)
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Ttk_ClearCache(cache);
Tcl_DeleteHashTable(&cache->colorTable);
Tcl_DeleteHashTable(&cache->fontTable);
Tcl_DeleteHashTable(&cache->imageTable);
/*
* Free named colors:
*/
entryPtr = Tcl_FirstHashEntry(&cache->namedColors, &search);
while (entryPtr != NULL) {
Tcl_Obj *colorNameObj = Tcl_GetHashValue(entryPtr);
Tcl_DecrRefCount(colorNameObj);
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&cache->namedColors);
ckfree(cache);
}
void DBus_SetupProc(ClientData data, int flags)
{
Tcl_Time blockTime;
DBusDispatchStatus status;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DBusBus *dbus;
blockTime.sec = 0;
blockTime.usec = 100000;
/* Check the incoming message queues */
for (hPtr = Tcl_FirstHashEntry(&bus, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
dbus_connection_read_write(dbus->conn, 0);
status = dbus_connection_get_dispatch_status(dbus->conn);
if (status == DBUS_DISPATCH_DATA_REMAINS) {
blockTime.sec = 0;
blockTime.usec = 0;
break;
}
}
Tcl_SetMaxBlockTime(&blockTime);
}
static void
MarkCheckProc(
TkTextSegment *markPtr, /* Segment to check. */
TkTextLine *linePtr) /* Line containing segment. */
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
if (markPtr->body.mark.linePtr != linePtr) {
Tcl_Panic("MarkCheckProc: markPtr->body.mark.linePtr bogus");
}
/*
* These two marks are not in the hash table
*/
if (markPtr->body.mark.textPtr->insertMarkPtr == markPtr) {
return;
}
if (markPtr->body.mark.textPtr->currentMarkPtr == markPtr) {
return;
}
/*
* Make sure that the mark is still present in the text's mark hash table.
*/
for (hPtr = Tcl_FirstHashEntry(
&markPtr->body.mark.textPtr->sharedTextPtr->markTable,
&search); hPtr != markPtr->body.mark.hPtr;
hPtr = Tcl_NextHashEntry(&search)) {
if (hPtr == NULL) {
Tcl_Panic("MarkCheckProc couldn't find hash table entry for mark");
}
}
}
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;
}
/*
* Ttk_ClearCache --
* Release references to all cached resources.
*/
static void Ttk_ClearCache(Ttk_ResourceCache cache)
{
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr;
/*
* Free fonts:
*/
entryPtr = Tcl_FirstHashEntry(&cache->fontTable, &search);
while (entryPtr != NULL) {
Tcl_Obj *fontObj = Tcl_GetHashValue(entryPtr);
if (fontObj) {
Tk_FreeFontFromObj(cache->tkwin, fontObj);
Tcl_DecrRefCount(fontObj);
}
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&cache->fontTable);
Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
/*
* Free colors:
*/
entryPtr = Tcl_FirstHashEntry(&cache->colorTable, &search);
while (entryPtr != NULL) {
Tcl_Obj *colorObj = Tcl_GetHashValue(entryPtr);
if (colorObj) {
Tk_FreeColorFromObj(cache->tkwin, colorObj);
Tcl_DecrRefCount(colorObj);
}
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&cache->colorTable);
Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
/*
* Free borders:
*/
entryPtr = Tcl_FirstHashEntry(&cache->borderTable, &search);
while (entryPtr != NULL) {
Tcl_Obj *borderObj = Tcl_GetHashValue(entryPtr);
if (borderObj) {
Tk_Free3DBorderFromObj(cache->tkwin, borderObj);
Tcl_DecrRefCount(borderObj);
}
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&cache->borderTable);
Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
/*
* Free images:
*/
entryPtr = Tcl_FirstHashEntry(&cache->imageTable, &search);
while (entryPtr != NULL) {
Tk_Image image = Tcl_GetHashValue(entryPtr);
if (image) {
Tk_FreeImage(image);
}
entryPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&cache->imageTable);
Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
return;
}
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;
}
void
Tcl_DeleteInterp(
Tcl_Interp *interp /* Token for command interpreter (returned
* by a previous call to Tcl_CreateInterp). */
)
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *he;
Tcl_HashSearch search;
register Command *c;
int i;
/*
* If the interpreter is in use, delay the deletion until later.
*/
iPtr->flags |= DELETED;
if (iPtr->numLevels != 0) {
return;
}
/*
* Free up any remaining resources associated with the
* interpreter.
*/
for (he = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
he != 0; he = Tcl_NextHashEntry(&search)) {
c = (Command *) Tcl_GetHashValue(he);
if (c->deleteProc != 0) {
(*c->deleteProc)(c->clientData);
}
mem_free (c);
}
Tcl_DeleteHashTable(&iPtr->commandTable);
TclDeleteVars(iPtr, &iPtr->globalTable);
if (iPtr->events != 0) {
int i;
for (i = 0; i < iPtr->numEvents; i++) {
mem_free(iPtr->events[i].command);
}
mem_free (iPtr->events);
}
while (iPtr->revPtr != 0) {
HistoryRev *nextPtr = iPtr->revPtr->nextPtr;
mem_free (iPtr->revPtr);
iPtr->revPtr = nextPtr;
}
if (iPtr->appendResult != 0) {
mem_free(iPtr->appendResult);
}
#ifdef TCL_FILE_CMDS
if (iPtr->numFiles > 0) {
for (i = 0; i < iPtr->numFiles; i++) {
OpenFile *filePtr;
filePtr = iPtr->filePtrArray[i];
if (filePtr == 0) {
continue;
}
if (i >= 3) {
fclose(filePtr->f);
if (filePtr->f2 != 0) {
fclose(filePtr->f2);
}
if (filePtr->numPids > 0) {
/* Tcl_DetachPids(filePtr->numPids, filePtr->pidPtr); */
mem_free (filePtr->pidPtr);
}
}
mem_free (filePtr);
}
mem_free (iPtr->filePtrArray);
}
#endif
for (i = 0; i < NUM_REGEXPS; i++) {
if (iPtr->patterns[i] == 0) {
break;
}
mem_free (iPtr->patterns[i]);
mem_free (iPtr->regexps[i]);
}
while (iPtr->tracePtr != 0) {
Trace *nextPtr = iPtr->tracePtr->nextPtr;
mem_free (iPtr->tracePtr);
iPtr->tracePtr = nextPtr;
}
mem_free (iPtr);
}
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;
}
}
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
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;
}
