From 071818f331706f06d0498f1f9d5f4e9121395daf Mon Sep 17 00:00:00 2001 From: pspjuth Date: Wed, 26 Sep 2001 21:36:19 +0000 Subject: Added labelframe widget. TIP#18. --- ChangeLog | 24 ++ doc/frame.n | 15 +- doc/labelframe.n | 147 +++++++ doc/toplevel.n | 19 +- generic/tkFrame.c | 989 ++++++++++++++++++++++++++++++++++++++++--- generic/tkInt.h | 5 +- generic/tkWindow.c | 3 +- library/demos/labelframe.tcl | 79 ++++ library/demos/radio.tcl | 6 +- library/demos/widget | 8 +- mac/tkMacDefault.h | 18 +- tests/frame.test | 284 +++++++++++-- tests/grid.test | 37 +- tests/pack.test | 38 +- tests/place.test | 19 +- unix/tkUnixDefault.h | 18 +- win/tkWinDefault.h | 24 +- win/tkWinFont.c | 7 +- 18 files changed, 1620 insertions(+), 120 deletions(-) create mode 100644 doc/labelframe.n create mode 100644 library/demos/labelframe.tcl diff --git a/ChangeLog b/ChangeLog index a832123..8c82f9a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,29 @@ 2001-09-26 Peter Spjuth + * win/tkWinFont.c (Tk_DrawChars): Added support for clipping text. + + * doc/frame.n: + * doc/labelframe.n: + * doc/toplevel.n: + * generic/tkFrame.c: + * generic/tkInt.h: + * generic/tkWindow.c: + * library/demos/radio.tcl: + * library/demos/labelframe.tcl: + * library/demos/widget: + * mac/tkMacDefault.h: + * tests/frame.test: + * unix/tkUnixDefault.h: + * win/tkWinDefault.h: Added labelframe widget. Added -padx/y + options to frame and toplevel. + + * tests/grid.test: + * tests/pack.test: + * tests/place.test: Used labelframe to test geometry manager changes. + [TIP 18] [Patch 429164] + +2001-09-26 Peter Spjuth + * doc/GeomReq.3: * doc/WindowId.3: * generic/tk.decls: diff --git a/doc/frame.n b/doc/frame.n index 3b195a4..cb00955 100644 --- a/doc/frame.n +++ b/doc/frame.n @@ -6,10 +6,10 @@ '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" -'\" RCS: @(#) $Id: frame.n,v 1.3 2000/08/25 06:58:32 ericm Exp $ +'\" RCS: @(#) $Id: frame.n,v 1.4 2001/09/26 21:36:19 pspjuth Exp $ '\" .so man.macros -.TH frame n 8.0 Tk "Tk Built-In Commands" +.TH frame n 8.4 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -17,9 +17,9 @@ frame \- Create and manipulate frame widgets .SH SYNOPSIS \fBframe\fR \fIpathName\fR ?\fIoptions\fR? .SO -\-borderwidth \-highlightcolor \-takefocus -\-cursor \-highlightthickness -\-highlightbackground \-relief +\-borderwidth \-highlightcolor \-pady +\-cursor \-highlightthickness \-relief +\-highlightbackground \-padx \-takefocus .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-background background Background @@ -46,7 +46,6 @@ If the \fBcolormap\fR option is not specified, the new window uses the same colormap as its parent. This option may not be changed with the \fBconfigure\fR widget command. -.VS "" br .OP \-container container Container The value must be a boolean. If true, it means that this window will be used as a container in which some other application will be embedded @@ -56,7 +55,6 @@ things like geometry requests. The window should not have any children of its own in this application. This option may not be changed with the \fBconfigure\fR widget command. -.VE .OP \-height height Height Specifies the desired height for the window in any of the forms acceptable to \fBTk_GetPixels\fR. @@ -131,5 +129,8 @@ command. When a new frame is created, it has no default event bindings: frames are not intended to be interactive. +.SH "SEE ALSO" +labelframe(n), toplevel(n) + .SH KEYWORDS frame, widget diff --git a/doc/labelframe.n b/doc/labelframe.n new file mode 100644 index 0000000..7a5c6ec --- /dev/null +++ b/doc/labelframe.n @@ -0,0 +1,147 @@ +'\" +'\" Copyright (c) 1990-1994 The Regents of the University of California. +'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +'\" +'\" RCS: @(#) $Id: labelframe.n,v 1.1 2001/09/26 21:36:19 pspjuth Exp $ +'\" +.so man.macros +.TH labelframe n 8.4 Tk "Tk Built-In Commands" +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +labelframe \- Create and manipulate labelframe widgets +.SH SYNOPSIS +\fBlabelframe\fR \fIpathName\fR ?\fIoptions\fR? +.SO +\-borderwidth \-highlightbackground \-pady +\-cursor \-highlightcolor \-relief +\-font \-highlightthickness \-takefocus +\-foreground \-padx \-text +.SE +.SH "WIDGET-SPECIFIC OPTIONS" +.OP \-background background Background +This option is the same as the standard \fBbackground\fR option +except that its value may also be specified as an empty string. +In this case, the widget will display no background or border, and +no colors will be consumed from its colormap for its background +and border. +.OP \-class class Class +Specifies a class for the window. +This class will be used when querying the option database for +the window's other options, and it will also be used later for +other purposes such as bindings. +The \fBclass\fR option may not be changed with the \fBconfigure\fR +widget command. +.OP \-colormap colormap Colormap +Specifies a colormap to use for the window. +The value may be either \fBnew\fR, in which case a new colormap is +created for the window and its children, or the name of another +window (which must be on the same screen and have the same visual +as \fIpathName\fR), in which case the new window will use the colormap +from the specified window. +If the \fBcolormap\fR option is not specified, the new window +uses the same colormap as its parent. +This option may not be changed with the \fBconfigure\fR +widget command. +.OP \-container container Container +The value must be a boolean. If true, it means that this window will +be used as a container in which some other application will be embedded +(for example, a Tk toplevel can be embedded using the \fB\-use\fR option). +The window will support the appropriate window manager protocols for +things like geometry requests. The window should not have any +children of its own in this application. +This option may not be changed with the \fBconfigure\fR +widget command. +.OP \-height height Height +Specifies the desired height for the window in any of the forms +acceptable to \fBTk_GetPixels\fR. +If this option is less than or equal to zero then the window will +not request any size at all. +.OP \-labelanchor labelAnchor LabelAnchor +Specifies where to place the label. A label is only displayed if the +\fB\-text\fR option is not the empty string. +Valid values for this option are (listing them clockwise) +\fBnw\fR, \fBn\fR, \fBne\fR, \fBen\fR, \fBe\fR, \fBes\fR, +\fBse\fR, \fBs\fR,\fBsw\fR, \fBws\fR, \fBw\fR and \fBwn\fR. +The default value is \fBnw\fR. +.OP \-labelwidget labelWidget LabelWidget +Specifies a widget to use as label. This overrides any \fB\-text\fR +option. The widget must exist before being used as \fB\-labelwidget\fR +and if it is not a descendant of this window, it will be raised +above it in the stacking order. +.OP \-visual visual Visual +Specifies visual information for the new window in any of the +forms accepted by \fBTk_GetVisual\fR. +If this option is not specified, the new window will use the same +visual as its parent. +The \fBvisual\fR option may not be modified with the \fBconfigure\fR +widget command. +.OP \-width width Width +Specifies the desired width for the window in any of the forms +acceptable to \fBTk_GetPixels\fR. +If this option is less than or equal to zero then the window will +not request any size at all. +.BE + +.SH DESCRIPTION +.PP +The \fBlabelframe\fR command creates a new window (given by the +\fIpathName\fR argument) and makes it into a labelframe widget. +Additional +options, described above, may be specified on the command line +or in the option database +to configure aspects of the labelframe such as its background color +and relief. The \fBlabelframe\fR command returns the +path name of the new window. +.PP +A labelframe is a simple widget. Its primary purpose is to act as a +spacer or container for complex window layouts. It has the features +of a \fBframe\fR plus the ability to display a label. +.SH "WIDGET COMMAND" +.PP +The \fBlabelframe\fR command creates a new Tcl command whose +name is the same as the path name of the labelframe's window. This +command may be used to invoke various +operations on the widget. It has the following general form: +.CS +\fIpathName option \fR?\fIarg arg ...\fR? +.CE +\fIPathName\fR is the name of the command, which is the same as +the labelframe widget's path name. \fIOption\fR and the \fIarg\fRs +determine the exact behavior of the command. The following +commands are possible for frame widgets: +.TP +\fIpathName \fBcget\fR \fIoption\fR +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBlabelframe\fR +command. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR? +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBlabelframe\fR +command. + +.SH BINDINGS +.PP +When a new labelframe is created, it has no default event bindings: +labelframes are not intended to be interactive. + +.SH "SEE ALSO" +frame(n), label(n) + +.SH KEYWORDS +labelframe, widget diff --git a/doc/toplevel.n b/doc/toplevel.n index 953f178..78d4e56 100644 --- a/doc/toplevel.n +++ b/doc/toplevel.n @@ -5,10 +5,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: toplevel.n,v 1.3 2000/08/25 06:58:33 ericm Exp $ +'\" RCS: @(#) $Id: toplevel.n,v 1.4 2001/09/26 21:36:19 pspjuth Exp $ '\" .so man.macros -.TH toplevel n 8.0 Tk "Tk Built-In Commands" +.TH toplevel n 8.4 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -16,9 +16,9 @@ toplevel \- Create and manipulate toplevel widgets .SH SYNOPSIS \fBtoplevel\fR \fIpathName \fR?\fIoptions\fR? .SO -\-borderwidth \-highlightcolor \-takefocus -\-cursor \-highlightthickness -\-highlightbackground \-relief +\-borderwidth \-highlightcolor \-pady +\-cursor \-highlightthickness \-relief +\-highlightbackground \-padx \-takefocus .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-background background Background @@ -45,7 +45,6 @@ If the \fBcolormap\fR option is not specified, the new window uses the default colormap of its screen. This option may not be changed with the \fBconfigure\fR widget command. -.VS 8.0 br .OP \-container container Container The value must be a boolean. If true, it means that this window will be used as a container in which some other application will be embedded @@ -55,20 +54,17 @@ things like geometry requests. The window should not have any children of its own in this application. This option may not be changed with the \fBconfigure\fR widget command. -.VE .OP \-height height Height Specifies the desired height for the window in any of the forms acceptable to \fBTk_GetPixels\fR. If this option is less than or equal to zero then the window will not request any size at all. -.VS 8.0 br .OP \-menu menu Menu Specifies a menu widget to be used as a menubar. On the Macintosh, the menubar will be displayed accross the top of the main monitor. On Microsoft Windows and all UNIX platforms, the menu will appear accross the toplevel window as part of the window dressing maintained by the window manager. -.VE .OP \-screen "" "" Specifies the screen on which to place the new window. Any valid screen name may be used, even one associated with a @@ -77,7 +73,6 @@ Defaults to the same screen as its parent. This option is special in that it may not be specified via the option database, and it may not be modified with the \fBconfigure\fR widget command. -.VS 8.0 br .OP \-use use Use This option is used for embedding. If the value isn't an empty string, it must be the the window identifier of a container window, specified as @@ -88,7 +83,6 @@ window is in a Tk application, it must be a frame or toplevel widget for which the \fB\-container\fR option was specified. This option may not be changed with the \fBconfigure\fR widget command. -.VE .OP \-visual visual Visual Specifies visual information for the new window in any of the forms accepted by \fBTk_GetVisual\fR. @@ -160,5 +154,8 @@ command. When a new toplevel is created, it has no default event bindings: toplevels are not intended to be interactive. +.SH "SEE ALSO" +frame(n) + .SH KEYWORDS toplevel, widget diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 9c6f84b..55dfc8f 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -1,8 +1,8 @@ /* * tkFrame.c -- * - * This module implements "frame" and "toplevel" widgets for - * the Tk toolkit. Frames are windows with a background color + * This module implements "frame", "labelframe" and "toplevel" widgets + * for the Tk toolkit. Frames are windows with a background color * and possibly a 3-D effect, but not much else in the way of * attributes. * @@ -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: tkFrame.c,v 1.9 2001/08/29 23:22:24 hobbs Exp $ + * RCS: @(#) $Id: tkFrame.c,v 1.10 2001/09/26 21:36:19 pspjuth Exp $ */ #include "default.h" @@ -24,7 +24,7 @@ */ enum FrameType { - TYPE_FRAME, TYPE_TOPLEVEL + TYPE_FRAME, TYPE_TOPLEVEL, TYPE_LABELFRAME }; /* @@ -90,9 +90,63 @@ typedef struct { * windows this is NULL. */ int flags; /* Various flags; see below for * definitions. */ + Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many + * pixels of extra space to leave on left and + * right of child area. */ + int padX; /* Integer value corresponding to padXPtr. */ + Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many + * pixels of extra space to leave above and + * below child area. */ + int padY; /* Integer value corresponding to padYPtr. */ } Frame; /* + * A data structure of the following type is kept for each labelframe + * widget managed by this file: + */ + +typedef struct { + Frame frame; /* A pointer to the generic frame structure. + * This must be the first element of the + * Labelframe. */ + + /* + * Labelframe specific configuration settings. + */ + + Tcl_Obj *textPtr; /* Value of -text option: specifies text to + * display in button. */ + Tk_Font tkfont; /* Value of -font option: specifies font + * to use for display text. */ + XColor *textColorPtr; /* Value of -fg option: specifies foreground + * color in normal mode. */ + int labelAnchor; /* Value of -labelanchor option: specifies + * where to place the label. */ + Tk_Window labelWin; /* Value of -labelwidget option: Window to + * use as label for the frame. */ + + /* + * Labelframe specific fields for use with configuration settings above. + */ + + GC textGC; /* GC for drawing text in normal mode. */ + Tk_TextLayout textLayout; /* Stored text layout information. */ + XRectangle labelBox; /* The label's actual size and position. */ + int labelReqWidth; /* The label's requested width. */ + int labelReqHeight; /* The label's requested height. */ + int labelTextX, labelTextY; /* Position of the text to be drawn. */ + +} Labelframe; + +/* + * The following macros define how many extra pixels to leave + * around a label's text. + */ + +#define LABELSPACING 1 +#define LABELMARGIN 4 + +/* * Flag bits for frames: * * REDRAW_PENDING: Non-zero means a DoWhenIdle handler @@ -106,21 +160,34 @@ typedef struct { #define GOT_FOCUS 4 /* + * The following enum is used to define a type for the -labelanchor option + * of the Labelframe widget. These values are used as indices into the + * string table below. + */ + +enum labelanchor { + LABELANCHOR_E, LABELANCHOR_EN, LABELANCHOR_ES, + LABELANCHOR_N, LABELANCHOR_NE, LABELANCHOR_NW, + LABELANCHOR_S, LABELANCHOR_SE, LABELANCHOR_SW, + LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS +}; + +static char *labelAnchorStrings[] = { + "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws", + (char *) NULL +}; + +/* * Information used for parsing configuration options. There are - * one common table used by both, one frame table and one toplevel table. + * one common table used by all and one table for each widget class. */ static Tk_OptionSpec commonOptSpec[] = { {TK_OPTION_BORDER, "-background", "background", "Background", DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border), TK_OPTION_NULL_OK, (ClientData) DEF_FRAME_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_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), - 0, 0, 0}, {TK_OPTION_STRING, "-colormap", "colormap", "Colormap", DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName), TK_OPTION_NULL_OK, 0, 0}, @@ -142,9 +209,12 @@ static Tk_OptionSpec commonOptSpec[] = { {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH, -1, Tk_Offset(Frame, highlightWidth), 0, 0, 0}, - {TK_OPTION_RELIEF, "-relief", "relief", "Relief", - DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), - 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_FRAME_PADX, Tk_Offset(Frame, padXPtr), + Tk_Offset(Frame, padX), 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", "padY", "Pad", + DEF_FRAME_PADY, Tk_Offset(Frame, padYPtr), + Tk_Offset(Frame, padY), 0, 0, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_FRAME_TAKE_FOCUS, -1, Tk_Offset(Frame, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -159,25 +229,72 @@ static Tk_OptionSpec commonOptSpec[] = { }; static Tk_OptionSpec frameOptSpec[] = { + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), + 0, 0, 0}, {TK_OPTION_STRING, "-class", "class", "Class", DEF_FRAME_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), + 0, 0, 0}, {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} }; static Tk_OptionSpec toplevelOptSpec[] = { + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), + 0, 0, 0}, {TK_OPTION_STRING, "-class", "class", "Class", DEF_TOPLEVEL_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0}, {TK_OPTION_STRING, "-menu", "menu", "Menu", DEF_TOPLEVEL_MENU, -1, Tk_Offset(Frame, menuName), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), + 0, 0, 0}, {TK_OPTION_STRING, "-screen", "screen", "Screen", DEF_TOPLEVEL_SCREEN, -1, Tk_Offset(Frame, screenName), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-use", "use", "Use", - DEF_FRAME_USE, -1, Tk_Offset(Frame, useThis), + DEF_TOPLEVEL_USE, -1, Tk_Offset(Frame, useThis), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} +}; + +static Tk_OptionSpec labelframeOptSpec[] = { + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_LABELFRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), + 0, 0, 0}, + {TK_OPTION_STRING, "-class", "class", "Class", + DEF_LABELFRAME_CLASS, -1, Tk_Offset(Frame, className), + 0, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_LABELFRAME_FONT, -1, Tk_Offset(Labelframe, tkfont), 0, 0, 0}, + {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", + DEF_LABELFRAME_FG, -1, Tk_Offset(Labelframe, textColorPtr), 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-labelanchor", "labelAnchor", "LabelAnchor", + DEF_LABELFRAME_LABELANCHOR, -1, Tk_Offset(Labelframe, labelAnchor), + 0, (ClientData) labelAnchorStrings, 0}, + {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", + (char *) NULL, -1, Tk_Offset(Labelframe, labelWin), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", + DEF_LABELFRAME_RELIEF, -1, Tk_Offset(Frame, relief), + 0, 0, 0}, + {TK_OPTION_STRING, "-text", "text", "Text", + DEF_LABELFRAME_TEXT, Tk_Offset(Labelframe, textPtr), -1, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} @@ -187,7 +304,7 @@ static Tk_OptionSpec toplevelOptSpec[] = { * Class names for widgets, indexed by FrameType. */ -static char *classNames[] = {"Frame", "Toplevel"}; +static char *classNames[] = {"Frame", "Toplevel", "Labelframe"}; /* * The following table maps from FrameType to the option template for @@ -196,36 +313,69 @@ static char *classNames[] = {"Frame", "Toplevel"}; static Tk_OptionSpec *optionSpecs[] = { frameOptSpec, - toplevelOptSpec + toplevelOptSpec, + labelframeOptSpec, }; /* * Forward declarations for procedures defined later in this file: */ +static void ComputeFrameGeometry _ANSI_ARGS_((Frame *framePtr)); static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp, Frame *framePtr, int objc, Tcl_Obj *CONST objv[])); static int CreateFrame _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST argv[], enum FrameType type, char *appName)); static void DestroyFrame _ANSI_ARGS_((char *memPtr)); +static void DestroyFramePartly _ANSI_ARGS_((Frame *framePtr)); static void DisplayFrame _ANSI_ARGS_((ClientData clientData)); static void FrameCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); static void FrameEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); +static void FrameLostSlaveProc _ANSI_ARGS_(( + ClientData clientData, Tk_Window tkwin)); +static void FrameRequestProc _ANSI_ARGS_((ClientData clientData, + Tk_Window tkwin)); +static void FrameStructureProc _ANSI_ARGS_(( + ClientData clientData, XEvent *eventPtr)); static int FrameWidgetObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static void FrameWorldChanged _ANSI_ARGS_(( + ClientData instanceData)); static void MapFrame _ANSI_ARGS_((ClientData clientData)); + +/* + * The structure below defines frame class behavior by means of procedures + * that can be invoked from generic window code. + */ + +static Tk_ClassProcs frameClass = { + sizeof(Tk_ClassProcs), /* size */ + FrameWorldChanged /* worldChangedProc */ +}; + +/* + * The structure below defines the official type record for the + * labelframe's geometry manager: + */ + +static Tk_GeomMgr frameGeomType = { + "labelframe", /* name */ + FrameRequestProc, /* requestProc */ + FrameLostSlaveProc /* lostSlaveProc */ +}; + /* *-------------------------------------------------------------- * - * Tk_FrameObjCmd, Tk_ToplevelObjCmd -- + * Tk_FrameObjCmd, Tk_ToplevelObjCmd, Tk_LabelframeObjCmd -- * - * These procedures are invoked to process the "frame" and - * "toplevel" Tcl commands. See the user documentation for - * details on what they do. + * These procedures are invoked to process the "frame", + * "toplevel" and "labelframe" Tcl commands. See the user + * documentation for details on what they do. * * Results: * A standard Tcl result. @@ -258,6 +408,17 @@ Tk_ToplevelObjCmd(clientData, interp, objc, objv) return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL, (char *) NULL); } + +int +Tk_LabelframeObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Either NULL or pointer to option table. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + return CreateFrame(clientData, interp, objc, objv, TYPE_LABELFRAME, + (char *) NULL); +} /* *-------------------------------------------------------------- @@ -470,24 +631,35 @@ CreateFrame(clientData, interp, objc, objv, type, appName) * in the widget record from the special options. */ - framePtr = (Frame *) ckalloc(sizeof(Frame)); - memset((void *) framePtr, 0, (sizeof(Frame))); + if (type == TYPE_LABELFRAME) { + framePtr = (Frame *) ckalloc(sizeof(Labelframe)); + memset((void *) framePtr, 0, (sizeof(Labelframe))); + } else { + framePtr = (Frame *) ckalloc(sizeof(Frame)); + memset((void *) framePtr, 0, (sizeof(Frame))); + } framePtr->tkwin = new; framePtr->display = Tk_Display(new); framePtr->interp = interp; framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(new), FrameWidgetObjCmd, (ClientData) framePtr, FrameCmdDeletedProc); - framePtr->optionTable = optionTable; - framePtr->type = type; - framePtr->colormap = colormap; - framePtr->relief = TK_RELIEF_FLAT; - framePtr->cursor = None; + framePtr->optionTable = optionTable; + framePtr->type = type; + framePtr->colormap = colormap; + framePtr->relief = TK_RELIEF_FLAT; + framePtr->cursor = None; + + if (framePtr->type == TYPE_LABELFRAME) { + Labelframe *labelframePtr = (Labelframe *) framePtr; + labelframePtr->labelAnchor = LABELANCHOR_NW; + labelframePtr->textGC = None; + } /* * Store backreference to frame widget in window structure. */ - Tk_SetClassProcs(new, NULL, (ClientData) framePtr); + Tk_SetClassProcs(new, &frameClass, (ClientData) framePtr); mask = ExposureMask | StructureNotifyMask | FocusChangeMask; if (type == TYPE_TOPLEVEL) { @@ -505,7 +677,7 @@ CreateFrame(clientData, interp, objc, objv, type, appName) } else { Tcl_AppendResult(interp, "A window cannot have both the -use ", "and the -container option set.", (char *) NULL); - return TCL_ERROR; + goto error; } } if (type == TYPE_TOPLEVEL) { @@ -610,7 +782,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) c = arg[1]; if (((c == 'c') && (strncmp(arg, "-class", length) == 0) && (length >= 2)) - || ((c == 'c') && (framePtr->type == TYPE_TOPLEVEL) + || ((c == 'c') && (strncmp(arg, "-colormap", length) == 0) && (length >= 3)) || ((c == 'c') @@ -620,7 +792,7 @@ FrameWidgetObjCmd(clientData, interp, objc, objv) && (strncmp(arg, "-screen", length) == 0)) || ((c == 'u') && (framePtr->type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", length) == 0)) - || ((c == 'v') && (framePtr->type == TYPE_TOPLEVEL) + || ((c == 'v') && (strncmp(arg, "-visual", length) == 0))) { Tcl_AppendResult(interp, "can't modify ", arg, " option after widget is created", (char *) NULL); @@ -662,7 +834,14 @@ DestroyFrame(memPtr) char *memPtr; /* Info about frame widget. */ { register Frame *framePtr = (Frame *) memPtr; + register Labelframe *labelframePtr = (Labelframe *) memPtr; + if (framePtr->type == TYPE_LABELFRAME) { + Tk_FreeTextLayout(labelframePtr->textLayout); + if (labelframePtr->textGC != None) { + Tk_FreeGC(framePtr->display, labelframePtr->textGC); + } + } if (framePtr->colormap != None) { Tk_FreeColormap(framePtr->display, framePtr->colormap); } @@ -672,6 +851,47 @@ DestroyFrame(memPtr) /* *---------------------------------------------------------------------- * + * DestroyFramePartly -- + * + * This procedure is invoked to clean up everything that needs + * tkwin to be defined when deleted. During the destruction + * process tkwin is always set to NULL and this procedure must + * be called before that happens. + * + * Results: + * None. + * + * Side effects: + * Some things associated with the frame are freed up. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyFramePartly(framePtr) + Frame *framePtr; /* Info about frame widget. */ +{ + register Labelframe *labelframePtr = (Labelframe *) framePtr; + + if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) { + Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask, + FrameStructureProc, (ClientData) framePtr); + Tk_ManageGeometry(labelframePtr->labelWin, (Tk_GeomMgr *) NULL, + (ClientData) NULL); + if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) { + Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin); + } + Tk_UnmapWindow(labelframePtr->labelWin); + labelframePtr->labelWin = NULL; + } + + Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable, + framePtr->tkwin); +} + +/* + *---------------------------------------------------------------------- + * * ConfigureFrame -- * * This procedure is called to process an objv/objc list, plus @@ -700,6 +920,8 @@ ConfigureFrame(interp, framePtr, objc, objv) { Tk_SavedOptions savedOptions; char *oldMenuName; + Tk_Window oldWindow; + Labelframe *labelframePtr = (Labelframe *) framePtr; /* * Need the old menubar name for the menu code to delete it. @@ -711,7 +933,10 @@ ConfigureFrame(interp, framePtr, objc, objv) oldMenuName = ckalloc(strlen(framePtr->menuName) + 1); strcpy(oldMenuName, framePtr->menuName); } - + + if (framePtr->type == TYPE_LABELFRAME) { + oldWindow = labelframePtr->labelWin; + } if (Tk_SetOptions(interp, (char *) framePtr, framePtr->optionTable, objc, objv, framePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { @@ -738,7 +963,7 @@ ConfigureFrame(interp, framePtr, objc, objv) if (oldMenuName != NULL) { ckfree(oldMenuName); } - + if (framePtr->border != NULL) { Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border); } else { @@ -748,20 +973,391 @@ ConfigureFrame(interp, framePtr, objc, objv) if (framePtr->highlightWidth < 0) { framePtr->highlightWidth = 0; } - Tk_SetInternalBorder(framePtr->tkwin, - framePtr->borderWidth + framePtr->highlightWidth); + if (framePtr->padX < 0) { + framePtr->padX = 0; + } + if (framePtr->padY < 0) { + framePtr->padY = 0; + } + + /* + * If a -labelwidget is specified, check that it is valid and set + * up geometry management for it. + */ + + if (framePtr->type == TYPE_LABELFRAME) { + if (oldWindow != labelframePtr->labelWin) { + if (oldWindow != NULL) { + Tk_DeleteEventHandler(oldWindow, StructureNotifyMask, + FrameStructureProc, (ClientData) framePtr); + Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL, + (ClientData) NULL); + Tk_UnmaintainGeometry(oldWindow, framePtr->tkwin); + Tk_UnmapWindow(oldWindow); + } + if (labelframePtr->labelWin != NULL) { + Tk_Window ancestor, parent, sibling = NULL; + + /* + * Make sure that the frame is either the parent of the + * window used as label or a descendant of that + * parent. Also, don't allow a top-level window to be + * managed inside the frame. + */ + + parent = Tk_Parent(labelframePtr->labelWin); + for (ancestor = framePtr->tkwin; ; + ancestor = Tk_Parent(ancestor)) { + if (ancestor == parent) { + break; + } + sibling = ancestor; + if (Tk_IsTopLevel(ancestor)) { + badWindow: + Tcl_AppendResult(interp, "can't use ", + Tk_PathName(labelframePtr->labelWin), + " as label in this frame", (char *) NULL); + labelframePtr->labelWin = NULL; + return TCL_ERROR; + } + } + if (Tk_IsTopLevel(labelframePtr->labelWin)) { + goto badWindow; + } + if (labelframePtr->labelWin == framePtr->tkwin) { + goto badWindow; + } + Tk_CreateEventHandler(labelframePtr->labelWin, + StructureNotifyMask, FrameStructureProc, + (ClientData) framePtr); + Tk_ManageGeometry(labelframePtr->labelWin, &frameGeomType, + (ClientData) framePtr); + + /* + * If the frame is not parent to the label, make + * sure the label is above its sibling in the stacking + * order. + */ + + if (sibling != NULL) { + Tk_RestackWindow(labelframePtr->labelWin, Above, sibling); + } + } + } + } + + FrameWorldChanged((ClientData) framePtr); + + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * FrameWorldChanged -- + * + * This procedure is called when the world has changed in some + * way and the widget needs to recompute all its graphics contexts + * and determine its new geometry. + * + * Results: + * None. + * + * Side effects: + * Frame will be relayed out and redisplayed. + * + *--------------------------------------------------------------------------- + */ + +static void +FrameWorldChanged(instanceData) + ClientData instanceData; /* Information about widget. */ +{ + Frame *framePtr = (Frame *) instanceData; + Labelframe *labelframePtr = (Labelframe *) framePtr; + Tk_Window tkwin = framePtr->tkwin; + XGCValues gcValues; + GC gc; + int anyTextLabel, anyWindowLabel; + int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom; + char *labelText; + + anyTextLabel = (framePtr->type == TYPE_LABELFRAME) && + (labelframePtr->textPtr != NULL) && + (labelframePtr->labelWin == NULL); + anyWindowLabel = (framePtr->type == TYPE_LABELFRAME) && + (labelframePtr->labelWin != NULL); + + if (framePtr->type == TYPE_LABELFRAME) { + /* + * The textGC is needed even in the labelWin case, so it's + * always created for a labelframe. + */ + + gcValues.font = Tk_FontId(labelframePtr->tkfont); + gcValues.foreground = labelframePtr->textColorPtr->pixel; + gcValues.graphics_exposures = False; + gc = Tk_GetGC(tkwin, GCForeground | GCFont | GCGraphicsExposures, + &gcValues); + if (labelframePtr->textGC != None) { + Tk_FreeGC(framePtr->display, labelframePtr->textGC); + } + labelframePtr->textGC = gc; + + /* + * Calculate label size. + */ + + labelframePtr->labelReqWidth = labelframePtr->labelReqHeight = 0; + + if (anyTextLabel) { + labelText = Tcl_GetString(labelframePtr->textPtr); + Tk_FreeTextLayout(labelframePtr->textLayout); + labelframePtr->textLayout = Tk_ComputeTextLayout(labelframePtr->tkfont, + labelText, -1, 0, TK_JUSTIFY_CENTER, 0, + &labelframePtr->labelReqWidth, &labelframePtr->labelReqHeight); + labelframePtr->labelReqWidth += 2 * LABELSPACING; + labelframePtr->labelReqHeight += 2 * LABELSPACING; + } else if (anyWindowLabel) { + labelframePtr->labelReqWidth = Tk_ReqWidth(labelframePtr->labelWin); + labelframePtr->labelReqHeight = Tk_ReqHeight(labelframePtr->labelWin); + } + + /* + * Make sure label size is at least as big as the border. + * This simplifies later calculations and gives a better + * appearance with thick borders. + */ + + if ((labelframePtr->labelAnchor >= LABELANCHOR_N) && + (labelframePtr->labelAnchor <= LABELANCHOR_SW)) { + if (labelframePtr->labelReqHeight < framePtr->borderWidth) { + labelframePtr->labelReqHeight = framePtr->borderWidth; + } + } else { + if (labelframePtr->labelReqWidth < framePtr->borderWidth) { + labelframePtr->labelReqWidth = framePtr->borderWidth; + } + } + } + + /* + * Calculate individual border widths. + */ + + bWidthBottom = bWidthTop = bWidthRight = bWidthLeft = + framePtr->borderWidth + framePtr->highlightWidth; + + bWidthLeft += framePtr->padX; + bWidthRight += framePtr->padX; + bWidthTop += framePtr->padY; + bWidthBottom += framePtr->padY; + + if (anyTextLabel || anyWindowLabel) { + switch (labelframePtr->labelAnchor) { + case LABELANCHOR_E: + case LABELANCHOR_EN: + case LABELANCHOR_ES: + bWidthRight += labelframePtr->labelReqWidth - + framePtr->borderWidth; + break; + case LABELANCHOR_N: + case LABELANCHOR_NE: + case LABELANCHOR_NW: + bWidthTop += labelframePtr->labelReqHeight - framePtr->borderWidth; + break; + case LABELANCHOR_S: + case LABELANCHOR_SE: + case LABELANCHOR_SW: + bWidthBottom += labelframePtr->labelReqHeight - + framePtr->borderWidth; + break; + default: + bWidthLeft += labelframePtr->labelReqWidth - framePtr->borderWidth; + break; + } + } + + Tk_SetInternalBorderEx(tkwin, bWidthLeft, bWidthRight, bWidthTop, + bWidthBottom); + + ComputeFrameGeometry(framePtr); + + /* + * A labelframe should request size for its label. + */ + + if (framePtr->type == TYPE_LABELFRAME) { + int minwidth = labelframePtr->labelReqWidth; + int minheight = labelframePtr->labelReqHeight; + int padding = framePtr->highlightWidth; + if (framePtr->borderWidth > 0) { + padding += framePtr->borderWidth + LABELMARGIN; + } + padding *= 2; + if ((labelframePtr->labelAnchor >= LABELANCHOR_N) && + (labelframePtr->labelAnchor <= LABELANCHOR_SW)) { + minwidth += padding; + minheight += framePtr->borderWidth + framePtr->highlightWidth; + } else { + minheight += padding; + minwidth += framePtr->borderWidth + framePtr->highlightWidth; + } + Tk_SetMinimumRequestSize(tkwin, minwidth, minheight); + } + if ((framePtr->width > 0) || (framePtr->height > 0)) { - Tk_GeometryRequest(framePtr->tkwin, framePtr->width, - framePtr->height); + Tk_GeometryRequest(tkwin, framePtr->width, framePtr->height); } - if (Tk_IsMapped(framePtr->tkwin)) { + if (Tk_IsMapped(tkwin)) { if (!(framePtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr); } framePtr->flags |= REDRAW_PENDING; } - return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ComputeFrameGeometry -- + * + * This procedure is called to compute various geometrical + * information for a frame, such as where various things get + * displayed. It's called when the window is reconfigured. + * + * Results: + * None. + * + * Side effects: + * Display-related numbers get changed in *framePtr. + * + *---------------------------------------------------------------------- + */ + +static void +ComputeFrameGeometry(framePtr) + register Frame *framePtr; /* Information about widget. */ +{ + int otherWidth, otherHeight, otherWidthT, otherHeightT, padding; + int maxWidth, maxHeight; + Tk_Window tkwin; + Labelframe *labelframePtr = (Labelframe *) framePtr; + + /* + * We have nothing to do here unless there is a label. + */ + + if (framePtr->type != TYPE_LABELFRAME) return; + if ((labelframePtr->textPtr == NULL) && + (labelframePtr->labelWin == NULL)) return; + + tkwin = framePtr->tkwin; + + /* + * Calculate the available size for the label + */ + + labelframePtr->labelBox.width = labelframePtr->labelReqWidth; + labelframePtr->labelBox.height = labelframePtr->labelReqHeight; + + padding = framePtr->highlightWidth; + if (framePtr->borderWidth > 0) { + padding += framePtr->borderWidth + LABELMARGIN; + } + padding *= 2; + + maxHeight = Tk_Height(tkwin); + maxWidth = Tk_Width(tkwin); + + if ((labelframePtr->labelAnchor >= LABELANCHOR_N) && + (labelframePtr->labelAnchor <= LABELANCHOR_SW)) { + maxWidth -= padding; + if (maxWidth < 1) maxWidth = 1; + } else { + maxHeight -= padding; + if (maxHeight < 1) maxHeight = 1; + } + if (labelframePtr->labelBox.width > maxWidth) { + labelframePtr->labelBox.width = maxWidth; + } + if (labelframePtr->labelBox.height > maxHeight) { + labelframePtr->labelBox.height = maxHeight; + } + + /* + * Calculate label and text position. + * The text's position is based on the requested size (= the text's + * real size) to get proper alignment if the text does not fit. + */ + + otherWidth = Tk_Width(tkwin) - labelframePtr->labelBox.width; + otherHeight = Tk_Height(tkwin) - labelframePtr->labelBox.height; + otherWidthT = Tk_Width(tkwin) - labelframePtr->labelReqWidth; + otherHeightT = Tk_Height(tkwin) - labelframePtr->labelReqHeight; + padding = framePtr->highlightWidth; + + switch (labelframePtr->labelAnchor) { + case LABELANCHOR_E: + case LABELANCHOR_EN: + case LABELANCHOR_ES: + labelframePtr->labelTextX = otherWidthT - padding; + labelframePtr->labelBox.x = otherWidth - padding; + break; + case LABELANCHOR_N: + case LABELANCHOR_NE: + case LABELANCHOR_NW: + labelframePtr->labelTextY = padding; + labelframePtr->labelBox.y = padding; + break; + case LABELANCHOR_S: + case LABELANCHOR_SE: + case LABELANCHOR_SW: + labelframePtr->labelTextY = otherHeightT - padding; + labelframePtr->labelBox.y = otherHeight - padding; + break; + default: + labelframePtr->labelTextX = padding; + labelframePtr->labelBox.x = padding; + break; + } + + if (framePtr->borderWidth > 0) { + padding += framePtr->borderWidth + LABELMARGIN; + } + + switch (labelframePtr->labelAnchor) { + case LABELANCHOR_NW: + case LABELANCHOR_SW: + labelframePtr->labelTextX = padding; + labelframePtr->labelBox.x = padding; + break; + case LABELANCHOR_N: + case LABELANCHOR_S: + labelframePtr->labelTextX = otherWidthT / 2; + labelframePtr->labelBox.x = otherWidth / 2; + break; + case LABELANCHOR_NE: + case LABELANCHOR_SE: + labelframePtr->labelTextX = otherWidthT - padding; + labelframePtr->labelBox.x = otherWidth - padding; + break; + case LABELANCHOR_EN: + case LABELANCHOR_WN: + labelframePtr->labelTextY = padding; + labelframePtr->labelBox.y = padding; + break; + case LABELANCHOR_E: + case LABELANCHOR_W: + labelframePtr->labelTextY = otherHeightT / 2; + labelframePtr->labelBox.y = otherHeight / 2; + break; + default: + labelframePtr->labelTextY = otherHeightT - padding; + labelframePtr->labelBox.y = otherHeight - padding; + break; + } } /* @@ -787,8 +1383,9 @@ DisplayFrame(clientData) { register Frame *framePtr = (Frame *) clientData; register Tk_Window tkwin = framePtr->tkwin; - void (* drawFunction) _ANSI_ARGS_((Tk_Window, Drawable, Tk_3DBorder, - int, int, int, int, int, int)) = Tk_Fill3DRectangle; + int bdX1, bdY1, bdX2, bdY2, hlWidth; + Pixmap pixmap; + TkRegion clipRegion = NULL; framePtr->flags &= ~REDRAW_PENDING; if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin) @@ -796,15 +1393,13 @@ DisplayFrame(clientData) return; } - if (framePtr->border != NULL) { - drawFunction(tkwin, Tk_WindowId(tkwin), - framePtr->border, framePtr->highlightWidth, - framePtr->highlightWidth, - Tk_Width(tkwin) - 2*framePtr->highlightWidth, - Tk_Height(tkwin) - 2*framePtr->highlightWidth, - framePtr->borderWidth, framePtr->relief); - } - if (framePtr->highlightWidth != 0) { + /* + * Highlight shall always be drawn if it exists, so do that first. + */ + + hlWidth = framePtr->highlightWidth; + + if (hlWidth != 0) { GC fgGC, bgGC; bgGC = Tk_GCForColor(framePtr->highlightBgColorPtr, @@ -812,13 +1407,179 @@ DisplayFrame(clientData) if (framePtr->flags & GOT_FOCUS) { fgGC = Tk_GCForColor(framePtr->highlightColorPtr, Tk_WindowId(tkwin)); - TkpDrawHighlightBorder(tkwin, fgGC, bgGC, framePtr->highlightWidth, + TkpDrawHighlightBorder(tkwin, fgGC, bgGC, hlWidth, Tk_WindowId(tkwin)); } else { - TkpDrawHighlightBorder(tkwin, bgGC, bgGC, framePtr->highlightWidth, + TkpDrawHighlightBorder(tkwin, bgGC, bgGC, hlWidth, Tk_WindowId(tkwin)); } } + + /* + * If -background is set to "", no interior is drawn. + */ + + if (framePtr->border == NULL) return; + + if (framePtr->type != TYPE_LABELFRAME) { + /* + * There is no label so there is just a simple rectangle to draw. + */ + + noLabel: + Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), + framePtr->border, hlWidth, hlWidth, + Tk_Width(tkwin) - 2 * hlWidth, + Tk_Height(tkwin) - 2 * hlWidth, + framePtr->borderWidth, framePtr->relief); + } else { + Labelframe *labelframePtr = (Labelframe *) framePtr; + + if ((labelframePtr->textPtr == NULL) && + (labelframePtr->labelWin == NULL)) { + goto noLabel; + } + + /* + * In order to avoid screen flashes, this procedure redraws the + * frame into off-screen memory, then copies it back on-screen + * in a single operation. This means there's no point in time + * where the on-screen image has been cleared. + */ + + pixmap = Tk_GetPixmap(framePtr->display, Tk_WindowId(tkwin), + Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); + + /* + * Clear the pixmap. + */ + + Tk_Fill3DRectangle(tkwin, pixmap, framePtr->border, 0, 0, + Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT); + + /* + * Calculate how the label affects the border's position. + */ + + bdX1 = bdY1 = hlWidth; + bdX2 = Tk_Width(tkwin) - hlWidth; + bdY2 = Tk_Height(tkwin) - hlWidth; + + switch (labelframePtr->labelAnchor) { + case LABELANCHOR_E: + case LABELANCHOR_EN: + case LABELANCHOR_ES: + bdX2 -= (labelframePtr->labelBox.width - framePtr->borderWidth) + / 2; + break; + case LABELANCHOR_N: + case LABELANCHOR_NE: + case LABELANCHOR_NW: + /* + * Since the glyphs of the text tend to be in the lower part + * we favor a lower border position by rounding up. + */ + + bdY1 += (labelframePtr->labelBox.height - framePtr->borderWidth +1) + / 2; + break; + case LABELANCHOR_S: + case LABELANCHOR_SE: + case LABELANCHOR_SW: + bdY2 -= (labelframePtr->labelBox.height - framePtr->borderWidth) + / 2; + break; + default: + bdX1 += (labelframePtr->labelBox.width - framePtr->borderWidth) + / 2; + break; + } + + /* + * Draw border + */ + + Tk_Draw3DRectangle(tkwin, pixmap, framePtr->border, bdX1, bdY1, + bdX2 - bdX1, bdY2 - bdY1, framePtr->borderWidth, + framePtr->relief); + + if (labelframePtr->labelWin == NULL) { + /* + * Clear behind the label + */ + + Tk_Fill3DRectangle(tkwin, pixmap, + framePtr->border, labelframePtr->labelBox.x, + labelframePtr->labelBox.y, labelframePtr->labelBox.width, + labelframePtr->labelBox.height, 0, TK_RELIEF_FLAT); + + /* + * Draw label. + * If there is not room for the entire label, use clipping to + * get a nice appearance. + */ + + if ((labelframePtr->labelBox.width < labelframePtr->labelReqWidth) + || (labelframePtr->labelBox.height < + labelframePtr->labelReqHeight)) { + clipRegion = TkCreateRegion(); + TkUnionRectWithRegion(&labelframePtr->labelBox, clipRegion, + clipRegion); + TkSetRegion(framePtr->display, labelframePtr->textGC, + clipRegion); + } + + Tk_DrawTextLayout(framePtr->display, pixmap, + labelframePtr->textGC, labelframePtr->textLayout, + labelframePtr->labelTextX + LABELSPACING, + labelframePtr->labelTextY + LABELSPACING, 0, -1); + + if (clipRegion != NULL) { + XSetClipMask(framePtr->display, labelframePtr->textGC, None); + TkDestroyRegion(clipRegion); + } + } else { + /* + * Reposition and map the window (but in different ways depending + * on whether the frame is the window's parent). + */ + + if (framePtr->tkwin == Tk_Parent(labelframePtr->labelWin)) { + if ((labelframePtr->labelBox.x != Tk_X(labelframePtr->labelWin)) + || (labelframePtr->labelBox.y != + Tk_Y(labelframePtr->labelWin)) + || (labelframePtr->labelBox.width != + Tk_Width(labelframePtr->labelWin)) + || (labelframePtr->labelBox.height != + Tk_Height(labelframePtr->labelWin))) { + Tk_MoveResizeWindow(labelframePtr->labelWin, + labelframePtr->labelBox.x, labelframePtr->labelBox.y, + labelframePtr->labelBox.width, + labelframePtr->labelBox.height); + } + Tk_MapWindow(labelframePtr->labelWin); + } else { + Tk_MaintainGeometry(labelframePtr->labelWin, framePtr->tkwin, + labelframePtr->labelBox.x, labelframePtr->labelBox.y, + labelframePtr->labelBox.width, + labelframePtr->labelBox.height); + } + } + + + /* + * Everything's been redisplayed; now copy the pixmap onto the screen + * and free up the pixmap. + */ + + XCopyArea(framePtr->display, pixmap, Tk_WindowId(tkwin), + labelframePtr->textGC, hlWidth, hlWidth, + (unsigned) (Tk_Width(tkwin) - 2 * hlWidth), + (unsigned) (Tk_Height(tkwin) - 2 * hlWidth), + hlWidth, hlWidth); + Tk_FreePixmap(framePtr->display, pixmap); + } + } /* @@ -847,8 +1608,10 @@ FrameEventProc(clientData, eventPtr) { register Frame *framePtr = (Frame *) clientData; - if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) - || (eventPtr->type == ConfigureNotify)) { + if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { + goto redraw; + } else if (eventPtr->type == ConfigureNotify) { + ComputeFrameGeometry(framePtr); goto redraw; } else if (eventPtr->type == DestroyNotify) { if (framePtr->menuName != NULL) { @@ -874,8 +1637,7 @@ FrameEventProc(clientData, eventPtr) * DestroyFrame, we must free all options now. */ - Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable, - framePtr->tkwin); + DestroyFramePartly(framePtr); Tk_DeleteEventHandler(framePtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, @@ -960,8 +1722,7 @@ FrameCmdDeletedProc(clientData) * before setting tkwin to NULL. */ - Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable, - framePtr->tkwin); + DestroyFramePartly(framePtr); framePtr->tkwin = NULL; Tk_DestroyWindow(tkwin); @@ -1054,3 +1815,115 @@ TkInstallFrameMenu(tkwin) framePtr->menuName); } } + +/* + *-------------------------------------------------------------- + * + * FrameStructureProc -- + * + * This procedure is invoked whenever StructureNotify events + * occur for a window that's managed as label for the frame. + * This procudure's only purpose is to clean up when windows + * are deleted. + * + * Results: + * None. + * + * Side effects: + * The window is disassociated from the frame when it is + * deleted. + * + *-------------------------------------------------------------- + */ + +static void +FrameStructureProc(clientData, eventPtr) + ClientData clientData; /* Pointer to record describing frame. */ + XEvent *eventPtr; /* Describes what just happened. */ +{ + Labelframe *labelframePtr = (Labelframe *) clientData; + + if (eventPtr->type == DestroyNotify) { + /* + * This should only happen in a labelframe but it doesn't + * hurt to be careful. + */ + + if (labelframePtr->frame.type == TYPE_LABELFRAME) { + labelframePtr->labelWin = NULL; + FrameWorldChanged((ClientData) labelframePtr); + } + } +} + +/* + *-------------------------------------------------------------- + * + * FrameRequestProc -- + * + * This procedure is invoked whenever a window that's associated + * with a frame changes its requested dimensions. + * + * Results: + * None. + * + * Side effects: + * The size and location on the screen of the window may change. + * depending on the options specified for the frame. + * + *-------------------------------------------------------------- + */ + +static void +FrameRequestProc(clientData, tkwin) + ClientData clientData; /* Pointer to record for frame. */ + Tk_Window tkwin; /* Window that changed its desired + * size. */ +{ + Frame *framePtr = (Frame *) clientData; + + FrameWorldChanged((ClientData) framePtr); +} + +/* + *-------------------------------------------------------------- + * + * FrameLostSlaveProc -- + * + * This procedure is invoked by Tk whenever some other geometry + * claims control over a slave that used to be managed by us. + * + * Results: + * None. + * + * Side effects: + * Forgets all frame-related information about the slave. + * + *-------------------------------------------------------------- + */ + +static void +FrameLostSlaveProc(clientData, tkwin) + ClientData clientData; /* Frame structure for slave window that + * was stolen away. */ + Tk_Window tkwin; /* Tk's handle for the slave window. */ +{ + Frame *framePtr = (Frame *) clientData; + Labelframe *labelframePtr = (Labelframe *) clientData; + + /* + * This should only happen in a labelframe but it doesn't + * hurt to be careful. + */ + + if (labelframePtr->frame.type == TYPE_LABELFRAME) { + Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask, + FrameStructureProc, (ClientData) labelframePtr); + if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) { + Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin); + } + Tk_UnmapWindow(labelframePtr->labelWin); + labelframePtr->labelWin = NULL; + } + FrameWorldChanged((ClientData) framePtr); +} diff --git a/generic/tkInt.h b/generic/tkInt.h index ce68146..440c339 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.39 2001/09/26 20:25:17 pspjuth Exp $ + * RCS: $Id: tkInt.h,v 1.40 2001/09/26 21:36:19 pspjuth Exp $ */ #ifndef _TKINT @@ -965,6 +965,9 @@ EXTERN int Tk_ImageObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int Tk_LabelframeObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_ListboxObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index c4d7ab4..c9481c5 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.38 2001/09/26 20:25:17 pspjuth Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.39 2001/09/26 21:36:19 pspjuth Exp $ */ #include "tkPort.h" @@ -139,6 +139,7 @@ static TkCmd commands[] = { {"entry", NULL, Tk_EntryObjCmd, 1, 0}, {"frame", NULL, Tk_FrameObjCmd, 1, 0}, {"label", NULL, Tk_LabelObjCmd, 1, 0}, + {"labelframe", NULL, Tk_LabelframeObjCmd, 1, 0}, {"listbox", NULL, Tk_ListboxObjCmd, 1, 0}, {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0}, {"message", NULL, Tk_MessageObjCmd, 1, 0}, diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl new file mode 100644 index 0000000..89931cf --- /dev/null +++ b/library/demos/labelframe.tcl @@ -0,0 +1,79 @@ +# labelframe.tcl -- +# +# This demonstration script creates a toplevel window containing +# several labelframe widgets. +# +# RCS: @(#) $Id: labelframe.tcl,v 1.1 2001/09/26 21:36:19 pspjuth Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .labelframe +catch {destroy $w} +toplevel $w +wm title $w "Labelframe Demonstration" +wm iconname $w "labelframe" +positionWindow $w + +# Some information + +label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\ +typically used to group related widgets together." +pack $w.msg -side top + +# The bottom buttons + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" -width 15 +button $w.buttons.code -text "See Code" -command "showCode $w" -width 15 +pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + +# Demo area + +frame $w.f +pack $w.f -side bottom -fill both -expand 1 +set w $w.f + +# A group of radiobuttons in a labelframe + +labelframe $w.f -text "Value" -padx 2 -pady 2 +grid $w.f -row 0 -column 0 -pady 2m -padx 2m + +foreach value {1 2 3 4} { + radiobutton $w.f.b$value -text $value -width 3 \ + -variable lfdummy -value $value + pack $w.f.b$value -side top -fill x -pady 2 +} + + +# Using a label window to control a group of options. + +proc lfEnableButtons {w} { + foreach child [winfo children $w] { + if {$child == "$w.cb"} continue + if {$::lfdummy2} { + $child configure -state normal + } else { + $child configure -state disabled + } + } +} + +labelframe $w.f2 -pady 2 -padx 2 +checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \ + -command "lfEnableButtons $w.f2" -padx 0 +$w.f2 configure -labelwidget $w.f2.cb +grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m + +set t 0 +foreach str {Option1 Option2 Option3} { + checkbutton $w.f2.b$t -text $str + pack $w.f2.b$t -side top -fill x -pady 2 + incr t +} +lfEnableButtons $w.f2 + + +grid columnconfigure $w {0 1} -weight 1 diff --git a/library/demos/radio.tcl b/library/demos/radio.tcl index 85614fc..0788b90 100644 --- a/library/demos/radio.tcl +++ b/library/demos/radio.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several radiobutton widgets. # -# RCS: @(#) $Id: radio.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: radio.tcl,v 1.3 2001/09/26 21:36:19 pspjuth Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -26,8 +26,8 @@ button $w.buttons.vars -text "See Variables" \ -command "showVars $w.dialog size color" pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 -frame $w.left -frame $w.right +labelframe $w.left -pady 2 -text "Point Size" +labelframe $w.right -pady 2 -text "Color" pack $w.left $w.right -side left -expand yes -pady .5c -padx .5c foreach i {10 12 18 24} { diff --git a/library/demos/widget b/library/demos/widget index f01da90..7d0d662 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,7 +11,7 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: widget,v 1.3 2001/09/26 21:36:19 pspjuth Exp $ eval destroy [winfo child .] wm title . "Widget Demonstration" @@ -210,6 +210,12 @@ This application provides a front end for several short scripts that demonstrate {demo demo-menubu} .t insert end " \n " {demospace} +.t insert end \n {} "Labelframes" title +.t insert end " \n " {demospace} +.t insert end "1. Labelframe." \ + {demo demo-labelframe} +.t insert end " \n " {demospace} + .t insert end \n {} "Common Dialogs" title .t insert end " \n " {demospace} .t insert end "1. Message boxes." {demo demo-msgbox} diff --git a/mac/tkMacDefault.h b/mac/tkMacDefault.h index 5358a0f..aaa5082 100644 --- a/mac/tkMacDefault.h +++ b/mac/tkMacDefault.h @@ -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: tkMacDefault.h,v 1.9 2000/07/28 16:34:55 ericm Exp $ + * RCS: @(#) $Id: tkMacDefault.h,v 1.10 2001/09/26 21:36:19 pspjuth Exp $ */ #ifndef _TKMACDEFAULT @@ -190,13 +190,26 @@ #define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG #define DEF_FRAME_HIGHLIGHT BLACK #define DEF_FRAME_HIGHLIGHT_WIDTH "0" +#define DEF_FRAME_PADX "0" +#define DEF_FRAME_PADY "0" #define DEF_FRAME_RELIEF "flat" #define DEF_FRAME_TAKE_FOCUS "0" -#define DEF_FRAME_USE "" #define DEF_FRAME_VISUAL "" #define DEF_FRAME_WIDTH "0" /* + * Defaults for labelframes: + */ + +#define DEF_LABELFRAME_BORDER_WIDTH "2" +#define DEF_LABELFRAME_CLASS "Labelframe" +#define DEF_LABELFRAME_RELIEF "groove" +#define DEF_LABELFRAME_FG "systemButtonText" +#define DEF_LABELFRAME_FONT "system" +#define DEF_LABELFRAME_TEXT "" +#define DEF_LABELFRAME_LABELANCHOR "nw" + +/* * Defaults for listboxes: */ @@ -472,5 +485,6 @@ #define DEF_TOPLEVEL_CLASS "Toplevel" #define DEF_TOPLEVEL_MENU "" #define DEF_TOPLEVEL_SCREEN "" +#define DEF_TOPLEVEL_USE "" #endif /* _TKMACDEFAULT */ diff --git a/tests/frame.test b/tests/frame.test index 8f5644b..7e7746c 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: frame.test,v 1.5 2001/05/28 16:56:02 pspjuth Exp $ +# RCS: @(#) $Id: frame.test,v 1.6 2001/09/26 21:36:19 pspjuth Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -65,12 +65,14 @@ test frame-1.1 {frame configuration options} { } {{-class class Class Frame NewFrame} 1 {can't modify -class option after widget is created}} catch {destroy .f} test frame-1.2 {frame configuration options} { - list [catch {frame .f -colormap new} msg] $msg -} {0 .f} + frame .f -colormap new + list [.f configure -colormap] [catch {.f configure -colormap .} msg] $msg +} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}} catch {destroy .f} test frame-1.3 {frame configuration options} { - list [catch {frame .f -visual default} msg] $msg -} {0 .f} + frame .f -visual default + list [.f configure -visual] [catch {.f configure -visual best} msg] $msg +} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}} catch {destroy .f} test frame-1.4 {frame configuration options} { list [catch {frame .f -screen bogus} msg] $msg @@ -105,6 +107,8 @@ foreach test { {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 6 6 badValue {bad screen distance "badValue"}} + {-padx 3 3 badValue {bad screen distance "badValue"}} + {-pady 4 4 badValue {bad screen distance "badValue"}} {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-takefocus "any string" "any string" {} {}} {-width 32 32 badValue {bad screen distance "badValue"}} @@ -206,6 +210,8 @@ foreach test { {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 3 3 badValue {bad screen distance "badValue"}} + {-padx 3 3 badValue {bad screen distance "badValue"}} + {-pady 4 4 badValue {bad screen distance "badValue"}} {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-width 32 32 badValue {bad screen distance "badValue"}} } { @@ -458,22 +464,22 @@ frame .f -highlightcolor black test frame-5.1 {FrameWidgetCommand procedure} { list [catch .f msg] $msg } {1 {wrong # args: should be ".f option ?arg arg ...?"}} -test scale-5.2 {FrameWidgetCommand procedure, cget option} { +test frame-5.2 {FrameWidgetCommand procedure, cget option} { list [catch {.f cget} msg] $msg } {1 {wrong # args: should be ".f cget option"}} -test scale-5.3 {FrameWidgetCommand procedure, cget option} { +test frame-5.3 {FrameWidgetCommand procedure, cget option} { list [catch {.f cget a b} msg] $msg } {1 {wrong # args: should be ".f cget option"}} -test scale-5.4 {FrameWidgetCommand procedure, cget option} { +test frame-5.4 {FrameWidgetCommand procedure, cget option} { list [catch {.f cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} -test scale-5.5 {FrameWidgetCommand procedure, cget option} { +test frame-5.5 {FrameWidgetCommand procedure, cget option} { .f cget -highlightcolor } {black} -test scale-5.6 {FrameWidgetCommand procedure, cget option} { +test frame-5.6 {FrameWidgetCommand procedure, cget option} { list [catch {.f cget -screen} msg] $msg } {1 {unknown option "-screen"}} -test scale-5.7 {FrameWidgetCommand procedure, cget option} { +test frame-5.7 {FrameWidgetCommand procedure, cget option} { catch {destroy .t} toplevel .t catch {.t cget -screen} @@ -481,7 +487,7 @@ test scale-5.7 {FrameWidgetCommand procedure, cget option} { catch {destroy .t} test frame-5.8 {FrameWidgetCommand procedure, configure option} { llength [.f configure] -} {16} +} {18} test frame-5.9 {FrameWidgetCommand procedure, configure option} { list [catch {.f configure -gorp} msg] $msg } {1 {unknown option "-gorp"}} @@ -494,6 +500,9 @@ test frame-5.11 {FrameWidgetCommand procedure, configure option} { test frame-5.12 {FrameWidgetCommand procedure} { list [catch {.f swizzle} msg] $msg } {1 {bad option "swizzle": must be cget or configure}} +test frame-5.13 {FrameWidgetCommand procedure, configure option} { + llength [. configure] +} {21} test frame-6.1 {ConfigureFrame procedure} { catch {destroy .f} @@ -624,6 +633,244 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} { list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1] } {{} {} {} {}} +test frame-12.1 {FrameWorldChanged procedure} { + # Test -bd -padx and -pady + destroy .f + frame .f -borderwidth 2 -padx 3 -pady 4 + place .f -x 0 -y 0 -width 40 -height 40 + pack [frame .f.f] -fill both -expand 1 + update + set result [list [winfo x .f.f] [winfo y .f.f] \ + [winfo width .f.f] [winfo height .f.f]] + destroy .f + set result +} {5 6 30 28} +test frame-12.2 {FrameWorldChanged procedure} { + # Test all -labelanchor positions + destroy .f + set font {helvetica 12} + labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \ + -text "Mupp" + set fh [expr {[font metrics $font -linespace] + 2 - 3}] + set fw [expr {[font measure $font "Mupp"] + 2 - 3}] + if {$fw < 0} {set fw 0} + if {$fh < 0} {set fh 0} + place .f -x 0 -y 0 -width 100 -height 100 + pack [frame .f.f] -fill both -expand 1 + + set result {} + foreach lp {nw n ne en e es se s sw ws w wn} { + .f configure -labelanchor $lp + update + set expx 5 + set expy 6 + set expw 90 + set exph 88 + switch -glob $lp { + n* {incr expy $fh ; incr exph -$fh} + s* {incr exph -$fh} + w* {incr expx $fw ; incr expw -$fw} + e* {incr expw -$fw} + } + lappend result [expr {\ + [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\ + [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}] + } + destroy .f + set result +} {1 1 1 1 1 1 1 1 1 1 1 1} +test frame-12.3 {FrameWorldChanged procedure} { + # Check reaction on font change + destroy .f + font create myfont -family courier -size 10 + labelframe .f -font myfont -text Mupp + place .f -x 0 -y 0 -width 40 -height 40 + pack [frame .f.f] -fill both -expand 1 + update + set h1 [font metrics myfont -linespace] + set y1 [winfo y .f.f] + font configure myfont -size 20 + update + set h2 [font metrics myfont -linespace] + set y2 [winfo y .f.f] + destroy .f + font delete myfont + expr {($h2 - $h1) - ($y2 - $y1)} +} {0} + +test frame-13.1 {labelframe configuration options} { + labelframe .f -class NewFrame + list [.f configure -class] [catch {.f configure -class Different} msg] $msg +} {{-class class Class Labelframe NewFrame} 1 {can't modify -class option after widget is created}} +catch {destroy .f} +test frame-13.2 {labelframe configuration options} { + list [catch {labelframe .f -colormap new} msg] $msg +} {0 .f} +catch {destroy .f} +test frame-13.3 {labelframe configuration options} { + list [catch {labelframe .f -visual default} msg] $msg +} {0 .f} +catch {destroy .f} +test frame-13.4 {labelframe configuration options} { + list [catch {labelframe .f -screen bogus} msg] $msg +} {1 {unknown option "-screen"}} +test frame-13.5 {labelframe configuration options} { + set result [list [catch {labelframe .f -container true} msg] $msg \ + [.f configure -container]] + destroy .f + set result +} {0 .f {-container container Container 0 1}} +test frame-13.6 {labelframe configuration options} { + list [catch {labelframe .f -container bogus} msg] $msg +} {1 {expected boolean value but got "bogus"}} +test frame-13.7 {labelframe configuration options} { + labelframe .f + set result [list [catch {.f configure -container 1} msg] $msg] + destroy .f + set result +} {1 {can't modify -container option after widget is created}} +labelframe .f +set i 8 +foreach test { + {-background #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-bd 4 4 badValue {bad screen distance "badValue"}} + {-bg #00ff00 #00ff00 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 #0000ff #0000ff non-existent + {unknown color name "non-existent"}} + {-font {courier 8} {courier 8} {} {}} + {-foreground #ff0000 #ff0000 non-existent + {unknown color name "non-existent"}} + {-height 100 100 not_a_number {bad screen distance "not_a_number"}} + {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} + {-highlightcolor #123456 #123456 non-existent + {unknown color name "non-existent"}} + {-highlightthickness 6 6 badValue {bad screen distance "badValue"}} + {-labelanchor se se badValue {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}} + {-padx 3 3 badValue {bad screen distance "badValue"}} + {-pady 4 4 badValue {bad screen distance "badValue"}} + {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} + {-takefocus "any string" "any string" {} {}} + {-text "any string" "any string" {} {}} + {-width 32 32 badValue {bad screen distance "badValue"}} +} { + set name [lindex $test 0] + test frame-13.$i {labelframe configuration options} { + .f configure $name [lindex $test 1] + lindex [.f configure $name] 4 + } [lindex $test 2] + incr i + if {[lindex $test 3] != ""} { + test frame-13.$i {labelframe configuration options} { + list [catch {.f configure $name [lindex $test 3]} msg] $msg + } [list 1 [lindex $test 4]] + } + .f configure $name [lindex [.f configure $name] 3] + incr i +} +destroy .f + +test frame-14.1 {labelframe labelwidget option} { + # Test that label is moved in stacking order + destroy .f .l + label .l -text Mupp + labelframe .f -labelwidget .l + pack .f + frame .f.f -width 50 -height 50 + pack .f.f + update + set res [list [winfo children .] [winfo width .f] \ + [expr {[winfo height .f] - [winfo height .l]}]] + destroy .f .l + set res +} {{.f .l} 54 52} +test frame-14.2 {labelframe labelwidget option} { + # Test the labelframe's reaction if the label is destroyed + destroy .f .l + label .l -text Aratherlonglabel + labelframe .f -labelwidget .l + pack .f + label .f.l -text Mupp + pack .f.l + update + set res [list [.f cget -labelwidget]] + lappend res [expr {[winfo width .f] - [winfo width .l]}] + destroy .l + lappend res [.f cget -labelwidget] + update + lappend res [expr {[winfo width .f] - [winfo width .f.l]}] + destroy .f + set res +} {.l 12 {} 4} +test frame-14.3 {labelframe labelwidget option} { + # Test the labelframe's reaction if the label is stolen + destroy .f .l + label .l -text Aratherlonglabel + labelframe .f -labelwidget .l + pack .f + label .f.l -text Mupp + pack .f.l + update + set res [list [.f cget -labelwidget]] + lappend res [expr {[winfo width .f] - [winfo width .l]}] + pack .l + lappend res [.f cget -labelwidget] + update + lappend res [expr {[winfo width .f] - [winfo width .f.l]}] + destroy .f .l + set res +} {.l 12 {} 4} +test frame-14.4 {labelframe labelwidget option} { + # Test the label's reaction if the labelframe is destroyed + destroy .f .l + label .l -text Mupp + labelframe .f -labelwidget .l + pack .f + update + set res [list [winfo manager .l]] + destroy .f + lappend res [winfo manager .l] + destroy .l + set res +} {labelframe {}} +test frame-14.5 {labelframe labelwidget option} { + # Test that the labelframe reacts on changes in label + destroy .f .l + label .l -text Aratherlonglabel + labelframe .f -labelwidget .l + pack .f + label .f.l -text Mupp + pack .f.l + update + set first [winfo width .f] + set res [expr {[winfo width .f] - [winfo width .l]}] + .l configure -text Shorter + update + lappend res [expr {[winfo width .f] - [winfo width .l]}] + lappend res [expr {[winfo width .f] < $first}] + .l configure -text Alotlongerthananytimebefore + update + lappend res [expr {[winfo width .f] - [winfo width .l]}] + lappend res [expr {[winfo width .f] > $first}] + destroy .f .l + set res +} {12 12 1 12 1} +test frame-14.6 {labelframe labelwidget option} { + # Destroying a labelframe with a child label caused a crash + # when not handling mapping of the label correctly. + # This test does not test anything directly, it's just ment + # to catch if the same mistake is made again. + destroy .f + labelframe .f + pack .f + label .f.l -text Mupp + .f configure -labelwidget .f.l + update + destroy .f +} {} catch {destroy .f} rename eatColors {} @@ -632,16 +879,3 @@ rename colorsFree {} # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/grid.test b/tests/grid.test index b7711a0..9342d9f 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: grid.test,v 1.13 2001/09/23 11:30:44 pspjuth Exp $ +# RCS: @(#) $Id: grid.test,v 1.14 2001/09/26 21:36:19 pspjuth Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1360,6 +1360,41 @@ test grid-17.1 {forget and pending idle handlers} { set result ok } ok +test grid-18.1 {test respect for internalborder} { + toplevel .pack + wm geometry .pack 200x200 + frame .pack.l -width 15 -height 10 + labelframe .pack.lf -labelwidget .pack.l + pack .pack.lf -fill both -expand 1 + frame .pack.lf.f + grid .pack.lf.f -sticky news + grid columnconfigure .pack.lf 0 -weight 1 + grid rowconfigure .pack.lf 0 -weight 1 + update + set res [list [winfo geometry .pack.lf.f]] + .pack.lf configure -labelanchor e -padx 3 -pady 5 + update + lappend res [winfo geometry .pack.lf.f] + destroy .pack + set res +} {196x188+2+10 177x186+5+7} +test grid-18.2 {test support for minreqsize} { + toplevel .pack + wm geometry .pack {} + frame .pack.l -width 150 -height 100 + labelframe .pack.lf -labelwidget .pack.l + pack .pack.lf -fill both -expand 1 + frame .pack.lf.f -width 20 -height 25 + grid .pack.lf.f + update + set res [list [winfo geometry .pack.lf]] + .pack.lf configure -labelanchor ws + update + lappend res [winfo geometry .pack.lf] + destroy .pack + set res +} {162x127+0+0 172x112+0+0} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/pack.test b/tests/pack.test index d05854f..395b3f2 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pack.test,v 1.8 2001/09/23 11:30:44 pspjuth Exp $ +# RCS: @(#) $Id: pack.test,v 1.9 2001/09/26 21:36:19 pspjuth Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1060,6 +1060,42 @@ test pack-18.2 {unmap slaves when master unmapped} { update lappend result [winfo ismapped .pack.b] } {1 0 100 30 0 1} + +test pack-19.1 {test respect for internalborder} { + catch {eval pack forget [pack slaves .pack]} + destroy .pack.l .pack.lf + wm geometry .pack 200x200 + frame .pack.l -width 15 -height 10 + labelframe .pack.lf -labelwidget .pack.l + pack .pack.lf -fill both -expand 1 + frame .pack.lf.f + pack .pack.lf.f -fill both -expand 1 + update + set res [list [winfo geometry .pack.lf.f]] + .pack.lf configure -labelanchor e -padx 3 -pady 5 + update + lappend res [winfo geometry .pack.lf.f] + destroy .pack.l .pack.lf + set res +} {196x188+2+10 177x186+5+7} +test pack-19.2 {test support for minreqsize} { + catch {eval pack forget [pack slaves .pack]} + destroy .pack.l .pack.lf + wm geometry .pack {} + frame .pack.l -width 150 -height 100 + labelframe .pack.lf -labelwidget .pack.l + pack .pack.lf -fill both -expand 1 + frame .pack.lf.f -width 20 -height 25 + pack .pack.lf.f + update + set res [list [winfo geometry .pack.lf]] + .pack.lf configure -labelanchor ws + update + lappend res [winfo geometry .pack.lf] + destroy .pack.l .pack.lf + set res +} {162x127+0+0 172x112+0+0} + destroy .pack foreach i {pack1 pack2 pack3 pack4} { rename $i {} diff --git a/tests/place.test b/tests/place.test index 1dc2dfa..2d25e3c 100644 --- a/tests/place.test +++ b/tests/place.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: place.test,v 1.5 2000/08/10 00:21:08 ericm Exp $ +# RCS: @(#) $Id: place.test,v 1.6 2001/09/26 21:36:19 pspjuth Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -353,6 +353,23 @@ test place-12.1 {PlaceObjCmd, forget command} { set res } [list 1 0] +test place-13.1 {test respect for internalborder} { + toplevel .pack + wm geometry .pack 200x200 + frame .pack.l -width 15 -height 10 + labelframe .pack.lf -labelwidget .pack.l + pack .pack.lf -fill both -expand 1 + frame .pack.lf.f + place .pack.lf.f -x 0 -y 0 -relwidth 1.0 -relheight 1.0 + update + set res [list [winfo geometry .pack.lf.f]] + .pack.lf configure -labelanchor e -padx 3 -pady 5 + update + lappend res [winfo geometry .pack.lf.f] + destroy .pack + set res +} {196x188+2+10 177x186+5+7} + catch {destroy .t} # cleanup diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index 4cc48a4..40113e8 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -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: tkUnixDefault.h,v 1.9 2000/07/28 16:34:55 ericm Exp $ + * RCS: @(#) $Id: tkUnixDefault.h,v 1.10 2001/09/26 21:36:19 pspjuth Exp $ */ #ifndef _TKUNIXDEFAULT @@ -185,13 +185,26 @@ #define DEF_FRAME_HIGHLIGHT BLACK #define DEF_FRAME_HIGHLIGHT_WIDTH "0" #define DEF_FRAME_LABEL "" +#define DEF_FRAME_PADX "0" +#define DEF_FRAME_PADY "0" #define DEF_FRAME_RELIEF "flat" #define DEF_FRAME_TAKE_FOCUS "0" -#define DEF_FRAME_USE "" #define DEF_FRAME_VISUAL "" #define DEF_FRAME_WIDTH "0" /* + * Defaults for labelframes: + */ + +#define DEF_LABELFRAME_BORDER_WIDTH "2" +#define DEF_LABELFRAME_CLASS "Labelframe" +#define DEF_LABELFRAME_RELIEF "groove" +#define DEF_LABELFRAME_FG BLACK +#define DEF_LABELFRAME_FONT "Helvetica -12 bold" +#define DEF_LABELFRAME_TEXT "" +#define DEF_LABELFRAME_LABELANCHOR "nw" + +/* * Defaults for listboxes: */ @@ -462,5 +475,6 @@ #define DEF_TOPLEVEL_CLASS "Toplevel" #define DEF_TOPLEVEL_MENU "" #define DEF_TOPLEVEL_SCREEN "" +#define DEF_TOPLEVEL_USE "" #endif /* _TKUNIXDEFAULT */ diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index 2e6d903..b1ea6cb 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDefault.h,v 1.9 2000/07/28 16:34:56 ericm Exp $ + * RCS: @(#) $Id: tkWinDefault.h,v 1.10 2001/09/26 21:36:19 pspjuth Exp $ */ #ifndef _TKWINDEFAULT @@ -32,14 +32,14 @@ #define NORMAL_BG "SystemButtonFace" #define NORMAL_FG "SystemButtonText" #define ACTIVE_BG NORMAL_BG -#define TEXT_FG "SystemWindowText" +#define TEXT_FG "SystemWindowText" #define SELECT_BG "SystemHighlight" #define SELECT_FG "SystemHighlightText" #define TROUGH "SystemScrollbar" #define INDICATOR "SystemWindow" #define DISABLED "SystemDisabledText" -#define MENU_BG "SystemMenu" -#define MENU_FG "SystemMenuText" +#define MENU_BG "SystemMenu" +#define MENU_FG "SystemMenuText" #define HIGHLIGHT "SystemWindowFrame" /* @@ -190,13 +190,26 @@ #define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG #define DEF_FRAME_HIGHLIGHT HIGHLIGHT #define DEF_FRAME_HIGHLIGHT_WIDTH "0" +#define DEF_FRAME_PADX "0" +#define DEF_FRAME_PADY "0" #define DEF_FRAME_RELIEF "flat" #define DEF_FRAME_TAKE_FOCUS "0" -#define DEF_FRAME_USE "" #define DEF_FRAME_VISUAL "" #define DEF_FRAME_WIDTH "0" /* + * Defaults for labelframes: + */ + +#define DEF_LABELFRAME_BORDER_WIDTH "2" +#define DEF_LABELFRAME_CLASS "Labelframe" +#define DEF_LABELFRAME_RELIEF "groove" +#define DEF_LABELFRAME_FG NORMAL_FG +#define DEF_LABELFRAME_FONT CTL_FONT +#define DEF_LABELFRAME_TEXT "" +#define DEF_LABELFRAME_LABELANCHOR "nw" + +/* * Defaults for listboxes: */ @@ -467,5 +480,6 @@ #define DEF_TOPLEVEL_CLASS "Toplevel" #define DEF_TOPLEVEL_MENU "" #define DEF_TOPLEVEL_SCREEN "" +#define DEF_TOPLEVEL_USE "" #endif /* _TKWINDEFAULT */ diff --git a/win/tkWinFont.c b/win/tkWinFont.c index 98a0545..b98e3b9 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.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: tkWinFont.c,v 1.13 2001/09/21 21:34:10 hobbs Exp $ + * RCS: @(#) $Id: tkWinFont.c,v 1.14 2001/09/26 21:36:19 pspjuth Exp $ */ #include "tkWinInt.h" @@ -826,6 +826,11 @@ Tk_DrawChars( dc = TkWinGetDrawableDC(display, drawable, &state); SetROP2(dc, tkpWinRopModes[gc->function]); + + if ((gc->clip_mask != None) && + ((TkpClipMask*)gc->clip_mask)->type == TKP_CLIP_REGION) { + SelectClipRgn(dc, (HRGN)((TkpClipMask*)gc->clip_mask)->value.region); + } if ((gc->fill_style == FillStippled || gc->fill_style == FillOpaqueStippled) -- cgit v0.12