/* Ttk_TraceVariable(interp, varNameObj, callback, clientdata) --
* Attach a write trace to the specified variable,
* which will pass the variable's value to 'callback'
* whenever the variable is set.
*
* When the variable is unset, passes NULL to the callback
* and reattaches the trace.
*/
Ttk_TraceHandle *Ttk_TraceVariable(
Tcl_Interp *interp,
Tcl_Obj *varnameObj,
Ttk_TraceProc callback,
void *clientData)
{
Ttk_TraceHandle *h = (Ttk_TraceHandle*)ckalloc(sizeof(*h));
int status;
h->interp = interp;
h->varnameObj = Tcl_DuplicateObj(varnameObj);
Tcl_IncrRefCount(h->varnameObj);
h->clientData = clientData;
h->callback = callback;
status = Tcl_TraceVar(interp, Tcl_GetString(varnameObj),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VarTraceProc, (ClientData)h);
if (status != TCL_OK) {
Tcl_DecrRefCount(h->varnameObj);
ckfree((ClientData)h);
return NULL;
}
return h;
}
static int wtInit(ClientData clientData, Tcl_Interp * interp, int argc,
char ** argv) {
newtInit();
newtCls();
newtPushHelpLine("");
Tcl_TraceVar(interp, "whiptcl_backtext",
TCL_TRACE_WRITES | TCL_GLOBAL_ONLY, setBacktext, NULL);
Tcl_TraceVar(interp, "whiptcl_helpline",
TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
setHelptext, NULL);
Tcl_TraceVar(interp, "whiptcl_fullbuttons",
TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
setFullButtons, NULL);
Tcl_SetVar(interp, "whiptcl_helpline", "", TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "whiptcl_fullbuttons", "1", TCL_GLOBAL_ONLY);
return TCL_OK;
}
/* ARGSUSED */
static char *
MenuButtonTextVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *name1, /* Name of variable. */
const char *name2, /* Second part of variable name. */
int flags) /* Information about what happened. */
{
register TkMenuButton *mbPtr = clientData;
const char *value;
unsigned len;
/*
* If the variable is unset, then immediately recreate it unless the whole
* interpreter is going away.
*/
if (flags & TCL_TRACE_UNSETS) {
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, clientData);
}
return NULL;
}
value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
if (value == NULL) {
value = "";
}
if (mbPtr->text != NULL) {
ckfree(mbPtr->text);
}
len = 1 + (unsigned) strlen(value);
mbPtr->text = (char *) ckalloc(len);
memcpy(mbPtr->text, value, len);
TkpComputeMenuButtonGeometry(mbPtr);
if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin)
&& !(mbPtr->flags & REDRAW_PENDING)) {
Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr);
mbPtr->flags |= REDRAW_PENDING;
}
return NULL;
}
char *channels_start(Function * global_funcs)
{
global = global_funcs;
gfld_chan_thr = 10;
gfld_chan_time = 60;
gfld_deop_thr = 3;
gfld_deop_time = 10;
gfld_kick_thr = 3;
gfld_kick_time = 10;
gfld_join_thr = 5;
gfld_join_time = 60;
gfld_ctcp_thr = 5;
gfld_ctcp_time = 60;
global_idle_kick = 0;
Context;
module_register(MODULE_NAME, channels_table, 1, 0);
if (!module_depend(MODULE_NAME, "eggdrop", 105, 3)) {
module_undepend(MODULE_NAME);
return "This module needs eggdrop1.5.3 or later";
}
add_hook(HOOK_MINUTELY, (Function) check_expired_bans);
add_hook(HOOK_MINUTELY, (Function) check_expired_exempts);
add_hook(HOOK_MINUTELY, (Function) check_expired_invites);
add_hook(HOOK_USERFILE, (Function) channels_writeuserfile);
add_hook(HOOK_REHASH, (Function) channels_rehash);
add_hook(HOOK_PRE_REHASH, (Function) channels_prerehash);
Tcl_TraceVar(interp, "global-chanset",
TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
traced_globchanset, NULL);
add_builtins(H_chon, my_chon);
add_builtins(H_dcc, C_dcc_irc);
add_tcl_commands(channels_cmds);
add_tcl_strings(my_tcl_strings);
add_help_reference("channels.help");
add_help_reference("chaninfo.help");
my_tcl_ints[0].val = &share_greet;
add_tcl_ints(my_tcl_ints);
add_tcl_coups(mychan_tcl_coups);
read_channels(0);
setstatic = 1;
return NULL;
}
static char *traced_globchanset(ClientData cdata, Tcl_Interp * irp,
char *name1, char *name2, int flags)
{
char *s;
char *t;
int i;
int items;
char **item;
Context;
if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
Tcl_SetVar2(interp, name1, name2, glob_chanset, TCL_GLOBAL_ONLY);
if (flags & TCL_TRACE_UNSETS)
Tcl_TraceVar(interp, "global-chanset",
TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
traced_globchanset, NULL);
} else { /* write */
s = Tcl_GetVar2(interp, name1, name2, TCL_GLOBAL_ONLY);
Tcl_SplitList(interp, s, &items, &item);
Context;
for (i = 0; i<items; i++) {
if (!(item[i]) || (strlen(item[i]) < 2)) continue;
s = glob_chanset;
while (s[0]) {
t = strchr(s, ' '); /* cant be NULL coz of the extra space */
Context;
t[0] = 0;
if (!strcmp(s + 1, item[i] + 1)) {
s[0] = item[i][0]; /* +- */
t[0] = ' ';
break;
}
t[0] = ' ';
s = t + 1;
}
}
if (item) /* hmm it cant be 0 */
Tcl_Free((char *) item);
Tcl_SetVar2(interp, name1, name2, glob_chanset, TCL_GLOBAL_ONLY);
}
return NULL;
}
int
Tcl_LinkVar(
Tcl_Interp *interp, /* Interpreter in which varName exists. */
CONST char *varName, /* Name of a global variable in interp. */
char *addr, /* Address of a C variable to be linked to
* varName. */
int type) /* Type of C variable: TCL_LINK_INT, etc. Also
* may have TCL_LINK_READ_ONLY OR'ed in. */
{
Tcl_Obj *objPtr;
Link *linkPtr;
int code;
linkPtr = (Link *) ckalloc(sizeof(Link));
linkPtr->interp = interp;
linkPtr->varName = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
} else {
linkPtr->flags = 0;
}
objPtr = ObjValue(linkPtr);
if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
return TCL_ERROR;
}
code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
(ClientData) linkPtr);
if (code != TCL_OK) {
Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
}
return code;
}
/*
* Tcl_VarTraceProc for trace handles.
*/
static char *
VarTraceProc(
ClientData clientData, /* Widget record pointer */
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *name1, /* (unused) */
const char *name2, /* (unused) */
int flags) /* Information about what happened. */
{
Ttk_TraceHandle *tracePtr = clientData;
const char *name, *value;
Tcl_Obj *valuePtr;
if (flags & TCL_INTERP_DESTROYED) {
return NULL;
}
name = Tcl_GetString(tracePtr->varnameObj);
/*
* If the variable is being unset, then re-establish the trace:
*/
if (flags & TCL_TRACE_DESTROYED) {
Tcl_TraceVar(interp, name,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VarTraceProc, clientData);
tracePtr->callback(tracePtr->clientData, NULL);
return NULL;
}
/*
* Call the callback:
*/
valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
value = valuePtr ? Tcl_GetString(valuePtr) : NULL;
tracePtr->callback(tracePtr->clientData, value);
return NULL;
}
void add_tcl_fset(Tcl_Interp *irp)
{
char varname[180];
int i = 0;
for(i = 0; fset_array[i].name; i++)
{
int type_of = -1;
switch(fset_array[i].type)
{
case INT_TYPE_VAR:
type_of = TCL_LINK_INT;
break;
case STR_TYPE_VAR:
type_of = TCL_LINK_STRING;
break;
case BOOL_TYPE_VAR:
type_of = TCL_LINK_BOOLEAN;
break;
default:
continue;
}
strncpy(varname, fset_array[i].name, 80);
lower(varname);
type_of |= TCL_LINK_READ_ONLY;
Tcl_LinkVar(irp, varname,
(fset_array[i].type == STR_TYPE_VAR) ?
(char *)&fset_array[i].string :
(char *)&fset_array[i].integer,
type_of);
#if 0
if (fset_array[i].type == STR_TYPE_VAR)
{
Tcl_TraceVar(irp, varname, TCL_TRACE_WRITES,
(Tcl_VarTraceProc *)fset_rem_str, (ClientData)&fset_array[i]);
}
#endif
}
}
static char *
LinkTraceProc(
ClientData clientData, /* Contains information about the link. */
Tcl_Interp *interp, /* Interpreter containing Tcl variable. */
CONST char *name1, /* First part of variable name. */
CONST char *name2, /* Second part of variable name. */
int flags) /* Miscellaneous additional information. */
{
Link *linkPtr = (Link *) clientData;
int changed, valueLength;
CONST char *value;
char **pp;
Tcl_Obj *valueObj;
int valueInt;
Tcl_WideInt valueWide;
double valueDouble;
/*
* If the variable is being unset, then just re-create it (with a trace)
* unless the whole interpreter is going away.
*/
if (flags & TCL_TRACE_UNSETS) {
if (Tcl_InterpDeleted(interp)) {
Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
}
return NULL;
}
/*
* If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
* do anything at all. In particular, we don't want to get upset that the
* variable is being modified, even if it is supposed to be read-only.
*/
if (linkPtr->flags & LINK_BEING_UPDATED) {
return NULL;
}
/*
* For read accesses, update the Tcl variable if the C variable has
* changed since the last time we updated the Tcl variable.
*/
if (flags & TCL_TRACE_READS) {
switch (linkPtr->type) {
case TCL_LINK_INT:
case TCL_LINK_BOOLEAN:
changed = (LinkedVar(int) != linkPtr->lastValue.i);
break;
case TCL_LINK_DOUBLE:
changed = (LinkedVar(double) != linkPtr->lastValue.d);
break;
case TCL_LINK_WIDE_INT:
changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
break;
case TCL_LINK_WIDE_UINT:
changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
break;
case TCL_LINK_CHAR:
changed = (LinkedVar(char) != linkPtr->lastValue.c);
break;
case TCL_LINK_UCHAR:
changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
break;
case TCL_LINK_SHORT:
changed = (LinkedVar(short) != linkPtr->lastValue.s);
break;
case TCL_LINK_USHORT:
changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
break;
case TCL_LINK_UINT:
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
case TCL_LINK_LONG:
changed = (LinkedVar(long) != linkPtr->lastValue.l);
break;
case TCL_LINK_ULONG:
changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
break;
case TCL_LINK_FLOAT:
changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
case TCL_LINK_STRING:
changed = 1;
break;
default:
return "internal error: bad linked variable type";
}
if (changed) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
}
return NULL;
}
/*
* For writes, first make sure that the variable is writable. Then convert
* the Tcl value to C if possible. If the variable isn't writable or can't
* be converted, then restore the varaible's old value and return an
* error. Another tricky thing: we have to save and restore the interp's
* result, since the variable access could occur when the result has been
* partially set.
*/
if (linkPtr->flags & LINK_READ_ONLY) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "linked variable is read-only";
}
valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
if (valueObj == NULL) {
/*
* This shouldn't ever happen.
*/
return "internal error: linked variable couldn't be read";
}
switch (linkPtr->type) {
case TCL_LINK_INT:
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_WIDE_INT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
case TCL_LINK_DOUBLE:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
!= TCL_OK) {
#ifdef ACCEPT_NAN
if (valueObj->typePtr != &tclDoubleType) {
#endif
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return "variable must have real value";
#ifdef ACCEPT_NAN
}
linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
#endif
}
LinkedVar(double) = linkPtr->lastValue.d;
break;
case TCL_LINK_BOOLEAN:
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have boolean value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_CHAR:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have char value";
}
linkPtr->lastValue.c = (char)valueInt;
LinkedVar(char) = linkPtr->lastValue.c;
break;
case TCL_LINK_UCHAR:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > UCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned char value";
}
linkPtr->lastValue.uc = (unsigned char) valueInt;
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
break;
case TCL_LINK_SHORT:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have short value";
}
linkPtr->lastValue.s = (short)valueInt;
LinkedVar(short) = linkPtr->lastValue.s;
break;
case TCL_LINK_USHORT:
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > USHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned short value";
}
linkPtr->lastValue.us = (unsigned short)valueInt;
LinkedVar(unsigned short) = linkPtr->lastValue.us;
break;
case TCL_LINK_UINT:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || valueWide > UINT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueWide;
LinkedVar(unsigned int) = linkPtr->lastValue.ui;
break;
case TCL_LINK_LONG:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have long value";
}
linkPtr->lastValue.l = (long)valueWide;
LinkedVar(long) = linkPtr->lastValue.l;
break;
case TCL_LINK_ULONG:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueWide;
LinkedVar(unsigned long) = linkPtr->lastValue.ul;
break;
case TCL_LINK_WIDE_UINT:
/*
* FIXME: represent as a bignum.
*/
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
break;
case TCL_LINK_FLOAT:
if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have float value";
}
linkPtr->lastValue.f = (float)valueDouble;
LinkedVar(float) = linkPtr->lastValue.f;
break;
case TCL_LINK_STRING:
value = Tcl_GetStringFromObj(valueObj, &valueLength);
valueLength++;
pp = (char **) linkPtr->addr;
*pp = ckrealloc(*pp, valueLength);
memcpy(*pp, value, (unsigned) valueLength);
break;
default:
return "internal error: bad linked variable type";
}
return NULL;
}
/* Main global setup function */
int init_globals(Tcl_Interp *interp) {
static int done_init = 0;
extern int gap_fatal_errors;
char *env;
if (done_init)
return 0;
else
done_init++;
/* lookup tables */
set_char_set(1); /* 1 == DNA */
set_dna_lookup(); /* general lookup and complementing */
set_iubc_lookup(); /* iubc codes for restriction enzymes */
#if 0
set_mask_lookup(); /* used to mask/mark consensus */
#endif
init_genetic_code();
#if 0
inits_(); /* fortran stuff */
initlu_(&idm); /* fortran stuff */
#endif
/* Init Tcl note database */
init_tcl_notes(interp);
if (NULL == (env = getenv("STADTABL")))
verror(ERR_FATAL, "init_globals",
"STADTABL environment variable is not set.");
else {
char buf[1024];
sprintf(buf, "%s/align_lib_nuc_matrix", env);
nt_matrix = create_matrix(buf, nt_order);
if (nt_matrix)
init_W128(nt_matrix, nt_order, 0);
else
verror(ERR_FATAL, "init_globals",
"%s: file not found", buf);
}
/*
* gap5_defs (a Tcl_Obj pointer)
*
* We keep this up to date by creating a write trace on the object and
* doing an ObjGetVar2 when it changes. This way the object is always
* valid.
* Firstly we have to create gap5_defs though as initially it doesn't
* exist.
*/
{
Tcl_Obj *val;
defs_name = Tcl_NewStringObj("gap5_defs", -1); /* global */
val = Tcl_ObjGetVar2(interp, defs_name, NULL, TCL_GLOBAL_ONLY);
if (NULL == val)
val = Tcl_NewStringObj("", -1);
gap5_defs = Tcl_ObjSetVar2(interp, defs_name, NULL, val,
TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, "gap5_defs", TCL_TRACE_WRITES | TCL_GLOBAL_ONLY,
gap5_defs_trace, NULL);
}
/* consensus_cutoff */
Tcl_TraceVar(interp, "consensus_cutoff", TCL_TRACE_WRITES|TCL_GLOBAL_ONLY,
change_consensus_cutoff, (ClientData)NULL);
/* quality_cutoff */
Tcl_LinkVar(interp, "quality_cutoff", (char *)&quality_cutoff,
TCL_LINK_INT);
/* chem_as_double */
Tcl_LinkVar(interp, "chem_as_double", (char *)&chem_as_double,
TCL_LINK_INT);
/* gap_fatal_errors */
Tcl_LinkVar(interp, "gap_fatal_errors", (char *)&gap_fatal_errors,
TCL_LINK_BOOLEAN);
#if 0
/* maxseq */
Tcl_LinkVar(interp, "maxseq", (char *)&maxseq,
TCL_LINK_INT);
/* maxdb */
Tcl_LinkVar(interp, "maxdb", (char *)&maxdb,
TCL_LINK_INT);
#endif
/* ignore_checkdb */
Tcl_LinkVar(interp, "ignore_checkdb", (char *)&ignore_checkdb,
TCL_LINK_INT);
/* consensus_mode */
Tcl_LinkVar(interp, "consensus_mode", (char *)&consensus_mode,
TCL_LINK_INT);
/* consensus_iub */
Tcl_LinkVar(interp, "consensus_iub", (char *)&consensus_iub,
TCL_LINK_INT);
/* exec_notes */
Tcl_LinkVar(interp, "exec_notes", (char *)&exec_notes,
TCL_LINK_INT);
/* rawdata_note */
Tcl_LinkVar(interp, "rawdata_note", (char *)&rawdata_note,
TCL_LINK_INT);
/* align_open_cost */
Tcl_LinkVar(interp, "align_open_cost", (char *)&gopenval,
TCL_LINK_INT);
/* align_extend_cost */
Tcl_LinkVar(interp, "align_extend_cost", (char *)&gextendval,
TCL_LINK_INT);
/* template_size_tolerance */
Tcl_LinkVar(interp, "template_size_tolerance",
(char *)&template_size_tolerance,
TCL_LINK_DOUBLE);
/* min_vector_len */
Tcl_LinkVar(interp, "min_vector_len", (char *)&min_vector_len,
TCL_LINK_INT);
/* template_check_flags */
Tcl_LinkVar(interp, "template_check_flags", (char *)&template_check_flags,
TCL_LINK_INT);
return TCL_OK;
}
char *irc_start(Function *global_funcs)
{
struct chanset_t *chan;
global = global_funcs;
module_register(MODULE_NAME, irc_table, 1, 5);
if (!module_depend(MODULE_NAME, "eggdrop", 108, 0)) {
module_undepend(MODULE_NAME);
return "This module requires Eggdrop 1.8.0 or later.";
}
if (!(server_funcs = module_depend(MODULE_NAME, "server", 1, 0))) {
module_undepend(MODULE_NAME);
return "This module requires server module 1.0 or later.";
}
if (!(channels_funcs = module_depend(MODULE_NAME, "channels", 1, 1))) {
module_undepend(MODULE_NAME);
return "This module requires channels module 1.1 or later.";
}
for (chan = chanset; chan; chan = chan->next) {
if (!channel_inactive(chan)) {
if (chan->key_prot[0])
dprintf(DP_SERVER, "JOIN %s %s\n",
chan->name[0] ? chan->name : chan->dname, chan->key_prot);
else
dprintf(DP_SERVER, "JOIN %s\n",
chan->name[0] ? chan->name : chan->dname);
}
chan->status &= ~(CHAN_ACTIVE | CHAN_PEND | CHAN_ASKEDBANS);
chan->ircnet_status &= ~(CHAN_ASKED_INVITED | CHAN_ASKED_EXEMPTS);
}
add_hook(HOOK_MINUTELY, (Function) check_expired_chanstuff);
add_hook(HOOK_5MINUTELY, (Function) status_log);
add_hook(HOOK_ADD_MODE, (Function) real_add_mode);
add_hook(HOOK_IDLE, (Function) flush_modes);
Tcl_TraceVar(interp, "net-type",
TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
traced_nettype, NULL);
Tcl_TraceVar(interp, "rfc-compliant",
TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
traced_rfccompliant, NULL);
strcpy(opchars, "@");
add_tcl_strings(mystrings);
add_tcl_ints(myints);
add_builtins(H_dcc, irc_dcc);
add_builtins(H_msg, C_msg);
add_builtins(H_raw, irc_raw);
add_tcl_commands(tclchan_cmds);
add_help_reference("irc.help");
H_topc = add_bind_table("topc", HT_STACKABLE, channels_5char);
H_splt = add_bind_table("splt", HT_STACKABLE, channels_4char);
H_sign = add_bind_table("sign", HT_STACKABLE, channels_5char);
H_rejn = add_bind_table("rejn", HT_STACKABLE, channels_4char);
H_part = add_bind_table("part", HT_STACKABLE, channels_5char);
H_nick = add_bind_table("nick", HT_STACKABLE, channels_5char);
H_mode = add_bind_table("mode", HT_STACKABLE, channels_6char);
H_kick = add_bind_table("kick", HT_STACKABLE, channels_6char);
H_join = add_bind_table("join", HT_STACKABLE, channels_4char);
H_pubm = add_bind_table("pubm", HT_STACKABLE, channels_5char);
H_pub = add_bind_table("pub", 0, channels_5char);
H_need = add_bind_table("need", HT_STACKABLE, channels_2char);
do_nettype();
return NULL;
}
int Tk_utils_Init(Tcl_Interp *interp) {
char *s, c[20], *lib = NULL, buf[1024];
our_interp = interp;
/* FIXME: Remove this, but firstly we need to remove from tcl code */
Tcl_SetVar2(interp, "licence","type", "f", TCL_GLOBAL_ONLY);
/* Master subversion repository version */
Tcl_SetVar(interp, "svn_version", SVN_VERS, TCL_GLOBAL_ONLY);
/* Keyed lists from tclX */
TclX_KeyedListInit(interp);
/* Our updated Raster widget */
Raster_Init(interp);
/* Our own widgets and commands */
Tk_utils_Misc_Init(interp);
TextOutput_Init(interp);
Trace_Init(interp);
Sheet_Init(interp);
/* Other ancillary commands */
Tcl_CreateObjCommand(interp, "read_seq_trace", tcl_read_seq_trace,
(ClientData) NULL,
NULL);
/* Used only by spin2; not currently supported */
/*
Container_Init(interp);
Tk_CreateItemType(&tkGraphType);
Tcl_GraphInit(interp);
*/
/* SeqReg_Init(interp); */
/*
* The auto_path.
*/
if (lib = getenv("STADTCL")) {
sprintf(buf, "%s/tk_utils", lib);
lib = buf;
}
if (lib) {
char *argv[3];
int argc = 3;
char *merged;
argv[0] = "lappend";
argv[1] = "auto_path";
argv[2] = lib;
Tcl_Eval(interp, merged = Tcl_Merge(argc, argv));
Tcl_Free(merged);
}
/*
* Set packages(name). This is done to prevent subsequent reloading
* of this library (for efficiency reasons). The only reason that this
* is necessary is that currently gap4 dynamically links with some
* libraries at link time. When they're all at run time this won't
* be necessary.
*/
if (s = Tcl_GetVar2(interp, "packages", "tk_utils", TCL_GLOBAL_ONLY))
sprintf(c, "%d", atoi(s)|2);
else
strcpy(c, "2");
Tcl_SetVar2(interp, "packages", "tk_utils", c, TCL_GLOBAL_ONLY);
/*
* tk_utils_defs (a Tcl_Obj pointer)
*
* We keep this up to date by creating a write trace on the object and
* doing an ObjGetVar2 when it changes. This way the object is always
* valid.
* Firstly we have to create tk_utils_defs though as initially it doesn't
* exist.
*/
{
Tcl_Obj *val = Tcl_NewStringObj("", -1);
defs_name = Tcl_NewStringObj("tk_utils_defs", -1); /* global */
tk_utils_defs = Tcl_ObjSetVar2(interp, defs_name, NULL, val,
TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, "tk_utils_defs",
TCL_TRACE_WRITES | TCL_GLOBAL_ONLY,
tk_utils_defs_trace, NULL);
}
return Tcl_PkgProvide(interp, "tk_utils", "1.0");
}
char *channels_start(Function *global_funcs)
{
global = global_funcs;
gfld_chan_thr = 10;
gfld_chan_time = 60;
gfld_deop_thr = 3;
gfld_deop_time = 10;
gfld_kick_thr = 3;
gfld_kick_time = 10;
gfld_join_thr = 5;
gfld_join_time = 60;
gfld_ctcp_thr = 5;
gfld_ctcp_time = 60;
global_idle_kick = 0;
global_aop_min = 5;
global_aop_max = 30;
allow_ps = 0;
lastdeletedmask = 0;
use_info = 1;
strcpy(chanfile, "chanfile");
chan_hack = 0;
quiet_save = 0;
strcpy(glob_chanmode, "nt");
udef = NULL;
global_stopnethack_mode = 0;
global_revenge_mode = 0;
global_ban_type = 3;
global_ban_time = 120;
global_exempt_time = 60;
global_invite_time = 60;
strcpy(glob_chanset,
"-enforcebans "
"+dynamicbans "
"+userbans "
"-autoop "
"-bitch "
"+greet "
"+protectops "
"+statuslog "
"-revenge "
"-secret "
"-autovoice "
"+cycle "
"+dontkickops "
"-inactive "
"-protectfriends "
"+shared "
"-seen "
"+userexempts "
"+dynamicexempts "
"+userinvites "
"+dynamicinvites "
"-revengebot "
"-protecthalfops "
"-autohalfop "
"-nodesynch "
"-static ");
module_register(MODULE_NAME, channels_table, 1, 1);
if (!module_depend(MODULE_NAME, "eggdrop", 106, 20)) {
module_undepend(MODULE_NAME);
return "This module requires Eggdrop 1.6.20 or later.";
}
add_hook(HOOK_MINUTELY, (Function) check_expired_bans);
add_hook(HOOK_MINUTELY, (Function) check_expired_exempts);
add_hook(HOOK_MINUTELY, (Function) check_expired_invites);
add_hook(HOOK_USERFILE, (Function) channels_writeuserfile);
add_hook(HOOK_BACKUP, (Function) backup_chanfile);
add_hook(HOOK_REHASH, (Function) channels_rehash);
add_hook(HOOK_PRE_REHASH, (Function) channels_prerehash);
Tcl_TraceVar(interp, "global-chanset",
TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
traced_globchanset, NULL);
add_builtins(H_chon, my_chon);
add_builtins(H_dcc, C_dcc_irc);
add_tcl_commands(channels_cmds);
add_tcl_strings(my_tcl_strings);
add_help_reference("channels.help");
add_help_reference("chaninfo.help");
my_tcl_ints[0].val = &share_greet;
add_tcl_ints(my_tcl_ints);
add_tcl_coups(mychan_tcl_coups);
read_channels(0, 1);
return NULL;
}
static int
ConfigureScale(
Tcl_Interp *interp, /* Used for error reporting. */
register TkScale *scalePtr, /* Information about widget; may or may not
* already have values for some fields. */
int objc, /* Number of valid entries in objv. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tk_SavedOptions savedOptions;
Tcl_Obj *errorResult = NULL;
int error;
double varValue;
/*
* Eliminate any existing trace on a variable monitored by the scale.
*/
if (scalePtr->varNamePtr != NULL) {
Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, scalePtr);
}
for (error = 0; error <= 1; error++) {
if (!error) {
/*
* First pass: set options to new values.
*/
if (Tk_SetOptions(interp, (char *) scalePtr,
scalePtr->optionTable, objc, objv, scalePtr->tkwin,
&savedOptions, NULL) != TCL_OK) {
continue;
}
} else {
/*
* Second pass: restore options to old values.
*/
errorResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errorResult);
Tk_RestoreSavedOptions(&savedOptions);
}
/*
* If the scale is tied to the value of a variable, then set the
* scale's value from the value of the variable, if it exists and it
* holds a valid double value.
*/
if (scalePtr->varNamePtr != NULL) {
double value;
Tcl_Obj *valuePtr;
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
if ((valuePtr != NULL) &&
(Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
scalePtr->value = TkRoundToResolution(scalePtr, value);
}
}
/*
* Several options need special processing, such as parsing the
* orientation and creating GCs.
*/
scalePtr->fromValue = TkRoundToResolution(scalePtr,
scalePtr->fromValue);
scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
scalePtr->tickInterval = TkRoundToResolution(scalePtr,
scalePtr->tickInterval);
/*
* Make sure that the tick interval has the right sign so that
* addition moves from fromValue to toValue.
*/
if ((scalePtr->tickInterval < 0)
^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
scalePtr->tickInterval = -scalePtr->tickInterval;
}
ComputeFormat(scalePtr);
scalePtr->labelLength = scalePtr->label ? (int)strlen(scalePtr->label) : 0;
Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
if (scalePtr->highlightWidth < 0) {
scalePtr->highlightWidth = 0;
}
scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
break;
}
if (!error) {
Tk_FreeSavedOptions(&savedOptions);
}
/*
* Set the scale value to itself; all this does is to make sure that the
* scale's value is within the new acceptable range for the scale. We
* don't set the var here because we need to make special checks for
* possibly changed varNamePtr.
*/
TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);
/*
* Reestablish the variable trace, if it is needed.
*/
if (scalePtr->varNamePtr != NULL) {
Tcl_Obj *valuePtr;
/*
* Set the associated variable only when the new value differs from
* the current value, or the variable doesn't yet exist.
*/
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
if ((valuePtr == NULL) || (Tcl_GetDoubleFromObj(NULL,
valuePtr, &varValue) != TCL_OK)) {
ScaleSetVariable(scalePtr);
} else {
char varString[TCL_DOUBLE_SPACE], scaleString[TCL_DOUBLE_SPACE];
sprintf(varString, scalePtr->format, varValue);
sprintf(scaleString, scalePtr->format, scalePtr->value);
if (strcmp(varString, scaleString)) {
ScaleSetVariable(scalePtr);
}
}
Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, scalePtr);
}
ScaleWorldChanged(scalePtr);
if (error) {
Tcl_SetObjResult(interp, errorResult);
Tcl_DecrRefCount(errorResult);
return TCL_ERROR;
}
return TCL_OK;
}
/* ARGSUSED */
static char *
ScaleVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *name1, /* Name of variable. */
const char *name2, /* Second part of variable name. */
int flags) /* Information about what happened. */
{
register TkScale *scalePtr = clientData;
const char *resultStr;
double value;
Tcl_Obj *valuePtr;
int result;
/*
* If the variable is unset, then immediately recreate it unless the whole
* interpreter is going away.
*/
if (flags & TCL_TRACE_UNSETS) {
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, clientData);
scalePtr->flags |= NEVER_SET;
TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
return NULL;
}
/*
* If we came here because we updated the variable (in TkScaleSetValue),
* then ignore the trace. Otherwise update the scale with the value of the
* variable.
*/
if (scalePtr->flags & SETTING_VAR) {
return NULL;
}
resultStr = NULL;
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
if (result != TCL_OK) {
resultStr = "can't assign non-numeric value to scale variable";
ScaleSetVariable(scalePtr);
} else {
scalePtr->value = TkRoundToResolution(scalePtr, value);
/*
* This code is a bit tricky because it sets the scale's value before
* calling TkScaleSetValue. This way, TkScaleSetValue won't bother to
* set the variable again or to invoke the -command. However, it also
* won't redisplay the scale, so we have to ask for that explicitly.
*/
TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
return (char *) resultStr;
}
static int
ConfigureMenuButton(
Tcl_Interp *interp, /* Used for error reporting. */
register TkMenuButton *mbPtr,
/* Information about widget; may or may not
* already have values for some fields. */
int objc, /* Number of valid entries in objv. */
Tcl_Obj *const objv[]) /* Arguments. */
{
Tk_SavedOptions savedOptions;
Tcl_Obj *errorResult = NULL;
int error;
Tk_Image image;
/*
* Eliminate any existing trace on variables monitored by the menubutton.
*/
if (mbPtr->textVarName != NULL) {
Tcl_UntraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, mbPtr);
}
/*
* The following loop is potentially executed twice. During the first pass
* configuration options get set to their new values. If there is an error
* in this pass, we execute a second pass to restore all the options to
* their previous values.
*/
for (error = 0; error <= 1; error++) {
if (!error) {
/*
* First pass: set options to new values.
*/
if (Tk_SetOptions(interp, (char *) mbPtr,
mbPtr->optionTable, objc, objv,
mbPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
continue;
}
} else {
/*
* Second pass: restore options to old values.
*/
errorResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errorResult);
Tk_RestoreSavedOptions(&savedOptions);
}
/*
* A few options need special processing, such as setting the
* background from a 3-D border, or filling in complicated defaults
* that couldn't be specified to Tk_SetOptions.
*/
if ((mbPtr->state == STATE_ACTIVE)
&& !Tk_StrictMotif(mbPtr->tkwin)) {
Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
} else {
Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
}
if (mbPtr->highlightWidth < 0) {
mbPtr->highlightWidth = 0;
}
if (mbPtr->padX < 0) {
mbPtr->padX = 0;
}
if (mbPtr->padY < 0) {
mbPtr->padY = 0;
}
/*
* Get the image for the widget, if there is one. Allocate the new
* image before freeing the old one, so that the reference count
* doesn't go to zero and cause image data to be discarded.
*/
if (mbPtr->imageString != NULL) {
image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
mbPtr->imageString, MenuButtonImageProc, mbPtr);
if (image == NULL) {
return TCL_ERROR;
}
} else {
image = NULL;
}
if (mbPtr->image != NULL) {
Tk_FreeImage(mbPtr->image);
}
mbPtr->image = image;
/*
* Recompute the geometry for the button.
*/
if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
&mbPtr->width) != TCL_OK) {
widthError:
Tcl_AddErrorInfo(interp, "\n (processing -width option)");
continue;
}
if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
&mbPtr->height) != TCL_OK) {
heightError:
Tcl_AddErrorInfo(interp, "\n (processing -height option)");
continue;
}
} else {
if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
!= TCL_OK) {
goto widthError;
}
if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
!= TCL_OK) {
goto heightError;
}
}
break;
}
if (!error) {
Tk_FreeSavedOptions(&savedOptions);
}
if (mbPtr->textVarName != NULL) {
/*
* If no image or -compound is used, display the value of a variable.
* Set up a trace to watch for any changes in it, create the variable
* if it doesn't exist, and fetch its current value.
*/
const char *value;
value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
if (value == NULL) {
Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
TCL_GLOBAL_ONLY);
} else {
if (mbPtr->text != NULL) {
ckfree(mbPtr->text);
}
mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
strcpy(mbPtr->text, value);
}
Tcl_TraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, mbPtr);
}
TkMenuButtonWorldChanged(mbPtr);
if (error) {
Tcl_SetObjResult(interp, errorResult);
Tcl_DecrRefCount(errorResult);
return TCL_ERROR;
}
return TCL_OK;
}
