[BACK]Return to gradesubjective.tcl CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / GUITools

Diff for /capa/capa51/GUITools/gradesubjective.tcl between versions 1.4 and 1.12

version 1.4, 1999/11/18 17:55:24 version 1.12, 2000/08/07 20:47:29
Line 1 Line 1
   # 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  set gMaxSet 99
   
 proc gradeSubjective {} {  proc gradeSubjective {} {
Line 20  proc gradeSubjective {} { Line 43  proc gradeSubjective {} {
     gets $fileid aline      gets $fileid aline
     gets $fileid aline      gets $fileid aline
     set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]      set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
       set gSubj(keywords) ""
     createGradeSubjWindow      createGradeSubjWindow
 }  }
   
Line 31  proc createGradeSubjWindow {} { Line 55  proc createGradeSubjWindow {} {
   
     set info [frame $gradSubj.info]      set info [frame $gradSubj.info]
     set grade [frame $gradSubj.grade]      set grade [frame $gradSubj.grade]
       set keyword [frame $gradSubj.keyword]
     set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]]      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 msg [frame $info.msg]
     set id [frame $info.id]      set id [frame $info.id]
Line 88  proc createGradeSubjWindow {} { Line 113  proc createGradeSubjWindow {} {
   
     set scoreandcom [toplevel $gradSubj.scoreandcom]      set scoreandcom [toplevel $gradSubj.scoreandcom]
     wm title $scoreandcom "Control Panel"        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 score [frame $scoreandcom.score]
     set command [frame $scoreandcom.command]      set command [frame $scoreandcom.command]
Line 116  proc createGradeSubjWindow {} { Line 141  proc createGradeSubjWindow {} {
     pack $bot.scroll       pack $bot.scroll 
     pack configure $bot.scroll -expand 0 -fill x      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"      wm geometry $gradSubj "-10+0"
   
     set score0 [frame $score.score0]      set score0 [frame $score.score0]
Line 143  proc createGradeSubjWindow {} { Line 188  proc createGradeSubjWindow {} {
     frame  $command2.space2 -height 30      frame  $command2.space2 -height 30
     frame  $command2.space22 -height 5      frame  $command2.space22 -height 5
     button $command1.next -text "Next" -command subjNext -width $buttonwidth      button $command1.next -text "Next" -command subjNext -width $buttonwidth
     button $command2.prev -text "Prev" -command subjPrev -width $buttonwidth      button $command1.prev -text "Prev" -command subjPrev -width $buttonwidth
     button $command1.findid -text "Find ID" -command subjFindId -width $buttonwidth      button $command1.goto -text "GoTo" -command subjGoto -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.exit -text "Exit" -command subjDone -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.wrap -text wrap -command subjWrap -variable gSubj(wrap)
     checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)      checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)
     checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled      checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled
     pack $command1.setnext $command2.set $command1.space1 $command2.space2 \      pack $command1.setnext $command2.set $command1.space1 $command2.space2 \
  $command1.next $command2.prev $command1.findid \   $command1.next $command1.prev $command2.findid \
  $command2.addid $command1.findname $command1.exit $command2.goto \   $command2.addid $command2.findname $command1.goto $command1.exit \
         $command2.wrap $command2.pict $command1.done $command2.space22          $command2.wrap $command2.pict $command1.done $command2.space22
   
     button $morebut.print -text "Print Response" -command subjPrint \      button $morebut.print -text "Print Response" -command subjPrint \
Line 205  proc updateSecCount {} { Line 250  proc updateSecCount {} {
   
 proc subjCheckForNew {} {  proc subjCheckForNew {} {
     global gSubj      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 {} {  proc subjRestore {} {
Line 213  proc subjRestore {} { Line 284  proc subjRestore {} {
     subjCheckForNew      subjCheckForNew
     set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]      set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
     cd $gSubj(dir)      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 }      if { $gSubj(redoalllists) } { subjInitAllLists; set gSubj(redoalllists) 0 }
       checkGSubj
     subjIndexResponse      subjIndexResponse
     subjNext      subjNext
 }  }
Line 230  proc subjSave {} { Line 302  proc subjSave {} {
   
 proc subjDone {} {  proc subjDone {} {
     global gSubj      global gSubj
     subjSave      if { [catch {subjSave}] } {
    displayMessage "Unable to save."
       }
     unset gSubj      unset gSubj
     destroy .gradesubjective      destroy .gradesubjective
 }  }
   
 proc subjInitAllLists {} {  proc subjInitAllLists {} {
     global gSubj      global gSubj
     puts "doing all lists"  
     set i 0      set i 0
     catch {unset gSubj(allstunum)}      catch {unset gSubj(allstunum)}
     catch {unset gSubj(allname)}      catch {unset gSubj(allname)}
Line 247  proc subjInitAllLists {} { Line 320  proc subjInitAllLists {} {
  incr i   incr i
  set aline [gets $fileId]   set aline [gets $fileId]
  if { [eof $fileId]} {break}   if { [eof $fileId]} {break}
    # skip blank lines
    if { [string trim $aline] == "" } { continue }
  lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]   lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
  #lappend gSubj(allname) [string toupper [string range $aline 24 59]]   #lappend gSubj(allname) [string toupper [string range $aline 24 59]]
  lappend gSubj(allname) [string range $aline 24 59]   lappend gSubj(allname) [string range $aline 24 59]
  lappend gSubj(allemail) [string range $aline 60 99]   lappend gSubj(allemail) [string range $aline 60 99]
     }      }
     puts "did $i lines"  
 }  }
   
 proc subjInit {} {  proc subjInit {} {
Line 271  proc subjInit {} { Line 345  proc subjInit {} {
  set gSubj(togo) [llength $gSubj(stunums)]   set gSubj(togo) [llength $gSubj(stunums)]
  subjNext   subjNext
     }      }
       subjUpdateKeywords
     after 300 updateSecCount      after 300 updateSecCount
 }  }
   
Line 351  proc subjNext {} { Line 426  proc subjNext {} {
  subjInsertIds $gSubj(done.$id.idlist)   subjInsertIds $gSubj(done.$id.idlist)
  update idletasks   update idletasks
     }      }
       subjUpdateResponse
     subjPicts      subjPicts
 }  }
   
Line 373  proc subjFindIds2 {} { Line 449  proc subjFindIds2 {} {
     set text [string toupper [$gSubj(response) get 0.0 end]]      set text [string toupper [$gSubj(response) get 0.0 end]]
     set result ""      set result ""
     if { [catch {lsearch $text a}] } {       if { [catch {lsearch $text a}] } { 
  puts badlist; return subjFindIds1    #puts badlist
    return subjFindIds1 
     } else {      } else {
  foreach id $gSubj(allstunum) {   foreach id $gSubj(allstunum) {
     if { [lsearch -glob $text *$id*] != -1 } {      if { [lsearch -glob $text *$id*] != -1 } {
Line 518  proc subjPrev {} { Line 595  proc subjPrev {} {
   
 proc subjMessage { mesg {tag normal} } {  proc subjMessage { mesg {tag normal} } {
     global gSubj      global gSubj
     displayMessage $message      displayMessage $mesg
 #    $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag  #    $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
 #    $gSubj(msg) see end  #    $gSubj(msg) see end
 }  }
Line 693  proc subjGetOneStudent { window path idV Line 770  proc subjGetOneStudent { window path idV
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc subjSendResponse {} {  proc subjSendResponse {} {
     global gSubj      global gSubj gCapaConfig
   
     if { "" == [set which [$gSubj(responseList) curselection]]} {      if { "" == [set which [$gSubj(responseList) curselection]]} {
  displayMessage "Please select a message to send."   displayMessage "Please select a message to send."
Line 701  proc subjSendResponse {} { Line 778  proc subjSendResponse {} {
     }      }
     incr which      incr which
   
       set message ""
   
     set stuList [$gSubj(idlist) get 0 end]      set stuList [$gSubj(idlist) get 0 end]
     foreach stu $stuList {      foreach stu $stuList {
  set stu [lindex $stu 0]   set stu [lindex $stu 0]
  set index [lsearch $gSubj(allstunum) $stu]   set index [lsearch $gSubj(allstunum) $stu]
  set name [lindex $gSubj(allname) $index]   set name [lindex $gSubj(allname) $index]
  set email [lindex $gSubj(allemail) $index]   set email [lindex $gSubj(allemail) $index]
  puts "$name:[split $name ,]:[lindex [split $name ,] 1]:[lindex [lindex [split $name ,] 1] 0]:$index:$stu"   #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 [lsearch $gSubj(allemail) albertel@pilot.msu.edu]
  set first_name [lindex [lindex [split $name ,] 1] 0]   set first_name [lindex [lindex [split $name ,] 1] 0]
  set last_name [lindex [split $name , ] 0]   set last_name [lindex [split $name , ] 0]
  set score $gSubj(score)   set score $gSubj(score)
Line 717  proc subjSendResponse {} { Line 796  proc subjSendResponse {} {
  regsub -all -- \\\$score $message $score message   regsub -all -- \\\$score $message $score message
 # set message [subst -nobackslashes -nocommands $gSubj(response.$which)]  # set message [subst -nobackslashes -nocommands $gSubj(response.$which)]
  if { [regexp -- (^Subject:\[^\n\]*)(\n)(.*) $message matchvar subjline newline messagebody] } {   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 {   } 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"   displayMessage "$message sent to $email"
  exec echo $message | mail $email   exec echo $message | $gCapaConfig(mail_command) -s $subject $email
     }      }
 }  }
   
Line 804  proc subjDeleteResponse {} { Line 884  proc subjDeleteResponse {} {
     if { "" == [set which [$gSubj(responseList) curselection]]} { return }      if { "" == [set which [$gSubj(responseList) curselection]]} { return }
     incr which      incr which
     if { [catch {unset gSubj(response.$which)}] } {      if { [catch {unset gSubj(response.$which)}] } {
  puts [array names gSubj response.*]   #puts [array names gSubj response.*]
  return   return
     }      }
     for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {      for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {
Line 889  proc subjViewResponse {} { Line 969  proc subjViewResponse {} {
     button $buttonFrame.forget -text Dismiss -command "destroy $response"      button $buttonFrame.forget -text Dismiss -command "destroy $response"
     pack $buttonFrame.forget -side left      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
   }
Removed from v.1.4  
changed lines
  Added in v.1.12

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>