--- capa/capa51/GUITools/gradesubjective.tcl 1999/09/28 21:25:37 1.1.1.1 +++ capa/capa51/GUITools/gradesubjective.tcl 1999/12/07 19:10:47 1.7 @@ -31,8 +31,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] @@ -50,10 +51,10 @@ proc createGradeSubjWindow {} { pack $msglist $msgbutton -side top pack configure $msgbutton -anchor w - set gSubj(response) [listbox $msglist.list -width 40 -height 5 \ - -yscrollcommand "$msglist.scroll set"] - scrollbar $msglist.scroll -command "$msglist.text yview" - pack $gSubj(response) $msglist.scroll -side left + 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 @@ -78,14 +79,17 @@ proc createGradeSubjWindow {} { pack configure $idlist.scroll -fill y button $idbutton.delete -text Delete -command subjDeleteId - pack $idbutton.delete + 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 $gradSubj WM_DELETE_WINDOW "subjDone" + wm protocol $scoreandcom WM_DELETE_WINDOW "subjDone" set score [frame $scoreandcom.score] set command [frame $scoreandcom.command] @@ -113,6 +117,23 @@ 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 + + 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] @@ -140,18 +161,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 \ @@ -204,13 +225,37 @@ 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 } @@ -219,36 +264,50 @@ proc subjSave {} { 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]\"" + puts $fileId "array set gSubj \{[array get gSubj]\}" close $fileId } proc subjDone {} { global gSubj - subjSave + 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} + 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] - set fileId [open classl r] - while { 1 } { - set aline [gets $fileId] - if { [eof $fileId]} {break} - 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] - } + subjInitAllLists set gSubj(togo) [llength $gSubj(stunums)] subjNext } @@ -318,6 +377,9 @@ proc subjNext {} { 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) "" @@ -496,7 +558,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 } @@ -672,17 +734,54 @@ proc subjGetOneStudent { window path idV ########################################################### proc subjSendResponse {} { global gSubj + + 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 message "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$messagebody" + } else { + set message "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$message" + } + displayMessage "$message sent to $email" + exec echo $message | mail $email + } } +########################################################### +# subjIndexResponse +########################################################### +########################################################### +########################################################### proc subjIndexResponse {} { global gSubj - $gSubj(response) delete 0 end + $gSubj(responseList) delete 0 end set i 0 foreach element [lsort -dictionary [array names gSubj "response.*"]] { - set head [string range $gSubj($element) 0 30] - $gSubj(response) insert end "[incr i]. $head" + regsub -all -- "\[\n\r\t\]+" [string range $gSubj($element) 0 37] " " head + $gSubj(responseList) insert end "[incr i].$head" } } @@ -695,8 +794,11 @@ proc subjSaveResponse {} { global gSubj set num [incr gSubj(numresponse)] - set gSubj(response.$num) [$gSubj(responseEdit) get 0.0 end] + 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 } ########################################################### @@ -717,11 +819,13 @@ proc subjNewResponse {} { set textFrame [frame $response.text] set buttonFrame [frame $response.button] + pack $textFrame $buttonFrame - set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \ + set gSubj(responseNew) [text $textFrame.text -yscrollcommand \ "$textFrame.scroll set" -wrap char -height 15] scrollbar $textFrame.scroll -command "$textFrame.text yview" - pack $textFrame.scroll $textFrame.text -side left -expand 1 + 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" @@ -735,6 +839,24 @@ proc subjNewResponse {} { ########################################################### 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] } ########################################################### @@ -743,7 +865,39 @@ proc subjDeleteResponse {} { ########################################################### ########################################################### proc subjEditResponse {} { - global gSubj + 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 } ########################################################### @@ -752,5 +906,38 @@ proc subjEditResponse {} { ########################################################### ########################################################### proc subjViewResponse {} { - global gSubj + 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 +} + +########################################################### +# subjAddKeyword +########################################################### +########################################################### +########################################################### +proc subjAddKeyword {} { + global gSubj gUniqueNumber + }