package require Tclx set auto_path [linsert $auto_path 0 $env(ANTELOPE)/data/tcl/library_contrib] CommandCheckoff name -label label \ [-labeljustify where] \ [-labelanchor where] \ [-command command] \ [-commandcolor color] \ [-nocommandcolor color] \ [-variable variable] \ [-background background]
#!/bin/sh # \ exec $ANTELOPE/bin/awish $0 -- "$@" package require Datascope package require Tclx set auto_path [linsert $auto_path 0 $env(ANTELOPE)/data/tcl/library_contrib] proc do_taskA {} { puts stdout "Doing the work for task A" } proc do_taskB {} { puts stdout "Doing the work for task B" } proc do_taskC {} { puts stdout "Doing the work for task C" } CommandCheckoff .taskA -label "Task A" \ -command do_taskA \ -variable taskA pack .taskA -side top -fill x CommandCheckoff .taskB -label "Task B" \ -command do_taskB \ -variable taskB pack .taskB -side top -fill x CommandCheckoff .taskC -label "Task C" \ -command do_taskC \ -variable taskC pack .taskC -side top -fill x button .quit -bg red -text Quit -command ApprovedExit pack .quit -side top -fill x set progname try proc ApprovedExit {} { global progname set procedures [list taskA \ taskB \ taskC ] catch { [destroy .exit] } toplevel .exit -class Dialog set report "" set quit "Quit" foreach var $procedures { global $var set checked [set $var] set state [.$var.b config -state] set state [lindex $state 4] if { $checked && $state == "disabled" } { # Task completed } elseif { $checked } { lappend Skipped $var } else { lappend Missed $var } } if { [info exists Missed] } { foreach var $Missed { puts \007 append report "\nTask $var was missed !!\n" set quit "Quit Anyway" } } if { $report != "" } { append report "\n" } if { [info exists Skipped] } { foreach var $Skipped { append report "\nTask $var intentionally skipped.\n" } } if { $report == "" } { destroy . } label .exit.l -text $report -background "orange red" -fg yellow pack .exit.l -side top -fill x button .exit.cancel -text "Return to $progname" -command \ "destroy .exit" -background chartreuse pack .exit.cancel -side top -fill x button .exit.fit -text $quit -command "destroy ." \ -background red pack .exit.fit -side top -fill x grab set .exit tkwait window .exit grab release .exit }
Kent Lindquist Lindquist Consulting