[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.5 and 1.8

version 1.5, 2000/01/05 21:11:15 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_try_val *= *" -
  "default_prob_val *= *" -   "default_prob_val *= *" -
  "default_hint_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 1221  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 1235  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 1432  proc pickSections { sectionsToPickFrom { Line 1444  proc pickSections { sectionsToPickFrom {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc pickSections { setsToPickFrom mode {title "Select Sets"} {window ""}} {  proc pickSets { setsToPickFrom mode {title "Select Sets"} {window ""}} {
     global gPromptPSets      global gPromptPSets
           
       if { $setsToPickFrom == "" } { 
    displayMessage "No available sets."
    return "Cancel" 
       }
     set dialog [toplevel $window.pickSets -borderwidth 10]      set dialog [toplevel $window.pickSets -borderwidth 10]
     wm title $dialog "Which Sets"      wm title $dialog "Which Sets"
   
Line 1464  proc pickSections { setsToPickFrom mode Line 1480  proc pickSections { setsToPickFrom mode
     pack configure $listboxFrame.scroll -fill y            pack configure $listboxFrame.scroll -fill y      
   
     foreach set $setsToPickFrom {      foreach set $setsToPickFrom {
  $setList insert end [format "%3d" $set   $setList insert end [format "%3d" $set]
     }      }
   
     button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \      button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \
Line 1475  proc pickSections { setsToPickFrom mode Line 1491  proc pickSections { setsToPickFrom mode
     button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \      button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \
     -underline 0      -underline 0
     bind $dialog <Destroy> "set gPromptPSets(yes) 0"      bind $dialog <Destroy> "set gPromptPSets(yes) 0"
       bind $dialog <Double-1> "set gPromptPSets(yes) 1"
   
     pack $buttonFrame.yes $buttonFrame.spacer \      if { $mode == "single" } {
  $buttonFrame.selectall $buttonFrame.cancel -side left   pack $buttonFrame.yes $buttonFrame.cancel -side left
       } else {
    pack $buttonFrame.yes $buttonFrame.spacer \
       $buttonFrame.selectall $buttonFrame.cancel -side left
       }
           
     bind $dialog <Alt-Key> break      bind $dialog <Alt-Key> break
           
Line 1494  proc pickSections { setsToPickFrom mode Line 1515  proc pickSections { setsToPickFrom mode
  set selectionList [ $setList curselection ]   set selectionList [ $setList curselection ]
  set setsToDo ""   set setsToDo ""
  foreach selection $selectionList {   foreach selection $selectionList {
     append setsToDo "[lindex [$setList get $selection] 0] "      lappend setsToDo [string trim [lindex [$setList get $selection] 0]]
  }   }
  destroy $dialog   destroy $dialog
  return $setsToDo   return $setsToDo
Line 1631  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 1776  proc limitEntry { window max type {newva Line 1806  proc limitEntry { window max type {newva
     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.5  
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.