Annotation of capa/capa51/GUITools/common.tcl, revision 1.4

1.1       albertel    1: set gMaxSet 99
                      2: ###########################################################
                      3: # capaRaise
                      4: ###########################################################
                      5: # tries to make sure that the window mostly definatley ends
                      6: # up on top. Needed to do this beacuase of how an Xserver 
                      7: # for WinNT handles raise
                      8: ###########################################################
                      9: # Argument: window - name of the window to get on top
                     10: # Returns : nothing
                     11: # Globals : nothing
                     12: ###########################################################
                     13: proc capaRaise { window } {
                     14:     if { $window == "" } { return }
                     15:     wm withdraw $window
                     16:     wm deiconify $window
                     17: #    raise $window
                     18: }
                     19: 
                     20: ###########################################################
                     21: # cleanWindowList
                     22: ###########################################################
                     23: ###########################################################
                     24: ###########################################################
                     25: proc cleanWindowList { } {
                     26:     global gWindowMenu gCmd gUndoSize gUndo
                     27: 
                     28:     set gCmd "Tcl Commands executed: [info cmdcount]" 
                     29:     catch {set gUndoSize "Undo information size [array size gUndo]:[string length [array get gUndo]]"}
                     30:     if { ![winfo exists $gWindowMenu] } {
                     31: 	after 1000 cleanWindowList
                     32: 	return
                     33:     }
                     34:     set num [$gWindowMenu index end]
                     35:     for { set i 1 } { $i <= $num } { incr i } {
                     36: 	set window [lindex [$gWindowMenu entrycget $i -command] 1]
                     37: 	if { ![winfo exists $window] } { 
                     38: 	    $gWindowMenu delete $i
                     39: 	    incr i -1
                     40: 	    set num [$gWindowMenu index end]
                     41: 	}
                     42:     }
                     43:     after 1000 cleanWindowList
                     44: }
                     45: 
                     46: ###########################################################
                     47: # createRemapWindow
                     48: ###########################################################
                     49: # creates the window to start the process of remapping or unmapping 
                     50: # the xKeySym for a key
                     51: ###########################################################
                     52: # Argument: none
                     53: # Returns: nothing
                     54: # Globals: gWindowMenu - used to register the window under the windows
                     55: #                        menu
                     56: ###########################################################
                     57: proc createRemapWindow {} {
                     58:     global gWindowMenu
                     59: 
                     60:     if { [winfo exists .remap] } {
                     61: 	capaRaise .remap 
                     62: 	return
                     63:     }
                     64: 
                     65:     set remap [toplevel .remap]
                     66:     $gWindowMenu add command -label "Remap" -command "capaRaise $remap"
                     67:     wm title $remap "Select Remap Command"
                     68: 
                     69:     label $remap.label -text "This requires that xmodmap be in your path"
                     70:     button $remap.delete -text "Remap a key to delete" -command \
                     71: 	    "remap Delete
                     72:              destroy $remap
                     73:              removeWindowEntry Remap"
                     74:     button $remap.backspace -text "Remap a key to backspace" -command \
                     75: 	    "remap BackSpace
                     76:              destroy $remap
                     77:              removeWindowEntry Remap"
                     78:     button $remap.unmap -text "Unmap a remapped key" -command \
                     79: 	    "remap unmap
                     80:              destroy $remap
                     81:              removeWindowEntry Remap"
                     82:     button $remap.cancel -text "Cancel" -command \
                     83:             "destroy $remap
                     84:              removeWindowEntry Remap"
                     85:     pack $remap.label $remap.delete $remap.backspace $remap.unmap \
                     86: 	    $remap.cancel -side top
                     87: 
                     88:     Centre_Dialog $remap default
                     89: }
                     90: 
                     91: ###########################################################
                     92: # remap
                     93: ###########################################################
                     94: # creates a window thaat tells the user to press a key, which globally
                     95: # grabs input, and the runs xmodmap to a file it creates in /tmp named
                     96: # gkc[pid].
                     97: ###########################################################
                     98: # Arguments: one of (Delete,Backspace,unmap), type of remap to preform
                     99: # Returns: nothing
                    100: # Globals: gOriginalKeySyms - stores the KeySyms and keycodes of
                    101: #                             remmapped keys.
                    102: #          gPromptRemap - used to capture the keypress by the user.
                    103: # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap 
                    104: #                        (created and removed)
                    105: ###########################################################
                    106: proc remap { type } {
                    107:     global gOriginalKeySyms gPromptRemap
                    108: 
                    109:     set gPromptRemap(result) ""
                    110: 
                    111:     switch $type {
                    112: 	Delete
                    113: 	-
                    114: 	BackSpace
                    115: 	{
                    116: 	    set dialog [toplevel .dialog]
                    117: 	    wm title $dialog "Grabbing keypress"
                    118: 	    label $dialog.label -text "Press the key that you want to remap \
                    119: 		    to $type" 
                    120: 	    label $dialog.label2 -textvariable gPromptRemap(result)
                    121: 	    pack $dialog.label $dialog.label2
                    122: 	    
                    123: 	    bind all <KeyPress> "set gPromptRemap(result) \"%k %K\""
                    124: 	    Centre_Dialog $dialog default
                    125: 	    capaRaise $dialog
                    126: 	    focus $dialog
                    127: 	    grab -global $dialog
                    128: 	    vwait gPromptRemap(result)
                    129: 	    grab release $dialog
                    130: 	    destroy $dialog
                    131: 	    bind all <KeyPress> ""
                    132: 	    set oldKeyCode [lindex $gPromptRemap(result) 0]
                    133: 	    set oldKeySym [lindex $gPromptRemap(result) 1]
                    134: 	    set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ]
                    135: 	    if { $error == 1 } {
                    136: 		set gOriginalKeySyms($oldKeyCode) $oldKeySym
                    137: 	    }
                    138: 	    exec echo "keycode $oldKeyCode = $type" > [ file join / tmp \
                    139: 		    gkc[pid] ]
                    140: 	    exec xmodmap [ file join / tmp gkc[pid] ]
                    141: 	    displayMessage "Remapped $oldKeySym to $type"
                    142: 	}
                    143: 	unmap
                    144: 	{
                    145: 	    set dialog [toplevel .dialog]
                    146: 	    wm title $dialog "Grabbing keypress"
                    147: 	    label $dialog.label -text "Press the key that you want to unmap" 
                    148: 	    label $dialog.label2 -textvariable gPromptRemap(result)
                    149: 	    pack $dialog.label $dialog.label2
                    150: 	    
                    151: 	    bind all <KeyPress> "set gPromptRemap(result) \"%k %K\""
                    152: 	    Centre_Dialog $dialog default
                    153: 	    capaRaise $dialog
                    154: 	    focus $dialog
                    155: 	    grab -global $dialog
                    156: 	    vwait gPromptRemap(result)
                    157: 	    grab release $dialog
                    158: 	    destroy $dialog
                    159: 	    bind all <KeyPress> ""
                    160: 	    set oldKeyCode [lindex $gPromptRemap(result) 0]
                    161: 	    set oldKeySym [lindex $gPromptRemap(result) 1]
                    162: 	    set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ]
                    163: 	    if { $error == 1 } {
                    164: 		displayMessage "Sorry, $oldKeySym has not been remapped \
                    165: 			since Quizzer has been started."
                    166: 	    } else {
                    167: 		exec echo "keycode $oldKeyCode = \
                    168: 			$gOriginalKeySyms($oldKeyCode)" > \
                    169: 			[ file join / tmp gkc[pid] ]
                    170: 		exec xmodmap [ file join / tmp gkc[pid] ]
                    171: 		displayMessage "Remapped $oldKeySym back to \
                    172: 		    $gOriginalKeySyms($oldKeyCode) "
                    173: 	    }
                    174: 	}
                    175:     }
                    176:     catch { rm -f [file join / tmp gkc*]}
                    177: }
                    178: 
                    179: ###########################################################
                    180: # unmapAllKeys
                    181: ###########################################################
                    182: # wanders through the gOriginalKeySyms var and unmap individually
                    183: # all of the keys that had been remmapped
                    184: ###########################################################
                    185: # Arguments: none
                    186: # Returns: nothing
                    187: # Globals: gOriginalKeySyms - stores the original KeySym values by
                    188: #                             keycodes that have been remmapped
                    189: # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap 
                    190: #                        (created and removed)
                    191: ###########################################################
                    192: proc unmapAllKeys { } {
                    193:     global gOriginalKeySyms
                    194: 
                    195:     set allKeyCodes [array names gOriginalKeySyms]
                    196:     
                    197:     while { $allKeyCodes != "" } {
                    198: 	set oldKeyCode [lindex $allKeyCodes 0]
                    199: 	set allKeyCodes [lrange $allKeyCodes 1 end]
                    200: 	exec echo "keycode $oldKeyCode = $gOriginalKeySyms($oldKeyCode)" \
                    201: 		> [ file join / tmp gkc[pid] ]
                    202: 	exec xmodmap [ file join / tmp gkc[pid] ]
                    203: 	catch { rm -rf [ file join / tmp gkc*] }
                    204:     }
                    205:     #displayMessage "Remapped all keys back to original value."
                    206: }
                    207: 
                    208: 
                    209: ###########################################################
                    210: # displayError
                    211: ###########################################################
                    212: # displays a modal dialog with an errormessage to the user
                    213: ###########################################################
                    214: # Arguments: the message to be displayed
                    215: # Returns: Nothing
                    216: # Globals: gPromptDE - used to detect when the user presses ok
                    217: ###########################################################
                    218: proc displayError { msg {color black} } {
                    219:     global gPromptDE
                    220: 
                    221:     set dialog [toplevel .prompt -borderwidth 10]
                    222:     wm geo $dialog "+200+200"
                    223:     wm title $dialog "Error"
                    224: 
                    225:     message $dialog.warning -text "WARNING" -font 12x24 -aspect 700
                    226:     message $dialog.msg -text "$msg" -aspect 700 -foreground $color
                    227:     set buttonFrame [frame $dialog.buttons -bd 10]
                    228:     pack $dialog.warning $dialog.msg $buttonFrame -side top -fill x
                    229:     
                    230:     button $buttonFrame.ok -text Dismiss -command { set gPromptDE(ok) 1 } \
                    231: 	    -underline 0
                    232:     pack $buttonFrame.ok -side left
                    233:    
                    234:     Centre_Dialog $dialog default 
                    235:     update
                    236: 
                    237:     capaRaise $dialog
                    238:     focus $dialog
                    239:     capaGrab $dialog
                    240:     vwait gPromptDE(ok)
                    241:     capaGrab release $dialog
                    242:     destroy $dialog
                    243:     return
                    244: }
                    245: 
                    246: ###########################################################
                    247: # capaGrab
                    248: ###########################################################
                    249: # modification of tcl's grab, this one sets up a binding so that
                    250: # if you click anywhere else the window is reshuffled back to the
                    251: # top
                    252: ###########################################################
                    253: # Arguments: either "window" or "release window"
                    254: # Returns: Nothing
                    255: # Globals: None
                    256: ###########################################################
                    257: proc capaGrab { args } {
                    258:     if { [lindex $args 0] == "release" } {
                    259: 	set window [lindex $args 1]
                    260: 	grab release $window
                    261: 	bind all <ButtonRelease> {}
                    262:     } else {
                    263: 	set window [lindex $args 0]
                    264: 	grab $window	
                    265: 	bind all <ButtonRelease> "capaAutoRaise $window %W"
                    266:     }
                    267: }
                    268: 
                    269: proc capaAutoRaise { window reportWin } {
                    270:     if { $window == $reportWin } {
                    271: 	capaRaise $window
                    272: 	focus $window
                    273:     }
                    274: }
                    275: 
                    276: ###########################################################
                    277: # displayMessage
                    278: ###########################################################
                    279: # displays a modal dialog with a message to the user
                    280: ###########################################################
                    281: # Arguments: the message to be displayed
                    282: # Returns: Nothing
                    283: # Globals: gPromptDM - used to detect when the user presses ok
                    284: ###########################################################
                    285: proc displayMessage { msg {color black} } {
                    286:     global gPromptDM
                    287: 
                    288:     set dialog [toplevel .prompt -borderwidth 10]
                    289:     wm geo $dialog "+200+200"
                    290:     wm title $dialog "Message"
                    291: 
                    292:     message $dialog.msg -text "$msg" -aspect 700 -foreground $color
                    293:     set buttonFrame [frame $dialog.buttons -bd 10]
                    294:     pack $dialog.msg $buttonFrame -side top -fill x
                    295:     
                    296:     button $buttonFrame.ok -text Dismiss -command { set gPromptDM(ok) 1 } \
                    297: 	    -underline 0
                    298:     pack $buttonFrame.ok -side left
                    299:     
                    300:     bind $buttonFrame.ok <Return> "set gPromptDM(ok) 1"
                    301:     Centre_Dialog $dialog default
                    302:     update
                    303: 
                    304:     focus $dialog
                    305:     capaRaise $dialog
                    306:     capaGrab $dialog
                    307:     vwait gPromptDM(ok)
                    308:     capaGrab release $dialog
                    309:     destroy $dialog
                    310:     return
                    311: }
                    312: 
                    313: ###########################################################
                    314: # getLprCommand
                    315: ###########################################################
                    316: # builds a command string to print with
                    317: ###########################################################
                    318: # Arguments: name of the file to be printed
                    319: #            num - index of options in gCapaConfig
                    320: # Returns: the print command if accepted, Cancel if cancel was hit 
                    321: # Globals: gPrompt - the variable watched to control when to 
                    322: #                    remove the dialog
                    323: #          gLprCommand - the variable which stores a specified command
                    324: #          gCapaConfig - the variable holding the print strings from
                    325: #                        the capa.config file
                    326: ###########################################################
                    327: proc getLprCommand { PS_file {num ""}} {
                    328:     global gLprCommand gPrompt gCapaConfig Printer_selected
                    329: 
                    330:     if { $num != "" } {	set prefix "$num." } else { set prefix "" }
                    331:     set showPrinterList false
                    332:     set dialog [toplevel .lprCommand -borderwidth 10]
                    333:     wm title $dialog "Command to Print"
                    334:     wm geo $dialog "+200+200"
                    335:     
                    336:     set infoFrame [ frame $dialog.infoFrame ]
                    337:     set optionsFrame [ frame $dialog.optionsFrame ]
                    338:     set buttonFrame [frame $dialog.buttons -bd 10]
                    339:     pack $infoFrame $optionsFrame $buttonFrame -side top -fill x -anchor w 
                    340: 
                    341:     message $infoFrame.msg -text "Select a printing method:" -aspect 5000
                    342:     pack $infoFrame.msg
                    343: 
                    344:     set printInfo [frame $optionsFrame.info]
                    345:     set printerList [frame $optionsFrame.list]
                    346:     set printerListFrame [frame $optionsFrame.printFrame]
                    347:     set oneSidedFrame [frame $optionsFrame.oneSided]
                    348:     set twoSidedFrame [frame $optionsFrame.twoSided]
                    349:     set spaceFrame [frame $optionsFrame.space -height 30]
                    350:     set specifiedFrame [frame $optionsFrame.specified]
                    351:     pack $printInfo $printerList $oneSidedFrame $twoSidedFrame \
                    352: 	    $spaceFrame $specifiedFrame -side top -anchor w
                    353:     pack configure $printInfo -anchor w
                    354:     pack configure $printerList -anchor e
                    355: 
                    356:     if { [array names gLprCommand which] == "" } { set gLprCommand(which) "" }
                    357:     radiobutton $oneSidedFrame.radio -text "One Sided" -value \
                    358: 	    "OneSided" -variable gLprCommand(which)
                    359:     message $oneSidedFrame.cmd -text $gCapaConfig([set prefix]lprOneSided_command) \
                    360: 	    -relief raised -width 600 -aspect 5000
                    361:     if { $gCapaConfig([set prefix]lprOneSided_command) != "" } {
                    362: 	if { $gLprCommand(which) == "" } { set gLprCommand(which) OneSided }
                    363: 	set showPrinterList true
                    364: 	pack $oneSidedFrame.radio $oneSidedFrame.cmd -side top
                    365: 	pack configure $oneSidedFrame.radio -anchor w
                    366: 	pack configure $oneSidedFrame.cmd -anchor e
                    367:     }
                    368: 
                    369:     radiobutton $twoSidedFrame.radio -text "Two Sided" -value \
                    370: 	    "TwoSided" -variable gLprCommand(which)
                    371:     message $twoSidedFrame.cmd -text $gCapaConfig([set prefix]lprTwoSided_command) \
                    372: 	    -relief raised -width 400 -aspect 5000
                    373:     if { $gCapaConfig([set prefix]lprTwoSided_command) != "" } {
                    374: 	if { $gLprCommand(which) == "" } { set gLprCommand(which) TwoSided }
                    375: 	set showPrinterList true
                    376: 	pack $twoSidedFrame.radio $twoSidedFrame.cmd -side top
                    377: 	pack configure $twoSidedFrame.radio -anchor w
                    378: 	pack configure $twoSidedFrame.cmd -anchor e
                    379:     }
                    380:     
                    381:     message $printInfo.text -text "\$Printer_selected = " -aspect 5000
                    382:     message $printInfo.current -textvariable Printer_selected \
                    383: 	    -aspect 5000 
                    384:     pack $printInfo.text $printInfo.current -side left
                    385: 
                    386:     set printerListbox [ listbox $printerList.list -width 20 \
                    387:                -yscrollcommand "$printerList.scroll set" -height 3 ]
                    388:     scrollbar $printerList.scroll -orient v -command "$printerList.list yview" 
                    389:     if { $showPrinterList && $gCapaConfig([set prefix]printer_option) != "" } {
                    390: 	pack $printerListbox $printerList.scroll -side left -anchor e
                    391: 	pack configure $printerList.scroll -fill y
                    392: 	foreach printer $gCapaConfig([set prefix]printer_option) {
                    393: 	    $printerListbox insert end $printer
                    394: 	}
                    395: 	set Printer_selected [lindex $gCapaConfig([set prefix]printer_option) 0]
                    396: 	if { $gCapaConfig(Printer_selected) == "" } {
                    397: 	    set gCapaConfig(Printer_selected) 0
                    398: 	}
                    399: 	$printerListbox selection set $gCapaConfig(Printer_selected)
                    400: 	$printerListbox see $gCapaConfig(Printer_selected)
                    401: 	set script "set Printer_selected \[$printerListbox get \[$printerListbox curselection \] \]"
                    402: 	eval $script
                    403: 	bind $printerListbox <B1-ButtonRelease> "eval $script"
                    404: 	bind $printerListbox <Key> "eval $script"
                    405: 	bind $printerListbox <Motion> "eval $script"
                    406:     }
                    407: 
                    408:     radiobutton $specifiedFrame.radio -text "Specified"  -value \
                    409: 	    "Specified" -variable gLprCommand(which)
                    410:     if { $gLprCommand(which) == "" } { set gLprCommand(which) Specified }
                    411:     message $specifiedFrame.msg -text "Print command:" -aspect 5000
                    412:     entry $specifiedFrame.entry -textvariable gLprCommand(Specified) \
                    413: 	    -width 40 -xscrollcommand "$specifiedFrame.scroll set"
                    414:     trace variable gLprCommand(Specified) w \
                    415: 	"global gLprCommand; set gLprCommand(which) Specified ;#"
                    416:     scrollbar $specifiedFrame.scroll -command "$specifiedFrame.entry xview" \
                    417: 	    -orient h
                    418:     message $specifiedFrame.msg2 -text "Example: lpr -PlocalPrinter" \
                    419: 	    -aspect 5000
                    420:     pack $specifiedFrame.radio $specifiedFrame.msg $specifiedFrame.entry \
                    421: 	    $specifiedFrame.scroll $specifiedFrame.msg2 -side top
                    422:     pack configure $specifiedFrame.radio -anchor w
                    423:     pack configure $specifiedFrame.entry -anchor w
                    424:     pack configure $specifiedFrame.scroll -fill x
                    425: 
                    426:     button $buttonFrame.ok -text Print -command {set gPrompt(yes) 1} \
                    427: 	    -underline 0
                    428:     button $buttonFrame.cancel -text Cancel -command { set gPrompt(yes) 0 } \
                    429: 	    -underline 0
                    430:     pack $buttonFrame.ok $buttonFrame.cancel -side left
                    431: 	
                    432:     bind $dialog <Alt-Key> break
                    433:     
                    434:     Centre_Dialog $dialog default
                    435:     update
                    436: 
                    437:     focus $dialog
                    438:     capaRaise $dialog
                    439:     capaGrab $dialog
                    440:     vwait gPrompt(yes)
                    441:     capaGrab release $dialog
                    442:     if {$gPrompt(yes)} {
                    443: 	switch $gLprCommand(which) {
                    444: 	    Specified { set command "$gLprCommand(Specified)" }
                    445: 	    OneSided  {	set command "$gCapaConfig([set prefix]lprOneSided_command)" }
                    446: 	    TwoSided  {	set command "$gCapaConfig([set prefix]lprTwoSided_command)" }
                    447: 	    default   {
                    448: 		destroy $dialog
                    449: 		return "Cancel" 
                    450: 	    }
                    451: 	}
                    452: 	if { $command == "" } {
                    453: 	    destroy $dialog
                    454: 	    displayError "An empty print command can not be used."
                    455: 	    return "Cancel"
                    456: 	}
                    457: 	set gCapaConfig(Printer_selected) [$printerListbox curselection]
                    458: 	if { [string first \$PS_file $command] == -1 } {
                    459: 	    set command "$command $PS_file"
                    460: 	    set command [subst $command]
                    461: 	} else {
                    462: 	    set command [subst $command]
                    463: 	}
                    464: 	destroy $dialog
                    465: 	return "$command"
                    466:     } else {
                    467: 	destroy $dialog
                    468: 	return "Cancel"
                    469:     }
                    470: }
                    471: 
                    472: ###########################################################
                    473: # makeSure
                    474: ###########################################################
                    475: # generalized Yes No question proc,
                    476: ###########################################################
                    477: # Arguments: a string containing the question to ask the user
                    478: # Returns: Yes, or Cancel
                    479: # Globals: gPrompt - used to watch for a response
                    480: ###########################################################
                    481: proc makeSure { question } {
                    482:     global gPrompt
                    483:     
                    484:     set dialog [toplevel .makeSurePrompt -borderwidth 10]
                    485: 
                    486:     wm geo $dialog "+200+200"
                    487:     message $dialog.msg -text "$question" -aspect 700
                    488:     
                    489:     set gPrompt(result) ""
                    490:     set buttonFrame [frame $dialog.buttons -bd 10]
                    491:     pack $dialog.msg $buttonFrame -side top -fill x
                    492:     
                    493:     button $buttonFrame.yes -text Yes -command {set gPrompt(yes) 1} \
                    494: 	    -underline 0
                    495:     frame  $buttonFrame.spacer 
                    496:     button $buttonFrame.cancel -text No -command { set gPrompt(yes) 0 } \
                    497: 	    -underline 0
                    498:     pack $buttonFrame.yes $buttonFrame.spacer $buttonFrame.cancel -side left
                    499:     pack configure $buttonFrame.spacer -expand 1 -fill x
                    500: 
                    501:     bind $dialog <Alt-Key> break
                    502:     
                    503:     Centre_Dialog $dialog default
                    504:     update
                    505:     
                    506:     focus $dialog
                    507:     capaRaise $dialog
                    508:     capaGrab $dialog
                    509:     vwait gPrompt(yes)
                    510:     capaGrab release $dialog
                    511:     destroy $dialog
                    512:     if {$gPrompt(yes)} {
                    513: 	return Yes
                    514:     } else {
                    515: 	return Cancel
                    516:     }
                    517: }    
                    518: 
                    519: ###########################################################
                    520: # parseCapaConfig
                    521: ###########################################################
                    522: ###########################################################
                    523: ###########################################################
                    524: proc parseCapaConfig { {num "" } { path "" } } {
                    525:     global gCapaConfig
                    526: 
                    527:     if { $num != "" } {
                    528: 	set prefix "$num."
                    529:     } else {
                    530: 	set prefix "" 
                    531:     }
                    532:     if { $path == "" } { set path [pwd] }
                    533:     set filename [file join $path capa.config]
                    534:     set error [ catch { set fileId [open $filename "r"] } ]
                    535:     if { $error } {
                    536: 	displayError "Unable to find a capa.config file in $path."
                    537: 	error "No capa.config"
                    538:     }
                    539:     
                    540:     set saveto ""
                    541:     set saveline false
                    542: 
                    543:     while { 1 } {
                    544: 	gets $fileId aline
                    545: 	if { [eof $fileId ] } { break }
                    546: 	set error [ catch {
                    547: 	    switch -glob -- "$aline" {
                    548: 		"printer_option *= *" {
                    549: 		    lappend gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end]
                    550: 		}
                    551: 		"BeginStandardQuizzerHeader*" {
                    552: 		    set saveto [set prefix]standardQuizzerHeader
                    553: 		    set saveline true
                    554: 		    set gCapaConfig($saveto) ""
                    555: 		    set aline ""
                    556: 		}
                    557: 		"EndStandardQuizzerHeader*" {
                    558: 		    set saveto ""
                    559: 		    set saveline false
                    560: 		}
                    561: 		"quizzerBackupQZ *= *" -
                    562: 		"quizzerBackupRef *= *" -
                    563: 		"lprOneSided_command *= *" -
                    564: 		"lprTwoSided_command *= *" -
                    565: 		"latex_command *= *" -
                    566: 		"allcapaid_command *= *" -
                    567: 		"qzparse_command *= *" -
                    568: 		"answers_command *= *" -
                    569: 		"dvips_command *= *" -
                    570:                 "xdvi_command *= *" -
                    571: 		"IMP_color *= *" -
                    572: 		"comment_color *= *" -
                    573: 		"exam_path *= *" -
                    574: 		"quiz_path *= *" -
                    575: 		"supp_path *= *" -
1.2       albertel  576: 		"default_try_val *= *" -
                    577: 		"default_prob_val *= *" -
                    578: 		"default_hint_val *= *" -
1.1       albertel  579: 		"others_path *= *" { 
                    580: 		    set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] 
                    581: 		}
                    582: 	    }
                    583: 	}
                    584:         ]
                    585: 	if { $error } {
                    586: 	    displayError "Error in capa.config file in line: $aline"
                    587: 	}
                    588: 	if { $saveline } {
                    589: 	    append gCapaConfig($saveto) "$aline\n"
                    590: 	}
                    591:     }
                    592:     close $fileId
                    593:     return OK
                    594: }
                    595: 
                    596: ###########################################################
                    597: # parseCapaUtilsConfig
                    598: ###########################################################
                    599: ###########################################################
                    600: ###########################################################
                    601: proc parseCapaUtilsConfig { num path } {
                    602:     global gCapaConfig
                    603:     
                    604:     set filename [file join $path capa.config]
                    605:     set error [ catch { set fileId [open $filename "r"] } ]
                    606:     if { $error } {
                    607: 	displayError "Unable to find a capautils.config file in $path."
                    608: 	error "No capautils.config"
                    609:     }
                    610:     
                    611:     set saveto ""
                    612:     set saveline false
                    613: 
                    614:     while { 1 } {
                    615: 	gets $fileId aline
                    616: 	if { [eof $fileId ] } { break }
                    617: 	set error [ catch {
                    618: 	    switch -glob -- "$aline" {
                    619: 		"homework_scores_limit_set *= *" -
                    620: 		"exam_scores_limit_set *= *" -
                    621: 		"quiz_scores_limit_set *= *" -
                    622: 		"supp_scores_limit_set *= *" -
                    623: 		"others_scores_limit_set *= *" -
                    624: 		"master_scores_file *= *" -
                    625: 		"email_template_file *= *" -
                    626: 		"correction_factor *= *" -
                    627: 		"hw_percent *= *" -
                    628: 		"qz_percent *= *" - 
                    629: 		"mt1_percent *= *" - 
                    630: 		"mt2_percent *= *" - 
                    631: 		"mt3_percent *= *" - 
                    632: 		"final_percent *= *" - 
                    633: 		"category_one_high *= *" -
                    634: 		"category_one_low *= *" -
                    635: 		"category_two_high *= *" -
                    636: 		"category_two_low *= *" -
                    637: 		"category_three_high *= *" -
                    638: 		"category_three_low *= *" -
                    639: 		"category_four_high *= *" -
                    640: 		"category_four_low *= *" -
                    641: 		"display_score_row_limit *= *" 
                    642: 		{
                    643: 		    set gCapaConfig($num.[lindex $aline 0]) [lindex $aline end] 
                    644: 		}
                    645: 	    }
                    646: 	}
                    647: 	]
                    648: 	if { $error } {
                    649: 	    displayError "Error in capautils.config file in line: $aline"
                    650: 	}
                    651: 	if { $saveline } {
                    652: 	    append capaConfig($saveto) "$aline\n"
                    653: 	}
                    654:     }
                    655:     return OK
                    656: }
                    657: 
                    658: ###########################################################
                    659: # removeWindowEntry
                    660: ###########################################################
                    661: # used to deregister a Window Menu entry
                    662: ###########################################################
                    663: # Arguments: the label the window was registered under
                    664: # Returns: nothing
                    665: # Globals: gWindowMenu - name of the WindowMenu
                    666: ###########################################################
                    667: proc removeWindowEntry { label } {
                    668:     global gWindowMenu
                    669: 
                    670:     catch {$gWindowMenu delete $label}
                    671: }
                    672: 
                    673: proc scrolltwo { firstcommand secondcommand args } {
                    674:     eval "$firstcommand $args"
                    675:     eval "$secondcommand $args"
                    676: }
                    677: 
                    678: ###########################################################
                    679: # getTextTagged
                    680: ###########################################################
                    681: ###########################################################
                    682: ###########################################################
                    683: proc getTextTagged { window tag } {
                    684:     if { $tag == "" } { return [$window get 0.0 end-1c] }
                    685:     set result ""
                    686:     set range [$window tag nextrange $tag 0.0]
                    687:     while { $range != "" } {
                    688: 	set index [lindex $range 1]
                    689: 	append result [eval "$window get $range"]
                    690: 	append result "\n"
                    691: 	set range [$window tag nextrange $tag $index]
                    692:     }
                    693:     return $result
                    694: }
                    695: 
                    696: ###########################################################
                    697: # getWhichTags
                    698: ###########################################################
                    699: ###########################################################
                    700: ###########################################################
                    701: proc getWhichTags { descriptions tags action } {
                    702:     set whichtag [eval "tk_dialog .whichtag {Select which messages} \
                    703:                    {Select which set of messages will be $action.} \
                    704:                    {} 0 $descriptions"]
                    705:     return [lindex $tags $whichtag]
                    706: }
                    707: 
                    708: ###########################################################
                    709: # displayStatus
                    710: ###########################################################
                    711: # creates a window on the screen with one or both of a message
                    712: # or a canvas with a status bar, uses updateStatusMessage and
                    713: # updateStatusBar to update the respective parts of the status
                    714: # window, and use removeStatus to remove the status bar from 
                    715: # the screen
                    716: ###########################################################
                    717: # Arguments: the message to be displayed (a blank if one is not wanted)
                    718: #            and one of (both, bar, or message) to specify what
                    719: #            parts one wnats in the status bar and optionally a number
                    720: #            if there might be more than one Status at a time
                    721: # Returns: Nothing
                    722: # Globals: gStatus - an array containing information for the status
                    723: #              ($num.type) - the type of status
                    724: #              ($num.message) - the message in the status window
                    725: #              ($num.bar) - the id number of the rectangle in the canvas
                    726: #              (num) - (Optional) if there are multiple Statuses
                    727: #                      the number of the Status
                    728: ###########################################################
                    729: proc displayStatus { message type {num 0} } {
                    730:     global gStatus
                    731:     if { [winfo exists .status$num]} {
                    732: 	capaRaise .status$num
                    733: 	return 
                    734:     }
                    735:     
                    736:     set status [toplevel .status$num]
                    737: 
                    738:     set gStatus($num.type) $type
                    739:     set gStatus($num.message) "$message"
                    740: 
                    741:     switch $type {
                    742: 	spinner {
                    743: 	    message $status.msg -textvariable gStatus($num.message) -aspect 700
                    744: 	    set gStatus($num.spinner) "-"
                    745: 	    message $status.spinner -textvariable gStatus($num.spinner) -aspect 700
                    746: 	    pack $status.msg $status.spinner -side top
                    747: 	}
                    748: 	both -
                    749: 	bar {
                    750: 	    message $status.msg -textvariable gStatus($num.message) -aspect 700
                    751: 	    canvas $status.canvas -width 200 -height 20
                    752: 	    $status.canvas create rectangle 1 1 199 19 -outline black
                    753: 	    set gStatus($num.bar) [$status.canvas create rectangle 1 1 1 19 \
                    754: 		    -fill red -outline black]
                    755: 	    pack $status.msg $status.canvas -side top
                    756: 	}
                    757: 	message	{
                    758: 	    message $status.msg -textvariable gStatus($num.message) -aspect 700
                    759: 	    pack $status.msg
                    760: 	}
                    761:     }
                    762:     Centre_Dialog $status default
                    763:     update idletasks
                    764: }
                    765: 
                    766: ###########################################################
                    767: # updateStatusMessage 
                    768: ###########################################################
                    769: # updates the message in the status bar
                    770: ###########################################################
                    771: # Arguments: the new message for the status bar and optionally a number
                    772: #            if there might be more than one Status at a time
                    773: # Returns: Nothing
                    774: # Globals: gStatus - an array containing information for the status
                    775: #              ($num.type) - the type of status
                    776: #              ($num.message) - the message in the status window
                    777: #              ($num.bar) - the id number of the rectangle in the canvas
                    778: #              (num) - (Optional) if there are multiple Statuses
                    779: #                      the number of the Status
                    780: ###########################################################
                    781: proc updateStatusMessage { message { num 0 } } {
                    782:     global gStatus
                    783:     set gStatus($num.message) "$message"
                    784:     update idletasks
                    785: }
                    786: 
                    787: ###########################################################
                    788: # updateStatusBar
                    789: ###########################################################
                    790: # updates the bar in the status bar
                    791: ###########################################################
                    792: # Arguments: a floating point number between 0 and 1 that is
                    793: #            the percentage done and optionally a number
                    794: #            if there might be more than one Status at a time
                    795: # Returns: Nothing
                    796: # Globals: gStatus - an array containing information for the status
                    797: #              ($num.type) - the type of status
                    798: #              ($num.message) - the message in the status window
                    799: #              ($num.bar) - the id number of the rectangle in the canvas
                    800: #              (num) - (Optional) if there are multiple Statuses
                    801: #                      the number of the Status
                    802: ###########################################################
                    803: proc updateStatusBar { percent { num 0 } } {
                    804:     global gStatus
                    805:     .status$num.canvas coords $gStatus($num.bar) 1 1 [expr $percent * 200 ] 19
                    806:     update idletasks
                    807: }
                    808: 
                    809: ###########################################################
                    810: # updateStatusSpinner
                    811: ###########################################################
                    812: # updates the spinner in the status bar
                    813: ###########################################################
                    814: # Arguments: optionally a number if there might be more 
                    815: #            than one Status at a time
                    816: # Returns: Nothing
                    817: # Globals: gStatus - an array containing information for the status
                    818: #              ($num.type) - the type of status
                    819: #              ($num.message) - the message in the status window
                    820: #              ($num.bar) - the id number of the rectangle in the canvas
                    821: #              (num) - (Optional) if there are multiple Statuses
                    822: #                      the number of the Status
                    823: ###########################################################
                    824: proc updateStatusSpinner { { num 0 } } {
                    825:     global gStatus
                    826:     switch -- $gStatus($num.spinner) {
                    827: 	"-" { set gStatus($num.spinner) "\\" }
                    828: 	"\\" { set gStatus($num.spinner) "|" }
                    829: 	"|" { set gStatus($num.spinner) "/" }
                    830: 	"/" { set gStatus($num.spinner) "-" }
                    831:     }
                    832:     update idletasks
                    833: }
                    834: 
                    835: ###########################################################
                    836: # removeStatus
                    837: ###########################################################
                    838: # takes the status message off of the screen, must be eventually
                    839: # called after a call to displayStatus
                    840: ###########################################################
                    841: # Arguments: and optionally a number if there might be more 
                    842: #            than one Status at a time
                    843: # Returns: Nothing
                    844: # Globals: gStatus - an array containing information for the status
                    845: #              ($num.type) - the type of status
                    846: #              ($num.message) - the message in the status window
                    847: #              ($num.bar) - the id number of the rectangle in the canvas
                    848: ###########################################################
                    849: proc removeStatus { {num 0 } } {
                    850:     global gStatus
                    851:     foreach name [array names gStatus "$num.*"] { unset gStatus($name) }
                    852:     destroy .status$num
                    853:     update idletasks
                    854: }
                    855: 
                    856: ###########################################################
                    857: # tkFDialogResolveFile 
                    858: ###########################################################
                    859: # I don't like how this version of the Tcl dialog box code
                    860: # evaluates links, my code here makes it so that clicking 
                    861: # on Open does the same thing as double clicking does, it 
                    862: # returns the path in the top of the dialog box along with
                    863: # the new filename
                    864: ###########################################################
                    865: # I do this catch command to get Tcl to source the 
                    866: # tkfbox.tcl file, then I change the tkFDialogResolveFile
                    867: # command
                    868: ###########################################################
                    869: catch {tkFDialogResolveFile}
                    870: proc tkFDialogResolveFile {context text defaultext} {
                    871:     set appPWD [pwd]
                    872: 
                    873:     set path [tkFDialog_JoinFile $context $text]
                    874: 
                    875:     if {[file ext $path] == ""} {
                    876: 	set path "$path$defaultext"
                    877:     }
                    878: 
                    879:     if [catch {file exists $path}] {
                    880: 	return [list ERROR $path ""]
                    881:     }
                    882: 
                    883:     if [catch {if [file exists $path] {}}] {
                    884: 	# This "if" block can be safely removed if the following code returns
                    885: 	# an error. It currently (7/22/97) doesn't
                    886: 	#
                    887: 	#	file exists ~nonsuchuser
                    888: 	#
                    889: 	return [list ERROR $path ""]
                    890:     }
                    891: 
                    892:     if [file exists $path] {
                    893: 	if [file isdirectory $path] {
                    894: 	    if [catch {
                    895: 		cd $path
                    896: 	    }] {
                    897: 		return [list CHDIR $path ""]
                    898: 	    }
                    899: 	    set directory [pwd]
                    900: 	    set file ""
                    901: 	    set flag OK
                    902: 	    cd $appPWD
                    903: 	} else {
                    904: 	    if [catch {
                    905: 		cd [file dirname $path]
                    906: 	    }] {
                    907: 		return [list CHDIR [file dirname $path] ""]
                    908: 	    }
                    909: 	    set directory [pwd]
                    910: 	    set directory [file dirname $path]
                    911: 	    set file [file tail $path]
                    912: 	    set flag OK
                    913: 	    cd $appPWD
                    914: 	}
                    915:     } else {
                    916: 	set dirname [file dirname $path]
                    917: 	if [file exists $dirname] {
                    918: 	    if [catch {
                    919: 		cd $dirname
                    920: 	    }] {
                    921: 		return [list CHDIR $dirname ""]
                    922: 	    }
                    923: 	    set directory [pwd]
                    924: 	    set file [file tail $path]
                    925: 	    if [regexp {[*]|[?]} $file] {
                    926: 		set flag PATTERN
                    927: 	    } else {
                    928: 		set flag FILE
                    929: 	    }
                    930: 	    cd $appPWD
                    931: 	} else {
                    932: 	    set directory $dirname
                    933: 	    set file [file tail $path]
                    934: 	    set flag PATH
                    935: 	}
                    936:     }
                    937: 
                    938:     return [list $flag $directory $file]
                    939: }
                    940: 
                    941: ###########################################################
                    942: # tkIconList_Create
                    943: ###########################################################
                    944: # Ed wants a bigger default dialog box
                    945: ###########################################################
                    946: # I do this catch command to get Tcl to source the 
                    947: # tkfbox.tcl file, then I change the tkIconList_Create
                    948: # command
                    949: ###########################################################
                    950: catch {tkIconList_Create}
                    951: proc tkIconList_Create {w} {
                    952:     upvar #0 $w data
                    953: 
                    954:     frame $w
                    955:     set data(sbar)   [scrollbar $w.sbar -orient horizontal \
                    956:         -highlightthickness 0 -takefocus 0]
                    957:     set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
                    958:         -width 600 -height 180 -takefocus 1]
                    959:     pack $data(sbar) -side bottom -fill x -padx 2
                    960:     pack $data(canvas) -expand yes -fill both
                    961: 
                    962:     $data(sbar) config -command "$data(canvas) xview"
                    963:     $data(canvas) config -xscrollcommand "$data(sbar) set"
                    964: 
                    965:     # Initializes the max icon/text width and height and other variables
                    966:     #
                    967:     set data(maxIW) 1
                    968:     set data(maxIH) 1
                    969:     set data(maxTW) 1
                    970:     set data(maxTH) 1
                    971:     set data(numItems) 0
                    972:     set data(curItem)  {}
                    973:     set data(noScroll) 1
                    974: 
                    975:     # Creates the event bindings.
                    976:     #
                    977:     bind $data(canvas) <Configure> "tkIconList_Arrange $w"
                    978: 
                    979:     bind $data(canvas) <1>         "tkIconList_Btn1 $w %x %y"
                    980:     bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
                    981:     bind $data(canvas) <Double-1>  "tkIconList_Double1 $w %x %y"
                    982:     bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
                    983:     bind $data(canvas) <B1-Leave>  "tkIconList_Leave1 $w %x %y"
                    984:     bind $data(canvas) <B1-Enter>  "tkCancelRepeat"
                    985: 
                    986:     bind $data(canvas) <Up>        "tkIconList_UpDown $w -1"
                    987:     bind $data(canvas) <Down>      "tkIconList_UpDown $w  1"
                    988:     bind $data(canvas) <Left>      "tkIconList_LeftRight $w -1"
                    989:     bind $data(canvas) <Right>     "tkIconList_LeftRight $w  1"
                    990:     bind $data(canvas) <Return>    "tkIconList_ReturnKey $w"
                    991:     bind $data(canvas) <KeyPress>  "tkIconList_KeyPress $w %A"
                    992:     bind $data(canvas) <Control-KeyPress> ";"
                    993:     bind $data(canvas) <Alt-KeyPress>  ";"
                    994: 
                    995:     bind $data(canvas) <FocusIn>   "tkIconList_FocusIn $w"
                    996: 
                    997:     return $w
                    998: }
                    999: 
                   1000: ###########################################################
                   1001: # findByStudentNumber
                   1002: ###########################################################
                   1003: ###########################################################
                   1004: ###########################################################
                   1005: proc findByStudentNumber { pattern path } {
                   1006:     set file [file join $path "classl"]
                   1007:     if {[catch {set fileId [open $file "r"]}]} { return "" }
                   1008:     set matched_entries ""
                   1009:     set aline [gets $fileId]
                   1010:     while { ! [eof $fileId] } {
                   1011: 	set aline [string trimright $aline]
                   1012: 	set tmp_sn [string range $aline 14 22]
                   1013: 	if { [regexp -nocase $pattern $tmp_sn] } {
                   1014: 	    lappend matched_entries [ list $tmp_sn [string range $aline 24 53] ]
                   1015: 	}
                   1016: 	set aline [gets $fileId]
                   1017:     }
                   1018:     close $fileId
                   1019:     return $matched_entries
                   1020: }
                   1021: 
                   1022: ###########################################################
                   1023: # findByStudentName
                   1024: ###########################################################
                   1025: ###########################################################
                   1026: ###########################################################
                   1027: proc findByStudentName { pattern path } {
                   1028:     set file [file join $path "classl"]
                   1029:     if {[catch {set fileId [open $file "r"]}]} { return "" }
                   1030:     set matched_entries ""
                   1031:     set aline [gets $fileId]
                   1032:     while { ! [eof $fileId] } {
                   1033: 	set aline [string trimright $aline]
                   1034: 	set tmp_name [string range $aline 24 53]
                   1035: 	if { [regexp -nocase $pattern $tmp_name] } {
                   1036: 	    lappend matched_entries [list [string range $aline 14 22] $tmp_name]
                   1037: 	}
                   1038: 	set aline [gets $fileId]
                   1039:     }
                   1040:     close $fileId
                   1041:     return $matched_entries
                   1042: }
                   1043: 
                   1044: ###########################################################
                   1045: # fillInStudent
                   1046: ###########################################################
                   1047: ###########################################################
                   1048: ###########################################################
                   1049: proc fillInStudent { fullnameVar numberVar doname } {
                   1050:     upvar $fullnameVar fullname $numberVar number
                   1051: 
                   1052:     if { !$doname } {
                   1053: 	set matched_entries [findByStudentNumber [string trim $number] .]
                   1054:     } else {
                   1055: 	set matched_entries [findByStudentName [string trim $fullname] .]
                   1056:     }
                   1057:     if { [llength $matched_entries] == 0 } {
                   1058: 	displayMessage "No student found. Please re-enter student info."
                   1059: 	set id ""; set name ""
                   1060:     } elseif { [llength $matched_entries] == 1 } {
                   1061: 	set id [lindex [lindex $matched_entries 0] 0]
                   1062: 	set name [lindex [lindex $matched_entries 0] 1]
                   1063:     } else {
                   1064: 	set select [ multipleChoice .main "Matched Student Records, Select one" \
                   1065: 			 $matched_entries ]
                   1066: 	if { $select == "" } { 
                   1067: 	    set id ""; set name "" 
                   1068: 	} else {
                   1069: 	    set id [lindex $select 0]
                   1070: 	    set name [lindex $select 1]
                   1071: 	}
                   1072:     }
                   1073:     set fullname $name
                   1074:     set number $id
                   1075: }
                   1076: 
                   1077: ###########################################################
                   1078: # getOneStudent
                   1079: ###########################################################
                   1080: # Lets you pick a student by name or student number
                   1081: # then verifies that they are in the classlist
                   1082: ###########################################################
                   1083: ###########################################################
                   1084: proc getOneStudent { window path idVar nameVar {message "" } {message2 ""}} {
                   1085:     upvar $idVar id
                   1086:     upvar $nameVar name
                   1087:     
                   1088:     set select [tk_dialog $window.dialog "Student select method" \
                   1089: 		    "$message Select student by:" "" "" "Student Number" \
                   1090: 		    "Student Name" "Cancel"]
                   1091:     if { $select == 2 } { 
                   1092: 	set id ""
                   1093: 	set name ""
                   1094: 	return 
                   1095:     }
                   1096:     set done 0
                   1097:     while { ! $done } {
                   1098: 	if { $select } { set search "name" } { set search "number" }
                   1099: 	set pattern [ getString $window "$message Please enter a student $search." ]
                   1100: 	if {$pattern == "" } {
                   1101: 	    set done 1
                   1102: 	    set id ""
                   1103: 	    set name ""
                   1104: 	    continue
                   1105: 	}
                   1106: 	if { $select } {
                   1107: 	    set matched_entries [findByStudentName $pattern $path]
                   1108: 	} else {
                   1109: 	    set matched_entries [findByStudentNumber $pattern $path]
                   1110: 	}
                   1111: 	if { [llength $matched_entries] == 0 } {
                   1112: 	    displayMessage "No student found. Please re-enter student $search."
                   1113: 	} elseif { [llength $matched_entries] == 1 } {
                   1114: 	    set id [lindex [lindex $matched_entries 0] 0]
                   1115: 	    set name [lindex [lindex $matched_entries 0] 1]
                   1116: 	    set done 1
                   1117: 	} elseif { [llength $matched_entries] < 30 } {
                   1118: 	    set select [ multipleChoice $window "Matched Student Records, Select one. $message2" \
                   1119: 			     $matched_entries ]
                   1120: 	    if { $select == "" } { 
                   1121: 		set id ""; set name ""
                   1122: 		return 
                   1123: 	    }
                   1124: 	    set id [lindex $select 0]
                   1125: 	    set name [lindex $select 1]
                   1126: 	    set done 1
                   1127: 	} else {
                   1128: 	    displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
                   1129: 	}
                   1130:     }
                   1131: }
                   1132: 
                   1133: ###########################################################
                   1134: # getString
                   1135: ###########################################################
                   1136: ###########################################################
                   1137: ###########################################################
1.3       albertel 1138: proc getString { window message {type "any"}} {
1.1       albertel 1139:     global gPrompt 
                   1140:     set setWin [toplevel $window.getstring]
                   1141:     
                   1142:     set msgFrame [frame $setWin.msgFrame]
                   1143:     set valFrame [frame $setWin.valFrame]
                   1144:     set buttonFrame [frame $setWin.buttonFrame]
                   1145:     pack $msgFrame $valFrame $buttonFrame
                   1146: 
                   1147:     
                   1148:     set gPrompt(val) ""
1.3       albertel 1149:     entry $valFrame.val -textvariable gPrompt(val) -validate key \
                   1150: 	-validatecommand "limitEntry %W -1 $type %P"
1.1       albertel 1151:     pack $valFrame.val
                   1152: 
                   1153:     message $msgFrame.msg -text $message -aspect 3000
                   1154:     pack $msgFrame.msg
                   1155: 
                   1156:     button $buttonFrame.select -text "Continue" -command { set gPrompt(ok) 1 }
                   1157:     button $buttonFrame.cancel -text "Cancel" -command { set gPrompt(ok) 0 }
                   1158:     pack $buttonFrame.select $buttonFrame.cancel -side left
                   1159: 
                   1160: 
                   1161:     bind $setWin <Return> "set gPrompt(ok) 1"
                   1162:     Centre_Dialog $setWin default
                   1163:     update idletasks
                   1164:     focus $setWin
                   1165:     focus $valFrame.val
                   1166:     capaRaise $setWin
                   1167:     capaGrab $setWin
                   1168:     vwait gPrompt(ok)
                   1169:     capaGrab release $setWin
                   1170:     destroy $setWin
                   1171:     if { $gPrompt(ok) == 1 } {
                   1172: 	return $gPrompt(val)
                   1173:     } else {
                   1174: 	return ""
                   1175:     }
                   1176: }
                   1177: 
                   1178: ###########################################################
                   1179: # multipleChoice
                   1180: ###########################################################
                   1181: ###########################################################
                   1182: ###########################################################
                   1183: proc multipleChoice { window message choices {single 1}} {
                   1184:     global gPromptMC
                   1185:     
1.2       albertel 1186:     set setWin [toplevel $window.choice]
1.1       albertel 1187:     
                   1188:     set msgFrame [frame $setWin.msgFrame]
                   1189:     set valFrame [frame $setWin.valFrame]
                   1190:     set buttonFrame [frame $setWin.buttonFrame]
                   1191:     pack $msgFrame $valFrame $buttonFrame
                   1192:     pack configure $valFrame -expand 1 -fill both
                   1193: 
                   1194:     message $msgFrame.msg -text $message -aspect 3000
                   1195:     pack $msgFrame.msg
                   1196:     
                   1197:     set maxWidth 1
                   1198:     foreach choice $choices {
                   1199: 	if {[string length $choice] > $maxWidth} {set maxWidth [string length $choice]}
                   1200:     }
                   1201:     set selectMode extended
                   1202:     if { $single } { set selectMode single }
                   1203:     listbox $valFrame.val -width [expr $maxWidth + 2] \
                   1204: 	-yscrollcommand "$valFrame.scroll set" -selectmode $selectMode
                   1205:     scrollbar $valFrame.scroll -command "$valFrame.val yview"
                   1206:     pack $valFrame.val $valFrame.scroll -side left
                   1207:     pack configure $valFrame.val -expand 1 -fill both 
                   1208:     pack configure $valFrame.scroll -expand 0 -fill y
                   1209:     foreach choice $choices { $valFrame.val insert end $choice }
                   1210: 
                   1211:     button $buttonFrame.select -text "Continue" -command { set gPromptMC(ok) 1 }
                   1212:     frame $buttonFrame.spacer -width 10
                   1213:     button $buttonFrame.selectall -text "SelectAll" -command \
                   1214: 	"$valFrame.val selection set 0 end"
                   1215:     button $buttonFrame.cancel -text "Cancel" -command { set gPromptMC(ok) 0 }
                   1216:     if { $single } {
                   1217: 	pack $buttonFrame.select $buttonFrame.cancel -side left
                   1218:     } else {
                   1219: 	pack $buttonFrame.select $buttonFrame.spacer \
                   1220: 	    $buttonFrame.selectall $buttonFrame.cancel -side left
                   1221:     }
                   1222: 
                   1223:     bind $setWin <Return> "set gPromptMC(ok) 1"
                   1224:     Centre_Dialog $setWin default
                   1225:     update idletasks
                   1226:     focus $setWin
                   1227:     capaRaise $setWin
                   1228:     capaGrab $setWin
                   1229:     while { 1 } {
                   1230: 	update idletasks
                   1231: 	vwait gPromptMC(ok)
                   1232: 	if { $gPromptMC(ok) != 1 } { break }
                   1233: 	set select [$valFrame.val curselection]
                   1234: 	if { $select != "" } { break } 
                   1235:     }
                   1236:     capaGrab release $setWin
                   1237:     destroy $setWin
                   1238:     if { $gPromptMC(ok) == 1 } {
                   1239: 	foreach selection $select { lappend result [lindex $choices $selection] }
                   1240: 	if { [llength $result] == 1 } { set result [lindex $result 0] }
                   1241: 	return $result
                   1242:     } else {
                   1243: 	return ""
                   1244:     }
                   1245: }
                   1246: 
                   1247: ###########################################################
                   1248: # getSetRange
                   1249: ###########################################################
                   1250: ###########################################################
                   1251: ###########################################################
                   1252: proc getSetRange { window path } {
                   1253:     global gMaxSet gPromptGSR
                   1254:     for { set i 1 } { $i <= $gMaxSet } { incr i } {
                   1255: 	if { ! [file exists [file join $path records "set$i.db"]] } { break }
                   1256:     }
                   1257:     incr i -1
                   1258:     
                   1259:     set setWin [toplevel $window.setselect]
                   1260:     
                   1261:     set msgFrame [frame $setWin.msgFrame]
                   1262:     set valFrame [frame $setWin.calFrame]
                   1263:     set buttonFrame [frame $setWin.buttonFrame]
                   1264:     pack $msgFrame $valFrame $buttonFrame
                   1265: 
                   1266:     message $msgFrame.msg -text "Please select a set range:" -aspect 1000
                   1267:     pack $msgFrame.msg
                   1268:     
                   1269:     global gSetNumberStart gSetNumberEnd
                   1270:     scale $valFrame.start -from 1 -to $i -variable gSetNumberStart -orient h
                   1271:     scale $valFrame.end -from 1 -to $i -variable gSetNumberEnd  -orient h
                   1272:     pack $valFrame.start $valFrame.end
                   1273: 
                   1274:     button $buttonFrame.select -text "Select" -command { set gPromptGSR(ok) 1 }
                   1275:     button $buttonFrame.cancel -text "Cancel" -command { set gPromptGSR(ok) 0 }
                   1276:     pack $buttonFrame.select $buttonFrame.cancel -side left
                   1277: 
                   1278:     bind $setWin <Return> "set gPromptGSR(ok) 1"
                   1279:     Centre_Dialog $setWin default
                   1280:     update idletasks
                   1281:     focus $setWin
                   1282:     capaRaise $setWin
                   1283:     capaGrab $setWin
                   1284:     vwait gPromptGSR(ok)
                   1285:     capaGrab release $setWin
                   1286:     destroy $setWin
                   1287:     if { $gPromptGSR(ok) == 1 } {
                   1288: 	set setIdStart $gSetNumberStart
                   1289: 	set setIdEnd $gSetNumberEnd
                   1290: 	if { $setIdStart > $setIdEnd } { set setIdEnd $setIdStart }
                   1291: 	unset gSetNumberStart
                   1292: 	unset gSetNumberEnd
                   1293: 	return [list $setIdStart $setIdEnd]
                   1294:     } else {
                   1295: 	unset gSetNumberStart
                   1296: 	unset gSetNumberEnd
                   1297: 	return ""
                   1298:     }
                   1299: }
                   1300: 
                   1301: ###########################################################
                   1302: # getOneSet
                   1303: ###########################################################
                   1304: ###########################################################
                   1305: ###########################################################
                   1306: proc getOneSet { window path } {
                   1307:     global gMaxSet  gPromptGOS 
                   1308:     for { set i 1 } { $i <= $gMaxSet } { incr i } {
                   1309: 	if { ! [file exists [file join $path records "set$i.db"]] } { break }
                   1310:     }
                   1311:     incr i -1
                   1312:     
                   1313:     set setWin [toplevel $window.setselect]
                   1314:     
                   1315:     set msgFrame [frame $setWin.msgFrame]
                   1316:     set valFrame [frame $setWin.calFrame]
                   1317:     set buttonFrame [frame $setWin.buttonFrame]
                   1318:     pack $msgFrame $valFrame $buttonFrame
                   1319: 
                   1320:     message $msgFrame.msg -text "Please select a set:" -aspect 1000
                   1321:     pack $msgFrame.msg
                   1322:     
                   1323:     global gSetNumber
                   1324:     scale $valFrame.val -from 1 -to $i -variable gSetNumber -orient h
                   1325:     pack $valFrame.val
                   1326: 
                   1327:     button $buttonFrame.select -text "Select" -command { set gPromptGOS(ok) 1 }
                   1328:     button $buttonFrame.cancel -text "Cancel" -command { set gPromptGOS(ok) 0 }
                   1329:     pack $buttonFrame.select $buttonFrame.cancel -side left
                   1330: 
                   1331:     bind $setWin <Return> "set gPromptGOS(ok) 1"
                   1332:     Centre_Dialog $setWin default
                   1333:     update idletasks
                   1334:     focus $setWin
                   1335:     capaRaise $setWin
                   1336:     capaGrab $setWin
                   1337:     vwait gPromptGOS(ok)
                   1338:     capaGrab release $setWin
                   1339:     destroy $setWin
                   1340:     if { $gPromptGOS(ok) == 1 } {
                   1341: 	set setId $gSetNumber
                   1342: 	unset gSetNumber
                   1343: 	return $setId
                   1344:     } else {
                   1345: 	unset gSetNumber
                   1346: 	return ""
                   1347:     }
                   1348: }
                   1349: 
                   1350: ###########################################################
                   1351: # pickSections
                   1352: ###########################################################
                   1353: ###########################################################
                   1354: ###########################################################
                   1355: proc pickSections { sectionsToPickFrom {title "Select Sections"} {window ""}} {
                   1356:     global gPromptPS
                   1357:     
                   1358:     set dialog [toplevel $window.pickSections -borderwidth 10]
                   1359:     wm title $dialog "Which Sections"
                   1360: 
                   1361:     set infoFrame [frame $dialog.info ]
                   1362:     set sectionListFrame [frame $dialog.list  -relief groove -borderwidth 5]
                   1363:     set buttonFrame [frame $dialog.buttons -bd 10]
                   1364:     pack $infoFrame $sectionListFrame $buttonFrame -side top -fill x
                   1365:     
                   1366:     message $infoFrame.msg -text $title -aspect 5000
                   1367:     pack $infoFrame.msg
                   1368: 
                   1369:     set headerFrame [frame $sectionListFrame.head ]
                   1370:     set listboxFrame [frame $sectionListFrame.listboxframe]
                   1371:     pack $headerFrame $listboxFrame -side top 
                   1372:     pack configure $headerFrame -anchor w
                   1373: 
                   1374:     message $headerFrame.msg -text "Section number    # of students" \
                   1375: 	    -aspect 5000
                   1376:     pack $headerFrame.msg
                   1377: 
                   1378:     set sectionList [ listbox $listboxFrame.list \
                   1379:                -yscrollcommand "$listboxFrame.scroll set" \
                   1380:                -width 30 -height 10 -selectmode extended ]
                   1381:     scrollbar $listboxFrame.scroll \
                   1382:                 -command "$listboxFrame.list yview" \
                   1383:                 -orient v
                   1384:     pack $sectionList $listboxFrame.scroll -side left
                   1385:     pack configure $listboxFrame.scroll -fill y      
                   1386: 
                   1387:     foreach section $sectionsToPickFrom {
                   1388: 	$sectionList insert end \
                   1389: 		[format "%3d                  %4d" [lindex $section 0]\
                   1390: 		[lindex $section 1] ]
                   1391:     }
                   1392: 
                   1393:     button $buttonFrame.yes -text Continue -command {set gPromptPS(yes) 1} \
                   1394: 	    -underline 0
                   1395:     frame $buttonFrame.spacer -width 10
                   1396:     button $buttonFrame.selectall -text "SelectAll" -command \
                   1397: 	"$sectionList selection set 0 end"
                   1398:     button $buttonFrame.cancel -text Cancel -command { set gPromptPS(yes) 0 } \
                   1399: 	    -underline 0
                   1400:     bind $dialog <Destroy> "set gPromptPS(yes) 0"
                   1401: 
                   1402:     pack $buttonFrame.yes $buttonFrame.spacer \
                   1403: 	$buttonFrame.selectall $buttonFrame.cancel -side left
                   1404:     
                   1405:     bind $dialog <Alt-Key> break
                   1406:     
                   1407:     Centre_Dialog $dialog default
                   1408:     update
                   1409:     
                   1410:     focus $dialog
                   1411:     capaRaise $dialog
                   1412:     capaGrab $dialog
                   1413:     vwait gPromptPS(yes)
                   1414:     capaGrab release $dialog
                   1415:     bind $dialog <Destroy> ""
                   1416:     if {$gPromptPS(yes)} {
                   1417: 	set selectionList [ $sectionList curselection ]
                   1418: 	set sectionsToPrint ""
                   1419: 	foreach selection $selectionList {
                   1420: 	    append sectionsToPrint "[lindex [$sectionList get $selection] 0] "
                   1421: 	}
                   1422: 	destroy $dialog
                   1423: 	return $sectionsToPrint
                   1424:     } else {
                   1425: 	destroy $dialog
                   1426: 	return Cancel
                   1427:     }
                   1428: }
                   1429: 
                   1430: ###########################################################
                   1431: # getSet
                   1432: ###########################################################
                   1433: ###########################################################
                   1434: ###########################################################
                   1435: proc getSet { pid set followupCommand {start 1}} {
                   1436:     global gCapaConfig gGetSet gUniqueNumber
                   1437:     set num [incr gUniqueNumber]
                   1438:     if { $start } { 
                   1439: 	set gGetSet($num.toprocess) $pid
                   1440: 	set gGetSet($num.command) $followupCommand
                   1441: 	foreach name [array names gGetSet {*.[alhu]*}] { unset gGetSet($name) }
                   1442: 	if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }
                   1443:     }
                   1444:     if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}
1.4     ! albertel 1445:     set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set"
1.1       albertel 1446:     foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }
                   1447:     set fileId [open "|$command" "r"]
                   1448:     fileevent $fileId readable "getSetLine $num $fileId"
                   1449:     update idletasks
                   1450: }
                   1451: 
                   1452: ###########################################################
                   1453: # getSetQuestion
                   1454: ###########################################################
                   1455: ###########################################################
                   1456: ###########################################################
                   1457: proc getSetQuestion { num fileId } {
                   1458:     global gGetSet 
                   1459:     if { $gGetSet(exit) } { 
                   1460: 	fileevent $fileId readable ""
                   1461: 	catch {close $fileId}
                   1462: 	return
                   1463:     }
                   1464:     set questNum $gGetSet($num.questNum)
                   1465:     set aline [gets $fileId]
                   1466:     if { $aline != "" } {
                   1467: 	switch [lindex [split $aline :] 0] {
                   1468: 	    EQES { fileevent $fileId readable "getSetLine $num $fileId" }
                   1469: 	    default { lappend gGetSet($num.$questNum.quest) $aline }
                   1470: 	}
                   1471:     }
                   1472:     if { [eof $fileId] } { getSetEnd $fileId }
                   1473: }
                   1474: 
                   1475: ###########################################################
                   1476: # getSetLine
                   1477: ###########################################################
                   1478: ###########################################################
                   1479: ###########################################################
                   1480: proc getSetLine { num fileId } {
                   1481:     global gGetSet 
                   1482:     
                   1483:     if { $gGetSet(exit) } { 
                   1484: 	fileevent $fileId readable ""
                   1485: 	catch {close $fileId}
                   1486: 	return
                   1487:     }
                   1488:     set aline [gets $fileId]
                   1489:     if { $aline != "" } {
                   1490: 	switch [lindex [split $aline :] 0] {
                   1491: 	    ANS { 
                   1492: 		set questNum $gGetSet($num.questNum)
                   1493: 		set ans [string range $aline 4 end]
                   1494: 		set length [llength $ans]
                   1495: 		lappend gGetSet($num.$questNum.ans) [lindex $ans 0]
                   1496: 		if { ($length == 2) || ($length == 4)} {
                   1497: 		    lappend gGetSet($num.$questNum.unit) [lindex $ans end]
                   1498: 		} 
                   1499: 		if { ($length == 3) || ($length == 4) } {
                   1500: 		    lappend gGetSet($num.$questNum.low) [lindex $ans 1]
                   1501: 		    lappend gGetSet($num.$questNum.high) [lindex $ans 2]
                   1502: 		}
                   1503: 	    }
                   1504: 	    DONE { set gGetSet($num.maxprob) $gGetSet($num.questNum) }
                   1505: 	    ERROR {
                   1506:  		fileevent $fileId readable ""
                   1507: 		displayError "Answers returned invalid message: $aline" 
                   1508: 		fileevent $fileId readable "getSetLine $num $fileId"
                   1509: 	    }
                   1510: 	    BQES {
                   1511:  		incr gGetSet($num.questNum)
                   1512: 		fileevent $fileId readable "getSetQuestion $num $fileId" 
                   1513: 	    }
                   1514: 	    SET { set gGetSet($num.questNum) 0 }
                   1515: 	    default {}
                   1516: 	}
                   1517:     }
                   1518:     if { [eof $fileId] } { getSetEnd $num $fileId }
                   1519: }
                   1520: 
                   1521: ###########################################################
                   1522: # getSetEnd
                   1523: ###########################################################
                   1524: ###########################################################
                   1525: ###########################################################
                   1526: proc getSetEnd { num fileId } {
                   1527:     global gGetSet c
                   1528:     if { [eof $fileId] } {
                   1529: 	catch {close $fileId} 
                   1530: 	set command $gGetSet($num.command)
                   1531: 	foreach var [array names gGetSet "$num.*"] { 
                   1532: 	    set var2 [join [lrange [split $var .] 1 end] .]
                   1533: 	    set array($var2) $gGetSet($var) 
                   1534: 	    unset gGetSet($var)
                   1535: 	}
                   1536: 	eval "$command array"
                   1537:     }
                   1538: }
                   1539: 
                   1540: ###########################################################
                   1541: # lunique --
                   1542: #   order independent list unique proc.  most efficient, but requires
                   1543: #   __LIST never be an element of the input list
                   1544: # Arguments:
                   1545: #   __LIST      list of items to make unique
                   1546: # Returns:
                   1547: #   list of only unique items, order not defined
                   1548: ###########################################################
                   1549: proc lunique __LIST {
                   1550:     if {[llength $__LIST]} {
                   1551:         foreach $__LIST $__LIST break
                   1552:         unset __LIST
                   1553:         return [info locals]
                   1554:     }
                   1555: }
                   1556: 
                   1557: proc splitline { line maxLength } {
                   1558:     set length [string length $line]
                   1559:     set lines [expr $length/$maxLength + 1]
                   1560:     set i 0
                   1561:     while { 1 } {
                   1562: 	if { [string length $line] > $maxLength } {
                   1563: 	    set end [string wordstart $line $maxLength]
                   1564: 	    while {1} {
                   1565: 		if {[string index $line $end] == " "} {break} {incr end -1}
                   1566: 	    }
                   1567: 	    append lin [string range $line 0 [expr int($end-1)]]\n
                   1568: 	    set line [string range $line $end end]
                   1569: 	} else {
                   1570: 	    append lin $line
                   1571: 	    break
                   1572: 	}
                   1573: 	incr i
                   1574:     }
                   1575:     return $lin
                   1576: }
                   1577: 
                   1578: ###########################################################
                   1579: # winputs
                   1580: ###########################################################
                   1581: ###########################################################
                   1582: ###########################################################
                   1583: proc winputs { num message {tag normal} } {
                   1584:     global gOut
                   1585: 
                   1586:     lappend gOut(output.$num) [list $message $tag]
                   1587: }
                   1588: 
                   1589: ###########################################################
                   1590: # winoutputWrap
                   1591: ###########################################################
                   1592: ###########################################################
                   1593: ###########################################################
                   1594: proc winoutputWrap { num } {
                   1595:     global gOut 
                   1596:     if { $gOut($num.wrap) } {
                   1597: 	$gOut($num.output) configure -wrap char
                   1598:     } else {
                   1599: 	$gOut($num.output) configure -wrap none
                   1600:     }
                   1601: }
                   1602: 
                   1603: ###########################################################
                   1604: # winoutput
                   1605: ###########################################################
                   1606: ###########################################################
                   1607: ###########################################################
                   1608: proc winoutput { num cmdnum window } {
                   1609:     global gOut 
                   1610:     
                   1611:     if { ![winfo exists $window.output$num] } {
                   1612: 	set outputWin [toplevel $window.output$num]
                   1613: 	
                   1614: 	set buttonFrame [frame $outputWin.button]
                   1615: 	set textFrame [frame $outputWin.text]
                   1616: 	set bottomFrame [frame $outputWin.bottom]
                   1617: 	pack $buttonFrame $textFrame $bottomFrame
                   1618: 	pack configure $buttonFrame -anchor e -expand 0 -fill x
                   1619: 	pack configure $textFrame -expand 1 -fill both
                   1620: 	pack configure $bottomFrame -expand 0 -fill x
                   1621: 
                   1622: 	set gOut($num.output) [text $textFrame.text \
                   1623: 				  -yscrollcommand "$textFrame.scroll set" \
                   1624: 				  -xscrollcommand "$bottomFrame.scroll set"]
                   1625: 	scrollbar $textFrame.scroll -command "$textFrame.text yview"
                   1626: 	pack $gOut($num.output) $textFrame.scroll -side left
                   1627: 	pack configure $textFrame.text -expand 1 -fill both
                   1628: 	pack configure $textFrame.scroll -expand 0 -fill y
                   1629: 
                   1630: 	scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h
                   1631: 	pack $bottomFrame.scroll -expand 0 -fill x
                   1632: 
                   1633: 	set gOut($num.wrap) 1
                   1634: 	checkbutton $buttonFrame.wrap -text "Wrap" -command "winoutputWrap $num" \
                   1635: 	    -variable gOut($num.wrap) 
                   1636: #	button $buttonFrame.save -text "Save Text" -command "CTsaveText $num"
                   1637: 	button $buttonFrame.print -text "Print Text" -command "winprintText $num"
                   1638: 	button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin"
                   1639: #	pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \
                   1640: 	    $buttonFrame.dismiss -side left
                   1641: 	pack $buttonFrame.wrap $buttonFrame.print $buttonFrame.dismiss -side left
                   1642:     }
                   1643:     set index [$gOut($num.output) index end]
                   1644:     foreach line $gOut(output.$cmdnum) {
                   1645: 	eval $gOut($num.output) insert end $line
                   1646:     }
                   1647:     unset gOut(output.$cmdnum)
                   1648:     capaRaise $window.output$num
                   1649:     $gOut($num.output) see $index
                   1650:     update idletasks
                   1651: }
                   1652: 
                   1653: ###########################################################
                   1654: # winprintText
                   1655: ###########################################################
                   1656: # prints the contents of the text window, creates a temp file named
                   1657: # quiztemp.txt
                   1658: ###########################################################
                   1659: # Arguments: num (the unique number of the path, and window)
                   1660: # Returns  : nothing
                   1661: # Globals  : gFile gCT
                   1662: ###########################################################
                   1663: proc winprintText { num } {
                   1664:     global gOut
                   1665: 
                   1666:     set window $gOut($num.output) 
                   1667:     if { ![winfo exists $window]} { return }
                   1668:     catch {parseCapaConfig $num}
                   1669:     set lprCommand [getLprCommand commontemp.txt $num]
                   1670:     if {$lprCommand == "Cancel"} { return }
                   1671:   
                   1672:     set fileId [open commontemp.txt w]
                   1673:     puts -nonewline $fileId [$window get 0.0 end-1c]
                   1674:     close $fileId
                   1675: 
                   1676:     set errorMsg ""
                   1677:     if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
                   1678:         displayError "An error occurred while printing: $errorMsg"
                   1679:     } else {
                   1680: 	displayMessage "Print job sent to the printer.\n $output"
                   1681:     }
                   1682:     exec rm -f commontemp.txt
                   1683: }
                   1684: 
                   1685: ###########################################################
                   1686: # limitEntry
                   1687: ###########################################################
                   1688: ###########################################################
                   1689: ###########################################################
                   1690: proc limitEntry { window max type {newvalue ""}} {
                   1691:     after idle "$window config -validate key"
1.3       albertel 1692:     if {($max != -1) && ([string length $newvalue] > $max)} { return 0 }
1.1       albertel 1693:     switch $type {
                   1694: 	any {}
                   1695: 	number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } }
1.3       albertel 1696: 	letter { if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }}
                   1697: 	nospace {if {(![regexp "^\[^ \]+$" $newvalue])&& ($newvalue!="")} { return 0 }}
1.1       albertel 1698:     }
                   1699:     return 1
                   1700: }
                   1701: 

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