Return to common.tcl CVS log

Up to [LON-CAPA] / capa / capa51 / GUITools

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

# 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 <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
}