diff options
| -rw-r--r-- | ChangeLog | 13 | ||||
| -rw-r--r-- | generic/tkInt.h | 7 | ||||
| -rw-r--r-- | generic/tkWindow.c | 4 | ||||
| -rw-r--r-- | tests/unixWm.test | 74 | ||||
| -rw-r--r-- | tests/winWm.test | 4 | ||||
| -rw-r--r-- | tests/wm.test | 954 | ||||
| -rw-r--r-- | unix/tkUnixWm.c | 3261 | ||||
| -rw-r--r-- | win/tkWinWm.c | 3657 |
8 files changed, 5329 insertions, 2645 deletions
@@ -1,3 +1,16 @@ +2002-07-25 Peter Spjuth <peter.spjuth@space.se> + + * generic/tkInt.h: + * generic/tkWindow.c: + * mac/tkMacWm.c: + * unix/tkUnixWm.c: + * win/tkWinWm.c: + * tests/wm.test: + * tests/winWm.test: + * tests/unixWm.test: Objectifed wm. [Patch #564521] + Note: At this point the Mac file is completely untested + and may not even compile. + 2002-07-25 Jeff Hobbs <jeffh@ActiveState.com> * tests/spinbox.test: added spinbox-22.[1-3] diff --git a/generic/tkInt.h b/generic/tkInt.h index a6e887a..4799737 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.51 2002/06/18 23:51:46 dkf Exp $ + * RCS: $Id: tkInt.h,v 1.52 2002/07/25 21:35:22 pspjuth Exp $ */ #ifndef _TKINT @@ -1080,8 +1080,9 @@ EXTERN int Tk_UpdateObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_WmCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_WmObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, int devId, CONST char *buffer, long size)); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 187dce4..1cd3f7f 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.50 2002/06/19 19:37:54 mdejong Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.51 2002/07/25 21:35:22 pspjuth Exp $ */ #include "tkPort.h" @@ -127,7 +127,7 @@ static TkCmd commands[] = { #endif {"update", NULL, Tk_UpdateObjCmd, 1, 1}, {"winfo", NULL, Tk_WinfoObjCmd, 1, 1}, - {"wm", Tk_WmCmd, NULL, 0, 1}, + {"wm", NULL, Tk_WmObjCmd, 0, 1}, /* * Widget class commands. diff --git a/tests/unixWm.test b/tests/unixWm.test index 484236d..1841635 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixWm.test,v 1.25 2002/07/15 18:10:47 dgp Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.26 2002/07/25 21:35:23 pspjuth Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -275,7 +275,7 @@ test unixWm-8.3 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg -} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} +} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} test unixWm-8.4 {icon windows} unix { catch {destroy .t} catch {destroy .icon} @@ -448,10 +448,10 @@ test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} { list [catch {wm} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} { - list [catch {wm foo} msg] $msg + list [catch {wm aspect} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} { - list [catch {wm foo bogus} msg] $msg + list [catch {wm iconify bogus} msg] $msg } {1 {bad window path name "bogus"}} test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} { catch {destroy .b} @@ -468,10 +468,10 @@ update test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} { list [catch {wm aspect .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} { list [catch {wm aspect .t 12 13 14 15 16} msg] $msg -} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} { set result {} lappend result [wm aspect .t] @@ -507,7 +507,7 @@ test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} { test unixWm-13.1 {Tk_WmCmd procedure, "client" option} { list [catch {wm client .t x y} msg] $msg -} {1 {wrong # arguments: must be "wm client window ?name?"}} +} {1 {wrong # args: should be "wm client window ?name?"}} test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} { set result {} lappend result [wm client .t] @@ -529,7 +529,7 @@ test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} { test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} { list [catch {wm colormapwindows .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}} +} {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}} test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} { catch {destroy .t2} toplevel .t2 -width 200 -height 200 -colormap new @@ -584,10 +584,10 @@ catch {destroy .t2} test unixWm-15.1 {Tk_WmCmd procedure, "command" option} { list [catch {wm command .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm command window ?value?"}} +} {1 {wrong # args: should be "wm command window ?value?"}} test unixWm-15.2 {Tk_WmCmd procedure, "command" option} { list [catch {wm command .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm command window ?value?"}} +} {1 {wrong # args: should be "wm command window ?value?"}} test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} { set result {} lappend result [wm command .t] @@ -615,7 +615,7 @@ test unixWm-15.5 {Tk_WmCmd procedure, "command" option} { test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} { list [catch {wm deiconify .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm deiconify window"}} +} {1 {wrong # args: should be "wm deiconify window"}} test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} { catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg red @@ -634,7 +634,7 @@ test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} { test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} { list [catch {wm focusmodel .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}} +} {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}} test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} { list [catch {wm focusmodel .t bogus} msg] $msg } {1 {bad argument "bogus": must be active or passive}} @@ -650,7 +650,7 @@ test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} { test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} { list [catch {wm frame .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm frame window"}} +} {1 {wrong # args: should be "wm frame window"}} test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable { expr [wm frame .t] == [winfo id .t] } {0} @@ -667,7 +667,7 @@ test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable { test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} { list [catch {wm geometry .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}} +} {1 {wrong # args: should be "wm geometry window ?newGeometry?"}} test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable { wm geometry .t -1+5 update @@ -704,10 +704,10 @@ test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} { test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} { list [catch {wm grid .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} { list [catch {wm grid .t 12 13 14 15 16} msg] $msg -} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} { set result {} lappend result [wm grid .t] @@ -749,7 +749,7 @@ update test unixWm-21.1 {Tk_WmCmd procedure, "group" option} { list [catch {wm group .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm group window ?pathName?"}} +} {1 {wrong # args: should be "wm group window ?pathName?"}} test unixWm-21.2 {Tk_WmCmd procedure, "group" option} { list [catch {wm group .t bogus} msg] $msg } {1 {bad window path name "bogus"}} @@ -791,7 +791,7 @@ test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {un test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} unix { list [catch {wm iconbitmap .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}} +} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { set result {} lappend result [wm iconbitmap .t] @@ -810,7 +810,7 @@ test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} { test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} { list [catch {wm iconify .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm iconify window"}} +} {1 {wrong # args: should be "wm iconify window"}} test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} { catch {destroy .t2} toplevel .t2 @@ -863,7 +863,7 @@ test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} { test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} { list [catch {wm iconmask .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}} +} {1 {wrong # args: should be "wm iconmask window ?bitmap?"}} test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} { set result {} lappend result [wm iconmask .t] @@ -882,10 +882,10 @@ test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} { test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm icon .t} msg] $msg -} {1 {unknown or ambiguous option "icon": must be aspect, attributes, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm iconname .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconname window ?newName?"}} +} {1 {wrong # args: should be "wm iconname window ?newName?"}} test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { set result {} lappend result [wm iconname .t] @@ -897,10 +897,10 @@ test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} { list [catch {wm iconposition .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} { list [catch {wm iconposition .t 12 13 14} msg] $msg -} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} { set result {} lappend result [wm iconposition .t] @@ -922,7 +922,7 @@ test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} { test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} { list [catch {wm iconwindow .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} +} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg green @@ -1026,7 +1026,7 @@ update test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} { list [catch {wm overrideredirect .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}} +} {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}} test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} { list [catch {wm overrideredirect .t boo} msg] $msg } {1 {expected boolean value but got "boo"}} @@ -1041,7 +1041,7 @@ test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} { test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} { list [catch {wm positionfrom .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}} +} {1 {wrong # args: should be "wm positionfrom window ?user/program?"}} test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} { set result {} lappend result [wm positionfrom .t] @@ -1062,7 +1062,7 @@ test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} { test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} { list [catch {wm protocol .t 1 2 3} msg] $msg -} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}} +} {1 {wrong # args: should be "wm protocol window ?name? ?command?"}} test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} { wm protocol .t {foo a} {a b c} wm protocol .t bar {test script for bar} @@ -1113,10 +1113,10 @@ test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} { test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable . a} msg] $msg -} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +} {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +} {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable .foo a b c} msg] $msg } {1 {bad window path name ".foo"}} @@ -1144,7 +1144,7 @@ test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} { test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} { list [catch {wm sizefrom .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}} +} {1 {wrong # args: should be "wm sizefrom window ?user|program?"}} test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { set result {} lappend result [wm sizefrom .t] @@ -1165,10 +1165,10 @@ test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} { test unixWm-35.1 {Tk_WmCmd procedure, "state" option} unix { list [catch {wm state .t 1} msg] $msg -} {1 {bad argument "1": must be normal, iconic or withdrawn}} +} {1 {bad argument "1": must be normal, iconic, or withdrawn}} test unixWm-35.2 {Tk_WmCmd procedure, "state" option} { list [catch {wm state .t iconic 1} msg] $msg -} {1 {wrong # arguments: must be "wm state window ?state?"}} +} {1 {wrong # args: should be "wm state window ?state?"}} test unixWm-35.3 {Tk_WmCmd procedure, "state" option} { set result {} catch {destroy .t2} @@ -1206,7 +1206,7 @@ test unixWm-35.4 {Tk_WmCmd procedure, "state" option} { test unixWm-36.1 {Tk_WmCmd procedure, "title" option} { list [catch {wm title .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm title window ?newTitle?"}} +} {1 {wrong # args: should be "wm title window ?newTitle?"}} test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} { set result {} lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] @@ -1260,7 +1260,7 @@ test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} { list [catch {wm withdraw .t 1} msg] $msg -} {1 {wrong # arguments: must be "wm withdraw window"}} +} {1 {wrong # args: should be "wm withdraw window"}} test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} { catch {destroy .t2} toplevel .t2 -width 120 -height 300 @@ -1280,7 +1280,7 @@ test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} { test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} { list [catch {wm unknown .t} msg] $msg -} {1 {unknown or ambiguous option "unknown": must be aspect, attributes, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} catch {destroy .t} catch {destroy .icon} @@ -2396,7 +2396,7 @@ test unixWm-60.2 {wm attributes} unix { destroy .t toplevel .t list [catch {wm attributes .t -foo} msg] $msg -} {1 {wrong # arguments: must be "wm attributes window"}} +} {1 {wrong # args: should be "wm attributes window"}} # cleanup catch {destroy .t} diff --git a/tests/winWm.test b/tests/winWm.test index 7f211bf..7bf9810 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -9,7 +9,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winWm.test,v 1.8 2002/07/13 20:28:36 dgp Exp $ +# RCS: @(#) $Id: winWm.test,v 1.9 2002/07/25 21:35:23 pspjuth Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -243,7 +243,7 @@ test winWm-6.3 {wm attributes} {pcOnly} { destroy .t toplevel .t list [catch {wm attributes .t -foo} msg] $msg -} {1 {wrong # arguments: must be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} +} {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} destroy .t diff --git a/tests/wm.test b/tests/wm.test index 6d576ea..6d218c1 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.15 2002/07/13 20:28:36 dgp Exp $ +# RCS: @(#) $Id: wm.test,v 1.16 2002/07/25 21:35:23 pspjuth Exp $ # This file tests window manager interactions that work across # platforms. Window manager tests that only work on a specific @@ -25,21 +25,825 @@ if {![winfo ismapped .]} { tkwait visibility . } +proc stdWindow {} { + destroy .t + toplevel .t -width 100 -height 50 + wm geom .t +0+0 + update +} + +deleteWindows +stdWindow + +test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} { + list [catch {wm} msg] $msg +} {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, iconposition, iconwindow, 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 ...?"}} + +test wm-1.4 {Tk_WmObjCmd procedure, miscellaneous errors} { + list [catch {wm aspect bogus} msg] $msg +} {1 {bad window path name "bogus"}} + +test wm-1.5 {Tk_WmObjCmd procedure, miscellaneous errors} { + catch {destroy .b} + button .b -text hello + list [catch {wm geometry .b} msg] $msg +} {1 {window ".b" isn't a top-level window}} + + +test wm-aspect-1.1 {usage} { + list [catch {wm aspect} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-aspect-1.2 {usage} { + list [catch {wm aspect . _} err] $err +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} + +test wm-aspect-1.3 {usage} { + list [catch {wm aspect . _ _ _} err] $err +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} + +test wm-aspect-1.4 {usage} { + list [catch {wm aspect . _ _ _ _ _} err] $err +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} + +test wm-aspect-1.5 {usage} { + list [catch {wm aspect . bad 14 15 16} msg] $msg +} {1 {expected integer but got "bad"}} + +test wm-aspect-1.6 {usage} { + list [catch {wm aspect . 13 foo 15 16} msg] $msg +} {1 {expected integer but got "foo"}} + +test wm-aspect-1.7 {usage} { + list [catch {wm aspect . 13 14 bar 16} msg] $msg +} {1 {expected integer but got "bar"}} + +test wm-aspect-1.8 {usage} { + list [catch {wm aspect . 13 14 15 baz} msg] $msg +} {1 {expected integer but got "baz"}} + +test wm-aspect-1.9 {usage} { + list [catch {wm aspect . 0 14 15 16} msg] $msg +} {1 {aspect number can't be <= 0}} + +test wm-aspect-1.10 {usage} { + list [catch {wm aspect . 13 0 15 16} msg] $msg +} {1 {aspect number can't be <= 0}} + +test wm-aspect-1.11 {usage} { + list [catch {wm aspect . 13 14 0 16} msg] $msg +} {1 {aspect number can't be <= 0}} + +test wm-aspect-1.12 {usage} { + list [catch {wm aspect . 13 14 15 0} msg] $msg +} {1 {aspect number can't be <= 0}} + +test wm-aspect-2.1 {setting and reading values} { + set result {} + lappend result [wm aspect .t] + wm aspect .t 3 4 10 2 + lappend result [wm aspect .t] + wm aspect .t {} {} {} {} + lappend result [wm aspect .t] +} [list {} {3 4 10 2} {}] + + +test wm-attributes-1.1 {usage} { + list [catch {wm attributes} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-attributes-1.2.1 {usage} {pcOnly} { + list [catch {wm attributes . _} err] $err +} {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} + +test wm-attributes-1.2.2 {usage} {macOrUnix} { + list [catch {wm attributes . _} err] $err +} {1 {wrong # args: should be "wm attributes window"}} + + +test wm-client-1.1 {usage} { + list [catch {wm client} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-client-1.2 {usage} { + list [catch {wm client . _ _} err] $err +} {1 {wrong # args: should be "wm client window ?name?"}} + +test wm-client-2.1 {setting and reading values} { + set result {} + lappend result [wm client .t] + wm client .t Miffo + lappend result [wm client .t] + wm client .t {} + lappend result [wm client .t] +} [list {} Miffo {}] + + +test wm-colormapwindows-1.1 {usage} { + list [catch {wm colormapwindows} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-colormapwindows-1.2 {usage} { + list [catch {wm colormapwindows . _ _} err] $err +} {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}} + +test wm-colormapwindows-1.3 {usage} { + list [catch {wm colormapwindows . "a \{"} msg] $msg +} {1 {unmatched open brace in list}} + +test wm-colormapwindows-1.4 {usage} { + list [catch {wm colormapwindows . foo} msg] $msg +} {1 {bad window path name "foo"}} + +test wm-colormapwindows-2.1 {reading values} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -colormap new + wm geom .t2 +0+0 + frame .t2.a -width 100 -height 30 + frame .t2.b -width 100 -height 30 -colormap new + pack .t2.a .t2.b -side top + update + set x [wm colormapwindows .t2] + frame .t2.c -width 100 -height 30 -colormap new + pack .t2.c -side top + update + list $x [wm colormapwindows .t2] +} {{.t2.b .t2} {.t2.b .t2.c .t2}} + +test wm-colormapwindows-2.2 {setting and reading values} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 + wm geom .t2 +0+0 + frame .t2.a -width 100 -height 30 + frame .t2.b -width 100 -height 30 + frame .t2.c -width 100 -height 30 + pack .t2.a .t2.b .t2.c -side top + wm colormapwindows .t2 {.t2.b .t2.a} + wm colormapwindows .t2 +} {.t2.b .t2.a} + + +test wm-command-1.1 {usage} { + list [catch {wm command} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-command-1.2 {usage} { + list [catch {wm command . _ _} err] $err +} {1 {wrong # args: should be "wm command window ?value?"}} + +test wm-command-1.3 {usage} { + list [catch {wm command . "a \{"} msg] $msg +} {1 {unmatched open brace in list}} + +test wm-command-2.1 {setting and reading values} { + set result {} + lappend result [wm command .t] + wm command .t [list Miffo Foo] + lappend result [wm command .t] + wm command .t {} + lappend result [wm command .t] +} [list {} [list Miffo Foo] {}] + + +test wm-deiconify-1.1 {usage} { + list [catch {wm deiconify} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-deiconify-1.2 {usage} { + list [catch {wm deiconify . _} err] $err +} {1 {wrong # args: should be "wm deiconify window"}} + +test wm-deiconify-1.3 {usage} { + list [catch {wm deiconify _} err] $err +} {1 {bad window path name "_"}} + +test wm-deiconify-1.4 {usage} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg red + wm iconwindow .t .icon + set result [list [catch {wm deiconify .icon} msg] $msg] + destroy .icon + set result +} {1 {can't deiconify .icon: it is an icon for .t}} + +test wm-deiconify-1.5 {usage} { + catch {destroy .embed} + frame .t.f -container 1 + toplevel .embed -use [winfo id .t.f] + set result [list [catch {wm deiconify .embed} msg] $msg] + destroy .t.f .embed + set result +} {1 {can't deiconify .embed: it is an embedded window}} + +test wm-deiconify-2.1 {a window that has never been mapped + should not be mapped by a call to deiconify} { + deleteWindows + toplevel .t + wm deiconify .t + winfo ismapped .t +} 0 + +test wm-deiconify-2.2 {a window that has already been + mapped should be mapped by deiconify} { + deleteWindows + toplevel .t + update idletasks + wm withdraw .t + wm deiconify .t + winfo ismapped .t +} 1 + +test wm-deiconify-2.3 {geometry for an unmapped window + should not be calculated by a call to deiconify, + it should be done at idle time} { + deleteWindows + set results {} + toplevel .t -width 200 -height 200 + lappend results [wm geometry .t] + wm deiconify .t + lappend results [wm geometry .t] + update idletasks + lappend results [lindex [split \ + [wm geometry .t] +] 0] +} {1x1+0+0 1x1+0+0 200x200} + +test wm-deiconify-2.4 {invoking destroy after a deiconify + should not result in a crash because of a callback + set on the toplevel} { + deleteWindows + toplevel .t + wm withdraw .t + wm deiconify .t + destroy .t + update +} {} + + +test wm-focusmodel-1.1 {usage} { + list [catch {wm focusmodel} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-focusmodel-1.2 {usage} { + list [catch {wm focusmodel . _ _} err] $err +} {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}} + +test wm-focusmodel-1.3 {usage} { + list [catch {wm focusmodel . bogus} msg] $msg +} {1 {bad argument "bogus": must be active or passive}} + +stdWindow + +test wm-focusmodel-2.1 {setting and reading values} { + set result {} + lappend result [wm focusmodel .t] + wm focusmodel .t active + lappend result [wm focusmodel .t] + wm focusmodel .t passive + lappend result [wm focusmodel .t] + set result +} {passive active passive} + + +test wm-frame-1.1 {usage} { + list [catch {wm frame} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-frame-1.2 {usage} { + list [catch {wm frame . _} err] $err +} {1 {wrong # args: should be "wm frame window"}} + + +test wm-geometry-1.1 {usage} { + list [catch {wm geometry} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-geometry-1.2 {usage} { + list [catch {wm geometry . _ _} err] $err +} {1 {wrong # args: should be "wm geometry window ?newGeometry?"}} + +test wm-geometry-1.3 {usage} { + list [catch {wm geometry . bogus} msg] $msg +} {1 {bad geometry specifier "bogus"}} + +test wm-geometry-2.1 {setting values} { + set result {} + wm geometry .t 150x150+50+50 + update + lappend result [wm geometry .t] + wm geometry .t {} + update + lappend result [string equal [wm geometry .t] "150x150+50+50"] +} [list 150x150+50+50 0] + + +test wm-grid-1.1 {usage} { + list [catch {wm grid} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-grid-1.2 {usage} { + list [catch {wm grid . _} err] $err +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} + +test wm-grid-1.3 {usage} { + list [catch {wm grid . _ _ _} err] $err +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} + +test wm-grid-1.4 {usage} { + list [catch {wm grid . _ _ _ _ _} err] $err +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} + +test wm-grid-1.5 {usage} { + list [catch {wm grid . bad 14 15 16} msg] $msg +} {1 {expected integer but got "bad"}} + +test wm-grid-1.6 {usage} { + list [catch {wm grid . 13 foo 15 16} msg] $msg +} {1 {expected integer but got "foo"}} + +test wm-grid-1.7 {usage} { + list [catch {wm grid . 13 14 bar 16} msg] $msg +} {1 {expected integer but got "bar"}} + +test wm-grid-1.8 {usage} { + list [catch {wm grid . 13 14 15 baz} msg] $msg +} {1 {expected integer but got "baz"}} + +test wm-grid-1.9 {usage} { + list [catch {wm grid . -1 14 15 16} msg] $msg +} {1 {baseWidth can't be < 0}} + +test wm-grid-1.10 {usage} { + list [catch {wm grid . 13 -1 15 16} msg] $msg +} {1 {baseHeight can't be < 0}} + +test wm-grid-1.11 {usage} { + list [catch {wm grid . 13 14 -1 16} msg] $msg +} {1 {widthInc can't be < 0}} + +test wm-grid-1.12 {usage} { + list [catch {wm grid . 13 14 15 -1} msg] $msg +} {1 {heightInc can't be < 0}} + +test wm-grid-2.1 {setting and reading values} { + set result {} + lappend result [wm grid .t] + wm grid .t 3 4 10 2 + lappend result [wm grid .t] + wm grid .t {} {} {} {} + lappend result [wm grid .t] +} [list {} {3 4 10 2} {}] + + +test wm-group-1.1 {usage} { + list [catch {wm group} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-group-1.2 {usage} { + list [catch {wm group .t 12 13} msg] $msg +} {1 {wrong # args: should be "wm group window ?pathName?"}} + +test wm-group-1.3 {usage} { + list [catch {wm group .t bogus} msg] $msg +} {1 {bad window path name "bogus"}} + +test wm-group-2.1 {setting and reading values} { + set result {} + lappend result [wm group .t] + wm group .t . + lappend result [wm group .t] + wm group .t {} + lappend result [wm group .t] +} [list {} . {}] + + +test wm-iconbitmap-1.1 {usage} { + list [catch {wm iconbitmap} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconbitmap-1.2.1 {usage} {macOrUnix} { + list [catch {wm iconbitmap .t 12 13} msg] $msg +} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} + +test wm-iconbitmap-1.2.2 {usage} {pcOnly} { + list [catch {wm iconbitmap .t 12 13 14} msg] $msg +} {1 {wrong # args: should be "wm iconbitmap window ?-default? ?image?"}} + +test wm-iconbitmap-1.3 {usage} {pcOnly} { + list [catch {wm iconbitmap .t 12 13} msg] $msg +} {1 {illegal option "12" must be "-default"}} + +test wm-iconbitmap-1.4 {usage} { + list [catch {wm iconbitmap .t bad-bitmap} msg] $msg +} {1 {bitmap "bad-bitmap" not defined}} + +test wm-iconbitmap-2.1 {setting and reading values} { + set result {} + lappend result [wm iconbitmap .t] + wm iconbitmap .t hourglass + lappend result [wm iconbitmap .t] + wm iconbitmap .t {} + lappend result [wm iconbitmap .t] +} [list {} hourglass {}] + + +test wm-iconify-1.1 {usage} { + list [catch {wm iconify} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconify-1.2 {usage} { + list [catch {wm iconify .t _} msg] $msg +} {1 {wrong # args: should be "wm iconify window"}} + +test wm-iconify-2.1 {Misc errors} { + catch {destroy .t2} + toplevel .t2 + wm overrideredirect .t2 1 + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify ".t2": override-redirect flag is set}} + +test wm-iconify-2.2 {Misc errors} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm transient .t2 .t + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify ".t2": it is a transient}} + +test wm-iconify-2.3 {Misc errors} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm iconwindow .t .t2 + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify .t2: it is an icon for .t}} + +test wm-iconify-2.4 {Misc errors} { + catch {destroy .t2} + frame .t.f -container 1 + toplevel .t2 -use [winfo id .t.f] + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 .r.f + set result +} {1 {can't iconify .t2: it is an embedded window}} + +test wm-iconify-3.1 {} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 -0+0 + update + set result [winfo ismapped .t2] + wm iconify .t2 + update + lappend result [winfo ismapped .t2] + destroy .t2 + set result +} {1 0} + + +test wm-iconmask-1.1 {usage} { + list [catch {wm iconmask} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconmask-1.2 {usage} { + list [catch {wm iconmask .t 12 13} msg] $msg +} {1 {wrong # args: should be "wm iconmask window ?bitmap?"}} + +test wm-iconmask-1.3 {usage} { + list [catch {wm iconmask .t bad-bitmap} msg] $msg +} {1 {bitmap "bad-bitmap" not defined}} + +test wm-iconmask-2.1 {setting and reading values} { + set result {} + lappend result [wm iconmask .t] + wm iconmask .t hourglass + lappend result [wm iconmask .t] + wm iconmask .t {} + lappend result [wm iconmask .t] +} [list {} hourglass {}] + + +test wm-iconname-1.1 {usage} { + list [catch {wm iconname} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconname-1.2 {usage} { + list [catch {wm iconname .t 12 13} msg] $msg +} {1 {wrong # args: should be "wm iconname window ?newName?"}} + +test wm-iconname-2.1 {setting and reading values} { + set result {} + lappend result [wm iconname .t] + wm iconname .t ThisIconHasAName + lappend result [wm iconname .t] + wm iconname .t {} + lappend result [wm iconname .t] +} [list {} ThisIconHasAName {}] + + +test wm-iconposition-1.1 {usage} { + list [catch {wm iconposition} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconposition-1.2 {usage} { + list [catch {wm iconposition .t 12} msg] $msg +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} + +test wm-iconposition-1.3 {usage} { + list [catch {wm iconposition .t 12 13 14} msg] $msg +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} + +test wm-iconposition-1.4 {usage} { + list [catch {wm iconposition .t bad 13} msg] $msg +} {1 {expected integer but got "bad"}} + +test wm-iconposition-1.5 {usage} { + list [catch {wm iconposition .t 13 lousy} msg] $msg +} {1 {expected integer but got "lousy"}} + +test wm-iconposition-2.1 {setting and reading values} { + set result {} + lappend result [wm iconposition .t] + wm iconposition .t 10 20 + lappend result [wm iconposition .t] + wm iconposition .t {} {} + lappend result [wm iconposition .t] +} [list {} {10 20} {}] + + +test wm-iconwindow-1.1 {usage} { + list [catch {wm iconwindow} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-iconwindow-1.2 {usage} { + list [catch {wm iconwindow .t 12 13} msg] $msg +} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} + +test wm-iconwindow-1.3 {usage} { + list [catch {wm iconwindow .t bogus} msg] $msg +} {1 {bad window path name "bogus"}} + +test wm-iconwindow-1.4 {usage} { + catch {destroy .b} + button .b -text Help + set result [list [catch {wm iconwindow .t .b} msg] $msg] + destroy .b + set result +} {1 {can't use .b as icon window: not at top level}} + +test wm-iconwindow-1.5 {usage} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg green + catch {destroy .t2} + toplevel .t2 + wm geom .t2 -0+0 + wm iconwindow .t2 .icon + set result [list [catch {wm iconwindow .t .icon} msg] $msg] + destroy .t2 + destroy .icon + set result +} {1 {.icon is already an icon for .t2}} + +test wm-iconwindow-2.1 {setting and reading values} { + set result {} + lappend result [wm iconwindow .t] + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg green + wm iconwindow .t .icon + lappend result [wm iconwindow .t] + wm iconwindow .t {} + destroy .icon + lappend result [wm iconwindow .t] +} [list {} .icon {}] + + +test wm-maxsize-1.1 {usage} { + list [catch {wm maxsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-maxsize-1.2 {usage} { + list [catch {wm maxsize . a} msg] $msg +} {1 {wrong # args: should be "wm maxsize window ?width height?"}} + +test wm-maxsize-1.3 {usage} { + list [catch {wm maxsize . a b c} msg] $msg +} {1 {wrong # args: should be "wm maxsize window ?width height?"}} + +test wm-maxsize-1.4 {usage} { + list [catch {wm maxsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} + +test wm-maxsize-1.5 {usage} { + list [catch {wm maxsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} + +test wm-maxsize-1.6 {usage} { + catch {destroy .t2} + toplevel .t2 + wm maxsize .t2 200 150 + set result [wm maxsize .t2] + destroy .t2 + set result +} {200 150} + + +test wm-minsize-1.1 {usage} { + list [catch {wm minsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-minsize-1.2 {usage} { + list [catch {wm minsize . a} msg] $msg +} {1 {wrong # args: should be "wm minsize window ?width height?"}} + +test wm-minsize-1.3 {usage} { + list [catch {wm minsize . a b c} msg] $msg +} {1 {wrong # args: should be "wm minsize window ?width height?"}} + +test wm-minsize-1.4 {usage} { + list [catch {wm minsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} + +test wm-minsize-1.5 {usage} { + list [catch {wm minsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} + +test wm-minsize-1.6 {usage} { + catch {destroy .t2} + toplevel .t2 + wm minsize .t2 200 150 + set result [wm minsize .t2] + destroy .t2 + set result +} {200 150} + + +test wm-overrideredirect-1.1 {usage} { + list [catch {wm overrideredirect} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-overrideredirect-1.2 {usage} { + list [catch {wm overrideredirect .t 1 2} msg] $msg +} {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}} + +test wm-overrideredirect-1.3 {usage} { + list [catch {wm overrideredirect .t boo} msg] $msg +} {1 {expected boolean value but got "boo"}} + +test wm-overrideredirect-2.1 {setting and reading values} { + set result {} + lappend result [wm overrideredirect .t] + wm overrideredirect .t true + lappend result [wm overrideredirect .t] + wm overrideredirect .t off + lappend result [wm overrideredirect .t] +} {0 1 0} + + +test wm-positionfrom-1.1 {usage} { + list [catch {wm positionfrom} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-positionfrom-1.2 {usage} { + list [catch {wm positionfrom .t 1 2} msg] $msg +} {1 {wrong # args: should be "wm positionfrom window ?user/program?"}} + +test wm-positionfrom-1.3 {usage} { + list [catch {wm positionfrom .t none} msg] $msg +} {1 {bad argument "none": must be program or user}} + +test wm-positionfrom-2.1 {setting and reading values} { + catch {destroy .t2} + toplevel .t2 + set result {} + wm positionfrom .t user + lappend result [wm positionfrom .t] + wm positionfrom .t program + lappend result [wm positionfrom .t] + wm positionfrom .t {} + lappend result [wm positionfrom .t] + destroy .t2 + set result +} {user program {}} + + +test wm-protocol-1.1 {usage} { + list [catch {wm protocol} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-protocol-1.2 {usage} { + list [catch {wm protocol .t 1 2 3} msg] $msg +} {1 {wrong # args: should be "wm protocol window ?name? ?command?"}} + +test wm-protocol-2.1 {setting and reading values} { + wm protocol .t {foo a} {a b c} + wm protocol .t bar {test script for bar} + set result [wm protocol .t] + wm protocol .t {foo a} {} + wm protocol .t bar {} + set result +} {bar {foo a}} + +test wm-protocol-2.2 {setting and reading values} { + set result {} + wm protocol .t foo {a b c} + wm protocol .t bar {test script for bar} + lappend result [wm protocol .t foo] [wm protocol .t bar] + wm protocol .t foo {} + wm protocol .t bar {} + lappend result [wm protocol .t foo] [wm protocol .t bar] +} {{a b c} {test script for bar} {} {}} + +test wm-protocol-2.3 {setting and reading values} { + wm protocol .t foo {a b c} + wm protocol .t foo {test script} + set result [wm protocol .t foo] + wm protocol .t foo {} + set result +} {test script} + + +test wm-resizable-1.1 {usage} { + list [catch {wm resizable} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-resizable-1.2 {usage} { + list [catch {wm resizable .t 1} msg] $msg +} {1 {wrong # args: should be "wm resizable window ?width height?"}} + +test wm-resizable-1.3 {usage} { + list [catch {wm resizable .t 1 2 3} msg] $msg +} {1 {wrong # args: should be "wm resizable window ?width height?"}} + +test wm-resizable-1.4 {usage} { + list [catch {wm resizable .t bad 0} msg] $msg +} {1 {expected boolean value but got "bad"}} + +test wm-resizable-1.5 {usage} { + list [catch {wm resizable .t 1 bad} msg] $msg +} {1 {expected boolean value but got "bad"}} + +test wm-resizable-2.1 {setting and reading values} { + wm resizable .t 0 1 + set result [wm resizable .t] + wm resizable .t 1 0 + lappend result [wm resizable .t] + wm resizable .t 1 1 + lappend result [wm resizable .t] +} {0 1 {1 0} {1 1}} + + +test wm-sizefrom-1.1 {usage} { + list [catch {wm sizefrom} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-sizefrom-1.2 {usage} { + list [catch {wm sizefrom .t 1 2} msg] $msg +} {1 {wrong # args: should be "wm sizefrom window ?user|program?"}} + +test wm-sizefrom-1.4 {usage} { + list [catch {wm sizefrom .t bad} msg] $msg +} {1 {bad argument "bad": must be program or user}} + +test wm-sizefrom-2.1 {setting and reading values} { + set result [list [wm sizefrom .t]] + wm sizefrom .t user + lappend result [wm sizefrom .t] + wm sizefrom .t program + lappend result [wm sizefrom .t] + wm sizefrom .t {} + lappend result [wm sizefrom .t] +} {{} user program {}} + + + test wm-stackorder-1.1 {usage} { list [catch {wm stackorder} err] $err } {1 {wrong # args: should be "wm option window ?arg ...?"}} test wm-stackorder-1.2 {usage} { list [catch {wm stackorder . _} err] $err -} {1 {wrong # arguments: must be "wm stackorder window ?isabove|isbelow window?"}} +} {1 {wrong # args: should be "wm stackorder window ?isabove|isbelow window?"}} test wm-stackorder-1.3 {usage} { list [catch {wm stackorder . _ _ _} err] $err -} {1 {wrong # arguments: must be "wm stackorder window ?isabove|isbelow window?"}} +} {1 {wrong # args: should be "wm stackorder window ?isabove|isbelow window?"}} test wm-stackorder-1.4 {usage} { list [catch {wm stackorder . is .} err] $err -} {1 {bad argument "is": must be isabove or isbelow}} +} {1 {ambiguous argument "is": must be isabove or isbelow}} test wm-stackorder-1.5 {usage} { list [catch {wm stackorder _} err] $err @@ -299,11 +1103,31 @@ test wm-stackorder-6.1 {An embedded toplevel does not wm stackorder . } {. .real} +stdWindow + +test wm-title-1.1 {usage} { + list [catch {wm title} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-title-1.2 {usage} { + list [catch {wm title . 1 2} msg] $msg +} {1 {wrong # args: should be "wm title window ?newTitle?"}} + +test wm-title-2.1 {setting and reading values} { + destroy .t + toplevel .t + set result [wm title .t] + wm title .t Apa + lappend result [wm title .t] + wm title .t {} + lappend result [wm title .t] +} {t Apa {}} + test wm-transient-1.1 {usage} { catch {destroy .t} ; toplevel .t list [catch {wm transient .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm transient window ?master?"}} +} {1 {wrong # args: should be "wm transient window ?master?"}} test wm-transient-1.2 {usage} { catch {destroy .t} ; toplevel .t @@ -552,7 +1376,7 @@ test wm-state-1.1 {usage} { test wm-state-1.2 {usage} { list [catch {wm state . _ _} err] $err -} {1 {wrong # arguments: must be "wm state window ?state?"}} +} {1 {wrong # args: should be "wm state window ?state?"}} test wm-state-2.1 {initial state} { deleteWindows @@ -689,112 +1513,32 @@ test wm-state-2.17 {state change after map} { } {normal} -test wm-maxsize-1.1 {usage} { - list [catch {wm maxsize} msg] $msg -} {1 {wrong # args: should be "wm option window ?arg ...?"}} - -test wm-maxsize-1.2 {usage} { - list [catch {wm maxsize . a} msg] $msg -} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} - -test wm-maxsize-1.3 {usage} { - list [catch {wm maxsize . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} - -test wm-maxsize-1.4 {usage} { - list [catch {wm maxsize . x 100} msg] $msg -} {1 {expected integer but got "x"}} - -test wm-maxsize-1.5 {usage} { - list [catch {wm maxsize . 100 bogus} msg] $msg -} {1 {expected integer but got "bogus"}} - -test wm-maxsize-1.6 {usage} { - wm maxsize .t 200 150 - wm maxsize .t -} {200 150} - - -test wm-minsize-1.1 {usage} { - list [catch {wm minsize} msg] $msg -} {1 {wrong # args: should be "wm option window ?arg ...?"}} - -test wm-minsize-1.2 {usage} { - list [catch {wm minsize . a} msg] $msg -} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} - -test wm-minsize-1.3 {usage} { - list [catch {wm minsize . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} - -test wm-minsize-1.4 {usage} { - list [catch {wm minsize . x 100} msg] $msg -} {1 {expected integer but got "x"}} - -test wm-minsize-1.5 {usage} { - list [catch {wm minsize . 100 bogus} msg] $msg -} {1 {expected integer but got "bogus"}} - -test wm-minsize-1.6 {usage} { - wm minsize .t 200 150 - wm minsize .t -} {200 150} - - -test wm-deiconify-1.1 {usage} { - list [catch {wm deiconify} err] $err +test wm-withdraw-1.1 {usage} { + list [catch {wm withdraw} err] $err } {1 {wrong # args: should be "wm option window ?arg ...?"}} -test wm-deiconify-1.2 {usage} { - list [catch {wm deiconify . _} err] $err -} {1 {wrong # arguments: must be "wm deiconify window"}} - -test wm-deiconify-1.3 {usage} { - list [catch {wm deiconify _} err] $err -} {1 {bad window path name "_"}} - -test wm-deiconify-2.1 {a window that has never been mapped - should not be mapped by a call to deiconify} { - deleteWindows - toplevel .t - wm deiconify .t - winfo ismapped .t -} 0 - -test wm-deiconify-2.2 {a window that has already been - mapped should be mapped by deiconify} { - deleteWindows - toplevel .t - update idletasks - wm withdraw .t - wm deiconify .t - winfo ismapped .t -} 1 +test wm-withdraw-1.2 {usage} { + list [catch {wm withdraw . _} msg] $msg +} {1 {wrong # args: should be "wm withdraw window"}} -test wm-deiconify-2.3 {geometry for an unmapped window - should not be calculated by a call to deiconify, - it should be done at idle time} { - deleteWindows - set results {} - toplevel .t -width 200 -height 200 - lappend results [wm geometry .t] - wm deiconify .t - lappend results [wm geometry .t] - update idletasks - lappend results [lindex [split \ - [wm geometry .t] +] 0] -} {1x1+0+0 1x1+0+0 200x200} - -test wm-deiconify-2.4 {invoking destroy after a deiconify - should not result in a crash because of a callback - set on the toplevel} { +test wm-withdraw-2.1 {Misc errors} { deleteWindows toplevel .t + toplevel .t2 + wm iconwindow .t .t2 + set result [list [catch {wm withdraw .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't withdraw .t2: it is an icon for .t}} + +test wm-withdraw-3.1 {} { + update + set result {} wm withdraw .t + lappend result [wm state .t] [winfo ismapped .t] wm deiconify .t - destroy .t - update -} {} + lappend result [wm state .t] [winfo ismapped .t] +} {withdrawn 0 normal 1} # FIXME: diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 0de4103..b2521a0 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -1,4 +1,4 @@ -/* +/* * tkUnixWm.c -- * * This module takes care of the interactions between a Tk-based @@ -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.26 2002/06/24 02:17:57 mdejong Exp $ + * RCS: @(#) $Id: tkUnixWm.c,v 1.27 2002/07/25 21:35:23 pspjuth Exp $ */ #include "tkPort.h" @@ -35,7 +35,7 @@ typedef struct ProtocolHandler { * end of list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ char command[4]; /* Tcl command to invoke when a client - * message for this protocol arrives. + * message for this protocol arrives. * The actual size of the structure varies * to accommodate the needs of the actual * command. THIS MUST BE THE LAST FIELD OF @@ -266,7 +266,7 @@ typedef struct TkWmInfo { /* * This module keeps a list of all top-level windows, primarily to - * simplify the job of Tk_CoordsToWindow. The list is called + * simplify the job of Tk_CoordsToWindow. The list is called * firstWmPtr and is stored in the TkDisplay structure. */ @@ -348,6 +348,96 @@ static void WrapperEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); static void WmWaitMapProc _ANSI_ARGS_(( ClientData clientData, XEvent *eventPtr)); + +static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr, + TkWindow *winPtr)); /* *-------------------------------------------------------------- @@ -555,7 +645,7 @@ TkWmMapWindow(winPtr) Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } - + if (wmPtr->masterPtr != NULL) { /* * Don't map a transient if the master is not mapped. @@ -569,7 +659,7 @@ TkWmMapWindow(winPtr) wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window); } } - + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; UpdateHints(winPtr); UpdateWmProtocols(wmPtr); @@ -653,7 +743,7 @@ TkWmUnmapWindow(winPtr) * mapped when in fact it is mapped. I suspect that this has something * to do with the window manager filtering Map events (and possily not * filtering Unmap events?). - */ + */ XUnmapWindow(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window); WaitForMapNotify(winPtr, 0); } @@ -691,7 +781,7 @@ TkWmDeadWindow(winPtr) } else { register WmInfo *prevPtr; - for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ; + for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { panic("couldn't unlink window in TkWmDeadWindow"); @@ -850,7 +940,7 @@ TkWmSetClass(winPtr) /* *---------------------------------------------------------------------- * - * Tk_WmCmd -- + * Tk_WmObjCmd -- * * This procedure is invoked to process the "wm" Tcl command. * See the user documentation for details on what it does. @@ -866,43 +956,58 @@ TkWmSetClass(winPtr) /* ARGSUSED */ int -Tk_WmCmd(clientData, interp, argc, argv) +Tk_WmObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { 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", "iconposition", + "iconwindow", "maxsize", "minsize", "overrideredirect", + "positionfrom", "protocol", "resizable", "sizefrom", + "stackorder", "state", "title", "transient", + "withdraw", (char *) 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_ICONPOSITION, + WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, + WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, + WMOPT_WITHDRAW }; + int index, length; + char *argv1; TkWindow *winPtr; - register WmInfo *wmPtr; - int c; - size_t length; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (argc < 2) { + if (objc < 2) { wrongNumArgs: - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option window ?arg ...?\"", (char *) NULL); + Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?"); return TCL_ERROR; } - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0) + + argv1 = Tcl_GetStringFromObj(objv[1], &length); + if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) && (length >= 3)) { int wmTracing; - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " tracing ?boolean?\"", (char *) NULL); + if ((objc != 2) && (objc != 3)) { + Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } - if (argc == 2) { + if (objc == 2) { Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), + TCL_STATIC); return TCL_OK; } - if (Tcl_GetBoolean(interp, argv[2], &wmTracing) != TCL_OK) { + if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { return TCL_ERROR; } if (wmTracing) { @@ -913,11 +1018,17 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_OK; } - if (argc < 3) { + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + if (objc < 3) { goto wrongNumArgs; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); - if (winPtr == NULL) { + + if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr) + != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(winPtr)) { @@ -925,1275 +1036,2127 @@ Tk_WmCmd(clientData, interp, argc, argv) "\" isn't a top-level window", (char *) NULL); return TCL_ERROR; } - wmPtr = winPtr->wmInfoPtr; - if ((c == 'a') && (strncmp(argv[1], "aspect", length) == 0) - && (length >= 2)) { - int numer1, denom1, numer2, denom2; - - if ((argc != 3) && (argc != 7)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " aspect window ?minNumer minDenom ", - "maxNumer maxDenom?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~PAspect; - } else { - if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) { - return TCL_ERROR; - } - if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || - (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", - TCL_STATIC); - return TCL_ERROR; - } - wmPtr->minAspect.x = numer1; - wmPtr->minAspect.y = denom1; - wmPtr->maxAspect.x = numer2; - wmPtr->maxAspect.y = denom2; - wmPtr->sizeHintsFlags |= PAspect; + + switch ((enum options) index) { + case WMOPT_ASPECT: + return WmAspectCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ATTRIBUTES: + return WmAttributesCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_CLIENT: + return WmClientCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_COLORMAPWINDOWS: + return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_COMMAND: + return WmCommandCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_DEICONIFY: + return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FOCUSMODEL: + return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FRAME: + return WmFrameCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GEOMETRY: + return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GRID: + return WmGridCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GROUP: + return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBITMAP: + return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONIFY: + return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONMASK: + return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONNAME: + return WmIconnameCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONPOSITION: + return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONWINDOW: + return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MAXSIZE: + return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MINSIZE: + return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_OVERRIDEREDIRECT: + return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_POSITIONFROM: + return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_PROTOCOL: + return WmProtocolCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_RESIZABLE: + return WmResizableCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_SIZEFROM: + return WmSizefromCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_STACKORDER: + return WmStackorderCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_STATE: + return WmStateCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_TITLE: + return WmTitleCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_TRANSIENT: + return WmTransientCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_WITHDRAW: + return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv); + } + + /* This should not happen */ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * WmAspectCmd -- + * + * This procedure is invoked to process the "wm aspect" 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 +WmAspectCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int numer1, denom1, numer2, denom2; + + if ((objc != 3) && (objc != 7)) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?minNumer minDenom maxNumer maxDenom?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & PAspect) { + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, + wmPtr->minAspect.y, wmPtr->maxAspect.x, + wmPtr->maxAspect.y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 'a') && (strncmp(argv[1], "attributes", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " attributes window\"", (char *) NULL); + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~PAspect; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) { return TCL_ERROR; } - } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " client window ?name?\"", - (char *) NULL); + if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || + (denom2 <= 0)) { + Tcl_SetResult(interp, "aspect number can't be <= 0", + TCL_STATIC); return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); - } - return TCL_OK; - } - if (argv[3][0] == 0) { - if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); - wmPtr->clientMachine = NULL; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, - "WM_CLIENT_MACHINE")); - } - } - return TCL_OK; + wmPtr->minAspect.x = numer1; + wmPtr->minAspect.y = denom1; + wmPtr->maxAspect.x = numer2; + wmPtr->maxAspect.y = denom2; + wmPtr->sizeHintsFlags |= PAspect; + } + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmAttributesCmd -- + * + * This procedure is invoked to process the "wm attributes" 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 +WmAttributesCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmClientCmd -- + * + * This procedure is invoked to process the "wm client" 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 +WmClientCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->clientMachine != NULL) { + Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } + return TCL_OK; + } + argv3 = Tcl_GetStringFromObj(objv[3], &length); + if (argv3[0] == 0) { if (wmPtr->clientMachine != NULL) { ckfree((char *) wmPtr->clientMachine); - } - wmPtr->clientMachine = (char *) - ckalloc((unsigned) (strlen(argv[3]) + 1)); - strcpy(wmPtr->clientMachine, argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XTextProperty textProp; - Tcl_DString ds; - - Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); - if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, - &textProp) != 0) { - XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, - &textProp); - XFree((char *) textProp.value); + wmPtr->clientMachine = NULL; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, + Tk_InternAtom((Tk_Window) winPtr, + "WM_CLIENT_MACHINE")); } - Tcl_DStringFree(&ds); } - } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0) - && (length >= 3)) { - Window *cmapList; - TkWindow *winPtr2; - int count, i, windowArgc, gotToplevel; - CONST char **windowArgv; - char buffer[20]; + return TCL_OK; + } + if (wmPtr->clientMachine != NULL) { + ckfree((char *) wmPtr->clientMachine); + } + wmPtr->clientMachine = (char *) + ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->clientMachine, argv3); + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XTextProperty textProp; + Tcl_DString ds; - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " colormapwindows window ?windowList?\"", - (char *) NULL); - return TCL_ERROR; - } - Tk_MakeWindowExist((Tk_Window) winPtr); - if (wmPtr->wrapperPtr == NULL) { - CreateWrapper(wmPtr); + Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, + &textProp) != 0) { + XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, + &textProp); + XFree((char *) textProp.value); } - if (argc == 3) { - if (XGetWMColormapWindows(winPtr->display, - wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { - return TCL_OK; - } - for (i = 0; i < count; i++) { - if ((i == (count-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { - break; - } - winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, - cmapList[i]); - if (winPtr2 == NULL) { - sprintf(buffer, "0x%lx", cmapList[i]); - Tcl_AppendElement(interp, buffer); - } else { - Tcl_AppendElement(interp, winPtr2->pathName); - } - } - XFree((char *) cmapList); + Tcl_DStringFree(&ds); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmColormapwindowsCmd -- + * + * This procedure is invoked to process the "wm colormapwindows" + * 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 +WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Window *cmapList; + TkWindow *winPtr2; + int count, i, windowObjc, gotToplevel; + Tcl_Obj **windowObjv; + char buffer[20]; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); + return TCL_ERROR; + } + Tk_MakeWindowExist((Tk_Window) winPtr); + if (wmPtr->wrapperPtr == NULL) { + CreateWrapper(wmPtr); + } + if (objc == 3) { + if (XGetWMColormapWindows(winPtr->display, + wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { return TCL_OK; } - if (Tcl_SplitList(interp, argv[3], &windowArgc, &windowArgv) - != TCL_OK) { - return TCL_ERROR; - } - cmapList = (Window *) ckalloc((unsigned) - ((windowArgc+1)*sizeof(Window))); - gotToplevel = 0; - for (i = 0; i < windowArgc; i++) { - winPtr2 = (TkWindow *) Tk_NameToWindow(interp, windowArgv[i], - tkwin); - if (winPtr2 == NULL) { - ckfree((char *) cmapList); - ckfree((char *) windowArgv); - return TCL_ERROR; - } - if (winPtr2 == winPtr) { - gotToplevel = 1; + for (i = 0; i < count; i++) { + if ((i == (count-1)) + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + break; } - if (winPtr2->window == None) { - Tk_MakeWindowExist((Tk_Window) winPtr2); + winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, + cmapList[i]); + if (winPtr2 == NULL) { + sprintf(buffer, "0x%lx", cmapList[i]); + Tcl_AppendElement(interp, buffer); + } else { + Tcl_AppendElement(interp, winPtr2->pathName); } - cmapList[i] = winPtr2->window; } - if (!gotToplevel) { - wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP; - cmapList[windowArgc] = wmPtr->wrapperPtr->window; - windowArgc++; - } else { - wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP; - } - wmPtr->flags |= WM_COLORMAPS_EXPLICIT; - XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window, - cmapList, windowArgc); - ckfree((char *) cmapList); - ckfree((char *) windowArgv); + XFree((char *) cmapList); return TCL_OK; - } else if ((c == 'c') && (strncmp(argv[1], "command", length) == 0) - && (length >= 3)) { - int cmdArgc; - CONST char **cmdArgv; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " command window ?value?\"", - (char *) NULL); + } + if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) + != TCL_OK) { + return TCL_ERROR; + } + cmapList = (Window *) ckalloc((unsigned) + ((windowObjc+1)*sizeof(Window))); + gotToplevel = 0; + for (i = 0; i < windowObjc; i++) { + if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], + (Tk_Window *) &winPtr2) != TCL_OK) + { + ckfree((char *) cmapList); return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->cmdArgv != NULL) { - Tcl_SetResult(interp, - Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), - TCL_DYNAMIC); - } - return TCL_OK; + if (winPtr2 == winPtr) { + gotToplevel = 1; } - if (argv[3][0] == 0) { - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); - wmPtr->cmdArgv = NULL; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND")); - } - } - return TCL_OK; + if (winPtr2->window == None) { + Tk_MakeWindowExist((Tk_Window) winPtr2); } - if (Tcl_SplitList(interp, argv[3], &cmdArgc, &cmdArgv) != TCL_OK) { - return TCL_ERROR; + cmapList[i] = winPtr2->window; + } + if (!gotToplevel) { + wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP; + cmapList[windowObjc] = wmPtr->wrapperPtr->window; + windowObjc++; + } else { + wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP; + } + wmPtr->flags |= WM_COLORMAPS_EXPLICIT; + XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window, + cmapList, windowObjc); + ckfree((char *) cmapList); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmCommandCmd -- + * + * This procedure is invoked to process the "wm command" 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 +WmCommandCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int cmdArgc; + CONST char **cmdArgv; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->cmdArgv != NULL) { + Tcl_SetResult(interp, + Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), + TCL_DYNAMIC); } + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (argv3[0] == 0) { if (wmPtr->cmdArgv != NULL) { ckfree((char *) wmPtr->cmdArgv); - } - wmPtr->cmdArgc = cmdArgc; - wmPtr->cmdArgv = cmdArgv; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - UpdateCommand(winPtr); - } - } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " deiconify window\"", (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { - wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; - } - (void) TkpWmSetState(winPtr, NormalState); - } else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " focusmodel window ?active|passive?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); - return TCL_OK; - } - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) { - wmPtr->hints.input = False; - } else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) { - wmPtr->hints.input = True; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be active or passive", (char *) NULL); - return TCL_ERROR; - } - UpdateHints(winPtr); - } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0) - && (length >= 2)) { - Window window; - char buf[TCL_INTEGER_SPACE]; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " frame window\"", (char *) NULL); - return TCL_ERROR; - } - window = wmPtr->reparent; - if (window == None) { - window = Tk_WindowId((Tk_Window) winPtr); - } - sprintf(buf, "0x%x", (unsigned int) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0) - && (length >= 2)) { - char xSign, ySign; - int width, height; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " geometry window ?newGeometry?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; - ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; - if (wmPtr->gridWin != NULL) { - width = wmPtr->reqGridWidth + (winPtr->changes.width - - winPtr->reqWidth)/wmPtr->widthInc; - height = wmPtr->reqGridHeight + (winPtr->changes.height - - winPtr->reqHeight)/wmPtr->heightInc; - } else { - width = winPtr->changes.width; - height = winPtr->changes.height; + wmPtr->cmdArgv = NULL; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, + Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND")); } - sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, - ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->width = -1; - wmPtr->height = -1; - goto updateGeom; } - return ParseGeometry(interp, argv[3], winPtr); - } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0) - && (length >= 3)) { - int reqWidth, reqHeight, widthInc, heightInc; + return TCL_OK; + } + if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) { + return TCL_ERROR; + } + if (wmPtr->cmdArgv != NULL) { + ckfree((char *) wmPtr->cmdArgv); + } + wmPtr->cmdArgc = cmdArgc; + wmPtr->cmdArgv = cmdArgv; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + UpdateCommand(winPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmDeiconifyCmd -- + * + * This procedure is invoked to process the "wm deiconify" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 7)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " grid window ?baseWidth baseHeight ", - "widthInc heightInc?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; +static int +WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - /* - * Turn off gridding and reset the width and height - * to make sense as ungridded numbers. - */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } + if (winPtr->flags & TK_EMBEDDED) { + Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, + ": it is an embedded window", (char *) NULL); + return TCL_ERROR; + } + if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { + wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; + } + TkpWmSetState(winPtr, NormalState); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmFocusmodelCmd -- + * + * This procedure is invoked to process the "wm focusmodel" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); - if (wmPtr->width != -1) { - wmPtr->width = winPtr->reqWidth + (wmPtr->width - - wmPtr->reqGridWidth)*wmPtr->widthInc; - wmPtr->height = winPtr->reqHeight + (wmPtr->height - - wmPtr->reqGridHeight)*wmPtr->heightInc; - } - wmPtr->widthInc = 1; - wmPtr->heightInc = 1; +static int +WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "active", "passive", (char *) NULL }; + enum options { + OPT_ACTIVE, OPT_PASSIVE }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), + TCL_STATIC); + return TCL_OK; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (index == OPT_ACTIVE) { + wmPtr->hints.input = False; + } else { /* OPT_PASSIVE */ + wmPtr->hints.input = True; + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmFrameCmd -- + * + * This procedure is invoked to process the "wm frame" 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 +WmFrameCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Window window; + char buf[TCL_INTEGER_SPACE]; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + window = wmPtr->reparent; + if (window == None) { + window = Tk_WindowId((Tk_Window) winPtr); + } + sprintf(buf, "0x%x", (unsigned int) window); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmGeometryCmd -- + * + * This procedure is invoked to process the "wm geometry" 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 +WmGeometryCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char xSign, ySign; + int width, height; + char *argv3; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[16 + TCL_INTEGER_SPACE * 4]; + + xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; + ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; + if (wmPtr->gridWin != NULL) { + width = wmPtr->reqGridWidth + (winPtr->changes.width + - winPtr->reqWidth)/wmPtr->widthInc; + height = wmPtr->reqGridHeight + (winPtr->changes.height + - winPtr->reqHeight)/wmPtr->heightInc; } else { - if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) { - return TCL_ERROR; - } - if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (widthInc < 0) { - Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (heightInc < 0) { - Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, - heightInc); + width = winPtr->changes.width; + height = winPtr->changes.height; } - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0) - && (length >= 3)) { - Tk_Window tkwin2; - WmInfo *wmPtr2; + sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, + ySign, wmPtr->y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (*argv3 == '\0') { + wmPtr->width = -1; + wmPtr->height = -1; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; + } + return ParseGeometry(interp, argv3, winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * WmGridCmd -- + * + * This procedure is invoked to process the "wm grid" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " group window ?pathName?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~WindowGroupHint; - if (wmPtr->leaderName != NULL) { - ckfree(wmPtr->leaderName); - } - wmPtr->leaderName = NULL; - } else { - tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin); - if (tkwin2 == NULL) { - return TCL_ERROR; - } - while (!Tk_TopWinHierarchy(tkwin2)) { - /* - * Ensure that the group leader is actually a Tk toplevel. - */ +static int +WmGridCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int reqWidth, reqHeight, widthInc, heightInc; - tkwin2 = Tk_Parent(tkwin2); - } - Tk_MakeWindowExist(tkwin2); - wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; - if (wmPtr2->wrapperPtr == NULL) { - CreateWrapper(wmPtr2); - } - if (wmPtr->leaderName != NULL) { - ckfree(wmPtr->leaderName); - } - wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr); - wmPtr->hints.flags |= WindowGroupHint; - wmPtr->leaderName = ckalloc((unsigned) (strlen(argv[3])+1)); - strcpy(wmPtr->leaderName, argv[3]); - } - UpdateHints(winPtr); - } else if ((c == 'i') && (strncmp(argv[1], "iconbitmap", length) == 0) - && (length >= 5)) { - Pixmap pixmap; + if ((objc != 3) && (objc != 7)) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?baseWidth baseHeight widthInc heightInc?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & PBaseSize) { + char buf[TCL_INTEGER_SPACE * 4]; - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconbitmap window ?bitmap?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, - Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), - TCL_STATIC); - } - return TCL_OK; + sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, + wmPtr->reqGridHeight, wmPtr->widthInc, + wmPtr->heightInc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } - if (*argv[3] == '\0') { - if (wmPtr->hints.icon_pixmap != None) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); - wmPtr->hints.icon_pixmap = None; - } - wmPtr->hints.flags &= ~IconPixmapHint; - } else { - pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, - Tk_GetUid(argv[3])); - if (pixmap == None) { - return TCL_ERROR; - } - wmPtr->hints.icon_pixmap = pixmap; - wmPtr->hints.flags |= IconPixmapHint; + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + /* + * Turn off gridding and reset the width and height + * to make sense as ungridded numbers. + */ + + wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); + if (wmPtr->width != -1) { + wmPtr->width = winPtr->reqWidth + (wmPtr->width + - wmPtr->reqGridWidth)*wmPtr->widthInc; + wmPtr->height = winPtr->reqHeight + (wmPtr->height + - wmPtr->reqGridHeight)*wmPtr->heightInc; } - UpdateHints(winPtr); - } else if ((c == 'i') && (strncmp(argv[1], "iconify", length) == 0) - && (length >= 5)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconify window\"", (char *) NULL); + wmPtr->widthInc = 1; + wmPtr->heightInc = 1; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) { return TCL_ERROR; } - if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", (char *) NULL); + if (reqWidth < 0) { + Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } - if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", (char *) NULL); + if (reqHeight < 0) { + Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); return TCL_ERROR; } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); + if (widthInc < 0) { + Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); return TCL_ERROR; } - if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, - "couldn't send iconify message to window manager", - TCL_STATIC); + if (heightInc < 0) { + Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); return TCL_ERROR; } - } else if ((c == 'i') && (strncmp(argv[1], "iconmask", length) == 0) - && (length >= 5)) { - Pixmap pixmap; + Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, + heightInc); + } + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmGroupCmd -- + * + * This procedure is invoked to process the "wm group" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconmask window ?bitmap?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, - Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); - } - return TCL_OK; +static int +WmGroupCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Tk_Window tkwin2; + WmInfo *wmPtr2; + char *argv3; + int length; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & WindowGroupHint) { + Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } - if (*argv[3] == '\0') { - if (wmPtr->hints.icon_mask != None) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); - } - wmPtr->hints.flags &= ~IconMaskHint; - } else { - pixmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid(argv[3])); - if (pixmap == None) { - return TCL_ERROR; - } - wmPtr->hints.icon_mask = pixmap; - wmPtr->hints.flags |= IconMaskHint; + return TCL_OK; + } + argv3 = Tcl_GetStringFromObj(objv[3], &length); + if (*argv3 == '\0') { + wmPtr->hints.flags &= ~WindowGroupHint; + if (wmPtr->leaderName != NULL) { + ckfree(wmPtr->leaderName); } - UpdateHints(winPtr); - } else if ((c == 'i') && (strncmp(argv[1], "iconname", length) == 0) - && (length >= 5)) { - if (argc > 4) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconname window ?newName?\"", (char *) NULL); + wmPtr->leaderName = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } - if (argc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); - return TCL_OK; - } else { - if (wmPtr->iconName != NULL) { - ckfree((char *) wmPtr->iconName); - } - wmPtr->iconName = ckalloc((unsigned) (strlen(argv[3]) + 1)); - strcpy(wmPtr->iconName, argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - Tcl_DString ds; + while (!Tk_TopWinHierarchy(tkwin2)) { + /* + * Ensure that the group leader is actually a Tk toplevel. + */ - Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds); - XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, - Tcl_DStringValue(&ds)); - Tcl_DStringFree(&ds); - } + tkwin2 = Tk_Parent(tkwin2); } - } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0) - && (length >= 5)) { - int x, y; - - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconposition window ?x y?\"", - (char *) NULL); - return TCL_ERROR; + Tk_MakeWindowExist(tkwin2); + wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; + if (wmPtr2->wrapperPtr == NULL) { + CreateWrapper(wmPtr2); + } + if (wmPtr->leaderName != NULL) { + ckfree(wmPtr->leaderName); } - if (argc == 3) { - if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr); + wmPtr->hints.flags |= WindowGroupHint; + wmPtr->leaderName = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->leaderName, argv3); + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconbitmapCmd -- + * + * This procedure is invoked to process the "wm iconbitmap" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; +static int +WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Pixmap pixmap; + char *argv3; + + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & IconPixmapHint) { + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), + TCL_STATIC); } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~IconPositionHint; - } else { - if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){ - return TCL_ERROR; - } - wmPtr->hints.icon_x = x; - wmPtr->hints.icon_y = y; - wmPtr->hints.flags |= IconPositionHint; + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (*argv3 == '\0') { + if (wmPtr->hints.icon_pixmap != None) { + Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); + wmPtr->hints.icon_pixmap = None; } - UpdateHints(winPtr); - } else if ((c == 'i') && (strncmp(argv[1], "iconwindow", length) == 0) - && (length >= 5)) { - Tk_Window tkwin2; - WmInfo *wmPtr2; - XSetWindowAttributes atts; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconwindow window ?pathName?\"", - (char *) NULL); + wmPtr->hints.flags &= ~IconPixmapHint; + } else { + pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, argv3); + if (pixmap == None) { return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~IconWindowHint; - if (wmPtr->icon != NULL) { - /* - * Remove the icon window relationship. In principle we - * should also re-enable button events for the window, but - * this doesn't work in general because the window manager - * is probably selecting on them (we'll get an error if - * we try to re-enable the events). So, just leave the - * icon window event-challenged; the user will have to - * recreate it if they want button events. - */ + wmPtr->hints.icon_pixmap = pixmap; + wmPtr->hints.flags |= IconPixmapHint; + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconifyCmd -- + * + * This procedure is invoked to process the "wm iconify" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; - wmPtr2->iconFor = NULL; - wmPtr2->withdrawn = 1; - wmPtr2->hints.initial_state = WithdrawnState; - } - wmPtr->icon = NULL; - } else { - tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin); - if (tkwin2 == NULL) { - return TCL_ERROR; - } - if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", argv[3], - " as icon window: not at top level", (char *) NULL); - return TCL_ERROR; - } - wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; - if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, argv[3], " is already an icon for ", - Tk_PathName(wmPtr2->iconFor), (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->icon != NULL) { - WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; - wmPtr3->iconFor = NULL; - wmPtr3->withdrawn = 1; - wmPtr3->hints.initial_state = WithdrawnState; - } +static int +WmIconifyCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { + Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, + "\": override-redirect flag is set", (char *) NULL); + return TCL_ERROR; + } + if (wmPtr->masterPtr != NULL) { + Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, + "\": it is a transient", (char *) NULL); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } + if (winPtr->flags & TK_EMBEDDED) { + Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, + ": it is an embedded window", (char *) NULL); + return TCL_ERROR; + } + if (TkpWmSetState(winPtr, IconicState) == 0) { + Tcl_SetResult(interp, + "couldn't send iconify message to window manager", + TCL_STATIC); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconmaskCmd -- + * + * This procedure is invoked to process the "wm iconmask" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - /* - * Disable button events in the icon window: some window - * managers (like olvwm) want to get the events themselves, - * but X only allows one application at a time to receive - * button events for a window. - */ +static int +WmIconmaskCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Pixmap pixmap; + char *argv3; - atts.event_mask = Tk_Attributes(tkwin2)->event_mask - & ~ButtonPressMask; - Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts); - Tk_MakeWindowExist(tkwin2); - if (wmPtr2->wrapperPtr == NULL) { - CreateWrapper(wmPtr2); - } - wmPtr->hints.icon_window = Tk_WindowId(wmPtr2->wrapperPtr); - wmPtr->hints.flags |= IconWindowHint; - wmPtr->icon = tkwin2; - wmPtr2->iconFor = (Tk_Window) winPtr; - if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) { - wmPtr2->withdrawn = 0; - if (XWithdrawWindow(Tk_Display(tkwin2), - Tk_WindowId(wmPtr2->wrapperPtr), - Tk_ScreenNumber(tkwin2)) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); - return TCL_ERROR; - } - WaitForMapNotify((TkWindow *) tkwin2, 0); - } - } - UpdateHints(winPtr); - } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0) - && (length >= 2)) { - int width, height; - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " maxsize window ?width height?\"", (char *) NULL); - return TCL_ERROR; + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & IconMaskHint) { + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + TCL_STATIC); } - if (argc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; - - GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (*argv3 == '\0') { + if (wmPtr->hints.icon_mask != None) { + Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); } - if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) { + wmPtr->hints.flags &= ~IconMaskHint; + } else { + pixmap = Tk_GetBitmap(interp, tkwin, argv3); + if (pixmap == None) { return TCL_ERROR; } - wmPtr->maxWidth = width; - wmPtr->maxHeight = height; - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0) - && (length >= 2)) { - int width, height; - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " minsize window ?width height?\"", (char *) NULL); - return TCL_ERROR; + wmPtr->hints.icon_mask = pixmap; + wmPtr->hints.flags |= IconMaskHint; + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconnameCmd -- + * + * This procedure is invoked to process the "wm iconname" 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 +WmIconnameCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; + + if (objc > 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, + ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + TCL_STATIC); + return TCL_OK; + } else { + if (wmPtr->iconName != NULL) { + ckfree((char *) wmPtr->iconName); } - if (argc == 3) { + argv3 = Tcl_GetStringFromObj(objv[3], &length); + wmPtr->iconName = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->iconName, argv3); + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + Tcl_DString ds; + + Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds); + XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, + Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconpositionCmd -- + * + * This procedure is invoked to process the "wm iconposition" + * 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 +WmIconpositionCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int x, y; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & IconPositionHint) { char buf[TCL_INTEGER_SPACE * 2]; - sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); + sprintf(buf, "%d %d", wmPtr->hints.icon_x, + wmPtr->hints.icon_y); Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; } - if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) { - return TCL_ERROR; - } - wmPtr->minWidth = width; - wmPtr->minHeight = height; - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 'o') - && (strncmp(argv[1], "overrideredirect", length) == 0)) { - int boolean, curValue; - XSetWindowAttributes atts; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " overrideredirect window ?boolean?\"", - (char *) NULL); + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->hints.flags &= ~IconPositionHint; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ return TCL_ERROR; } - curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; - if (argc == 3) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); - return TCL_OK; - } - if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) { - return TCL_ERROR; + wmPtr->hints.icon_x = x; + wmPtr->hints.icon_y = y; + wmPtr->hints.flags |= IconPositionHint; + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconwindowCmd -- + * + * This procedure is invoked to process the "wm iconwindow" 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 +WmIconwindowCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Tk_Window tkwin2; + WmInfo *wmPtr2; + XSetWindowAttributes atts; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->icon != NULL) { + Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } - if (curValue != boolean) { + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->hints.flags &= ~IconWindowHint; + if (wmPtr->icon != NULL) { /* - * Only do this if we are really changing value, because it - * causes some funky stuff to occur + * Remove the icon window relationship. In principle we + * should also re-enable button events for the window, but + * this doesn't work in general because the window manager + * is probably selecting on them (we'll get an error if + * we try to re-enable the events). So, just leave the + * icon window event-challenged; the user will have to + * recreate it if they want button events. */ - atts.override_redirect = (boolean) ? True : False; - Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, - &atts); - if (winPtr->wmInfoPtr->wrapperPtr != NULL) { - Tk_ChangeWindowAttributes( - (Tk_Window) winPtr->wmInfoPtr->wrapperPtr, - CWOverrideRedirect, &atts); - } + + wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr2->iconFor = NULL; + wmPtr2->withdrawn = 1; + wmPtr2->hints.initial_state = WithdrawnState; } - } else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " positionfrom window ?user/program?\"", - (char *) NULL); + wmPtr->icon = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); - } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); - } else { - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) { - wmPtr->sizeHintsFlags &= ~PPosition; - wmPtr->sizeHintsFlags |= USPosition; - } else if ((c == 'p') && (strncmp(argv[3], "program", length) == 0)) { - wmPtr->sizeHintsFlags &= ~USPosition; - wmPtr->sizeHintsFlags |= PPosition; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be program or user", (char *) NULL); - return TCL_ERROR; - } - } - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0) - && (length >= 2)) { - register ProtocolHandler *protPtr, *prevPtr; - Atom protocol; - int cmdLength; - - if ((argc < 3) || (argc > 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " protocol window ?name? ?command?\"", - (char *) NULL); + if (!Tk_IsTopLevel(tkwin2)) { + Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), + " as icon window: not at top level", (char *) NULL); return TCL_ERROR; } - if (argc == 3) { - /* - * Return a list of all defined protocols for the window. - */ - for (protPtr = wmPtr->protPtr; protPtr != NULL; - protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); - } - return TCL_OK; + wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; + if (wmPtr2->iconFor != NULL) { + Tcl_AppendResult(interp, Tcl_GetString(objv[3]), + " is already an icon for ", + Tk_PathName(wmPtr2->iconFor), (char *) NULL); + return TCL_ERROR; } - protocol = Tk_InternAtom((Tk_Window) winPtr, argv[3]); - if (argc == 4) { - /* - * Return the command to handle a given protocol. - */ - for (protPtr = wmPtr->protPtr; protPtr != NULL; - protPtr = protPtr->nextPtr) { - if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); - return TCL_OK; - } - } - return TCL_OK; + if (wmPtr->icon != NULL) { + WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr3->iconFor = NULL; + wmPtr3->withdrawn = 1; + wmPtr3->hints.initial_state = WithdrawnState; } /* - * Delete any current protocol handler, then create a new - * one with the specified command, unless the command is - * empty. + * Disable button events in the icon window: some window + * managers (like olvwm) want to get the events themselves, + * but X only allows one application at a time to receive + * button events for a window. */ - for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL; - prevPtr = protPtr, protPtr = protPtr->nextPtr) { - if (protPtr->protocol == protocol) { - if (prevPtr == NULL) { - wmPtr->protPtr = protPtr->nextPtr; - } else { - prevPtr->nextPtr = protPtr->nextPtr; - } - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); - break; + atts.event_mask = Tk_Attributes(tkwin2)->event_mask + & ~ButtonPressMask; + Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts); + Tk_MakeWindowExist(tkwin2); + if (wmPtr2->wrapperPtr == NULL) { + CreateWrapper(wmPtr2); + } + wmPtr->hints.icon_window = Tk_WindowId(wmPtr2->wrapperPtr); + wmPtr->hints.flags |= IconWindowHint; + wmPtr->icon = tkwin2; + wmPtr2->iconFor = (Tk_Window) winPtr; + if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) { + wmPtr2->withdrawn = 0; + if (XWithdrawWindow(Tk_Display(tkwin2), + Tk_WindowId(wmPtr2->wrapperPtr), + Tk_ScreenNumber(tkwin2)) == 0) { + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); + return TCL_ERROR; } + WaitForMapNotify((TkWindow *) tkwin2, 0); } - cmdLength = strlen(argv[4]); - if (cmdLength > 0) { - protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); - protPtr->protocol = protocol; - protPtr->nextPtr = wmPtr->protPtr; - wmPtr->protPtr = protPtr; - protPtr->interp = interp; - strcpy(protPtr->command, argv[4]); - } - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - UpdateWmProtocols(wmPtr); - } - } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) { - int width, height; + } + UpdateHints(winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmMaxsizeCmd -- + * + * This procedure is invoked to process the "wm maxsize" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " resizable window ?width height?\"", - (char *) NULL); - return TCL_ERROR; +static int +WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + GetMaxSize(wmPtr, &width, &height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + wmPtr->maxWidth = width; + wmPtr->maxHeight = height; + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmMinsizeCmd -- + * + * This procedure is invoked to process the "wm minsize" 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 +WmMinsizeCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + wmPtr->minWidth = width; + wmPtr->minHeight = height; + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmOverrideredirectCmd -- + * + * This procedure is invoked to process the "wm overrideredirect" + * 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 +WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int boolean, curValue; + XSetWindowAttributes atts; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); + return TCL_ERROR; + } + curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; + if (objc == 3) { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); + return TCL_OK; + } + if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { + return TCL_ERROR; + } + if (curValue != boolean) { + /* + * Only do this if we are really changing value, because it + * causes some funky stuff to occur + */ + atts.override_redirect = (boolean) ? True : False; + Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, + &atts); + if (winPtr->wmInfoPtr->wrapperPtr != NULL) { + Tk_ChangeWindowAttributes( + (Tk_Window) winPtr->wmInfoPtr->wrapperPtr, + CWOverrideRedirect, &atts); } - if (argc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmPositionfromCmd -- + * + * This procedure is invoked to process the "wm positionfrom" + * Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; +static int +WmPositionfromCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "program", "user", (char *) NULL }; + enum options { + OPT_PROGRAM, OPT_USER }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & USPosition) { + Tcl_SetResult(interp, "user", TCL_STATIC); + } else if (wmPtr->sizeHintsFlags & PPosition) { + Tcl_SetResult(interp, "program", TCL_STATIC); } - if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) { + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); + } else { + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } - if (width) { - wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE; - } else { - wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE; - } - if (height) { - wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE; + if (index == OPT_USER) { + wmPtr->sizeHintsFlags &= ~PPosition; + wmPtr->sizeHintsFlags |= USPosition; } else { - wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; + wmPtr->sizeHintsFlags &= ~USPosition; + wmPtr->sizeHintsFlags |= PPosition; } - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " sizefrom window ?user|program?\"", - (char *) NULL); - return TCL_ERROR; + } + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmProtocolCmd -- + * + * This procedure is invoked to process the "wm protocol" 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 +WmProtocolCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + register ProtocolHandler *protPtr, *prevPtr; + Atom protocol; + char *cmd; + int cmdLength; + + if ((objc < 3) || (objc > 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); + return TCL_ERROR; + } + if (objc == 3) { + /* + * Return a list of all defined protocols for the window. + */ + for (protPtr = wmPtr->protPtr; protPtr != NULL; + protPtr = protPtr->nextPtr) { + Tcl_AppendElement(interp, + Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); - } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + return TCL_OK; + } + protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); + if (objc == 4) { + /* + * Return the command to handle a given protocol. + */ + for (protPtr = wmPtr->protPtr; protPtr != NULL; + protPtr = protPtr->nextPtr) { + if (protPtr->protocol == protocol) { + Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + return TCL_OK; } - return TCL_OK; } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~(USSize|PSize); - } else { - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) { - wmPtr->sizeHintsFlags &= ~PSize; - wmPtr->sizeHintsFlags |= USSize; - } else if ((c == 'p') - && (strncmp(argv[3], "program", length) == 0)) { - wmPtr->sizeHintsFlags &= ~USSize; - wmPtr->sizeHintsFlags |= PSize; + return TCL_OK; + } + + /* + * Delete any current protocol handler, then create a new + * one with the specified command, unless the command is + * empty. + */ + + for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL; + prevPtr = protPtr, protPtr = protPtr->nextPtr) { + if (protPtr->protocol == protocol) { + if (prevPtr == NULL) { + wmPtr->protPtr = protPtr->nextPtr; } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be program or user", (char *) NULL); - return TCL_ERROR; + prevPtr->nextPtr = protPtr->nextPtr; } + Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + break; } - wmPtr->flags |= WM_UPDATE_SIZE_HINTS; - goto updateGeom; - } else if ((c == 's') && (strncmp(argv[1], "stackorder", length) == 0) - && (length >= 2)) { - TkWindow **windows, **window_ptr; - - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], - " stackorder window ?isabove|isbelow window?\"", - (char *) NULL); + } + cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); + if (cmdLength > 0) { + protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); + protPtr->protocol = protocol; + protPtr->nextPtr = wmPtr->protPtr; + wmPtr->protPtr = protPtr; + protPtr->interp = interp; + strcpy(protPtr->command, cmd); + } + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + UpdateWmProtocols(wmPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmResizableCmd -- + * + * This procedure is invoked to process the "wm resizable" 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 +WmResizableCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", + (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, + (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + if (width) { + wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE; + } else { + wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE; + } + if (height) { + wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE; + } else { + wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; + } + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmSizefromCmd -- + * + * This procedure is invoked to process the "wm sizefrom" 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 +WmSizefromCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "program", "user", (char *) NULL }; + enum options { + OPT_PROGRAM, OPT_USER }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & USSize) { + Tcl_SetResult(interp, "user", TCL_STATIC); + } else if (wmPtr->sizeHintsFlags & PSize) { + Tcl_SetResult(interp, "program", TCL_STATIC); + } + return TCL_OK; + } + + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~(USSize|PSize); + } else { + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } + if (index == OPT_USER) { + wmPtr->sizeHintsFlags &= ~PSize; + wmPtr->sizeHintsFlags |= USSize; + } else { /* OPT_PROGRAM */ + wmPtr->sizeHintsFlags &= ~USSize; + wmPtr->sizeHintsFlags |= PSize; + } + } + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmStackorderCmd -- + * + * This procedure is invoked to process the "wm stackorder" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if (argc == 3) { - windows = TkWmStackorderToplevel(winPtr); - if (windows == NULL) { - panic("TkWmStackorderToplevel failed"); - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); - } - ckfree((char *) windows); - return TCL_OK; - } - } else { - TkWindow *winPtr2; - int index1=-1, index2=-1, result; +static int +WmStackorderCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + TkWindow **windows, **window_ptr; + static CONST char *optionStrings[] = { + "isabove", "isbelow", (char *) NULL }; + enum options { + OPT_ISABOVE, OPT_ISBELOW }; + int index; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?"); + return TCL_ERROR; + } - winPtr2 = (TkWindow *) Tk_NameToWindow(interp, argv[4], tkwin); - if (winPtr2 == NULL) { - return TCL_ERROR; + if (objc == 3) { + windows = TkWmStackorderToplevel(winPtr); + if (windows == NULL) { + panic("TkWmStackorderToplevel failed"); + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + Tcl_AppendElement(interp, (*window_ptr)->pathName); } + ckfree((char *) windows); + return TCL_OK; + } + } else { + TkWindow *winPtr2; + int index1=-1, index2=-1, result; - if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) + != TCL_OK) { + return TCL_ERROR; + } + + if (!Tk_IsTopLevel(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't a top-level window", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, + if (!Tk_IsMapped(winPtr)) { + Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't mapped", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + if (!Tk_IsMapped(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't mapped", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - /* - * Lookup stacking order of all toplevels that are children - * of "." and find the position of winPtr and winPtr2 - * in the stacking order. - */ + /* + * Lookup stacking order of all toplevels that are children + * of "." and find the position of winPtr and winPtr2 + * in the stacking order. + */ - windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); + windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); - if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", + if (windows == NULL) { + Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", (char *) NULL); - return TCL_ERROR; - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) - index1 = (window_ptr - windows); - if (*window_ptr == winPtr2) - index2 = (window_ptr - windows); - } - if (index1 == -1) - panic("winPtr window not found"); - if (index2 == -1) - panic("winPtr2 window not found"); - - ckfree((char *) windows); - } - - c = argv[3][0]; - length = strlen(argv[3]); - if ((length > 2) && (c == 'i') - && (strncmp(argv[3], "isabove", length) == 0)) { - result = index1 > index2; - } else if ((length > 2) && (c == 'i') - && (strncmp(argv[3], "isbelow", length) == 0)) { - result = index1 < index2; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be isabove or isbelow", (char *) NULL); - return TCL_ERROR; - } - Tcl_SetIntObj(Tcl_GetObjResult(interp), result); - return TCL_OK; - } - } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0) - && (length >= 2)) { - if ((argc < 3) || (argc > 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " state window ?state?\"", (char *) NULL); return TCL_ERROR; - } - if (argc == 4) { - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; - } - - c = argv[3][0]; - length = strlen(argv[3]); - - if ((c == 'n') && (strncmp(argv[3], "normal", length) == 0)) { - if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { - wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; - } - (void) TkpWmSetState(winPtr, NormalState); - } else if ((c == 'i') - && (strncmp(argv[3], "iconic", length) == 0)) { - if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, - "\": override-redirect flag is set", - (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, - "\": it is a transient", (char *) NULL); - return TCL_ERROR; - } - if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, - "couldn't send iconify message to window manager", - TCL_STATIC); - return TCL_ERROR; - } - } else if ((c == 'w') - && (strncmp(argv[3], "withdrawn", length) == 0)) { - if (wmPtr->masterPtr != NULL) { - wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; - } - if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be normal, iconic or withdrawn", - (char *) NULL); - return TCL_ERROR; - } } else { - if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); - } else if (wmPtr->withdrawn) { - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); - } else if (Tk_IsMapped((Tk_Window) winPtr) - || ((wmPtr->flags & WM_NEVER_MAPPED) - && (wmPtr->hints.initial_state == NormalState))) { - Tcl_SetResult(interp, "normal", TCL_STATIC); - } else { - Tcl_SetResult(interp, "iconic", TCL_STATIC); + for (window_ptr = windows; *window_ptr ; window_ptr++) { + if (*window_ptr == winPtr) + index1 = (window_ptr - windows); + if (*window_ptr == winPtr2) + index2 = (window_ptr - windows); } + if (index1 == -1) + panic("winPtr window not found"); + if (index2 == -1) + panic("winPtr2 window not found"); + + ckfree((char *) windows); } - } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0) - && (length >= 2)) { - if (argc > 4) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " title window ?newTitle?\"", (char *) NULL); + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } - if (argc == 3) { - Tcl_SetResult(interp, - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); - return TCL_OK; - } else { - if (wmPtr->title != NULL) { - ckfree((char *) wmPtr->title); - } - wmPtr->title = ckalloc((unsigned) (strlen(argv[3]) + 1)); - strcpy(wmPtr->title, argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XTextProperty textProp; - Tcl_DString ds; - - Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds); - if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, - &textProp) != 0) { - XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, - &textProp); - XFree((char *) textProp.value); - } - Tcl_DStringFree(&ds); - } + if (index == OPT_ISABOVE) { + result = index1 > index2; + } else { /* OPT_ISBELOW */ + result = index1 < index2; } - } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0) - && (length >= 3)) { - TkWindow *masterPtr = wmPtr->masterPtr; - WmInfo *wmPtr2; + Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + return TCL_OK; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmStateCmd -- + * + * This procedure is invoked to process the "wm state" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " transient window ?master?\"", (char *) NULL); +static int +WmStateCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "normal", "iconic", "withdrawn", (char *) NULL }; + enum options { + OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN }; + int index; + + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); + return TCL_ERROR; + } + if (objc == 4) { + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't change state of ", + Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); return TCL_ERROR; } - if (argc == 3) { - if (masterPtr != NULL) { - Tcl_SetResult(interp, masterPtr->pathName, TCL_STATIC); - } - return TCL_OK; + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { + return TCL_ERROR; } - if (argv[3][0] == '\0') { - if (masterPtr != NULL) { - /* - * If we had a master, tell them that we aren't tied - * to them anymore - */ - masterPtr->wmInfoPtr->numTransients--; - Tk_DeleteEventHandler((Tk_Window) masterPtr, - StructureNotifyMask, - WmWaitMapProc, (ClientData) winPtr); - - /* FIXME: Need a call like Win32's UpdateWrapper() so - we can recreate the wrapper and get rid of the - transient window decorations. */ - } - wmPtr->masterPtr = NULL; - } else { - masterPtr = (TkWindow *) Tk_NameToWindow(interp, argv[3], tkwin); - if (masterPtr == NULL) { + if (index == OPT_NORMAL) { + if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { + wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; + } + (void) TkpWmSetState(winPtr, NormalState); + } else if (index == OPT_ICONIC) { + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { + Tcl_AppendResult(interp, "can't iconify \"", + winPtr->pathName, + "\": override-redirect flag is set", + (char *) NULL); return TCL_ERROR; } - while (!Tk_TopWinHierarchy(masterPtr)) { - /* - * Ensure that the master window is actually a Tk toplevel. - */ - - masterPtr = masterPtr->parentPtr; + if (wmPtr->masterPtr != NULL) { + Tcl_AppendResult(interp, "can't iconify \"", + winPtr->pathName, + "\": it is a transient", (char *) NULL); + return TCL_ERROR; } - Tk_MakeWindowExist((Tk_Window) masterPtr); - - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", argv[2], - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; + if (TkpWmSetState(winPtr, IconicState) == 0) { + Tcl_SetResult(interp, + "couldn't send iconify message to window manager", + TCL_STATIC); + return TCL_ERROR; } - - wmPtr2 = masterPtr->wmInfoPtr; - if (wmPtr2->wrapperPtr == NULL) { - CreateWrapper(wmPtr2); + } else { /* OPT_WITHDRAWN */ + if (wmPtr->masterPtr != NULL) { + wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; } - - if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", argv[3], - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), - (char *) NULL); - return TCL_ERROR; + if (TkpWmSetState(winPtr, WithdrawnState) == 0) { + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); + return TCL_ERROR; } + } + } else { + if (wmPtr->iconFor != NULL) { + Tcl_SetResult(interp, "icon", TCL_STATIC); + } else if (wmPtr->withdrawn) { + Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + } else if (Tk_IsMapped((Tk_Window) winPtr) + || ((wmPtr->flags & WM_NEVER_MAPPED) + && (wmPtr->hints.initial_state == NormalState))) { + Tcl_SetResult(interp, "normal", TCL_STATIC); + } else { + Tcl_SetResult(interp, "iconic", TCL_STATIC); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmTitleCmd -- + * + * This procedure is invoked to process the "wm title" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", - (char *) NULL); - return TCL_ERROR; - } else if (masterPtr != wmPtr->masterPtr) { - /* - * Remove old master map/unmap binding before setting - * the new master. The event handler will ensure that - * transient states reflect the state of the master. - */ +static int +WmTitleCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; - if (wmPtr->masterPtr == NULL) { - masterPtr->wmInfoPtr->numTransients++; - } else { - Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, - StructureNotifyMask, - WmWaitMapProc, (ClientData) winPtr); - } + if (objc > 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, + ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), + TCL_STATIC); + return TCL_OK; + } else { + if (wmPtr->title != NULL) { + ckfree((char *) wmPtr->title); + } + argv3 = Tcl_GetStringFromObj(objv[3], &length); + wmPtr->title = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->title, argv3); - Tk_CreateEventHandler((Tk_Window) masterPtr, - StructureNotifyMask, - WmWaitMapProc, (ClientData) winPtr); + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XTextProperty textProp; + Tcl_DString ds; - wmPtr->masterPtr = masterPtr; + Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds); + if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, + &textProp) != 0) { + XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, + &textProp); + XFree((char *) textProp.value); } + Tcl_DStringFree(&ds); } - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { - if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); - return TCL_ERROR; - } - } else { - Window xwin = (wmPtr->masterPtr == NULL) ? None : - wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window; - XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window, - xwin); - } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmTransientCmd -- + * + * This procedure is invoked to process the "wm transient" 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 +WmTransientCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + TkWindow *masterPtr = wmPtr->masterPtr; + WmInfo *wmPtr2; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?master?"); + return TCL_ERROR; + } + if (objc == 3) { + if (masterPtr != NULL) { + Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); } - } else if ((c == 'w') && (strncmp(argv[1], "withdraw", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " withdraw window\"", (char *) NULL); + return TCL_OK; + } + if (Tcl_GetString(objv[3])[0] == '\0') { + if (masterPtr != NULL) { + /* + * If we had a master, tell them that we aren't tied + * to them anymore + */ + + masterPtr->wmInfoPtr->numTransients--; + Tk_DeleteEventHandler((Tk_Window) masterPtr, + StructureNotifyMask, + WmWaitMapProc, (ClientData) winPtr); + + /* FIXME: Need a call like Win32's UpdateWrapper() so + we can recreate the wrapper and get rid of the + transient window decorations. */ + } + + wmPtr->masterPtr = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], + (Tk_Window *) &masterPtr) != TCL_OK) { return TCL_ERROR; } + while (!Tk_TopWinHierarchy(masterPtr)) { + /* + * Ensure that the master window is actually a Tk toplevel. + */ + + masterPtr = masterPtr->parentPtr; + } + Tk_MakeWindowExist((Tk_Window) masterPtr); + if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + Tcl_AppendResult(interp, "can't make \"", + Tcl_GetString(objv[2]), + "\" a transient: it is an icon for ", + Tk_PathName(wmPtr->iconFor), (char *) NULL); return TCL_ERROR; } - if (wmPtr->masterPtr != NULL) { - wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; + + wmPtr2 = masterPtr->wmInfoPtr; + if (wmPtr2->wrapperPtr == NULL) { + CreateWrapper(wmPtr2); } - if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); + + if (wmPtr2->iconFor != NULL) { + Tcl_AppendResult(interp, "can't make \"", + Tcl_GetString(objv[3]), + "\" a master: it is an icon for ", + Tk_PathName(wmPtr2->iconFor), + (char *) NULL); return TCL_ERROR; } - } else { - Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1], - "\": must be aspect, attributes, client, command, deiconify, ", - "focusmodel, frame, geometry, grid, group, iconbitmap, ", - "iconify, iconmask, iconname, iconposition, ", - "iconwindow, maxsize, minsize, overrideredirect, ", - "positionfrom, protocol, resizable, sizefrom, stackorder, ", - "state, title, transient, or withdraw", + + if (masterPtr == winPtr) { + Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), + "\" its own master", + (char *) NULL); + return TCL_ERROR; + } else if (masterPtr != wmPtr->masterPtr) { + /* + * Remove old master map/unmap binding before setting + * the new master. The event handler will ensure that + * transient states reflect the state of the master. + */ + + if (wmPtr->masterPtr == NULL) { + masterPtr->wmInfoPtr->numTransients++; + } else { + Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, + StructureNotifyMask, + WmWaitMapProc, (ClientData) winPtr); + } + + Tk_CreateEventHandler((Tk_Window) masterPtr, + StructureNotifyMask, + WmWaitMapProc, (ClientData) winPtr); + + wmPtr->masterPtr = masterPtr; + } + } + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { + if (TkpWmSetState(winPtr, WithdrawnState) == 0) { + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); + return TCL_ERROR; + } + } else { + Window xwin = (wmPtr->masterPtr == NULL) ? None : + wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window; + XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window, + xwin); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmWithdrawCmd -- + * + * This procedure is invoked to process the "wm withdraw" 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 +WmWithdrawCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), (char *) NULL); return TCL_ERROR; } + if (wmPtr->masterPtr != NULL) { + wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; + } + if (TkpWmSetState(winPtr, WithdrawnState) == 0) { + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); + return TCL_ERROR; + } return TCL_OK; +} - updateGeom: +/* + * Invoked by those wm subcommands that affect geometry. + * Schedules a geometry update. + */ +static void +WmUpdateGeom(wmPtr, winPtr) + WmInfo *wmPtr; + TkWindow *winPtr; +{ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } - return TCL_OK; } /* @@ -2272,7 +3235,7 @@ Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc) } } wmPtr = winPtr->wmInfoPtr; - if(wmPtr == NULL) { + if (wmPtr == NULL) { return; } @@ -2285,7 +3248,7 @@ Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc) && (wmPtr->widthInc == widthInc) && (wmPtr->heightInc == heightInc) && ((wmPtr->sizeHintsFlags & (PBaseSize|PResizeInc)) - == (PBaseSize|PResizeInc) )) { + == (PBaseSize|PResizeInc))) { return; } @@ -2306,7 +3269,7 @@ Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc) wmPtr->height = -1; } - /* + /* * Set the new gridding information, and start the process of passing * all of this information to the window manager. */ @@ -2367,7 +3330,7 @@ Tk_UnsetGrid(tkwin) } } wmPtr = winPtr->wmInfoPtr; - if(wmPtr == NULL) { + if (wmPtr == NULL) { return; } @@ -2422,7 +3385,7 @@ ConfigureEvent(wmPtr, configEventPtr) TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; Tk_ErrorHandler handler; - /* + /* * Update size information from the event. There are a couple of * tricky points here: * @@ -2864,7 +3827,7 @@ WrapperEventProc(clientData, eventPtr) * Tk_DestroyWindow will try to destroy the window, but of course * it's already gone. */ - + handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL); Tk_DestroyWindow((Tk_Window) wmPtr->winPtr); @@ -3168,7 +4131,7 @@ UpdateGeometryInfo(clientData) * It is possible that the window's overall size has not changed * but the menu size has. */ - + Tk_MoveResizeWindow(wmPtr->menubar, 0, 0, wmPtr->wrapperPtr->changes.width, wmPtr->menuHeight); XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, @@ -3795,7 +4758,7 @@ Tk_GetRootCoords(tkwin, xPtr, yPtr) if (root == None) { root = RootWindowOfScreen(Tk_Screen((Tk_Window)winPtr)); } - XTranslateCoordinates(winPtr->display, winPtr->window, + XTranslateCoordinates(winPtr->display, winPtr->window, root, 0, 0, &rootX, &rootY, &dummyChild); x += rootX; y += rootY; @@ -3908,7 +4871,7 @@ Tk_CoordsToWindow(rootX, rootY, tkwin) Tk_DeleteErrorHandler(handler); return NULL; } - for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; + for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) { if (wmPtr->reparent == child) { goto gotToplevel; @@ -4132,7 +5095,7 @@ Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr) winPtr = winPtr->parentPtr; } wmPtr = winPtr->wmInfoPtr; - if(wmPtr == NULL) { + if (wmPtr == NULL) { /* Punt. */ *xPtr = 0; *yPtr = 0; @@ -4730,7 +5693,7 @@ TkWmAddToColormapWindows(winPtr) break; } } - if(topPtr->wmInfoPtr == NULL) { + if (topPtr->wmInfoPtr == NULL) { return; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index d92c1bf..c2e56ff 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -1,4 +1,4 @@ -/* +/* * tkWinWm.c -- * * This module takes care of the interactions between a Tk-based @@ -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.49 2002/07/17 21:33:55 vincentdarley Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.50 2002/07/25 21:35:22 pspjuth Exp $ */ #include "tkWinInt.h" @@ -44,7 +44,7 @@ typedef struct ProtocolHandler { * end of list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ char command[4]; /* Tcl command to invoke when a client - * message for this protocol arrives. + * message for this protocol arrives. * The actual size of the structure varies * to accommodate the needs of the actual * command. THIS MUST BE THE LAST FIELD OF @@ -62,7 +62,7 @@ typedef struct TkWmStackorderToplevelPair { TkWindow **window_ptr; } TkWmStackorderToplevelPair; -/* +/* * This structure represents the contents of a icon, in terms of its * image. The HICON is an internal Windows format. Most of these * icon-specific-structures originated with the Winico extension. @@ -78,7 +78,7 @@ typedef struct { LPBYTE lpAND; /* ptr to AND image bits */ HICON hIcon; /* DAS ICON */ } ICONIMAGE, *LPICONIMAGE; -/* +/* * This structure is how we represent a block of the above * items. We will reallocate these structures according to * how many images they need to contain. @@ -87,7 +87,7 @@ typedef struct { int nNumImages; /* How many images? */ ICONIMAGE IconImages[1]; /* Image entries */ } BlockOfIconImages, *BlockOfIconImagesPtr; -/* +/* * These two structures are used to read in icons from an * 'icon directory' (i.e. the contents of a .icr file, say). * We only use these structures temporarily, since we copy @@ -110,27 +110,27 @@ typedef struct { ICONDIRENTRY idEntries[1]; /* the entries for each image */ } ICONDIR, *LPICONDIR; -/* +/* * A pointer to one of these strucutures is associated with each * toplevel. This allows us to free up all memory associated with icon * resources when a window is deleted or if the window's icon is * changed. They are simply reference counted according to: - * + * * (i) how many WmInfo structures point to this object * (ii) whether the ThreadSpecificData defined in this file contains * a pointer to this object. - * + * * The former count is for windows whose icons are individually * set, and the latter is for the global default icon choice. - * + * * Icons loaded from .icr/.icr use the iconBlock field, icons * loaded from .exe/.dll use the hIcon field. */ typedef struct WinIconInstance { int refCount; /* Number of instances that share this * data structure. */ - BlockOfIconImagesPtr iconBlock; - /* Pointer to icon resource data for + BlockOfIconImagesPtr iconBlock; + /* Pointer to icon resource data for * image. */ } WinIconInstance; @@ -148,17 +148,17 @@ typedef struct TkWmInfo { * created by the window manager to wrap * a toplevel window. This window is * a direct child of the root window. */ - Tk_Uid titleUid; /* Title to display in window caption. If - * NULL, use name of widget. */ - Tk_Uid iconName; /* Name to display in icon. */ - TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property, - * or NULL. */ + char *title; /* Title to display in window caption. If + * NULL, use name of widget. Malloced. */ + char *iconName; /* Name to display in icon. Malloced. */ XWMHints hints; /* Various pieces of information for * window manager. */ char *leaderName; /* Path name of leader of window group * (corresponds to hints.window_group). - * Malloc-ed. Note: this field doesn't + * Malloc-ed. Note: this field doesn't * get updated if leader is destroyed. */ + TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property, + * or NULL. */ Tk_Window icon; /* Window to use as icon for this window, * or NULL. */ Tk_Window iconFor; /* Window for which this window is icon, or @@ -278,7 +278,7 @@ typedef struct TkWmInfo { * a new position for the window, but it hasn't * been reflected through the window manager * yet. - * WM_COLORAMPS_EXPLICIT - non-zero means the colormap windows were + * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were * set explicitly via "wm colormapwindows". * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows" * was called the top-level itself wasn't @@ -339,7 +339,7 @@ static Tk_GeomMgr wmMgrType = { }; typedef struct ThreadSpecificData { - HPALETTE systemPalette; /* System palette; refers to the + HPALETTE systemPalette; /* System palette; refers to the * currently installed foreground logical * palette. */ TkWindow *createWindow; /* Window that is being constructed. This @@ -351,7 +351,7 @@ typedef struct ThreadSpecificData { * WM_GETMINMAXINFO message before the * WM_CREATE window. */ int initialized; /* Flag indicating whether thread- - * specific elements of module have + * specific elements of module have * been initialized. */ int firstWindow; /* Flag, cleared when the first window * is mapped in a non-iconic state. */ @@ -403,8 +403,8 @@ static void RefreshColormap _ANSI_ARGS_((Colormap colormap, TkDisplay *dispPtr)); static void SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info)); static void TkWmStackorderToplevelWrapperMap _ANSI_ARGS_(( - TkWindow *winPtr, - Tcl_HashTable *table)); + TkWindow *winPtr, + Tcl_HashTable *table)); static LRESULT CALLBACK TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); static void TopLevelEventProc _ANSI_ARGS_((ClientData clientData, @@ -430,11 +430,101 @@ static HICON MakeIconOrCursorFromResource _ANSI_ARGS_((LPICONIMAGE lpIcon, BOOL isIcon)); static HICON GetIcon _ANSI_ARGS_((WinIconPtr titlebaricon, int icon_size)); -static int WinSetIcon _ANSI_ARGS_((Tcl_Interp *interp, +static int WinSetIcon _ANSI_ARGS_((Tcl_Interp *interp, WinIconPtr titlebaricon, Tk_Window tkw)); static void FreeIconBlock _ANSI_ARGS_((BlockOfIconImagesPtr lpIR)); static void DecrIconRefCount _ANSI_ARGS_((WinIconPtr titlebaricon)); +static int WmAspectCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmAttributesCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmClientCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmColormapwindowsCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmCommandCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmDeiconifyCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmFocusmodelCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmFrameCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGeometryCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGridCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmGroupCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconbitmapCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconifyCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmIconwindowCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmMaxsizeCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmMinsizeCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmOverrideredirectCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmPositionfromCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmProtocolCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmResizableCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmSizefromCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmStackorderCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmStateCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmTitleCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmTransientCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr, + TkWindow *winPtr)); + /* Used in BytesPerLine */ #define WIDTHBYTES(bits) ((((bits) + 31)>>5)<<2) @@ -443,16 +533,16 @@ static void DecrIconRefCount _ANSI_ARGS_((WinIconPtr titlebaricon)); * * DIBNumColors -- * - * Calculates the number of entries in the color table, given by + * Calculates the number of entries in the color table, given by * LPSTR lpbi - pointer to the CF_DIB memory block. Used by * titlebar icon code. * * Results: - * + * * WORD - Number of entries in the color table. * * Side effects: None. - * + * * *---------------------------------------------------------------------- */ @@ -491,7 +581,7 @@ DIBNumColors( LPSTR lpbi ) * number of bytes in the color table * * Side effects: None. - * + * * *---------------------------------------------------------------------- */ @@ -514,7 +604,7 @@ PaletteSize( LPSTR lpbi ) * pointer to the image bits * * Side effects: None - * + * * *---------------------------------------------------------------------- */ @@ -537,7 +627,7 @@ FindDIBBits( LPSTR lpbi ) * number of bytes in one scan line (DWORD aligned) * * Side effects: None - * + * * *---------------------------------------------------------------------- */ @@ -560,7 +650,7 @@ BytesPerLine( LPBITMAPINFOHEADER lpBMIH ) * BOOL - TRUE for success, FALSE for failure * * Side effects: - * + * * *---------------------------------------------------------------------- */ @@ -599,10 +689,10 @@ AdjustIconImagePointers( LPICONIMAGE lpImage ) * in a resource. * * Results: - * + * * * Side effects: - * + * * *---------------------------------------------------------------------- */ @@ -619,7 +709,7 @@ MakeIconOrCursorFromResource(LPICONIMAGE lpIcon, BOOL isIcon) { if (!initinfo) { HMODULE hMod = GetModuleHandleA("USER32.DLL"); initinfo=1; - if(hMod){ + if (hMod){ pfnCreateIconFromResourceEx = GetProcAddress(hMod, "CreateIconFromResourceEx"); } @@ -653,11 +743,11 @@ MakeIconOrCursorFromResource(LPICONIMAGE lpIcon, BOOL isIcon) { * * Results: * UINT - Number of images in file, -1 for failure. - * If this succeeds, there is a decent chance this is a + * If this succeeds, there is a decent chance this is a * valid icon file. * * Side effects: - * + * * *---------------------------------------------------------------------- */ @@ -743,7 +833,7 @@ InitWindowClass(WinIconPtr titlebaricon) { /* * When threads are enabled, we cannot use CLASSDC because * threads will then write into the same device context. - * + * * This is a hack; we should add a subsystem that manages * device context on a per-thread basis. See also tkWinX.c, * which also initializes a WNDCLASS structure. @@ -765,8 +855,8 @@ InitWindowClass(WinIconPtr titlebaricon) { if (class.hIcon == NULL) { return TCL_ERROR; } - /* - * Store pointer to default icon so we know when + /* + * Store pointer to default icon so we know when * we need to free that information */ tsdPtr->iconPtr = titlebaricon; @@ -813,10 +903,10 @@ InitWm(void) * Sets either the default toplevel titlebar icon, or the icon * for a specific toplevel (if tkw is given, then only that * window is used). - * + * * The ref-count of the titlebaricon is NOT changed. If this * function returns successfully, the caller should assume - * the icon was used (and therefore the ref-count should + * the icon was used (and therefore the ref-count should * be adjusted to reflect that fact). If the function returned * an error, the caller should assume the icon was not used * (and may wish to free the memory associated with it). @@ -841,14 +931,14 @@ WinSetIcon(interp, titlebaricon, tkw) WmInfo *wmPtr; HWND hwnd; int application = 0; - + if (tkw == NULL) { tkw = Tk_MainWindow(interp); application = 1; } - + if (!(Tk_IsTopLevel(tkw))) { - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw), + Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw), "\" isn't a top-level window", (char *) NULL); return TCL_ERROR; } @@ -861,14 +951,14 @@ WinSetIcon(interp, titlebaricon, tkw) if (application) { if (hwnd == NULL) { - /* + /* * I don't actually think this is ever the correct thing, unless * perhaps the window doesn't have a wrapper. But I believe all * windows have wrappers. */ hwnd = Tk_GetHWND(Tk_WindowId(tkw)); } - /* + /* * If we aren't initialised, then just initialise with the user's * icon. Otherwise our icon choice will be ignored moments later * when Tk finishes initialising. @@ -889,13 +979,13 @@ WinSetIcon(interp, titlebaricon, tkw) (LPARAM)GetIcon(titlebaricon, ICON_SMALL)) #endif ) { - /* + /* * For some reason this triggers, even though it seems * to be successful This is probably related to the * WNDCLASS vs WNDCLASSEX difference. Anyway it seems * we have to ignore errors returned here. */ - + /* * Tcl_AppendResult(interp,"Unable to set new small icon", (char*)NULL); * return TCL_ERROR; @@ -913,7 +1003,7 @@ WinSetIcon(interp, titlebaricon, tkw) Tcl_AppendResult(interp,"Unable to set new icon", (char*)NULL); return TCL_ERROR; } - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->iconPtr != NULL) { DecrIconRefCount(tsdPtr->iconPtr); @@ -922,29 +1012,26 @@ WinSetIcon(interp, titlebaricon, tkw) } } else { if (!initialized) { - /* + /* * Need to initialise the wm otherwise we will fail on * code which tries to set a toplevel's icon before that * happens. Ignore return result. */ (void)InitWindowClass(NULL); } - /* + /* * The following code is exercised if you do - * + * * toplevel .t ; wm titlebaricon .t foo.icr - * + * * i.e. the wm hasn't had time to properly create * the '.t' window before you set the icon. */ if (hwnd == NULL) { - /* + /* * This little snippet is copied from the 'Map' function, * and should probably be placed in one proper location */ - if (wmPtr->titleUid == NULL) { - wmPtr->titleUid = wmPtr->winPtr->nameUid; - } UpdateWrapper(wmPtr->winPtr); wmPtr = ((TkWindow*)tkw)->wmInfoPtr; hwnd = wmPtr->wrapper; @@ -964,7 +1051,7 @@ WinSetIcon(interp, titlebaricon, tkw) /* Free any old icon ptr which is associated with this window. */ DecrIconRefCount(wmPtr->iconPtr); } - /* + /* * We do not need to increment the ref count for the * titlebaricon, because it was already incremented when we * retrieved it. @@ -990,7 +1077,7 @@ WinSetIcon(interp, titlebaricon, tkw) * its ref count already incremented. The calling procedure should * either place this structure inside a WmInfo structure, or it should * pass it on to DecrIconRefCount() to ensure no memory leaks occur. - * + * * If the given fileName did not contain a valid icon structure, * return NULL. * @@ -999,20 +1086,20 @@ WinSetIcon(interp, titlebaricon, tkw) * it contains. If the structure is not wanted, it should be * passed to DecrIconRefCount, and in any case a valid ref count * should be ensured to avoid memory leaks. - * + * * Currently icon resources are not shared, so the ref count of * one of these structures will always be 0 or 1. However all we * need do is implement some sort of lookup function between * filenames and WinIconPtr structures and no other code will need * to be changed. The pseudo-code for this is implemented below * in the 'if (0)' branch. It did not seem necessary to implement - * this optimisation here, since moving to icon<->image + * this optimisation here, since moving to icon<->image * conversions will probably make it obsolete. * *---------------------------------------------------------------------- */ -static WinIconPtr -ReadIconFromFile(interp, fileName) +static WinIconPtr +ReadIconFromFile(interp, fileName) Tcl_Interp *interp; Tcl_Obj *fileName; { @@ -1185,7 +1272,7 @@ GetIconFromPixmap(dsPtr, pixmap) static void DecrIconRefCount(WinIconPtr titlebaricon) { titlebaricon->refCount--; - + if (titlebaricon->refCount <= 0) { if (titlebaricon->iconBlock != NULL) { FreeIconBlock(titlebaricon->iconBlock); @@ -1201,7 +1288,7 @@ DecrIconRefCount(WinIconPtr titlebaricon) { * * FreeIconBlock -- * - * Frees all memory associated with a previously loaded + * Frees all memory associated with a previously loaded * titlebaricon. The icon block pointer is no longer * valid once this function returns. * @@ -1209,14 +1296,14 @@ DecrIconRefCount(WinIconPtr titlebaricon) { * None. * * Side effects: - * + * * *---------------------------------------------------------------------- */ static void FreeIconBlock(BlockOfIconImagesPtr lpIR) { int i; - + /* Free all the bits */ for (i=0; i< lpIR->nNumImages; i++) { if (lpIR->IconImages[i].lpBits != NULL) { @@ -1240,7 +1327,7 @@ FreeIconBlock(BlockOfIconImagesPtr lpIR) { * Returns the icon, if found, else NULL. * * Side effects: - * + * * *---------------------------------------------------------------------- */ @@ -1258,10 +1345,10 @@ GetIcon(WinIconPtr titlebaricon, int icon_size) { } else { unsigned int size = (icon_size == 0 ? 16 : 32); int i; - + for (i = 0; i < lpIR->nNumImages; i++) { /* Take the first or a 32x32 16 color icon*/ - if((lpIR->IconImages[i].Height == size) + if ((lpIR->IconImages[i].Height == size) && (lpIR->IconImages[i].Width == size) && (lpIR->IconImages[i].Colors >= 4)) { return lpIR->IconImages[i].hIcon; @@ -1300,7 +1387,7 @@ TclWinReadCursorFromFile(Tcl_Interp* interp, Tcl_Obj* fileName) { * * ReadIconOrCursorFromFile -- * - * Reads an Icon Resource from an ICO file, as given by + * Reads an Icon Resource from an ICO file, as given by * char* fileName - Name of the ICO file. This name should * be in Utf format. * @@ -1452,7 +1539,7 @@ static TkWindow * GetTopLevel(hwnd) HWND hwnd; { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1504,7 +1591,7 @@ SetLimits(hwnd, info) } wmPtr = winPtr->wmInfoPtr; - + /* * Copy latest constraint info. */ @@ -1513,7 +1600,7 @@ SetLimits(hwnd, info) wmPtr->defMinHeight = info->ptMinTrackSize.y; wmPtr->defMaxWidth = info->ptMaxTrackSize.x; wmPtr->defMaxHeight = info->ptMaxTrackSize.y; - + GetMaxSize(wmPtr, &maxWidth, &maxHeight); GetMinSize(wmPtr, &minWidth, &minHeight); @@ -1552,7 +1639,7 @@ SetLimits(hwnd, info) info->ptMaxTrackSize.x = info->ptMinTrackSize.x; } if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) { - info->ptMinTrackSize.y = winPtr->changes.height + info->ptMinTrackSize.y = winPtr->changes.height + wmPtr->borderHeight; info->ptMaxTrackSize.y = info->ptMinTrackSize.y; } @@ -1593,14 +1680,14 @@ TkWinWmCleanup(hInstance) } #endif - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { return; } tsdPtr->initialized = 0; - + UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance); } @@ -1719,7 +1806,7 @@ UpdateWrapper(winPtr) HICON hBigIcon = NULL; Tcl_DString titleString, classString; int *childStateInfo = NULL; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window == None) { @@ -1758,7 +1845,7 @@ UpdateWrapper(winPtr) wmPtr->style = WM_TRANSIENT_STYLE; wmPtr->exStyle = EX_TRANSIENT_STYLE; parentHWND = Tk_GetHWND(Tk_WindowId(wmPtr->masterPtr)); - if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) && + if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) && (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) { wmPtr->style |= WS_THICKFRAME; } @@ -1807,7 +1894,8 @@ UpdateWrapper(winPtr) */ tsdPtr->createWindow = winPtr; - Tcl_WinUtfToTChar(wmPtr->titleUid, -1, &titleString); + Tcl_WinUtfToTChar(((wmPtr->title != NULL) ? + wmPtr->title : winPtr->nameUid), -1, &titleString); Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString); wmPtr->wrapper = (*tkWinProcs->createWindowEx)(wmPtr->exStyle, (LPCTSTR) Tcl_DStringValue(&classString), @@ -1858,8 +1946,8 @@ UpdateWrapper(winPtr) hBigIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_BIG, (LPARAM) NULL); } - - if (oldWrapper && (oldWrapper != wmPtr->wrapper) + + if (oldWrapper && (oldWrapper != wmPtr->wrapper) && (oldWrapper != GetDesktopWindow())) { #ifdef _WIN64 SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG) NULL); @@ -1898,10 +1986,10 @@ UpdateWrapper(winPtr) wmPtr->flags &= ~WM_NEVER_MAPPED; SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0); - + /* * Force an initial transition from withdrawn to the real - * initial state. + * initial state. */ state = wmPtr->hints.initial_state; @@ -1931,7 +2019,7 @@ UpdateWrapper(winPtr) /* * Set up menus on the wrapper if required. */ - + if (wmPtr->hMenu != NULL) { wmPtr->flags = WM_SYNC_PENDING; SetMenu(wmPtr->wrapper, wmPtr->hMenu); @@ -2000,7 +2088,7 @@ TkWmMapWindow(winPtr) * be mapped. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { @@ -2036,9 +2124,6 @@ TkWmMapWindow(winPtr) * window. */ - if (wmPtr->titleUid == NULL) { - wmPtr->titleUid = winPtr->nameUid; - } UpdateWrapper(winPtr); } @@ -2183,7 +2268,13 @@ TkWmDeadWindow(winPtr) } if (wmPtr->numTransients != 0) panic("numTransients should be 0"); - + + if (wmPtr->title != NULL) { + ckfree(wmPtr->title); + } + if (wmPtr->iconName != NULL) { + ckfree(wmPtr->iconName); + } if (wmPtr->hints.flags & IconPixmapHint) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); } @@ -2245,14 +2336,14 @@ TkWmDeadWindow(winPtr) } } if (wmPtr->iconPtr != NULL) { - /* + /* * This may delete the icon resource data. I believe we * should do this after destroying the decorative frame, * because the decorative frame is using this icon. */ DecrIconRefCount(wmPtr->iconPtr); } - + ckfree((char *) wmPtr); winPtr->wmInfoPtr = NULL; } @@ -2287,7 +2378,7 @@ TkWmSetClass(winPtr) /* *---------------------------------------------------------------------- * - * Tk_WmCmd -- + * Tk_WmObjCmd -- * * This procedure is invoked to process the "wm" Tcl command. * See the user documentation for details on what it does. @@ -2303,43 +2394,58 @@ TkWmSetClass(winPtr) /* ARGSUSED */ int -Tk_WmCmd(clientData, interp, argc, argv) +Tk_WmObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tk_Window tkwin = (Tk_Window) clientData; - TkWindow *winPtr = NULL; - register WmInfo *wmPtr; - int c; - size_t length; + static CONST char *optionStrings[] = { + "aspect", "attributes", "client", "colormapwindows", + "command", "deiconify", "focusmodel", "frame", + "geometry", "grid", "group", "iconbitmap", + "iconify", "iconmask", "iconname", "iconposition", + "iconwindow", "maxsize", "minsize", "overrideredirect", + "positionfrom", "protocol", "resizable", "sizefrom", + "stackorder", "state", "title", "transient", + "withdraw", (char *) 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_ICONPOSITION, + WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, + WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, + WMOPT_WITHDRAW }; + int index, length; + char *argv1; + TkWindow *winPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (argc < 2) { + if (objc < 2) { wrongNumArgs: - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option window ?arg ...?\"", (char *) NULL); + Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?"); return TCL_ERROR; } - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0) + + argv1 = Tcl_GetStringFromObj(objv[1], &length); + if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) && (length >= 3)) { int wmTracing; - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " tracing ?boolean?\"", (char *) NULL); + if ((objc != 2) && (objc != 3)) { + Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } - if (argc == 2) { + if (objc == 2) { Tcl_SetResult(interp, ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), TCL_STATIC); return TCL_OK; } - if (Tcl_GetBoolean(interp, argv[2], &wmTracing) != TCL_OK) { + if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { return TCL_ERROR; } if (wmTracing) { @@ -2350,1404 +2456,2261 @@ Tk_WmCmd(clientData, interp, argc, argv) return TCL_OK; } - if (argc < 3) { + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + if (objc < 3) { goto wrongNumArgs; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); - if (winPtr == NULL) { + + if (TkGetWindowFromObj(interp, tkwin, objv[2], (Tk_Window *) &winPtr) + != TCL_OK) { return TCL_ERROR; } - if (!(winPtr->flags & TK_TOP_LEVEL)) { + if (!Tk_IsTopLevel(winPtr)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", (char *) NULL); return TCL_ERROR; } - wmPtr = winPtr->wmInfoPtr; - if ((c == 'a') && (strncmp(argv[1], "aspect", length) == 0) - && (length >= 2)) { - int numer1, denom1, numer2, denom2; - - if ((argc != 3) && (argc != 7)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " aspect window ?minNumer minDenom ", - "maxNumer maxDenom?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; + + switch ((enum options) index) { + case WMOPT_ASPECT: + return WmAspectCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ATTRIBUTES: + return WmAttributesCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_CLIENT: + return WmClientCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_COLORMAPWINDOWS: + return WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_COMMAND: + return WmCommandCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_DEICONIFY: + return WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FOCUSMODEL: + return WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_FRAME: + return WmFrameCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GEOMETRY: + return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GRID: + return WmGridCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_GROUP: + return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBITMAP: + return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONIFY: + return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONMASK: + return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONNAME: + return WmIconnameCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONPOSITION: + return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONWINDOW: + return WmIconwindowCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MAXSIZE: + return WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_MINSIZE: + return WmMinsizeCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_OVERRIDEREDIRECT: + return WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_POSITIONFROM: + return WmPositionfromCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_PROTOCOL: + return WmProtocolCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_RESIZABLE: + return WmResizableCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_SIZEFROM: + return WmSizefromCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_STACKORDER: + return WmStackorderCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_STATE: + return WmStateCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_TITLE: + return WmTitleCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_TRANSIENT: + return WmTransientCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_WITHDRAW: + return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv); + } + + /* This should not happen */ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * WmAspectCmd -- + * + * This procedure is invoked to process the "wm aspect" 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 +WmAspectCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int numer1, denom1, numer2, denom2; + + if ((objc != 3) && (objc != 7)) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?minNumer minDenom maxNumer maxDenom?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & PAspect) { + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, + wmPtr->minAspect.y, wmPtr->maxAspect.x, + wmPtr->maxAspect.y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~PAspect; - } else { - if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) { - return TCL_ERROR; - } - if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || - (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", - TCL_STATIC); - return TCL_ERROR; - } - wmPtr->minAspect.x = numer1; - wmPtr->minAspect.y = denom1; - wmPtr->maxAspect.x = numer2; - wmPtr->maxAspect.y = denom2; - wmPtr->sizeHintsFlags |= PAspect; - } - goto updateGeom; - } else if ((c == 'a') && (strncmp(argv[1], "attributes", length) == 0) - && (length >= 2)) { - LONG style, exStyle, styleBit, *stylePtr; - char buf[TCL_INTEGER_SPACE]; - int i, boolean; - - if (argc < 3) { - configArgs: - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " attributes window", - " ?-disabled ?bool??", - " ?-toolwindow ?bool??", - " ?-topmost ?bool??", - "\"", (char *) NULL); + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~PAspect; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &numer1) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &denom1) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) { return TCL_ERROR; } - exStyle = wmPtr->exStyleConfig; - style = wmPtr->styleConfig; - if (argc == 3) { - sprintf(buf, "%d", ((style & WS_DISABLED) != 0)); - Tcl_AppendResult(interp, "-disabled ", buf, (char *) NULL); - sprintf(buf, "%d", ((exStyle & WS_EX_TOOLWINDOW) != 0)); - Tcl_AppendResult(interp, " -toolwindow ", buf, (char *) NULL); - sprintf(buf, "%d", ((exStyle & WS_EX_TOPMOST) != 0)); - Tcl_AppendResult(interp, " -topmost ", buf, (char *) NULL); - return TCL_OK; - } - for (i = 3; i < argc; i += 2) { - length = strlen(argv[i]); - if ((length < 2) || (argv[i][0] != '-')) { - goto configArgs; - } - if ((i < argc-1) && - (Tcl_GetBoolean(interp, argv[i+1], &boolean) != TCL_OK)) { - return TCL_ERROR; - } - if (strncmp(argv[i], "-disabled", length) == 0) { - stylePtr = &style; - styleBit = WS_DISABLED; - } else if ((strncmp(argv[i], "-toolwindow", length) == 0) - && (length >= 3)) { - stylePtr = &exStyle; - styleBit = WS_EX_TOOLWINDOW; - } else if ((strncmp(argv[i], "-topmost", length) == 0) - && (length >= 3)) { - stylePtr = &exStyle; - styleBit = WS_EX_TOPMOST; - if ((i < argc-1) && (winPtr->flags & TK_EMBEDDED)) { - Tcl_AppendResult(interp, "can't set topmost flag on ", - winPtr->pathName, ": it is an embedded window", - (char *) NULL); - return TCL_ERROR; - } - } else { - goto configArgs; - } - if (i == argc-1) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), - ((*stylePtr & styleBit) != 0)); - } else if (boolean) { - *stylePtr |= styleBit; - } else { - *stylePtr &= ~styleBit; - } - } - if ((wmPtr->styleConfig != style) || - (wmPtr->exStyleConfig != exStyle)) { - wmPtr->styleConfig = style; - wmPtr->exStyleConfig = exStyle; - UpdateWrapper(winPtr); - } - } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " client window ?name?\"", - (char *) NULL); + if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || + (denom2 <= 0)) { + Tcl_SetResult(interp, "aspect number can't be <= 0", + TCL_STATIC); return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); - } - return TCL_OK; - } - if (argv[3][0] == 0) { - if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); - wmPtr->clientMachine = NULL; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XDeleteProperty(winPtr->display, winPtr->window, - Tk_InternAtom((Tk_Window) winPtr, - "WM_CLIENT_MACHINE")); - } - } - return TCL_OK; - } - if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); - } - wmPtr->clientMachine = (char *) - ckalloc((unsigned) (strlen(argv[3]) + 1)); - strcpy(wmPtr->clientMachine, argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XTextProperty textProp; - if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) - != 0) { - XSetWMClientMachine(winPtr->display, winPtr->window, - &textProp); - XFree((char *) textProp.value); - } - } - } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0) - && (length >= 3)) { - TkWindow **cmapList; - TkWindow *winPtr2; - int i, windowArgc, gotToplevel; - CONST char **windowArgv; + wmPtr->minAspect.x = numer1; + wmPtr->minAspect.y = denom1; + wmPtr->maxAspect.x = numer2; + wmPtr->maxAspect.y = denom2; + wmPtr->sizeHintsFlags |= PAspect; + } + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmAttributesCmd -- + * + * This procedure is invoked to process the "wm attributes" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " colormapwindows window ?windowList?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - Tk_MakeWindowExist((Tk_Window) winPtr); - for (i = 0; i < wmPtr->cmapCount; i++) { - if ((i == (wmPtr->cmapCount-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { - break; - } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); - } - return TCL_OK; +static int +WmAttributesCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + LONG style, exStyle, styleBit, *stylePtr; + char buf[TCL_INTEGER_SPACE], *string; + int i, boolean, length; + + if (objc < 3) { + configArgs: + Tcl_WrongNumArgs(interp, 2, objv, + "window" + " ?-disabled ?bool??" + " ?-toolwindow ?bool??" + " ?-topmost ?bool??"); + return TCL_ERROR; + } + exStyle = wmPtr->exStyleConfig; + style = wmPtr->styleConfig; + if (objc == 3) { + sprintf(buf, "%d", ((style & WS_DISABLED) != 0)); + Tcl_AppendResult(interp, "-disabled ", buf, (char *) NULL); + sprintf(buf, "%d", ((exStyle & WS_EX_TOOLWINDOW) != 0)); + Tcl_AppendResult(interp, " -toolwindow ", buf, (char *) NULL); + sprintf(buf, "%d", ((exStyle & WS_EX_TOPMOST) != 0)); + Tcl_AppendResult(interp, " -topmost ", buf, (char *) NULL); + return TCL_OK; + } + for (i = 3; i < objc; i += 2) { + string = Tcl_GetStringFromObj(objv[i], &length); + if ((length < 2) || (string[0] != '-')) { + goto configArgs; } - if (Tcl_SplitList(interp, argv[3], &windowArgc, &windowArgv) - != TCL_OK) { + if ((i < objc-1) && + (Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean) != TCL_OK)) { return TCL_ERROR; } - cmapList = (TkWindow **) ckalloc((unsigned) - ((windowArgc+1)*sizeof(TkWindow*))); - for (i = 0; i < windowArgc; i++) { - winPtr2 = (TkWindow *) Tk_NameToWindow(interp, windowArgv[i], - tkwin); - if (winPtr2 == NULL) { - ckfree((char *) cmapList); - ckfree((char *) windowArgv); + if (strncmp(string, "-disabled", length) == 0) { + stylePtr = &style; + styleBit = WS_DISABLED; + } else if ((strncmp(string, "-toolwindow", length) == 0) + && (length >= 3)) { + stylePtr = &exStyle; + styleBit = WS_EX_TOOLWINDOW; + } else if ((strncmp(string, "-topmost", length) == 0) + && (length >= 3)) { + stylePtr = &exStyle; + styleBit = WS_EX_TOPMOST; + if ((i < objc-1) && (winPtr->flags & TK_EMBEDDED)) { + Tcl_AppendResult(interp, "can't set topmost flag on ", + winPtr->pathName, ": it is an embedded window", + (char *) NULL); return TCL_ERROR; } - if (winPtr2 == winPtr) { - gotToplevel = 1; - } - if (winPtr2->window == None) { - Tk_MakeWindowExist((Tk_Window) winPtr2); - } - cmapList[i] = winPtr2; - } - if (!gotToplevel) { - wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP; - cmapList[windowArgc] = winPtr; - windowArgc++; } else { - wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP; + goto configArgs; } - wmPtr->flags |= WM_COLORMAPS_EXPLICIT; - if (wmPtr->cmapList != NULL) { - ckfree((char *)wmPtr->cmapList); + if (i == objc-1) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), + ((*stylePtr & styleBit) != 0)); + } else if (boolean) { + *stylePtr |= styleBit; + } else { + *stylePtr &= ~styleBit; } - wmPtr->cmapList = cmapList; - wmPtr->cmapCount = windowArgc; - ckfree((char *) windowArgv); + } + if ((wmPtr->styleConfig != style) || + (wmPtr->exStyleConfig != exStyle)) { + wmPtr->styleConfig = style; + wmPtr->exStyleConfig = exStyle; + UpdateWrapper(winPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmClientCmd -- + * + * This procedure is invoked to process the "wm client" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - /* - * Now we need to force the updated colormaps to be installed. - */ +static int +WmClientCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; - if (wmPtr == winPtr->dispPtr->foregroundWmPtr) { - InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1); - } else { - InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0); + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->clientMachine != NULL) { + Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); } return TCL_OK; - } else if ((c == 'c') && (strncmp(argv[1], "command", length) == 0) - && (length >= 3)) { - int cmdArgc; - CONST char **cmdArgv; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " command window ?value?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->cmdArgv != NULL) { - Tcl_SetResult(interp, - Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), - TCL_DYNAMIC); + } + argv3 = Tcl_GetStringFromObj(objv[3], &length); + if (argv3[0] == 0) { + if (wmPtr->clientMachine != NULL) { + ckfree((char *) wmPtr->clientMachine); + wmPtr->clientMachine = NULL; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XDeleteProperty(winPtr->display, winPtr->window, + Tk_InternAtom((Tk_Window) winPtr, + "WM_CLIENT_MACHINE")); } - return TCL_OK; } - if (argv[3][0] == 0) { - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); - wmPtr->cmdArgv = NULL; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XDeleteProperty(winPtr->display, winPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND")); - } + return TCL_OK; + } + if (wmPtr->clientMachine != NULL) { + ckfree((char *) wmPtr->clientMachine); + } + wmPtr->clientMachine = (char *) + ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->clientMachine, argv3); + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XTextProperty textProp; + if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp) + != 0) { + XSetWMClientMachine(winPtr->display, winPtr->window, + &textProp); + XFree((char *) textProp.value); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmColormapwindowsCmd -- + * + * This procedure is invoked to process the "wm colormapwindows" + * 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 +WmColormapwindowsCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + TkWindow **cmapList; + TkWindow *winPtr2; + int i, windowObjc, gotToplevel; + Tcl_Obj **windowObjv; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); + return TCL_ERROR; + } + if (objc == 3) { + Tk_MakeWindowExist((Tk_Window) winPtr); + for (i = 0; i < wmPtr->cmapCount; i++) { + if ((i == (wmPtr->cmapCount-1)) + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + break; } - return TCL_OK; + Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); } - if (Tcl_SplitList(interp, argv[3], &cmdArgc, &cmdArgv) != TCL_OK) { + return TCL_OK; + } + if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) + != TCL_OK) { + return TCL_ERROR; + } + cmapList = (TkWindow **) ckalloc((unsigned) + ((windowObjc+1)*sizeof(TkWindow*))); + gotToplevel = 0; + for (i = 0; i < windowObjc; i++) { + if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], + (Tk_Window *) &winPtr2) != TCL_OK) + { + ckfree((char *) cmapList); return TCL_ERROR; } - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + if (winPtr2 == winPtr) { + gotToplevel = 1; } - wmPtr->cmdArgc = cmdArgc; - wmPtr->cmdArgv = cmdArgv; - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XSetCommand(winPtr->display, winPtr->window, cmdArgv, cmdArgc); + if (winPtr2->window == None) { + Tk_MakeWindowExist((Tk_Window) winPtr2); } - } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " deiconify window\"", (char *) NULL); - return TCL_ERROR; + cmapList[i] = winPtr2; + } + if (!gotToplevel) { + wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP; + cmapList[windowObjc] = winPtr; + windowObjc++; + } else { + wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP; + } + wmPtr->flags |= WM_COLORMAPS_EXPLICIT; + if (wmPtr->cmapList != NULL) { + ckfree((char *)wmPtr->cmapList); + } + wmPtr->cmapList = cmapList; + wmPtr->cmapCount = windowObjc; + + /* + * Now we need to force the updated colormaps to be installed. + */ + + if (wmPtr == winPtr->dispPtr->foregroundWmPtr) { + InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1); + } else { + InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmCommandCmd -- + * + * This procedure is invoked to process the "wm command" 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 +WmCommandCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int cmdArgc; + CONST char **cmdArgv; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->cmdArgv != NULL) { + Tcl_SetResult(interp, + Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), + TCL_DYNAMIC); } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (argv3[0] == 0) { + if (wmPtr->cmdArgv != NULL) { + ckfree((char *) wmPtr->cmdArgv); + wmPtr->cmdArgv = NULL; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XDeleteProperty(winPtr->display, winPtr->window, + Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND")); + } } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", (char *) NULL); - return TCL_ERROR; - } + return TCL_OK; + } + if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) { + return TCL_ERROR; + } + if (wmPtr->cmdArgv != NULL) { + ckfree((char *) wmPtr->cmdArgv); + } + wmPtr->cmdArgc = cmdArgc; + wmPtr->cmdArgv = cmdArgv; + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XSetCommand(winPtr->display, winPtr->window, cmdArgv, cmdArgc); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmDeiconifyCmd -- + * + * This procedure is invoked to process the "wm deiconify" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { - wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; - } +static int +WmDeiconifyCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; - /* - * If WM_UPDATE_PENDING is true, a pending UpdateGeometryInfo may - * need to be called first to update a withdrawn toplevel's geometry - * before it is deiconified by TkpWmSetState. - * Don't bother if we've never been mapped. - */ - if ((wmPtr->flags & WM_UPDATE_PENDING) && - !(wmPtr->flags & WM_NEVER_MAPPED)) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); - UpdateGeometryInfo((ClientData) winPtr); - } + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } + if (winPtr->flags & TK_EMBEDDED) { + Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, + ": it is an embedded window", (char *) NULL); + return TCL_ERROR; + } - /* - * If we were in the ZoomState (maximized), 'wm deiconify' - * should not cause the window to shrink - */ - if (wmPtr->hints.initial_state == ZoomState) { - TkpWmSetState(winPtr, ZoomState); + if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { + wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; + } + + /* + * If WM_UPDATE_PENDING is true, a pending UpdateGeometryInfo may + * need to be called first to update a withdrawn toplevel's geometry + * before it is deiconified by TkpWmSetState. + * Don't bother if we've never been mapped. + */ + if ((wmPtr->flags & WM_UPDATE_PENDING) && + !(wmPtr->flags & WM_NEVER_MAPPED)) { + Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + UpdateGeometryInfo((ClientData) winPtr); + } + + /* + * If we were in the ZoomState (maximized), 'wm deiconify' + * should not cause the window to shrink + */ + if (wmPtr->hints.initial_state == ZoomState) { + TkpWmSetState(winPtr, ZoomState); + } else { + TkpWmSetState(winPtr, NormalState); + } + + /* + * An unmapped window will be mapped at idle time + * by a call to MapFrame. That calls CreateWrapper + * which sets the focus and raises the window. + */ + if (wmPtr->flags & WM_NEVER_MAPPED) { + return TCL_OK; + } + + /* + * Follow Windows-like style here, raising the window to the top. + */ + TkWmRestackToplevel(winPtr, Above, NULL); + if (!(Tk_Attributes((Tk_Window) winPtr)->override_redirect)) { + TkSetFocusWin(winPtr, 1); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmFocusmodelCmd -- + * + * This procedure is invoked to process the "wm focusmodel" 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 +WmFocusmodelCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "active", "passive", (char *) NULL }; + enum options { + OPT_ACTIVE, OPT_PASSIVE }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?active|passive?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), + TCL_STATIC); + return TCL_OK; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (index == OPT_ACTIVE) { + wmPtr->hints.input = False; + } else { /* OPT_PASSIVE */ + wmPtr->hints.input = True; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmFrameCmd -- + * + * This procedure is invoked to process the "wm frame" 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 +WmFrameCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + HWND hwnd; + char buf[TCL_INTEGER_SPACE]; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (Tk_WindowId((Tk_Window) winPtr) == None) { + Tk_MakeWindowExist((Tk_Window) winPtr); + } + hwnd = wmPtr->wrapper; + if (hwnd == NULL) { + hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr)); + } + sprintf(buf, "0x%x", (unsigned int) hwnd); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmGeometryCmd -- + * + * This procedure is invoked to process the "wm geometry" 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 +WmGeometryCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char xSign, ySign; + int width, height; + char *argv3; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[16 + TCL_INTEGER_SPACE * 4]; + + xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; + ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; + if (wmPtr->gridWin != NULL) { + width = wmPtr->reqGridWidth + (winPtr->changes.width + - winPtr->reqWidth)/wmPtr->widthInc; + height = wmPtr->reqGridHeight + (winPtr->changes.height + - winPtr->reqHeight)/wmPtr->heightInc; } else { - TkpWmSetState(winPtr, NormalState); + width = winPtr->changes.width; + height = winPtr->changes.height; } + sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, + ySign, wmPtr->y); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (*argv3 == '\0') { + wmPtr->width = -1; + wmPtr->height = -1; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; + } + return ParseGeometry(interp, argv3, winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * WmGridCmd -- + * + * This procedure is invoked to process the "wm grid" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - /* - * An unmapped window will be mapped at idle time - * by a call to MapFrame. That calls CreateWrapper - * which sets the focus and raises the window. - */ - if (wmPtr->flags & WM_NEVER_MAPPED) { - return TCL_OK; - } +static int +WmGridCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int reqWidth, reqHeight, widthInc, heightInc; + + if ((objc != 3) && (objc != 7)) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?baseWidth baseHeight widthInc heightInc?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & PBaseSize) { + char buf[TCL_INTEGER_SPACE * 4]; + sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, + wmPtr->reqGridHeight, wmPtr->widthInc, + wmPtr->heightInc); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { /* - * Follow Windows-like style here, raising the window to the top. + * Turn off gridding and reset the width and height + * to make sense as ungridded numbers. */ - TkWmRestackToplevel(winPtr, Above, NULL); - if (!(Tk_Attributes((Tk_Window) winPtr)->override_redirect)) { - TkSetFocusWin(winPtr, 1); - } - } else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " focusmodel window ?active|passive?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); - return TCL_OK; + + wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); + if (wmPtr->width != -1) { + wmPtr->width = winPtr->reqWidth + (wmPtr->width + - wmPtr->reqGridWidth)*wmPtr->widthInc; + wmPtr->height = winPtr->reqHeight + (wmPtr->height + - wmPtr->reqGridHeight)*wmPtr->heightInc; } - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) { - wmPtr->hints.input = False; - } else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) { - wmPtr->hints.input = True; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be active or passive", (char *) NULL); + wmPtr->widthInc = 1; + wmPtr->heightInc = 1; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &heightInc) != TCL_OK)) { return TCL_ERROR; } - } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0) - && (length >= 2)) { - HWND hwnd; - char buf[TCL_INTEGER_SPACE]; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " frame window\"", (char *) NULL); + if (reqWidth < 0) { + Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); return TCL_ERROR; } - if (Tk_WindowId((Tk_Window) winPtr) == None) { - Tk_MakeWindowExist((Tk_Window) winPtr); + if (reqHeight < 0) { + Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); + return TCL_ERROR; } - hwnd = wmPtr->wrapper; - if (hwnd == NULL) { - hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr)); + if (widthInc < 0) { + Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); + return TCL_ERROR; } - sprintf(buf, "0x%x", (unsigned int) hwnd); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0) - && (length >= 2)) { - char xSign, ySign; - int width, height; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " geometry window ?newGeometry?\"", - (char *) NULL); + if (heightInc < 0) { + Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); return TCL_ERROR; } - if (argc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; - ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; - if (wmPtr->gridWin != NULL) { - width = wmPtr->reqGridWidth + (winPtr->changes.width - - winPtr->reqWidth)/wmPtr->widthInc; - height = wmPtr->reqGridHeight + (winPtr->changes.height - - winPtr->reqHeight)/wmPtr->heightInc; - } else { - width = winPtr->changes.width; - height = winPtr->changes.height; - } - sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, - ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; + Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, + heightInc); + } + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmGroupCmd -- + * + * This procedure is invoked to process the "wm group" 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 +WmGroupCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Tk_Window tkwin2; + char *argv3; + int length; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & WindowGroupHint) { + Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); } - if (*argv[3] == '\0') { - wmPtr->width = -1; - wmPtr->height = -1; - goto updateGeom; + return TCL_OK; + } + argv3 = Tcl_GetStringFromObj(objv[3], &length); + if (*argv3 == '\0') { + wmPtr->hints.flags &= ~WindowGroupHint; + if (wmPtr->leaderName != NULL) { + ckfree(wmPtr->leaderName); } - return ParseGeometry(interp, argv[3], winPtr); - } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0) - && (length >= 3)) { - int reqWidth, reqHeight, widthInc, heightInc; - - if ((argc != 3) && (argc != 7)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " grid window ?baseWidth baseHeight ", - "widthInc heightInc?\"", (char *) NULL); + wmPtr->leaderName = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; + Tk_MakeWindowExist(tkwin2); + if (wmPtr->leaderName != NULL) { + ckfree(wmPtr->leaderName); } - if (*argv[3] == '\0') { - /* - * Turn off gridding and reset the width and height - * to make sense as ungridded numbers. - */ + wmPtr->hints.window_group = Tk_WindowId(tkwin2); + wmPtr->hints.flags |= WindowGroupHint; + wmPtr->leaderName = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->leaderName, argv3); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconbitmapCmd -- + * + * This procedure is invoked to process the "wm iconbitmap" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc); - if (wmPtr->width != -1) { - wmPtr->width = winPtr->reqWidth + (wmPtr->width - - wmPtr->reqGridWidth)*wmPtr->widthInc; - wmPtr->height = winPtr->reqHeight + (wmPtr->height - - wmPtr->reqGridHeight)*wmPtr->heightInc; - } - wmPtr->widthInc = 1; - wmPtr->heightInc = 1; - } else { - if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) { - return TCL_ERROR; - } - if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (widthInc < 0) { - Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (heightInc < 0) { - Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, - heightInc); - } - goto updateGeom; - } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0) - && (length >= 3)) { - Tk_Window tkwin2; +static int +WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + /* If true, then set for all windows. */ + int isDefault = 0; + char *string; - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " group window ?pathName?\"", + if ((objc < 3) || (objc > 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?"); + return TCL_ERROR; + } else if (objc == 5) { + /* If we have 5 arguments, we must have a '-default' flag */ + char *argv3 = Tcl_GetString(objv[3]); + if (strcmp(argv3, "-default")) { + Tcl_AppendResult(interp, "illegal option \"", + argv3, "\" must be \"-default\"", (char *) NULL); return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); - } - return TCL_OK; + isDefault = 1; + } else if (objc == 3) { + /* No arguments were given */ + if (wmPtr->hints.flags & IconPixmapHint) { + Tcl_SetResult(interp, + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), + TCL_STATIC); } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~WindowGroupHint; - if (wmPtr->leaderName != NULL) { - ckfree(wmPtr->leaderName); - } - wmPtr->leaderName = NULL; - } else { - tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin); - if (tkwin2 == NULL) { - return TCL_ERROR; - } - Tk_MakeWindowExist(tkwin2); - wmPtr->hints.window_group = Tk_WindowId(tkwin2); - wmPtr->hints.flags |= WindowGroupHint; - wmPtr->leaderName = ckalloc((unsigned) (strlen(argv[3])+1)); - strcpy(wmPtr->leaderName, argv[3]); - } - } else if ((c == 'i') && (strncmp(argv[1], "iconbitmap", length) == 0) - && (length >= 5)) { - /* If true, then set for all windows. */ - int isDefault = 0; - - if ((argc < 3) || (argc > 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconbitmap window ?-default? ?image?\"", - (char *) NULL); + return TCL_OK; + } + + string = Tcl_GetString(objv[objc-1]); + if (*string == '\0') { + if (wmPtr->hints.icon_pixmap != None) { + Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); + wmPtr->hints.icon_pixmap = None; + } + wmPtr->hints.flags &= ~IconPixmapHint; + if (WinSetIcon(interp, NULL, + (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { return TCL_ERROR; - } else if (argc == 5) { - /* If we have 5 arguments, we must have a '-default' flag */ - if (strcmp(argv[3],"-default")) { - Tcl_AppendResult(interp, "illegal option \"", - argv[3], " must be \"-default\"", - (char *) NULL); - return TCL_ERROR; - } - isDefault = 1; - } else if (argc == 3) { - /* No arguments were given */ - if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, - Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap), TCL_STATIC); - } - return TCL_OK; } - if (*argv[argc-1] == '\0') { - if (wmPtr->hints.icon_pixmap != None) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); + } else { + /* + * In the future this block of code will use Tk's 'image' + * functionality to allow all supported image formats. + * However, this will require a change to the way icons are + * handled. We will need to add icon<->image conversions + * routines. + * + * Until that happens we simply try to find an icon in the + * given argument, and if that fails, we use the older + * bitmap code. We do things this way round (icon then + * bitmap), because the bitmap code actually seems to have + * no visible effect, so we want to give the icon code the + * first try at doing something. + */ + + /* + * Either return NULL, or return a valid titlebaricon with its + * ref count already incremented. + */ + WinIconPtr titlebaricon = ReadIconFromFile(interp, objv[objc-1]); + if (titlebaricon != NULL) { + /* + * Try to set the icon for the window. If it is a '-default' + * icon, we must pass in NULL + */ + if (WinSetIcon(interp, titlebaricon, + (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { + /* We didn't use the titlebaricon after all */ + DecrIconRefCount(titlebaricon); + titlebaricon = NULL; } - wmPtr->hints.flags &= ~IconPixmapHint; - if (WinSetIcon(interp, NULL, - (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { + } + if (titlebaricon == NULL) { + /* + * We didn't manage to handle the argument as a valid + * icon. Try as a bitmap. First we must clear the + * error message which was placed in the interpreter + */ + Pixmap pixmap; + Tcl_ResetResult(interp); + pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string); + if (pixmap == None) { return TCL_ERROR; } - } else { - /* - * In the future this block of code will use Tk's 'image' - * functionality to allow all supported image formats. - * However, this will require a change to the way icons are - * handled. We will need to add icon<->image conversions - * routines. - * - * Until that happens we simply try to find an icon in the - * given argument, and if that fails, we use the older - * bitmap code. We do things this way round (icon then - * bitmap), because the bitmap code actually seems to have - * no visible effect, so we want to give the icon code the - * first try at doing something. - */ - - /* - * Either return NULL, or return a valid titlebaricon with its - * ref count already incremented. - */ - WinIconPtr titlebaricon; - - Tcl_Obj *tempPath = Tcl_NewStringObj(argv[argc-1], -1); - Tcl_IncrRefCount(tempPath); - titlebaricon = ReadIconFromFile(interp, tempPath); - Tcl_DecrRefCount(tempPath); + wmPtr->hints.icon_pixmap = pixmap; + wmPtr->hints.flags |= IconPixmapHint; + titlebaricon = GetIconFromPixmap(Tk_Display(winPtr), pixmap); if (titlebaricon != NULL) { - /* - * Try to set the icon for the window. If it is a '-default' - * icon, we must pass in NULL - */ if (WinSetIcon(interp, titlebaricon, - (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { + (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { /* We didn't use the titlebaricon after all */ DecrIconRefCount(titlebaricon); titlebaricon = NULL; } } - if (titlebaricon == NULL) { - /* - * We didn't manage to handle the argument as a valid - * icon. Try as a bitmap. First we must clear the - * error message which was placed in the interpreter - */ - Pixmap pixmap; - Tcl_ResetResult(interp); - pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, - Tk_GetUid(argv[argc-1])); - if (pixmap == None) { - return TCL_ERROR; - } - wmPtr->hints.icon_pixmap = pixmap; - wmPtr->hints.flags |= IconPixmapHint; - titlebaricon = GetIconFromPixmap(Tk_Display(winPtr), pixmap); - if (titlebaricon != NULL) { - if (WinSetIcon(interp, titlebaricon, - (isDefault ? NULL : (Tk_Window) winPtr)) != TCL_OK) { - /* We didn't use the titlebaricon after all */ - DecrIconRefCount(titlebaricon); - titlebaricon = NULL; - } - - } - } - } - } else if ((c == 'i') && (strncmp(argv[1], "iconify", length) == 0) - && (length >= 5)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconify window\"", (char *) NULL); - return TCL_ERROR; - } - if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", (char *) NULL); - return TCL_ERROR; - } - TkpWmSetState(winPtr, IconicState); - } else if ((c == 'i') && (strncmp(argv[1], "iconmask", length) == 0) - && (length >= 5)) { - Pixmap pixmap; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconmask window ?bitmap?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, - Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); - } - return TCL_OK; } - if (*argv[3] == '\0') { - if (wmPtr->hints.icon_mask != None) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); - } - wmPtr->hints.flags &= ~IconMaskHint; - } else { - pixmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid(argv[3])); - if (pixmap == None) { - return TCL_ERROR; - } - wmPtr->hints.icon_mask = pixmap; - wmPtr->hints.flags |= IconMaskHint; - } - } else if ((c == 'i') && (strncmp(argv[1], "iconname", length) == 0) - && (length >= 5)) { - if (argc > 4) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconname window ?newName?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconifyCmd -- + * + * This procedure is invoked to process the "wm iconify" 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 +WmIconifyCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { + Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, + "\": override-redirect flag is set", (char *) NULL); + return TCL_ERROR; + } + if (wmPtr->masterPtr != NULL) { + Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, + "\": it is a transient", (char *) NULL); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } + if (winPtr->flags & TK_EMBEDDED) { + Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, + ": it is an embedded window", (char *) NULL); + return TCL_ERROR; + } + TkpWmSetState(winPtr, IconicState); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconmaskCmd -- + * + * This procedure is invoked to process the "wm iconmask" 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 +WmIconmaskCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Pixmap pixmap; + char *argv3; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & IconMaskHint) { Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), TCL_STATIC); - return TCL_OK; - } else { - wmPtr->iconName = Tk_GetUid(argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED)) { - XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName); - } - } - } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0) - && (length >= 5)) { - int x, y; - - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconposition window ?x y?\"", - (char *) NULL); - return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; - - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - return TCL_OK; + return TCL_OK; + } + argv3 = Tcl_GetString(objv[3]); + if (*argv3 == '\0') { + if (wmPtr->hints.icon_mask != None) { + Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~IconPositionHint; - } else { - if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){ - return TCL_ERROR; - } - wmPtr->hints.icon_x = x; - wmPtr->hints.icon_y = y; - wmPtr->hints.flags |= IconPositionHint; - } - } else if ((c == 'i') && (strncmp(argv[1], "iconwindow", length) == 0) - && (length >= 5)) { - Tk_Window tkwin2; - WmInfo *wmPtr2; - XSetWindowAttributes atts; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " iconwindow window ?pathName?\"", - (char *) NULL); + wmPtr->hints.flags &= ~IconMaskHint; + } else { + pixmap = Tk_GetBitmap(interp, tkwin, argv3); + if (pixmap == None) { return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->hints.flags &= ~IconWindowHint; - if (wmPtr->icon != NULL) { - /* - * Let the window use button events again, then remove - * it as icon window. - */ - - atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask - | ButtonPressMask; - Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts); - wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; - wmPtr2->iconFor = NULL; - wmPtr2->hints.initial_state = WithdrawnState; - } - wmPtr->icon = NULL; - } else { - tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin); - if (tkwin2 == NULL) { - return TCL_ERROR; - } - if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", argv[3], - " as icon window: not at top level", (char *) NULL); - return TCL_ERROR; - } - wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; - if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, argv[3], " is already an icon for ", - Tk_PathName(wmPtr2->iconFor), (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->icon != NULL) { - WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; - wmPtr3->iconFor = NULL; - - /* - * Let the window use button events again. - */ - - atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask - | ButtonPressMask; - Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts); - } + wmPtr->hints.icon_mask = pixmap; + wmPtr->hints.flags |= IconMaskHint; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconnameCmd -- + * + * This procedure is invoked to process the "wm iconname" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - /* - * Disable button events in the icon window: some window - * managers (like olvwm) want to get the events themselves, - * but X only allows one application at a time to receive - * button events for a window. - */ +static int +WmIconnameCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; - atts.event_mask = Tk_Attributes(tkwin2)->event_mask - & ~ButtonPressMask; - Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts); - Tk_MakeWindowExist(tkwin2); - wmPtr->hints.icon_window = Tk_WindowId(tkwin2); - wmPtr->hints.flags |= IconWindowHint; - wmPtr->icon = tkwin2; - wmPtr2->iconFor = (Tk_Window) winPtr; - if (!(wmPtr2->flags & WM_NEVER_MAPPED)) { - if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2), - Tk_ScreenNumber(tkwin2)) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); - return TCL_ERROR; - } - } - } - } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0) - && (length >= 2)) { - int width, height; - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " maxsize window ?width height?\"", - (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; - - GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; - } - if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) { - return TCL_ERROR; + if (objc > 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, + ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), + TCL_STATIC); + return TCL_OK; + } else { + if (wmPtr->iconName != NULL) { + ckfree((char *) wmPtr->iconName); } - wmPtr->maxWidth = width; - wmPtr->maxHeight = height; - goto updateGeom; - } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0) - && (length >= 2)) { - int width, height; - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " minsize window ?width height?\"", - (char *) NULL); - return TCL_ERROR; + argv3 = Tcl_GetStringFromObj(objv[3], &length); + wmPtr->iconName = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->iconName, argv3); + if (!(wmPtr->flags & WM_NEVER_MAPPED)) { + XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName); } - if (argc == 3) { + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconpositionCmd -- + * + * This procedure is invoked to process the "wm iconposition" + * 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 +WmIconpositionCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int x, y; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->hints.flags & IconPositionHint) { char buf[TCL_INTEGER_SPACE * 2]; - - GetMinSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); + + sprintf(buf, "%d %d", wmPtr->hints.icon_x, + wmPtr->hints.icon_y); Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; - } - if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) { - return TCL_ERROR; } - wmPtr->minWidth = width; - wmPtr->minHeight = height; - goto updateGeom; - } else if ((c == 'o') - && (strncmp(argv[1], "overrideredirect", length) == 0)) { - int boolean, curValue; - XSetWindowAttributes atts; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " overrideredirect window ?boolean?\"", - (char *) NULL); + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->hints.flags &= ~IconPositionHint; + } else { + if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ return TCL_ERROR; } - curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; - if (argc == 3) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); - return TCL_OK; - } - if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) { - return TCL_ERROR; + wmPtr->hints.icon_x = x; + wmPtr->hints.icon_y = y; + wmPtr->hints.flags |= IconPositionHint; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmIconwindowCmd -- + * + * This procedure is invoked to process the "wm iconwindow" 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 +WmIconwindowCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + Tk_Window tkwin2; + WmInfo *wmPtr2; + XSetWindowAttributes atts; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->icon != NULL) { + Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); } - if (curValue != boolean) { + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->hints.flags &= ~IconWindowHint; + if (wmPtr->icon != NULL) { /* - * Only do this if we are really changing value, because it - * causes some funky stuff to occur + * Let the window use button events again, then remove + * it as icon window. */ - atts.override_redirect = (boolean) ? True : False; - Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, - &atts); - if (!(wmPtr->flags & (WM_NEVER_MAPPED) - && !(winPtr->flags & TK_EMBEDDED))) { - UpdateWrapper(winPtr); - } + + atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask + | ButtonPressMask; + Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts); + wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr2->iconFor = NULL; + wmPtr2->hints.initial_state = WithdrawnState; } - } else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " positionfrom window ?user/program?\"", - (char *) NULL); + wmPtr->icon = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) { return TCL_ERROR; } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); - } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); - } - return TCL_OK; - } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); - } else { - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) { - wmPtr->sizeHintsFlags &= ~PPosition; - wmPtr->sizeHintsFlags |= USPosition; - } else if ((c == 'p') - && (strncmp(argv[3], "program", length) == 0)) { - wmPtr->sizeHintsFlags &= ~USPosition; - wmPtr->sizeHintsFlags |= PPosition; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be program or user", (char *) NULL); - return TCL_ERROR; - } - } - goto updateGeom; - } else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0) - && (length >= 2)) { - register ProtocolHandler *protPtr, *prevPtr; - Atom protocol; - int cmdLength; - - if ((argc < 3) || (argc > 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " protocol window ?name? ?command?\"", - (char *) NULL); + if (!Tk_IsTopLevel(tkwin2)) { + Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), + " as icon window: not at top level", (char *) NULL); return TCL_ERROR; } - if (argc == 3) { - /* - * Return a list of all defined protocols for the window. - */ - for (protPtr = wmPtr->protPtr; protPtr != NULL; - protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); - } - return TCL_OK; + wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; + if (wmPtr2->iconFor != NULL) { + Tcl_AppendResult(interp, Tcl_GetString(objv[3]), + " is already an icon for ", + Tk_PathName(wmPtr2->iconFor), (char *) NULL); + return TCL_ERROR; } - protocol = Tk_InternAtom((Tk_Window) winPtr, argv[3]); - if (argc == 4) { + if (wmPtr->icon != NULL) { + WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr3->iconFor = NULL; + /* - * Return the command to handle a given protocol. + * Let the window use button events again. */ - for (protPtr = wmPtr->protPtr; protPtr != NULL; - protPtr = protPtr->nextPtr) { - if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); - return TCL_OK; - } - } - return TCL_OK; + + atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask + | ButtonPressMask; + Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts); } /* - * Delete any current protocol handler, then create a new - * one with the specified command, unless the command is - * empty. + * Disable button events in the icon window: some window + * managers (like olvwm) want to get the events themselves, + * but X only allows one application at a time to receive + * button events for a window. */ - for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL; - prevPtr = protPtr, protPtr = protPtr->nextPtr) { - if (protPtr->protocol == protocol) { - if (prevPtr == NULL) { - wmPtr->protPtr = protPtr->nextPtr; - } else { - prevPtr->nextPtr = protPtr->nextPtr; - } - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); - break; + atts.event_mask = Tk_Attributes(tkwin2)->event_mask + & ~ButtonPressMask; + Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts); + Tk_MakeWindowExist(tkwin2); + wmPtr->hints.icon_window = Tk_WindowId(tkwin2); + wmPtr->hints.flags |= IconWindowHint; + wmPtr->icon = tkwin2; + wmPtr2->iconFor = (Tk_Window) winPtr; + if (!(wmPtr2->flags & WM_NEVER_MAPPED)) { + if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2), + Tk_ScreenNumber(tkwin2)) == 0) { + Tcl_SetResult(interp, + "couldn't send withdraw message to window manager", + TCL_STATIC); + return TCL_ERROR; } } - cmdLength = strlen(argv[4]); - if (cmdLength > 0) { - protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); - protPtr->protocol = protocol; - protPtr->nextPtr = wmPtr->protPtr; - wmPtr->protPtr = protPtr; - protPtr->interp = interp; - strcpy(protPtr->command, argv[4]); - } - } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) { - int width, height; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmMaxsizeCmd -- + * + * This procedure is invoked to process the "wm maxsize" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " resizable window ?width height?\"", - (char *) NULL); - return TCL_ERROR; +static int +WmMaxsizeCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + GetMaxSize(wmPtr, &width, &height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + wmPtr->maxWidth = width; + wmPtr->maxHeight = height; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmMinsizeCmd -- + * + * This procedure is invoked to process the "wm minsize" 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 +WmMinsizeCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + GetMinSize(wmPtr, &width, &height); + sprintf(buf, "%d %d", width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + wmPtr->minWidth = width; + wmPtr->minHeight = height; + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmOverrideredirectCmd -- + * + * This procedure is invoked to process the "wm overrideredirect" + * 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 +WmOverrideredirectCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int boolean, curValue; + XSetWindowAttributes atts; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); + return TCL_ERROR; + } + curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; + if (objc == 3) { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); + return TCL_OK; + } + if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { + return TCL_ERROR; + } + if (curValue != boolean) { + /* + * Only do this if we are really changing value, because it + * causes some funky stuff to occur + */ + atts.override_redirect = (boolean) ? True : False; + Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, + &atts); + if (!(wmPtr->flags & (WM_NEVER_MAPPED) + && !(winPtr->flags & TK_EMBEDDED))) { + UpdateWrapper(winPtr); } - if (argc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; - - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmPositionfromCmd -- + * + * This procedure is invoked to process the "wm positionfrom" + * 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 +WmPositionfromCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "program", "user", (char *) NULL }; + enum options { + OPT_PROGRAM, OPT_USER }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & USPosition) { + Tcl_SetResult(interp, "user", TCL_STATIC); + } else if (wmPtr->sizeHintsFlags & PPosition) { + Tcl_SetResult(interp, "program", TCL_STATIC); } - if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK) - || (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) { + return TCL_OK; + } + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); + } else { + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } - if (width) { - wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE; - } else { - wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE; - } - if (height) { - wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE; + if (index == OPT_USER) { + wmPtr->sizeHintsFlags &= ~PPosition; + wmPtr->sizeHintsFlags |= USPosition; } else { - wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; + wmPtr->sizeHintsFlags &= ~USPosition; + wmPtr->sizeHintsFlags |= PPosition; } - if (!((wmPtr->flags & WM_NEVER_MAPPED) - && !(winPtr->flags & TK_EMBEDDED))) { - UpdateWrapper(winPtr); - } - goto updateGeom; - } else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " sizefrom window ?user|program?\"", - (char *) NULL); - return TCL_ERROR; + } + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmProtocolCmd -- + * + * This procedure is invoked to process the "wm protocol" 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 +WmProtocolCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + register ProtocolHandler *protPtr, *prevPtr; + Atom protocol; + char *cmd; + int cmdLength; + + if ((objc < 3) || (objc > 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); + return TCL_ERROR; + } + if (objc == 3) { + /* + * Return a list of all defined protocols for the window. + */ + for (protPtr = wmPtr->protPtr; protPtr != NULL; + protPtr = protPtr->nextPtr) { + Tcl_AppendElement(interp, + Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); } - if (argc == 3) { - if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); - } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + return TCL_OK; + } + protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); + if (objc == 4) { + /* + * Return the command to handle a given protocol. + */ + for (protPtr = wmPtr->protPtr; protPtr != NULL; + protPtr = protPtr->nextPtr) { + if (protPtr->protocol == protocol) { + Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + return TCL_OK; } - return TCL_OK; } - if (*argv[3] == '\0') { - wmPtr->sizeHintsFlags &= ~(USSize|PSize); - } else { - c = argv[3][0]; - length = strlen(argv[3]); - if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) { - wmPtr->sizeHintsFlags &= ~PSize; - wmPtr->sizeHintsFlags |= USSize; - } else if ((c == 'p') - && (strncmp(argv[3], "program", length) == 0)) { - wmPtr->sizeHintsFlags &= ~USSize; - wmPtr->sizeHintsFlags |= PSize; + return TCL_OK; + } + + /* + * Delete any current protocol handler, then create a new + * one with the specified command, unless the command is + * empty. + */ + + for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL; + prevPtr = protPtr, protPtr = protPtr->nextPtr) { + if (protPtr->protocol == protocol) { + if (prevPtr == NULL) { + wmPtr->protPtr = protPtr->nextPtr; } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be program or user", (char *) NULL); - return TCL_ERROR; + prevPtr->nextPtr = protPtr->nextPtr; } + Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + break; } - goto updateGeom; - } else if ((c == 's') && (strncmp(argv[1], "stackorder", length) == 0) - && (length >= 2)) { - TkWindow **windows, **window_ptr; + } + cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); + if (cmdLength > 0) { + protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); + protPtr->protocol = protocol; + protPtr->nextPtr = wmPtr->protPtr; + wmPtr->protPtr = protPtr; + protPtr->interp = interp; + strcpy(protPtr->command, cmd); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmResizableCmd -- + * + * This procedure is invoked to process the "wm resizable" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], - " stackorder window ?isabove|isbelow window?\"", - (char *) NULL); +static int +WmResizableCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + int width, height; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); + return TCL_ERROR; + } + if (objc == 3) { + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", + (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, + (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; + } + if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) + || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { + return TCL_ERROR; + } + if (width) { + wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE; + } else { + wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE; + } + if (height) { + wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE; + } else { + wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE; + } + if (!((wmPtr->flags & WM_NEVER_MAPPED) + && !(winPtr->flags & TK_EMBEDDED))) { + UpdateWrapper(winPtr); + } + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmSizefromCmd -- + * + * This procedure is invoked to process the "wm sizefrom" 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 +WmSizefromCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "program", "user", (char *) NULL }; + enum options { + OPT_PROGRAM, OPT_USER }; + int index; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); + return TCL_ERROR; + } + if (objc == 3) { + if (wmPtr->sizeHintsFlags & USSize) { + Tcl_SetResult(interp, "user", TCL_STATIC); + } else if (wmPtr->sizeHintsFlags & PSize) { + Tcl_SetResult(interp, "program", TCL_STATIC); + } + return TCL_OK; + } + + if (*Tcl_GetString(objv[3]) == '\0') { + wmPtr->sizeHintsFlags &= ~(USSize|PSize); + } else { + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } + if (index == OPT_USER) { + wmPtr->sizeHintsFlags &= ~PSize; + wmPtr->sizeHintsFlags |= USSize; + } else { /* OPT_PROGRAM */ + wmPtr->sizeHintsFlags &= ~USSize; + wmPtr->sizeHintsFlags |= PSize; + } + } + WmUpdateGeom(wmPtr, winPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmStackorderCmd -- + * + * This procedure is invoked to process the "wm stackorder" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if (argc == 3) { - windows = TkWmStackorderToplevel(winPtr); - if (windows == NULL) { - panic("TkWmStackorderToplevel failed"); - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); - } - ckfree((char *) windows); - return TCL_OK; - } - } else { - TkWindow *winPtr2; - int index1=-1, index2=-1, result; +static int +WmStackorderCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + TkWindow **windows, **window_ptr; + static CONST char *optionStrings[] = { + "isabove", "isbelow", (char *) NULL }; + enum options { + OPT_ISABOVE, OPT_ISBELOW }; + int index; + + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?isabove|isbelow window?"); + return TCL_ERROR; + } - winPtr2 = (TkWindow *) Tk_NameToWindow(interp, argv[4], tkwin); - if (winPtr2 == NULL) { - return TCL_ERROR; + if (objc == 3) { + windows = TkWmStackorderToplevel(winPtr); + if (windows == NULL) { + panic("TkWmStackorderToplevel failed"); + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + Tcl_AppendElement(interp, (*window_ptr)->pathName); } + ckfree((char *) windows); + return TCL_OK; + } + } else { + TkWindow *winPtr2; + int index1=-1, index2=-1, result; - if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) + != TCL_OK) { + return TCL_ERROR; + } + + if (!Tk_IsTopLevel(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't a top-level window", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, + if (!Tk_IsMapped(winPtr)) { + Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't mapped", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + if (!Tk_IsMapped(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, "\" isn't mapped", (char *) NULL); - return TCL_ERROR; - } + return TCL_ERROR; + } - /* - * Lookup stacking order of all toplevels that are children - * of "." and find the position of winPtr and winPtr2 - * in the stacking order. - */ + /* + * Lookup stacking order of all toplevels that are children + * of "." and find the position of winPtr and winPtr2 + * in the stacking order. + */ - windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); + windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); - if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", + if (windows == NULL) { + Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", (char *) NULL); - return TCL_ERROR; - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) - index1 = (window_ptr - windows); - if (*window_ptr == winPtr2) - index2 = (window_ptr - windows); - } - if (index1 == -1) - panic("winPtr window not found"); - if (index2 == -1) - panic("winPtr2 window not found"); - - ckfree((char *) windows); + return TCL_ERROR; + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + if (*window_ptr == winPtr) + index1 = (window_ptr - windows); + if (*window_ptr == winPtr2) + index2 = (window_ptr - windows); } + if (index1 == -1) + panic("winPtr window not found"); + if (index2 == -1) + panic("winPtr2 window not found"); - c = argv[3][0]; - length = strlen(argv[3]); - if ((length > 2) && (c == 'i') - && (strncmp(argv[3], "isabove", length) == 0)) { - result = index1 > index2; - } else if ((length > 2) && (c == 'i') - && (strncmp(argv[3], "isbelow", length) == 0)) { - result = index1 < index2; - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be isabove or isbelow", (char *) NULL); - return TCL_ERROR; - } - Tcl_SetIntObj(Tcl_GetObjResult(interp), result); - return TCL_OK; + ckfree((char *) windows); } - } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0) - && (length >= 2)) { - if ((argc < 3) || (argc > 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " state window ?state?\"", (char *) NULL); + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { return TCL_ERROR; } - if (argc == 4) { - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; + if (index == OPT_ISABOVE) { + result = index1 > index2; + } else { /* OPT_ISBELOW */ + result = index1 < index2; + } + Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + return TCL_OK; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmStateCmd -- + * + * This procedure is invoked to process the "wm state" 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 +WmStateCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + static CONST char *optionStrings[] = { + "normal", "iconic", "withdrawn", "zoomed", (char *) NULL }; + enum options { + OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN, OPT_ZOOMED }; + int index; + + if ((objc < 3) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); + return TCL_ERROR; + } + if (objc == 4) { + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't change state of ", + Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } + if (winPtr->flags & TK_EMBEDDED) { + Tcl_AppendResult(interp, "can't change state of ", + winPtr->pathName, ": it is an embedded window", + (char *) NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + if (index == OPT_NORMAL) { + if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { + wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, ": it is an embedded window", + TkpWmSetState(winPtr, NormalState); + /* + * This varies from 'wm deiconify' because it does not + * force the window to be raised and receive focus + */ + } else if (index == OPT_ICONIC) { + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { + Tcl_AppendResult(interp, "can't iconify \"", + winPtr->pathName, + "\": override-redirect flag is set", (char *) NULL); return TCL_ERROR; } - - c = argv[3][0]; - length = strlen(argv[3]); - - if ((c == 'n') && (strncmp(argv[3], "normal", length) == 0)) { - if (wmPtr->flags & WM_TRANSIENT_WITHDRAWN) { - wmPtr->flags &= ~WM_TRANSIENT_WITHDRAWN; - } - TkpWmSetState(winPtr, NormalState); - /* - * This varies from 'wm deiconify' because it does not - * force the window to be raised and receive focus - */ - } else if ((c == 'i') - && (strncmp(argv[3], "iconic", length) == 0)) { - if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, - "\": override-redirect flag is set", - (char *) NULL); - return TCL_ERROR; - } - if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, - "\": it is a transient", (char *) NULL); - return TCL_ERROR; - } - TkpWmSetState(winPtr, IconicState); - } else if ((c == 'w') - && (strncmp(argv[3], "withdrawn", length) == 0)) { - if (wmPtr->masterPtr != NULL) { - wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; - } - TkpWmSetState(winPtr, WithdrawnState); - } else if ((c == 'z') - && (strncmp(argv[3], "zoomed", length) == 0)) { - TkpWmSetState(winPtr, ZoomState); - } else { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": must be normal, iconic, withdrawn or zoomed", - (char *) NULL); + if (wmPtr->masterPtr != NULL) { + Tcl_AppendResult(interp, "can't iconify \"", + winPtr->pathName, + "\": it is a transient", (char *) NULL); return TCL_ERROR; } - } else { - if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); - } else { - switch (wmPtr->hints.initial_state) { - case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); - break; - case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); - break; - case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); - break; - case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); - break; - } + TkpWmSetState(winPtr, IconicState); + } else if (index == OPT_WITHDRAWN) { + if (wmPtr->masterPtr != NULL) { + wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; } + TkpWmSetState(winPtr, WithdrawnState); + } else { /* OPT_ZOOMED */ + TkpWmSetState(winPtr, ZoomState); } - } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0) - && (length >= 2)) { - if (argc > 4) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " title window ?newTitle?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - Tcl_SetResult(interp, ((wmPtr->titleUid != NULL) ? - wmPtr->titleUid : winPtr->nameUid), TCL_STATIC); - return TCL_OK; + } else { + if (wmPtr->iconFor != NULL) { + Tcl_SetResult(interp, "icon", TCL_STATIC); } else { - wmPtr->titleUid = Tk_GetUid(argv[3]); - if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) { - Tcl_DString titleString; - Tcl_WinUtfToTChar(wmPtr->titleUid, -1, &titleString); - (*tkWinProcs->setWindowText)(wmPtr->wrapper, - (LPCTSTR) Tcl_DStringValue(&titleString)); - Tcl_DStringFree(&titleString); + switch (wmPtr->hints.initial_state) { + case NormalState: + Tcl_SetResult(interp, "normal", TCL_STATIC); + break; + case IconicState: + Tcl_SetResult(interp, "iconic", TCL_STATIC); + break; + case WithdrawnState: + Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + break; + case ZoomState: + Tcl_SetResult(interp, "zoomed", TCL_STATIC); + break; } } - } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0) - && (length >= 3)) { - TkWindow *masterPtr = wmPtr->masterPtr; - WmInfo *wmPtr2; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmTitleCmd -- + * + * This procedure is invoked to process the "wm title" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " transient window ?master?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - if (masterPtr != NULL) { - Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); - } - return TCL_OK; +static int +WmTitleCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + char *argv3; + int length; + + if (objc > 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); + return TCL_ERROR; + } + if (objc == 3) { + Tcl_SetResult(interp, + ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), + TCL_STATIC); + return TCL_OK; + } else { + if (wmPtr->title != NULL) { + ckfree((char *) wmPtr->title); } - if (argv[3][0] == '\0') { - if (masterPtr != NULL) { - /* - * If we had a master, tell them that we aren't tied - * to them anymore - */ + argv3 = Tcl_GetStringFromObj(objv[3], &length); + wmPtr->title = ckalloc((unsigned) (length + 1)); + strcpy(wmPtr->title, argv3); - masterPtr->wmInfoPtr->numTransients--; - Tk_DeleteEventHandler((Tk_Window) masterPtr, - VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); - } + if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) { + Tcl_DString titleString; + Tcl_WinUtfToTChar(wmPtr->title, -1, &titleString); + (*tkWinProcs->setWindowText)(wmPtr->wrapper, + (LPCTSTR) Tcl_DStringValue(&titleString)); + Tcl_DStringFree(&titleString); + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmTransientCmd -- + * + * This procedure is invoked to process the "wm transient" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ - wmPtr->masterPtr = NULL; - } else { - masterPtr = (TkWindow*) Tk_NameToWindow(interp, argv[3], tkwin); - if (masterPtr == NULL) { - return TCL_ERROR; - } - while (!(masterPtr->flags & TK_TOP_HIERARCHY)) { - /* - * Ensure that the master window is actually a Tk toplevel. - */ +static int +WmTransientCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + TkWindow *masterPtr = wmPtr->masterPtr; + WmInfo *wmPtr2; - masterPtr = masterPtr->parentPtr; - } - Tk_MakeWindowExist((Tk_Window)masterPtr); - - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", argv[2], - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), - (char *) NULL); - return TCL_ERROR; - } + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?master?"); + return TCL_ERROR; + } + if (objc == 3) { + if (masterPtr != NULL) { + Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); + } + return TCL_OK; + } + if (Tcl_GetString(objv[3])[0] == '\0') { + if (masterPtr != NULL) { + /* + * If we had a master, tell them that we aren't tied + * to them anymore + */ - wmPtr2 = masterPtr->wmInfoPtr; + masterPtr->wmInfoPtr->numTransients--; + Tk_DeleteEventHandler((Tk_Window) masterPtr, + VisibilityChangeMask|StructureNotifyMask, + WmWaitVisibilityOrMapProc, (ClientData) winPtr); + } - if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", argv[3], - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), - (char *) NULL); - return TCL_ERROR; - } + wmPtr->masterPtr = NULL; + } else { + if (TkGetWindowFromObj(interp, tkwin, objv[3], + (Tk_Window *) &masterPtr) != TCL_OK) { + return TCL_ERROR; + } + while (!Tk_TopWinHierarchy(masterPtr)) { + /* + * Ensure that the master window is actually a Tk toplevel. + */ - if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", - (char *) NULL); - return TCL_ERROR; - } else if (masterPtr != wmPtr->masterPtr) { - /* - * Remove old master map/unmap binding before setting - * the new master. The event handler will ensure that - * transient states reflect the state of the master. - */ + masterPtr = masterPtr->parentPtr; + } + Tk_MakeWindowExist((Tk_Window) masterPtr); - if (wmPtr->masterPtr == NULL) { - masterPtr->wmInfoPtr->numTransients++; - } else { - Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, - VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); - } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't make \"", + Tcl_GetString(objv[2]), + "\" a transient: it is an icon for ", + Tk_PathName(wmPtr->iconFor), + (char *) NULL); + return TCL_ERROR; + } - Tk_CreateEventHandler((Tk_Window) masterPtr, - VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); + wmPtr2 = masterPtr->wmInfoPtr; - wmPtr->masterPtr = masterPtr; - } - } - if (!((wmPtr->flags & WM_NEVER_MAPPED) - && !(winPtr->flags & TK_EMBEDDED))) { - if (wmPtr->masterPtr != NULL && - !Tk_IsMapped(wmPtr->masterPtr)) { - TkpWmSetState(winPtr, WithdrawnState); - } else { - UpdateWrapper(winPtr); - } - } - } else if ((c == 'w') && (strncmp(argv[1], "withdraw", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: must be \"", - argv[0], " withdraw window\"", (char *) NULL); + if (wmPtr2->iconFor != NULL) { + Tcl_AppendResult(interp, "can't make \"", + Tcl_GetString(objv[3]), + "\" a master: it is an icon for ", + Tk_PathName(wmPtr2->iconFor), + (char *) NULL); return TCL_ERROR; } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", argv[2], - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), + + if (masterPtr == winPtr) { + Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), + "\" its own master", (char *) NULL); return TCL_ERROR; + } else if (masterPtr != wmPtr->masterPtr) { + /* + * Remove old master map/unmap binding before setting + * the new master. The event handler will ensure that + * transient states reflect the state of the master. + */ + + if (wmPtr->masterPtr == NULL) { + masterPtr->wmInfoPtr->numTransients++; + } else { + Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, + VisibilityChangeMask|StructureNotifyMask, + WmWaitVisibilityOrMapProc, (ClientData) winPtr); + } + + Tk_CreateEventHandler((Tk_Window) masterPtr, + VisibilityChangeMask|StructureNotifyMask, + WmWaitVisibilityOrMapProc, (ClientData) winPtr); + + wmPtr->masterPtr = masterPtr; } - if (wmPtr->masterPtr != NULL) { - wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; + } + if (!((wmPtr->flags & WM_NEVER_MAPPED) + && !(winPtr->flags & TK_EMBEDDED))) { + if (wmPtr->masterPtr != NULL && + !Tk_IsMapped(wmPtr->masterPtr)) { + TkpWmSetState(winPtr, WithdrawnState); + } else { + UpdateWrapper(winPtr); } - TkpWmSetState(winPtr, WithdrawnState); - } else { - Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1], - "\": must be aspect, attributes, client, command, deiconify, ", - "focusmodel, frame, geometry, grid, group, iconbitmap, ", - "iconify, iconmask, iconname, iconposition, ", - "iconwindow, maxsize, minsize, overrideredirect, ", - "positionfrom, protocol, resizable, sizefrom, stackorder, ", - "state, title, transient, or withdraw", + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WmWithdrawCmd -- + * + * This procedure is invoked to process the "wm withdraw" 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 +WmWithdrawCmd(tkwin, winPtr, interp, objc, objv) + Tk_Window tkwin; /* Main window of the application. */ + TkWindow *winPtr; /* Toplevel to work with */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + if (wmPtr->iconFor != NULL) { + Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), + ": it is an icon for ", Tk_PathName(wmPtr->iconFor), (char *) NULL); return TCL_ERROR; } + if (wmPtr->masterPtr != NULL) { + wmPtr->flags |= WM_TRANSIENT_WITHDRAWN; + } + TkpWmSetState(winPtr, WithdrawnState); return TCL_OK; +} - updateGeom: +/* + * Invoked by those wm subcommands that affect geometry. + * Schedules a geometry update. + */ +static void +WmUpdateGeom(wmPtr, winPtr) + WmInfo *wmPtr; + TkWindow *winPtr; +{ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } - return TCL_OK; } + /*ARGSUSED*/ static void WmWaitVisibilityOrMapProc(clientData, eventPtr) @@ -3859,7 +4822,7 @@ Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc) wmPtr->height = -1; } - /* + /* * Set the new gridding information, and start the process of passing * all of this information to the window manager. */ @@ -3973,7 +4936,7 @@ TopLevelEventProc(clientData, eventPtr) * Tk_DestroyWindow will try to destroy the window, but of course * it's already gone. */ - + handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL); Tk_DestroyWindow((Tk_Window) winPtr); @@ -4178,7 +5141,7 @@ UpdateGeometryInfo(clientData) wmPtr->configWidth = width; wmPtr->configHeight = height; - + /* * Don't bother moving the window if we are in the process of * creating it. Just update the geometry info based on what @@ -4245,7 +5208,7 @@ UpdateGeometryInfo(clientData) GetClientRect(wmPtr->wrapper, &windowRect); newHeight = windowRect.bottom - windowRect.top; - + if (newHeight == height) { /* * We're done. @@ -4817,7 +5780,7 @@ TkWmStackorderToplevel(parentPtr) goto done; } - /* + /* * We will be inserting into the array starting at the end * and working our way to the beginning since EnumWindows * returns windows in highest to lowest order. @@ -5147,7 +6110,7 @@ ConfigureTopLevel(pos) int state; /* Current window state. */ RECT rect; WINDOWPLACEMENT windowPos; - + if (winPtr == NULL) { return; } @@ -5238,7 +6201,7 @@ ConfigureTopLevel(pos) if (state == NormalState) { - /* + /* * Update size information from the event. There are a couple of * tricky points here: * @@ -5301,9 +6264,9 @@ ConfigureTopLevel(pos) wmPtr->flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y); } } - + /* - * Update the wrapper window location information. + * Update the wrapper window location information. */ if (wmPtr->flags & WM_NEGATIVE_X) { @@ -5396,9 +6359,9 @@ InstallColormaps(hwnd, message, isForemost) HPALETTE oldPalette; TkWindow *winPtr = GetTopLevel(hwnd); WmInfo *wmPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - + if (winPtr == NULL) { return 0; } @@ -5558,7 +6521,7 @@ InvalidateSubTree(winPtr, colormap) childPtr = childPtr->nextPtr) { /* * We can stop the descent when we hit an unmapped or - * toplevel window. + * toplevel window. */ if (!Tk_TopWinHierarchy(childPtr) && Tk_IsMapped(childPtr)) { @@ -5587,7 +6550,7 @@ InvalidateSubTree(winPtr, colormap) HPALETTE TkWinGetSystemPalette() { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->systemPalette; @@ -5762,7 +6725,7 @@ TopLevelProc(hwnd, message, wParam, lParam) if (message == WM_WINDOWPOSCHANGED) { WINDOWPOS *pos = (WINDOWPOS *) lParam; TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(pos->hwnd); - + if (winPtr == NULL) { return 0; } @@ -5852,7 +6815,7 @@ WmProc(hwnd, message, wParam, lParam) } break; - case WM_GETMINMAXINFO: + case WM_GETMINMAXINFO: SetLimits(hwnd, (MINMAXINFO *) lParam); result = 0; goto done; @@ -5865,7 +6828,7 @@ WmProc(hwnd, message, wParam, lParam) case WM_QUERYNEWPALETTE: result = InstallColormaps(hwnd, WM_QUERYNEWPALETTE, TRUE); goto done; - + case WM_WINDOWPOSCHANGED: ConfigureTopLevel((WINDOWPOS *) lParam); result = 0; @@ -5909,7 +6872,7 @@ WmProc(hwnd, message, wParam, lParam) * handle the mouse event. */ - if (winPtr) { + if (winPtr) { eventPtr = (ActivateEvent *)ckalloc(sizeof(ActivateEvent)); eventPtr->ev.proc = ActivateWindow; eventPtr->winPtr = winPtr; @@ -5978,13 +6941,13 @@ TkpMakeMenuWindow(tkwin, transient) atts.override_redirect = False; atts.save_under = False; } - + if ((atts.override_redirect != Tk_Attributes(tkwin)->override_redirect) || (atts.save_under != Tk_Attributes(tkwin)->save_under)) { Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect|CWSaveUnder, &atts); } - + } /* @@ -6111,7 +7074,7 @@ ActivateWindow( if (winPtr && (TkGrabState(winPtr) != TK_GRAB_EXCLUDED)) { SetFocus(Tk_GetHWND(winPtr->window)); } - + return 1; } @@ -6139,7 +7102,7 @@ TkWinSetForegroundWindow(winPtr) TkWindow *winPtr; { register WmInfo *wmPtr = winPtr->wmInfoPtr; - + if (wmPtr->wrapper != NULL) { SetForegroundWindow(wmPtr->wrapper); } else { |