[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.

----

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]
]]