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 <KeyPress> "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 <KeyPress> ""
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 <KeyPress> "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 <KeyPress> ""
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 <ButtonRelease> {}
} else {
set window [lindex $args 0]
grab $window
bind all <ButtonRelease> "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 <Return> "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 <B1-ButtonRelease> "eval $script"
bind $printerListbox <Key> "eval $script"
bind $printerListbox <Motion> "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 <Alt-Key> 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 <Alt-Key> 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) <Configure> "tkIconList_Arrange $w"
bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
bind $data(canvas) <Double-1> "tkIconList_Double1 $w %x %y"
bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
bind $data(canvas) <B1-Leave> "tkIconList_Leave1 $w %x %y"
bind $data(canvas) <B1-Enter> "tkCancelRepeat"
bind $data(canvas) <Up> "tkIconList_UpDown $w -1"
bind $data(canvas) <Down> "tkIconList_UpDown $w 1"
bind $data(canvas) <Left> "tkIconList_LeftRight $w -1"
bind $data(canvas) <Right> "tkIconList_LeftRight $w 1"
bind $data(canvas) <Return> "tkIconList_ReturnKey $w"
bind $data(canvas) <KeyPress> "tkIconList_KeyPress $w %A"
bind $data(canvas) <Control-KeyPress> ";"
bind $data(canvas) <Alt-KeyPress> ";"
bind $data(canvas) <FocusIn> "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 <Return> "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 <Return> "set gPromptMC(ok) 1"
bind $setWin <Double-1> "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 <Return> "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 <Return> "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 <Destroy> "set gPromptPS(yes) 0"
pack $buttonFrame.yes $buttonFrame.spacer \
$buttonFrame.selectall $buttonFrame.cancel -side left
bind $dialog <Alt-Key> break
Centre_Dialog $dialog default
update
focus $dialog
capaRaise $dialog
capaGrab $dialog
vwait gPromptPS(yes)
capaGrab release $dialog
bind $dialog <Destroy> ""
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 <Destroy> "set gPromptPSets(yes) 0"
bind $dialog <Double-1> "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 <Alt-Key> break
Centre_Dialog $dialog default
update
focus $dialog
capaRaise $dialog
capaGrab $dialog
vwait gPromptPSets(yes)
capaGrab release $dialog
bind $dialog <Destroy> ""
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
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to common.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools