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
}

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.