# functions common to all to main CAPA programs # Copyright (C) 1992-2000 Michigan State University # # The CAPA system is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation; either version 2 of the # License, or (at your option) any later version. # # The CAPA system is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public # License along with the CAPA system; see the file COPYING. If not, # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # # As a special exception, you have permission to link this program # with the TtH/TtM library and distribute executables, as long as you # follow the requirements of the GNU GPL in regard to all of the # software in the executable aside from TtH/TtM. set gMaxSet 99 ########################################################### # capaRaise ########################################################### # tries to make sure that the window mostly definatley ends # up on top. Needed to do this beacuase of how an Xserver # for WinNT handles raise ########################################################### # Argument: window - name of the window to get on top # Returns : nothing # Globals : nothing ########################################################### proc capaRaise { window } { if { $window == "" } { return } wm withdraw $window wm deiconify $window # raise $window } ########################################################### # cleanWindowList ########################################################### ########################################################### ########################################################### proc cleanWindowList { } { global gWindowMenu gCmd gUndoSize gUndo set gCmd "Tcl Commands executed: [info cmdcount]" catch {set gUndoSize "Undo information size [array size gUndo]:[string length [array get gUndo]]"} if { ![winfo exists $gWindowMenu] } { after 1000 cleanWindowList return } set num [$gWindowMenu index end] for { set i 1 } { $i <= $num } { incr i } { set window [lindex [$gWindowMenu entrycget $i -command] 1] if { ![winfo exists $window] } { $gWindowMenu delete $i incr i -1 set num [$gWindowMenu index end] } } after 1000 cleanWindowList } ########################################################### # createRemapWindow ########################################################### # creates the window to start the process of remapping or unmapping # the xKeySym for a key ########################################################### # Argument: none # Returns: nothing # Globals: gWindowMenu - used to register the window under the windows # menu ########################################################### proc createRemapWindow {} { global gWindowMenu if { [winfo exists .remap] } { capaRaise .remap return } set remap [toplevel .remap] $gWindowMenu add command -label "Remap" -command "capaRaise $remap" wm title $remap "Select Remap Command" label $remap.label -text "This requires that xmodmap be in your path" button $remap.delete -text "Remap a key to delete" -command \ "remap Delete destroy $remap removeWindowEntry Remap" button $remap.backspace -text "Remap a key to backspace" -command \ "remap BackSpace destroy $remap removeWindowEntry Remap" button $remap.unmap -text "Unmap a remapped key" -command \ "remap unmap destroy $remap removeWindowEntry Remap" button $remap.cancel -text "Cancel" -command \ "destroy $remap removeWindowEntry Remap" pack $remap.label $remap.delete $remap.backspace $remap.unmap \ $remap.cancel -side top Centre_Dialog $remap default } ########################################################### # remap ########################################################### # creates a window thaat tells the user to press a key, which globally # grabs input, and the runs xmodmap to a file it creates in /tmp named # gkc[pid]. ########################################################### # Arguments: one of (Delete,Backspace,unmap), type of remap to preform # Returns: nothing # Globals: gOriginalKeySyms - stores the KeySyms and keycodes of # remmapped keys. # gPromptRemap - used to capture the keypress by the user. # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap # (created and removed) ########################################################### proc remap { type } { global gOriginalKeySyms gPromptRemap set gPromptRemap(result) "" switch $type { Delete - BackSpace { set dialog [toplevel .dialog] wm title $dialog "Grabbing keypress" label $dialog.label -text "Press the key that you want to remap \ to $type" label $dialog.label2 -textvariable gPromptRemap(result) pack $dialog.label $dialog.label2 bind all "set gPromptRemap(result) \"%k %K\"" Centre_Dialog $dialog default capaRaise $dialog focus $dialog grab -global $dialog vwait gPromptRemap(result) grab release $dialog destroy $dialog bind all "" set oldKeyCode [lindex $gPromptRemap(result) 0] set oldKeySym [lindex $gPromptRemap(result) 1] set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ] if { $error == 1 } { set gOriginalKeySyms($oldKeyCode) $oldKeySym } exec echo "keycode $oldKeyCode = $type" > [ file join / tmp \ gkc[pid] ] exec xmodmap [ file join / tmp gkc[pid] ] displayMessage "Remapped $oldKeySym to $type" } unmap { set dialog [toplevel .dialog] wm title $dialog "Grabbing keypress" label $dialog.label -text "Press the key that you want to unmap" label $dialog.label2 -textvariable gPromptRemap(result) pack $dialog.label $dialog.label2 bind all "set gPromptRemap(result) \"%k %K\"" Centre_Dialog $dialog default capaRaise $dialog focus $dialog grab -global $dialog vwait gPromptRemap(result) grab release $dialog destroy $dialog bind all "" set oldKeyCode [lindex $gPromptRemap(result) 0] set oldKeySym [lindex $gPromptRemap(result) 1] set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ] if { $error == 1 } { displayMessage "Sorry, $oldKeySym has not been remapped \ since Quizzer has been started." } else { exec echo "keycode $oldKeyCode = \ $gOriginalKeySyms($oldKeyCode)" > \ [ file join / tmp gkc[pid] ] exec xmodmap [ file join / tmp gkc[pid] ] displayMessage "Remapped $oldKeySym back to \ $gOriginalKeySyms($oldKeyCode) " } } } catch { rm -f [file join / tmp gkc*]} } ########################################################### # unmapAllKeys ########################################################### # wanders through the gOriginalKeySyms var and unmap individually # all of the keys that had been remmapped ########################################################### # Arguments: none # Returns: nothing # Globals: gOriginalKeySyms - stores the original KeySym values by # keycodes that have been remmapped # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap # (created and removed) ########################################################### proc unmapAllKeys { } { global gOriginalKeySyms set allKeyCodes [array names gOriginalKeySyms] while { $allKeyCodes != "" } { set oldKeyCode [lindex $allKeyCodes 0] set allKeyCodes [lrange $allKeyCodes 1 end] exec echo "keycode $oldKeyCode = $gOriginalKeySyms($oldKeyCode)" \ > [ file join / tmp gkc[pid] ] exec xmodmap [ file join / tmp gkc[pid] ] catch { rm -rf [ file join / tmp gkc*] } } #displayMessage "Remapped all keys back to original value." } ########################################################### # displayError ########################################################### # displays a modal dialog with an errormessage to the user ########################################################### # Arguments: the message to be displayed # Returns: Nothing # Globals: gPromptDE - used to detect when the user presses ok ########################################################### proc displayError { msg {color black} } { global gPromptDE set dialog [toplevel .prompt -borderwidth 10] wm geo $dialog "+200+200" wm title $dialog "Error" message $dialog.warning -text "WARNING" -font 12x24 -aspect 700 message $dialog.msg -text "$msg" -aspect 700 -foreground $color set buttonFrame [frame $dialog.buttons -bd 10] pack $dialog.warning $dialog.msg $buttonFrame -side top -fill x button $buttonFrame.ok -text Dismiss -command { set gPromptDE(ok) 1 } \ -underline 0 pack $buttonFrame.ok -side left Centre_Dialog $dialog default update capaRaise $dialog focus $dialog capaGrab $dialog vwait gPromptDE(ok) capaGrab release $dialog destroy $dialog return } ########################################################### # capaGrab ########################################################### # modification of tcl's grab, this one sets up a binding so that # if you click anywhere else the window is reshuffled back to the # top ########################################################### # Arguments: either "window" or "release window" # Returns: Nothing # Globals: None ########################################################### proc capaGrab { args } { if { [lindex $args 0] == "release" } { set window [lindex $args 1] grab release $window bind all {} } else { set window [lindex $args 0] grab $window bind all "capaAutoRaise $window %W" } } proc capaAutoRaise { window reportWin } { if { $window == $reportWin } { capaRaise $window focus $window } } ########################################################### # displayMessage ########################################################### # displays a modal dialog with a message to the user ########################################################### # Arguments: the message to be displayed # Returns: Nothing # Globals: gPromptDM - used to detect when the user presses ok ########################################################### proc displayMessage { msg {color black} } { global gPromptDM set dialog [toplevel .prompt -borderwidth 10] wm geo $dialog "+200+200" wm title $dialog "Message" message $dialog.msg -text "$msg" -aspect 700 -foreground $color set buttonFrame [frame $dialog.buttons -bd 10] pack $dialog.msg $buttonFrame -side top -fill x button $buttonFrame.ok -text Dismiss -command { set gPromptDM(ok) 1 } \ -underline 0 pack $buttonFrame.ok -side left bind $buttonFrame.ok "set gPromptDM(ok) 1" Centre_Dialog $dialog default update focus $dialog capaRaise $dialog capaGrab $dialog vwait gPromptDM(ok) capaGrab release $dialog destroy $dialog return } ########################################################### # getLprCommand ########################################################### # builds a command string to print with ########################################################### # Arguments: name of the file to be printed # num - index of options in gCapaConfig # Returns: the print command if accepted, Cancel if cancel was hit # Globals: gPrompt - the variable watched to control when to # remove the dialog # gLprCommand - the variable which stores a specified command # gCapaConfig - the variable holding the print strings from # the capa.config file ########################################################### proc getLprCommand { PS_file {num ""}} { global gLprCommand gPrompt gCapaConfig Printer_selected if { $num != "" } { set prefix "$num." } else { set prefix "" } set showPrinterList false set dialog [toplevel .lprCommand -borderwidth 10] wm title $dialog "Command to Print" wm geo $dialog "+200+200" set infoFrame [ frame $dialog.infoFrame ] set optionsFrame [ frame $dialog.optionsFrame ] set buttonFrame [frame $dialog.buttons -bd 10] pack $infoFrame $optionsFrame $buttonFrame -side top -fill x -anchor w message $infoFrame.msg -text "Select a printing method:" -aspect 5000 pack $infoFrame.msg set printInfo [frame $optionsFrame.info] set printerList [frame $optionsFrame.list] set printerListFrame [frame $optionsFrame.printFrame] set oneSidedFrame [frame $optionsFrame.oneSided] set twoSidedFrame [frame $optionsFrame.twoSided] set spaceFrame [frame $optionsFrame.space -height 30] set specifiedFrame [frame $optionsFrame.specified] pack $printInfo $printerList $oneSidedFrame $twoSidedFrame \ $spaceFrame $specifiedFrame -side top -anchor w pack configure $printInfo -anchor w pack configure $printerList -anchor e if { [array names gLprCommand which] == "" } { set gLprCommand(which) "" } radiobutton $oneSidedFrame.radio -text "One Sided" -value \ "OneSided" -variable gLprCommand(which) message $oneSidedFrame.cmd -text $gCapaConfig([set prefix]lprOneSided_command) \ -relief raised -width 600 -aspect 5000 if { $gCapaConfig([set prefix]lprOneSided_command) != "" } { if { $gLprCommand(which) == "" } { set gLprCommand(which) OneSided } set showPrinterList true pack $oneSidedFrame.radio $oneSidedFrame.cmd -side top pack configure $oneSidedFrame.radio -anchor w pack configure $oneSidedFrame.cmd -anchor e } radiobutton $twoSidedFrame.radio -text "Two Sided" -value \ "TwoSided" -variable gLprCommand(which) message $twoSidedFrame.cmd -text $gCapaConfig([set prefix]lprTwoSided_command) \ -relief raised -width 400 -aspect 5000 if { $gCapaConfig([set prefix]lprTwoSided_command) != "" } { if { $gLprCommand(which) == "" } { set gLprCommand(which) TwoSided } set showPrinterList true pack $twoSidedFrame.radio $twoSidedFrame.cmd -side top pack configure $twoSidedFrame.radio -anchor w pack configure $twoSidedFrame.cmd -anchor e } message $printInfo.text -text "\$Printer_selected = " -aspect 5000 message $printInfo.current -textvariable Printer_selected \ -aspect 5000 pack $printInfo.text $printInfo.current -side left set printerListbox [ listbox $printerList.list -width 20 \ -yscrollcommand "$printerList.scroll set" -height 3 ] scrollbar $printerList.scroll -orient v -command "$printerList.list yview" if { $showPrinterList && $gCapaConfig([set prefix]printer_option) != "" } { pack $printerListbox $printerList.scroll -side left -anchor e pack configure $printerList.scroll -fill y foreach printer $gCapaConfig([set prefix]printer_option) { $printerListbox insert end $printer } set Printer_selected [lindex $gCapaConfig([set prefix]printer_option) 0] if { $gCapaConfig(Printer_selected) == "" } { set gCapaConfig(Printer_selected) 0 } $printerListbox selection set $gCapaConfig(Printer_selected) $printerListbox see $gCapaConfig(Printer_selected) set script "set Printer_selected \[$printerListbox get \[$printerListbox curselection \] \]" eval $script bind $printerListbox "eval $script" bind $printerListbox "eval $script" bind $printerListbox "eval $script" } radiobutton $specifiedFrame.radio -text "Specified" -value \ "Specified" -variable gLprCommand(which) if { $gLprCommand(which) == "" } { set gLprCommand(which) Specified } message $specifiedFrame.msg -text "Print command:" -aspect 5000 entry $specifiedFrame.entry -textvariable gLprCommand(Specified) \ -width 40 -xscrollcommand "$specifiedFrame.scroll set" trace variable gLprCommand(Specified) w \ "global gLprCommand; set gLprCommand(which) Specified ;#" scrollbar $specifiedFrame.scroll -command "$specifiedFrame.entry xview" \ -orient h message $specifiedFrame.msg2 -text "Example: lpr -PlocalPrinter" \ -aspect 5000 pack $specifiedFrame.radio $specifiedFrame.msg $specifiedFrame.entry \ $specifiedFrame.scroll $specifiedFrame.msg2 -side top pack configure $specifiedFrame.radio -anchor w pack configure $specifiedFrame.entry -anchor w pack configure $specifiedFrame.scroll -fill x button $buttonFrame.ok -text Print -command {set gPrompt(yes) 1} \ -underline 0 button $buttonFrame.cancel -text Cancel -command { set gPrompt(yes) 0 } \ -underline 0 pack $buttonFrame.ok $buttonFrame.cancel -side left bind $dialog break Centre_Dialog $dialog default update focus $dialog capaRaise $dialog capaGrab $dialog vwait gPrompt(yes) capaGrab release $dialog if {$gPrompt(yes)} { switch $gLprCommand(which) { Specified { set command "$gLprCommand(Specified)" } OneSided { set command "$gCapaConfig([set prefix]lprOneSided_command)" } TwoSided { set command "$gCapaConfig([set prefix]lprTwoSided_command)" } default { destroy $dialog return "Cancel" } } if { $command == "" } { destroy $dialog displayError "An empty print command can not be used." return "Cancel" } set gCapaConfig(Printer_selected) [$printerListbox curselection] if { [string first \$PS_file $command] == -1 } { set command "$command $PS_file" set command [subst $command] } else { set command [subst $command] } destroy $dialog return "$command" } else { destroy $dialog return "Cancel" } } ########################################################### # makeSure ########################################################### # generalized Yes No question proc, ########################################################### # Arguments: a string containing the question to ask the user # Returns: Yes, or Cancel # Globals: gPrompt - used to watch for a response ########################################################### proc makeSure { question } { global gPrompt set dialog [toplevel .makeSurePrompt -borderwidth 10] wm geo $dialog "+200+200" message $dialog.msg -text "$question" -aspect 700 set gPrompt(result) "" set buttonFrame [frame $dialog.buttons -bd 10] pack $dialog.msg $buttonFrame -side top -fill x button $buttonFrame.yes -text Yes -command {set gPrompt(yes) 1} \ -underline 0 frame $buttonFrame.spacer button $buttonFrame.cancel -text No -command { set gPrompt(yes) 0 } \ -underline 0 pack $buttonFrame.yes $buttonFrame.spacer $buttonFrame.cancel -side left pack configure $buttonFrame.spacer -expand 1 -fill x bind $dialog break Centre_Dialog $dialog default update focus $dialog capaRaise $dialog capaGrab $dialog vwait gPrompt(yes) capaGrab release $dialog destroy $dialog if {$gPrompt(yes)} { return Yes } else { return Cancel } } ########################################################### # parseCapaConfig ########################################################### ########################################################### ########################################################### proc parseCapaConfig { {num "" } { path "" } } { global gCapaConfig if { $num != "" } { set prefix "$num." } else { set prefix "" } if { $path == "" } { set path [pwd] } set filename [file join $path capa.config] set error [ catch { set fileId [open $filename "r"] } ] if { $error } { displayError "Unable to find a capa.config file in $path." error "No capa.config" } set saveto "" set saveline false while { 1 } { gets $fileId aline if { [eof $fileId ] } { break } set error [ catch { switch -glob -- "$aline" { "printer_option *= *" { lappend gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] } "BeginStandardQuizzerHeader*" { set saveto [set prefix]standardQuizzerHeader set saveline true set gCapaConfig($saveto) "" set aline "" } "EndStandardQuizzerHeader*" { set saveto "" set saveline false } "quizzerBackupQZ *= *" - "quizzerBackupRef *= *" - "lprOneSided_command *= *" - "lprTwoSided_command *= *" - "latex_command *= *" - "allcapaid_command *= *" - "qzparse_command *= *" - "answers_command *= *" - "dvips_command *= *" - "xdvi_command *= *" - "mail_command *= *" - "IMP_color *= *" - "comment_color *= *" - "exam_path *= *" - "quiz_path *= *" - "supp_path *= *" - "correction_path *= *" - "default_try_val *= *" - "default_prob_val *= *" - "default_hint_val *= *" - "homework_weight *= *" - "quiz_weight *= *" - "exam_weight *= *" - "final_weight *= *" - "correction_weight *= *" - "final_exam_set_number *= *" - "homework_count *= *" - "quiz_count *= *" - "others_path *= *" { set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] } } } ] if { $error } { displayError "Error in capa.config file in line: $aline" } if { $saveline } { append gCapaConfig($saveto) "$aline\n" } } close $fileId return OK } ########################################################### # parseCapaUtilsConfig ########################################################### ########################################################### ########################################################### proc parseCapaUtilsConfig { num path } { global gCapaConfig set filename [file join $path capa.config] set error [ catch { set fileId [open $filename "r"] } ] if { $error } { displayError "Unable to find a capautils.config file in $path." error "No capautils.config" } set saveto "" set saveline false while { 1 } { gets $fileId aline if { [eof $fileId ] } { break } set error [ catch { switch -glob -- "$aline" { "homework_scores_limit_set *= *" - "exam_scores_limit_set *= *" - "quiz_scores_limit_set *= *" - "supp_scores_limit_set *= *" - "others_scores_limit_set *= *" - "master_scores_file *= *" - "email_template_file *= *" - "correction_factor *= *" - "hw_percent *= *" - "qz_percent *= *" - "mt1_percent *= *" - "mt2_percent *= *" - "mt3_percent *= *" - "final_percent *= *" - "category_one_high *= *" - "category_one_low *= *" - "category_two_high *= *" - "category_two_low *= *" - "category_three_high *= *" - "category_three_low *= *" - "category_four_high *= *" - "category_four_low *= *" - "display_score_row_limit *= *" { set gCapaConfig($num.[lindex $aline 0]) [lindex $aline end] } } } ] if { $error } { displayError "Error in capautils.config file in line: $aline" } if { $saveline } { append capaConfig($saveto) "$aline\n" } } return OK } ########################################################### # removeWindowEntry ########################################################### # used to deregister a Window Menu entry ########################################################### # Arguments: the label the window was registered under # Returns: nothing # Globals: gWindowMenu - name of the WindowMenu ########################################################### proc removeWindowEntry { label } { global gWindowMenu catch {$gWindowMenu delete $label} } proc scrolltwo { firstcommand secondcommand args } { eval "$firstcommand $args" eval "$secondcommand $args" } ########################################################### # getTextTagged ########################################################### ########################################################### ########################################################### proc getTextTagged { window tag } { if { $tag == "" } { return [$window get 0.0 end-1c] } set result "" set range [$window tag nextrange $tag 0.0] while { $range != "" } { set index [lindex $range 1] append result [eval "$window get $range"] append result "\n" set range [$window tag nextrange $tag $index] } return $result } ########################################################### # getWhichTags ########################################################### ########################################################### ########################################################### proc getWhichTags { descriptions tags action } { set whichtag [eval "tk_dialog .whichtag {Select which messages} \ {Select which set of messages will be $action.} \ {} 0 $descriptions"] return [lindex $tags $whichtag] } ########################################################### # displayStatus ########################################################### # creates a window on the screen with one or both of a message # or a canvas with a status bar, uses updateStatusMessage and # updateStatusBar to update the respective parts of the status # window, and use removeStatus to remove the status bar from # the screen ########################################################### # Arguments: the message to be displayed (a blank if one is not wanted) # and one of (both, bar, or message) to specify what # parts one wnats in the status bar and optionally a number # if there might be more than one Status at a time # Returns: Nothing # Globals: gStatus - an array containing information for the status # ($num.type) - the type of status # ($num.message) - the message in the status window # ($num.bar) - the id number of the rectangle in the canvas # (num) - (Optional) if there are multiple Statuses # the number of the Status ########################################################### proc displayStatus { message type {num 0} } { global gStatus if { [winfo exists .status$num]} { capaRaise .status$num return } set status [toplevel .status$num] set gStatus($num.type) $type set gStatus($num.message) "$message" switch $type { spinner { message $status.msg -textvariable gStatus($num.message) -aspect 700 set gStatus($num.spinner) "-" message $status.spinner -textvariable gStatus($num.spinner) -aspect 700 pack $status.msg $status.spinner -side top } both - bar { message $status.msg -textvariable gStatus($num.message) -aspect 700 canvas $status.canvas -width 200 -height 20 $status.canvas create rectangle 1 1 199 19 -outline black set gStatus($num.bar) [$status.canvas create rectangle 1 1 1 19 \ -fill red -outline black] pack $status.msg $status.canvas -side top } message { message $status.msg -textvariable gStatus($num.message) -aspect 700 pack $status.msg } } Centre_Dialog $status default update idletasks } ########################################################### # updateStatusMessage ########################################################### # updates the message in the status bar ########################################################### # Arguments: the new message for the status bar and optionally a number # if there might be more than one Status at a time # Returns: Nothing # Globals: gStatus - an array containing information for the status # ($num.type) - the type of status # ($num.message) - the message in the status window # ($num.bar) - the id number of the rectangle in the canvas # (num) - (Optional) if there are multiple Statuses # the number of the Status ########################################################### proc updateStatusMessage { message { num 0 } } { global gStatus set gStatus($num.message) "$message" update idletasks } ########################################################### # updateStatusBar ########################################################### # updates the bar in the status bar ########################################################### # Arguments: a floating point number between 0 and 1 that is # the percentage done and optionally a number # if there might be more than one Status at a time # Returns: Nothing # Globals: gStatus - an array containing information for the status # ($num.type) - the type of status # ($num.message) - the message in the status window # ($num.bar) - the id number of the rectangle in the canvas # (num) - (Optional) if there are multiple Statuses # the number of the Status ########################################################### proc updateStatusBar { percent { num 0 } } { global gStatus .status$num.canvas coords $gStatus($num.bar) 1 1 [expr $percent * 200 ] 19 update idletasks } ########################################################### # updateStatusSpinner ########################################################### # updates the spinner in the status bar ########################################################### # Arguments: optionally a number if there might be more # than one Status at a time # Returns: Nothing # Globals: gStatus - an array containing information for the status # ($num.type) - the type of status # ($num.message) - the message in the status window # ($num.bar) - the id number of the rectangle in the canvas # (num) - (Optional) if there are multiple Statuses # the number of the Status ########################################################### proc updateStatusSpinner { { num 0 } } { global gStatus switch -- $gStatus($num.spinner) { "-" { set gStatus($num.spinner) "\\" } "\\" { set gStatus($num.spinner) "|" } "|" { set gStatus($num.spinner) "/" } "/" { set gStatus($num.spinner) "-" } } update idletasks } ########################################################### # removeStatus ########################################################### # takes the status message off of the screen, must be eventually # called after a call to displayStatus ########################################################### # Arguments: and optionally a number if there might be more # than one Status at a time # Returns: Nothing # Globals: gStatus - an array containing information for the status # ($num.type) - the type of status # ($num.message) - the message in the status window # ($num.bar) - the id number of the rectangle in the canvas ########################################################### proc removeStatus { {num 0 } } { global gStatus foreach name [array names gStatus "$num.*"] { unset gStatus($name) } destroy .status$num update idletasks } ########################################################### # tkFDialogResolveFile ########################################################### # I don't like how this version of the Tcl dialog box code # evaluates links, my code here makes it so that clicking # on Open does the same thing as double clicking does, it # returns the path in the top of the dialog box along with # the new filename ########################################################### # I do this catch command to get Tcl to source the # tkfbox.tcl file, then I change the tkFDialogResolveFile # command ########################################################### catch {tkFDialogResolveFile} proc tkFDialogResolveFile {context text defaultext} { set appPWD [pwd] set path [tkFDialog_JoinFile $context $text] if {[file ext $path] == ""} { set path "$path$defaultext" } if [catch {file exists $path}] { return [list ERROR $path ""] } if [catch {if [file exists $path] {}}] { # This "if" block can be safely removed if the following code returns # an error. It currently (7/22/97) doesn't # # file exists ~nonsuchuser # return [list ERROR $path ""] } if [file exists $path] { if [file isdirectory $path] { if [catch { cd $path }] { return [list CHDIR $path ""] } set directory [pwd] set file "" set flag OK cd $appPWD } else { if [catch { cd [file dirname $path] }] { return [list CHDIR [file dirname $path] ""] } set directory [pwd] set directory [file dirname $path] set file [file tail $path] set flag OK cd $appPWD } } else { set dirname [file dirname $path] if [file exists $dirname] { if [catch { cd $dirname }] { return [list CHDIR $dirname ""] } set directory [pwd] set file [file tail $path] if [regexp {[*]|[?]} $file] { set flag PATTERN } else { set flag FILE } cd $appPWD } else { set directory $dirname set file [file tail $path] set flag PATH } } return [list $flag $directory $file] } ########################################################### # tkIconList_Create ########################################################### # Ed wants a bigger default dialog box ########################################################### # I do this catch command to get Tcl to source the # tkfbox.tcl file, then I change the tkIconList_Create # command ########################################################### catch {tkIconList_Create} proc tkIconList_Create {w} { upvar #0 $w data frame $w set data(sbar) [scrollbar $w.sbar -orient horizontal \ -highlightthickness 0 -takefocus 0] set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \ -width 600 -height 180 -takefocus 1] pack $data(sbar) -side bottom -fill x -padx 2 pack $data(canvas) -expand yes -fill both $data(sbar) config -command "$data(canvas) xview" $data(canvas) config -xscrollcommand "$data(sbar) set" # Initializes the max icon/text width and height and other variables # set data(maxIW) 1 set data(maxIH) 1 set data(maxTW) 1 set data(maxTH) 1 set data(numItems) 0 set data(curItem) {} set data(noScroll) 1 # Creates the event bindings. # bind $data(canvas) "tkIconList_Arrange $w" bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y" bind $data(canvas) "tkIconList_Motion1 $w %x %y" bind $data(canvas) "tkIconList_Double1 $w %x %y" bind $data(canvas) "tkCancelRepeat" bind $data(canvas) "tkIconList_Leave1 $w %x %y" bind $data(canvas) "tkCancelRepeat" bind $data(canvas) "tkIconList_UpDown $w -1" bind $data(canvas) "tkIconList_UpDown $w 1" bind $data(canvas) "tkIconList_LeftRight $w -1" bind $data(canvas) "tkIconList_LeftRight $w 1" bind $data(canvas) "tkIconList_ReturnKey $w" bind $data(canvas) "tkIconList_KeyPress $w %A" bind $data(canvas) ";" bind $data(canvas) ";" bind $data(canvas) "tkIconList_FocusIn $w" return $w } ########################################################### # findByStudentNumber ########################################################### ########################################################### ########################################################### proc findByStudentNumber { pattern path } { set file [file join $path "classl"] if {[catch {set fileId [open $file "r"]}]} { return "" } set matched_entries "" set aline [gets $fileId] while { ! [eof $fileId] } { set aline [string trimright $aline] set tmp_sn [string range $aline 14 22] if { [regexp -nocase $pattern $tmp_sn] } { lappend matched_entries [ list $tmp_sn [string range $aline 24 53] ] } set aline [gets $fileId] } close $fileId return $matched_entries } ########################################################### # findByStudentName ########################################################### ########################################################### ########################################################### proc findByStudentName { pattern path } { set file [file join $path "classl"] if {[catch {set fileId [open $file "r"]}]} { return "" } set matched_entries "" set aline [gets $fileId] while { ! [eof $fileId] } { set aline [string trimright $aline] set tmp_name [string range $aline 24 53] if { [regexp -nocase $pattern $tmp_name] } { lappend matched_entries [list [string range $aline 14 22] $tmp_name] } set aline [gets $fileId] } close $fileId return $matched_entries } ########################################################### # fillInStudent ########################################################### ########################################################### ########################################################### proc fillInStudent { fullnameVar numberVar doname } { upvar $fullnameVar fullname $numberVar number if { !$doname } { set matched_entries [findByStudentNumber [string trim $number] .] } else { set matched_entries [findByStudentName [string trim $fullname] .] } if { [llength $matched_entries] == 0 } { displayMessage "No student found. Please re-enter student info." set id ""; set name "" } elseif { [llength $matched_entries] == 1 } { set id [lindex [lindex $matched_entries 0] 0] set name [lindex [lindex $matched_entries 0] 1] } else { set select [ multipleChoice .main "Matched Student Records, Select one" \ $matched_entries ] if { $select == "" } { set id ""; set name "" } else { set id [lindex $select 0] set name [lindex $select 1] } } set fullname $name set number $id } ########################################################### # getOneStudent ########################################################### # Lets you pick a student by name or student number # then verifies that they are in the classlist ########################################################### ########################################################### proc getOneStudent { window path idVar nameVar {message "" } {message2 ""}} { upvar $idVar id upvar $nameVar name set select [tk_dialog $window.dialog "Student select method" \ "$message Select student by:" "" "" "Student Number" \ "Student Name" "Cancel"] if { $select == 2 } { set id "" set name "" return } set done 0 while { ! $done } { if { $select } { set search "name" } { set search "number" } set pattern [ getString $window "$message Please enter a student $search." ] if {$pattern == "" } { set done 1 set id "" set name "" continue } if { $select } { set matched_entries [findByStudentName $pattern $path] } else { set matched_entries [findByStudentNumber $pattern $path] } if { [llength $matched_entries] == 0 } { displayMessage "No student found. Please re-enter student $search." } elseif { [llength $matched_entries] == 1 } { set id [lindex [lindex $matched_entries 0] 0] set name [lindex [lindex $matched_entries 0] 1] set done 1 } elseif { [llength $matched_entries] < 30 } { set select [ multipleChoice $window "Matched Student Records, Select one. $message2" \ $matched_entries ] if { $select == "" } { set id ""; set name "" return } set id [lindex $select 0] set name [lindex $select 1] set done 1 } else { displayMessage "There were [llength $matched_entries], please enter more data to narrow the search." } } } ########################################################### # getString ########################################################### ########################################################### ########################################################### proc getString { window message {type "any"}} { global gPrompt set setWin [toplevel $window.getstring] set msgFrame [frame $setWin.msgFrame] set valFrame [frame $setWin.valFrame] set buttonFrame [frame $setWin.buttonFrame] pack $msgFrame $valFrame $buttonFrame set gPrompt(val) "" entry $valFrame.val -textvariable gPrompt(val) -validate key \ -validatecommand "limitEntry %W -1 $type %P" pack $valFrame.val message $msgFrame.msg -text $message -aspect 3000 pack $msgFrame.msg button $buttonFrame.select -text "Continue" -command { set gPrompt(ok) 1 } button $buttonFrame.cancel -text "Cancel" -command { set gPrompt(ok) 0 } pack $buttonFrame.select $buttonFrame.cancel -side left bind $setWin "set gPrompt(ok) 1" Centre_Dialog $setWin default update idletasks focus $setWin focus $valFrame.val capaRaise $setWin capaGrab $setWin vwait gPrompt(ok) capaGrab release $setWin destroy $setWin if { $gPrompt(ok) == 1 } { return $gPrompt(val) } else { return "" } } ########################################################### # multipleChoice ########################################################### ########################################################### ########################################################### proc multipleChoice { window message choices {single 1}} { global gPromptMC set setWin [toplevel $window.choice] set msgFrame [frame $setWin.msgFrame] set valFrame [frame $setWin.valFrame] set buttonFrame [frame $setWin.buttonFrame] pack $msgFrame $valFrame $buttonFrame pack configure $valFrame -expand 1 -fill both message $msgFrame.msg -text $message -aspect 3000 pack $msgFrame.msg set maxWidth 1 foreach choice $choices { if {[string length $choice] > $maxWidth} {set maxWidth [string length $choice]} } set selectMode extended if { $single } { set selectMode single } listbox $valFrame.val -width [expr $maxWidth + 2] \ -yscrollcommand "$valFrame.scroll set" -selectmode $selectMode scrollbar $valFrame.scroll -command "$valFrame.val yview" pack $valFrame.val $valFrame.scroll -side left pack configure $valFrame.val -expand 1 -fill both pack configure $valFrame.scroll -expand 0 -fill y foreach choice $choices { $valFrame.val insert end $choice } button $buttonFrame.select -text "Continue" -command { set gPromptMC(ok) 1 } frame $buttonFrame.spacer -width 10 button $buttonFrame.selectall -text "SelectAll" -command \ "$valFrame.val selection set 0 end" button $buttonFrame.cancel -text "Cancel" -command { set gPromptMC(ok) 0 } if { $single } { pack $buttonFrame.select $buttonFrame.cancel -side left } else { pack $buttonFrame.select $buttonFrame.spacer \ $buttonFrame.selectall $buttonFrame.cancel -side left } bind $setWin "set gPromptMC(ok) 1" bind $setWin "set gPromptMC(ok) 1" Centre_Dialog $setWin default update idletasks focus $setWin capaRaise $setWin capaGrab $setWin while { 1 } { update idletasks vwait gPromptMC(ok) if { $gPromptMC(ok) != 1 } { break } set select [$valFrame.val curselection] if { $select != "" } { break } } capaGrab release $setWin destroy $setWin update idletasks if { $gPromptMC(ok) == 1 } { foreach selection $select { lappend result [lindex $choices $selection] } if { [llength $result] == 1 } { set result [lindex $result 0] } return $result } else { return "" } } ########################################################### # getSetRange ########################################################### ########################################################### ########################################################### proc getSetRange { window path } { global gMaxSet gPromptGSR for { set i 1 } { $i <= $gMaxSet } { incr i } { if { ! [file exists [file join $path records "set$i.db"]] } { break } } incr i -1 set setWin [toplevel $window.setselect] set msgFrame [frame $setWin.msgFrame] set valFrame [frame $setWin.calFrame] set buttonFrame [frame $setWin.buttonFrame] pack $msgFrame $valFrame $buttonFrame message $msgFrame.msg -text "Please select a set range:" -aspect 1000 pack $msgFrame.msg global gSetNumberStart gSetNumberEnd scale $valFrame.start -from 1 -to $i -variable gSetNumberStart -orient h scale $valFrame.end -from 1 -to $i -variable gSetNumberEnd -orient h pack $valFrame.start $valFrame.end button $buttonFrame.select -text "Select" -command { set gPromptGSR(ok) 1 } button $buttonFrame.cancel -text "Cancel" -command { set gPromptGSR(ok) 0 } pack $buttonFrame.select $buttonFrame.cancel -side left bind $setWin "set gPromptGSR(ok) 1" Centre_Dialog $setWin default update idletasks focus $setWin capaRaise $setWin capaGrab $setWin vwait gPromptGSR(ok) capaGrab release $setWin destroy $setWin if { $gPromptGSR(ok) == 1 } { set setIdStart $gSetNumberStart set setIdEnd $gSetNumberEnd if { $setIdStart > $setIdEnd } { set setIdEnd $setIdStart } unset gSetNumberStart unset gSetNumberEnd return [list $setIdStart $setIdEnd] } else { unset gSetNumberStart unset gSetNumberEnd return "" } } ########################################################### # getOneSet ########################################################### ########################################################### ########################################################### proc getOneSet { window path } { global gMaxSet gPromptGOS for { set i 1 } { $i <= $gMaxSet } { incr i } { if { ! [file exists [file join $path records "set$i.db"]] } { break } } incr i -1 set setWin [toplevel $window.setselect] set msgFrame [frame $setWin.msgFrame] set valFrame [frame $setWin.calFrame] set buttonFrame [frame $setWin.buttonFrame] pack $msgFrame $valFrame $buttonFrame message $msgFrame.msg -text "Please select a set:" -aspect 1000 pack $msgFrame.msg global gSetNumber scale $valFrame.val -from 1 -to $i -variable gSetNumber -orient h pack $valFrame.val button $buttonFrame.select -text "Select" -command { set gPromptGOS(ok) 1 } button $buttonFrame.cancel -text "Cancel" -command { set gPromptGOS(ok) 0 } pack $buttonFrame.select $buttonFrame.cancel -side left bind $setWin "set gPromptGOS(ok) 1" Centre_Dialog $setWin default update idletasks focus $setWin capaRaise $setWin capaGrab $setWin vwait gPromptGOS(ok) capaGrab release $setWin destroy $setWin if { $gPromptGOS(ok) == 1 } { set setId $gSetNumber unset gSetNumber return $setId } else { unset gSetNumber return "" } } ########################################################### # pickSections ########################################################### ########################################################### ########################################################### proc pickSections { sectionsToPickFrom {title "Select Sections"} {window ""}} { global gPromptPS set dialog [toplevel $window.pickSections -borderwidth 10] wm title $dialog "Which Sections" set infoFrame [frame $dialog.info ] set sectionListFrame [frame $dialog.list -relief groove -borderwidth 5] set buttonFrame [frame $dialog.buttons -bd 10] pack $infoFrame $sectionListFrame $buttonFrame -side top -fill x message $infoFrame.msg -text $title -aspect 5000 pack $infoFrame.msg set headerFrame [frame $sectionListFrame.head ] set listboxFrame [frame $sectionListFrame.listboxframe] pack $headerFrame $listboxFrame -side top pack configure $headerFrame -anchor w message $headerFrame.msg -text "Section number # of students" \ -aspect 5000 pack $headerFrame.msg set sectionList [ listbox $listboxFrame.list \ -yscrollcommand "$listboxFrame.scroll set" \ -width 30 -height 10 -selectmode extended ] scrollbar $listboxFrame.scroll \ -command "$listboxFrame.list yview" \ -orient v pack $sectionList $listboxFrame.scroll -side left pack configure $listboxFrame.scroll -fill y foreach section $sectionsToPickFrom { $sectionList insert end \ [format "%3d %4d" [lindex $section 0]\ [lindex $section 1] ] } button $buttonFrame.yes -text Continue -command {set gPromptPS(yes) 1} \ -underline 0 frame $buttonFrame.spacer -width 10 button $buttonFrame.selectall -text "SelectAll" -command \ "$sectionList selection set 0 end" button $buttonFrame.cancel -text Cancel -command { set gPromptPS(yes) 0 } \ -underline 0 bind $dialog "set gPromptPS(yes) 0" pack $buttonFrame.yes $buttonFrame.spacer \ $buttonFrame.selectall $buttonFrame.cancel -side left bind $dialog break Centre_Dialog $dialog default update focus $dialog capaRaise $dialog capaGrab $dialog vwait gPromptPS(yes) capaGrab release $dialog bind $dialog "" if {$gPromptPS(yes)} { set selectionList [ $sectionList curselection ] set sectionsToPrint "" foreach selection $selectionList { append sectionsToPrint "[lindex [$sectionList get $selection] 0] " } destroy $dialog return $sectionsToPrint } else { destroy $dialog return Cancel } } ########################################################### # pickSets ########################################################### ########################################################### ########################################################### proc pickSets { setsToPickFrom mode {title "Select Sets"} {window ""}} { global gPromptPSets if { $setsToPickFrom == "" } { displayMessage "No available sets." return "Cancel" } set dialog [toplevel $window.pickSets -borderwidth 10] wm title $dialog "Which Sets" set infoFrame [frame $dialog.info ] set setListFrame [frame $dialog.list -relief groove -borderwidth 5] set buttonFrame [frame $dialog.buttons -bd 10] pack $infoFrame $setListFrame $buttonFrame -side top -fill x message $infoFrame.msg -text $title -aspect 5000 pack $infoFrame.msg set headerFrame [frame $setListFrame.head ] set listboxFrame [frame $setListFrame.listboxframe] pack $headerFrame $listboxFrame -side top pack configure $headerFrame -anchor w message $headerFrame.msg -text "Set #" -aspect 5000 pack $headerFrame.msg set setList [ listbox $listboxFrame.list \ -yscrollcommand "$listboxFrame.scroll set" \ -width 30 -height 10 -selectmode $mode ] scrollbar $listboxFrame.scroll \ -command "$listboxFrame.list yview" \ -orient v pack $setList $listboxFrame.scroll -side left pack configure $listboxFrame.scroll -fill y foreach set $setsToPickFrom { $setList insert end [format "%3d" $set] } button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \ -underline 0 frame $buttonFrame.spacer -width 10 button $buttonFrame.selectall -text "SelectAll" -command \ "$setList selection set 0 end" button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \ -underline 0 bind $dialog "set gPromptPSets(yes) 0" bind $dialog "set gPromptPSets(yes) 1" if { $mode == "single" } { pack $buttonFrame.yes $buttonFrame.cancel -side left } else { pack $buttonFrame.yes $buttonFrame.spacer \ $buttonFrame.selectall $buttonFrame.cancel -side left } bind $dialog break Centre_Dialog $dialog default update focus $dialog capaRaise $dialog capaGrab $dialog vwait gPromptPSets(yes) capaGrab release $dialog bind $dialog "" if {$gPromptPSets(yes)} { set selectionList [ $setList curselection ] set setsToDo "" foreach selection $selectionList { lappend setsToDo [string trim [lindex [$setList get $selection] 0]] } destroy $dialog return $setsToDo } else { destroy $dialog return Cancel } } ########################################################### # getSet ########################################################### ########################################################### ########################################################### proc getSet { pid set followupCommand {start 1}} { global gCapaConfig gGetSet gUniqueNumber set num [incr gUniqueNumber] if { $start } { set gGetSet($num.toprocess) $pid set gGetSet($num.command) $followupCommand if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 } } if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet} set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set" foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) } set fileId [open "|$command" "r"] # puts "new command $num $fileId" fileevent $fileId readable "getSetLine $num $fileId" update idletasks } ########################################################### # getSetQuestion ########################################################### ########################################################### ########################################################### proc getSetQuestion { num fileId } { global gGetSet # puts -nonewline "$num $fileId " if { $gGetSet(exit) } { fileevent $fileId readable "" catch {close $fileId} return } set questNum $gGetSet($num.questNum) set aline [gets $fileId] if { $aline != "" } { switch [lindex [split $aline :] 0] { EQES { # puts -nonewline " EQES " fileevent $fileId readable "getSetLine $num $fileId" } default { # puts -nonewline " QES TEXT " lappend gGetSet($num.$questNum.quest) $aline } } } else { # puts -nonewline " QES BLANK " } if { [eof $fileId] } { getSetEnd $fileId } # puts "" } ########################################################### # getSetLine ########################################################### ########################################################### ########################################################### proc getSetLine { num fileId } { global gGetSet # puts -nonewline "$num $fileId " if { $gGetSet(exit) } { fileevent $fileId readable "" catch {close $fileId} return } set aline [gets $fileId] if { $aline != "" } { switch [lindex [split $aline :] 0] { ANS { set list [array name gGetSet "$num.*"] # puts -nonewline " ANS $aline :$list: " set questNum $gGetSet($num.questNum) set ans [string range $aline 4 end] set length [llength $ans] lappend gGetSet($num.$questNum.ans) [lindex $ans 0] if { ($length == 2) || ($length == 4)} { lappend gGetSet($num.$questNum.unit) [lindex $ans end] } if { ($length == 3) || ($length == 4) } { lappend gGetSet($num.$questNum.low) [lindex $ans 1] lappend gGetSet($num.$questNum.high) [lindex $ans 2] } set list [array name gGetSet "$num.*"] # puts -nonewline " $ans :$list: " } DONE { # puts -nonewline " DONE " set gGetSet($num.maxprob) $gGetSet($num.questNum) } ERROR { # puts -nonewline " ERROR " fileevent $fileId readable "" displayError "Answers returned invalid message: $aline" fileevent $fileId readable "getSetLine $num $fileId" } BQES { # puts -nonewline " BQES " incr gGetSet($num.questNum) fileevent $fileId readable "getSetQuestion $num $fileId" } SET { # puts -nonewline " SET " set gGetSet($num.questNum) 0 } default { # puts "What's this: $aline" } } } else { # puts -nonewline "BLANK" } if { [eof $fileId] } { getSetEnd $num $fileId } # puts "" } ########################################################### # getSetEnd ########################################################### ########################################################### ########################################################### proc getSetEnd { num fileId } { global gGetSet if { [eof $fileId] } { catch {close $fileId} set command $gGetSet($num.command) # puts [array name gGetSet "$num.*"] # parray gGetSet foreach var [array names gGetSet "$num.*"] { set var2 [join [lrange [split $var .] 1 end] .] set array($var2) $gGetSet($var) # puts "unset $var" unset gGetSet($var) } # parray gGetSet eval $command [list [array get array]] } } ########################################################### # lunique -- # order independent list unique proc. most efficient, but requires # __LIST never be an element of the input list # Arguments: # __LIST list of items to make unique # Returns: # list of only unique items, order not defined ########################################################### proc lunique __LIST { if {[llength $__LIST]} { foreach $__LIST $__LIST break unset __LIST return [info locals] } } ########################################################### # lreverse ########################################################### proc lreverse list { set result "" foreach element $list { set result [linsert $result 0 $element] } return [concat $result] } proc splitline { line maxLength } { set length [string length $line] set lines [expr $length/$maxLength + 1] set i 0 while { 1 } { if { [string length $line] > $maxLength } { set end [string wordstart $line $maxLength] while {1} { if {[string index $line $end] == " "} {break} {incr end -1} } append lin [string range $line 0 [expr int($end-1)]]\n set line [string range $line $end end] } else { append lin $line break } incr i } return $lin } ########################################################### # winputs ########################################################### ########################################################### ########################################################### proc winputs { num message {tag normal} } { global gOut lappend gOut(output.$num) [list $message $tag] } ########################################################### # winoutputWrap ########################################################### ########################################################### ########################################################### proc winoutputWrap { num } { global gOut if { $gOut($num.wrap) } { $gOut($num.output) configure -wrap char } else { $gOut($num.output) configure -wrap none } } ########################################################### # winoutput ########################################################### ########################################################### ########################################################### proc winoutput { num cmdnum window } { global gOut if { ![winfo exists $window.output$num] } { set outputWin [toplevel $window.output$num] set buttonFrame [frame $outputWin.button] set textFrame [frame $outputWin.text] set bottomFrame [frame $outputWin.bottom] pack $buttonFrame $textFrame $bottomFrame pack configure $buttonFrame -anchor e -expand 0 -fill x pack configure $textFrame -expand 1 -fill both pack configure $bottomFrame -expand 0 -fill x set gOut($num.output) [text $textFrame.text \ -yscrollcommand "$textFrame.scroll set" \ -xscrollcommand "$bottomFrame.scroll set"] scrollbar $textFrame.scroll -command "$textFrame.text yview" pack $gOut($num.output) $textFrame.scroll -side left pack configure $textFrame.text -expand 1 -fill both pack configure $textFrame.scroll -expand 0 -fill y scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h pack $bottomFrame.scroll -expand 0 -fill x set gOut($num.wrap) 1 checkbutton $buttonFrame.wrap -text "Wrap" -command "winoutputWrap $num" \ -variable gOut($num.wrap) # button $buttonFrame.save -text "Save Text" -command "CTsaveText $num" button $buttonFrame.print -text "Print Text" -command "winprintText $num" button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin" # pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \ $buttonFrame.dismiss -side left pack $buttonFrame.wrap $buttonFrame.print $buttonFrame.dismiss -side left } set index [$gOut($num.output) index end] foreach line $gOut(output.$cmdnum) { eval $gOut($num.output) insert end $line } unset gOut(output.$cmdnum) capaRaise $window.output$num $gOut($num.output) see $index update idletasks } ########################################################### # winprintText ########################################################### # prints the contents of the text window, creates a temp file named # quiztemp.txt ########################################################### # Arguments: num (the unique number of the path, and window) # Returns : nothing # Globals : gFile gCT ########################################################### proc winprintText { num } { global gOut set window $gOut($num.output) if { ![winfo exists $window]} { return } catch {parseCapaConfig $num} set lprCommand [getLprCommand commontemp.txt $num] if {$lprCommand == "Cancel"} { return } set fileId [open commontemp.txt w] puts -nonewline $fileId [$window get 0.0 end-1c] close $fileId set errorMsg "" if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} { displayError "An error occurred while printing: $errorMsg" } else { displayMessage "Print job sent to the printer.\n $output" } exec rm -f commontemp.txt } ########################################################### # limitEntry ########################################################### ########################################################### ########################################################### proc limitEntry { window max type {newvalue ""}} { after idle "$window config -validate key" if {($max != -1) && ([string length $newvalue] > $max)} { return 0 } switch $type { any {} number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } } letter { if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }} nospace {if {(![regexp "^\[^ \]+$" $newvalue])&& ($newvalue!="")} { return 0 }} } return 1 } ########################################################### # getCapaID ########################################################### ########################################################### ########################################################### proc getCapaID { setinfo stunum sectionnum {path .} } { global gMaxSet set pwd [pwd] cd $path set result "" switch -regexp -- $setinfo { ^[0-9]+$ { set result [getSpecificCapaId $stunum $setinfo] } ^[0-9]+\.\.[0-9]+$ { set range [split $setinfo .] set low [lindex $range 0] set high [lindex $range 2] for { set i $low } { $i <= $high } { incr i } { append result "[getSpecificCapaId $stunum $i] " } } ^[0-9]+(,[0-9]+)+$ { set list [split $setinfo ,] foreach set $list { append result "[getSpecificCapaId $stunum $set] " } } all { for { set i 1 } { $i <= $gMaxSet } { incr i } { if { [file exists [file join records date$i.db]] } { if { [isSetOpen $stunum $sectionnum $i] } { append result "[getSpecificCapaId $stunum $i] " } } else { break } } } default { set result "UNKNOWN" } } cd $pwd set result [string trim $result] return $result } ########################################################### # getScores ########################################################### ########################################################### ########################################################### proc getScores { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} { global gMaxSet if { $limitVar != "none" } { upvar $limitVar limit } set pwd [pwd] cd $path set result "0" switch -regexp -- $setinfo { ^[0-9]+$ { if { $setinfo <= $max } { set result [format "%4d" [getScore $stunum $setinfo]] } } ^[0-9]+\.\.[0-9]+$ { set range [split $setinfo .] set low [lindex $range 0] set high [lindex $range 2] if { $high > $max } { set high $max } for { set i $low } { $i <= $high } { incr i } { incr result [getScore $stunum $i] } set result [format "%4d" $result] } ^[0-9]+(,[0-9]+)+$ { set result "" set list [split $setinfo ,] foreach set $list { if { $set > $max } { continue } append result [format "%4d " [getScore $stunum $set]] } } all { for { set i 1 } { $i <= $max } { incr i } { if { [file exists [file join records date$i.db]] } { if { [isSetOpen $stunum $sectionnum $i] } { incr result [getScore $stunum $i] } } else { set result [format "%4d" $result] break } } set limit [expr {$i-1}] } default { set result "UNKNOWN" } } cd $pwd set result [string trimright $result] return $result } ########################################################### # getScore ########################################################### ########################################################### ########################################################### proc getScore { stunum set } { set fileId [open [file join records set$set.db] r] set total_score 0 set aline [gets $fileId] set weights [split [gets $fileId] {}] set aline [gets $fileId] set aline [gets $fileId] while {! [eof $fileId]} { if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} { set scores [lindex [split [lindex [split $aline " "] 1] ","] 0] set scores [split $scores {}] for { set i 0 } { $i < [llength $scores] } { incr i } { switch -- [lindex $scores $i] { y - Y { incr total_score [lindex $weights $i] } n - N - e - E - - { } 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { # catching in case weights is not as long as the record catch {incr total_score [lindex $scores $i]} } default { puts "Unknown character [lindex $scores $i]" } } } break } set aline [gets $fileId] } close $fileId return $total_score } ########################################################### # getTotals ########################################################### ########################################################### ########################################################### proc getTotals { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} { global gMaxSet if { $limitVar != "none" } { upvar $limitVar limit } set pwd [pwd] cd $path set result "0" switch -regexp -- $setinfo { ^[0-9]+$ { if { $setinfo <= $max } { set result [format "%4d" [getTotal $stunum $setinfo]] } } ^[0-9]+\.\.[0-9]+$ { set range [split $setinfo .] set low [lindex $range 0] set high [lindex $range 2] if { $high > $max } { set high $max } for { set i $low } { $i <= $high } { incr i } { incr result [getTotal $stunum $i] } set result [format "%4d" $result] } ^[0-9]+(,[0-9]+)+$ { set result "" set list [split $setinfo ,] foreach set $list { if { $set > $max } { continue } append result [format "%4d " [getTotal $stunum $set]] } } all { for { set i 1 } { $i <= $max } { incr i } { if { [file exists [file join records date$i.db]] } { if { [isSetOpen $stunum $sectionnum $i] } { incr result [getTotal $stunum $i] } } else { set result [format "%4d" $result] break } } set limit [expr {$i-1}] } default { set result "UNKNOWN" } } cd $pwd set result [string trimright $result] return $result } ########################################################### # getTotal ########################################################### ########################################################### ########################################################### proc getTotal { stunum set } { set fileId [open [file join records set$set.db] r] set total_total 0 set aline [gets $fileId] set weights [split [gets $fileId] {}] set aline [gets $fileId] set aline [gets $fileId] while {! [eof $fileId]} { if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} { set scores [lindex [split [lindex [split $aline " "] 1] ","] 0] set scores [split $scores {}] for { set i 0 } { $i < [llength $scores] } { incr i } { switch -- [lindex $scores $i] { e - E { } 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - y - Y - n - N - - { catch { incr total_total [lindex $weights $i] } } default { catch { incr total_total [lindex $weights $i] } puts "Unknown character [lindex $scores $i]" } } } break } set aline [gets $fileId] } close $fileId return $total_total }