--- capa/capa51/GUITools/common.tcl	1999/12/16 22:18:35	1.4
+++ capa/capa51/GUITools/common.tcl	2000/08/07 20:47:29	1.11
@@ -1,3 +1,26 @@
+# 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
@@ -568,14 +591,24 @@ proc parseCapaConfig { {num "" } { path
 		"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] 
 		}
@@ -1221,6 +1254,7 @@ proc multipleChoice { window message cho
     }
 
     bind $setWin <Return> "set gPromptMC(ok) 1"
+    bind $setWin <Double-1> "set gPromptMC(ok) 1"
     Centre_Dialog $setWin default
     update idletasks
     focus $setWin
@@ -1235,6 +1269,7 @@ proc multipleChoice { window message cho
     }
     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] }
@@ -1428,6 +1463,92 @@ proc pickSections { sectionsToPickFrom {
 }
 
 ###########################################################
+# 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
 ###########################################################
 ###########################################################
@@ -1438,13 +1559,13 @@ proc getSet { pid set followupCommand {s
     if { $start } { 
 	set gGetSet($num.toprocess) $pid
 	set gGetSet($num.command) $followupCommand
-	foreach name [array names gGetSet {*.[alhu]*}] { unset gGetSet($name) }
 	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
 }
@@ -1456,6 +1577,7 @@ proc getSet { pid set followupCommand {s
 ###########################################################
 proc getSetQuestion { num fileId } {
     global gGetSet 
+#    puts -nonewline "$num $fileId "
     if { $gGetSet(exit) } { 
 	fileevent $fileId readable ""
 	catch {close $fileId}
@@ -1465,11 +1587,20 @@ proc getSetQuestion { num fileId } {
     set aline [gets $fileId]
     if { $aline != "" } {
 	switch [lindex [split $aline :] 0] {
-	    EQES { fileevent $fileId readable "getSetLine $num $fileId" }
-	    default { lappend gGetSet($num.$questNum.quest) $aline }
+	    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 ""
 }
 
 ###########################################################
@@ -1480,6 +1611,7 @@ proc getSetQuestion { num fileId } {
 proc getSetLine { num fileId } {
     global gGetSet 
     
+#    puts -nonewline "$num $fileId "
     if { $gGetSet(exit) } { 
 	fileevent $fileId readable ""
 	catch {close $fileId}
@@ -1489,6 +1621,8 @@ proc getSetLine { num 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]
@@ -1500,22 +1634,34 @@ proc getSetLine { num fileId } {
 		    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 { set gGetSet($num.maxprob) $gGetSet($num.questNum) }
+	    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 { set gGetSet($num.questNum) 0 }
-	    default {}
+	    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 ""
 }
 
 ###########################################################
@@ -1524,16 +1670,20 @@ proc getSetLine { num fileId } {
 ###########################################################
 ###########################################################
 proc getSetEnd { num fileId } {
-    global gGetSet c
+    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)
 	}
-	eval "$command array"
+#	parray gGetSet
+	eval $command [list [array get array]]
     }
 }
 
@@ -1554,6 +1704,15 @@ proc lunique __LIST {
     }
 }
 
+###########################################################
+# 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]
@@ -1699,3 +1858,235 @@ proc limitEntry { window max type {newva
     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
+}