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

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

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