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