static void
IvyDirectMsgCB(IvyClientPtr app,
void *user_data,
int id,
char *msg)
{
filter_struct *filter = (filter_struct *) user_data;
int result, size;
char *script_to_call;
char int_buffer[INTEGER_SPACE];
sprintf(int_buffer, "%d", id);
size = strlen(filter->script) + 1;
size += strlen(int_buffer) + 1;
size += strlen(msg) + 1;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " ");
strcat(script_to_call, int_buffer);
strcat(script_to_call, " \"");
strcat(script_to_call, msg);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
static void tvfsExecTcl(
Testvfs *p,
const char *zMethod,
Tcl_Obj *arg1,
Tcl_Obj *arg2,
Tcl_Obj *arg3,
Tcl_Obj *arg4
){
int rc; /* Return code from Tcl_EvalObj() */
Tcl_Obj *pEval;
assert( p->pScript );
assert( zMethod );
assert( p );
assert( arg2==0 || arg1!=0 );
assert( arg3==0 || arg2!=0 );
pEval = Tcl_DuplicateObj(p->pScript);
Tcl_IncrRefCount(p->pScript);
Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zMethod, -1));
if( arg1 ) Tcl_ListObjAppendElement(p->interp, pEval, arg1);
if( arg2 ) Tcl_ListObjAppendElement(p->interp, pEval, arg2);
if( arg3 ) Tcl_ListObjAppendElement(p->interp, pEval, arg3);
if( arg4 ) Tcl_ListObjAppendElement(p->interp, pEval, arg4);
rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
}
}
static void
IvyDieCB(IvyClientPtr app,
void *user_data, /* script a appeler */
int id)
{
filter_struct *filter = (filter_struct *) user_data;
int result, size;
char idstr[INTEGER_SPACE];
char *script_to_call;
sprintf(idstr, "%d", id);
size = strlen(filter->script) + INTEGER_SPACE + 1;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " \"");
strcat(script_to_call, idstr);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
static void
IvyAppCB(IvyClientPtr app,
void *user_data, /* script a appeler */
IvyApplicationEvent event)
{
static const char *app_event_str[] = {
"Connected", "Disconnected" };
filter_struct *filter = (filter_struct *) user_data;
int result, size, dummy;
char *script_to_call;
Tcl_HashEntry *entry;
entry = Tcl_FindHashEntry(&app_table, IvyGetApplicationName(app));
if (event == IvyApplicationConnected) {
if (!entry) {
entry = Tcl_CreateHashEntry(&app_table, IvyGetApplicationName(app), &dummy);
Tcl_SetHashValue(entry, (ClientData) app);
}
}
size = strlen(filter->script) + INTEGER_SPACE;
if (entry) {
size += strlen(IvyGetApplicationName(app)) + 3;
}
else {
size += 4;
}
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " ");
if (entry) {
strcat(script_to_call, " \"");
strcat(script_to_call, IvyGetApplicationName(app));
strcat(script_to_call, "\"");
}
else {
strcat(script_to_call, "???");
}
strcat(script_to_call, " \"");
strcat(script_to_call, app_event_str[event%2]);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
if (event == IvyApplicationDisconnected) {
if (entry) {
Tcl_DeleteHashEntry(entry);
}
}
}
/*
** Handler for events of type EvalEvent.
*/
static int tclScriptEvent(Tcl_Event *evPtr, int flags){
int rc;
EvalEvent *p = (EvalEvent *)evPtr;
rc = Tcl_Eval(p->interp, p->zScript);
if( rc!=TCL_OK ){
Tcl_BackgroundError(p->interp);
}
UNUSED_PARAMETER(flags);
return 1;
}
static void ThemeChangedProc(ClientData clientData)
{
static char ThemeChangedScript[] = "ttk::ThemeChanged";
StylePackageData *pkgPtr = (StylePackageData *)clientData;
if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) {
Tcl_BackgroundError(pkgPtr->interp);
}
pkgPtr->themeChangePending = 0;
}
static gboolean doCommand( gpointer data )
{
GnoclCommandData *cs = (GnoclCommandData *)data;
int ret = Tcl_EvalEx( cs->interp, cs->command, -1,
TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT );
if( ret == TCL_ERROR )
Tcl_BackgroundError( cs->interp );
if( ret != TCL_OK )
return 0;
return 1;
}
/* UpdateScrollbarBG --
* Idle handler to update the scrollbar.
*/
static void UpdateScrollbarBG(ClientData clientData)
{
ScrollHandle h = (ScrollHandle)clientData;
Tcl_Interp *interp = h->corePtr->interp;
int code;
h->flags &= ~SCROLL_UPDATE_PENDING;
Tcl_Preserve((ClientData) interp);
code = UpdateScrollbar(interp, h);
if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
Tcl_BackgroundError(interp);
}
Tcl_Release((ClientData) interp);
}
static void dns_tcl_iporhostres(sockname_t *ip, char *hostn, int ok, void *other)
{
devent_tclinfo_t *tclinfo = (devent_tclinfo_t *) other;
Tcl_DString list;
Tcl_DStringInit(&list);
Tcl_DStringAppendElement(&list, tclinfo->proc);
Tcl_DStringAppendElement(&list, iptostr(&ip->addr.sa));
Tcl_DStringAppendElement(&list, hostn);
Tcl_DStringAppendElement(&list, ok ? "1" : "0");
if (tclinfo->paras) {
EGG_CONST char *argv[2];
char *output;
argv[0] = Tcl_DStringValue(&list);
argv[1] = tclinfo->paras;
output = Tcl_Concat(2, argv);
if (Tcl_Eval(interp, output) == TCL_ERROR) {
putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
Tcl_BackgroundError(interp);
}
Tcl_Free(output);
} else if (Tcl_Eval(interp, Tcl_DStringValue(&list)) == TCL_ERROR) {
putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
Tcl_BackgroundError(interp);
}
Tcl_DStringFree(&list);
nfree(tclinfo->proc);
if (tclinfo->paras)
nfree(tclinfo->paras);
nfree(tclinfo);
}
static OSErr
PrefsHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
if (Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences") != TCL_OK) {
Tcl_BackgroundError(interp);
}
}
return noErr;
}
void
TkWmProtocolEventProc(
TkWindow *winPtr, /* Window to which the event was sent. */
XEvent *eventPtr) /* X event. */
{
WmInfo *wmPtr;
ProtocolHandler *protPtr;
Tcl_Interp *interp;
Atom protocol;
int result;
wmPtr = winPtr->wmInfoPtr;
if (wmPtr == NULL) {
return;
}
protocol = (Atom) eventPtr->xclient.data.l[0];
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protocol == protPtr->protocol) {
Tcl_Preserve(protPtr);
interp = protPtr->interp;
Tcl_Preserve(interp);
result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command for \"");
Tcl_AddErrorInfo(interp,
Tk_GetAtomName((Tk_Window) winPtr, protocol));
Tcl_AddErrorInfo(interp, "\" window manager protocol)");
Tcl_BackgroundError(interp);
}
Tcl_Release(interp);
Tcl_Release(protPtr);
return;
}
}
/*
* No handler was present for this protocol. If this is a WM_DELETE_WINDOW
* message then just destroy the window.
*/
if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
Tk_DestroyWindow((Tk_Window) winPtr);
}
}
/*
** For the markup <a href=XXX>, find out if the URL has been visited
** before or not. Return COLOR_Visited or COLOR_Unvisited, as
** appropriate.
**
** This routine may invoke a callback procedure which could delete
** the HTML widget. The calling function should call HtmlLock()
** if it needs the widget structure to be preserved.
*/
static int GetLinkColor(HtmlWidget *htmlPtr, char *zURL){
char *zCmd;
int result;
int isVisited;
if( htmlPtr->tkwin==0 ){
TestPoint(0);
return COLOR_Normal;
}
if( htmlPtr->zIsVisited==0 || htmlPtr->zIsVisited[0]==0 ){
TestPoint(0);
return COLOR_Unvisited;
}
zCmd = HtmlAlloc( strlen(htmlPtr->zIsVisited) + strlen(zURL) + 10 );
if( zCmd==0 ){
TestPoint(0);
return COLOR_Unvisited;
}
sprintf(zCmd,"%s {%s}",htmlPtr->zIsVisited, zURL);
HtmlLock(htmlPtr);
result = Tcl_GlobalEval(htmlPtr->interp,zCmd);
HtmlFree(zCmd);
if( HtmlUnlock(htmlPtr) ){
return COLOR_Unvisited;
}
if( result!=TCL_OK ){
TestPoint(0);
goto errorOut;
}
result = Tcl_GetBoolean(htmlPtr->interp,
Tcl_GetStringResult(htmlPtr->interp), &isVisited);
if( result!=TCL_OK ){
TestPoint(0);
goto errorOut;
}
TestPoint(0);
return isVisited ? COLOR_Visited : COLOR_Unvisited;
errorOut:
Tcl_AddErrorInfo(htmlPtr->interp,
"\n (\"-isvisitedcommand\" command executed by html widget)");
Tcl_BackgroundError(htmlPtr->interp);
TestPoint(0);
return COLOR_Unvisited;
}
static int
asyncSignalHandler(ClientData data, Tcl_Interp *interp, int code)
{
ElTclSignalContext *ctx = data;
Tcl_Obj *result, *errorInfo, *errorCode;
if (ctx->script == ELTCL_SIGDFL || ctx->script == ELTCL_SIGIGN) {
fputs("Warning: wrong signal delivered for Tcl\n", stdout);
return code;
}
/* save interpreter state */
result = Tcl_GetObjResult(ctx->iinfo->interp);
if (result != NULL) Tcl_IncrRefCount(result);
errorInfo = Tcl_GetVar2Ex(ctx->iinfo->interp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
if (errorInfo != NULL) Tcl_IncrRefCount(errorInfo);
errorCode = Tcl_GetVar2Ex(ctx->iinfo->interp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
if (errorCode != NULL) Tcl_IncrRefCount(errorCode);
/* eval script */
if (Tcl_EvalObjEx(ctx->iinfo->interp,
ctx->script, TCL_EVAL_GLOBAL) != TCL_OK)
Tcl_BackgroundError(ctx->iinfo->interp);
/* restore interpreter state */
if (errorInfo != NULL) {
Tcl_SetVar2Ex(ctx->iinfo->interp, "errorInfo", NULL, errorInfo,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(errorInfo);
}
if (errorCode != NULL) {
Tcl_SetVar2Ex(ctx->iinfo->interp, "errorCode", NULL, errorCode,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(errorCode);
}
if (result != NULL) {
Tcl_SetObjResult(ctx->iinfo->interp, result);
Tcl_DecrRefCount(result);
}
return code;
}
static OSErr
OappHandler(
const AppleEvent *event,
AppleEvent *reply,
SRefCon handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication");
if (code != TCL_OK) {
Tcl_BackgroundError(interp);
}
}
return noErr;
}
static int
ReallyKillMe(
Tcl_Event *eventPtr,
int flags)
{
Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
Tcl_CmdInfo dummy;
int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
if (Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit") != TCL_OK) {
/*
* Should be never reached...
*/
Tcl_BackgroundError(interp);
}
return 1;
}
/*
** Delete all input controls. This happens when the HTML widget
** is cleared.
**
** When the TCL "exit" command is invoked, the order of operations
** here is very touchy.
*/
void HtmlDeleteControls(HtmlWidget *htmlPtr){
HtmlElement *p; /* For looping over all controls */
Tcl_Interp *interp; /* The interpreter */
interp = htmlPtr->interp;
p = htmlPtr->firstInput;
htmlPtr->firstInput = 0;
htmlPtr->lastInput = 0;
htmlPtr->nInput = 0;
if( p==0 || htmlPtr->tkwin==0 ) return;
HtmlLock(htmlPtr);
for(; p; p=p->input.pNext){
if( p->input.pForm && p->input.pForm->form.id>0
&& htmlPtr->zFormCommand && htmlPtr->zFormCommand[0]
&& !Tcl_InterpDeleted(interp) && htmlPtr->clipwin ){
Tcl_DString cmd;
int result;
char zBuf[60];
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
sprintf(zBuf," %d flush", p->input.pForm->form.id);
Tcl_DStringAppend(&cmd, zBuf, -1);
result = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd));
Tcl_DStringFree(&cmd);
if( !Tcl_InterpDeleted(interp) ){
if( result != TCL_OK ){
Tcl_AddErrorInfo(htmlPtr->interp,
"\n (-formcommand flush callback executed by html widget)");
Tcl_BackgroundError(htmlPtr->interp);
TestPoint(0);
}
Tcl_ResetResult(htmlPtr->interp);
}
p->input.pForm->form.id = 0;
}
if( p->input.tkwin ){
if( htmlPtr->clipwin!=0 ) Tk_DestroyWindow(p->input.tkwin);
p->input.tkwin = 0;
}
p->input.sized = 0;
}
HtmlUnlock(htmlPtr);
}
static OSErr
RappHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
ProcessSerialNumber thePSN = {0, kCurrentProcess};
OSStatus err = ChkErr(SetFrontProcess, &thePSN);
if (interp && Tcl_GetCommandInfo(interp,
"::tk::mac::ReopenApplication", &dummy)) {
if (Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication") != TCL_OK){
Tcl_BackgroundError(interp);
}
}
return err;
}
static void
IvyMsgCB(IvyClientPtr app,
void *user_data,
int argc,
char **argv)
{
filter_struct *filter = (filter_struct *) user_data;
int result, i, size;
char *script_to_call;
size = strlen(filter->script) + 3;
for (i = 0; i < argc; i++) {
size += strlen(argv[i]) + 3;
}
size ++;
size += strlen(IvyGetApplicationName(app))+4;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " \"");
strcat(script_to_call, IvyGetApplicationName(app));
strcat(script_to_call, "\"");
/* strcat(script_to_call, " {"); */
for (i = 0; i < argc; i++) {
strcat(script_to_call, " \"");
strcat(script_to_call, argv[i]);
strcat(script_to_call, "\"");
}
/* strcat(script_to_call, " }"); */
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
/*
** This is the callback from a quota-over-limit.
*/
static void tclQuotaCallback(
const char *zFilename, /* Name of file whose size increases */
sqlite3_int64 *piLimit, /* IN/OUT: The current limit */
sqlite3_int64 iSize, /* Total size of all files in the group */
void *pArg /* Client data */
){
TclQuotaCallback *p; /* Callback script object */
Tcl_Obj *pEval; /* Script to evaluate */
Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */
unsigned int rnd; /* Random part of pVarname */
int rc; /* Tcl error code */
p = (TclQuotaCallback *)pArg;
if( p==0 ) return;
pVarname = Tcl_NewStringObj("::piLimit_", -1);
Tcl_IncrRefCount(pVarname);
sqlite3_randomness(sizeof(rnd), (void *)&rnd);
Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF)));
Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0);
pEval = Tcl_DuplicateObj(p->pScript);
Tcl_IncrRefCount(pEval);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1));
Tcl_ListObjAppendElement(0, pEval, pVarname);
Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize));
rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
if( rc==TCL_OK ){
Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0);
rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit);
Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0);
}
Tcl_DecrRefCount(pEval);
Tcl_DecrRefCount(pVarname);
if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp);
}
void test_ota_delta(sqlite3_context *pCtx, int nArg, sqlite3_value **apVal){
Tcl_Interp *interp = (Tcl_Interp*)sqlite3_user_data(pCtx);
Tcl_Obj *pScript;
int i;
pScript = Tcl_NewObj();
Tcl_IncrRefCount(pScript);
Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj("ota_delta", -1));
for(i=0; i<nArg; i++){
sqlite3_value *pIn = apVal[i];
const char *z = (const char*)sqlite3_value_text(pIn);
Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(z, -1));
}
if( TCL_OK==Tcl_EvalObjEx(interp, pScript, TCL_GLOBAL_ONLY) ){
const char *z = Tcl_GetStringResult(interp);
sqlite3_result_text(pCtx, z, -1, SQLITE_TRANSIENT);
}else{
Tcl_BackgroundError(interp);
}
Tcl_DecrRefCount(pScript);
}
void
TkpDisplayScale(
ClientData clientData) /* Widget record for scale. */
{
TkScale *scalePtr = (TkScale *) clientData;
Tk_Window tkwin = scalePtr->tkwin;
Tcl_Interp *interp = scalePtr->interp;
Pixmap pixmap;
int result;
char string[PRINT_CHARS];
XRectangle drawnArea;
scalePtr->flags &= ~REDRAW_PENDING;
if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
goto done;
}
/*
* Invoke the scale's command if needed.
*/
Tcl_Preserve((ClientData) scalePtr);
if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
Tcl_Preserve((ClientData) interp);
sprintf(string, scalePtr->format, scalePtr->value);
result = Tcl_VarEval(interp, scalePtr->command, " ", string,
(char *) NULL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command executed by scale)");
Tcl_BackgroundError(interp);
}
Tcl_Release((ClientData) interp);
}
scalePtr->flags &= ~INVOKE_COMMAND;
if (scalePtr->flags & SCALE_DELETED) {
Tcl_Release((ClientData) scalePtr);
return;
}
Tcl_Release((ClientData) scalePtr);
#ifndef TK_NO_DOUBLE_BUFFERING
/*
* In order to avoid screen flashes, this function redraws the scale in a
* pixmap, then copies the pixmap to the screen in a single operation.
* This means that there's no point in time where the on-sreen image has
* been cleared.
*/
pixmap = Tk_GetPixmap(scalePtr->display, Tk_WindowId(tkwin),
Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
#else
pixmap = Tk_WindowId(tkwin);
#endif /* TK_NO_DOUBLE_BUFFERING */
drawnArea.x = 0;
drawnArea.y = 0;
drawnArea.width = Tk_Width(tkwin);
drawnArea.height = Tk_Height(tkwin);
/*
* Much of the redisplay is done totally differently for horizontal and
* vertical scales. Handle the part that's different.
*/
if (scalePtr->orient == ORIENT_VERTICAL) {
DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
} else {
DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
}
/*
* Now handle the part of redisplay that is the same for horizontal and
* vertical scales: border and traversal highlight.
*/
if (scalePtr->flags & REDRAW_OTHER) {
if (scalePtr->relief != TK_RELIEF_FLAT) {
Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder,
scalePtr->highlightWidth, scalePtr->highlightWidth,
Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
scalePtr->borderWidth, scalePtr->relief);
}
if (scalePtr->highlightWidth != 0) {
GC gc;
if (scalePtr->flags & GOT_FOCUS) {
gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
} else {
gc = Tk_GCForColor(
Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
}
Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
}
}
#ifndef TK_NO_DOUBLE_BUFFERING
/*
* Copy the information from the off-screen pixmap onto the screen, then
* delete the pixmap.
*/
XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin),
scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width,
drawnArea.height, drawnArea.x, drawnArea.y);
Tk_FreePixmap(scalePtr->display, pixmap);
#endif /* TK_NO_DOUBLE_BUFFERING */
done:
scalePtr->flags &= ~REDRAW_ALL;
}
HRESULT
ComObject::invoke (const Method &method,
bool isProperty,
REFIID /*riid*/,
LCID /*lcid*/,
WORD wFlags,
DISPPARAMS *pDispParams,
VARIANT *pReturnValue,
EXCEPINFO *pExcepInfo,
UINT *pArgErr)
{
HRESULT hresult;
try {
// Construct Tcl script to invoke operation on the servant.
TclObject script(m_servant);
// Get the method or property to invoke on the servant.
std::string operation;
if ((wFlags & DISPATCH_PROPERTYGET) != 0 && isProperty) {
operation = getPrefix + method.name();
} else if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) {
operation = setPrefix + method.name();
} else if (wFlags & DISPATCH_METHOD) {
operation = method.name();
} else {
return DISP_E_MEMBERNOTFOUND;
}
script.lappend(
Tcl_NewStringObj(const_cast<char *>(operation.c_str()), -1));
// Set the argument error pointer in case we need to use it.
UINT argErr;
if (pArgErr == 0) {
pArgErr = &argErr;
}
// Convert arguments to Tcl values.
// TODO: Should handle named arguments differently than positional
// arguments.
const Method::Parameters ¶meters = method.parameters();
int argIndex = pDispParams->cArgs - 1;
Method::Parameters::const_iterator pParam;
for (pParam = parameters.begin(); pParam != parameters.end();
++pParam, --argIndex) {
// Append argument value.
VARIANT *pArg = &(pDispParams->rgvarg[argIndex]);
try {
script.lappend(getArgument(pArg, *pParam));
}
catch (_com_error &) {
*pArgErr = argIndex;
throw;
}
}
if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) {
VARIANT *pArg = &(pDispParams->rgvarg[argIndex]);
try {
TclObject value(pArg, method.type(), m_interp);
script.lappend(value);
}
catch (_com_error &) {
*pArgErr = argIndex;
throw;
}
}
// Execute the Tcl script.
TclObject result;
int completionCode = eval(script, &result);
if (completionCode == TCL_OK) {
hresult = S_OK;
} else {
if (m_isSink) {
Tcl_BackgroundError(m_interp);
}
hresult = hresultFromErrorCode();
if (FAILED(hresult)) {
fillExcepInfo(
pExcepInfo,
hresult,
m_servant.c_str(),
result.c_str());
hresult = DISP_E_EXCEPTION;
}
}
// Copy values to out arguments.
argIndex = pDispParams->cArgs - 1;
for (pParam = parameters.begin(); pParam != parameters.end();
++pParam, --argIndex) {
VARIANT *pArg = &(pDispParams->rgvarg[argIndex]);
if ((pParam->flags() & PARAMFLAG_FOUT) && (V_VT(pArg) & VT_BYREF)) {
// Get name of Tcl variable that holds out value.
TclObject varName = getOutVariableName(*pParam);
// Copy variable value to out argument.
TclObject value;
if (getVariable(varName, value) == TCL_OK) {
putOutVariant(m_interp, pArg, value, pParam->type());
}
}
}
// Convert return value.
if (pReturnValue != 0 && method.type().vartype() != VT_VOID) {
// Must increment reference count of interface pointers returned
// from methods.
result.toVariant(pReturnValue, method.type(), m_interp, true);
}
}
catch (_com_error &e) {
fillExcepInfo(pExcepInfo, e.Error(), m_servant.c_str(), 0);
hresult = DISP_E_EXCEPTION;
}
return hresult;
}
/*ARGSUSED*/
static int
EmbWinLayoutProc(
TkText *textPtr, /* Text widget being layed out. */
TkTextIndex *indexPtr, /* Identifies first character in chunk. */
TkTextSegment *ewPtr, /* Segment corresponding to indexPtr. */
int offset, /* Offset within segPtr corresponding to
* indexPtr (always 0). */
int maxX, /* Chunk must not occupy pixels at this
* position or higher. */
int maxChars, /* Chunk must not include more than this many
* characters. */
int noCharsYet, /* Non-zero means no characters have been
* assigned to this line yet. */
TkWrapMode wrapMode, /* Wrap mode to use for line:
* TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
* TEXT_WRAPMODE_WORD. */
register TkTextDispChunk *chunkPtr)
/* Structure to fill in with information about
* this chunk. The x field has already been
* set by the caller. */
{
int width, height;
TkTextEmbWindowClient *client;
if (offset != 0) {
Tcl_Panic("Non-zero offset in EmbWinLayoutProc");
}
client = EmbWinGetClient(textPtr, ewPtr);
if (client == NULL) {
ewPtr->body.ew.tkwin = NULL;
} else {
ewPtr->body.ew.tkwin = client->tkwin;
}
if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) {
int code, isNew;
Tk_Window ancestor;
Tcl_HashEntry *hPtr;
const char *before, *string;
Tcl_DString name, buf, *dsPtr = NULL;
before = ewPtr->body.ew.create;
/*
* Find everything up to the next % character and append it to the
* result string.
*/
string = before;
while (*string != 0) {
if ((*string == '%') && (string[1] == '%' || string[1] == 'W')) {
if (dsPtr == NULL) {
Tcl_DStringInit(&buf);
dsPtr = &buf;
}
if (string != before) {
Tcl_DStringAppend(dsPtr, before, (int) (string-before));
before = string;
}
if (string[1] == '%') {
Tcl_DStringAppend(dsPtr, "%", 1);
} else {
/*
* Substitute string as proper Tcl list element.
*/
int spaceNeeded, cvtFlags, length;
const char *str = Tk_PathName(textPtr->tkwin);
spaceNeeded = Tcl_ScanElement(str, &cvtFlags);
length = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
spaceNeeded = Tcl_ConvertElement(str,
Tcl_DStringValue(dsPtr) + length,
cvtFlags | TCL_DONT_USE_BRACES);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
}
before += 2;
string++;
}
string++;
}
/*
* The window doesn't currently exist. Create it by evaluating the
* creation script. The script must return the window's path name:
* look up that name to get back to the window token. Then register
* ourselves as the geometry manager for the window.
*/
if (dsPtr != NULL) {
Tcl_DStringAppend(dsPtr, before, (int) (string-before));
code = Tcl_GlobalEval(textPtr->interp, Tcl_DStringValue(dsPtr));
Tcl_DStringFree(dsPtr);
} else {
code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
}
if (code != TCL_OK) {
createError:
Tcl_BackgroundException(textPtr->interp, code);
goto gotWindow;
}
Tcl_DStringInit(&name);
Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1);
Tcl_ResetResult(textPtr->interp);
ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
Tcl_DStringValue(&name), textPtr->tkwin);
Tcl_DStringFree(&name);
if (ewPtr->body.ew.tkwin == NULL) {
goto createError;
}
for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
break;
}
if (Tk_TopWinHierarchy(ancestor)) {
badMaster:
Tcl_AppendResult(textPtr->interp, "can't embed ",
Tk_PathName(ewPtr->body.ew.tkwin), " relative to ",
Tk_PathName(textPtr->tkwin), NULL);
Tcl_BackgroundError(textPtr->interp);
ewPtr->body.ew.tkwin = NULL;
goto gotWindow;
}
}
if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
|| (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
goto badMaster;
}
if (client == NULL) {
/*
* We just used a '-create' script to make a new window, which we
* now need to add to our client list.
*/
client = (TkTextEmbWindowClient *)
ckalloc(sizeof(TkTextEmbWindowClient));
client->next = ewPtr->body.ew.clients;
client->textPtr = textPtr;
client->tkwin = NULL;
client->chunkCount = 0;
client->displayed = 0;
client->parent = ewPtr;
ewPtr->body.ew.clients = client;
}
client->tkwin = ewPtr->body.ew.tkwin;
Tk_ManageGeometry(client->tkwin, &textGeomType, client);
Tk_CreateEventHandler(client->tkwin, StructureNotifyMask,
EmbWinStructureProc, client);
/*
* Special trick! Must enter into the hash table *after* calling
* Tk_ManageGeometry: if the window was already managed elsewhere in
* this text, the Tk_ManageGeometry call will cause the entry to be
* removed, which could potentially lose the new entry.
*/
hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable,
Tk_PathName(client->tkwin), &isNew);
Tcl_SetHashValue(hPtr, ewPtr);
}
/*
* See if there's room for this window on this line.
*/
gotWindow:
if (ewPtr->body.ew.tkwin == NULL) {
width = 0;
height = 0;
} else {
width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
}
if ((width > (maxX - chunkPtr->x))
&& !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
return 0;
}
/*
* Fill in the chunk structure.
*/
chunkPtr->displayProc = TkTextEmbWinDisplayProc;
chunkPtr->undisplayProc = EmbWinUndisplayProc;
chunkPtr->measureProc = NULL;
chunkPtr->bboxProc = EmbWinBboxProc;
chunkPtr->numBytes = 1;
if (ewPtr->body.ew.align == ALIGN_BASELINE) {
chunkPtr->minAscent = height - ewPtr->body.ew.padY;
chunkPtr->minDescent = ewPtr->body.ew.padY;
chunkPtr->minHeight = 0;
} else {
chunkPtr->minAscent = 0;
chunkPtr->minDescent = 0;
chunkPtr->minHeight = height;
}
chunkPtr->width = width;
chunkPtr->breakIndex = -1;
chunkPtr->breakIndex = 1;
chunkPtr->clientData = ewPtr;
if (client != NULL) {
client->chunkCount += 1;
}
return 1;
}
static void
ImgBmapConfigureInstance(
BitmapInstance *instancePtr)/* Instance to reconfigure. */
{
BitmapMaster *masterPtr = instancePtr->masterPtr;
XColor *colorPtr;
XGCValues gcValues;
GC gc;
unsigned int mask;
Pixmap oldBitmap, oldMask;
/*
* For each of the options in masterPtr, translate the string form into an
* internal form appropriate for instancePtr.
*/
if (*masterPtr->bgUid != 0) {
colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
masterPtr->bgUid);
if (colorPtr == NULL) {
goto error;
}
} else {
colorPtr = NULL;
}
if (instancePtr->bg != NULL) {
Tk_FreeColor(instancePtr->bg);
}
instancePtr->bg = colorPtr;
colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
masterPtr->fgUid);
if (colorPtr == NULL) {
goto error;
}
if (instancePtr->fg != NULL) {
Tk_FreeColor(instancePtr->fg);
}
instancePtr->fg = colorPtr;
/*
* Careful: We have to allocate new Pixmaps before deleting the old ones.
* Otherwise, The XID allocator will always return the same XID for the
* new Pixmaps as was used for the old Pixmaps. And that will prevent the
* data and/or mask from changing in the GC below.
*/
oldBitmap = instancePtr->bitmap;
instancePtr->bitmap = None;
oldMask = instancePtr->mask;
instancePtr->mask = None;
if (masterPtr->data != NULL) {
instancePtr->bitmap = XCreateBitmapFromData(
Tk_Display(instancePtr->tkwin),
RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
masterPtr->data, (unsigned) masterPtr->width,
(unsigned) masterPtr->height);
}
if (masterPtr->maskData != NULL) {
instancePtr->mask = XCreateBitmapFromData(
Tk_Display(instancePtr->tkwin),
RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
masterPtr->maskData, (unsigned) masterPtr->width,
(unsigned) masterPtr->height);
}
if (oldMask != None) {
Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask);
}
if (oldBitmap != None) {
Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldBitmap);
}
if (masterPtr->data != NULL) {
gcValues.foreground = instancePtr->fg->pixel;
gcValues.graphics_exposures = False;
mask = GCForeground|GCGraphicsExposures;
if (instancePtr->bg != NULL) {
gcValues.background = instancePtr->bg->pixel;
mask |= GCBackground;
if (instancePtr->mask != None) {
gcValues.clip_mask = instancePtr->mask;
mask |= GCClipMask;
}
} else {
gcValues.clip_mask = instancePtr->bitmap;
mask |= GCClipMask;
}
gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
} else {
gc = None;
}
if (instancePtr->gc != None) {
Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
}
instancePtr->gc = gc;
return;
error:
/*
* An error occurred: clear the graphics context in the instance to make
* it clear that this instance cannot be displayed. Then report the error.
*/
if (instancePtr->gc != None) {
Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
}
instancePtr->gc = None;
Tcl_AppendObjToErrorInfo(masterPtr->interp, Tcl_ObjPrintf(
"\n (while configuring image \"%s\")", Tk_NameOfImage(
masterPtr->tkMaster)));
Tcl_BackgroundError(masterPtr->interp);
}
static int
Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
{
NotifyEvent *event = (NotifyEvent *) evPtr;
Pg_TclNotifies *notifies;
char *callback;
char *svcallback;
/* We classify SQL notifies as Tcl file events. */
if (!(flags & TCL_FILE_EVENTS))
return 0;
/* If connection's been closed, just forget the whole thing. */
if (event->connid == NULL)
{
if (event->notify)
PQfreemem(event->notify);
return 1;
}
/*
* Preserve/Release to ensure the connection struct doesn't disappear
* underneath us.
*/
Tcl_Preserve((ClientData) event->connid);
/*
* Loop for each interpreter that has ever registered on the
* connection. Each one can get a callback.
*/
for (notifies = event->connid->notify_list;
notifies != NULL;
notifies = notifies->next)
{
Tcl_Interp *interp = notifies->interp;
if (interp == NULL)
continue; /* ignore deleted interpreter */
/*
* Find the callback to be executed for this interpreter, if any.
*/
if (event->notify)
{
/* Ordinary NOTIFY event */
Tcl_HashEntry *entry;
entry = Tcl_FindHashEntry(¬ifies->notify_hash,
event->notify->relname);
if (entry == NULL)
continue; /* no pg_listen in this interpreter */
callback = (char *) Tcl_GetHashValue(entry);
}
else
{
/* Connection-loss event */
callback = notifies->conn_loss_cmd;
}
if (callback == NULL)
continue; /* nothing to do for this interpreter */
/*
* We have to copy the callback string in case the user executes a
* new pg_listen or pg_on_connection_loss during the callback.
*/
svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1));
strcpy(svcallback, callback);
/*
* Execute the callback.
*/
Tcl_Preserve((ClientData) interp);
if (Tcl_GlobalEval(interp, svcallback) != TCL_OK)
{
if (event->notify)
Tcl_AddErrorInfo(interp, "\n (\"pg_listen\" script)");
else
Tcl_AddErrorInfo(interp, "\n (\"pg_on_connection_loss\" script)");
Tcl_BackgroundError(interp);
}
Tcl_Release((ClientData) interp);
ckfree(svcallback);
/*
* Check for the possibility that the callback closed the
* connection.
*/
if (event->connid->conn == NULL)
break;
}
Tcl_Release((ClientData) event->connid);
if (event->notify)
PQfreemem(event->notify);
return 1;
}
/*-----------------------------------------------------------------------------
* ProcessSignals --
*
* Called by the async handler to process pending signals in a safe state
* interpreter state. This is often called just after a command completes.
* The results of the command are passed to this procedure and may be altered
* by it. If trap code is specified for the signal that was received, then
* the trap will be executed, otherwise an error result will be returned
* indicating that the signal occured. If an error is returned, clear the
* errorInfo variable. This makes sure it exists and that it is empty,
* otherwise bogus or non-existant information will be returned if this
* routine was called somewhere besides Tcl_Eval. If a signal was received
* multiple times and a trap is set on it, then that trap will be executed for
* each time the signal was received.
*
* Parameters:
* o clientData - Not used.
* o interp (I/O) - interp result should contain the result for
* the command that just executed. This will either be restored or
* replaced with a new result. If this is NULL, then no interpreter
* is directly available (i.e. event loop). In this case, the first
* interpreter in internal interpreter table is used. If an error results
* from signal processing, it is handled via Tcl_BackgroundError.
* o cmdResultCode - The integer result returned by the command that
* Tcl_Eval just completed. Should be TCL_OK if not called from
* Tcl_Eval.
* Returns:
* Either the original result code, an error result if one of the
* trap commands returned an error, or an error indicating the
* a signal occured.
*-----------------------------------------------------------------------------
*/
static int
ProcessSignals (ClientData clientData, Tcl_Interp *interp, int cmdResultCode)
{
Tcl_Interp *sigInterp;
Tcl_Obj *errStateObjPtr;
int signalNum, result;
/*
* Get the interpreter if it wasn't supplied, if none is available,
* bail out.
*/
if (interp == NULL) {
if (numInterps == 0)
return cmdResultCode;
sigInterp = interpTable [0];
} else {
sigInterp = interp;
}
errStateObjPtr = TclX_SaveResultErrorInfo (sigInterp);
/*
* Process all signals. Don't process any more if one returns an error.
*/
result = TCL_OK;
for (signalNum = 1; signalNum < MAXSIG; signalNum++) {
if (signalsReceived [signalNum] == 0)
continue;
result = ProcessASignal (sigInterp,
(interp == NULL),
signalNum);
if (result == TCL_ERROR)
break;
}
/*
* Restore result and error state if we didn't get an error in signal
* handling.
*/
if (result != TCL_ERROR) {
TclX_RestoreResultErrorInfo (sigInterp, errStateObjPtr) ;
} else {
Tcl_DecrRefCount (errStateObjPtr);
cmdResultCode = TCL_ERROR;
}
/*
* Reset the signal received flag in case more signals are pending.
*/
for (signalNum = 1; signalNum < MAXSIG; signalNum++) {
if (signalsReceived [signalNum] != 0)
break;
}
if (signalNum < MAXSIG) {
if (asyncHandler)
Tcl_AsyncMark (asyncHandler);
}
/*
* If a signal handler returned an error and an interpreter was not
* supplied, call the background error handler.
*/
if ((result == TCL_ERROR) && (interp == NULL)) {
Tcl_BackgroundError (sigInterp);
}
return cmdResultCode;
}
static OSErr
PrintHandler(
const AppleEvent * event,
AppleEvent * reply,
long handlerRefcon)
{
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
AEDescList fileSpecList;
FSRef file;
DescType type;
Size actual;
long count, index;
AEKeyword keyword;
Tcl_DString command, pathName;
Tcl_CmdInfo dummy;
/*
* Don't bother if we don't have an interp or the print document procedure
* doesn't exist.
*/
if (!interp ||
!Tcl_GetCommandInfo(interp, "::tk::mac::PrintDocument", &dummy)) {
return noErr;
}
/*
* If we get any errors while retrieving our parameters we just return with
* no error.
*/
if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList,
&fileSpecList) != noErr) {
return noErr;
}
if (ChkErr(MissedAnyParameters, event) != noErr) {
return noErr;
}
if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) {
return noErr;
}
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, "::tk::mac::PrintDocument", -1);
for (index = 1; index <= count; index++) {
if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword,
&type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) {
continue;
}
if (ChkErr(FSRefToDString, &file, &pathName) == noErr) {
Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
Tcl_DStringFree(&pathName);
}
}
/*
* Now handle the event by evaluating a script.
*/
if (Tcl_EvalEx(interp, Tcl_DStringValue(&command),
Tcl_DStringLength(&command), TCL_EVAL_GLOBAL) != TCL_OK) {
Tcl_BackgroundError(interp);
}
Tcl_DStringFree(&command);
return noErr;
}
int
TnmSnmpEvalCallback(Tcl_Interp *interp, TnmSnmp *session, TnmSnmpPdu *pdu, char *cmd, char *instance, char *oid, char *value, char *last)
{
char buf[20];
int code;
Tcl_DString tclCmd;
char *startPtr, *scanPtr, *name;
Tcl_DStringInit(&tclCmd);
startPtr = cmd;
for (scanPtr = startPtr; *scanPtr != '\0'; scanPtr++) {
if (*scanPtr != '%') {
continue;
}
Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr);
scanPtr++;
startPtr = scanPtr + 1;
switch (*scanPtr) {
case 'R':
sprintf(buf, "%d", pdu->requestId);
Tcl_DStringAppend(&tclCmd, buf, -1);
break;
case 'S':
if (session && session->interp && session->token) {
Tcl_DStringAppend(&tclCmd,
Tcl_GetCommandName(session->interp, session->token), -1);
}
break;
case 'V':
Tcl_DStringAppend(&tclCmd, Tcl_DStringValue(&pdu->varbind), -1);
break;
case 'E':
name = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus);
if (name == NULL) {
name = "unknown";
}
Tcl_DStringAppend(&tclCmd, name, -1);
break;
case 'I':
sprintf(buf, "%d", pdu->errorIndex - 1);
Tcl_DStringAppend(&tclCmd, buf, -1);
break;
case 'A':
Tcl_DStringAppend(&tclCmd, inet_ntoa(pdu->addr.sin_addr), -1);
break;
case 'P':
sprintf(buf, "%u", ntohs((unsigned short) pdu->addr.sin_port));
Tcl_DStringAppend(&tclCmd, buf, -1);
break;
#ifdef TNM_SNMPv3
case 'C':
if (pdu->context && pdu->contextLength) {
Tcl_DStringAppend(&tclCmd, pdu->context, pdu->contextLength);
}
break;
case 'G':
if (pdu->engineID && pdu->engineIDLength) {
Tcl_DStringAppend(&tclCmd, pdu->engineID, pdu->engineIDLength);
}
break;
#endif
case 'T':
name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type);
if (name == NULL) {
name = "unknown";
}
Tcl_DStringAppend(&tclCmd, name, -1);
break;
case 'o':
if (instance) {
Tcl_DStringAppend(&tclCmd, instance, -1);
}
break;
case 'i':
if (oid) {
Tcl_DStringAppend(&tclCmd, oid, -1);
}
break;
case 'v':
if (value) {
Tcl_DStringAppend(&tclCmd, value, -1);
}
break;
case 'p':
if (last) {
Tcl_DStringAppend(&tclCmd, last, -1);
}
break;
case '%':
Tcl_DStringAppend(&tclCmd, "%", -1);
break;
default:
sprintf(buf, "%%%c", *scanPtr);
Tcl_DStringAppend(&tclCmd, buf, -1);
}
}
Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr);
/*
* Now evaluate the callback function and issue a background
* error if the callback fails for some reason. Return the
* original error message and code to the caller.
*/
Tcl_AllowExceptions(interp);
code = Tcl_GlobalEval(interp, Tcl_DStringValue(&tclCmd));
Tcl_DStringFree(&tclCmd);
/*
* Call the usual error handling proc if we have evaluated
* a binding not bound to a specific instance. Bindings
* bound to an instance are usually called during PDU
* processing where it is important to get the error message
* back.
*/
if (code == TCL_ERROR && oid == NULL) {
char *errorMsg = ckstrdup(Tcl_GetStringResult(interp));
Tcl_AddErrorInfo(interp, "\n (snmp callback)");
Tcl_BackgroundError(interp);
Tcl_SetResult(interp, errorMsg, TCL_DYNAMIC);
}
return code;
}
/*
*---------------------------------------------------------------------------
*
* HtmlImageServerGet --
*
* Retrieve an HtmlImage2 object for the image at URL zUrl from
* an image-server. The caller should match this call with a single
* HtmlImageFree() when the image object is no longer required.
*
* If the image is not already in the cache, the Tcl script
* configured as the widget -imagecmd is invoked. If this command
* raises an error or returns an invalid result, then this function
* returns NULL. A Tcl back-ground error is propagated in this case
* also.
*
* Results:
* Pointer to HtmlImage2 object containing the image from zUrl, or
* NULL, if zUrl was invalid for some reason.
*
* Side effects:
* May invoke -imagecmd script.
*
*---------------------------------------------------------------------------
*/
HtmlImage2 *
HtmlImageServerGet (HtmlImageServer *p, const char *zUrl)
{
Tcl_Obj *pImageCmd = p->pTree->options.imagecmd;
Tcl_Interp *interp = p->pTree->interp;
Tcl_HashEntry *pEntry = 0;
HtmlImage2 *pImage = 0;
/* Try to find the requested image in the hash table. */
if (pImageCmd) {
int new_entry;
pEntry = Tcl_CreateHashEntry(&p->aImage, zUrl, &new_entry);
if (new_entry) {
Tcl_Obj *pEval;
Tcl_Obj *pResult;
int rc;
int nObj;
Tcl_Obj **apObj = 0;
Tk_Image img;
/* The image could not be found in the hash table and an
* -imagecmd callback is configured. The callback script
* must be executed to obtain an image. Build up a script
* in pEval and execute it. Put the result in variable pResult.
*/
pEval = Tcl_DuplicateObj(pImageCmd);
Tcl_IncrRefCount(pEval);
Tcl_ListObjAppendElement(interp, pEval, Tcl_NewStringObj(zUrl, -1));
rc = Tcl_EvalObjEx(interp, pEval, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(pEval);
if (rc != TCL_OK) {
goto image_get_out;
}
pResult = Tcl_GetObjResult(interp);
/* Read the result into array apObj. If the result was
* not a valid Tcl list, return NULL and raise a background
* error about the badly formed list.
*/
rc = Tcl_ListObjGetElements(interp, pResult, &nObj, &apObj);
if (rc != TCL_OK) {
goto image_get_out;
}
if (nObj==0) {
Tcl_DeleteHashEntry(pEntry);
goto image_unavailable;
}
pImage = HtmlNew(HtmlImage2);
if (nObj == 1 || nObj == 2) {
img = Tk_GetImage(
interp, p->pTree->tkwin, Tcl_GetString(apObj[0]),
imageChanged, pImage
);
}
if ((nObj != 1 && nObj != 2) || !img) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "-imagecmd returned bad value", 0);
HtmlFree(pImage);
pImage = 0;
goto image_get_out;
}
Tcl_SetHashValue(pEntry, (ClientData)pImage);
Tcl_IncrRefCount(apObj[0]);
pImage->pImageName = apObj[0];
if (nObj == 2) {
Tcl_IncrRefCount(apObj[1]);
pImage->pDelete = apObj[1];
}
pImage->pImageServer = p;
pImage->zUrl = Tcl_GetHashKey(&p->aImage, pEntry);
pImage->image = img;
Tk_SizeOfImage(pImage->image, &pImage->width, &pImage->height);
pImage->isValid = 1;
HtmlImagePixmap(pImage);
}
}
image_get_out:
pImage = (HtmlImage2 *)(pEntry ? Tcl_GetHashValue(pEntry) : 0);
HtmlImageRef(pImage);
if (!pImage && pImageCmd) {
Tcl_BackgroundError(interp);
Tcl_ResetResult(interp);
assert(pEntry);
Tcl_DeleteHashEntry(pEntry);
}
image_unavailable:
return pImage;
}
void
TkpDisplayScale(
ClientData clientData) /* Widget record for scale. */
{
TkScale *scalePtr = (TkScale *) clientData;
Tk_Window tkwin = scalePtr->tkwin;
Tcl_Interp *interp = scalePtr->interp;
int result;
char string[TCL_DOUBLE_SPACE];
MacScale *macScalePtr = (MacScale *) clientData;
Rect r;
WindowRef windowRef;
CGrafPtr destPort, savePort;
Boolean portChanged;
MacDrawable *macDraw;
SInt32 initialValue, minValue, maxValue;
UInt16 numTicks;
#ifdef TK_MAC_DEBUG_SCALE
TkMacOSXDbgMsg("TkpDisplayScale");
#endif
scalePtr->flags &= ~REDRAW_PENDING;
if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
goto done;
}
/*
* Invoke the scale's command if needed.
*/
Tcl_Preserve((ClientData) scalePtr);
if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
Tcl_Preserve((ClientData) interp);
sprintf(string, scalePtr->format, scalePtr->value);
result = Tcl_VarEval(interp, scalePtr->command, " ", string, NULL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command executed by scale)");
Tcl_BackgroundError(interp);
}
Tcl_Release((ClientData) interp);
}
scalePtr->flags &= ~INVOKE_COMMAND;
if (scalePtr->flags & SCALE_DELETED) {
Tcl_Release((ClientData) scalePtr);
return;
}
Tcl_Release((ClientData) scalePtr);
/*
* Now handle the part of redisplay that is the same for
* horizontal and vertical scales: border and traversal
* highlight.
*/
if (scalePtr->highlightWidth != 0) {
GC gc = Tk_GCForColor(scalePtr->highlightColorPtr, Tk_WindowId(tkwin));
Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth,
Tk_WindowId(tkwin));
}
Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scalePtr->bgBorder,
scalePtr->highlightWidth, scalePtr->highlightWidth,
Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
scalePtr->borderWidth, scalePtr->relief);
/*
* Set up port for drawing Macintosh control.
*/
macDraw = (MacDrawable *) Tk_WindowId(tkwin);
destPort = TkMacOSXGetDrawablePort(Tk_WindowId(tkwin));
windowRef = TkMacOSXDrawableWindow(Tk_WindowId(tkwin));
portChanged = QDSwapPort(destPort, &savePort);
TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin));
/*
* Create Macintosh control.
*/
#define MAC_OSX_SCROLL_WIDTH 10
if (scalePtr->orient == ORIENT_HORIZONTAL) {
int offset = (Tk_Height(tkwin) - MAC_OSX_SCROLL_WIDTH)/2;
if (offset < 0) {
offset = 0;
}
r.left = macDraw->xOff + scalePtr->inset;
r.top = macDraw->yOff + offset;
r.right = macDraw->xOff+Tk_Width(tkwin) - scalePtr->inset;
r.bottom = macDraw->yOff + offset + MAC_OSX_SCROLL_WIDTH/2;
} else {
int offset = (Tk_Width(tkwin) - MAC_OSX_SCROLL_WIDTH)/2;
if (offset < 0) {
offset = 0;
}
r.left = macDraw->xOff + offset;
r.top = macDraw->yOff + scalePtr->inset;
r.right = macDraw->xOff + offset + MAC_OSX_SCROLL_WIDTH/2;
r.bottom = macDraw->yOff+Tk_Height(tkwin) - scalePtr->inset;
}
if (macScalePtr->scaleHandle == NULL) {
#ifdef TK_MAC_DEBUG_SCALE
TkMacOSXDbgMsg("Initialising scale");
#endif
initialValue = scalePtr->value;
if (scalePtr->orient == ORIENT_HORIZONTAL) {
minValue = scalePtr->fromValue;
maxValue = scalePtr->toValue;
} else {
minValue = scalePtr->fromValue;
maxValue = scalePtr->toValue;
}
if (scalePtr->tickInterval == 0) {
numTicks = 0;
} else {
numTicks = (maxValue - minValue)/scalePtr->tickInterval;
}
CreateSliderControl(windowRef, &r, initialValue, minValue, maxValue,
kControlSliderPointsDownOrRight, numTicks, 1, scaleActionProc,
&(macScalePtr->scaleHandle));
SetControlReference(macScalePtr->scaleHandle, (UInt32) scalePtr);
if (IsWindowActive(windowRef)) {
macScalePtr->flags |= ACTIVE;
}
} else {
SetControlBounds(macScalePtr->scaleHandle, &r);
SetControl32BitValue(macScalePtr->scaleHandle, scalePtr->value);
SetControl32BitMinimum(macScalePtr->scaleHandle, scalePtr->fromValue);
SetControl32BitMaximum(macScalePtr->scaleHandle, scalePtr->toValue);
}
/*
* Finally draw the control.
*/
SetControlVisibility(macScalePtr->scaleHandle,true,true);
HiliteControl(macScalePtr->scaleHandle,0);
Draw1Control(macScalePtr->scaleHandle);
if (portChanged) {
QDSwapPort(savePort, NULL);
}
done:
scalePtr->flags &= ~REDRAW_ALL;
}
