From 65df794905c3a9673211043eed2f9f1f4968ec1b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Oct 2007 04:03:52 +0000 Subject: merge updates from HEAD --- ChangeLog | 30 +++++-- doc/ttk_sizegrip.n | 14 ++-- doc/wm.n | 28 ++++++- generic/tkFocus.c | 129 ++++++++++++++++++++++++++++- generic/tkFrame.c | 34 +++++++- generic/tkInt.h | 5 +- library/demos/button.tcl | 16 +--- library/demos/check.tcl | 5 +- library/demos/style.tcl | 25 +++--- library/demos/textpeer.tcl | 60 ++++++++++++++ library/demos/twind.tcl | 8 +- library/demos/widget | 140 +++++++++++++++---------------- macosx/tkMacOSXButton.c | 14 +++- macosx/tkMacOSXMenubutton.c | 10 ++- macosx/tkMacOSXWm.c | 197 +++++++++++++++++++++++++++++++++++++++++--- tests/wm.test | 50 ++++++++++- unix/tkUnixWm.c | 161 ++++++++++++++++++++++++++++++++++-- win/tkWinWm.c | 159 +++++++++++++++++++++++++++++++++-- 18 files changed, 934 insertions(+), 151 deletions(-) create mode 100644 library/demos/textpeer.tcl diff --git a/ChangeLog b/ChangeLog index af29210..007b927 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,9 +1,27 @@ +2007-10-15 Donal K. Fellows + + * library/demos/widget: Use Ttk widgets for the widget demo core, for + vastly improved look-and-feel on at least one platform (Windows). + * library/demos/{button,check,style,twind}.tcl: Various tweaks for + GOOBE... + * library/demos/textpeer.tcl: New demo script to show off peering as a + specific feature. + +2007-10-15 Jeff Hobbs + + * generic/tkFocus.c, generic/tkFrame.c, generic/tkInt.h: + * macosx/tkMacOSXButton.c, macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXWm.c, unix/tkUnixWm.c, win/tkWinWm.c: + * doc/wm.n, tests/wm.test: TIP #125 implementation [Bug 998125] + Adds [wm manage|forget] for dockable frames. + Finished X11 and Windows code, needs OS X completion. + 2007-10-15 Joe English - * generic/ttk/ttkTreeview.c: Store pointer to column - table entry instead of column index in columnNames hash table. - This avoids the need for the evil PTR2INT and INT2PTR macros, - and simplifies things a bit. + * generic/ttk/ttkTreeview.c: Store pointer to column table entry + instead of column index in columnNames hash table. This avoids the + need for the evil PTR2INT and INT2PTR macros, and simplifies things a + bit. 2007-10-15 Daniel Steffen @@ -52,7 +70,7 @@ * macosx/tkMacOSXDraw.c: replace all (internal) use of QD region * macosx/tkMacOSXSubwindows.c: API by HIShape API, with conversion to - * macosx/tkMacOSXWindowEvent.c QD regions only when required by legacy + * macosx/tkMacOSXWindowEvent.c: QD regions only when required by legacy * macosx/tkMacOSXPrivate.h: Carbon or Tk API. * macosx/tkMacOSXRegion.c: * macosx/tkMacOSXDebug.c: @@ -117,7 +135,7 @@ * generic/tkImage.c: Make Ttk_GetImage safe if called with NULL * tests/ttk/image.test: interp. Added some tests that crash on Windows without this fix. - + 2007-10-02 Don Porter [core-stabilizer-branch] diff --git a/doc/ttk_sizegrip.n b/doc/ttk_sizegrip.n index 105114f..e9c33d8 100644 --- a/doc/ttk_sizegrip.n +++ b/doc/ttk_sizegrip.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ttk_sizegrip.n,v 1.3.2.1 2007/05/26 04:06:06 dgp Exp $ +'\" RCS: @(#) $Id: ttk_sizegrip.n,v 1.3.2.2 2007/10/16 04:03:53 dgp Exp $ '\" .so man.macros .TH ttk_sizegrip n 8.5 Tk "Tk Themed Widget" @@ -21,25 +21,25 @@ A \fBttk::sizegrip\fR widget (also known as a \fIgrow box\fR) allows the user to resize the containing toplevel window by pressing and dragging the grip. .SO -\-class \-cursor \-state \-style +\-class \-cursor \-state \-style \-takefocus .SE .SH "WIDGET COMMAND" -Sizegrip widgets support the standard -\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR +Sizegrip widgets support the standard +\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR methods. No other widget methods are used. .SH "PLATFORM-SPECIFIC NOTES" On Mac OSX, toplevel windows automatically include a built-in size grip by default. -Adding an \fBttk::sizegrip\fR there is harmless, since -the built-in grip will just mask the widget. +Adding an \fBttk::sizegrip\fR there is harmless, since +the built-in grip will just mask the widget. .SH EXAMPLES .CS # Using pack: pack [ttk::frame $top.statusbar] -side bottom -fill x -pack [ttk::sizegrip $top.statusbar.grip -side right -anchor se] +pack [ttk::sizegrip $top.statusbar.grip] -side right -anchor se # Using grid: grid [ttk::sizegrip $top.statusbar.grip] \ diff --git a/doc/wm.n b/doc/wm.n index b33bb4e..f8dfe61 100644 --- a/doc/wm.n +++ b/doc/wm.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: wm.n,v 1.29 2007/04/23 21:19:52 das Exp $ +'\" RCS: @(#) $Id: wm.n,v 1.29.2.1 2007/10/16 04:03:53 dgp Exp $ '\" .so man.macros .TH wm n 8.5 Tk "Tk Built-In Commands" @@ -219,6 +219,13 @@ the application may re-assign the focus among \fIwindow\fR's descendants. The focus model defaults to \fBpassive\fR, and Tk's \fBfocus\fR command assumes a passive model of focusing. .TP +\fBwm forget \fIwindow\fR +The \fIwindow\fR will be unmapped from the screen and will no longer +be managed by \fBwm\fR. Windows created with the \fBtoplevel\fR +command will be treated like \fBframe\fR windows once they are no +longer managed by \fBwm\fR, however, the -menu configuration will be +remembered and the menus will return once the widget is managed again. +.TP \fBwm frame \fIwindow\fR If \fIwindow\fR has been reparented by the window manager into a decorative frame, the command returns the platform specific window @@ -398,6 +405,10 @@ an icon window; this is needed in order to allow window managers to ``own'' those events. Note: not all window managers support the notion of an icon window. .TP +\fBwm manage \fIwidget\fR +The \fIwidget\fR specified will become a stand alone top-level window. The +window will be decorated with the window managers title bar, etc. +.TP \fBwm maxsize \fIwindow\fR ?\fIwidth height\fR? If \fIwidth\fR and \fIheight\fR are specified, they give the maximum permissible dimensions for \fIwindow\fR. @@ -604,6 +615,21 @@ all forms of resizing, including the window's natural size as well as manual resizes and the \fBwm geometry\fR command. You can also use the command \fBwm resizable\fR to completely disable interactive resizing in one or both dimensions. +.PP +The \fBwm manage\fR and \fBwm forget\fR commands may be used to +perform undocking and docking of windows. After a widget is managed +by \fBwm manage\fR command, all other \fBwm\fR subcommands may be used +with the widget. Only widgets created using the toplevel command may +have an attached menu via the -menu configure option. A toplevel +widget may be used as a frame and managed with any of the other +geometry managers after using the \fBwm forget\fR command. Any menu +associated with a toplevel widget will be hidden when managed by +another geometry managers. The menus will reappear once the window is +managed by \fBwm\fR. All custom bindtags for widgets in a subtree +that have their top-level widget changed via a \fBwm manage\fR or +\fBwm forget\fR command, must be redone to adjust any top-level widget +path in the bindtags. Bindtags that have not been customized do not +have to be redone. .SH "GRIDDED GEOMETRY MANAGEMENT" .PP Gridded geometry management occurs when one of the widgets of an diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 5aedfe5..a4240da 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -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: tkFocus.c,v 1.13.2.1 2007/09/07 01:25:34 dgp Exp $ + * RCS: @(#) $Id: tkFocus.c,v 1.13.2.2 2007/10/16 04:03:53 dgp Exp $ */ #include "tkInt.h" @@ -1044,6 +1044,133 @@ TkFocusFree( } /* + *---------------------------------------------------------------------- + * + * TkFocusSplit -- + * + * Adjust focus window for a newly managed toplevel, thus splitting + * the toplevel into two toplevels. + * + * Results: + * None. + * + * Side effects: + * A new record is allocated for the new toplevel window. + * + *---------------------------------------------------------------------- + */ + +void +TkFocusSplit(winPtr) + TkWindow *winPtr; /* Window is the new toplevel + * Any focus point at or below window + * must be moved to this new toplevel */ +{ + ToplevelFocusInfo *tlFocusPtr; + DisplayFocusInfo *displayFocusPtr; + TkWindow *topLevelPtr; + TkWindow *subWinPtr; + + displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr); + + /* + * Find the top-level window for winPtr, then find (or create) + * a record for the top-level. Also see whether winPtr and all its + * ancestors are mapped. + */ + + for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) { + if (topLevelPtr == NULL) { + /* + * The window is being deleted. No point in worrying about + * giving it the focus. + */ + return; + } + if (topLevelPtr->flags & TK_TOP_HIERARCHY) { + break; + } + } + + /* Search all focus records to find child windows of winPtr */ + for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; + tlFocusPtr = tlFocusPtr->nextPtr) { + if (tlFocusPtr->topLevelPtr == topLevelPtr) { + break; + } + } + + if (tlFocusPtr == NULL) { + /* No focus record for this toplevel, nothing to do. */ + return; + } + + /* See if current focusWin is child of the new toplevel */ + for (subWinPtr = tlFocusPtr->focusWinPtr; + subWinPtr && subWinPtr != winPtr && subWinPtr != topLevelPtr; + subWinPtr = subWinPtr->parentPtr) {} + + if (subWinPtr == winPtr) { + /* Move focus to new toplevel */ + ToplevelFocusInfo *newTlFocusPtr; + + newTlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo)); + newTlFocusPtr->topLevelPtr = winPtr; + newTlFocusPtr->focusWinPtr = tlFocusPtr->focusWinPtr; + newTlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; + winPtr->mainPtr->tlFocusPtr = newTlFocusPtr; + /* Move old toplevel's focus to the toplevel itself */ + tlFocusPtr->focusWinPtr = topLevelPtr; + } + /* If it's not, then let focus progress naturally */ +} + +/* + *---------------------------------------------------------------------- + * + * TkFocusJoin -- + * + * Remove the focus record for this window that is nolonger managed + * + * Results: + * None. + * + * Side effects: + * A tlFocusPtr record is removed + * + *---------------------------------------------------------------------- + */ + +void +TkFocusJoin(winPtr) + TkWindow *winPtr; /* Window is no longer a toplevel */ +{ + ToplevelFocusInfo *tlFocusPtr; + ToplevelFocusInfo *tmpPtr; + + /* + * Remove old toplevel record + */ + if (winPtr && winPtr->mainPtr && winPtr->mainPtr->tlFocusPtr + && winPtr->mainPtr->tlFocusPtr->topLevelPtr == winPtr) { + tmpPtr = winPtr->mainPtr->tlFocusPtr; + winPtr->mainPtr->tlFocusPtr = tmpPtr->nextPtr; + ckfree((char *)tmpPtr); + } else { + for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; + tlFocusPtr = tlFocusPtr->nextPtr) { + if (tlFocusPtr->nextPtr && + tlFocusPtr->nextPtr->topLevelPtr == winPtr) { + tmpPtr = tlFocusPtr->nextPtr; + tlFocusPtr->nextPtr = tmpPtr->nextPtr; + ckfree((char *)tmpPtr); + break; + } + } + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 3dcb1e5..23b5c99 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.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: tkFrame.c,v 1.28.2.1 2007/09/07 01:25:34 dgp Exp $ + * RCS: @(#) $Id: tkFrame.c,v 1.28.2.2 2007/10/16 04:03:53 dgp Exp $ */ #include "default.h" @@ -943,10 +943,11 @@ ConfigureFrame( * A few of the options require additional processing. */ - if (((oldMenuName == NULL) && (framePtr->menuName != NULL)) + if ((((oldMenuName == NULL) && (framePtr->menuName != NULL)) || ((oldMenuName != NULL) && (framePtr->menuName == NULL)) || ((oldMenuName != NULL) && (framePtr->menuName != NULL) - && strcmp(oldMenuName, framePtr->menuName) != 0)) { + && strcmp(oldMenuName, framePtr->menuName) != 0)) + && framePtr->type == TYPE_TOPLEVEL) { TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName, framePtr->menuName); } @@ -1910,6 +1911,33 @@ FrameLostSlaveProc( FrameWorldChanged((ClientData) framePtr); } +void +TkMapTopFrame (tkwin) + Tk_Window tkwin; +{ + Frame *framePtr = ((TkWindow*)tkwin)->instanceData; + Tk_OptionTable optionTable; + if (Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_FRAME) { + framePtr->type = TYPE_TOPLEVEL; + Tcl_DoWhenIdle(MapFrame, (ClientData)framePtr); + if (framePtr->menuName != NULL) { + TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin, NULL, + framePtr->menuName); + } + } else if (!Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_TOPLEVEL) { + framePtr->type = TYPE_FRAME; + } else { + /* Not a frame or toplevel, skip it */ + return; + } + /* + * The option table has already been created so + * the cached pointer will be returned. + */ + optionTable = Tk_CreateOptionTable(framePtr->interp, optionSpecs[framePtr->type]); + framePtr->optionTable = optionTable; +} + /* *-------------------------------------------------------------- * diff --git a/generic/tkInt.h b/generic/tkInt.h index 29a476f..2d4fdcb 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.77.2.2 2007/10/15 18:38:33 dgp Exp $ + * RCS: $Id: tkInt.h,v 1.77.2.3 2007/10/16 04:03:53 dgp Exp $ */ #ifndef _TKINT @@ -1180,6 +1180,7 @@ MODULE_SCOPE int TkTileParseProc(ClientData clientData, MODULE_SCOPE char * TkTilePrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); +MODULE_SCOPE void TkMapTopFrame(Tk_Window tkwin); MODULE_SCOPE XEvent * TkpGetBindingXEvent(Tcl_Interp *interp); MODULE_SCOPE void TkCreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); @@ -1196,6 +1197,8 @@ MODULE_SCOPE void TkPrintPadAmount(Tcl_Interp *interp, MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, int *pad1Ptr, int *pad2Ptr); +MODULE_SCOPE void TkFocusSplit(TkWindow *winPtr); +MODULE_SCOPE void TkFocusJoin(TkWindow *winPtr); MODULE_SCOPE int TkpAlwaysShowSelection(Tk_Window tkwin); MODULE_SCOPE void TkpDrawCharsInContext(Display * display, Drawable drawable, GC gc, Tk_Font tkfont, diff --git a/library/demos/button.tcl b/library/demos/button.tcl index 69129582..92e3eff 100644 --- a/library/demos/button.tcl +++ b/library/demos/button.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several button widgets. # -# RCS: @(#) $Id: button.tcl,v 1.4.2.1 2007/05/30 13:47:42 dgp Exp $ +# RCS: @(#) $Id: button.tcl,v 1.4.2.2 2007/10/16 04:03:53 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,22 +22,10 @@ label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any pack $w.msg -side top ## See Code / Dismiss buttons -set btns [addSeeDismiss $w.buttons $w] -pack $btns -side bottom -fill x +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x proc colorrefresh {w col} { $w configure -bg $col - $w.buttons configure -bg $col - if {[tk windowingsystem] eq "aqua"} { - # set highlightbackground of all buttons in $w - set l [list $w] - while {[llength $l]} { - set l [concat [lassign $l b] [winfo children $b]] - if {[winfo class $b] eq "Button"} { - $b configure -highlightbackground $col - } - } - } } button $w.b1 -text "Peach Puff" -width 10 \ diff --git a/library/demos/check.tcl b/library/demos/check.tcl index 3e3ddc4..612311f 100644 --- a/library/demos/check.tcl +++ b/library/demos/check.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several checkbuttons. # -# RCS: @(#) $Id: check.tcl,v 1.5 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: check.tcl,v 1.5.2.1 2007/10/16 04:03:54 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -35,6 +35,9 @@ checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat pack $w.b0 -side top -pady 2 -anchor w pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w -padx 15 +## This code makes $w.b0 function as a tri-state button; it's not +## needed at all for just straight yes/no buttons. + set in_check 0 proc tristate_check {n1 n2 op} { global safety wipers brakes sober in_check diff --git a/library/demos/style.tcl b/library/demos/style.tcl index ff31fc6..73b84a1 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget that illustrates the # various display styles that may be set for tags. # -# RCS: @(#) $Id: style.tcl,v 1.4 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: style.tcl,v 1.4.2.1 2007/10/16 04:03:54 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,17 +22,22 @@ positionWindow $w set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x +# Only set the font family in one place for simplicity and consistency + +set family Courier + text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ - -width 70 -height 32 -wrap word + -width 70 -height 32 -wrap word -font "$family 12" scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both # Set up display styles -$w.text tag configure bold -font {Courier 12 bold italic} -$w.text tag configure big -font {Courier 14 bold} -$w.text tag configure verybig -font {Helvetica 24 bold} +$w.text tag configure bold -font "$family 12 bold italic" +$w.text tag configure big -font "$family 14 bold" +$w.text tag configure verybig -font "Helvetica 24 bold" +$w.text tag configure tiny -font "Times 8 bold" if {[winfo depth $w] > 1} { $w.text tag configure color1 -background #a0b7ce $w.text tag configure color2 -foreground red @@ -53,8 +58,8 @@ $w.text tag configure underline -underline on $w.text tag configure overstrike -overstrike on $w.text tag configure right -justify right $w.text tag configure center -justify center -$w.text tag configure super -offset 4p -font {Courier 10} -$w.text tag configure sub -offset -2p -font {Courier 10} +$w.text tag configure super -offset 4p -font "$family 10" +$w.text tag configure sub -offset -2p -font "$family 10" $w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m $w.text tag configure spacing -spacing1 10p -spacing2 2p \ -lmargin1 12m -lmargin2 6m -rmargin 10m @@ -63,17 +68,17 @@ $w.text insert end {Text widgets like this one allow you to display information variety of styles. Display styles are controlled using a mechanism called } $w.text insert end tags bold -$w.text insert end {. Tags are just textual names that you can apply to one +$w.text insert end {. Tags are just textual names that you can apply to one or more ranges of characters within a text widget. You can configure tags with various display styles. If you do this, then the tagged characters will be displayed with the styles you chose. The available display styles are: } $w.text insert end "\n1. Font." big -$w.text insert end " You can choose any X font, " +$w.text insert end " You can choose any system font, " $w.text insert end large verybig $w.text insert end " or " -$w.text insert end "small.\n" +$w.text insert end "small" tiny ".\n" $w.text insert end "\n2. Color." big $w.text insert end " You can change either the " $w.text insert end background color1 diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl new file mode 100644 index 0000000..9a1a985 --- /dev/null +++ b/library/demos/textpeer.tcl @@ -0,0 +1,60 @@ +# textpeer.tcl -- +# +# This demonstration script creates a pair of text widgets that can edit a +# single logical buffer. This is particularly useful when editing related text +# in two (or more) parts of the same file. +# +# RCS: @(#) $Id: textpeer.tcl,v 1.1.2.2 2007/10/16 04:03:54 dgp Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .textpeer +catch {destroy $w} +toplevel $w +wm title $w "Text Widget Peering Demonstration" +wm iconname $w "textpeer" +positionWindow $w + +set count 0 + +set first [text $w.text[incr count]] +$first insert end "This is a coupled pair of text widgets; they are peers to " +$first insert end "each other. They have the same underlying data model, but " +$first insert end "can show different locations, have different current edit " +$first insert end "locations, and have different selections. You can also " +$first insert end "create additional peers of any of these text widgets using " +$first insert end "the Make Peer button beside the text widget to clone, and " +$first insert end "delete a particular peer widget using the Delete Peer " +$first insert end "button." +grid $first + +proc makeClone {w parent} { + global count + set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ + -height 10 -wrap word] + set sb [scrollbar $w.sb$count -command "$t yview" -orient vertical] + set b1 [button $w.clone$count -command "makeClone $w $t" \ + -text "Make Peer"] + set b2 [button $w.kill$count -command "killClone $w $count" \ + -text "Delete Peer"] + set row [expr {$count * 2}] + grid $t $sb $b1 -sticky nsew -row $row + grid ^ ^ $b2 -row [incr row] + grid configure $b1 $b2 -sticky new + grid rowconfigure $w $b2 -weight 1 +} +proc killClone {w count} { + destroy $w.text$count $w.sb$count + destroy $w.clone$count $w.kill$count +} + +makeClone $w $first +makeClone $w $first +destroy $first + +## See Code / Dismiss buttons +grid [addSeeDismiss $w.buttons $w] - - -sticky ew -row 5000 diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 7510776..b569d9a 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.8 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.8.2.1 2007/10/16 04:03:54 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -66,7 +66,7 @@ $t insert end "Or, here is another example. If you " $t window create end -create { button %W.click -text "Click Here" -command "textWindPlot %W" \ -cursor top_left_arrow} - + $t insert end " a canvas displaying an x-y plot will appear right here." $t mark set plot insert $t mark gravity plot left @@ -97,6 +97,10 @@ $t window create end \ -cursor top_left_arrow} -padx 3 $t insert end " \n\n" +$t insert end "Users of previous versions of Tk will also be interested " +$t insert end "to note that now cursor movement is now by visual line by " +$t insert end "default, and that all scrolling of this widget is by pixel.\n\n" + $t insert end "You may also find it useful to put embedded windows in " $t insert end "a text without any actual text. In this case the " $t insert end "text widget acts like a geometry manager. For " diff --git a/library/demos/widget b/library/demos/widget index 02b4b0b..458a384 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -3,19 +3,19 @@ exec wish "$0" "$@" # widget -- -# This script demonstrates the various widgets provided by Tk, -# along with many of the features of the Tk toolkit. This file -# only contains code to generate the main window for the -# application, which invokes individual demonstrations. The -# code for the actual demonstrations is contained in separate -# ".tcl" files is this directory, which are sourced by this script -# as needed. +# This script demonstrates the various widgets provided by Tk, along with many +# of the features of the Tk toolkit. This file only contains code to generate +# the main window for the application, which invokes individual +# demonstrations. The code for the actual demonstrations is contained in +# separate ".tcl" files is this directory, which are sourced by this script as +# needed. # -# RCS: @(#) $Id: widget,v 1.29.2.1 2007/05/29 11:36:43 dgp Exp $ +# RCS: @(#) $Id: widget,v 1.29.2.2 2007/10/16 04:03:54 dgp Exp $ package require Tcl 8.5 package require Tk 8.5 package require msgcat +package require Ttk eval destroy [winfo child .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] @@ -23,8 +23,8 @@ set tk_demoDirectory [file join [pwd] [file dirname [info script]]] namespace import ::msgcat::mc wm title . [mc "Widget Demonstration"] if {[tk windowingsystem] eq "x11"} { - # This won't work everywhere, but there's no other way in core Tk - # at the moment to display a coloured icon. + # This won't work everywhere, but there's no other way in core Tk at the + # moment to display a coloured icon. image create photo TclPowered \ -file [file join $tk_library images logo64.gif] wm iconwindow . [toplevel ._iconWindow] @@ -37,16 +37,16 @@ if {[lsearch -exact [font names] defaultFont] == -1} { if {[lsearch -exact [font names] TkDefaultFont] != -1 && [lsearch -exact [font names] TkFixedFont] != -1} { # FIX ME: the following tecnique of cloning the font to copy it works - # fine but means that if the system font is changed by - # Tk cannot update the copied font. font alias might be - # useful here -- or fix the app to use TkDefaultFont etc. + # fine but means that if the system font is changed by Tk + # cannot update the copied font. font alias might be useful + # here -- or fix the app to use TkDefaultFont etc. font create mainFont {*}[font configure TkDefaultFont] font create fixedFont {*}[font configure TkFixedFont] font create boldFont {*}[font configure TkDefaultFont] -weight bold font create titleFont {*}[font configure TkDefaultFont] -weight bold font create statusFont {*}[font configure TkDefaultFont] font create varsFont {*}[font configure TkDefaultFont] - } else { + } else { font create mainFont -family Helvetica -size 12 font create fixedFont -family Courier -size 10 font create boldFont -family Helvetica -size 12 -weight bold @@ -108,9 +108,9 @@ image create photo ::img::print -height 19 -format GIF -data { } #---------------------------------------------------------------- -# The code below create the main window, consisting of a menu bar -# and a text widget that explains how to use the program, plus lists -# all of the demos as hypertext items. +# The code below create the main window, consisting of a menu bar and a text +# widget that explains how to use the program, plus lists all of the demos as +# hypertext items. #---------------------------------------------------------------- menu .menuBar -tearoff 0 @@ -136,16 +136,14 @@ if {[tk windowingsystem] eq "aqua"} { . configure -menu .menuBar -frame .statusBar -label .statusBar.lab -text " " -relief sunken -bd 1 \ - -font statusFont -anchor w -label .statusBar.foo -width 8 -relief sunken -bd 1 \ - -font statusFont -anchor w +ttk::frame .statusBar +ttk::label .statusBar.lab -text " " -anchor w +ttk::sizegrip .statusBar.foo pack .statusBar.lab -side left -padx 2 -expand yes -fill both pack .statusBar.foo -side left -padx 2 pack .statusBar -side bottom -fill x -pady 2 -frame .textFrame +ttk::frame .textFrame scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ -takefocus 1 -bd 1 pack .s -in .textFrame -side right -fill y @@ -155,16 +153,16 @@ text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both -# Create a bunch of tags to use in the text widget, such as those for -# section titles and demo descriptions. Also define the bindings for -# tags. +# Create a bunch of tags to use in the text widget, such as those for section +# titles and demo descriptions. Also define the bindings for tags. .t tag configure title -font titleFont .t tag configure bold -font boldFont -# We put some "space" characters to the left and right of each demo description -# so that the descriptions are highlighted only when the mouse cursor -# is right over them (but not when the cursor is to their left or right) +# We put some "space" characters to the left and right of each demo +# description so that the descriptions are highlighted only when the mouse +# cursor is right over them (but not when the cursor is to their left or +# right). # .t tag configure demospace -lmargin1 1c -lmargin2 1c @@ -216,11 +214,11 @@ set lastLine "" # addFormattedText -- # -# Add formatted text (but not hypertext) to the text widget after -# first passing it through the message catalog to allow for -# localization. Lines starting with @@ are formatting directives -# (begin newline, or change style) and all other lines are literal -# strings to be inserted. Blank lines are ignored. +# Add formatted text (but not hypertext) to the text widget after first +# passing it through the message catalog to allow for localization. +# Lines starting with @@ are formatting directives (begin newline, or +# change style) and all other lines are literal strings to be inserted. +# Blank lines are ignored. # proc addFormattedText {formattedText} { set style normal @@ -249,9 +247,9 @@ proc addFormattedText {formattedText} { # addDemoSection -- # -# Add a new section of demos with a title and a (stride-2) list of -# demo files and their descriptions. Titles and descriptions are -# passed through the message catalog to allow for localization. +# Add a new section of demos with a title and a (stride-2) list of demo +# files and their descriptions. Titles and descriptions are passed +# through the message catalog to allow for localization. # proc addDemoSection {title demos} { .t insert end "\n" {} [mc $title] title " \n " demospace @@ -271,7 +269,7 @@ addFormattedText { This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the - numbered lines below describes a demonstration; you can click on + numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the @@bold @@ -316,6 +314,7 @@ addDemoSection "Text" { bind "Hypertext (tag bindings)" twind "A text widget with embedded windows and other features" search "A search tool built with a text widget" + textpeer "Peering text widgets" } addDemoSection "Canvases" { items "The canvas item types" @@ -366,18 +365,19 @@ focus .s proc addSeeDismiss {w show {vars {}} {extra {}}} { ## See Code / Dismiss buttons - frame $w - frame $w.sep -height 2 -relief sunken -bd 2 + ttk::frame $w + ttk::separator $w.sep + #ttk::frame $w.sep -height 2 -relief sunken grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2 - button $w.dismiss -text [mc "Dismiss"] \ + ttk::button $w.dismiss -text [mc "Dismiss"] \ -image ::img::delete -compound left \ -command [list destroy [winfo toplevel $w]] - button $w.code -text [mc "See Code"] \ + ttk::button $w.code -text [mc "See Code"] \ -image ::img::view -compound left \ -command [list showCode $show] set buttons [list x $w.code $w.dismiss] if {[llength $vars]} { - button $w.vars -text [mc "See Variables"] \ + ttk::button $w.vars -text [mc "See Variables"] \ -image ::img::view -compound left \ -command [concat [list showVars $w.dialog] $vars] set buttons [linsert $buttons 1 $w.vars] @@ -385,14 +385,14 @@ proc addSeeDismiss {w show {vars {}} {extra {}}} { if {$extra ne ""} { set buttons [linsert $buttons 1 [uplevel 1 $extra]] } - eval grid $buttons -padx 4 -pady 4 + grid {*}$buttons -padx 4 -pady 4 grid columnconfigure $w 0 -weight 1 return $w } # positionWindow -- -# This procedure is invoked by most of the demos to position a -# new demo window. +# This procedure is invoked by most of the demos to position a new demo +# window. # # Arguments: # w - The name of the window to position. @@ -402,8 +402,8 @@ proc positionWindow w { } # showVars -- -# Displays the values of one or more variables in a window, and -# updates the display whenever any of the variables changes. +# Displays the values of one or more variables in a window, and updates the +# display whenever any of the variables changes. # # Arguments: # w - Name of new window to create for display. @@ -414,13 +414,13 @@ proc showVars {w args} { toplevel $w wm title $w [mc "Variable values"] - set f [labelframe $w.title -text [mc "Variable values:"] -font varsFont] + set f [ttk::labelframe $w.title -text [mc "Variable values:"]] foreach var $args { - label $f.n$var -text "$var:" -anchor w - label $f.v$var -textvariable $var -anchor w + ttk::label $f.n$var -text "$var:" -anchor w + ttk::label $f.v$var -textvariable $var -anchor w grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } - button $w.ok -width 8 -text [mc "OK"] \ + ttk::button $w.ok -width 8 -text [mc "OK"] \ -command [list destroy $w] -default active bind $w [list $w.ok invoke] bind $w [list $w.ok invoke] @@ -434,8 +434,8 @@ proc showVars {w args} { } # invoke -- -# This procedure is called when the user clicks on a demo description. -# It is responsible for invoking the demonstration. +# This procedure is called when the user clicks on a demo description. It is +# responsible for invoking the demonstration. # # Arguments: # index - The index of the character that the user clicked on. @@ -460,8 +460,8 @@ proc invoke index { # showStatus -- # -# Show the name of the demo program in the status bar. This procedure -# is called when the user moves the cursor over a demo description. +# Show the name of the demo program in the status bar. This procedure is +# called when the user moves the cursor over a demo description. # proc showStatus index { set tags [.t tag names $index] @@ -491,12 +491,12 @@ proc evalShowCode {w} { } # showCode -- -# This procedure creates a toplevel window that displays the code for -# a demonstration and allows it to be edited and reinvoked. +# This procedure creates a toplevel window that displays the code for a +# demonstration and allows it to be edited and reinvoked. # # Arguments: -# w - The name of the demonstration's window, which can be -# used to derive the name of the file containing its code. +# w - The name of the demonstration's window, which can be used to +# derive the name of the file containing its code. proc showCode w { global tk_demoDirectory @@ -522,13 +522,13 @@ proc showCode w { set btns [frame $top.btns] - button $btns.dismiss -text [mc "Dismiss"] \ + ttk::button $btns.dismiss -text [mc "Dismiss"] \ -default active -command [list destroy $top] \ -image ::img::delete -compound left - button $btns.print -text [mc "Print Code"] \ + ttk::button $btns.print -text [mc "Print Code"] \ -command [list printCode $text $file] \ -image ::img::print -compound left - button $btns.rerun -text [mc "Rerun Demo"] \ + ttk::button $btns.rerun -text [mc "Rerun Demo"] \ -command [list evalShowCode $text] \ -image ::img::refresh -compound left @@ -558,8 +558,8 @@ proc showCode w { } # printCode -- -# Prints the source code currently displayed in the See Code dialog. -# Much thanks to Arjen Markus for this. +# Prints the source code currently displayed in the See Code dialog. Much +# thanks to Arjen Markus for this. # # Arguments: # w - Name of text widget containing code to print @@ -618,11 +618,11 @@ proc printCode {w file} { # filename - Name of the file # # Note: -# Taken from the Wiki page by Keith Vetter, "Printing text files -# under Windows" +# Taken from the Wiki page by Keith Vetter, "Printing text files under +# Windows". # Note: -# Do not execute the command in the background: that way we can dispose -# of the file smoothly +# Do not execute the command in the background: that way we can dispose of the +# file smoothly. # proc PrintTextWin32 {filename} { package require registry @@ -652,7 +652,7 @@ proc aboutBox {} { [mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] [mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] -[mc {Copyright (c) %s} {2001-2003 Donal K. Fellows}]" +[mc {Copyright (c) %s} {2001-2007 Donal K. Fellows}]" } # Local Variables: diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index 6101539..e46eeec 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.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: tkMacOSXButton.c,v 1.25.2.3 2007/10/15 18:38:34 dgp Exp $ + * RCS: @(#) $Id: tkMacOSXButton.c,v 1.25.2.4 2007/10/16 04:03:54 dgp Exp $ */ #include "tkMacOSXPrivate.h" @@ -863,6 +863,7 @@ TkMacOSXDrawControl( TkButton *butPtr = (TkButton *) mbPtr; TkWindow *winPtr; Rect paneRect, cntrRect; + int rebuild; winPtr = (TkWindow *) butPtr->tkwin; @@ -888,12 +889,17 @@ TkMacOSXDrawControl( * The control has been previously initialised. * It may need to be re-initialised */ - +#ifdef TK_REBUILD_TOPLEVEL + rebuild = (winPtr->flags & TK_REBUILD_TOPLEVEL); + winPtr->flags &= ~TK_REBUILD_TOPLEVEL; +#else + rebuild = 0; +#endif if (mbPtr->flags) { MacControlParams params; TkMacOSXComputeControlParams(butPtr, ¶ms); - if (bcmp(¶ms, &mbPtr->params, sizeof(params))) { + if (rebuild || bcmp(¶ms, &mbPtr->params, sizeof(params))) { /* * The type of control has changed. * Clean it up and clear the flag. @@ -931,7 +937,7 @@ TkMacOSXDrawControl( len = 0; controlTitle[0] = 0; } - if (bcmp(mbPtr->controlTitle, controlTitle, len+1)) { + if (rebuild || bcmp(mbPtr->controlTitle, controlTitle, len+1)) { CFStringRef cf = CFStringCreateWithCString(NULL, (char*) controlTitle, kCFStringEncodingUTF8); diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c index ed303d6..218d079 100644 --- a/macosx/tkMacOSXMenubutton.c +++ b/macosx/tkMacOSXMenubutton.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: tkMacOSXMenubutton.c,v 1.14.2.1 2007/07/01 17:31:37 dgp Exp $ + * RCS: @(#) $Id: tkMacOSXMenubutton.c,v 1.14.2.2 2007/10/16 04:03:54 dgp Exp $ */ #include "tkMacOSXPrivate.h" @@ -193,8 +193,12 @@ TkpDisplayMenuButton( if (mbPtr->userPane) { MenuButtonControlParams params; bzero(¶ms, sizeof(params)); - ComputeMenuButtonControlParams(butPtr, ¶ms ); - if (bcmp(¶ms,&mbPtr->params,sizeof(params))) { + ComputeMenuButtonControlParams(butPtr, ¶ms); + if ( +#ifdef TK_REBUILD_TOPLEVEL + (winPtr->flags & TK_REBUILD_TOPLEVEL) || +#endif + bcmp(¶ms,&mbPtr->params,sizeof(params))) { if (mbPtr->userPane) { DisposeControl(mbPtr->userPane); mbPtr->userPane = NULL; diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index f18d400..b7a2789 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacOSXWm.c,v 1.49.2.7 2007/10/15 18:38:36 dgp Exp $ + * RCS: @(#) $Id: tkMacOSXWm.c,v 1.49.2.8 2007/10/16 04:03:54 dgp Exp $ */ #include "tkMacOSXPrivate.h" @@ -113,6 +113,8 @@ static int WmDeiconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmFocusmodelCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmForgetCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmFrameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmGeometryCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, @@ -135,6 +137,8 @@ static int WmIconpositionCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmIconwindowCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmManageCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int WmMaxsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmMinsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, @@ -168,6 +172,7 @@ static void ApplyWindowClassAttributeChanges(TkWindow *winPtr, static void ApplyMasterOverrideChanges(TkWindow *winPtr, WindowRef macWindow); static void GetMinSize(TkWindow *winPtr, int *minWidthPtr, int *minHeightPtr); static void GetMaxSize(TkWindow *winPtr, int *maxWidthPtr, int *maxHeightPtr); +static void RemapWindows(TkWindow *winPtr, MacDrawable *parentWin); /* @@ -514,21 +519,21 @@ Tk_WmObjCmd( Tk_Window tkwin = (Tk_Window) clientData; static const char *optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", - "command", "deiconify", "focusmodel", "frame", - "geometry", "grid", "group", "iconbitmap", - "iconify", "iconmask", "iconname", - "iconphoto", "iconposition", - "iconwindow", "maxsize", "minsize", "overrideredirect", + "command", "deiconify", "focusmodel", "forget", + "frame", "geometry", "grid", "group", + "iconbitmap", "iconify", "iconmask", "iconname", + "iconphoto", "iconposition", "iconwindow", + "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, - WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME, - WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, - WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, - WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, - WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, + WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, + WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, + WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, + WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; @@ -569,7 +574,8 @@ wrongNumArgs: != TCL_OK) { return TCL_ERROR; } - if (!Tk_IsTopLevel(winPtr)) { + if (!Tk_IsTopLevel(winPtr) && + (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", NULL); return TCL_ERROR; @@ -590,6 +596,8 @@ wrongNumArgs: return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FOCUSMODEL: return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FORGET: + return WmForgetCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FRAME: return WmFrameCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GEOMETRY: @@ -612,6 +620,8 @@ wrongNumArgs: return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONWINDOW: return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MANAGE: + return WmManageCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MAXSIZE: return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MINSIZE: @@ -1345,6 +1355,67 @@ WmFocusmodelCmd( /* *---------------------------------------------------------------------- * + * WmForgetCmd -- + * + * This procedure is invoked to process the "wm forget" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmForgetCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel or Frame to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + char *oldClass = (char*)Tk_Class(frameWin); + +#if 1 + Tcl_AppendResult(interp, "wm forget is not yet supported", (char*)NULL); + return TCL_ERROR; +#else + if (Tk_IsTopLevel(frameWin)) { + MacDrawable *macWin = (MacDrawable *) winPtr->window; + CGrafPtr destPort = TkMacOSXGetDrawablePort(winPtr->window); + + TkFocusJoin(winPtr); + Tk_UnmapWindow(frameWin); + + if (destPort != NULL) { + WindowRef winRef; + winRef = GetWindowFromPort(destPort); + TkMacOSXUnregisterMacWindow(winRef); + DisposeWindow(winRef); + } + macWin->grafPtr = NULL; + macWin->toplevel = winPtr->parentPtr->privatePtr->toplevel; + macWin->flags &= ~TK_HOST_EXISTS; + + RemapWindows(winPtr, macWin); + TkWmDeadWindow(winPtr); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + + TkMapTopFrame(frameWin); + } else { + /* Already not managed by wm - ignore it */ + } + return TCL_OK; +#endif +} + +/* + *---------------------------------------------------------------------- + * * WmFrameCmd -- * * This procedure is invoked to process the "wm frame" Tcl command. @@ -2038,6 +2109,67 @@ WmIconwindowCmd( /* *---------------------------------------------------------------------- * + * WmManageCmd -- + * + * This procedure is invoked to process the "wm manage" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmManageCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel or Frame to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *oldClass = (char*)Tk_Class(frameWin); + +#if 1 + Tcl_AppendResult(interp, "wm manage is not yet supported", (char*)NULL); + return TCL_ERROR; +#else + if (!Tk_IsTopLevel(frameWin)) { + MacDrawable *macWin = (MacDrawable *) winPtr->window; + + TkFocusSplit(winPtr); + Tk_UnmapWindow(frameWin); + if (wmPtr == NULL) { + TkWmNewWindow(winPtr); + if (winPtr->window == None) { + Tk_MakeWindowExist((Tk_Window) winPtr); + macWin = (MacDrawable *) winPtr->window; + } + TkWmMapWindow(winPtr); + Tk_UnmapWindow(frameWin); + } + wmPtr = winPtr->wmInfoPtr; + winPtr->flags &= ~TK_MAPPED; + macWin->grafPtr = NULL; + macWin->toplevel = macWin; + RemapWindows(winPtr, macWin); + winPtr->flags |= (TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + TkMapTopFrame (frameWin); + } else if (Tk_IsTopLevel(frameWin)) { + /* Already managed by wm - ignore it */ + } + return TCL_OK; +#endif +} + +/* + *---------------------------------------------------------------------- + * * WmMaxsizeCmd -- * * This procedure is invoked to process the "wm maxsize" Tcl command. @@ -6234,3 +6366,44 @@ GetMaxSize( *maxHeightPtr = maxHeight; } } + +/* + *---------------------------------------------------------------------- + * + * RemapWindows + * + * Adjust parent/child relation ships of + * the given window hierarchy. + * + * Results: + * none + * + * Side effects: + * keeps windowing system (X11) happy + * + *---------------------------------------------------------------------- + */ +static void +RemapWindows(TkWindow *winPtr, MacDrawable *parentWin) +{ + TkWindow *childPtr; + + /* Remove the OS specific window. + * It will get rebuilt when the window gets Mapped. + */ + if (winPtr->window != None) { + MacDrawable *macWin = (MacDrawable *) winPtr->window; + macWin->grafPtr = NULL; + macWin->toplevel = parentWin->toplevel; + winPtr->flags &= ~TK_MAPPED; +#ifdef TK_REBUILD_TOPLEVEL + winPtr->flags |= TK_REBUILD_TOPLEVEL; +#endif + } + + /* Repeat for all the children */ + for (childPtr = winPtr->childList; childPtr != NULL; + childPtr = childPtr->nextPtr) { + RemapWindows(childPtr, (MacDrawable *) winPtr->window); + } +} diff --git a/tests/wm.test b/tests/wm.test index 39e5596..10b77e5 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: wm.test,v 1.37 2006/12/28 21:15:14 mdejong Exp $ +# RCS: @(#) $Id: wm.test,v 1.37.2.1 2007/10/16 04:03:54 dgp Exp $ # This file tests window manager interactions that work across # platforms. Window manager tests that only work on a specific @@ -47,7 +47,7 @@ test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} { } {1 {wrong # args: should be "wm option window ?arg ...?"}} test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} { list [catch {wm foo} msg] $msg -} {1 {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} { list [catch {wm command} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} @@ -2033,6 +2033,52 @@ test wm-deletion-epoch-1.1 {Deletion epoch on multiple displays} -constraints al wm deiconify $w } -returnCodes error -result {bad window path name ".t"} +### Docking test (manage, forget) ### +test wm-manage-1.1 {} { + deleteWindows + set result [list] + toplevel .t + button .t.b -text "Manage This" + pack .t.b + update + lappend result [winfo manage .t.b] + lappend result [winfo toplevel .t.b] + wm manage .t.b + update + lappend result [winfo manage .t.b] + lappend result [winfo toplevel .t.b] + wm forget .t.b + pack .t.b + update + lappend result [winfo manage .t.b] + lappend result [winfo toplevel .t.b] + set result +} {pack .t wm .t.b pack .t} + +test wm-manage-1.2 {} { + deleteWindows + set result [list] + toplevel .t + toplevel .t.t + button .t.t.b -text "Manage This" + pack .t.t.b + update + lappend result [winfo manage .t.t] + lappend result [winfo toplevel .t.t.b] + wm forget .t.t + wm forget .t.t ; # second call should be a no-op + pack .t.t + update + lappend result [winfo manage .t.t] + lappend result [winfo toplevel .t.t.b] + wm manage .t.t + wm manage .t.t ; # second call should be a no-op + wm deiconify .t.t + update + lappend result [winfo manage .t.t] + lappend result [winfo toplevel .t.t.b] +} {wm .t.t pack .t wm .t.t} + # FIXME: # Test delivery of virtual events to the WM. We could check to see diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 171dc98..676f754 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.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: tkUnixWm.c,v 1.55.2.1 2007/09/07 01:25:40 dgp Exp $ + * RCS: @(#) $Id: tkUnixWm.c,v 1.55.2.2 2007/10/16 04:03:55 dgp Exp $ */ #include "tkUnixInt.h" @@ -290,6 +290,7 @@ typedef struct TkWmInfo { */ static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); +static void RemapWindows(TkWindow *winPtr, TkWindow *parentPtr); static void MenubarReqProc(ClientData clientData, Tk_Window tkwin); static const Tk_GeomMgr wmMgrType = { @@ -336,6 +337,7 @@ static void PropertyEvent(WmInfo *wmPtr, XPropertyEvent *eventPtr); static void TkWmStackorderToplevelWrapperMap(TkWindow *winPtr, Display *display, Tcl_HashTable *reparentTable); static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); +static void RemapWindows(TkWindow *winPtr, TkWindow *parentPtr); static void UpdateCommand(TkWindow *winPtr); static void UpdateGeometryInfo(ClientData clientData); static void UpdateHints(TkWindow *winPtr); @@ -380,6 +382,9 @@ static int WmDeiconifyCmd(Tk_Window tkwin, TkWindow *winPtr, static int WmFocusmodelCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int WmForgetCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); static int WmFrameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -413,6 +418,9 @@ static int WmIconpositionCmd(Tk_Window tkwin, TkWindow *winPtr, static int WmIconwindowCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int WmManageCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); static int WmMaxsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -996,21 +1004,21 @@ Tk_WmObjCmd( Tk_Window tkwin = (Tk_Window) clientData; static CONST char *optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", - "command", "deiconify", "focusmodel", "frame", + "command", "deiconify", "focusmodel", "forget", "frame", "geometry", "grid", "group", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", - "iconwindow", "maxsize", "minsize", "overrideredirect", + "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, - WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME, + WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, - WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; @@ -1065,7 +1073,8 @@ Tk_WmObjCmd( return TCL_ERROR; } winPtr = (TkWindow *) targetWin; - if (!Tk_IsTopLevel(winPtr)) { + if (!Tk_IsTopLevel(winPtr) && + (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", NULL); return TCL_ERROR; @@ -1086,6 +1095,8 @@ Tk_WmObjCmd( return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FOCUSMODEL: return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FORGET: + return WmForgetCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FRAME: return WmFrameCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GEOMETRY: @@ -1108,6 +1119,8 @@ Tk_WmObjCmd( return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONWINDOW: return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MANAGE: + return WmManageCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MAXSIZE: return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MINSIZE: @@ -1757,6 +1770,48 @@ WmFocusmodelCmd( /* *---------------------------------------------------------------------- * + * WmForgetCmd -- + * + * This procedure is invoked to process the "wm forget" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmForgetCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel or Frame to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + + if (Tk_IsTopLevel(frameWin)) { + TkFocusJoin(winPtr); + Tk_UnmapWindow(frameWin); + TkWmDeadWindow(winPtr); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + RemapWindows(winPtr, winPtr->parentPtr); + /* flags (above) must be cleared before calling */ + /* TkMapTopFrame (below) */ + TkMapTopFrame(frameWin); + } else { + /* Already not managed by wm - ignore it */ + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * WmFrameCmd -- * * This function is invoked to process the "wm frame" Tcl command. See @@ -2580,6 +2635,55 @@ WmIconwindowCmd( /* *---------------------------------------------------------------------- * + * WmManageCmd -- + * + * This procedure is invoked to process the "wm manage" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmManageCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel or Frame to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + register WmInfo *wmPtr = winPtr->wmInfoPtr; + + if (!Tk_IsTopLevel(frameWin)) { + TkFocusSplit(winPtr); + Tk_UnmapWindow(frameWin); + winPtr->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + if (wmPtr == NULL) { + TkWmNewWindow(winPtr); + TkWmMapWindow(winPtr); + Tk_UnmapWindow(frameWin); + } + wmPtr = winPtr->wmInfoPtr; + winPtr->flags &= ~TK_MAPPED; + RemapWindows(winPtr, wmPtr->wrapperPtr); + /* flags (above) must be set before calling */ + /* TkMapTopFrame (below) */ + TkMapTopFrame (frameWin); + } else if (Tk_IsTopLevel(frameWin)) { + /* Already managed by wm - ignore it */ + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * WmMaxsizeCmd -- * * This function is invoked to process the "wm maxsize" Tcl command. See @@ -4298,7 +4402,8 @@ TopLevelReqProc( TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr; - wmPtr = winPtr->wmInfoPtr; + if ((wmPtr = winPtr->wmInfoPtr) == NULL) + return; if ((wmPtr->width >= 0) && (wmPtr->height >= 0)) { /* @@ -6728,6 +6833,10 @@ TkUnixSetMenubar( Tk_Window parent; TkWindow *menubarPtr = (TkWindow *) menubar; + /* Could be a Frame (i.e. not a toplevel) */ + if (wmPtr == NULL) + return; + if (wmPtr->menubar != NULL) { /* * There's already a menubar for this toplevel. If it isn't the same @@ -7018,6 +7127,44 @@ TkpWmSetState( } /* + *---------------------------------------------------------------------- + * + * RemapWindows + * + * Adjust parent/child relation ships of + * the given window hierarchy. + * + * Results: + * none + * + * Side effects: + * keeps windowing system (X11) happy + * + *---------------------------------------------------------------------- + */ + +static void +RemapWindows(winPtr, parentPtr) + TkWindow *winPtr; + TkWindow *parentPtr; +{ + XWindowAttributes win_attr; + + if (winPtr->window) { + XGetWindowAttributes(winPtr->display, winPtr->window, &win_attr); + if (parentPtr == NULL) { + XReparentWindow(winPtr->display, winPtr->window, + XRootWindow(winPtr->display, winPtr->screenNum), + win_attr.x, win_attr.y); + } else if (parentPtr->window) { + XReparentWindow(parentPtr->display, winPtr->window, + parentPtr->window, + win_attr.x, win_attr.y); + } + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 8aa4217..1e00394 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.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: tkWinWm.c,v 1.116.2.2 2007/09/09 04:15:55 dgp Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.116.2.3 2007/10/16 04:03:55 dgp Exp $ */ #include "tkWinInt.h" @@ -356,6 +356,7 @@ typedef struct TkWmInfo { */ static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); +static void RemapWindows(TkWindow *winPtr, HWND parentHWND); static const Tk_GeomMgr wmMgrType = { "wm", /* name */ @@ -480,6 +481,9 @@ static int WmDeiconifyCmd(Tk_Window tkwin, static int WmFocusmodelCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int WmForgetCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); static int WmFrameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -513,6 +517,9 @@ static int WmIconpositionCmd(Tk_Window tkwin, static int WmIconwindowCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int WmManageCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); static int WmMaxsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -2838,7 +2845,7 @@ TkWmDeadWindow( if (!(winPtr->flags & TK_EMBEDDED)) { if (wmPtr->wrapper != NULL) { DestroyWindow(wmPtr->wrapper); - } else { + } else if (winPtr->window) { DestroyWindow(Tk_GetHWND(winPtr->window)); } } else { @@ -2915,22 +2922,22 @@ Tk_WmObjCmd( Tk_Window tkwin = (Tk_Window) clientData; static CONST char *optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", - "command", "deiconify", "focusmodel", "frame", + "command", "deiconify", "focusmodel", "forget", "frame", "geometry", "grid", "group", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", - "iconwindow", "maxsize", "minsize", "overrideredirect", + "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, - WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME, + WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, - WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW @@ -2985,7 +2992,8 @@ Tk_WmObjCmd( != TCL_OK) { return TCL_ERROR; } - if (!Tk_IsTopLevel(winPtr)) { + if (!Tk_IsTopLevel(winPtr) && + (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", NULL); return TCL_ERROR; @@ -3006,6 +3014,8 @@ Tk_WmObjCmd( return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FOCUSMODEL: return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FORGET: + return WmForgetCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_FRAME: return WmFrameCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GEOMETRY: @@ -3028,6 +3038,8 @@ Tk_WmObjCmd( return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONWINDOW: return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MANAGE: + return WmManageCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MAXSIZE: return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_MINSIZE: @@ -3737,6 +3749,47 @@ WmFocusmodelCmd( /* *---------------------------------------------------------------------- * + * WmForgetCmd -- + * + * This procedure is invoked to process the "wm forget" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmForgetCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel or Frame to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + char *oldClass = (char*)Tk_Class(frameWin); + + if (Tk_IsTopLevel(frameWin)) { + Tk_UnmapWindow(frameWin); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + RemapWindows(winPtr, Tk_GetHWND(winPtr->parentPtr->window)); + TkWmDeadWindow(winPtr); + /* flags (above) must be cleared before calling */ + /* TkMapTopFrame (below) */ + TkMapTopFrame(frameWin); + } else { + /* Already not managed by wm - ignore it */ + } + return TCL_OK; +} +/* + *---------------------------------------------------------------------- + * * WmFrameCmd -- * * This function is invoked to process the "wm frame" Tcl command. See @@ -4592,6 +4645,54 @@ WmIconwindowCmd( /* *---------------------------------------------------------------------- * + * WmManageCmd -- + * + * This procedure is invoked to process the "wm manage" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmManageCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel or Frame to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register Tk_Window frameWin = (Tk_Window)winPtr; + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *oldClass = (char*)Tk_Class(frameWin); + + if (!Tk_IsTopLevel(frameWin)) { + TkFocusSplit(winPtr); + Tk_UnmapWindow(frameWin); + winPtr->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + RemapWindows(winPtr, NULL); + if (wmPtr == NULL) { + TkWmNewWindow(winPtr); + } + wmPtr = winPtr->wmInfoPtr; + winPtr->flags &= ~TK_MAPPED; + /* flags (above) must be set before calling */ + /* TkMapTopFrame (below) */ + TkMapTopFrame (frameWin); + } else if (Tk_IsTopLevel(frameWin)) { + /* Already managed by wm - ignore it */ + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * WmMaxsizeCmd -- * * This function is invoked to process the "wm maxsize" Tcl command. See @@ -6966,6 +7067,10 @@ TkWinSetMenu( TkWindow *winPtr = (TkWindow *) tkwin; WmInfo *wmPtr = winPtr->wmInfoPtr; + /* Could be a Frame (i.e. not a Toplevel) */ + if (wmPtr == NULL) + return; + wmPtr->hMenu = hMenu; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { int syncPending = wmPtr->flags & WM_SYNC_PENDING; @@ -8431,6 +8536,46 @@ TkpWinToplevelDetachWindow( } /* + *---------------------------------------------------------------------- + * + * RemapWindows + * + * Adjust parent/child relation ships of + * the given window hierarchy. + * + * Results: + * none + * + * Side effects: + * keeps windowing system happy + * + *---------------------------------------------------------------------- + */ + +static void +RemapWindows(winPtr, parentHWND) + TkWindow *winPtr; + HWND parentHWND; +{ + TkWindow *childPtr; + + /* Skip Menus as they are handled differently */ + if (strcmp(Tk_Class(winPtr), "Menu") == 0) { + return; + } + if (winPtr->window) { + SetParent(Tk_GetHWND(winPtr->window), parentHWND); + } + + /* Repeat for all the children */ + for (childPtr = winPtr->childList; childPtr != NULL; + childPtr = childPtr->nextPtr) { + RemapWindows(childPtr, + winPtr->window ? Tk_GetHWND(winPtr->window) : NULL); + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 -- cgit v0.12