diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tkCmds.c | 12 | ||||
-rw-r--r-- | generic/tkInt.h | 11 | ||||
-rw-r--r-- | generic/tkUtil.c | 115 |
3 files changed, 131 insertions, 7 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 49d1f38..21bd8d4 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCmds.c,v 1.48 2008/12/10 00:34:51 das Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.49 2008/12/10 05:02:40 das Exp $ */ #include "tkInt.h" @@ -51,6 +51,12 @@ static int WindowingsystemCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +#if defined(__WIN32__) || defined(MAC_OSX_TK) +MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; +#else +#define tkFontchooserEnsemble NULL +#endif + /* * Table of tk subcommand names and implementations. */ @@ -63,6 +69,7 @@ static const TkEnsemble tkCmdMap[] = { {"scaling", ScalingCmd }, {"useinputmethods", UseinputmethodsCmd }, {"windowingsystem", WindowingsystemCmd }, + {"fontchooser", NULL, tkFontchooserEnsemble}, {NULL} }; @@ -635,6 +642,9 @@ int TkInitTkCmd(Tcl_Interp *interp, ClientData clientData) { TkMakeEnsemble(interp, "::", "tk", clientData, tkCmdMap); +#if defined(__WIN32__) || defined(MAC_OSX_TK) + TkInitFontchooser(interp, clientData); +#endif return TCL_OK; } diff --git a/generic/tkInt.h b/generic/tkInt.h index 7131bb7..214b428 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.97 2008/12/10 00:34:51 das Exp $ + * RCS: $Id: tkInt.h,v 1.98 2008/12/10 05:02:51 das Exp $ */ #ifndef _TKINT @@ -1040,9 +1040,6 @@ MODULE_SCOPE int Tk_ChooseColorObjCmd(ClientData clientData, MODULE_SCOPE int Tk_ChooseDirectoryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_ChooseFontObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_DestroyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1251,7 +1248,6 @@ MODULE_SCOPE void TkpMakeTransparentWindowExist(Tk_Window tkwin, MODULE_SCOPE void TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef, Window *parentPtr, Tk_Window tkParent, TkBusy busy); - MODULE_SCOPE void TkDrawAngledTextLayout(Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int firstChar, @@ -1264,11 +1260,16 @@ MODULE_SCOPE void TkUnderlineAngledTextLayout(Display *display, int x, int y, double angle, int underline); MODULE_SCOPE int TkIntersectAngledTextLayout(Tk_TextLayout layout, int x,int y, int width, int height, double angle); +MODULE_SCOPE int TkBackgroundEvalObjv(Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv, int flags); +MODULE_SCOPE void TkSendVirtualEvent(Tk_Window tgtWin, const char *eventName); MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp, const char *namespace, const char *name, ClientData clientData, const TkEnsemble *map); MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp, ClientData clientData); +MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp, + ClientData clientData); /* * Unsupported commands. diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 8cfaf9a..5218740 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUtil.c,v 1.26 2008/12/10 04:27:45 das Exp $ + * RCS: @(#) $Id: tkUtil.c,v 1.27 2008/12/10 05:02:51 das Exp $ */ #include "tkInt.h" @@ -978,6 +978,89 @@ TkFindStateNumObj( } /* + * ---------------------------------------------------------------------- + * + * TkBackgroundEvalObjv -- + * + * Evaluate a command while ensuring that we do not affect the + * interpreters state. This is important when evaluating script + * during background tasks. + * + * Results: + * A standard Tcl result code. + * + * Side Effects: + * The interpreters variables and code may be modified by the script + * but the result will not be modified. + * + * ---------------------------------------------------------------------- + */ + +int +TkBackgroundEvalObjv( + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv, + int flags) +{ + Tcl_DString errorInfo, errorCode; + Tcl_SavedResult state; + int n, r = TCL_OK; + + Tcl_DStringInit(&errorInfo); + Tcl_DStringInit(&errorCode); + + Tcl_Preserve(interp); + + /* + * Record the state of the interpreter + */ + + Tcl_SaveResult(interp, &state); + Tcl_DStringAppend(&errorInfo, + Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); + Tcl_DStringAppend(&errorCode, + Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); + + /* + * Evaluate the command and handle any error. + */ + + for (n = 0; n < objc; ++n) { + Tcl_IncrRefCount(objv[n]); + } + r = Tcl_EvalObjv(interp, objc, objv, flags); + for (n = 0; n < objc; ++n) { + Tcl_DecrRefCount(objv[n]); + } + if (r == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (background event handler)"); + Tcl_BackgroundError(interp); + } + + Tcl_Release(interp); + + /* + * Restore the state of the interpreter + */ + + Tcl_SetVar(interp, "errorInfo", + Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "errorCode", + Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); + Tcl_RestoreResult(interp, &state); + + /* + * Clean up references. + */ + + Tcl_DStringFree(&errorInfo); + Tcl_DStringFree(&errorCode); + + return r; +} + +/* *---------------------------------------------------------------------- * * TkMakeEnsemble -- @@ -1060,6 +1143,36 @@ TkMakeEnsemble( Tcl_DStringFree(&ds); return ensemble; } + +/* + *---------------------------------------------------------------------- + * + * TkSendVirtualEvent -- + * + * Send a virtual event notification to the specified target window. + * Equivalent to "event generate $target <<$eventName>>" + * + * Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, + * so this routine does not reenter the interpreter. + * + *---------------------------------------------------------------------- + */ + +void +TkSendVirtualEvent(Tk_Window target, const char *eventName) +{ + XEvent event; + + memset(&event, 0, sizeof(event)); + event.xany.type = VirtualEvent; + event.xany.serial = NextRequest(Tk_Display(target)); + event.xany.send_event = False; + event.xany.window = Tk_WindowId(target); + event.xany.display = Tk_Display(target); + ((XVirtualEvent *) &event)->name = Tk_GetUid(eventName); + + Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); +} /* * Local Variables: * mode: c |