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

Diff for /capa/capa51/GUITools/common.tcl between versions 1.1.1.1 and 1.8

version 1.1.1.1, 1999/09/28 21:25:36 version 1.8, 2000/02/22 18:10:27
Line 568  proc parseCapaConfig { {num "" } { path Line 568  proc parseCapaConfig { {num "" } { path
  "answers_command *= *" -   "answers_command *= *" -
  "dvips_command *= *" -   "dvips_command *= *" -
                 "xdvi_command *= *" -                  "xdvi_command *= *" -
    "mail_command *= *" -
  "IMP_color *= *" -   "IMP_color *= *" -
  "comment_color *= *" -   "comment_color *= *" -
  "exam_path *= *" -   "exam_path *= *" -
  "quiz_path *= *" -   "quiz_path *= *" -
  "supp_path *= *" -   "supp_path *= *" -
    "correction_path *= *" -
    "default_try_val *= *" -
    "default_prob_val *= *" -
    "default_hint_val *= *" -
    "homework_weight *= *" -
    "quiz_weight *= *" -
    "exam_weight *= *" -
    "final_weight *= *" -
    "correction_weight *= *" -
    "final_exam_set_number *= *" -
    "homework_count *= *" -
    "quiz_count *= *" -
  "others_path *= *" {    "others_path *= *" { 
     set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end]       set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] 
  }   }
Line 1132  proc getOneStudent { window path idVar n Line 1145  proc getOneStudent { window path idVar n
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc getString { window message } {  proc getString { window message {type "any"}} {
     global gPrompt       global gPrompt 
     set setWin [toplevel $window.getstring]      set setWin [toplevel $window.getstring]
           
Line 1143  proc getString { window message } { Line 1156  proc getString { window message } {
   
           
     set gPrompt(val) ""      set gPrompt(val) ""
     entry $valFrame.val -textvariable gPrompt(val)       entry $valFrame.val -textvariable gPrompt(val) -validate key \
    -validatecommand "limitEntry %W -1 $type %P"
     pack $valFrame.val      pack $valFrame.val
   
     message $msgFrame.msg -text $message -aspect 3000      message $msgFrame.msg -text $message -aspect 3000
Line 1179  proc getString { window message } { Line 1193  proc getString { window message } {
 proc multipleChoice { window message choices {single 1}} {  proc multipleChoice { window message choices {single 1}} {
     global gPromptMC      global gPromptMC
           
     set setWin [toplevel $window.getstring]      set setWin [toplevel $window.choice]
           
     set msgFrame [frame $setWin.msgFrame]      set msgFrame [frame $setWin.msgFrame]
     set valFrame [frame $setWin.valFrame]      set valFrame [frame $setWin.valFrame]
Line 1217  proc multipleChoice { window message cho Line 1231  proc multipleChoice { window message cho
     }      }
   
     bind $setWin <Return> "set gPromptMC(ok) 1"      bind $setWin <Return> "set gPromptMC(ok) 1"
       bind $setWin <Double-1> "set gPromptMC(ok) 1"
     Centre_Dialog $setWin default      Centre_Dialog $setWin default
     update idletasks      update idletasks
     focus $setWin      focus $setWin
Line 1231  proc multipleChoice { window message cho Line 1246  proc multipleChoice { window message cho
     }      }
     capaGrab release $setWin      capaGrab release $setWin
     destroy $setWin      destroy $setWin
       update idletasks
     if { $gPromptMC(ok) == 1 } {      if { $gPromptMC(ok) == 1 } {
  foreach selection $select { lappend result [lindex $choices $selection] }   foreach selection $select { lappend result [lindex $choices $selection] }
  if { [llength $result] == 1 } { set result [lindex $result 0] }   if { [llength $result] == 1 } { set result [lindex $result 0] }
Line 1424  proc pickSections { sectionsToPickFrom { Line 1440  proc pickSections { sectionsToPickFrom {
 }  }
   
 ###########################################################  ###########################################################
   # pickSets
   ###########################################################
   ###########################################################
   ###########################################################
   proc pickSets { setsToPickFrom mode {title "Select Sets"} {window ""}} {
       global gPromptPSets
       
       if { $setsToPickFrom == "" } { 
    displayMessage "No available sets."
    return "Cancel" 
       }
       set dialog [toplevel $window.pickSets -borderwidth 10]
       wm title $dialog "Which Sets"
   
       set infoFrame [frame $dialog.info ]
       set setListFrame [frame $dialog.list  -relief groove -borderwidth 5]
       set buttonFrame [frame $dialog.buttons -bd 10]
       pack $infoFrame $setListFrame $buttonFrame -side top -fill x
       
       message $infoFrame.msg -text $title -aspect 5000
       pack $infoFrame.msg
   
       set headerFrame [frame $setListFrame.head ]
       set listboxFrame [frame $setListFrame.listboxframe]
       pack $headerFrame $listboxFrame -side top 
       pack configure $headerFrame -anchor w
   
       message $headerFrame.msg -text "Set #" -aspect 5000
       pack $headerFrame.msg
   
       set setList [ listbox $listboxFrame.list \
                  -yscrollcommand "$listboxFrame.scroll set" \
                  -width 30 -height 10 -selectmode $mode ]
       scrollbar $listboxFrame.scroll \
                   -command "$listboxFrame.list yview" \
                   -orient v
       pack $setList $listboxFrame.scroll -side left
       pack configure $listboxFrame.scroll -fill y      
   
       foreach set $setsToPickFrom {
    $setList insert end [format "%3d" $set]
       }
   
       button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \
       -underline 0
       frame $buttonFrame.spacer -width 10
       button $buttonFrame.selectall -text "SelectAll" -command \
    "$setList selection set 0 end"
       button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \
       -underline 0
       bind $dialog <Destroy> "set gPromptPSets(yes) 0"
       bind $dialog <Double-1> "set gPromptPSets(yes) 1"
   
       if { $mode == "single" } {
    pack $buttonFrame.yes $buttonFrame.cancel -side left
       } else {
    pack $buttonFrame.yes $buttonFrame.spacer \
       $buttonFrame.selectall $buttonFrame.cancel -side left
       }
       
       bind $dialog <Alt-Key> break
       
       Centre_Dialog $dialog default
       update
       
       focus $dialog
       capaRaise $dialog
       capaGrab $dialog
       vwait gPromptPSets(yes)
       capaGrab release $dialog
       bind $dialog <Destroy> ""
       if {$gPromptPSets(yes)} {
    set selectionList [ $setList curselection ]
    set setsToDo ""
    foreach selection $selectionList {
       lappend setsToDo [string trim [lindex [$setList get $selection] 0]]
    }
    destroy $dialog
    return $setsToDo
       } else {
    destroy $dialog
    return Cancel
       }
   }
   
   ###########################################################
 # getSet  # getSet
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
Line 1438  proc getSet { pid set followupCommand {s Line 1540  proc getSet { pid set followupCommand {s
  if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }   if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }
     }      }
     if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}      if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}
     set command "$gCapaConfig(getSet.answers_command) $pid {} {} $set"      set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set"
     foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }      foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }
     set fileId [open "|$command" "r"]      set fileId [open "|$command" "r"]
     fileevent $fileId readable "getSetLine $num $fileId"      fileevent $fileId readable "getSetLine $num $fileId"
Line 1550  proc lunique __LIST { Line 1652  proc lunique __LIST {
     }      }
 }  }
   
   ###########################################################
   # lreverse
   ###########################################################
   proc lreverse list { 
       set result ""
       foreach element $list { set result [linsert $result 0 $element] } 
       return [concat $result]
   }
   
 proc splitline { line maxLength } {  proc splitline { line maxLength } {
     set length [string length $line]      set length [string length $line]
     set lines [expr $length/$maxLength + 1]      set lines [expr $length/$maxLength + 1]
Line 1685  proc winprintText { num } { Line 1796  proc winprintText { num } {
 ###########################################################  ###########################################################
 proc limitEntry { window max type {newvalue ""}} {  proc limitEntry { window max type {newvalue ""}} {
     after idle "$window config -validate key"      after idle "$window config -validate key"
     if {[string length $newvalue] > $max } { return 0 }      if {($max != -1) && ([string length $newvalue] > $max)} { return 0 }
     switch $type {      switch $type {
  any {}   any {}
  number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } }   number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } }
  letter {if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }}   letter { if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }}
    nospace {if {(![regexp "^\[^ \]+$" $newvalue])&& ($newvalue!="")} { return 0 }}
     }      }
     return 1      return 1
 }  }
   
   ###########################################################
   # getCapaID
   ###########################################################
   ###########################################################
   ###########################################################
   proc getCapaID { setinfo stunum sectionnum {path .} } {
       global  gMaxSet
       set pwd [pwd]
       cd $path
       set result ""
       switch -regexp -- $setinfo {
    ^[0-9]+$ {
       set result [getSpecificCapaId $stunum $setinfo]
    }
    ^[0-9]+\.\.[0-9]+$ {
       set range [split $setinfo .]
       set low [lindex $range 0]
       set high [lindex $range 2]
       for { set i $low } { $i <= $high } { incr i } {
    append result "[getSpecificCapaId $stunum $i] "
       }
    }
    ^[0-9]+(,[0-9]+)+$ {
       set list [split $setinfo ,]
       foreach set $list {
    append result "[getSpecificCapaId $stunum $set] "
       }
    }
    all {
       for { set i 1 } { $i <= $gMaxSet } { incr i } {
    if { [file exists [file join records date$i.db]] } {
       if { [isSetOpen $stunum $sectionnum $i] } {
    append result "[getSpecificCapaId $stunum $i] "
       }
    } else {
       break
    }
       }
    }
    default {
       set result "UNKNOWN"
    }
       }
       cd $pwd
       set result [string trim $result]
       return $result
   }
   
   ###########################################################
   # getScores
   ###########################################################
   ###########################################################
   ###########################################################
   proc getScores { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} {
       global  gMaxSet
       if { $limitVar != "none" } { upvar $limitVar limit }
       set pwd [pwd]
       cd $path
       set result "0"
       switch -regexp -- $setinfo {
    ^[0-9]+$ {
       if { $setinfo <= $max } {
    set result [format "%4d" [getScore $stunum $setinfo]]
       }
    }
    ^[0-9]+\.\.[0-9]+$ {
       set range [split $setinfo .]
       set low [lindex $range 0]
       set high [lindex $range 2]
       if { $high > $max } { set high $max }
       for { set i $low } { $i <= $high } { incr i } {
    incr result [getScore $stunum $i]
       }
       set result [format "%4d" $result]
    }
    ^[0-9]+(,[0-9]+)+$ {
       set result ""
       set list [split $setinfo ,]
       foreach set $list {
    if { $set > $max } { continue }
    append result [format "%4d " [getScore $stunum $set]]
       }
    }
    all {
       for { set i 1 } { $i <= $max } { incr i } {
    if { [file exists [file join records date$i.db]] } {
       if { [isSetOpen $stunum $sectionnum $i] } {
    incr result [getScore $stunum $i]
       }
    } else {
       set result [format "%4d" $result]
       break
    }
       }
       set limit [expr {$i-1}]
    }
    default {
       set result "UNKNOWN"
    }
       }
       cd $pwd
       set result [string trimright $result]
       return $result
   }
   
   ###########################################################
   # getScore
   ###########################################################
   ###########################################################
   ###########################################################
   proc getScore { stunum set } {
       set fileId [open [file join records set$set.db] r]
       set total_score 0
       set aline [gets $fileId]
       set weights [split [gets $fileId] {}]
       set aline [gets $fileId]
       set aline [gets $fileId]
       while {! [eof $fileId]} {
    if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} {
       set scores [lindex [split [lindex [split $aline " "] 1] ","] 0]
       set scores [split $scores {}] 
       for { set i 0 } { $i < [llength $scores] } { incr i } {
    switch -- [lindex $scores $i] {
       y - Y { incr total_score [lindex $weights $i] }
       n - N - e - E - - { }
       0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 {
    # catching in case weights is not as long as the record
    catch {incr total_score [lindex $scores $i]}
       }
       default { puts "Unknown character [lindex $scores $i]" }
    }
       }
       break
    }
    set aline [gets $fileId]
       }
       close $fileId
       return $total_score
   }
   
   ###########################################################
   # getTotals
   ###########################################################
   ###########################################################
   ###########################################################
   proc getTotals { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} {
       global  gMaxSet
       if { $limitVar != "none" } { upvar $limitVar limit }
       set pwd [pwd]
       cd $path
       set result "0"
       switch -regexp -- $setinfo {
    ^[0-9]+$ {
       if { $setinfo <= $max } {
    set result [format "%4d" [getTotal $stunum $setinfo]]
       }
    }
    ^[0-9]+\.\.[0-9]+$ {
       set range [split $setinfo .]
       set low [lindex $range 0]
       set high [lindex $range 2]
       if { $high > $max } { set high $max }
       for { set i $low } { $i <= $high } { incr i } {
    incr result [getTotal $stunum $i]
       }
       set result [format "%4d" $result]
    }
    ^[0-9]+(,[0-9]+)+$ {
       set result ""
       set list [split $setinfo ,]
       foreach set $list {
    if { $set > $max } { continue }
    append result [format "%4d " [getTotal $stunum $set]]
       }
    }
    all {
       for { set i 1 } { $i <= $max } { incr i } {
    if { [file exists [file join records date$i.db]] } {
       if { [isSetOpen $stunum $sectionnum $i] } {
    incr result [getTotal $stunum $i]
       }
    } else {
       set result [format "%4d" $result]
       break
    }
       }
       set limit [expr {$i-1}]
    }
    default {
       set result "UNKNOWN"
    }
       }
       cd $pwd
       set result [string trimright $result]
       return $result
   }
   
   ###########################################################
   # getTotal
   ###########################################################
   ###########################################################
   ###########################################################
   proc getTotal { stunum set } {
       set fileId [open [file join records set$set.db] r]
       set total_total 0
       set aline [gets $fileId]
       set weights [split [gets $fileId] {}]
       set aline [gets $fileId]
       set aline [gets $fileId]
       while {! [eof $fileId]} {
    if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} {
       set scores [lindex [split [lindex [split $aline " "] 1] ","] 0]
       set scores [split $scores {}] 
       for { set i 0 } { $i < [llength $scores] } { incr i } {
    switch -- [lindex $scores $i] {
       e - E { }
       0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - y - Y - n - N - - { 
    incr total_total [lindex $weights $i] 
       }
       default { 
    incr total_total [lindex $weights $i] 
    puts "Unknown character [lindex $scores $i]" 
       }
    }
       }
       break
    }
    set aline [gets $fileId]
       }
       close $fileId
       return $total_total
   }
   
Removed from v.1.1.1.1  
changed lines
  Added in v.1.8

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.