--- capa/capa51/GUITools/gradesubjective.tcl	1999/12/07 19:45:45	1.8
+++ capa/capa51/GUITools/gradesubjective.tcl	2000/08/07 20:47:29	1.12
@@ -1,3 +1,26 @@
+# 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 {} {
@@ -20,6 +43,7 @@ proc gradeSubjective {} {
     gets $fileid aline
     gets $fileid aline
     set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
+    set gSubj(keywords) ""
     createGradeSubjWindow
 }
 
@@ -124,12 +148,13 @@ proc createGradeSubjWindow {} {
 
     set gSubj(keyword) [text $right.keyword -width 60 -height 5 \
 			    -yscrollcommand "$right.scroll set" ]
-    puts $gSubj(keyword)
-    puts $right
     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"
@@ -225,6 +250,11 @@ proc 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 {} {
@@ -290,6 +320,8 @@ proc subjInitAllLists {} {
 	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]
@@ -313,6 +345,7 @@ proc subjInit {} {
 	set gSubj(togo) [llength $gSubj(stunums)]
 	subjNext
     }
+    subjUpdateKeywords
     after 300 updateSecCount
 }
 
@@ -393,6 +426,7 @@ proc subjNext {} {
 	subjInsertIds $gSubj(done.$id.idlist)
 	update idletasks
     }
+    subjUpdateResponse
     subjPicts
 }
 
@@ -415,7 +449,8 @@ proc subjFindIds2 {} {
     set text [string toupper [$gSubj(response) get 0.0 end]]
     set result ""
     if { [catch {lsearch $text a}] } { 
-	puts badlist; return subjFindIds1 
+	#puts badlist
+	return subjFindIds1 
     } else {
 	foreach id $gSubj(allstunum) {
 	    if { [lsearch -glob $text *$id*] != -1 } {
@@ -735,7 +770,7 @@ proc subjGetOneStudent { window path idV
 ###########################################################
 ###########################################################
 proc subjSendResponse {} {
-    global gSubj
+    global gSubj gCapaConfig
 
     if { "" == [set which [$gSubj(responseList) curselection]]} {
 	displayMessage "Please select a message to send."
@@ -751,8 +786,8 @@ proc subjSendResponse {} {
 	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]
+	#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)
@@ -761,12 +796,13 @@ proc subjSendResponse {} {
 	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 message "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$messagebody"
+	    set subject "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest)"
+	    set message $messagebody
 	} else {
-	    set message "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$message"
+	    set subject "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest)"
 	}
 	displayMessage "$message sent to $email"
-	exec echo $message | mail $email
+	exec echo $message | $gCapaConfig(mail_command) -s $subject $email
     }
 }
 
@@ -848,7 +884,7 @@ proc subjDeleteResponse {} {
     if { "" == [set which [$gSubj(responseList) curselection]]} { return }
     incr which
     if { [catch {unset gSubj(response.$which)}] } {
-	puts [array names gSubj response.*]
+	#puts [array names gSubj response.*]
 	return
     }
     for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {
@@ -940,7 +976,33 @@ proc subjViewResponse {} {
 ###########################################################
 ###########################################################
 proc subjUpdateResponse {} {
-    gSubj
+    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 }
+    }
 }
 
 ###########################################################
@@ -951,8 +1013,10 @@ proc subjUpdateResponse {} {
 proc subjUpdateKeywords {} {
     global gSubj
     $gSubj(keyword) delete 0.0 end
-    puts $gSubj(keywords)
+    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 {
@@ -965,10 +1029,10 @@ proc subjUpdateKeywords {} {
     for { set i 0 } { $i < $end } { incr i } {
 	set line [expr $i/$numcol]
 	set col [expr $i%$numcol*$max]
-	puts $line.$col
+#	puts $line.$col
 	$gSubj(keyword) insert end [format "%-[set max]s" [lindex $lokeyword $i]]
 	if {($col + (2*$max)) > 60} {
-	    puts "Putting in newlne"
+#	    puts "Putting in newlne"
 	    $gSubj(keyword) insert end "\n"
 	    set lastline $line
 	}
@@ -982,12 +1046,133 @@ proc subjUpdateKeywords {} {
 ###########################################################
 ###########################################################
 proc subjAddKeyword {} {
-    global gSubj gUniqueNumber
+    global gSubj 
 
-    if { "" == [set keyword [getString [winfo toplevel $gSubj(keyword)] "Enter a new keyword"]]} {
+    if { "" == [set newword [getString [winfo toplevel $gSubj(keyword)] "Enter a new keyword" nospace ]]} {
 	return
     }
-    puts "New keyword $keyword"
-    lappend gSubj(keywords) [list $keyword [list $keyword]]
+    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
 }