Googie (21.05.2005) - I've just created some Itcl-based modal widgets and I'd like to share them with others :) There are 2 widgets so far, meaby there'll be more... meaby someone else could add ones.
I know that there is tk_messageBox, but MsgBox looks better (I think so) under X11 and it's Tile-ready.
Modal window (it could be not-modal but callback-mode, optionally) grabs application input (with grab) and halts code execution at exec method call until user response in that window.
Here's example, what you can do with that widgets:
package require Tk
package require Itcl
namespace import itcl::*
source modal.tcl ;# this is base class for all modal widgets
source msgbox.tcl
source inputdialog.tcl
MsgBox msg .question -message "Are you sure about that?" -title "Question" -buttons [list "Yes" "Not sure" "No" "I don't understeand"] -default 0
# here some code, if you want
switch -- [msg exec] {
0 {
puts "He/She wants!"
}
1 {
puts "He/She isn't sure!"
}
2 {
puts "He/She doesn't want!"
}
3 {
puts "He/She doesn't understeand!"
}
}
InputDialog dialog .input -message "Type some value" -title "Input dialog" -default "Some initial string"
# here's some your custom code
set ret [dialog exec]
if {$ret != ""} {
puts "Entered: $ret"
} else {
puts "Entered empty string or clicked cancel/close button"
}
proc test {button} {
puts "Clicked button $button"
}
MsgBox msg .msg -modal 0 -command test -message "Just test"
msg exec
puts "This command is executed immediately, instead waiting for user respond in above MsgBox."And here's code of 2 classes used above and the 3rd class needed by these 2:
class Modal {
constructor {Path Args} {}
destructor {}
protected {
variable modal 1
variable command ""
variable path
variable parent ""
variable default 0
variable title "Modal"
method center {path {parent {}}}
}
public {
variable sleep
method exec {}
method clicked {btn}
}
}
body Modal::constructor {Path Args} {
set path $Path
foreach {opt val} $Args {
switch -- $opt {
"-modal" {
set modal $val
}
"-command" {
set command $val
}
"-title" {
set title $val
}
"-parent" {
set parent ""
}
"-default" {
set default $val
}
}
}
}
body Modal::destructor {} {
destroy $path
}
body Modal::center {path {parent {}}} {
update
if {$parent == ""} {
set sp [split $path .]
if {[llength $sp] > 2} {
set parent [join [lrange $sp 0 end-1] .]
} else {
set parent .
}
}
set sp [split [wm geometry $parent] +]
set px [lindex $sp 1]
set py [lindex $sp 2]
set wd [winfo reqwidth $path]
set ht [winfo reqheight $path]
set x [expr {$px+([winfo reqwidth $parent]-$wd)/2}]
set y [expr {$py+([winfo reqheight $parent]-$ht)/2}]
wm geometry $path +$x+$y
}
body Modal::clicked {btn} {
}
body Modal::exec {} {
}
class MsgBox {
inherit Modal
constructor {Path args} {
Modal::constructor $Path $args
} {}
private {
variable buttons "ok"
variable msg ""
}
public {
method exec {}
method clicked {btn}
}
}
body MsgBox::constructor {Path args} {
set title "MsgBox"
foreach {opt val} $args {
switch -- $opt {
"-message" {
set msg $val
}
"-buttons" {
set buttons $val
}
}
}
}
body MsgBox::exec {} {
toplevel $path
frame $path.u
pack $path.u -side top -fill both
label $path.u.l -text "" -font "helvetica 12 bold" -relief groove -bd 2
pack $path.u.l -side top -fill x -pady 0.1c -padx 0.2c
frame $path.d
pack $path.d -side bottom -fill x
frame $path.d.f
pack $path.d.f -side bottom
set i 0
foreach txt $buttons {
button $path.d.f.$i -text $txt -command "$this clicked $i"
pack $path.d.f.$i -side left -pady 3
incr i
}
bind $path <Destroy> "catch {$this configure -sleep $default}"
wm title $path $title
$path.u.l configure -text $msg
center $path $parent
update
wm resizable $path 0 0
if {$modal} {
if {$parent == ""} {
set sp [split $path .]
if {[llength $sp] > 2} {
set parent [join [lrange $sp 0 end-1] .]
} else {
set parent .
}
}
grab $path
vwait [scope sleep]
set retval $sleep
delete object $this
return $retval
}
}
body MsgBox::clicked {btn} {
if {$command != ""} {
eval $command $btn
} else {
set sleep $btn
}
}
class InputDialog {
inherit Modal
constructor {Path args} {
Modal::constructor $Path $args
} {}
destructor {}
private {
variable msg ""
}
public {
method exec {}
method clicked {btn}
}
}
body InputDialog::constructor {Path args} {
set path $Path
foreach {opt val} $args {
switch -- $opt {
"-message" {
set msg $val
}
}
}
}
body InputDialog::destructor {} {
destroy $path
}
body InputDialog::exec {} {
toplevel $path
frame $path.u
pack $path.u -side top -fill both
label $path.u.l -text "" -font "helvetica 12 bold" -justify left
pack $path.u.l -side top -fill x -pady 2 -padx 0.2c
entry $path.u.e
pack $path.u.e -side top -fill x -pady 0.1c -padx 0.2c
frame $path.d
pack $path.d -side bottom -fill x
frame $path.d.f
pack $path.d.f -side bottom
button $path.d.f.ok -text "Ok" -command "$this clicked ok"
pack $path.d.f.ok -side left -pady 3
button $path.d.f.cancel -text "Cancel" -command "$this clicked cancel"
pack $path.d.f.cancel -side left -pady 3
bind $path <Destroy> "catch {$this configure -sleep {}}"
wm title $path $title
$path.u.l configure -text $msg
center $path $parent
update
wm resizable $path 0 0
focus -force $path.u.e
$path.u.e insert end $default
$path.u.e selection range 0 end
if {$modal} {
if {$parent == ""} {
set sp [split $path .]
if {[llength $sp] > 2} {
set parent [join [lrange $sp 0 end-1] .]
} else {
set parent .
}
}
grab $path
vwait [scope sleep]
set retval $sleep
delete object $this
return $retval
}
}
body InputDialog::clicked {btn} {
if {$btn == "cancel"} {
set sleep ""
return
}
if {$command != ""} {
eval $command [$path.u.e get]
} else {
set sleep [$path.u.e get]
}
}[ Category Widget ]