--- capa/capa51/GUITools/gradesubjective.tcl	1999/11/18 17:55:24	1.4
+++ capa/capa51/GUITools/gradesubjective.tcl	1999/12/13 21:38:44	1.9
@@ -20,6 +20,7 @@ proc gradeSubjective {} {
     gets $fileid aline
     gets $fileid aline
     set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
+    set gSubj(keywords) ""
     createGradeSubjWindow
 }
 
@@ -31,8 +32,9 @@ proc createGradeSubjWindow {} {
 
     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 -side top
+    pack $info $grade $keyword -side top
 
     set msg [frame $info.msg]
     set id [frame $info.id]
@@ -88,7 +90,7 @@ proc createGradeSubjWindow {} {
 
     set scoreandcom [toplevel $gradSubj.scoreandcom]
     wm title $scoreandcom "Control Panel"  
-    wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"
+    wm protocol $scoreandcom WM_DELETE_WINDOW "subjDone"
 
     set score [frame $scoreandcom.score]
     set command [frame $scoreandcom.command]
@@ -116,6 +118,26 @@ proc createGradeSubjWindow {} {
     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]
@@ -143,18 +165,18 @@ proc createGradeSubjWindow {} {
     frame  $command2.space2 -height 30
     frame  $command2.space22 -height 5
     button $command1.next -text "Next" -command subjNext -width $buttonwidth
-    button $command2.prev -text "Prev" -command subjPrev -width $buttonwidth
-    button $command1.findid -text "Find ID" -command subjFindId -width $buttonwidth
-    button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth
-    button $command1.findname -text "Find Name" -command subjFindName -width $buttonwidth
-    button $command2.goto -text "GoTo" -command subjGoto -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 $command2.prev $command1.findid \
-	$command2.addid $command1.findname $command1.exit $command2.goto \
+	$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 \
@@ -207,14 +229,36 @@ proc subjCheckForNew {} {
     global gSubj
 }
 
+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)
-    incr gSubj(current) -1
+    if { [catch {incr gSubj(current) -1}]} { set gSubj(current) -1 }
     if { $gSubj(redoalllists) } { subjInitAllLists; set gSubj(redoalllists) 0 }
+    checkGSubj
     subjIndexResponse
     subjNext
 }
@@ -230,14 +274,15 @@ proc subjSave {} {
 
 proc subjDone {} {
     global gSubj
-    subjSave
+    if { [catch {subjSave}] } {
+	displayMessage "Unable to save."
+    }
     unset gSubj
     destroy .gradesubjective
 }
 
 proc subjInitAllLists {} {
     global gSubj
-    puts "doing all lists"
     set i 0
     catch {unset gSubj(allstunum)}
     catch {unset gSubj(allname)}
@@ -252,7 +297,6 @@ proc subjInitAllLists {} {
 	lappend gSubj(allname) [string range $aline 24 59]
 	lappend gSubj(allemail) [string range $aline 60 99]
     }
-    puts "did $i lines"
 }
 
 proc subjInit {} {
@@ -271,6 +315,7 @@ proc subjInit {} {
 	set gSubj(togo) [llength $gSubj(stunums)]
 	subjNext
     }
+    subjUpdateKeywords
     after 300 updateSecCount
 }
 
@@ -351,6 +396,7 @@ proc subjNext {} {
 	subjInsertIds $gSubj(done.$id.idlist)
 	update idletasks
     }
+    subjUpdateResponse
     subjPicts
 }
 
@@ -518,7 +564,7 @@ proc subjPrev {} {
 
 proc subjMessage { mesg {tag normal} } {
     global gSubj
-    displayMessage $message
+    displayMessage $mesg
 #    $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
 #    $gSubj(msg) see end
 }
@@ -701,6 +747,8 @@ proc subjSendResponse {} {
     }
     incr which
 
+    set message ""
+
     set stuList [$gSubj(idlist) get 0 end]
     foreach stu $stuList {
 	set stu [lindex $stu 0]
@@ -889,3 +937,210 @@ proc subjViewResponse {} {
     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
+}
\ No newline at end of file