Tk
view release on metacpan or search on metacpan
pTk/mTk/generic/tkWindow.c view on Meta::CPAN
* events on internal windows: these events are generated internally.
*/
static XWindowChanges defChanges = {
0, 0, 1, 1, 0, 0, Above
};
#define ALL_EVENTS_MASK \
KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \
VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask
static XSetWindowAttributes defAtts= {
None, /* background_pixmap */
0, /* background_pixel */
CopyFromParent, /* border_pixmap */
0, /* border_pixel */
NorthWestGravity, /* bit_gravity */
NorthWestGravity, /* win_gravity */
NotUseful, /* backing_store */
(unsigned) ~0, /* backing_planes */
0, /* backing_pixel */
False, /* save_under */
ALL_EVENTS_MASK, /* event_mask */
0, /* do_not_propagate_mask */
False, /* override_redirect */
CopyFromParent, /* colormap */
None /* cursor */
};
/*
* The following structure defines all of the commands supported by
* Tk, and the C procedures that execute them.
*/
typedef struct {
char *name; /* Name of command. */
Tcl_ObjCmdProc *cmdProc; /* Command's string-based procedure. */
Tcl_ObjCmdProc *objProc; /* Command's object-based procedure. */
int isSafe; /* If !0, this command will be exposed in
* a safe interpreter. Otherwise it will be
* hidden in a safe interpreter. */
int passMainWindow; /* 0 means provide NULL clientData to
* command procedure; 1 means pass main
* window as clientData to command
* procedure. */
} TkCmd;
#ifdef _LANG
#define LangLoaded(x) NULL
#else
#define LangLoaded(x) x
#endif
static TkCmd commands[] = {
/*
* Commands that are part of the intrinsics:
*/
{"bell", NULL, Tk_BellObjCmd, 0, 1},
{"bind", NULL, Tk_BindObjCmd, 1, 1},
{"bindtags", NULL, Tk_BindtagsObjCmd, 1, 1},
{"clipboard", NULL, Tk_ClipboardObjCmd, 0, 1},
{"destroy", NULL, Tk_DestroyObjCmd, 1, 1},
{"event", NULL, Tk_EventObjCmd, 1, 1},
{"focus", NULL, Tk_FocusObjCmd, 1, 1},
{"font", NULL, Tk_FontObjCmd, 1, 1},
{"grab", NULL, Tk_GrabObjCmd, 0, 1},
{"grid", NULL, Tk_GridObjCmd, 1, 1},
{"image", NULL, Tk_ImageObjCmd, 1, 1},
{"lower", NULL, Tk_LowerObjCmd, 1, 1},
{"option", NULL, Tk_OptionObjCmd, 1, 1},
{"pack", NULL, Tk_PackObjCmd, 1, 1},
{"place", NULL, Tk_PlaceObjCmd, 1, 0},
{"raise", NULL, Tk_RaiseObjCmd, 1, 1},
{"selection", NULL, Tk_SelectionObjCmd, 0, 1},
{"tk", NULL, Tk_TkObjCmd, 1, 1},
{"tkwait", NULL, Tk_TkwaitObjCmd, 1, 1},
#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)
{"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1},
{"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd, 0, 1},
{"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, 0, 1},
{"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, 0, 1},
#endif
#ifdef __WIN32__
{"tk_messageBox", NULL, Tk_MessageBoxObjCmd, 0, 1},
#endif
{"update", NULL, Tk_UpdateObjCmd, 1, 1},
{"winfo", NULL, Tk_WinfoObjCmd, 1, 1},
{"wm", NULL, Tk_WmObjCmd, 0, 1},
/*
* Widget class commands.
*/
{"button", NULL, Tk_ButtonObjCmd, 1, 0},
{"canvas", NULL, LangLoaded(Tk_CanvasObjCmd), 1, 1},
{"checkbutton", NULL, Tk_CheckbuttonObjCmd, 1, 0},
{"entry", NULL, LangLoaded(Tk_EntryObjCmd), 1, 0},
{"frame", NULL, Tk_FrameObjCmd, 1, 0},
{"label", NULL, Tk_LabelObjCmd, 1, 0},
{"labelframe", NULL, Tk_LabelframeObjCmd, 1, 0},
{"listbox", NULL, LangLoaded(Tk_ListboxObjCmd), 1, 0},
{"menubutton", NULL, LangLoaded(Tk_MenubuttonObjCmd), 1, 0},
{"message", NULL, Tk_MessageObjCmd, 1, 0},
{"panedwindow", NULL, Tk_PanedWindowObjCmd, 1, 0},
{"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0},
{"scale", NULL, LangLoaded(Tk_ScaleObjCmd), 1, 0},
{"scrollbar", LangLoaded(Tk_ScrollbarCmd), NULL, 1, 1},
{"spinbox", NULL, LangLoaded(Tk_SpinboxObjCmd), 1, 0},
{"text", LangLoaded(Tk_TextCmd), NULL, 1, 1},
{"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
/*
* Misc.
*/
#if defined(MAC_TCL) || defined(MAC_OSX_TK)
{"::tk::unsupported::MacWindowStyle",
TkUnsupported1Cmd, NULL, 1, 1},
#endif
{(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST *))) NULL, NULL, 0}
};
pTk/mTk/generic/tkWindow.c view on Meta::CPAN
*
* Tk_Init --
*
* This procedure is invoked to add Tk to an interpreter. It
* incorporates all of Tk's commands into the interpreter and
* creates the main window for a new Tk application. If the
* interpreter contains a variable "argv", this procedure
* extracts several arguments from that variable, uses them
* to configure the main window, and modifies argv to exclude
* the arguments (see the "wish" documentation for a list of
* the arguments that are extracted).
*
* Results:
* Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
* Depends on various initialization scripts that get invoked.
*
*----------------------------------------------------------------------
*/
int
Tk_Init(interp)
Tcl_Interp *interp; /* Interpreter to initialize. */
{
return Initialize(interp);
}
/*
*----------------------------------------------------------------------
*
* Tk_SafeInit --
*
* This procedure is invoked to add Tk to a safe interpreter. It
* invokes the internal procedure that does the real work.
*
* Results:
* Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
* Depends on various initialization scripts that are invoked.
*
*----------------------------------------------------------------------
*/
int
Tk_SafeInit(interp)
Tcl_Interp *interp; /* Interpreter to initialize. */
{
/*
* Initialize the interpreter with Tk, safely. This removes
* all the Tk commands that are unsafe.
*
* Rationale:
*
* - Toplevel and menu are unsafe because they can be used to cover
* the entire screen and to steal input from the user.
* - Continuous ringing of the bell is a nuisance.
* - Cannot allow access to the clipboard because a malicious script
* can replace the contents with the string "rm -r *" and lead to
* surprises when the contents of the clipboard are pasted. Similarly,
* the selection command is blocked.
* - Cannot allow send because it can be used to cause unsafe
* interpreters to execute commands. The tk command recreates the
* send command, so that too must be hidden.
* - Focus can be used to grab the focus away from another window,
* in effect stealing user input. Cannot allow that.
* NOTE: We currently do *not* hide focus as it would make it
* impossible to provide keyboard input to Tk in a safe interpreter.
* - Grab can be used to block the user from using any other apps
* on the screen.
* - Tkwait can block the containing process forever. Use bindings,
* fileevents and split the protocol into before-the-wait and
* after-the-wait parts. More work but necessary.
* - Wm is unsafe because (if toplevels are allowed, in the future)
* it can be used to remove decorations, move windows around, cover
* the entire screen etc etc.
*
* Current risks:
*
* - No CPU time limit, no memory allocation limits, no color limits.
*
* The actual code called is the same as Tk_Init but Tcl_IsSafe()
* is checked at several places to differentiate the two initialisations.
*/
return Initialize(interp);
}
extern TkStubs tkStubs;
/*
*----------------------------------------------------------------------
*
* Initialize --
*
*
* Results:
* A standard Tcl result. Also leaves an error message in the interp's
* result if there was an error.
*
* Side effects:
* Depends on the initialization scripts that are invoked.
*
*----------------------------------------------------------------------
*/
static int
Initialize(interp)
Tcl_Interp *interp; /* Interpreter to initialize. */
{
Var p;
int argc, code;
CONST char **argv;
char *args[20];
CONST char *argString = NULL;
Tcl_DString class;
ThreadSpecificData *tsdPtr;
/*
( run in 1.317 second using v1.01-cache-2.11-cpan-84e82930d8c )