summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tkCmds.c12
-rw-r--r--generic/tkInt.h11
-rw-r--r--generic/tkUtil.c115
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