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

version 1.1.1.1, 1999/09/28 21:25:36 version 1.7, 2000/01/31 18:34:13
Line 573  proc parseCapaConfig { {num "" } { path Line 573  proc parseCapaConfig { {num "" } { path
  "exam_path *= *" -   "exam_path *= *" -
  "quiz_path *= *" -   "quiz_path *= *" -
  "supp_path *= *" -   "supp_path *= *" -
    "default_try_val *= *" -
    "default_prob_val *= *" -
    "default_hint_val *= *" -
  "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 1135  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 1146  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 1183  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 1424  proc pickSections { sectionsToPickFrom { Line 1428  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 1528  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 1640  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 1784  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
 }  }

Removed from v.1.1.1.1  
changed lines
  Added in v.1.7


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