[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.8 and 1.9

version 1.8, 1999/12/07 19:45:45 version 1.9, 1999/12/13 21:38:44
Line 20  proc gradeSubjective {} { Line 20  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 124  proc createGradeSubjWindow {} { Line 125  proc createGradeSubjWindow {} {
   
     set gSubj(keyword) [text $right.keyword -width 60 -height 5 \      set gSubj(keyword) [text $right.keyword -width 60 -height 5 \
     -yscrollcommand "$right.scroll set" ]      -yscrollcommand "$right.scroll set" ]
     puts $gSubj(keyword)  
     puts $right  
     scrollbar $right.scroll -command "$right.response yview"      scrollbar $right.scroll -command "$right.response yview"
     pack $gSubj(keyword) $right.scroll -side left      pack $gSubj(keyword) $right.scroll -side left
     pack configure $right.scroll -fill y      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 $left.add -command "subjAddKeyword" -text "Add"
     button $left2.addsp -command "subjAddKeywordSpelling" -text "Add Sp"      button $left2.addsp -command "subjAddKeywordSpelling" -text "Add Sp"
     button $left.delete -command "subjDeleteKeyword" -text "Delete"      button $left.delete -command "subjDeleteKeyword" -text "Delete"
Line 313  proc subjInit {} { Line 315  proc subjInit {} {
  set gSubj(togo) [llength $gSubj(stunums)]   set gSubj(togo) [llength $gSubj(stunums)]
  subjNext   subjNext
     }      }
       subjUpdateKeywords
     after 300 updateSecCount      after 300 updateSecCount
 }  }
   
Line 393  proc subjNext {} { Line 396  proc subjNext {} {
  subjInsertIds $gSubj(done.$id.idlist)   subjInsertIds $gSubj(done.$id.idlist)
  update idletasks   update idletasks
     }      }
       subjUpdateResponse
     subjPicts      subjPicts
 }  }
   
Line 940  proc subjViewResponse {} { Line 944  proc subjViewResponse {} {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc subjUpdateResponse {} {  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 }
       }
 }  }
   
 ###########################################################  ###########################################################
Line 951  proc subjUpdateResponse {} { Line 981  proc subjUpdateResponse {} {
 proc subjUpdateKeywords {} {  proc subjUpdateKeywords {} {
     global gSubj      global gSubj
     $gSubj(keyword) delete 0.0 end      $gSubj(keyword) delete 0.0 end
     puts $gSubj(keywords)      set lokeyword ""
   #    puts $gSubj(keywords)
     foreach keyword $gSubj(keywords) { lappend lokeyword [lindex $keyword 0] }      foreach keyword $gSubj(keywords) { lappend lokeyword [lindex $keyword 0] }
       if { $lokeyword == "" } { return }
     set lokeyword [lsort $lokeyword]      set lokeyword [lsort $lokeyword]
     set max 0      set max 0
     foreach key $lokeyword {      foreach key $lokeyword {
Line 965  proc subjUpdateKeywords {} { Line 997  proc subjUpdateKeywords {} {
     for { set i 0 } { $i < $end } { incr i } {      for { set i 0 } { $i < $end } { incr i } {
  set line [expr $i/$numcol]   set line [expr $i/$numcol]
  set col [expr $i%$numcol*$max]   set col [expr $i%$numcol*$max]
  puts $line.$col  # puts $line.$col
  $gSubj(keyword) insert end [format "%-[set max]s" [lindex $lokeyword $i]]   $gSubj(keyword) insert end [format "%-[set max]s" [lindex $lokeyword $i]]
  if {($col + (2*$max)) > 60} {   if {($col + (2*$max)) > 60} {
     puts "Putting in newlne"  #    puts "Putting in newlne"
     $gSubj(keyword) insert end "\n"      $gSubj(keyword) insert end "\n"
     set lastline $line      set lastline $line
  }   }
Line 982  proc subjUpdateKeywords {} { Line 1014  proc subjUpdateKeywords {} {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc subjAddKeyword {} {  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   return
     }      }
     puts "New keyword $keyword"      set i 0
     lappend gSubj(keywords) [list $keyword [list $keyword]]      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      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.8  
changed lines
  Added in v.1.9

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