diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tkInt.h | 7 | ||||
| -rw-r--r-- | generic/tkMessage.c | 359 | ||||
| -rw-r--r-- | generic/tkWindow.c | 6 | ||||
| -rw-r--r-- | tests/message.test | 122 |
5 files changed, 339 insertions, 165 deletions
@@ -1,5 +1,15 @@ 2000-08-01 Eric Melski <ericm@ajubasolutions.com> + * generic/tkInt.h: Replaced prototype for Tk_MessageCmd with + prototype for Tk_MessageObjCmd. + + * generic/tkWindow.c: Marked message command as using the new + MessageObjCmd instead of the old MessageCmd. + + * tests/message.test: Added tests for the message widget. + + * generic/tkMessage.c: Obj'ified the message widget. + * generic/tkInt.h: Removed prototype for Tk_ClipboardCmd, added prototype for Tk_ClipboardObjCmd. diff --git a/generic/tkInt.h b/generic/tkInt.h index 98316d8..81e4bd1 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.25 2000/08/01 18:52:45 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.26 2000/08/02 01:33:33 ericm Exp $ */ #ifndef _TKINT @@ -964,8 +964,9 @@ EXTERN int Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_MessageObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_OptionObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/generic/tkMessage.c b/generic/tkMessage.c index bb3cb00..2f85885 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -7,11 +7,12 @@ * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-2000 by Ajuba Solutions. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMessage.c,v 1.5 1999/12/14 06:52:30 hobbs Exp $ + * RCS: @(#) $Id: tkMessage.c,v 1.6 2000/08/02 01:33:33 ericm Exp $ */ #include "tkPort.h" @@ -28,6 +29,8 @@ typedef struct { * means that the window has been destroyed * but the data structures haven't yet been * cleaned up.*/ + Tk_OptionTable optionTable; /* Table that defines options available for + * this widget. */ Display *display; /* Display containing widget. Used, among * other things, so that resources can be * freed even after tkwin has gone away. */ @@ -58,6 +61,7 @@ typedef struct { XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ Tk_Font tkfont; /* Information about text font, or NULL. */ XColor *fgColorPtr; /* Foreground color in normal mode. */ + Tcl_Obj *padXPtr, *padYPtr; /* Tcl_Obj rep's of padX, padY values. */ int padX, padY; /* User-requested extra space around text. */ int width; /* User-requested width, in pixels. 0 means * compute width using aspect ratio below. */ @@ -95,68 +99,72 @@ typedef struct { * this window. * GOT_FOCUS: Non-zero means this button currently * has the input focus. + * MESSAGE_DELETED: The message has been effectively deleted. */ #define REDRAW_PENDING 1 #define GOT_FOCUS 4 +#define MESSAGE_DELETED 8 /* * Information used for argv parsing. */ -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", - DEF_MESSAGE_ANCHOR, Tk_Offset(Message, anchor), 0}, - {TK_CONFIG_INT, "-aspect", "aspect", "Aspect", - DEF_MESSAGE_ASPECT, Tk_Offset(Message, aspect), 0}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MESSAGE_BG_COLOR, Tk_Offset(Message, border), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_MESSAGE_BG_MONO, Tk_Offset(Message, border), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_MESSAGE_BORDER_WIDTH, Tk_Offset(Message, borderWidth), 0}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_MESSAGE_CURSOR, Tk_Offset(Message, cursor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_MESSAGE_FONT, Tk_Offset(Message, tkfont), 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_MESSAGE_FG, Tk_Offset(Message, fgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG, - Tk_Offset(Message, highlightBgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_MESSAGE_HIGHLIGHT, Tk_Offset(Message, highlightColorPtr), 0}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_MESSAGE_HIGHLIGHT_WIDTH, Tk_Offset(Message, highlightWidth), 0}, - {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", - DEF_MESSAGE_JUSTIFY, Tk_Offset(Message, justify), 0}, - {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", - DEF_MESSAGE_PADX, Tk_Offset(Message, padX), 0}, - {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", - DEF_MESSAGE_PADY, Tk_Offset(Message, padY), 0}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_MESSAGE_RELIEF, Tk_Offset(Message, relief), 0}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_MESSAGE_TAKE_FOCUS, Tk_Offset(Message, takeFocus), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-text", "text", "Text", - DEF_MESSAGE_TEXT, Tk_Offset(Message, string), 0}, - {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable", - DEF_MESSAGE_TEXT_VARIABLE, Tk_Offset(Message, textVarName), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_PIXELS, "-width", "width", "Width", - DEF_MESSAGE_WIDTH, Tk_Offset(Message, width), 0}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_MESSAGE_ANCHOR, + -1, Tk_Offset(Message, anchor), 0, 0, 0}, + {TK_OPTION_INT, "-aspect", "aspect", "Aspect", DEF_MESSAGE_ASPECT, + -1, Tk_Offset(Message, aspect), 0, 0, 0}, + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_MESSAGE_BG_COLOR, -1, Tk_Offset(Message, border), 0, + (ClientData) DEF_MESSAGE_BG_MONO, 0}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, (char *) NULL, + 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, (char *) NULL, + 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_MESSAGE_BORDER_WIDTH, -1, + Tk_Offset(Message, borderWidth), 0, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_MESSAGE_CURSOR, -1, Tk_Offset(Message, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, (char *) NULL, + 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_MESSAGE_FONT, -1, Tk_Offset(Message, tkfont), 0, 0, 0}, + {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", + DEF_MESSAGE_FG, -1, Tk_Offset(Message, fgColorPtr), 0, 0, 0}, + {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", + "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG, -1, + Tk_Offset(Message, highlightBgColorPtr), 0, 0}, + {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", + DEF_MESSAGE_HIGHLIGHT, -1, Tk_Offset(Message, highlightColorPtr), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", + "HighlightThickness", DEF_MESSAGE_HIGHLIGHT_WIDTH, -1, + Tk_Offset(Message, highlightWidth), 0, 0, 0}, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + DEF_MESSAGE_JUSTIFY, -1, Tk_Offset(Message, justify), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_MESSAGE_PADX, Tk_Offset(Message, padXPtr), + Tk_Offset(Message, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_MESSAGE_PADY, Tk_Offset(Message, padYPtr), + Tk_Offset(Message, padY), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_MESSAGE_RELIEF, -1, Tk_Offset(Message, relief), 0, 0, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_MESSAGE_TAKE_FOCUS, -1, Tk_Offset(Message, takeFocus), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_MESSAGE_TEXT, -1, Tk_Offset(Message, string), 0, 0, 0}, + {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", + DEF_MESSAGE_TEXT_VARIABLE, -1, Tk_Offset(Message, textVarName), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-width", "width", "Width", + DEF_MESSAGE_WIDTH, -1, Tk_Offset(Message, width), 0, 0 ,0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, 0} }; /* @@ -170,13 +178,14 @@ static void MessageEventProc _ANSI_ARGS_((ClientData clientData, static char * MessageTextVarProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int MessageWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +static int MessageWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void MessageWorldChanged _ANSI_ARGS_(( ClientData instanceData)); static void ComputeMessageGeometry _ANSI_ARGS_((Message *msgPtr)); static int ConfigureMessage _ANSI_ARGS_((Tcl_Interp *interp, - Message *msgPtr, int argc, char **argv, + Message *msgPtr, int objc, Tcl_Obj *CONST objv[], int flags)); static void DestroyMessage _ANSI_ARGS_((char *memPtr)); static void DisplayMessage _ANSI_ARGS_((ClientData clientData)); @@ -212,80 +221,89 @@ static TkClassProcs messageClass = { */ int -Tk_MessageCmd(clientData, interp, argc, argv) +Tk_MessageObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { register Message *msgPtr; - Tk_Window new; + Tk_OptionTable optionTable; Tk_Window tkwin = (Tk_Window) clientData; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + optionTable = (Tk_OptionTable) clientData; + if (optionTable == NULL) { + Tcl_CmdInfo info; + char *name; + /* + * We haven't created the option table for this widget class + * yet. Do it now and save the table as the clientData for + * the command, so we'll have access to it in future + * invocations of the command. + */ + + optionTable = Tk_CreateOptionTable(interp, optionSpecs); + name = Tcl_GetString(objv[0]); + Tcl_GetCommandInfo(interp, name, &info); + info.objClientData = (ClientData) optionTable; + Tcl_SetCommandInfo(interp, name, &info); + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); - if (new == NULL) { + tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), + Tcl_GetString(objv[1]), (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } msgPtr = (Message *) ckalloc(sizeof(Message)); - msgPtr->tkwin = new; - msgPtr->display = Tk_Display(new); - msgPtr->interp = interp; - msgPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(msgPtr->tkwin), - MessageWidgetCmd, (ClientData) msgPtr, MessageCmdDeletedProc); - msgPtr->textLayout = NULL; - msgPtr->string = NULL; - msgPtr->numChars = 0; - msgPtr->textVarName = NULL; - msgPtr->border = NULL; - msgPtr->borderWidth = 0; - msgPtr->relief = TK_RELIEF_FLAT; - msgPtr->highlightWidth = 0; - msgPtr->highlightBgColorPtr = NULL; - msgPtr->highlightColorPtr = NULL; - msgPtr->tkfont = NULL; - msgPtr->fgColorPtr = NULL; - msgPtr->textGC = None; - msgPtr->padX = 0; - msgPtr->padY = 0; - msgPtr->anchor = TK_ANCHOR_CENTER; - msgPtr->width = 0; - msgPtr->aspect = 150; - msgPtr->msgWidth = 0; - msgPtr->msgHeight = 0; - msgPtr->justify = TK_JUSTIFY_LEFT; - msgPtr->cursor = None; - msgPtr->takeFocus = NULL; - msgPtr->flags = 0; + memset(msgPtr, 0, (size_t) sizeof(Message)); + + /* + * Set values for those fields that don't take a 0 or NULL value. + */ + msgPtr->tkwin = tkwin; + msgPtr->display = Tk_Display(tkwin); + msgPtr->interp = interp; + msgPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(msgPtr->tkwin), MessageWidgetObjCmd, + (ClientData) msgPtr, MessageCmdDeletedProc); + msgPtr->optionTable = optionTable; + msgPtr->relief = TK_RELIEF_FLAT; + msgPtr->textGC = None; + msgPtr->anchor = TK_ANCHOR_CENTER; + msgPtr->aspect = 150; + msgPtr->justify = TK_JUSTIFY_LEFT; + msgPtr->cursor = None; Tk_SetClass(msgPtr->tkwin, "Message"); TkSetClassProcs(msgPtr->tkwin, &messageClass, (ClientData) msgPtr); Tk_CreateEventHandler(msgPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, MessageEventProc, (ClientData) msgPtr); - if (ConfigureMessage(interp, msgPtr, argc-2, argv+2, 0) != TCL_OK) { - goto error; + if (Tk_InitOptions(interp, (char *)msgPtr, optionTable, tkwin) != TCL_OK) { + Tk_DestroyWindow(msgPtr->tkwin); + return TCL_ERROR; + } + + if (ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0) != TCL_OK) { + Tk_DestroyWindow(msgPtr->tkwin); + return TCL_ERROR; } Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); return TCL_OK; - - error: - Tk_DestroyWindow(msgPtr->tkwin); - return TCL_ERROR; } /* *-------------------------------------------------------------- * - * MessageWidgetCmd -- + * MessageWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a widget managed by this module. @@ -301,50 +319,67 @@ Tk_MessageCmd(clientData, interp, argc, argv) */ static int -MessageWidgetCmd(clientData, interp, argc, argv) +MessageWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about message widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { register Message *msgPtr = (Message *) clientData; - size_t length; - int c; + static char *optionStrings[] = { "cget", "configure", (char *) NULL }; + enum options { MESSAGE_CGET, MESSAGE_CONFIGURE }; + int index, result; + Tcl_Obj *objPtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - (char *) NULL); - return TCL_ERROR; + + Tcl_Preserve((ClientData) msgPtr); + + switch ((enum options) index) { + case MESSAGE_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + return TCL_ERROR; + } + objPtr = Tk_GetOptionValue(interp, (char *) msgPtr, + msgPtr->optionTable, objv[2], msgPtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; + } + break; } - return Tk_ConfigureValue(interp, msgPtr->tkwin, configSpecs, - (char *) msgPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { - return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs, - (char *) msgPtr, (char *) NULL, 0); - } else if (argc == 3) { - return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs, - (char *) msgPtr, argv[2], 0); - } else { - return ConfigureMessage(interp, msgPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); + case MESSAGE_CONFIGURE: { + if (objc <= 3) { + objPtr = Tk_GetOptionInfo(interp, (char *) msgPtr, + msgPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + msgPtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; + } + } else { + result = ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0); + } + break; } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be cget or configure", (char *) NULL); - return TCL_ERROR; } + + Tcl_Release((ClientData) msgPtr); + return result; } /* @@ -371,22 +406,32 @@ DestroyMessage(memPtr) { register Message *msgPtr = (Message *) memPtr; + msgPtr->flags |= MESSAGE_DELETED; + + Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd); + if (msgPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr); + } + /* * Free up all the stuff that requires special handling, then - * let Tk_FreeOptions handle all the standard option-related + * let Tk_FreeConfigOptions handle all the standard option-related * stuff. */ - Tk_FreeTextLayout(msgPtr->textLayout); + if (msgPtr->textGC != None) { + Tk_FreeGC(msgPtr->display, msgPtr->textGC); + } + if (msgPtr->textLayout != NULL) { + Tk_FreeTextLayout(msgPtr->textLayout); + } if (msgPtr->textVarName != NULL) { Tcl_UntraceVar(msgPtr->interp, msgPtr->textVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, (ClientData) msgPtr); } - if (msgPtr->textGC != None) { - Tk_FreeGC(msgPtr->display, msgPtr->textGC); - } - Tk_FreeOptions(configSpecs, (char *) msgPtr, msgPtr->display, 0); + Tk_FreeConfigOptions((char *) msgPtr, msgPtr->optionTable, msgPtr->tkwin); + msgPtr->tkwin = NULL; ckfree((char *) msgPtr); } @@ -412,14 +457,16 @@ DestroyMessage(memPtr) */ static int -ConfigureMessage(interp, msgPtr, argc, argv, flags) +ConfigureMessage(interp, msgPtr, objc, objv, flags) Tcl_Interp *interp; /* Used for error reporting. */ register Message *msgPtr; /* Information about widget; may or may * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - char **argv; /* Arguments. */ + int objc; /* Number of valid entries in argv. */ + Tcl_Obj *CONST objv[]; /* Arguments. */ int flags; /* Flags to pass to Tk_ConfigureWidget. */ { + Tk_SavedOptions savedOptions; + /* * Eliminate any existing trace on a variable monitored by the message. */ @@ -430,10 +477,12 @@ ConfigureMessage(interp, msgPtr, argc, argv, flags) MessageTextVarProc, (ClientData) msgPtr); } - if (Tk_ConfigureWidget(interp, msgPtr->tkwin, configSpecs, - argc, argv, (char *) msgPtr, flags) != TCL_OK) { + if (Tk_SetOptions(interp, (char *) msgPtr, msgPtr->optionTable, objc, objv, + msgPtr->tkwin, &savedOptions, (int *)NULL) != TCL_OK) { + Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } + /* * If the message is to display the value of a variable, then set up @@ -471,6 +520,7 @@ ConfigureMessage(interp, msgPtr, argc, argv, flags) msgPtr->highlightWidth = 0; } + Tk_FreeSavedOptions(&savedOptions); MessageWorldChanged((ClientData) msgPtr); return TCL_OK; } @@ -725,14 +775,7 @@ MessageEventProc(clientData, eventPtr) || (eventPtr->type == ConfigureNotify)) { goto redraw; } else if (eventPtr->type == DestroyNotify) { - if (msgPtr->tkwin != NULL) { - msgPtr->tkwin = NULL; - Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd); - } - if (msgPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr); - } - Tcl_EventuallyFree((ClientData) msgPtr, DestroyMessage); + DestroyMessage((char *) clientData); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { msgPtr->flags |= GOT_FOCUS; @@ -780,7 +823,6 @@ MessageCmdDeletedProc(clientData) ClientData clientData; /* Pointer to widget record for widget. */ { Message *msgPtr = (Message *) clientData; - Tk_Window tkwin = msgPtr->tkwin; /* * This procedure could be invoked either because the window was @@ -789,9 +831,8 @@ MessageCmdDeletedProc(clientData) * destroys the widget. */ - if (tkwin != NULL) { - msgPtr->tkwin = NULL; - Tk_DestroyWindow(tkwin); + if (!(msgPtr->flags & MESSAGE_DELETED)) { + Tk_DestroyWindow(msgPtr->tkwin); } } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index d1238ac..c2bc9fb 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.18 2000/05/29 01:43:14 hobbs Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.19 2000/08/02 01:33:33 ericm Exp $ */ #include "tkPort.h" @@ -100,7 +100,7 @@ static TkCmd commands[] = { {"bell", NULL, Tk_BellObjCmd, 0, 1}, {"bind", Tk_BindCmd, NULL, 1, 1}, {"bindtags", Tk_BindtagsCmd, NULL, 1, 1}, - {"clipboard", Tk_ClipboardCmd, NULL, 0, 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}, @@ -141,7 +141,7 @@ static TkCmd commands[] = { {"label", NULL, Tk_LabelObjCmd, 1, 0}, {"listbox", NULL, Tk_ListboxObjCmd, 1, 0}, {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0}, - {"message", Tk_MessageCmd, NULL, 1, 1}, + {"message", NULL, Tk_MessageObjCmd, 1, 0}, {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0}, {"scale", NULL, Tk_ScaleObjCmd, 1, 0}, {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1}, diff --git a/tests/message.test b/tests/message.test new file mode 100644 index 0000000..f2c7d5d --- /dev/null +++ b/tests/message.test @@ -0,0 +1,122 @@ +# This file is a Tcl script to test out the "message" command +# of Tk. It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-2000 by Ajuba Solutions. +# All rights reserved. +# +# RCS: @(#) $Id: message.test,v 1.1 2000/08/02 01:33:34 ericm Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +option add *Message.borderWidth 2 +option add *Message.highlightThickness 2 +option add *Message.font {Helvetica -12 bold} + +message .m +pack .m +update +set i 0 +foreach test { + {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} + {-aspect 3 3 bogus {expected integer but got "bogus"}} + {-background #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-bd 4 4 badValue {bad screen distance "badValue"}} + {-bg #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-cursor arrow arrow badValue {bad cursor spec "badValue"}} + {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} + {-font fixed fixed {} {font "" doesn't exist}} + {-foreground green green badValue {unknown color name "badValue"}} + {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} + {-highlightcolor #123456 #123456 non-existent + {unknown color name "non-existent"}} + {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} + {-justify right right bogus {bad justification "bogus": must be left, right, or center}} + {-padx 12m 12m 420x {bad screen distance "420x"}} + {-pady 12m 12m 420x {bad screen distance "420x"}} + {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} + {-text "Sample text" {Sample text} {} {} {1 1 1 1}} + {-textvariable i i {} {} {1 1 1 1}} + {-width 32 32 badValue {bad screen distance "badValue"}} +} { + set name [lindex $test 0] + test message-1.$i {configuration options} { + .m configure $name [lindex $test 1] + lindex [.m configure $name] 4 + } [lindex $test 2] + incr i + if {[lindex $test 3] != ""} { + test message-1.$i {configuration options} { + list [catch {.m configure $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + .m configure $name [lindex [.m configure $name] 3] + incr i +} +destroy .m + +test message-2.1 {Tk_MessageObjCmd procedure} { + list [catch {message} msg] $msg +} {1 {wrong # args: should be "message pathName ?options?"}} +test message-2.2 {Tk_MessageObjCmd procedure} { + list [catch {message foo} msg] $msg [winfo child .] +} {1 {bad window path name "foo"} {}} +test message-2.3 {Tk_MessageObjCmd procedure} { + list [catch {message .s -gorp dumb} msg] $msg [winfo child .] +} {1 {unknown option "-gorp"} {}} + +test message-3.1 {MessageWidgetObjCmd procedure} { + message .m + set result [list [catch {.m} msg] $msg] + destroy .m + set result +} {1 {wrong # args: should be ".m option ?arg arg ...?"}} +test message-3.2 {MessageWidgetObjCmd procedure, "cget"} { + message .m + set result [list [catch {.m cget} msg] $msg] + destroy .m + set result +} {1 {wrong # args: should be ".m cget option"}} +test message-3.3 {MessageWidgetObjCmd procedure, "cget"} { + message .m + set result [list [catch {.m cget -gorp} msg] $msg] + destroy .m + set result +} {1 {unknown option "-gorp"}} +test message-3.4 {MessageWidgetObjCmd procedure, "cget"} { + message .m + .m configure -text foobar + set result [.m cget -text] + destroy .m + set result +} "foobar" +test message-3.5 {MessageWidgetObjCmd procedure, "configure"} { + message .m + set result [llength [.m configure]] + destroy .m + set result +} 21 +test message-3.6 {MessageWidgetObjCmd procedure, "configure"} { + message .m + set result [list [catch {.m configure -foo} msg] $msg] + destroy .m + set result +} {1 {unknown option "-foo"}} +test message-3.7 {MessageWidgetObjCmd procedure, "configure"} { + message .m + .m configure -bd 4 + .m configure -bg #ffffff + set result [lindex [.m configure -bd] 4] + destroy .m + set result +} {4} + +# cleanup +::tcltest::cleanupTests +return |