Return to gradesubjective.tcl CVS log

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

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

# grade subjective responses
#  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

proc gradeSubjective {} {
    global gSubj

    if { [winfo exists .gradeSubjective] } { return }
    set var [tk_getOpenFile -title "Please select a capa.config file" -filetypes \
		 { { {Capa Config} {capa.config} } }]
    
    if { $var != "" } {
	set gSubj(dir) [file dirname $var]
	cd $gSubj(dir)
    } else {
	return
    }
    parseCapaConfig
    if { "" == [set gSubj(set) [getOneSet {} $gSubj(dir)]] } return
    if { "" == [set gSubj(quest) [getString {} "Which question?"]] } return
    set fileid [open "records/set$gSubj(set).db" r]
    gets $fileid aline
    gets $fileid aline
    set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
    set gSubj(keywords) ""
    createGradeSubjWindow
}

proc createGradeSubjWindow {} {
    global gSubj

    set gradSubj [toplevel .gradesubjective]
    wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"

    set info [frame $gradSubj.info]
    set grade [frame $gradSubj.grade]
    set keyword [frame $gradSubj.keyword]
    set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]]
    pack $info $grade $keyword -side top

    set msg [frame $info.msg]
    set id [frame $info.id]
    pack $msg $id -side left
    
#    set gSubj(msg) [text $msg.text -width 40 -height 8 -yscrollcommand "$msg.scroll set"]
#    scrollbar $msg.scroll -command "$msg.text yview"
#    pack $gSubj(msg) $msg.scroll -side left
#    pack configure $msg.scroll -fill y
#    $gSubj(msg) tag configure error -foreground red
#    $gSubj(msg) tag configure info -foreground #006c00

    set msglist [frame $msg.msglist]
    set msgbutton [frame $msg.msgbutton]
    pack $msglist $msgbutton -side top
    pack configure $msgbutton -anchor w

    set gSubj(responseList) [listbox $msglist.list -width 40 -height 5 \
				 -yscrollcommand "$msglist.scroll set"]
    scrollbar $msglist.scroll -command "$msglist.list yview"
    pack $gSubj(responseList) $msglist.scroll -side left
    pack configure $msglist.scroll -fill y
    
    set gSubj(numresponse) 0

    button $msgbutton.send -text Send -command subjSendResponse
    button $msgbutton.new -text New -command subjNewResponse
    button $msgbutton.delete -text Delete -command subjDeleteResponse
    button $msgbutton.view -text View -command subjViewResponse
    button $msgbutton.edit -text Edit -command subjEditResponse
    pack $msgbutton.send $msgbutton.new $msgbutton.delete $msgbutton.view \
	$msgbutton.edit -side left

    set idlist [frame $id.idlist]
    set idbutton [frame $id.idbutton]
    pack $idlist $idbutton -side top
    pack configure $idbutton -anchor w

    set gSubj(idlist) [listbox $idlist.list -width 34 -height 5 \
			   -yscrollcommand "$idlist.scroll set"]
    scrollbar $idlist.scroll -command "$idlist.list yview"
    pack $idlist.list $idlist.scroll -side left
    pack configure $idlist.scroll -fill y

    button $idbutton.delete -text Delete -command subjDeleteId
    frame $idbutton.spacer -width 30
    label $idbutton.l1 -text "\# Words:"
    label $idbutton.words -textvariable gSubj(numwords)
    pack $idbutton.delete $idbutton.spacer $idbutton.l1 $idbutton.words -side left 
    
    set response [frame $grade.response]
    pack $response 

    set scoreandcom [toplevel $gradSubj.scoreandcom]
    wm title $scoreandcom "Control Panel"  
    wm protocol $scoreandcom WM_DELETE_WINDOW "subjDone"

    set score [frame $scoreandcom.score]
    set command [frame $scoreandcom.command]
    set morebut [frame $scoreandcom.morebut]
    set stat [frame $scoreandcom.stat]
    pack $score $command $morebut $stat -side top

    set command1 [frame $command.command1]
    set command2 [frame $command.command2]
    pack $command1 $command2 -side left

    set top [frame $response.top]
    set bot [frame $response.bot]
    pack $top $bot -side top
    pack configure $bot -expand 0 -fill x

    set gSubj(response) [text $top.response -width 80 -height 21 \
			     -yscrollcommand "$top.scroll set" \
			     -xscrollcommand "$bot.scroll set"]
    scrollbar $top.scroll -command "$top.response yview"
    pack $gSubj(response) $top.scroll -side left
    pack configure $top.scroll -fill y

    scrollbar $bot.scroll -orient h -command "$top.response xview"
    pack $bot.scroll 
    pack configure $bot.scroll -expand 0 -fill x

    set left [frame $keyword.left]
    set left2 [frame $keyword.left2]
    set right [frame $keyword.right]
    pack $left $left2 $right -side left

    set gSubj(keyword) [text $right.keyword -width 60 -height 5 \
			    -yscrollcommand "$right.scroll set" ]
    scrollbar $right.scroll -command "$right.response yview"
    pack $gSubj(keyword) $right.scroll -side left
    pack configure $right.scroll -fill y

    bindtags $gSubj(keyword) "$gSubj(keyword) all"
    bind $gSubj(keyword) <1> "[bind Text <1>][bind Text <Double-1>]"

    button $left.add -command "subjAddKeyword" -text "Add"
    button $left2.addsp -command "subjAddKeywordSpelling" -text "Add Sp"
    button $left.delete -command "subjDeleteKeyword" -text "Delete"
    button $left2.see -command "subjSeeKeyword" -text "See Sp"
    pack $left.add $left2.addsp $left.delete $left2.see -side top

    wm geometry $gradSubj "-10+0"

    set score0 [frame $score.score0]
    set score1 [frame $score.score1]
    pack $score0 $score1 -side top

    for {set i 0} {$i < 10 } { incr i } {
	set parent [eval set "score[expr $i/5]"]
	set a [frame $parent.score$i -relief sunken -borderwidth 1]
	if { $gSubj(max) < $i} {
	    radiobutton $a.score$i -text $i -variable gSubj(score) \
		-value $i -state disabled
	} else {
	    radiobutton $a.score$i -text $i -variable gSubj(score) -value $i
	}
	pack $parent.score$i $a.score$i -side left
    }

    set buttonwidth 8
    set gSubj(wrap) 1;set gSubj(pict) 0
    button $command1.setnext -text "Grade&Next" -command "subjSet;subjNext" \
	-width $buttonwidth
    button $command2.set -text "Grade" -command subjSet -width $buttonwidth
    frame  $command1.space1 -height 30
    frame  $command2.space2 -height 30
    frame  $command2.space22 -height 5
    button $command1.next -text "Next" -command subjNext -width $buttonwidth
    button $command1.prev -text "Prev" -command subjPrev -width $buttonwidth
    button $command1.goto -text "GoTo" -command subjGoto -width $buttonwidth
    button $command1.exit -text "Exit" -command subjDone -width $buttonwidth
    button $command2.findid -text "Find ID" -command subjFindId -width $buttonwidth
    button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth
    button $command2.findname -text "Find Name" -command subjFindName -width $buttonwidth
    checkbutton $command2.wrap -text wrap -command subjWrap -variable gSubj(wrap)
    checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)
    checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled
    pack $command1.setnext $command2.set $command1.space1 $command2.space2 \
	$command1.next $command1.prev $command2.findid \
	$command2.addid $command2.findname $command1.goto $command1.exit \
        $command2.wrap $command2.pict $command1.done $command2.space22

    button $morebut.print -text "Print Response" -command subjPrint \
	-width [expr $buttonwidth*2]
    pack $morebut.print

    set gSubj(done) 0
    set gSubj(togo) 0
    set gSubj(secAvg) 0.0
    set gSubj(sec) 0
    set gSubj(pause) 0
    label $stat.done -text Done:
    label $stat.donenum -textvariable gSubj(done) -width 4
    label $stat.togo -text "To Go:"
    label $stat.togonum -textvariable gSubj(togo) -width 4
    label $stat.sec -text Sec:
    label $stat.secnum -textvariable gSubj(sec) -width 4
    label $stat.avgsec -text AvgSec:
    label $stat.avgsecnum -textvariable gSubj(avgsec) -width 4
    checkbutton $stat.pause -variable gSubj(pause) -text "Pause" -command subjPause
    pack $stat.done $stat.donenum $stat.togo $stat.togonum -side left 
    #not packed
    #$stat.sec $stat.secnum $stat.avgsec $stat.avgsecnum $stat.pause

    set gSubj(canvas) [canvas $picts.canvas -height 220 \
			   -xscrollcommand "$picts.scroll set"]
    scrollbar $picts.scroll -orient h -command "$picts.canvas xview"
    pack  $picts.scroll $gSubj(canvas) -fill x
    subjInit
}

proc subjWrap {} {
    global gSubj 
    if { $gSubj(wrap) } {
	$gSubj(response) configure -wrap char
    } else {
	$gSubj(response) configure -wrap none
    }
}

proc updateSecCount {} {
    global gSubj
    
    if { [catch {set gSubj(pause)}] } { return }
    if { !$gSubj(pause) } {set gSubj(sec) [expr {[clock seconds] - $gSubj(seconds)}]}
    after 300 updateSecCount
}

proc subjCheckForNew {} {
    global gSubj
 
    foreach file [glob ?????????] {
	if { [lsearch $gSubj(stunums) $file] == -1 } { lappend gSubj(stunums) $file }
    }
    set gSubj(togo) [expr [llength $gSubj(stunums)]-$gSubj(done)]
}

proc checkGSubj {} {
    global gSubj
    if {[catch {set gSubj(stunums)}]} {
	cd [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
	set gSubj(stunums) [lsort -dictionary [glob *]]
	if { [set num [lsearch $gSubj(stunums) gradingstatus]] != -1} {
	    set gSubj(stunums) [lreplace $gSubj(stunums) $num $num]
	}
	cd $gSubj(dir)
    }
    if {[catch {set gSubj(current)}]} {set gSubj(current) -1}
    if {[catch {set gSubj(totalsec)}]} {set gSubj(totalsec) 0}
    if {[catch {set gSubj(seconds)}]} {set gSubj(seconds) [clock seconds]}
    if {[catch {set gSubj(togo)}]} {set gSubj(togo) [llength $gSubj(stunums)]}
    if {[catch {set gSubj(allstunum)}] || 
	[catch {set gSubj(allname)}] || 
	[catch {set gSubj(allemail)}] } {
	subjInitAllLists
    }
}

proc subjRestore {} {
    global gSubj
    source gradingstatus
    subjCheckForNew
    set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
    cd $gSubj(dir)
    if { [catch {incr gSubj(current) -1}]} { set gSubj(current) -1 }
    if { $gSubj(redoalllists) } { subjInitAllLists; set gSubj(redoalllists) 0 }
    checkGSubj
    subjIndexResponse
    subjNext
}

proc subjSave {} {
    global gSubj
    set file [file join $gSubj(dir) records set$gSubj(set) \
		  problem$gSubj(quest) gradingstatus]
    set fileId [open $file w]
    puts $fileId "array set gSubj \{[array get gSubj]\}"
    close $fileId
}

proc subjDone {} {
    global gSubj
    if { [catch {subjSave}] } {
	displayMessage "Unable to save."
    }
    unset gSubj
    destroy .gradesubjective
}

proc subjInitAllLists {} {
    global gSubj
    set i 0
    catch {unset gSubj(allstunum)}
    catch {unset gSubj(allname)}
    catch {unset gSubj(allemail)}
    set fileId [open classl r]
    while { 1 } {
	incr i
	set aline [gets $fileId]
	if { [eof $fileId]} {break}
	# skip blank lines
	if { [string trim $aline] == "" } { continue }
	lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
	#lappend gSubj(allname) [string toupper [string range $aline 24 59]]
	lappend gSubj(allname) [string range $aline 24 59]
	lappend gSubj(allemail) [string range $aline 60 99]
    }
}

proc subjInit {} {
    global gSubj
    
    set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
    cd $dir
    set gSubj(redoalllists) 0
    if { [file exists gradingstatus] } { subjRestore } else {
	set gSubj(stunums) [lsort -dictionary [glob *]]
	cd $gSubj(dir)
	set gSubj(current) -1
	set gSubj(totalsec) 0
	set gSubj(seconds) [clock seconds]
	subjInitAllLists
	set gSubj(togo) [llength $gSubj(stunums)]
	subjNext
    }
    subjUpdateKeywords
    after 300 updateSecCount
}

#FIXME check Ids when adding them to the list of ids
proc checkId { id } {
    global gSubj
    set score [getScore $gSubj(set) $gSubj(quest) $id]
    if { $score == "-" || $score == "0" } { return 1 }
    return 0
}

proc subjPause {} {
    global gSubj
    if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] }
}

proc subjStatusUpdate {} {
    global gSubj
    
    set gSubj(done) [llength [array names gSubj "done.*.score"]]
    set total [llength $gSubj(stunums)]
    set gSubj(togo) [expr $total-$gSubj(done)]
    incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}]
    set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]]
#    puts $gSubj(avgsec)
    set gSubj(seconds) [clock seconds]
}

proc subjSet {} {
    global gSubj

#    if {$gSubj(togo) == 0} { return }
    if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return }
    set idlist [subjGetIdList]
    foreach id $idlist {
	setScore $gSubj(set) $gSubj(quest) $id $gSubj(score)
    }
    set id [lindex $gSubj(stunums) $gSubj(current)]
    set gSubj(done.$id.idlist) $idlist
    set gSubj(done.$id.score) $gSubj(score)
    set gSubj(donestat) 1
    subjStatusUpdate
    subjSave
}

proc subjNext {} {
    global gSubj

    set gSubj(score) ""
    set gSubj(pict) 0
    subjPict
    incr gSubj(current)
    if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 }
    set id [lindex $gSubj(stunums) $gSubj(current)]

    $gSubj(response) delete 0.0 end
    $gSubj(idlist) delete 0 end

    if { $id != "" } { 
	set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id]
	set fileId [open $file "r"]
	$gSubj(response) insert 0.0 [read $fileId [file size $file]]
	close $fileId
	subjInsertIds $id
    }

    append words [string trim [$gSubj(response) get 0.0 end-1c]] " "
    set ws [format " \t\n"]
    set gSubj(numwords) [regsub -all -- \[$ws\]+  $words {} b]
    wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id"
    if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } {
	set gSubj(score) ""
	set gSubj(donestat) 0
	update idletasks
	subjFindIds
    } else {
	set gSubj(donestat) 1
	subjInsertIds $gSubj(done.$id.idlist)
	update idletasks
    }
    subjUpdateResponse
    subjPicts
}

proc subjFindIds1 {} {
    global gSubj

    set text [$gSubj(response) get 0.0 end]
    set result ""
    foreach id $gSubj(allstunum) {
	if { [regexp -nocase -- $id $text] } {
	    lappend result $id
	}
    }
    return $result
}

proc subjFindIds2 {} {
    global gSubj

    set text [string toupper [$gSubj(response) get 0.0 end]]
    set result ""
    if { [catch {lsearch $text a}] } { 
	#puts badlist
	return subjFindIds1 
    } else {
	foreach id $gSubj(allstunum) {
	    if { [lsearch -glob $text *$id*] != -1 } {
		lappend result $id
	    }
	}
    }
    return $result
}

proc subjFindIds3 {} {
    global gSubj

    set text [string toupper [$gSubj(response) get 0.0 end]]
    set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
    set result ""
    foreach word $text {
	if { [lsearch -exact $gSubj(allstunum) $word] != -1 } {
	    lappend result $word
	}
    }
    return $result
}

proc subjFindIds4 {} {
    global gSubj

    set text [string toupper [$gSubj(response) get 0.0 end]]
    set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
    set result ""
    foreach id $gSubj(allstunum) {
	if { [lsearch -exact $text $id] != -1 } {
	    lappend result $id
	}
    }
    return $result
}

proc subjFindId {} {
    global gSubj
    puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
    subjPicts
}

proc subjFindIds {} {
    global gSubj
#    puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
    subjInsertIds [set ids [subjFindIds4]]
#    puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]"
#    puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]"
#    puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]"

}

proc subjFindName {} {
    global gSubj
    
    if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} {
	set text [string toupper [$gSubj(response) get 0.0 end]]
    }
    set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
    set result ""
    set length [llength $gSubj(allname)]
    foreach word $text {
	if { [string length $word] == 0 } { continue }
	for { set i 0 } { $i < $length } { incr i } {
	    set name [string toupper [lindex $gSubj(allname) $i]]
	    if { [set find [lsearch -glob $name *$word*]] != -1 } {
		lappend result $i
	    }
	}
    }
    set result [lunique $result]
    foreach index $result {
	lappend temp [list [lindex $gSubj(allstunum) $index] \
			  [lindex $gSubj(allname) $index]]
    }
    if {[catch {set temp [lsort $temp]}]} {
	displayMessage "No Student found."
	return
    }
    set selected [multipleChoice {} "Select which student you want." $temp 1]
    if {$selected == ""} { return }
    set done 0
    if { [llength $selected] == 2 } { 
	if { [lindex [lindex $selected 0] 0] == "" } { 
	    set selected [lindex $selected 0]
	    set done 1
	}
    }
    if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } }
    subjInsertIds $idlist
    subjPicts
}

proc subjGetNameFromId { id } {
    global gSubj
    return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]]
}

proc subjGetIdList {} {
    global gSubj
    set list [$gSubj(idlist) get 0 end]
    set id ""
    foreach element $list {
	append id "[lindex $element 0] "
    }
    return $id
}

proc subjInsertIds { selected } {
    global gSubj
    set current [subjGetIdList]
    foreach person $selected {lappend current [lindex $person 0]}
    set current [lsort [lunique $current]]
    $gSubj(idlist) delete 0 end
    foreach id $current {
	$gSubj(idlist) insert end "$id [subjGetNameFromId $id]"
    }
}

proc subjDeleteId {} {
    global gSubj
    $gSubj(idlist) delete [$gSubj(idlist) curselection]
    subjPicts
}

proc subjAddId {} {
    global gSubj
    getOneStudent {} $gSubj(dir) id name
    if { $id == "" } { return }
    subjInsertIds $id
}

proc subjPrev {} {
    global gSubj
    if  { $gSubj(current) > 0 } {
	incr gSubj(current) -2
	subjNext
    }
}

proc subjMessage { mesg {tag normal} } {
    global gSubj
    displayMessage $mesg
#    $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
#    $gSubj(msg) see end
}

proc subjAddPict { id } {
    global gSubj
    set gif [file join $gSubj(dir) photo gif $id.gif]
    if { ![file exists $gif] } { return }
    lappend gSubj(imagelist) [set image [image create photo]]
    $image read $gif
    set a [llength $gSubj(imagelist)]
    $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw
    $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw
    $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \
	-anchor nw
    $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200"
    update idletasks
    return $a
}

proc subjConvertPict { id } {
    global gSubj
    set gif [file join $gSubj(dir) photo gif $id.gif]
    set jpg [file join $gSubj(dir) photo jpg $id.jpg]
    if { ![file exists $gif] } {
	if { [file exists $jpg] } {
	    exec djpeg -outfile $gif $jpg
	}
    }
}

proc subjPicts {} {
    global gSubj 

    $gSubj(canvas) delete all
    catch { foreach image $gSubj(imagelist) { catch {image delete $image} } }
    set gSubj(imagelist) ""
    set idlist [subjGetIdList]
    foreach id $idlist {
	subjConvertPict $id
	set num [subjAddPict $id]
    } 
}

proc subjPict {} {
    global gSubj
    if { $gSubj(pict) } {
	pack $gSubj(pictFrame)
	pack configure $gSubj(pictFrame) -fill x
    } else {
	pack forget $gSubj(pictFrame)
    }
}

proc subjPrint {} {
    global gSubj
    set lprCommand [getLprCommand quiztemp.txt]
    if {$lprCommand == "Cancel"} { return }
  
    set fileId [open "quiztemp.txt" w] 
    set subid [lindex $gSubj(stunums) $gSubj(current)]
    if { $subid != "" } {
	set file [file join $gSubj(dir) records set$gSubj(set) \
		      problem$gSubj(quest) $subid]
	puts $fileId "Submitted at [clock format [file mtime $file ]]"
	puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)"
    }
    if { [llength [subjGetIdList]] > 1 } {
	puts $fileId "Additional Authors:"
	foreach id [subjGetIdList] {
	    if { $id == $subid } { continue }
	    puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)"
	}
    }
    puts $fileId ""
    puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]"
    close $fileId

    set errorMsg ""
    set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
    
    if { $error == 1 } {
        displayError "An error occurred while printing: $errorMsg"
    } else {
	displayMessage "Print job sent to the printer.\n $output"
    }
    exec rm -f quiztemp.txt
}

proc subjGoto {} {
    global gSubj
    subjGetOneStudent {} $gSubj(dir) id name
    if { $id == "" } { return }
    if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } {
	set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1]
	subjNext
    } else {
	displayMessage "Student $id did not submit an answer."
    }
}

proc subjGetUngraded {} {
    global gSubj

    set idlist ""
    foreach stunum $gSubj(stunums) {
	if {[catch {set gSubj(done.$stunum.score)}]} {
	    lappend idlist $stunum
	}
    }
    return [multipleChoice {} "Select which student you want to grade." $idlist 1]
}

proc subjGetOneStudent { window path idVar nameVar {message "" } } {
    upvar $idVar id
    upvar $nameVar name
    
    set select [tk_dialog $window.dialog "$message Student select method" \
		    "Select student by:" "" "" "Student Number" \
		    "Student Name" "Not Yet Graded" "Cancel"]
    if { $select == 3 } { 
	set id ""
	set name ""
	return 
    }
    if { $select == 2 } {
	set id [subjGetUngraded]
	set name [subjGetNameFromId $id]
	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" \
			     $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."
	}
    }
}

###########################################################
# subjSendResponse
###########################################################
###########################################################
###########################################################
proc subjSendResponse {} {
    global gSubj gCapaConfig

    if { "" == [set which [$gSubj(responseList) curselection]]} {
	displayMessage "Please select a message to send."
	return
    }
    incr which

    set message ""

    set stuList [$gSubj(idlist) get 0 end]
    foreach stu $stuList {
	set stu [lindex $stu 0]
	set index [lsearch $gSubj(allstunum) $stu]
	set name [lindex $gSubj(allname) $index]
	set email [lindex $gSubj(allemail) $index]
	#puts "$name:[split $name ,]:[lindex [split $name ,] 1]:[lindex [lindex [split $name ,] 1] 0]:$index:$stu"
	#puts [lsearch $gSubj(allemail) albertel@pilot.msu.edu]
	set first_name [lindex [lindex [split $name ,] 1] 0]
	set last_name [lindex [split $name , ] 0]
	set score $gSubj(score)
	regsub -all -- \\\$last_name $gSubj(response.$which) $last_name message
	regsub -all -- \\\$first_name $message $first_name message
	regsub -all -- \\\$score $message $score message
#	set message [subst -nobackslashes -nocommands $gSubj(response.$which)]
	if { [regexp -- (^Subject:\[^\n\]*)(\n)(.*) $message matchvar subjline newline messagebody] } {
	    set subject "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest)"
	    set message $messagebody
	} else {
	    set subject "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest)"
	}
	displayMessage "$message sent to $email"
	exec echo $message | $gCapaConfig(mail_command) -s $subject $email
    }
}

###########################################################
# subjIndexResponse
###########################################################
###########################################################
###########################################################
proc subjIndexResponse {} {
    global gSubj
    
    $gSubj(responseList) delete 0 end

    set i 0
    foreach element [lsort -dictionary [array names gSubj "response.*"]] {
	regsub -all -- "\[\n\r\t\]+" [string range $gSubj($element) 0 37] " " head
	$gSubj(responseList) insert end "[incr i].$head"
    }
}

###########################################################
# subjSaveResponse
###########################################################
###########################################################
###########################################################
proc subjSaveResponse {} {
    global gSubj
    
    set num [incr gSubj(numresponse)]
    set gSubj(response.$num) [$gSubj(responseNew) get 0.0 end-1c]
    destroy [winfo toplevel $gSubj(responseNew)]
    subjIndexResponse
    $gSubj(responseList) selection set end
    $gSubj(responseList) see end
}

###########################################################
# subjNewResponse
###########################################################
###########################################################
###########################################################
proc subjNewResponse {} {
    global gSubj gWindowMenu
   
    if { [winfo exists .addresponse] } { 
	capaRaise .addresponse
	return 
    }
    set response [toplevel .addresponse]
    $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response"
    wm title $response "Adding a New Response"  

    set textFrame [frame $response.text]
    set buttonFrame [frame $response.button]
    pack $textFrame $buttonFrame

    set gSubj(responseNew) [text $textFrame.text -yscrollcommand \
	    "$textFrame.scroll set" -wrap char -height 15]
    scrollbar $textFrame.scroll -command "$textFrame.text yview"
    pack $textFrame.text $textFrame.scroll -side left -expand 1
    pack configure $textFrame.scroll -fill y

    button $buttonFrame.save -text Save -command "subjSaveResponse"
    button $buttonFrame.forget -text Cancel -command "destroy $response"
    pack $buttonFrame.save $buttonFrame.forget -side left
}

###########################################################
# subjDeleteResponse
###########################################################
###########################################################
###########################################################
proc subjDeleteResponse {} {
    global gSubj
    if { [winfo exists .editresponse] } { 
	displayMessage "Please finish with editing the response, before deleting responses."
	return
    }
    if { "" == [set which [$gSubj(responseList) curselection]]} { return }
    incr which
    if { [catch {unset gSubj(response.$which)}] } {
	#puts [array names gSubj response.*]
	return
    }
    for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {
	set j [expr $i - 1]
	set gSubj(response.$j) $gSubj(response.$i)
	unset gSubj(response.$i)
    }
    set gSubj(numresponse) [expr $i - 2]
    subjIndexResponse
    $gSubj(responseList) see [incr which -2]
}

###########################################################
# subjEditResponse
###########################################################
###########################################################
###########################################################
proc subjEditResponse {} {
    global gSubj gWindowMenu

    if { [winfo exists .editresponse] } { capaRaise .editresponse ; return }
    if { "" == [set which [$gSubj(responseList) curselection]]} { return }
    incr which

    set response [toplevel .editresponse ]
    $gWindowMenu add command -label "EditingResponse" -command "capaRaise $response"
    wm title $response "Editing a Response"  

    set textFrame [frame $response.text]
    set buttonFrame [frame $response.button]
    pack $textFrame $buttonFrame

    set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \
	    "$textFrame.scroll set" -wrap char -height 15]
    scrollbar $textFrame.scroll -command "$textFrame.text yview"
    pack $textFrame.text $textFrame.scroll -side left -expand 1
    pack configure $textFrame.scroll -fill y
    $gSubj(responseEdit) insert 0.0 $gSubj(response.$which)

    set gSubj(editresponsedone) 0
    button $buttonFrame.save -text Save -command "set gSubj(editresponsedone) 1"
    button $buttonFrame.forget -text Cancel -command "set gSubj(editresponsedone) 0"
    pack $buttonFrame.save $buttonFrame.forget -side left
    vwait gSubj(editresponsedone)
    if { $gSubj(editresponsedone) } {
	set gSubj(response.$which) [$gSubj(responseEdit) get 0.0 end-1c]	
	subjIndexResponse
	$gSubj(responseList) selection set $which
	$gSubj(responseList) see $which
    } 
    destroy $response
}

###########################################################
# subjViewResponse
###########################################################
###########################################################
###########################################################
proc subjViewResponse {} {
    global gSubj gUniqueNumber gWindowMenu

    if { "" == [set which [$gSubj(responseList) curselection]]} { return }
    incr which
    set num [incr gUniqueNumber]

    set response [toplevel .viewresponse$num ]
    $gWindowMenu add command -label "ViewingResponse $which" \
	-command "capaRaise $response"
    wm title $response "Viewing Response $which"  

    set textFrame [frame $response.text]
    set buttonFrame [frame $response.button]
    pack $textFrame $buttonFrame

    text $textFrame.text -yscrollcommand "$textFrame.scroll set" -wrap char -height 15
    scrollbar $textFrame.scroll -command "$textFrame.text yview"
    pack $textFrame.text $textFrame.scroll -side left -expand 1
    pack configure $textFrame.scroll -fill y
    $textFrame.text insert 0.0 $gSubj(response.$which)
    $textFrame.text configure -state disabled

    button $buttonFrame.forget -text Dismiss -command "destroy $response"
    pack $buttonFrame.forget -side left
}

###########################################################
# subjUpdateResponse
###########################################################
###########################################################
###########################################################
proc subjUpdateResponse {} {
    global gSubj

    $gSubj(response) tag delete keyword
    $gSubj(response) tag configure keyword -background green
    set startindex 0.0
    set lastindex [$gSubj(response) index end]
    while { 1 } {
	set endindex [$gSubj(response) index "$startindex wordend"]
#	puts "$startindex -> $endindex"
	set word [string trim [string toupper [$gSubj(response) get $startindex $endindex]]]
	if { $word != "" } {
	    #	puts "Word :$word:"
	    foreach keyword $gSubj(keywords) {
		set keyword [string toupper [lindex $keyword 1]]
		if { [lsearch -exact $keyword $word] != -1 } {
		    $gSubj(response) tag add keyword $startindex $endindex
		}
	    }
	    #	puts [$gSubj(response) index "$endindex+1c"]
	    #	puts [$gSubj(response) index "$endindex wordstart"]
	    #	puts [$gSubj(response) index "$endindex+1c wordstart"]
	    
	    #	set startindex [$gSubj(response) index "$endindex + 1c"]
	}
	set startindex $endindex
	if { $startindex == $lastindex } { break }
    }
}

###########################################################
# subjUpdateKeywords
###########################################################
###########################################################
###########################################################
proc subjUpdateKeywords {} {
    global gSubj
    $gSubj(keyword) delete 0.0 end
    set lokeyword ""
#    puts $gSubj(keywords)
    foreach keyword $gSubj(keywords) { lappend lokeyword [lindex $keyword 0] }
    if { $lokeyword == "" } { return }
    set lokeyword [lsort $lokeyword]
    set max 0
    foreach key $lokeyword {
	if { [string length $key] > $max } { set max [string length $key] }
    }
    incr max
    set numcol [expr 60/$max]
    set end [llength $lokeyword]
    set lastline 0
    for { set i 0 } { $i < $end } { incr i } {
	set line [expr $i/$numcol]
	set col [expr $i%$numcol*$max]
#	puts $line.$col
	$gSubj(keyword) insert end [format "%-[set max]s" [lindex $lokeyword $i]]
	if {($col + (2*$max)) > 60} {
#	    puts "Putting in newlne"
	    $gSubj(keyword) insert end "\n"
	    set lastline $line
	}
    }
    subjUpdateResponse
}

###########################################################
# subjAddKeyword
###########################################################
###########################################################
###########################################################
proc subjAddKeyword {} {
    global gSubj 

    if { "" == [set newword [getString [winfo toplevel $gSubj(keyword)] "Enter a new keyword" nospace ]]} {
	return
    }
    set i 0
    foreach keyword $gSubj(keywords) {
	if {-1 != [lsearch $keyword $newword]} { break }
	incr i
    }
    if { $i >= [llength $gSubj(keywords)] } {
        lappend gSubj(keywords) [list $newword [list $newword]]
	subjUpdateKeywords
    }
}

###########################################################
# subjAddKeywordSpelling
###########################################################
###########################################################
###########################################################
proc subjAddKeywordSpelling {} {
    global gSubj

    if { [catch {set word [$gSubj(keyword) get sel.first sel.last]}]} { return }
    if { "" == [set newspell [getString [winfo toplevel $gSubj(keyword)] "Enter a new spelling for $word" nospace ]]} {
	return
    }
    set i 0
    foreach keyword $gSubj(keywords) {
	if {-1 != [lsearch $keyword $word]} { break }
	incr i
    }

    set gSubj(keywords) [lreplace $gSubj(keywords) $i $i \
			     [list $word [concat [lindex $keyword 1] $newspell]]]
    subjUpdateKeywords
}

###########################################################
# subjSeeKeyword
###########################################################
###########################################################
###########################################################
proc subjSeeKeyword {} {
    global gSubj gPromptMC
    
    if { [catch {set word [$gSubj(keyword) get sel.first sel.last]}]} { return }
    set i 0
    foreach keyword $gSubj(keywords) {
	if {-1 != [lsearch $keyword $word]} { break }
	incr i
    }

    set which $i
    set setWin [toplevel $gSubj(keyword).keyword]
    
    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 "Alternate spellings for [lindex $keyword 0]" \
	-aspect 3000
    pack $msgFrame.msg
    
    set maxWidth 1
    foreach choice [lindex $keyword 1] {
	if {[string length $choice] > $maxWidth} {set maxWidth [string length $choice]}
    }
    listbox $valFrame.val -width [expr $maxWidth + 2] \
	-yscrollcommand "$valFrame.scroll set" -selectmode single
    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 [lsort [lrange [lindex $keyword 1] 1 end]] { 
	$valFrame.val insert end $choice 
    }

    button $buttonFrame.select -text "Delete" -command { set gPromptMC(ok) 1 }
    frame $buttonFrame.spacer -width 10
    button $buttonFrame.cancel -text "Dismiss" -command { set gPromptMC(ok) 0 }
    pack $buttonFrame.select $buttonFrame.cancel -side left

    bind $setWin <Return> "set gPromptMC(ok) 0"
    Centre_Dialog $setWin default
    update idletasks
    focus $setWin
    capaRaise $setWin
    capaGrab $setWin
    while { 1 } {
	update idletasks
	vwait gPromptMC(ok)
	if { $gPromptMC(ok) == 0 } { break }
	set select [$valFrame.val curselection]
	if { $select != "" } { 
	    $valFrame.val delete $select
	} 
    }
    set spellings [lindex $keyword 0]
    for {set i 0} {$i < [$valFrame.val index end]} { incr i } { 
	lappend spellings [$valFrame.val get $i]
    }
    capaGrab release $setWin
    destroy $setWin

    set gSubj(keywords) [lreplace $gSubj(keywords) $which $which \
			     [list [lindex $keyword 0] $spellings ]]

    subjUpdateKeywords
}

###########################################################
# subjDeleteKeyword
###########################################################
###########################################################
###########################################################
proc subjDeleteKeyword {} {
    global gSubj
    
    if { [catch {set word [$gSubj(keyword) get sel.first sel.last]}]} { return }
    set newkeyword ""
    foreach keyword $gSubj(keywords) {
	if {-1 == [lsearch $keyword $word]} { lappend newkeyword $keyword }
    }
    set gSubj(keywords) $newkeyword
    subjUpdateKeywords
}