Annotation of capa/capa51/GUITools/quizzer.tcl, revision 1.1
1.1 ! albertel 1: ###########################################################
! 2: # quizzer.tcl -
! 3: # Copyright Guy Albertelli II 1996
! 4: ###########################################################
! 5: set gTclVer 4.0
! 6:
! 7: ###########################################################
! 8: # createControlWindow
! 9: ###########################################################
! 10: # Creates the menu window
! 11: ###########################################################
! 12: # Arguments: none
! 13: # Returns: nothing
! 14: ###########################################################
! 15: proc createControlWindow {} {
! 16: global gPrefs gDate gFind gChanged gWindowMenu gStudentSelection gFile \
! 17: gUniqueNumber gXdviOpt gHeaderQCount gDir gHintVal gTryVal gProbVal \
! 18: gPutLine gQuizTemp gCapaConfig gStopPrinting gFindList gFirstTime \
! 19: gRefChanged gChangedLast gCreateImportLinks gFasterParsing
! 20:
! 21: after 500 { dateUpdate }
! 22: after 1000 { cleanWindowList }
! 23:
! 24: set gFasterParsing 1
! 25: set gFirstTime 1
! 26: set gPrefs(info) "Problem"
! 27: set gPrefs(TeXHeader) ""
! 28: set gPrefs(TeXFooter) ""
! 29: set gFind(find) ""
! 30: set gFind(replace) ""
! 31: set gFind(findOption) "-nocase"
! 32: set gFind(scope) File
! 33: set gChanged 0
! 34: set gChangedLast 0
! 35: trace variable gChanged w updateChangeStatus
! 36: trace variable gRefChanged w updateChangeStatus
! 37: set gStudentSelection(type) "Random"
! 38: set gStudentSelection(random) "1"
! 39: set gStudentSelection(studentNumber) ""
! 40: set gStudentSelection(studentName) ""
! 41: set gFile ""
! 42: set gUniqueNumber 1
! 43: set gXdviOpt "-geometry 800x650"
! 44: set gHeaderQCount 0
! 45: set gPutLine 1
! 46: set gTryVal 99
! 47: set gHintVal 1
! 48: set gProbVal 1
! 49: set gStopPrinting 0
! 50: set gDir(class) [pwd]
! 51: set gDir(import) [pwd]
! 52: set gDir(include) [pwd]
! 53: set gDir(reference) [pwd]
! 54: set gQuizTemp "true"
! 55: set gFindList(files) ""
! 56: set gFindList(refNum) ""
! 57: set gCreateImportLinks 1
! 58: set gCapaConfig(IMP_color) #0000ff
! 59: set gCapaConfig(comment_color) #008400
! 60: set gCapaConfig(Printer_selected) "0"
! 61: set gCapaConfig(latex_command) "latex"
! 62: set gCapaConfig(qzparse_command) "qzparse"
! 63: set gCapaConfig(dvips_command) "dvips"
! 64: set gCapaConfig(xdvi_command) "xdvi"
! 65: set gCapaConfig(lprOneSided_command) "lpr "
! 66: set gCapaConfig(lprTwoSided_command) ""
! 67: set gCapaConfig(printer_option) ""
! 68: set gCapaConfig(standardQuizzerHeader) "//CAPA system software is copyrighted by Michigan State University.\n//By using these materials, the User agrees to:\n//1) Protect the source code files from unauthorized copying.\n//2) Limit access of the source material to teaching staff.\n//3) The User is free to mix, cut and paste, modify, adapt, delete,\n// improve, etc. the problems and graphics for his/her own use.\n//\n/IMP \"../Tools/StdMacros\"\n/IMP \"../Tools/StdUnits\"\n/IMP \"../Tools/StdConst\"\n/IMP \"HWTop\"\n"
! 69:
! 70:
! 71: wm withdraw .
! 72:
! 73: # there is code later on that depends upon .main existing and being visable
! 74: set menuFrame [menu .main -tearoff 0 -type tearoff ]
! 75:
! 76: wm title $menuFrame "Quizzer"
! 77:
! 78: $menuFrame post 0 0
! 79:
! 80: wm geometry $menuFrame "+0+20"
! 81: $menuFrame add command -label "Quizzer" -foreground grey85 -background \
! 82: black -state disabled
! 83: $menuFrame add command -label "Info" -command { createInfoWindow }
! 84: $menuFrame add cascade -label "File" -menu $menuFrame.file
! 85: #$menuFrame add cascade -label "Edit .qz" -menu $menuFrame.edit
! 86: #$menuFrame add cascade -label "Find" -menu $menuFrame.find
! 87: $menuFrame add command -label "Prefs" -command { createPrefsWindow }
! 88: $menuFrame add cascade -label "Windows" -menu $menuFrame.windows
! 89: $menuFrame add command -label "Create .dvi" -command {
! 90: studentSelectWindow createDvi } -accelerator "Alt+D"
! 91: bind all <Alt-Shift-D> "studentSelectWindow createDvi"
! 92: $menuFrame add command -label "Analyze Set" -command {
! 93: analyzeSet } -accelerator "Alt+A"
! 94: bind all <Alt-Shift-A> "analyzeSet"
! 95: $menuFrame add command -label "Print" -command { printWindow }
! 96: $menuFrame add command -label "Remap" -command { createRemapWindow }
! 97: $menuFrame add command -label "Xdvi Options" -command { createXdviOpt }
! 98: #$menuFrame add command -label "Change font" -command { changeFont }
! 99: $menuFrame add command -label "Quit" -command { quit } \
! 100: -accelerator "Alt+q"
! 101: bind all <Alt-q> quit
! 102: bind $menuFrame <Destroy> "quit 1"
! 103:
! 104: set file [menu $menuFrame.file -tearoff 1 ]
! 105: set edit [menu $menuFrame.edit -tearoff 1 ]
! 106: #set find [menu $menuFrame.find -tearoff 1 ]
! 107: set windows [menu $menuFrame.windows -tearoff 1 ]
! 108: set gWindowMenu $windows
! 109:
! 110: $file add command -label "Set.qz File" -foreground grey50 -background \
! 111: black -state disabled
! 112: $file add command -label "New" -command {
! 113: createEditingWindow
! 114: pickCapaConfig
! 115: } -accelerator "Alt+n"
! 116: bind all <Alt-n> {
! 117: createEditingWindow
! 118: pickCapaConfig
! 119: }
! 120: $file add command -label "Open" -command { openDocument } -accelerator "Alt+o"
! 121: bind all <Alt-o> openDocument
! 122: $file add command -label "Save" -command { saveDocument } -accelerator "Alt+s"
! 123: # binding moved to the creation of the editwindow
! 124: # bind $menuFrame <Alt-s> saveDocument
! 125: $file add command -label "Save As..." -command { saveDocument 1 } \
! 126: -accelerator "Alt+S"
! 127: # binding moved to the creation of the editwindow
! 128: # bind $menuFrame <Alt-Shift-s> { saveDocument 1 }
! 129: $file add command -label "Delete" -command { deleteFile 0 }
! 130: $file add command -label "Close" -command { closeDocument } -accelerator "Alt+w"
! 131: # binding moved to the creation of the editwindow
! 132: # bind .main <Alt-w> closeDocument
! 133: $file add command -label "Reference File" -foreground grey90 -background \
! 134: black -state disabled
! 135: $file add command -label "New Reference File..." \
! 136: -command { newReferenceFile } -accelerator "Alt+t"
! 137: bind all <Alt-t> openReferenceFile
! 138: $file add command -label "Open Reference File..." \
! 139: -command { openReferenceFile } -accelerator "Alt+r"
! 140: bind all <Alt-r> openReferenceFile
! 141: $file add command -label "Open capa.config" \
! 142: -command { openReferenceFile capa.config }
! 143:
! 144: $edit add command -label "Cut" -command { cut } -accelerator "Alt+x"
! 145: # binding moved to the creation of the editwindow
! 146: # bind $menuFrame <Alt-x> cut
! 147: $edit add command -label "Copy" -command { copy } -accelerator "Alt+c"
! 148: # binding moved to the creation of the editwindow
! 149: # bind $menuFrame <Alt-c> copy
! 150: $edit add command -label "Paste" -command { paste } -accelerator "Alt+v"
! 151: # binding moved to the creation of the editwindow
! 152: # bind .main <Alt-v> paste
! 153: $edit add command -label "Select All " -command { selectAll } \
! 154: -accelerator "Alt+a"
! 155: # binding moved to the creation of the editwindow
! 156: # bind $menuFrame <Alt-a> selectAll
! 157: $edit add separator
! 158: $edit add command -label "Undo" -command "undo 0" \
! 159: -accelerator "Alt+u"
! 160: # $edit add command -label "Redo" -command "redo $num"
! 161: $edit add separator
! 162: $edit add command -label "Find" -command { createFindWindow } \
! 163: -accelerator "Alt+f"
! 164: bind all <Alt-f> createFindWindow
! 165:
! 166: # $find add command -label "Find Panel.." -command { createFindWindow } \
! 167: -accelerator "Alt+f"
! 168: # bind all <Alt-f> createFindWindow
! 169: # $find add command -label "Find Next" -command { next }
! 170: # $find add command -label "Find Previous" -command { previous }
! 171: # $find add command -label "Enter Selecton" -command { enterSelection }
! 172: # $find add command -label "Jump to Selection" -command { jumpToSelection }
! 173: # $find add command -label "Line Range..." -command { createLineWindow } \
! 174: -accelerator "Alt+l"
! 175: # bind all <Alt-l> createLineWindow
! 176:
! 177: bind all <Alt-0> printInfo
! 178: bind all <Alt-KeyPress> { #unbind tkTraverseToMenu
! 179: }
! 180: bind all <Control-Tab> {tkTabToWindow [tk_focusPrev %W]}
! 181: catch {bind all <ISO_Left_Tab> {tkTabToWindow [tk_focusPrev %W]}}
! 182: catch {bind all <KP_Tab> {tkTabToWindow [tk_focusPrev %W]}}
! 183: trace variable gQuizTemp w "changeMenuStatus $menuFrame"
! 184: }
! 185:
! 186: ###########################################################
! 187: # changeMenuStatus
! 188: ###########################################################
! 189: # either enables or disable printing or creation of Dvi files
! 190: # based on the value of the gQuizTemp global
! 191: ###########################################################
! 192: # Argument: menuFrame (path name of the menu window)
! 193: # name1 (name of traced varaiable, gQuizTemp)
! 194: # name2 (empty argument from trace)
! 195: # op (tracing on writes so this should be "w")
! 196: # Returns : nothing
! 197: # Globals : gQuizTemp (r)
! 198: ###########################################################
! 199: proc changeMenuStatus { menuFrame name1 name2 op } {
! 200: global gQuizTemp
! 201: if { $gQuizTemp } {
! 202: $menuFrame entryconfigure 5 -state normal
! 203: $menuFrame entryconfigure 6 -state normal
! 204: } else {
! 205: $menuFrame entryconfigure 5 -state disabled
! 206: $menuFrame entryconfigure 6 -state disabled
! 207: }
! 208: }
! 209:
! 210: ###########################################################
! 211: # printInfo
! 212: ###########################################################
! 213: # gets called by Alt-0, used to print out variable while
! 214: # still running
! 215: ###########################################################
! 216: # Argument: none
! 217: # Returns : nothing
! 218: # Globals : auto_path
! 219: ###########################################################
! 220: proc printInfo { } {
! 221: global auto_path gUndo gRefText
! 222: set num [lindex [array names gRefText] 0]
! 223: set a "updateLocation 0"
! 224: puts [list Main2: [time $a 20000]]
! 225: set a "updateLocation $num"
! 226: puts [list Ref : [time $a 20000]]
! 227: }
! 228:
! 229: ###########################################################
! 230: # createXdviOpt
! 231: ###########################################################
! 232: ###########################################################
! 233: ###########################################################
! 234: proc createXdviOpt {} {
! 235: global gXdviOpt gWindowMenu
! 236:
! 237: if { [winfo exists .xdviOpt] } {
! 238: capaRaise .xdviOpt
! 239: return
! 240: }
! 241:
! 242: set xdviOpt [toplevel .xdviOpt]
! 243: $gWindowMenu add command -label "XdviOptions" -command "capaRaise $xdviOpt"
! 244: wm title $xdviOpt "Options for Xdvi"
! 245:
! 246: set messageFrame [frame $xdviOpt.msg]
! 247: message $xdviOpt.msg2 -text "Example: -geometry 800x700" -aspect 5000
! 248: set buttonFrame [frame $xdviOpt.buttons -bd 10]
! 249: pack $messageFrame $xdviOpt.msg2 $buttonFrame -side top -fill x
! 250:
! 251: message $messageFrame.msg -text "Options to xdvi:" -aspect 5000
! 252: entry $messageFrame.entry -textvariable gXdviOpt
! 253:
! 254: pack $messageFrame.msg $messageFrame.entry -side left -fill x
! 255:
! 256: button $buttonFrame.ok -text Dismiss -command "destroy $xdviOpt
! 257: removeWindowEntry XdviOptions" -underline 0
! 258: pack $buttonFrame.ok -side left
! 259: bind $xdviOpt <Destroy> "removeWindowEntry XdviOptions"
! 260: }
! 261:
! 262: ###########################################################
! 263: # createInfoWindow
! 264: ###########################################################
! 265: # creates the Information window
! 266: ###########################################################
! 267: # Arguments: None
! 268: # Returns: Nothing
! 269: # Globals: gDate - the variable containg the current date
! 270: # gWindowMenu - used to register the new window in the
! 271: # windows menu
! 272: # gVer - Stores the current version of Quizzer (set in
! 273: # C init code
! 274: ###########################################################
! 275: proc createInfoWindow {} {
! 276: global gDate gWindowMenu gVer gTclVer gCmd gCompileDate gUndoSize gUniqueNumber
! 277:
! 278: if { [winfo exists .about] } {
! 279: capaRaise .about
! 280: return
! 281: }
! 282:
! 283: set about [toplevel .about]
! 284: $gWindowMenu add command -label "About" -command "capaRaise $about"
! 285: wm title $about "About"
! 286:
! 287: label $about.l1 -font 12x24 -text "Quizzer $gVer" -pady 20
! 288: label $about.l4 -font 8x13 -text "Quizzer.tcl version $gTclVer" -pady 20
! 289: label $about.l6 -font 8x13 -text "$gCompileDate"
! 290: message $about.l2 -font 8x13 -text "Code by: Y. Tsai, G. Albertelli II Copyright Michigan State University Board of Trustees, 1992-1999, No Unauthorized Commercial Use" \
! 291: -pady 20 -aspect 300
! 292: label $about.l3 -font 8x13 -textvariable gDate
! 293: label $about.l5 -font 8x13 -textvariable gCmd
! 294: label $about.l7 -font 8x13 -textvariable gUndoSize
! 295: label $about.l8 -font 8x13 -textvariable gUniqueNumber
! 296:
! 297: button $about.close -text "Close" -command "destroy $about
! 298: removeWindowEntry About"
! 299:
! 300: pack $about.l1 $about.l4 $about.l6 $about.l2 $about.l3 $about.l5 $about.l7 $about.l8\
! 301: $about.close -side top
! 302: bind $about <Destroy> "removeWindowEntry About"
! 303: Centre_Dialog $about default
! 304: }
! 305:
! 306: ###########################################################
! 307: # enterSelection
! 308: ###########################################################
! 309: ###########################################################
! 310: ###########################################################
! 311: proc enterSelection {} {
! 312: global gTextWindow gFind
! 313: if { [catch {set gTextWindow}] } { return }
! 314: if { ![winfo exists $gTextWindow] } { return }
! 315:
! 316: createFindWindow
! 317: catch {set gFind(find) [$gTextWindow get sel.first sel.last]}
! 318: }
! 319:
! 320: ###########################################################
! 321: # jumpToSelection
! 322: ###########################################################
! 323: ###########################################################
! 324: ###########################################################
! 325: proc jumpToSelection {} {
! 326: global gTextWindow
! 327: catch {$gTextWindow see sel.first}
! 328: }
! 329:
! 330: proc cut {} {global gTextWindow;tk_textCut $gTextWindow}
! 331: proc copy {} {global gTextWindow;tk_textCopy $gTextWindow}
! 332: proc paste {} {global gTextWindow;tk_textPaste $gTextWindow}
! 333:
! 334: ###########################################################
! 335: # selectAll
! 336: ###########################################################
! 337: ###########################################################
! 338: ###########################################################
! 339: proc selectAll { { refNum 0 } } {
! 340: global gTextWindow gRefText
! 341:
! 342: if { $refNum } { set window $gRefText($refNum) } else {
! 343: catch {set window $gTextWindow}
! 344: }
! 345: if { ![winfo exists $window] } { return }
! 346: $window tag add sel 0.0 end
! 347: }
! 348:
! 349: ###########################################################
! 350: # creatEditingWindow
! 351: ###########################################################
! 352: ###########################################################
! 353: # Arguments: none
! 354: # Returns: a one if the Editing window existed and a zero
! 355: # if it created a new window
! 356: # Globals:
! 357: ###########################################################
! 358: proc createEditingWindow { {setupUndo 1} } {
! 359: global gEditWindow gPreviewMode gTextWindow gSetNumberText gFile \
! 360: gWindowMenu gNumberParsedText gLineNumberGoto gUndo \
! 361: gCharacterNumberGoto gLineNumberGoto gClosedDocument \
! 362: gPreviewButton gFirstTime
! 363:
! 364: if { [winfo exists .editwindow] } {
! 365: capaRaise .editwindow
! 366: return 1
! 367: }
! 368: set gFirstTime 1
! 369:
! 370: set gEditWindow [toplevel .editwindow]
! 371: $gWindowMenu add command -label "$gFile" -command "capaRaise $gEditWindow"
! 372: wm title $gEditWindow $gFile
! 373: set gClosedDocument 0
! 374: set editWindow [frame $gEditWindow.frame -borderwidth 10]
! 375:
! 376: pack $editWindow -expand 1 -fill both
! 377:
! 378: set editTop [frame $editWindow.editTop]
! 379: set editBottom [frame $editWindow.editBottom]
! 380:
! 381: pack $editTop $editBottom -side top
! 382: pack configure $editBottom -expand 1 -fill both
! 383:
! 384: set menuFrame [frame $editTop.menu -borderwidth 2 -relief raised]
! 385: set assignInfo [frame $editTop.assignInfo -borderwidth 4 -relief groove]
! 386: set mode [frame $editTop.mode -borderwidth 4 -relief groove]
! 387: set buttonAndGoto [frame $editTop.buttonAndGoto ]
! 388: pack $menuFrame $assignInfo $mode $buttonAndGoto -side left
! 389: pack configure $menuFrame -anchor n
! 390:
! 391: menubutton $menuFrame.edit -text Edit -menu $menuFrame.edit.m
! 392: pack $menuFrame.edit -side left
! 393:
! 394: set edit [ menu $menuFrame.edit.m ]
! 395: $edit add command -label "Cut" -command { cut } -accelerator "Alt+x"
! 396: $edit add command -label "Copy" -command { copy } -accelerator "Alt+c"
! 397: $edit add command -label "Paste" -command { paste } -accelerator "Alt+v"
! 398: $edit add command -label "Select All " -command { selectAll } -accelerator "Alt+a"
! 399: $edit add separator
! 400: $edit add command -label "Undo" -command "undo 0" -accelerator "Alt+u"
! 401: $edit add separator
! 402: $edit add command -label "Find" -command { createFindWindow } -accelerator "Alt+f"
! 403: bind all <Alt-f> createFindWindow
! 404:
! 405: set buttons [frame $buttonAndGoto.buttons ]
! 406: set gotoFrame [ frame $buttonAndGoto.gotoFrame ]
! 407: pack $buttons $gotoFrame -side top
! 408:
! 409: set button1 [frame $buttons.button1]
! 410: set button2 [frame $buttons.button2]
! 411: pack $button1 $button2 -side top
! 412:
! 413: set gPreviewButton [button $button1.preview -text "Preview" -command \
! 414: { studentSelectWindow createPreviewWindow }]
! 415: button $button1.dbHeader -text "DB Header" -command createDBHeader
! 416: button $button1.include -text "Include" -command includeFile
! 417: pack $button1.preview $button1.dbHeader $button1.include -side left
! 418:
! 419: button $button2.header -text "Std. Header" \
! 420: -command insertStandardHeader
! 421: button $button2.import -text "Import" -command importFile
! 422: button $button2.end -text "Endline" -command insertEndline
! 423: pack $button2.header $button2.import $button2.end -side left
! 424:
! 425: label $gotoFrame.msg -text "Current Line:"
! 426: label $gotoFrame.current -textvariable gLineNumber
! 427: entry $gotoFrame.line -width 8 -textvariable gLineNumberGoto
! 428: bind $gotoFrame.line <KeyPress-Return> "gotoLine"
! 429: button $gotoFrame.button -text "Goto" -command "gotoLine"
! 430: pack $gotoFrame.msg $gotoFrame.current $gotoFrame.line \
! 431: $gotoFrame.button -side left
! 432: # variable used by gotoLine, needs to be set if it doesn't exist
! 433: if { [ catch { set gCharacterNumberGoto } ] } {
! 434: set gCharacterNumberGoto ""
! 435: }
! 436:
! 437: label $assignInfo.time -textvariable gDate
! 438: set setNum [frame $assignInfo.setNum -borderwidth 2]
! 439: set probsParsed [frame $assignInfo.probsParsed -borderwidth 2]
! 440:
! 441: pack $assignInfo.time $setNum $probsParsed -side top
! 442: pack configure $setNum $probsParsed -anchor e
! 443:
! 444: message $setNum.msg -text "Problem Set Number" -aspect 10000
! 445: set setNumberWindow [message $setNum.num -relief sunken -width 70 \
! 446: -textvariable gSetNumberText]
! 447:
! 448: pack $setNum.num $setNum.msg -side right -anchor e
! 449:
! 450: label $probsParsed.msg -text "Number of Questions Parsed"
! 451: set numberParsedWindow [label $probsParsed.num -relief sunken \
! 452: -textvariable gNumberParsedText]
! 453:
! 454: pack $probsParsed.num $probsParsed.msg -side right -anchor e
! 455:
! 456: message $mode.msg -text "Mode" -aspect 10000
! 457: radiobutton $mode.enscript -text "Enscript" -value "Enscript" \
! 458: -variable gPreviewMode
! 459: radiobutton $mode.tex -text "TeX" -value "TeX" -variable gPreviewMode
! 460: radiobutton $mode.web -text "Web" -value "Web" -variable gPreviewMode
! 461:
! 462: pack $mode.msg $mode.enscript $mode.tex $mode.web -side top
! 463: pack configure $mode.enscript $mode.tex $mode.web -anchor w
! 464: set gPreviewMode Enscript
! 465:
! 466: scrollbar $editBottom.scroll -orient vertical -command \
! 467: "$editBottom.text yview"
! 468: set gTextWindow [text $editBottom.text -yscrollcommand \
! 469: "$editBottom.scroll set" -wrap char -height 40]
! 470:
! 471: pack $editBottom.scroll $editBottom.text -side left -expand 0
! 472: pack configure $editBottom.scroll -expand 0 -fill y
! 473: pack configure $editBottom.text -expand true -fill both
! 474:
! 475: if { $setupUndo} {
! 476: rename $gTextWindow .$gTextWindow
! 477: trackChanges $gTextWindow 0
! 478: set gUndo(0) 0
! 479: set gUndo(0.cur) 0
! 480: }
! 481:
! 482: bind $gTextWindow <Alt-s> saveDocument
! 483: bind $gTextWindow <Alt-Shift-s> { saveDocument 1 }
! 484: bind $gEditWindow <Alt-w> closeDocument
! 485: # bind $gEditWindow <Destroy> "closeDocument 1"
! 486: wm protocol $gEditWindow WM_DELETE_WINDOW "closeDocument 1"
! 487: bind $gTextWindow <Alt-x> "tk_textCut %W"
! 488: bind $gTextWindow <Alt-c> "tk_textCopy %W"
! 489: bind $gTextWindow <Alt-v> "tk_textPaste %W"
! 490: bind $gTextWindow <Alt-a> selectAll
! 491: bind $gTextWindow <Alt-u> "undo 0"
! 492: addFindList
! 493: Centre_Dialog $gEditWindow default
! 494:
! 495: createImportLinks 0 0.0 end
! 496: return 0
! 497: }
! 498:
! 499: ###########################################################
! 500: # includeFile
! 501: ###########################################################
! 502: ###########################################################
! 503: ###########################################################
! 504: proc includeFile {} {
! 505: global gTextWindow gDir
! 506:
! 507: if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
! 508: return
! 509: }
! 510:
! 511: # if { $gDir(include) == "." } { set gDir(include) [pwd] }
! 512: set file [tk_getOpenFile -filetypes \
! 513: { { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
! 514: -title "Select the proper file" \
! 515: -initialdir "$gDir(include)" ]
! 516: if { $file == "" } { return }
! 517: set gDir(include) [file dirname $file]
! 518:
! 519: if { $file == "" } { return }
! 520:
! 521: set fileId [open $file "r"]
! 522:
! 523: $gTextWindow insert insert [read $fileId [file size $file]]
! 524: }
! 525:
! 526: ###########################################################
! 527: # insertStandardHeader
! 528: ###########################################################
! 529: ###########################################################
! 530: ###########################################################
! 531: proc insertStandardHeader {} {
! 532: global gTextWindow gCapaConfig
! 533:
! 534: if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
! 535: return
! 536: }
! 537: $gTextWindow insert insert $gCapaConfig(standardQuizzerHeader)
! 538: }
! 539:
! 540: ###########################################################
! 541: # importFile
! 542: ###########################################################
! 543: ###########################################################
! 544: ###########################################################
! 545: proc importFile {} {
! 546: global gTextWindow gDir gProbVal gTryVal gHintVal gPutLine
! 547:
! 548: if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
! 549: return
! 550: }
! 551:
! 552: # if { $gDir(import) == "." } { set gDir(import) [pwd] }
! 553: set file [tk_getOpenFile -filetypes \
! 554: { { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
! 555: -title "Select the proper file" -initialdir "$gDir(import)" ]
! 556: if { $file == "" } { return }
! 557: set gDir(import) [file dirname $file]
! 558:
! 559:
! 560: if { [getProbValTryVal] == "Cancel" } { return }
! 561:
! 562: $gTextWindow insert insert "//\n/BEG prob_val=$gProbVal\n/LET try_val=$gTryVal\n/LET hint_val=$gHintVal\n/DIS(\"$file\")\n/IMP \"$file\"\n"
! 563: if { $gPutLine } {
! 564: $gTextWindow insert insert "/DIS(stdline)\n"
! 565: } else {
! 566: $gTextWindow insert insert "/DIS(webonlyline)\n"
! 567: }
! 568: $gTextWindow see insert
! 569: }
! 570:
! 571: ###########################################################
! 572: # insertEndline
! 573: ###########################################################
! 574: ###########################################################
! 575: ###########################################################
! 576: proc insertEndline {} {
! 577: global gTextWindow
! 578:
! 579: if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
! 580: return
! 581: }
! 582: $gTextWindow insert insert "/END(stdendline)\n"
! 583: }
! 584:
! 585: ###########################################################
! 586: # getProbValTryVal
! 587: ###########################################################
! 588: ###########################################################
! 589: ###########################################################
! 590: proc getProbValTryVal {} {
! 591: global gPrompt gProbVal gTryVal gHintVal gPutLine
! 592:
! 593: set dialog [toplevel .getProbValTryVal -borderwidth 10]
! 594: wm title $dialog "Getting Problem Value and Try Value"
! 595: wm geo $dialog "+200+200"
! 596: message $dialog.msg -text "Set the weight of the problem and the number of tries allowed." -aspect 700
! 597:
! 598: set gPrompt(result) ""
! 599: scale $dialog.probVal -orient horizontal -variable gProbVal \
! 600: -from 0 -to 9 -label "Problem Value" -length 150
! 601: scale $dialog.tryVal -orient horizontal -variable gTryVal \
! 602: -from 0 -to 99 -label "Try Value" -length 150
! 603: scale $dialog.hintVal -orient horizontal -variable gHintVal \
! 604: -from 1 -to 99 -label "Number of Tries Before Showing Hint" -length 150
! 605: set gPrompt(stdline.1) "Put a stdline after this problem."
! 606: set gPrompt(stdline.0) "Put a webonlyline after this problem."
! 607: checkbutton $dialog.putLine -variable gPutLine \
! 608: -width 38 \
! 609: -textvariable gPrompt(displayLine) \
! 610: -command { set gPrompt(displayLine) $gPrompt(stdline.$gPutLine) }
! 611: set gPrompt(displayLine) $gPrompt(stdline.$gPutLine)
! 612: set buttonFrame [frame $dialog.buttons -bd 10]
! 613: pack $dialog.msg $dialog.probVal $dialog.tryVal $dialog.hintVal $dialog.putLine \
! 614: $buttonFrame -side top -fill x
! 615:
! 616: button $buttonFrame.yes -text Import -command {set gPrompt(yes) 1} \
! 617: -underline 0
! 618: button $buttonFrame.cancel -text Cancel -command { set gPrompt(yes) 0 } \
! 619: -underline 0
! 620: pack $buttonFrame.yes $buttonFrame.cancel -side left
! 621:
! 622: bind $dialog <Alt-Key> break
! 623: bind $dialog <Destroy> "set gPrompt(yes) 0"
! 624: Centre_Dialog $dialog default
! 625: update
! 626:
! 627: focus $dialog
! 628: capaRaise $dialog
! 629: capaGrab $dialog
! 630: vwait gPrompt(yes)
! 631: capaGrab release $dialog
! 632: bind $dialog <Destroy> ""
! 633: destroy $dialog
! 634: if {$gPrompt(yes)} {
! 635: return Done
! 636: } else {
! 637: return Cancel
! 638: }
! 639: }
! 640:
! 641: ###########################################################
! 642: # updateDateBox
! 643: ###########################################################
! 644: ###########################################################
! 645: ###########################################################
! 646: proc updateDateBox { listbox } {
! 647: global gControlDates
! 648: $listbox delete 0 end
! 649: for {set i 0} {$i < [llength $gControlDates]} {incr i } {
! 650: set date [lindex $gControlDates $i]
! 651: if { $i != 0 } {
! 652: $listbox insert end [eval format {"%4d %4d %s %s %s"} $date]
! 653: } else {
! 654: $listbox insert end [eval format {" DEFAULT %s %s %s"} [lrange $date 2 end]]
! 655: }
! 656: }
! 657: }
! 658:
! 659: ###########################################################
! 660: # loadDates
! 661: ###########################################################
! 662: ###########################################################
! 663: ###########################################################
! 664: proc loadDates { listbox } {
! 665: global gControlDates
! 666: if { [catch {getHeaderInfo}]} {
! 667: displayError "That set.db does not exist"
! 668: }
! 669: updateDateBox $listbox
! 670: }
! 671:
! 672: ###########################################################
! 673: # deleteDate
! 674: ###########################################################
! 675: ###########################################################
! 676: ###########################################################
! 677: proc deleteDate { listbox } {
! 678: global gControlDates
! 679: if { [set a [$listbox index anchor]] != 0 } {
! 680: catch {$listbox delete anchor}
! 681: set gControlDates [lreplace $gControlDates $a $a]
! 682: } else {
! 683: displayError "You can not delete the default setting, only change it."
! 684: }
! 685: }
! 686:
! 687: ###########################################################
! 688: # checkHeaderForDefault
! 689: ###########################################################
! 690: ###########################################################
! 691: ###########################################################
! 692: proc checkHeaderForDefault { } {
! 693: global gControlDates
! 694: if { [lindex [lindex $gControlDates 0] 0] == 0 && \
! 695: [lindex [lindex $gControlDates 0] 1] == 0 } {
! 696: return 1
! 697: }
! 698: return 0
! 699: }
! 700:
! 701: ###########################################################
! 702: # dueAnswerOrder
! 703: ###########################################################
! 704: ###########################################################
! 705: ###########################################################
! 706: proc dueAnswerOrder { } {
! 707: global gDates
! 708: set duetime [clock scan "$gDates(duemonth)/$gDates(dueday)/$gDates(dueyear) $gDates(duehour):$gDates(dueminute)"]
! 709: set answertime [clock scan "$gDates(answermonth)/$gDates(answerday)/$gDates(answeryear) $gDates(answerhour):$gDates(answerminute)"]
! 710: if { $duetime > $answertime } { return 1 } { return 0 }
! 711: }
! 712:
! 713: ###########################################################
! 714: # checkDateFields
! 715: ###########################################################
! 716: ###########################################################
! 717: ###########################################################
! 718: proc checkDateFields { } {
! 719: global gDates
! 720:
! 721: set result 1
! 722: foreach kind { open due answer } {
! 723: foreach type { year month day hour minute } {
! 724: if { [validate $kind $type] != 1 } {
! 725: return $kind$type
! 726: }
! 727: }
! 728: }
! 729: if { [validate "" durationhour] != 1 } { return durationhour }
! 730: if { [validate duration minute] != 1 } { return durationminute }
! 731: if { [catch { expr $gDates(sectionstart) }] } { return sectionstart } else {
! 732: if {[string length $gDates(sectionstart)] <1} { return sectionstart } else {
! 733: if { [catch { expr $gDates(sectionend) }] } { return sectionend } else {
! 734: if {[string length $gDates(sectionend)] <1} { return sectionend }
! 735: }
! 736: }
! 737: }
! 738: return $result
! 739: }
! 740:
! 741: ###########################################################
! 742: # validate
! 743: ###########################################################
! 744: ###########################################################
! 745: ###########################################################
! 746: proc validate { kind type {newvalue novalue} } {
! 747: global gDates
! 748: #tcl interprets all strings of digits with 0 as the first number as being
! 749: #in octal, need to prevent this from causing an error
! 750: if { $newvalue == "novalue" } {
! 751: set temp $gDates($kind$type)
! 752: set lowfail -1
! 753: } else {
! 754: if { $newvalue == "" } { return 1 }
! 755: set temp $newvalue
! 756: set lowfail 1
! 757: }
! 758: if { [string length $temp] > 1 && [string index $temp 0] == 0 } {
! 759: set test [string range $temp 1 end]
! 760: } else {
! 761: set test $temp
! 762: }
! 763: if { [catch { expr $test }] } { return 0 } else {
! 764: switch $type {
! 765: year {
! 766: if { $test < 1990 } { return $lowfail }
! 767: if { $test > 9999 } { return 0 }
! 768: if { [string length $temp] > 4 } { return 0 }
! 769: }
! 770: month {
! 771: if { $test < 1 } { return $lowfail }
! 772: if { $test > 12 } { return 0 }
! 773: if { [string length $temp] > 2 } { return 0 }
! 774: }
! 775: day {
! 776: if { $test < 1 } { return $lowfail }
! 777: if { $test > 31 } { return 0 }
! 778: if { [string length $temp] > 2 } { return 0 }
! 779: }
! 780: hour {
! 781: if { $test < 0 } { return 0 }
! 782: if { $test > 23 } { return 0 }
! 783: if { [string length $temp] > 2 } { return 0 }
! 784: }
! 785: minute {
! 786: if { $test < 0 } { return 0 }
! 787: if { $test > 59 } { return 0 }
! 788: if { [string length $temp] > 2 } { return 0 }
! 789: }
! 790: durationhour {
! 791: if { $test < 0 } { return 0 }
! 792: if { [string length $temp] > 4 } { return 0 }
! 793: }
! 794: }
! 795: }
! 796: return 1
! 797: }
! 798:
! 799: ###########################################################
! 800: # getday
! 801: ###########################################################
! 802: ###########################################################
! 803: ###########################################################
! 804: proc getday { kind } {
! 805: global gDates
! 806: if { [set day $gDates([set kind]day)] != ""} {
! 807: if { [set month $gDates([set kind]month)] != ""} {
! 808: if { [set year $gDates([set kind]year)] != ""} {
! 809: if { [ catch { set gDates($kind.dayoweek) \
! 810: [clock format [clock scan "$month/$day/$year"] \
! 811: -format %a] } error ] } {
! 812: set gDates($kind.dayoweek) ""
! 813: }
! 814: return
! 815: }
! 816: }
! 817: }
! 818: set gDates($kind.dayoweek) ""
! 819: }
! 820:
! 821: ###########################################################
! 822: # enableDateValidation
! 823: ###########################################################
! 824: ###########################################################
! 825: ###########################################################
! 826: proc enableDateValidation { toplevel } {
! 827: global gDates
! 828: set dateFrame $toplevel.dateFrame
! 829: foreach type { open due answer } {
! 830: $dateFrame.[set type]date.year configure -validate key \
! 831: -validatecommand "validate $type year %P"
! 832: $dateFrame.[set type]date.month configure -validate key \
! 833: -validatecommand "validate $type month %P"
! 834: $dateFrame.[set type]date.day configure -validate key \
! 835: -validatecommand "validate $type day %P"
! 836: $dateFrame.[set type]time.hour configure -validate key \
! 837: -validatecommand "validate $type hour %P"
! 838: $dateFrame.[set type]time.minute configure -validate key \
! 839: -validatecommand "validate $type minute %P"
! 840: }
! 841: $gDates(optFrame).duration.hour configure -validate key \
! 842: -validatecommand "validate {} durationhour %P"
! 843: $gDates(optFrame).duration.minute configure -validate key \
! 844: -validatecommand "validate duration minute %P"
! 845:
! 846: }
! 847:
! 848: ###########################################################
! 849: # addDateOptions
! 850: ###########################################################
! 851: ###########################################################
! 852: ###########################################################
! 853: proc addDateOptions {} {
! 854: global gDates
! 855: pack $gDates(optFrame2)
! 856: $gDates(optBut) configure -text "Less Options" -command "removeDateOptions"
! 857: }
! 858:
! 859: ###########################################################
! 860: # removeDateOptions
! 861: ###########################################################
! 862: ###########################################################
! 863: ###########################################################
! 864: proc removeDateOptions {} {
! 865: global gDates
! 866: pack forget $gDates(optFrame2)
! 867: $gDates(optBut) configure -text "More Options" -command "addDateOptions"
! 868: }
! 869:
! 870: ###########################################################
! 871: # createDateDialog
! 872: ###########################################################
! 873: ###########################################################
! 874: ###########################################################
! 875: proc createDateDialog { toplevel makedefault } {
! 876: global gDates gPrompt2
! 877:
! 878: catch [unset gDates]
! 879:
! 880: set infoFrame [frame $toplevel.infoFrame]
! 881: set sectionFrame [frame $toplevel.sectionFrame -borderwidth 4]
! 882: set dateFrame [frame $toplevel.dateFrame]
! 883: set optionsFrame [frame $toplevel.optionsFrame]
! 884: set buttonFrame [frame $toplevel.buttonFrame]
! 885: pack $infoFrame $sectionFrame $dateFrame $buttonFrame -side top
! 886:
! 887: if { $makedefault } {
! 888: label $sectionFrame.sectionl -text "Default value for all sections:"
! 889: pack $sectionFrame.sectionl
! 890: set gDates(sectionstart) 0
! 891: set gDates(sectionend) 0
! 892: } else {
! 893: grid [label $sectionFrame.sectionl -text "Dates and times are for"] \
! 894: -column 0 -columnspan 4 -row 0
! 895: grid [label $sectionFrame.section12 -text "section:"] -column 0 -row 1
! 896: grid [entry $sectionFrame.start -width 3 -textvariable gDates(sectionstart)] \
! 897: -column 1 -row 1
! 898: grid [label $sectionFrame.sectionl3 -text "through section: "] -column 2 -row 1
! 899: grid [entry $sectionFrame.end -width 3 -textvariable gDates(sectionend)] \
! 900: -column 3 -row 1
! 901: button $buttonFrame.getdefaults -text "Get Defaults" -command \
! 902: "setValues 0 0;enableDateValidation $toplevel"
! 903: pack $buttonFrame.getdefaults -side left
! 904: }
! 905:
! 906: grid [label $dateFrame.datel -text "Date"] -column 1 -row 0
! 907: grid [label $dateFrame.timel -text "Time"] -column 2 -row 0
! 908: grid [label $dateFrame.helpd -text "yyyy/mm/dd"] -column 1 -row 1
! 909: grid [label $dateFrame.helpt -text "hh:mm"] -column 2 -row 1
! 910: grid [label $dateFrame.openl -text "Open"] -column 0 -row 2
! 911: grid [set openDate [frame $dateFrame.opendate -borderwidth 2 -relief sunken]] -column 1 -row 2
! 912: grid [set openTime [frame $dateFrame.opentime -borderwidth 2 -relief sunken]] -column 2 -row 2
! 913: grid [label $dateFrame.openday -textvariable gDates(open.dayoweek)] -column 3 -row 2
! 914: grid [label $dateFrame.duel -text "Due"] -column 0 -row 3
! 915: grid [set dueDate [frame $dateFrame.duedate -borderwidth 2 -relief sunken]] -column 1 -row 3
! 916: grid [set dueTime [frame $dateFrame.duetime -borderwidth 2 -relief sunken]] -column 2 -row 3
! 917: grid [label $dateFrame.dueday -textvariable gDates(due.dayoweek)] -column 3 -row 3
! 918: grid [label $dateFrame.answerl -text "Answer"] -column 0 -row 4
! 919: grid [set answerDate [frame $dateFrame.answerdate -borderwidth 2 -relief sunken]] -column 1 -row 4
! 920: grid [set answerTime [frame $dateFrame.answertime -borderwidth 2 -relief sunken]] -column 2 -row 4
! 921: grid [label $dateFrame.ansday -textvariable gDates(answer.dayoweek)] -column 3 -row 4
! 922:
! 923:
! 924: foreach type { open due answer } {
! 925: entry [set [set type]Date].year -width 4 -textvariable gDates([set type]year)
! 926: label [set [set type]Date].sl1 -text "/"
! 927: entry [set [set type]Date].month -width 2 -textvariable gDates([set type]month)
! 928: label [set [set type]Date].sl2 -text "/"
! 929: entry [set [set type]Date].day -width 2 -textvariable gDates([set type]day)
! 930: entry [set [set type]Time].hour -width 2 -textvariable gDates([set type]hour)
! 931: label [set [set type]Time].colon -text ":"
! 932: entry [set [set type]Time].minute -width 2 -textvariable gDates([set type]minute)
! 933: pack [set [set type]Date].year [set [set type]Date].sl1 \
! 934: [set [set type]Date].month [set [set type]Date].sl2 \
! 935: [set [set type]Date].day -side left
! 936: pack [set [set type]Time].hour [set [set type]Time].colon \
! 937: [set [set type]Time].minute -side left
! 938: }
! 939:
! 940: set optionsFrame3 [frame $optionsFrame.options]
! 941: set gDates(optFrame) [ set optionsFrame2 [frame $optionsFrame3.options ] ]
! 942: pack $gDates(optFrame) $optionsFrame3
! 943: set gDates(optFrame2) $optionsFrame
! 944:
! 945: set durationFrame [frame $optionsFrame2.duration]
! 946: checkbutton $optionsFrame2.view -variable gDates(viewbetween) \
! 947: -text "Allow Viewing between Due and Answer dates"
! 948: checkbutton $optionsFrame2.response -variable gDates(inhibitresponse) \
! 949: -text "Inhibit Correct/Incorrect response \n(normally only for exams/quizzes)"
! 950: pack $durationFrame $optionsFrame2.view $optionsFrame2.response -side top
! 951: set gDates(viewbetween) 1
! 952: set gDates(inhibitresponse) 0
! 953:
! 954: label $durationFrame.label -text "Duration"
! 955: entry $durationFrame.hour -width 4 -textvariable gDates(durationhour)
! 956: label $durationFrame.colon -text ":"
! 957: entry $durationFrame.minute -width 2 -textvariable gDates(durationminute)
! 958: pack $durationFrame.label $durationFrame.hour $durationFrame.colon \
! 959: $durationFrame.minute -side left
! 960: set gDates(durationhour) 0
! 961: set gDates(durationminute) 0
! 962:
! 963: button $buttonFrame.help -text "Help" -command "showHelp dateEntry"
! 964: button $buttonFrame.set -text "Ok" -command "set gPrompt2(ok) 1"
! 965: button $buttonFrame.cancel -text "Cancel" -command "set gPrompt2(ok) 0"
! 966: set gDates(optBut) [ button $buttonFrame.options -text "More Options" \
! 967: -command "addDateOptions"]
! 968: pack $buttonFrame.help $buttonFrame.set $buttonFrame.cancel $buttonFrame.options \
! 969: -side left
! 970: bind $toplevel <Destroy> "set gPrompt2(ok) 0"
! 971: bind $toplevel <KeyPress> "getday open;getday due;getday answer"
! 972: bind $toplevel <Return> {tkTabToWindow [tk_focusNext %W]}
! 973: }
! 974:
! 975: ###########################################################
! 976: # addCurrentDates
! 977: ###########################################################
! 978: ###########################################################
! 979: ###########################################################
! 980: proc addCurrentDates { listbox makedefault {which -1} } {
! 981: global gControlDates gDates
! 982: foreach kind { open due answer } {
! 983: foreach type { year month day hour minute } {
! 984: #tcl interprets all strings of digits with 0 as the first number as
! 985: #being in octal, need to prevent this from causing an error
! 986: if { [string length $gDates($kind$type)] > 1 && \
! 987: [string index $gDates($kind$type) 0] == 0 } {
! 988: set gDates($kind$type) [string range $gDates($kind$type) 1 end]
! 989: }
! 990: }
! 991: }
! 992: set datestring [list $gDates(sectionstart) $gDates(sectionend) \
! 993: [format "%04d/%02d/%02d %02d:%02d" $gDates(openyear) \
! 994: $gDates(openmonth) $gDates(openday) \
! 995: $gDates(openhour) $gDates(openminute) ] \
! 996: [format "%04d/%02d/%02d %02d:%02d" $gDates(dueyear) \
! 997: $gDates(duemonth) $gDates(dueday) \
! 998: $gDates(duehour) $gDates(dueminute) ] \
! 999: [format "%04d/%02d/%02d %02d:%02d" $gDates(answeryear) \
! 1000: $gDates(answermonth) $gDates(answerday) \
! 1001: $gDates(answerhour) $gDates(answerminute) ] \
! 1002: [format "%d:%d" $gDates(durationhour) $gDates(durationminute)] \
! 1003: $gDates(inhibitresponse) $gDates(viewbetween) ]
! 1004: if { $makedefault } {
! 1005: if { ([info globals gControlDates] == "") || ($gControlDates == "") } {
! 1006: set gControlDates [list $datestring]
! 1007: } else {
! 1008: set gControlDates [lreplace $gControlDates 0 0 $datestring]
! 1009: }
! 1010: } else {
! 1011: if { $which > -1 } {
! 1012: # puts "$gControlDates=$which=$which=$datestring"
! 1013: set gControlDates [lreplace $gControlDates $which $which $datestring]
! 1014: } else {
! 1015: lappend gControlDates $datestring
! 1016: }
! 1017: }
! 1018: updateDateBox $listbox
! 1019: }
! 1020:
! 1021: ###########################################################
! 1022: # setValues
! 1023: ###########################################################
! 1024: ###########################################################
! 1025: ###########################################################
! 1026: proc setValues { which {doSections 1} } {
! 1027: global gControlDates gDates
! 1028: set datestring [lindex $gControlDates $which]
! 1029: if { $doSections } {
! 1030: set gDates(sectionstart) [lindex $datestring 0]
! 1031: set gDates(sectionend) [lindex $datestring 1]
! 1032: }
! 1033: foreach type {open due answer} element {2 3 4} {
! 1034: set gDates([set type]year) [lindex [split [lindex $datestring $element] "/" ] 0]
! 1035: set gDates([set type]month) [lindex [split [lindex $datestring $element] "/" ] 1]
! 1036: set gDates([set type]day) [lindex [split [lindex [lindex $datestring $element] 0] "/" ] 2]
! 1037: set gDates([set type]hour) [lindex [split [lindex [lindex $datestring $element] 1] ":" ] 0]
! 1038: set gDates([set type]minute) [lindex [split [lindex [lindex $datestring $element] 1] ":" ] 1]
! 1039: }
! 1040: set gDates(durationhour) [lindex [split [lindex $datestring 5] ":" ] 0]
! 1041: set gDates(durationminute) [lindex [split [lindex $datestring 5] ":" ] 1]
! 1042: set gDates(inhibitresponse) [lindex $datestring 6]
! 1043: set gDates(viewbetween) [lindex $datestring 7]
! 1044: getday open
! 1045: getday due
! 1046: getday answer
! 1047: }
! 1048:
! 1049: ###########################################################
! 1050: # changeDate
! 1051: ###########################################################
! 1052: ###########################################################
! 1053: ###########################################################
! 1054: proc changeDate { listbox } {
! 1055: global gDates gPrompt2 gControlDates
! 1056:
! 1057: if { ![winfo exists $listbox] } { return }
! 1058: if { [winfo exists .adddate] } { return }
! 1059: if { [set which [$listbox index anchor]] == 0 } { set makedefault 1 } else {
! 1060: set makedefault 0 }
! 1061: if { $which == [$listbox index end] } {addDate $listbox;return}
! 1062: set changeDate [toplevel .changeDate]
! 1063: createDateDialog $changeDate $makedefault
! 1064: setValues $which
! 1065: enableDateValidation $changeDate
! 1066:
! 1067: if { $makedefault } {
! 1068: set gDates(sectionstart) 0
! 1069: set gDates(sectionend) 0
! 1070: }
! 1071:
! 1072: Centre_Dialog $changeDate default
! 1073: update
! 1074:
! 1075: focus $changeDate
! 1076: capaRaise $changeDate
! 1077: capaGrab $changeDate
! 1078: set done 0
! 1079: while { $done != 1 } {
! 1080: vwait gPrompt2(ok)
! 1081: if { $gPrompt2(ok) == 1 } {
! 1082: if { 1 != [set done [checkDateFields]] } {
! 1083: displayError "Please correct field: $done"
! 1084: set done 0
! 1085: } else {
! 1086: if { [dueAnswerOrder] } {
! 1087: if { "Yes" == [makeSure "Right now answers are available before an assignment is due. Would you like to change this?."]} {
! 1088: set done 0
! 1089: } else {
! 1090: set done 1
! 1091: }
! 1092: }
! 1093: }
! 1094: } else {
! 1095: set done 1
! 1096: }
! 1097: }
! 1098: capaGrab release $changeDate
! 1099: bind $changeDate <Destroy> ""
! 1100: destroy $changeDate
! 1101: if {$gPrompt2(ok) == 1 } {
! 1102: addCurrentDates $listbox $makedefault $which
! 1103: }
! 1104: return
! 1105: }
! 1106:
! 1107: ###########################################################
! 1108: # addDate
! 1109: ###########################################################
! 1110: ###########################################################
! 1111: ###########################################################
! 1112: proc addDate { listbox } {
! 1113: global gDates gPrompt2
! 1114:
! 1115: if { ![winfo exists $listbox ] } { return }
! 1116: if { [winfo exists .adddate ] } { return }
! 1117: if { [$listbox index end] == 0 } { set makedefault 1 } else { set makedefault 0 }
! 1118: set addDate [toplevel .adddate]
! 1119:
! 1120: createDateDialog $addDate $makedefault
! 1121: enableDateValidation $addDate
! 1122:
! 1123: Centre_Dialog $addDate default
! 1124: update
! 1125:
! 1126: focus $addDate
! 1127: capaRaise $addDate
! 1128: capaGrab $addDate
! 1129: set done 0
! 1130: while { $done != 1 } {
! 1131: vwait gPrompt2(ok)
! 1132: if { $gPrompt2(ok) == 1 } {
! 1133: if { 1 != [set done [checkDateFields]] } {
! 1134: displayError "Please correct field: $done"
! 1135: set done 0
! 1136: } else {
! 1137: if { [dueAnswerOrder] } {
! 1138: if { "Yes" == [makeSure "Right now answers are available before an assignment is due. Would you like to change this?."]} {
! 1139: set done 0
! 1140: } else {
! 1141: set done 1
! 1142: }
! 1143: }
! 1144: }
! 1145: } else {
! 1146: set done 1
! 1147: }
! 1148: }
! 1149: capaGrab release $addDate
! 1150: bind $addDate <Destroy> ""
! 1151: destroy $addDate
! 1152: if {$gPrompt2(ok) == 1 } {
! 1153: addCurrentDates $listbox $makedefault
! 1154: }
! 1155: return
! 1156: }
! 1157:
! 1158: ###########################################################
! 1159: # createDBHeader
! 1160: ###########################################################
! 1161: ###########################################################
! 1162: ###########################################################
! 1163: proc createDBHeader {} {
! 1164: global gNumberParsedText gPrompt gLoadHeaderSet gControlDates \
! 1165: gSetNumberText gHeaderQCount
! 1166:
! 1167: if { $gNumberParsedText == "" } {
! 1168: displayError "You must first preview the file before creating the \
! 1169: DB header."
! 1170: return
! 1171: }
! 1172:
! 1173: if { [winfo exists .headerPrompt] } {
! 1174: capaRaise .headerPrompt
! 1175: return
! 1176: }
! 1177:
! 1178: set dialog [toplevel .headerPrompt -borderwidth 10]
! 1179: wm geo $dialog "+200+200"
! 1180: wm title $dialog "Creating DB Header"
! 1181:
! 1182: message $dialog.msg -text "Header Information" -aspect 1000
! 1183: set loadFrame [frame $dialog.loadFrame -borderwidth 4 -relief sunken]
! 1184: set infoFrame [frame $dialog.infoFrame -borderwidth 4 -relief sunken]
! 1185: set buttonFrame [frame $dialog.buttons -bd 10]
! 1186: pack $dialog.msg $loadFrame $infoFrame $buttonFrame -side top -fill x
! 1187:
! 1188: set legendFrame [frame $infoFrame.legendFrame]
! 1189: set listFrame [frame $infoFrame.listFrame]
! 1190: set commandFrame [frame $infoFrame.commandFrame]
! 1191: pack $legendFrame $listFrame $commandFrame -side top
! 1192:
! 1193: label $legendFrame.legend1 -text " Section# | Open | Due | Answer "
! 1194: label $legendFrame.legend2 -text "Start End| Date Time | Date Time | Date Time "
! 1195: pack $legendFrame.legend1 $legendFrame.legend2 -side top
! 1196:
! 1197: set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ]
! 1198: scrollbar $listFrame.scroll -command "$listbox yview"
! 1199: pack $listFrame.list $listFrame.scroll -side left
! 1200: updateDateBox $listbox
! 1201:
! 1202: button $commandFrame.add -text "Add" -command "addDate $listbox"
! 1203: button $commandFrame.change -text "Change" -command "changeDate $listbox"
! 1204: button $commandFrame.delete -text "Delete" -command "deleteDate $listbox"
! 1205: pack $commandFrame.add $commandFrame.change $commandFrame.delete -side left
! 1206: bind $listbox <Double-ButtonPress-1> "changeDate $listbox"
! 1207:
! 1208: message $loadFrame.msg -text "Load header information from set:" \
! 1209: -aspect 1000
! 1210: set gLoadHeaderSet $gSetNumberText
! 1211: entry $loadFrame.entry -textvariable gLoadHeaderSet -width 2
! 1212: button $loadFrame.load -text "load" -command "loadDates $listbox"
! 1213: pack $loadFrame.msg $loadFrame.entry $loadFrame.load -side left
! 1214:
! 1215: button $buttonFrame.ok -text Set -command { set gPrompt(ok) 1 } \
! 1216: -underline 0
! 1217: button $buttonFrame.cancel -text Cancel -command { set gPrompt(ok) 0 } \
! 1218: -underline 0
! 1219: pack $buttonFrame.ok $buttonFrame.cancel -side left
! 1220:
! 1221: bind $dialog <Destroy> "set gPrompt(ok) 0"
! 1222: Centre_Dialog $dialog default
! 1223: update
! 1224:
! 1225: focus $dialog
! 1226: capaRaise $dialog
! 1227: capaGrab $dialog
! 1228: bind $dialog <Destroy> ""
! 1229: set done 0
! 1230: while { $done != 1 } {
! 1231: vwait gPrompt(ok)
! 1232: if { $gPrompt(ok) == 1 } {
! 1233: set done [checkHeaderForDefault]
! 1234: if { $done == 0 } {
! 1235: displayError "Must have a Default setting."
! 1236: }
! 1237: } else {
! 1238: set done 1
! 1239: }
! 1240: }
! 1241: capaGrab release $dialog
! 1242: destroy $dialog
! 1243: if {$gPrompt(ok) == 1 } {
! 1244: eval updateHeader [ eval concat $gControlDates ]
! 1245: }
! 1246:
! 1247: return
! 1248:
! 1249: }
! 1250:
! 1251: ###########################################################
! 1252: # allFieldsComplete2
! 1253: ###########################################################
! 1254: ###########################################################
! 1255: ###########################################################
! 1256: proc allFieldsComplete2 {} {
! 1257: global gLoadHeaderSet gControlDates
! 1258:
! 1259: if { [string length $gOpenDate] != 8 } {
! 1260: return 0
! 1261: } elseif { [string length $gOpenTime] != 5 } {
! 1262: return 0
! 1263: } elseif { [string length $gDueDate] != 8 } {
! 1264: return 0
! 1265: } elseif { [string length $gDueTime] != 5 } {
! 1266: return 0
! 1267: } elseif { [string length $gAnswerDate] != 8 } {
! 1268: return 0
! 1269: } elseif { [string length $gAnswerTime] != 5 } {
! 1270: return 0
! 1271: } else {
! 1272: return 1
! 1273: }
! 1274: }
! 1275:
! 1276: ###########################################################
! 1277: # createFindWindow
! 1278: ###########################################################
! 1279: ###########################################################
! 1280: ###########################################################
! 1281: proc createFindWindow { {num 0} } {
! 1282: global gFind gWindowMenu gFindListbox
! 1283:
! 1284: if { [winfo exists .find] } {
! 1285: capaRaise .find
! 1286: pickFindFile $num
! 1287: return
! 1288: }
! 1289:
! 1290: set find [toplevel .find]
! 1291: $gWindowMenu add command -label "Find" -command "capaRaise $find"
! 1292: wm title $find "Find"
! 1293:
! 1294: set findFrame [frame $find.findFrame -width 5i]
! 1295: set replaceFrame [frame $find.replaceFrame ]
! 1296: set optionsFrame [frame $find.optionsFrame ]
! 1297: set buttonFrame [frame $find.buttonsFrame ]
! 1298: pack $findFrame $replaceFrame $optionsFrame $buttonFrame -side top \
! 1299: -anchor e
! 1300: pack configure $buttonFrame -anchor center
! 1301:
! 1302: message $findFrame.msg -text "Find:" -aspect 10000
! 1303: entry $findFrame.entry -width 50 -textvariable gFind(find)
! 1304: pack $findFrame.msg $findFrame.entry -side left
! 1305:
! 1306: message $replaceFrame.msg -text "Replace with:" -aspect 10000
! 1307: entry $replaceFrame.entry -width 50 -textvariable gFind(replace)
! 1308: pack $replaceFrame.msg $replaceFrame.entry -side left
! 1309:
! 1310: set fileFrame [frame $optionsFrame.file]
! 1311: set scopeFrame [frame $optionsFrame.scope -relief groove -borderwidth 4]
! 1312: set findOptionsFrame [frame $optionsFrame.findOptionsFrame -relief \
! 1313: groove -borderwidth 4]
! 1314: pack $fileFrame $scopeFrame $findOptionsFrame -side left
! 1315:
! 1316: set fileList [ frame $fileFrame.list ]
! 1317: set fileScroll [frame $fileFrame.scroll ]
! 1318: pack $fileList $fileScroll -side left
! 1319: pack configure $fileScroll -fill y
! 1320:
! 1321: set gFindListbox [listbox $fileList.list -width 35 -height 4 \
! 1322: -xscrollcommand "$fileList.scroll set" \
! 1323: -yscrollcommand "$fileScroll.scroll set" \
! 1324: -exportselection no]
! 1325: scrollbar $fileList.scroll -orient h -command "$fileList.list xview"
! 1326: pack $fileList.list $fileList.scroll -side top
! 1327: pack configure $fileList.scroll -fill x
! 1328: pack configure $fileList.list -fill both -expand 1
! 1329: $fileList.list xview moveto 1
! 1330:
! 1331: scrollbar $fileScroll.scroll -orient v \
! 1332: -command "$fileList.list yview"
! 1333: pack $fileScroll.scroll -fill y -expand 1
! 1334:
! 1335: message $scopeFrame.msg -text "Replace All Scope" -aspect 10000
! 1336: radiobutton $scopeFrame.file -value "File" -variable gFind(scope) -text \
! 1337: "Entire File" \
! 1338:
! 1339: radiobutton $scopeFrame.selection -value "Selection" -variable \
! 1340: gFind(scope) -text "Selection"
! 1341: pack $scopeFrame.msg $scopeFrame.file $scopeFrame.selection
! 1342: pack configure $scopeFrame.file $scopeFrame.selection -anchor w
! 1343: set gFind(scope) File
! 1344:
! 1345: message $findOptionsFrame.msg -text "Find Options" -aspect 10000
! 1346: radiobutton $findOptionsFrame.ignoreCase -variable gFind(findOption) \
! 1347: -text "Ignore Case" -value "-nocase"
! 1348: radiobutton $findOptionsFrame.exactCase -variable gFind(findOption) \
! 1349: -text "Exact Case" -value "-exact"
! 1350: radiobutton $findOptionsFrame.regexp -variable gFind(findOption) \
! 1351: -text "Regular Expression" -value "-regexp"
! 1352: pack $findOptionsFrame.msg $findOptionsFrame.ignoreCase \
! 1353: $findOptionsFrame.exactCase $findOptionsFrame.regexp
! 1354: pack $findOptionsFrame.ignoreCase $findOptionsFrame.exactCase \
! 1355: $findOptionsFrame.regexp -anchor w
! 1356: set gFind(findOption) "-nocase"
! 1357:
! 1358: button $buttonFrame.replaceAll -text "Replace All" -command "replaceAll"
! 1359: button $buttonFrame.replace -text "Replace" -command "replace"
! 1360: button $buttonFrame.replaceFind -text "Replace and Find" -command \
! 1361: "replaceFind"
! 1362: button $buttonFrame.previous -text "Previous" -command "previous"
! 1363: button $buttonFrame.next -text "Next <Return>" -command "next"
! 1364: bind $find <KeyPress-Return> next
! 1365: button $buttonFrame.close -text "Close" -command "removeWindowEntry Find
! 1366: destroy $find"
! 1367: bind $find <Destroy> "removeWindowEntry Find"
! 1368: pack $buttonFrame.replaceAll $buttonFrame.replace \
! 1369: $buttonFrame.replaceFind $buttonFrame.previous \
! 1370: $buttonFrame.next $buttonFrame.close -side left
! 1371:
! 1372: Centre_Dialog $find default
! 1373: updateFindList
! 1374: pickFindFile $num
! 1375: }
! 1376:
! 1377: ###########################################################
! 1378: # pickFindFile
! 1379: ###########################################################
! 1380: ###########################################################
! 1381: ###########################################################
! 1382: proc pickFindFile { num } {
! 1383: global gFindListbox gFindList gRefFile gFile
! 1384: if { [catch {set gFindListbox}] } { return }
! 1385: if { ![winfo exists $gFindListbox] } { return }
! 1386: if { $num == 0 } {
! 1387: set newfile $gFile
! 1388: } else {
! 1389: set newfile $gRefFile($num)
! 1390: }
! 1391: for {set i 0} {$i<[llength $gFindList(files)]} {incr i} {
! 1392: set file [lindex $gFindList(files) $i]
! 1393: if { $file == $newfile } { break }
! 1394: }
! 1395: if { $i < [llength $gFindList(files)] } {
! 1396: $gFindListbox selection clear 0 end
! 1397: $gFindListbox selection set $i
! 1398: }
! 1399: }
! 1400:
! 1401: ###########################################################
! 1402: # updateFindList
! 1403: ###########################################################
! 1404: ###########################################################
! 1405: ###########################################################
! 1406: proc updateFindList {} {
! 1407: global gFindListbox gFindList
! 1408: if { [catch {set gFindListbox}] } { return }
! 1409: if { ![winfo exists $gFindListbox] } { return }
! 1410: $gFindListbox delete 0 end
! 1411: eval "$gFindListbox insert end $gFindList(files)"
! 1412: $gFindListbox xview moveto 1
! 1413: }
! 1414:
! 1415: ###########################################################
! 1416: # whichFile
! 1417: ###########################################################
! 1418: ###########################################################
! 1419: ###########################################################
! 1420: proc whichFile { refNum } {
! 1421: global gRefFile gFile
! 1422: if { $refNum > 0 } {
! 1423: return $gRefFile($refNum)
! 1424: } else {
! 1425: if { $refNum < 0 } {
! 1426: switch -- $refNum {
! 1427: -1 { return "Preview Window" }
! 1428: -2 { return "Parse Errors Window" }
! 1429: -3 { return "LaTeX Output Window" }
! 1430: }
! 1431: } else {
! 1432: return $gFile
! 1433: }
! 1434: }
! 1435: }
! 1436: ###########################################################
! 1437: # addFindList
! 1438: ###########################################################
! 1439: ###########################################################
! 1440: ###########################################################
! 1441: proc addFindList { {refNum 0} } {
! 1442: global gFindList gRefFile gFile
! 1443:
! 1444: set file [whichFile $refNum]
! 1445: lappend gFindList(files) $file
! 1446: lappend gFindList(refNum) $refNum
! 1447: updateFindList
! 1448: }
! 1449:
! 1450: ###########################################################
! 1451: # removeFindList
! 1452: ###########################################################
! 1453: ###########################################################
! 1454: ###########################################################
! 1455: proc removeFindList { {refNum 0} } {
! 1456: global gFindList gRefFile gFile
! 1457:
! 1458: set file [whichFile $refNum]
! 1459: set k [llength $gFindList(refNum)]
! 1460: for {set i 0} {$i < $k } { incr i } {
! 1461: if { $refNum == [lindex $gFindList(refNum) $i] } { break }
! 1462: }
! 1463: if { $i != $k } {
! 1464: set gFindList(refNum) [lreplace $gFindList(refNum) $i $i]
! 1465: set gFindList(files) [lreplace $gFindList(files) $i $i]
! 1466: }
! 1467: updateFindList
! 1468: }
! 1469:
! 1470: ###########################################################
! 1471: # getFindWindow
! 1472: ###########################################################
! 1473: ###########################################################
! 1474: ###########################################################
! 1475: proc getFindWindow { {refNumVar none} } {
! 1476: global gFindListbox gFindList gRefText gTextWindow \
! 1477: gPreviewText gParseErrorsText gCreateDviText
! 1478:
! 1479: set current [$gFindListbox curselection]
! 1480: if { $current == "" } { set current 0 }
! 1481: if { [set refNum [lindex $gFindList(refNum) $current] ] } {
! 1482: if { $refNum < 0 } {
! 1483: switch -- $refNum {
! 1484: -1 { set window $gPreviewText }
! 1485: -2 { set window $gParseErrorsText }
! 1486: -3 { set window $gCreateDviText }
! 1487: }
! 1488: } else {
! 1489: set window $gRefText($refNum)
! 1490: }
! 1491: } else {
! 1492: set window $gTextWindow
! 1493: }
! 1494: if { $refNumVar != "none" } {
! 1495: upvar $refNumVar refNumUp
! 1496: set refNumUp $refNum
! 1497: }
! 1498: return $window
! 1499: }
! 1500:
! 1501: ###########################################################
! 1502: # replaceAll
! 1503: ###########################################################
! 1504: ###########################################################
! 1505: ###########################################################
! 1506: proc replaceAll {} {
! 1507: global gFind gCreateImportLinks
! 1508:
! 1509: set window [getFindWindow]
! 1510: if { ![winfo exists $window] } { return }
! 1511:
! 1512: set gCreateImportLinks 0
! 1513: set num 0
! 1514: switch $gFind(scope) {
! 1515: File
! 1516: {
! 1517: $window mark set insert 0.0
! 1518: set begin 0.0
! 1519: while { [nextRegion $begin end] != "" } {
! 1520: incr num
! 1521: replace
! 1522: if { ! ($num%10) } { update idletasks }
! 1523: set begin sel.last
! 1524: }
! 1525: }
! 1526: Selection
! 1527: {
! 1528: set error [ catch {$window mark set replace sel.first}]
! 1529: if { $error != 0 } { return }
! 1530: $window mark set capaBegin sel.first
! 1531: $window mark set capaEnd sel.last
! 1532: while { [set begin [nextRegion capaBegin capaEnd]] != "" } {
! 1533: incr num
! 1534: replace
! 1535: $window mark set capaBegin $begin
! 1536: }
! 1537: }
! 1538: }
! 1539: if { $num == 1 } { set s {} } { set s s }
! 1540: update idletasks
! 1541: set gCreateImportLinks 1
! 1542: getFindWindow refNum
! 1543: if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end }
! 1544: displayMessage "Replaced $num occurance$s"
! 1545: }
! 1546:
! 1547: ###########################################################
! 1548: ###########################################################
! 1549: ###########################################################
! 1550: ###########################################################
! 1551: proc replace {} {
! 1552: global gFind
! 1553:
! 1554: set refNum 0
! 1555: set window [getFindWindow refNum]
! 1556: if { ![winfo exist $window] } { return }
! 1557:
! 1558: set error [ catch {$window mark set replace sel.first}]
! 1559: if { $error == 0 } {
! 1560: $window delete sel.first sel.last
! 1561: } else {
! 1562: $window mark set replace insert
! 1563: }
! 1564:
! 1565: $window insert replace "$gFind(replace)"
! 1566:
! 1567: catch {$window tag remove sel sel.first sel.last}
! 1568:
! 1569: $window tag add sel "replace - [string length "$gFind(replace)"] \
! 1570: chars " replace
! 1571: $window see replace
! 1572:
! 1573: $window mark unset replace
! 1574: }
! 1575:
! 1576: ###########################################################
! 1577: ###########################################################
! 1578: ###########################################################
! 1579: ###########################################################
! 1580: proc replaceFind {} {
! 1581: set window [getFindWindow]
! 1582: if { ![winfo exists $window] } { return }
! 1583: replace
! 1584: next
! 1585: }
! 1586:
! 1587: ###########################################################
! 1588: ###########################################################
! 1589: ###########################################################
! 1590: ###########################################################
! 1591: proc searchBody { found } {
! 1592: global gFind
! 1593:
! 1594: set window [getFindWindow refNum]
! 1595: if { ![winfo exists $window] } { return }
! 1596:
! 1597: catch {$window tag remove sel sel.first sel.last}
! 1598: $window tag add sel $found "$found + [string length $gFind(find)] \
! 1599: chars"
! 1600: $window see $found
! 1601: $window mark set insert "$found + [string length $gFind(find)] chars"
! 1602: }
! 1603:
! 1604: ###########################################################
! 1605: ###########################################################
! 1606: ###########################################################
! 1607: ###########################################################
! 1608: proc previous {} {
! 1609: global gFind
! 1610:
! 1611: set window [getFindWindow]
! 1612: if { ![winfo exists $window] } { return }
! 1613:
! 1614: if { [catch { set found [$window search $gFind(findOption) -backwards -- \
! 1615: $gFind(find) "sel.first - 1 c" ] } ] } {
! 1616: set found [ $window search $gFind(findOption) -backwards -- \
! 1617: $gFind(find) "insert - 1 c" ]
! 1618: }
! 1619: if { $found != "" } { searchBody $found }
! 1620: return $found
! 1621: }
! 1622:
! 1623: ###########################################################
! 1624: ###########################################################
! 1625: ###########################################################
! 1626: ###########################################################
! 1627: proc next {} {
! 1628: global gFind
! 1629:
! 1630: set window [getFindWindow]
! 1631: if { ![winfo exists $window] } { return }
! 1632:
! 1633: set found [ $window search $gFind(findOption) -forwards -- \
! 1634: $gFind(find) "insert + 1 c" ]
! 1635: if { $found != "" } {
! 1636: searchBody $found
! 1637: } else {
! 1638: displayMessage "Search String Not Found"
! 1639: }
! 1640: return $found
! 1641: }
! 1642:
! 1643: ###########################################################
! 1644: ###########################################################
! 1645: ###########################################################
! 1646: ###########################################################
! 1647: proc nextRegion { begin end } {
! 1648: global gFind
! 1649:
! 1650: set window [getFindWindow]
! 1651: if { ![winfo exists $window] } { return }
! 1652:
! 1653: set error [ catch {set found [ $window search $gFind(findOption) \
! 1654: -forwards -- $gFind(find) $begin $end ] } ]
! 1655: if { $error != 0 } { set found "" }
! 1656: if { $found != "" } {
! 1657: searchBody $found
! 1658: set found "$found + [string length $gFind(find)] chars"
! 1659: }
! 1660: return $found
! 1661: }
! 1662:
! 1663: ###########################################################
! 1664: ###########################################################
! 1665: ###########################################################
! 1666: ###########################################################
! 1667: proc createLineWindow {} {
! 1668: global gLineNumber gCharacterNumber gLineNumberGoto gCharacterNumberGoto
! 1669: global gWindowMenu
! 1670:
! 1671: if { [winfo exists .lineWindow] } {
! 1672: capaRaise .lineWindow
! 1673: return
! 1674: }
! 1675:
! 1676: set lineWindow [toplevel .lineWindow]
! 1677: $gWindowMenu add command -label "LineSelect" -command \
! 1678: "capaRaise $lineWindow"
! 1679: wm title $lineWindow "Select Line"
! 1680:
! 1681: label $lineWindow.line -text "Line:"
! 1682: grid $lineWindow.line -column 1 -row 0
! 1683: label $lineWindow.character -text "Character:"
! 1684: grid $lineWindow.character -column 2 -row 0
! 1685: label $lineWindow.current -text "Current:"
! 1686: grid $lineWindow.current -column 0 -row 1
! 1687: label $lineWindow.lineNumber -textvariable gLineNumber
! 1688: grid $lineWindow.lineNumber -column 1 -row 1
! 1689: label $lineWindow.characterNumber -textvariable gCharacterNumber
! 1690: grid $lineWindow.characterNumber -column 2 -row 1
! 1691: label $lineWindow.goto -text "Goto:"
! 1692: grid $lineWindow.goto -column 0 -row 2
! 1693: entry $lineWindow.lineEntry -textvariable gLineNumberGoto
! 1694: grid $lineWindow.lineEntry -column 1 -row 2
! 1695: set gLineNumberGoto ""
! 1696: entry $lineWindow.characterEntry -textvariable gCharacterNumberGoto
! 1697: grid $lineWindow.characterEntry -column 2 -row 2
! 1698: set gCharacterNumberGoto ""
! 1699: button $lineWindow.close -text "Close" -command "destroy $lineWindow
! 1700: removeWindowEntry LineSelect"
! 1701: bind $lineWindow <Destroy> "removeWindowEntry LineSelect"
! 1702: grid $lineWindow.close -column 1 -row 3
! 1703: button $lineWindow.gotoButton -text "Goto<Return>" -command "gotoLine"
! 1704: grid $lineWindow.gotoButton -column 2 -row 3
! 1705:
! 1706: bind $lineWindow <KeyPress-Return> gotoLine
! 1707:
! 1708: Centre_Dialog $lineWindow default
! 1709: }
! 1710:
! 1711: ###########################################################
! 1712: ###########################################################
! 1713: ###########################################################
! 1714: ###########################################################
! 1715: proc gotoLine {} {
! 1716: global gTextWindow gLineNumberGoto gCharacterNumberGoto
! 1717: if { [catch {set gTextWindow}] } { return }
! 1718: if { ![winfo exists $gTextWindow] } { return }
! 1719:
! 1720: if { $gCharacterNumberGoto == "" } {
! 1721: if { $gLineNumberGoto == "" } {
! 1722: return
! 1723: } else {
! 1724: $gTextWindow mark set insert $gLineNumberGoto.0
! 1725: catch {$gTextWindow tag remove sel sel.first sel.last}
! 1726: $gTextWindow tag add sel "insert linestart" "insert lineend"
! 1727: $gTextWindow see insert
! 1728: }
! 1729: } else {
! 1730: if { $gLineNumberGoto == "" } {
! 1731: $gTextWindow mark set insert "insert linestart + \
! 1732: $gCharacterNumberGoto chars"
! 1733: catch {$gTextWindow tag remove sel sel.first sel.last}
! 1734: $gTextWindow tag add sel "insert - 1 chars " insert
! 1735: $gTextWindow see insert
! 1736: } else {
! 1737: $gTextWindow mark set insert $gLineNumberGoto.$gCharacterNumberGoto
! 1738: catch {$gTextWindow tag remove sel sel.first sel.last}
! 1739: $gTextWindow tag add sel "$gLineNumberGoto.$gCharacterNumberGoto \
! 1740: - 1 chars " "$gLineNumberGoto.$gCharacterNumberGoto"
! 1741: $gTextWindow see insert
! 1742: }
! 1743: }
! 1744: }
! 1745:
! 1746: proc faster {} {
! 1747: global gFasterParsing
! 1748: puts $gFasterParsing
! 1749: }
! 1750:
! 1751: ###########################################################
! 1752: # createPrefsWindow
! 1753: ###########################################################
! 1754: ###########################################################
! 1755: ###########################################################
! 1756: proc createPrefsWindow {} {
! 1757: global gPrefs gWindowMenu gEditWindow gFile gWhichFile gPrefsEditWindow \
! 1758: gFasterParsing
! 1759: if { [catch {set gEditWindow}] } { return }
! 1760: if { ![winfo exists $gEditWindow] } { return }
! 1761: if { [winfo exists .prefs] } { capaRaise .prefs; return }
! 1762:
! 1763: set prefs [toplevel .prefs]
! 1764: $gWindowMenu add command -label "Prefrences" -command "capaRaise $prefs"
! 1765: wm title $prefs "Preferences"
! 1766:
! 1767: set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4]
! 1768: pack $frameAll -expand true -fill both
! 1769:
! 1770: set frameFile [frame $frameAll.file]
! 1771: set frameInfo [frame $frameAll.info -relief groove -borderwidth 4 ]
! 1772: set frameButton [frame $frameAll.button ]
! 1773: pack $frameButton $frameInfo $frameFile -side top -expand false
! 1774: pack configure $frameButton -expand false -anchor center
! 1775:
! 1776: message $frameInfo.msg -text "Print Out"
! 1777: radiobutton $frameInfo.problem -text "Problems Only" -value "Problem" \
! 1778: -variable gPrefs(info)
! 1779: radiobutton $frameInfo.problemandanswer -text "Problems and Answers" \
! 1780: -value "ProblemAnswer" -variable gPrefs(info)
! 1781: radiobutton $frameInfo.answer -text "Answers Only" -value "Answer" \
! 1782: -variable gPrefs(info)
! 1783: pack $frameInfo.msg $frameInfo.problem $frameInfo.problemandanswer \
! 1784: $frameInfo.answer -side left -expand false -anchor w
! 1785:
! 1786:
! 1787: set selectMenu [tk_optionMenu $frameFile.menu gWhichFile HTMLheader HTMLfooter \
! 1788: TeXheader TeXfooter]
! 1789: set frameEdit [frame $frameFile.edit]
! 1790: pack $frameFile.menu $frameEdit
! 1791: pack configure $frameEdit -expand true -fill both
! 1792: trace variable gWhichFile w changePrefFile
! 1793:
! 1794: scrollbar $frameEdit.scroll -orient vertical -command "$frameEdit.text yview"
! 1795: set gPrefsEditWindow [text $frameEdit.text -yscrollcommand \
! 1796: "$frameEdit.scroll set" -wrap char -height 20 -width 80]
! 1797: pack $frameEdit.scroll $frameEdit.text -side left
! 1798: pack configure $frameEdit.scroll -expand false -fill y
! 1799: pack configure $frameEdit.text -expand true -fill both
! 1800:
! 1801: checkbutton $frameButton.faster -text "Faster Parsing" -command faster \
! 1802: -variable gFasterParsing
! 1803: button $frameButton.impcolor -text "/IMP color" -command "getColor IMP_color"
! 1804: button $frameButton.commentcolor -text "// color" -command "getColor comment_color"
! 1805: button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig"
! 1806: button $frameButton.ok -text "Dismiss" -command "destroy $prefs
! 1807: trace vdelete gWhichFile w changePrefFile
! 1808: removeWindowEntry Prefrences"
! 1809: bind $prefs <Destroy> "removeWindowEntry Preferences"
! 1810: button $frameButton.save -text "Save All" -command "savePrefs"
! 1811: pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \
! 1812: $frameButton.ok $frameButton.save $frameButton.faster -side left
! 1813:
! 1814: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
! 1815: if { [ catch {
! 1816: set filename [file join [file dirname $gFile] $file ]
! 1817: set fileId [open $filename r]
! 1818: set gPrefs($file) [read $fileId [file size $filename ]]
! 1819: close $fileId } errors ] } {
! 1820: set gPrefs($file) ""
! 1821: }
! 1822: }
! 1823: set gPrefs(currentFile) ""
! 1824: set gWhichFile HTMLheader
! 1825:
! 1826:
! 1827: Centre_Dialog $prefs default
! 1828: }
! 1829:
! 1830: ###########################################################
! 1831: # getColor
! 1832: ###########################################################
! 1833: ###########################################################
! 1834: ###########################################################
! 1835: proc getColor { whatfor } {
! 1836: global gCapaConfig gUniqueNumber gRefText
! 1837: set color [tk_chooseColor -initialcolor $gCapaConfig($whatfor)]
! 1838: set gCapaConfig($whatfor) $color
! 1839: if { $color != "" } { updateColors }
! 1840: displayMessage "To keep this color, put \"$whatfor = $color\" in the capa.config file."
! 1841: }
! 1842:
! 1843: ###########################################################
! 1844: # updateColors
! 1845: ###########################################################
! 1846: ###########################################################
! 1847: ###########################################################
! 1848: proc updateColors {} {
! 1849: global gCapaConfig gUniqueNumber gRefText
! 1850: set todo [array names gRefText]
! 1851: lappend todo 0
! 1852: displayStatus "Updating Colors . . ." both
! 1853: set num 0
! 1854: foreach win $todo {
! 1855: createImportLinks $win 0.0 end
! 1856: incr num
! 1857: updateStatusBar [expr $num/double([llength $todo])]
! 1858: }
! 1859: removeStatus
! 1860: }
! 1861:
! 1862: ###########################################################
! 1863: # changePrefFile
! 1864: ###########################################################
! 1865: ###########################################################
! 1866: ###########################################################
! 1867: proc changePrefFile { var1 var2 op } {
! 1868: global gPrefs gPrefsEditWindow gFile gWhichFile
! 1869:
! 1870: if { $gPrefs(currentFile) != "" } {
! 1871: set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
! 1872: }
! 1873: set gPrefs(currentFile) $gWhichFile
! 1874: $gPrefsEditWindow delete 0.0 end
! 1875: $gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
! 1876: }
! 1877:
! 1878: ###########################################################
! 1879: # updatePrefsWindow
! 1880: ###########################################################
! 1881: ###########################################################
! 1882: ###########################################################
! 1883: proc updatePrefsWindow {} {
! 1884: global gPrefs gPrefsEditWindow gFile gWhichFile
! 1885: if { [catch {set gPrefsEditWindow}] } { return }
! 1886: if { ![winfo exists $gPrefsEditWindow] } { return }
! 1887:
! 1888: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
! 1889: if { [ catch {
! 1890: set filename [file join [file dirname $gFile] $file ]
! 1891: set fileId [open $filename r]
! 1892: set gPrefs($file) [read $fileId [file size $filename]]
! 1893: close $fileId } ] } {
! 1894: set gPrefs($file) ""
! 1895: }
! 1896: }
! 1897: $gPrefsEditWindow delete 0.0 end
! 1898: $gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
! 1899: }
! 1900:
! 1901: ###########################################################
! 1902: ###########################################################
! 1903: ###########################################################
! 1904: ###########################################################
! 1905: proc savePrefs {} {
! 1906: global gPrefsEditWindow gFile gPrefs
! 1907: if { [catch {set gPrefsEditWindow}] } { return }
! 1908: if { ![winfo exists $gPrefsEditWindow] } { return }
! 1909: if { $gPrefs(currentFile) != "" } {
! 1910: set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
! 1911: }
! 1912: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
! 1913: if { $gPrefs($file) != "" } {
! 1914: set fileId [open [file join [file dirname $gFile] $file ] w]
! 1915: puts -nonewline $fileId $gPrefs($file)
! 1916: close $fileId
! 1917: } else {
! 1918: exec rm -f [file join [file dirname $gFile] $file ]
! 1919: }
! 1920: }
! 1921: }
! 1922:
! 1923: ###########################################################
! 1924: # checkHeader
! 1925: ###########################################################
! 1926: ###########################################################
! 1927: ###########################################################
! 1928: proc checkHeader { numberParsed } {
! 1929: global gWeightsDiffer gPartialDiffer gSetNumberText gHeaderQCount \
! 1930: gControlDates gLoadHeaderSet gFirstTime
! 1931:
! 1932: # if { $gFirstTime } { set gFirstTime 0; return }
! 1933: set gLoadHeaderSet $gSetNumberText
! 1934: set error [catch {getHeaderInfo}]
! 1935: if { $error == 1 } {
! 1936: set gHeaderQCount "0"
! 1937: set gControlDates ""
! 1938: displayError "The db file for this set does not yet exist."
! 1939: } else {
! 1940: set errortext ""
! 1941: if { ( $numberParsed != $gHeaderQCount ) } {
! 1942: set error 1
! 1943: append errortext "Number of questions ($numberParsed) is different from the number in setX.db ($gHeaderQCount). "
! 1944: }
! 1945: if { $gWeightsDiffer } {
! 1946: set error 1
! 1947: append errortext "The problem weights specified in the QZ file are different from the ones in the DB file. "
! 1948: }
! 1949: if { $gPartialDiffer } {
! 1950: set error 1
! 1951: append errortext "Whether or not a problem is hand graded as specified in the QZ file is different from the DB file. "
! 1952: }
! 1953: if { $error } {
! 1954: displayError "The curent DB Header does not match what the set file says it should be: $errortext. Set the DB Header!" red
! 1955: }
! 1956: }
! 1957: return $error
! 1958: }
! 1959:
! 1960: ###########################################################
! 1961: # fillInStudentName
! 1962: ###########################################################
! 1963: ###########################################################
! 1964: ###########################################################
! 1965: #proc notherefillInStudentName { v } {
! 1966: # global $v
! 1967:
! 1968: # set student [capaGetStudent [set ${v}(studentNumber)]]
! 1969: # set ${v}(studentName) [lindex $student [expr [llength $student] - 1] ]
! 1970: #}
! 1971:
! 1972: ###########################################################
! 1973: # studentSelectWindow
! 1974: ###########################################################
! 1975: ###########################################################
! 1976: ###########################################################
! 1977: proc studentSelectWindow { followupCommand } {
! 1978: global gStudentSelection gChanged gWindowMenu gEditWindow
! 1979: if { [catch {set gEditWindow}] } { return }
! 1980: if { ![winfo exists $gEditWindow] } { return }
! 1981: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
! 1982:
! 1983: if { [winfo exists .studentSelect] } {
! 1984: capaRaise .studentSelect
! 1985: return
! 1986: }
! 1987: set student [toplevel .studentSelect]
! 1988: $gWindowMenu add command -label "SelectStudent" \
! 1989: -command "capaRaise $student"
! 1990: wm title $student "Select Student"
! 1991:
! 1992: message $student.msg -text "Please specify a student to preview" \
! 1993: -aspect 10000
! 1994: set infoFrame [frame $student.frame -relief groove -borderwidth 4]
! 1995: set buttonFrame [frame $student.buttonFrame ]
! 1996: pack $student.msg $infoFrame $buttonFrame -side top
! 1997:
! 1998: button $buttonFrame.ok -text "Preview" -command \
! 1999: "selectStudentPreview $student $followupCommand"
! 2000: button $buttonFrame.cancel -text "Cancel" -command \
! 2001: "destroy $student
! 2002: trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
! 2003: trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
! 2004: removeWindowEntry SelectStudent"
! 2005: bind $student <Destroy> \
! 2006: "trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
! 2007: trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
! 2008: removeWindowEntry SelectStudent"
! 2009: pack $buttonFrame.ok $buttonFrame.cancel -side left
! 2010:
! 2011: set randomAnyFrame [frame $infoFrame.randomany]
! 2012: set randomFrame [frame $infoFrame.random]
! 2013: set specificFrame [frame $infoFrame.specific]
! 2014: set sectionFrame [frame $infoFrame.section]
! 2015: # pack $randomAnyFrame $randomFrame $specificFrame $sectionFrame -side top
! 2016: pack $randomFrame $specificFrame -side top
! 2017: pack configure $specificFrame -expand true -fill both
! 2018:
! 2019: radiobutton $randomAnyFrame.random -text "Randomly select a student" \
! 2020: -value "RandomAny" -variable gStudentSelection(type)
! 2021: pack $randomAnyFrame.random
! 2022:
! 2023: radiobutton $randomFrame.random -text "Randomly select one student \
! 2024: from section:" -value "Random" -variable gStudentSelection(type)
! 2025: entry $randomFrame.entry -textvariable gStudentSelection(random) -width 3
! 2026: pack $randomFrame.random $randomFrame.entry -side left
! 2027:
! 2028: radiobutton $specificFrame.specific -text "Specify the student by:" \
! 2029: -value "Specific" -variable gStudentSelection(type)
! 2030: set studentNumber [frame $specificFrame.studentNumber]
! 2031: set fullName [frame $specificFrame.fullName]
! 2032: pack $specificFrame.specific $studentNumber $fullName -side top
! 2033: pack configure $specificFrame.specific -anchor w
! 2034: pack configure $studentNumber $fullName -anchor e
! 2035:
! 2036: radiobutton $sectionFrame.section
! 2037: message $studentNumber.msg -text "Student Number: " -aspect 10000
! 2038: entry $studentNumber.entry -textvariable gStudentSelection(studentNumber) \
! 2039: -width 9 -validate key -validatecommand "limitEntry %W 9 any %P"
! 2040: pack $studentNumber.msg $studentNumber.entry -side left
! 2041:
! 2042: message $fullName.msg -text "Student Name: " -aspect 10000
! 2043: entry $fullName.msg2 -textvariable gStudentSelection(studentName) -width 35 \
! 2044: -validate key -validatecommand "limitEntry %W 35 any %P"
! 2045: pack $fullName.msg $fullName.msg2 -side left
! 2046:
! 2047: trace variable gStudentSelection(studentNumber) w \
! 2048: "global gStudentSelection; set gStudentSelection(type) Specific ;#"
! 2049: trace variable gStudentSelection(studentName) w \
! 2050: "global gStudentSelection; set gStudentSelection(type) Specific ;#"
! 2051:
! 2052: bind $studentNumber.entry <KeyPress-Return> \
! 2053: "fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 0"
! 2054: bind $fullName.msg2 <KeyPress-Return> \
! 2055: "fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 1"
! 2056: # $specificFrame.specific configure -command \
! 2057: "$studentNumber.entry configure -state normal"
! 2058: # $randomFrame.random configure -command \
! 2059: "$studentNumber.entry configure -state disabled"
! 2060:
! 2061: Centre_Dialog $student default
! 2062: }
! 2063:
! 2064: ###########################################################
! 2065: # selectStudentPreview
! 2066: ###########################################################
! 2067: ###########################################################
! 2068: ###########################################################
! 2069: proc selectStudentPreview { student followupCommand} {
! 2070: global gStudentSelection
! 2071: destroy $student
! 2072: if { $gStudentSelection(type) == "Specific" } {
! 2073: if {$gStudentSelection(studentNumber) == ""} {
! 2074: fillInStudent gStudentSelection(studentName) \
! 2075: gStudentSelection(studentNumber) 1
! 2076: } else {
! 2077: fillInStudent gStudentSelection(studentName) \
! 2078: gStudentSelection(studentNumber) 0
! 2079: }
! 2080: if {$gStudentSelection(studentNumber) == ""} { return }
! 2081: }
! 2082: removeWindowEntry SelectStudent
! 2083: $followupCommand
! 2084: }
! 2085:
! 2086: ###########################################################
! 2087: # createPreviewWindow
! 2088: ###########################################################
! 2089: ###########################################################
! 2090: ###########################################################
! 2091: proc createPreviewWindow {} {
! 2092: global gPreviewMode gPreviewText gPrefs gSetNumberText gStudentSelection
! 2093: global gWindowMenu gNumberParsedText gNumber
! 2094: global gLoadHeaderSet gHeaderQCount gControlDates
! 2095:
! 2096: if { ![winfo exists .preview] } {
! 2097:
! 2098: set previewWindow [toplevel .preview]
! 2099: $gWindowMenu add command -label "Preview" -command \
! 2100: "capaRaise $previewWindow"
! 2101: wm title $previewWindow "Preview"
! 2102: addFindList -1
! 2103:
! 2104: set windowFrame [frame $previewWindow.windowFrame]
! 2105: set buttonFrame [frame $previewWindow.buttonFrame]
! 2106:
! 2107: pack $windowFrame $buttonFrame -side bottom
! 2108: pack configure $windowFrame -expand true -fill both
! 2109: pack configure $buttonFrame -anchor e
! 2110:
! 2111: scrollbar $windowFrame.scroll -orient vertical -command \
! 2112: "$windowFrame.text yview"
! 2113: set gPreviewText [text $windowFrame.text -yscrollcommand \
! 2114: "$windowFrame.scroll set" -wrap char -height 40]
! 2115:
! 2116: pack $windowFrame.scroll $gPreviewText -side left -expand 0
! 2117: pack configure $windowFrame.scroll -expand 0 -fill y
! 2118: pack configure $gPreviewText -expand true -fill both
! 2119:
! 2120: button $buttonFrame.ok -text Dismiss -command "destroy $previewWindow
! 2121: removeWindowEntry Preview
! 2122: removeFindList -1"
! 2123: bind $previewWindow <Destroy> "removeWindowEntry Preview
! 2124: removeFindList -1"
! 2125: button $buttonFrame.save -text "Save Output" -command "saveText $gPreviewText"
! 2126: button $buttonFrame.stop -text "Stop Parser" -command "stopParser"
! 2127: button $buttonFrame.print -text "Print Output" -command "printText $gPreviewText"
! 2128: pack $buttonFrame.print $buttonFrame.save $buttonFrame.stop \
! 2129: $buttonFrame.ok -side left
! 2130:
! 2131: Centre_Dialog $previewWindow default
! 2132: wm withdraw $previewWindow
! 2133: update idletasks
! 2134: set win_width [winfo reqwidth $previewWindow]
! 2135: set win_height [winfo reqheight $previewWindow]
! 2136: wm geometry $previewWindow +[expr [winfo rootx $previewWindow] - \
! 2137: 100]+[winfo rooty $previewWindow]
! 2138: wm deiconify $previewWindow
! 2139: update
! 2140: } else {
! 2141: set previewWindow .preview
! 2142: $gPreviewText delete 0.0 end
! 2143: update
! 2144: }
! 2145:
! 2146: switch $gPrefs(info) {
! 2147: Problem { set type 0 }
! 2148: ProblemAnswer { set type 1 }
! 2149: Answer { set type 2 }
! 2150: }
! 2151: grab .preview
! 2152: if { [catch {
! 2153: switch $gPreviewMode {
! 2154: Enscript
! 2155: {
! 2156: set numberParsed [enscriptParse $type $gSetNumberText \
! 2157: $gStudentSelection(type) $gStudentSelection(random) \
! 2158: $gStudentSelection(studentNumber) \
! 2159: $gStudentSelection(studentName) gPreviewText]
! 2160: }
! 2161: TeX
! 2162: {
! 2163: set numberParsed [texParse $type $gSetNumberText \
! 2164: $gStudentSelection(type) $gStudentSelection(random) \
! 2165: $gStudentSelection(studentNumber) \
! 2166: $gStudentSelection(studentName) gPreviewText]
! 2167: }
! 2168: Web
! 2169: {
! 2170: set numberParsed [webParse $type $gSetNumberText \
! 2171: $gStudentSelection(type) $gStudentSelection(random) \
! 2172: $gStudentSelection(studentNumber) \
! 2173: $gStudentSelection(studentName) gPreviewText]
! 2174: }
! 2175: } }]} { return }
! 2176: grab release .preview
! 2177: if { $numberParsed == -1 } {
! 2178: destroy $previewWindow
! 2179: removeWindowEntry Preview
! 2180: return
! 2181: }
! 2182: checkHeader $numberParsed
! 2183: $gPreviewText tag configure problem
! 2184: $gPreviewText tag configure answer
! 2185: capaRaise $previewWindow
! 2186:
! 2187: set gNumberParsedText $numberParsed
! 2188: showParseErrors
! 2189: }
! 2190:
! 2191: ###########################################################
! 2192: ###########################################################
! 2193: ###########################################################
! 2194: ###########################################################
! 2195: proc showParseErrors {} {
! 2196: global gParseErrorsText gWindowMenu
! 2197:
! 2198: set parseErrors [getParseErrors]
! 2199:
! 2200: if { $parseErrors != "" } {
! 2201:
! 2202: if { ![winfo exists .parseErrors] } {
! 2203:
! 2204: set parseErrorsWindow [toplevel .parseErrors]
! 2205: $gWindowMenu add command -label "ParseErrors" -command "capaRaise \
! 2206: $parseErrorsWindow"
! 2207: wm title $parseErrorsWindow "Parse Errors"
! 2208: addFindList -2
! 2209:
! 2210: set windowFrame [frame $parseErrorsWindow.windowFrame]
! 2211: set buttonFrame [frame $parseErrorsWindow.buttonFrame]
! 2212:
! 2213: pack $windowFrame $buttonFrame -side bottom
! 2214: pack configure $windowFrame -expand true -fill both
! 2215: pack configure $buttonFrame -anchor e
! 2216:
! 2217: scrollbar $windowFrame.scroll -orient vertical -command \
! 2218: "$windowFrame.text yview"
! 2219: set gParseErrorsText [text $windowFrame.text -yscrollcommand \
! 2220: "$windowFrame.scroll set" -wrap char -height 40]
! 2221:
! 2222: pack $windowFrame.scroll $gParseErrorsText -side left -expand 0
! 2223: pack configure $windowFrame.scroll -expand 0 -fill y
! 2224: pack configure $gParseErrorsText -expand true -fill both
! 2225:
! 2226: button $buttonFrame.ok -text Dismiss -command \
! 2227: "destroy $parseErrorsWindow
! 2228: removeWindowEntry ParseErrors
! 2229: removeFindList -2"
! 2230: bind $parseErrorsWindow <Destroy> "removeWindowEntry ParseErrors
! 2231: removeFindList -2"
! 2232: button $buttonFrame.save -text "Save Output" \
! 2233: -command "saveText $gParseErrorsText"
! 2234: button $buttonFrame.print -text "Print Output" \
! 2235: -command "printText $gParseErrorsText"
! 2236: pack $buttonFrame.print $buttonFrame.save \
! 2237: $buttonFrame.ok -side left
! 2238:
! 2239: Centre_Dialog $parseErrorsWindow default
! 2240: update
! 2241: capaRaise $parseErrorsWindow
! 2242: } else {
! 2243: $gParseErrorsText delete 0.0 end
! 2244: capaRaise .parseErrors
! 2245: }
! 2246:
! 2247: $gParseErrorsText insert end $parseErrors
! 2248: } else {
! 2249: if { [winfo exists .parseErrors] } { $gParseErrorsText delete 0.0 end }
! 2250: }
! 2251:
! 2252: return $parseErrors
! 2253: }
! 2254:
! 2255: ###########################################################
! 2256: # printText
! 2257: ###########################################################
! 2258: # prints the contents of the text window, creates a temp file named
! 2259: # quiztemp.txt
! 2260: ###########################################################
! 2261: # Arguments: window (name of text window to print the contents of.
! 2262: # Returns : nothing
! 2263: # Globals :
! 2264: ###########################################################
! 2265: proc printText { window } {
! 2266:
! 2267: if { ![winfo exists $window] } {
! 2268: return
! 2269: }
! 2270: set lprCommand [getLprCommand quiztemp.txt]
! 2271:
! 2272: if {$lprCommand == "Cancel"} {
! 2273: return
! 2274: }
! 2275:
! 2276: set fileId [open "quiztemp.txt" w]
! 2277: puts -nonewline $fileId "[ $window get 0.0 end ]"
! 2278: close $fileId
! 2279:
! 2280: set errorMsg ""
! 2281: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
! 2282:
! 2283: if { $error == 1 } {
! 2284: displayError "An error occurred while printing: $errorMsg"
! 2285: } else {
! 2286: displayMessage "Print job sent to the printer.\n $output"
! 2287: }
! 2288: exec rm -f quiztemp.txt
! 2289: }
! 2290:
! 2291: ###########################################################
! 2292: # saveText
! 2293: ###########################################################
! 2294: # saves the contents of the text window
! 2295: ###########################################################
! 2296: # Arguments: window (name of text window to save the contents of.
! 2297: # saveAs (whether to ask to save)
! 2298: # refNum (if supplied reference file unique number
! 2299: # that is being saved)
! 2300: # Returns : name of the file saved
! 2301: # Globals :
! 2302: ###########################################################
! 2303: proc saveText { window {saveAs 1} {refNum 0} } {
! 2304: global gWindowMenu gRefFile gRefChanged gCapaConfig gFile
! 2305:
! 2306: if { ![winfo exists $window] } {return}
! 2307: if { $refNum } {
! 2308: if {$saveAs} {
! 2309: set dir [file dirname $gRefFile($refNum)]
! 2310: set file ""
! 2311: } else {
! 2312: set dir [file dirname $gRefFile($refNum)]
! 2313: set file [file tail $gRefFile($refNum)]
! 2314: }
! 2315: } else { set dir [ set file "" ] }
! 2316: # if { $dir == "" || $dir == "."} { set dir [pwd] }
! 2317: if { $file == "" } {
! 2318: set file [tk_getSaveFile -title "Enter the name to Save As" \
! 2319: -initialdir "$dir" ]
! 2320: if { $file == "" } {
! 2321: displayError "File not saved"
! 2322: return
! 2323: }
! 2324: } else {
! 2325: set file [file join $dir $file]
! 2326: }
! 2327:
! 2328: if { $refNum } {
! 2329: catch {removeWindowEntry "Reference $gRefFile($refNum)*" }
! 2330: catch {removeFindList $refNum}
! 2331: set gRefFile($refNum) $file
! 2332: addFindList $refNum
! 2333: wm title [winfo toplevel $window] $file
! 2334: $gWindowMenu add command -label "Reference $file" \
! 2335: -command "capaRaise [winfo toplevel $window]"
! 2336: if { !$saveAs } {
! 2337: if { ([array name gCapaConfig quizzerBackupRef] == "") ||
! 2338: ($gCapaConfig(quizzerBackupRef)!="off") } {
! 2339: if { [catch {file copy -force $file $file.bak} ] } {
! 2340: displayError "Unable to create backup for $file"
! 2341: }
! 2342: }
! 2343: }
! 2344: }
! 2345: set fileId [open $file w]
! 2346: puts -nonewline $fileId [$window get 0.0 end]
! 2347: close $fileId
! 2348: if { $refNum } { set gRefChanged($refNum) 0 }
! 2349: if { ([file tail $file] == "capa.config") && ($dir == [file dirname $gFile]) } {
! 2350: if { [makeSure "Reread capa.config settings into Quizzer?"] != "Cancel" } {
! 2351: rereadCapaConfig
! 2352: }
! 2353: }
! 2354:
! 2355: return $file
! 2356: }
! 2357:
! 2358: ###########################################################
! 2359: # deleteFile
! 2360: ###########################################################
! 2361: ###########################################################
! 2362: ###########################################################
! 2363: proc deleteFile { which } {
! 2364: global gFile gRefFile
! 2365: if { $which } { set file $gRefFile($which) } else { set file $gFile }
! 2366: if { [makeSure "Do you wish to Delete $file"] == "Cancel" } { return }
! 2367: if { $which } { closeRefFile $which 1 0 } else { closeDocument 1 0 }
! 2368: file delete -- $file
! 2369: }
! 2370:
! 2371: ###########################################################
! 2372: ###########################################################
! 2373: ###########################################################
! 2374: ###########################################################
! 2375: proc rereadCapaConfig { } {
! 2376: global gCapaConfig
! 2377: set printer_option $gCapaConfig(printer_option)
! 2378: unset gCapaConfig(printer_option)
! 2379: set error [parseCapaConfig]
! 2380: if { $error != "OK" } {
! 2381: displayError "Invalid capa.config file"
! 2382: set gCapaConfig(printer_option) $printer_option
! 2383: }
! 2384: updateColors
! 2385: }
! 2386:
! 2387: ###########################################################
! 2388: ###########################################################
! 2389: ###########################################################
! 2390: ###########################################################
! 2391: proc pickCapaConfig { } {
! 2392: set error NOTOK
! 2393: while { $error != "OK" } {
! 2394: set file [tk_getOpenFile -title "Pick a capa.config file" \
! 2395: -filetypes { { {CAPA configuration} {capa.config} } \
! 2396: { {All Files} {*} } }]
! 2397: if { $file == "" } { break }
! 2398: set oldDir [pwd]
! 2399: cd [file dirname $file]
! 2400: set error [parseCapaConfig]
! 2401: if { $error != "OK" } { displayError "Invalid capa.config file"; cd $oldDir }
! 2402: }
! 2403: }
! 2404:
! 2405: ###########################################################
! 2406: # openDocument
! 2407: ###########################################################
! 2408: ###########################################################
! 2409: ###########################################################
! 2410: proc openDocument {} {
! 2411: global gFile gTextWindow gSetNumberText gPrefs gChanged gQuizTemp gUndo
! 2412:
! 2413: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
! 2414: if { ![catch {set gTextWindow}] } {
! 2415: if { [winfo exists $gTextWindow] } { return }
! 2416: }
! 2417:
! 2418: # the event generation is because of a bug in tk_getOpenFile
! 2419: # After double cliking the mouse Button one is thought to be left down.
! 2420: # this only seems to happen when a toplevel window is created
! 2421: # after getting the file
! 2422: set gFile [tk_getOpenFile -filetypes \
! 2423: { { {Quizzer} {"*.qz"} } { {All Files} {"*"} } } \
! 2424: -title "Select the proper file" -initialdir "[pwd]" ]
! 2425: # event generate .main <ButtonRelease-1>
! 2426: if { $gFile == "" } { return }
! 2427: if { [file isdirectory $gFile] } {
! 2428: displayError "You attempted to open $gFile which is a directory not a file."
! 2429: return
! 2430: }
! 2431:
! 2432: set error [ catch {set fileId [open $gFile r] } ]
! 2433:
! 2434: if { $error } {
! 2435: displayError "Unable to read $gFile"
! 2436: return
! 2437: }
! 2438:
! 2439: set oldDir [pwd]
! 2440:
! 2441: cd [file dirname $gFile]
! 2442:
! 2443: set tempfiles ""
! 2444: catch {set tempfiles [glob quiztemp.*]}
! 2445: if { $tempfiles == "" } {
! 2446: set gQuizTemp true
! 2447: }
! 2448: foreach quiztempFile $tempfiles {
! 2449: if { ! ( [file isfile $quiztempFile] &&
! 2450: [file writable $quiztempFile] ) } {
! 2451: if { [makeSure "There are old quiztemp files in this directory that can not be overwritten. If you continue editing you will be unable to print or Create .dvi. You can still preview and save."] == "Cancel" } {
! 2452: cd $oldDir
! 2453: set gQuizTemp true
! 2454: return
! 2455: } else {
! 2456: set gQuizTemp false
! 2457: break
! 2458: }
! 2459: }
! 2460: }
! 2461:
! 2462: if { $tempfiles == "" } {
! 2463: if { ! [file writable $gFile] } {
! 2464: if { [makeSure "You do not have permission to write to this directory. If you continue editing you will be unable to save, print, or create .dvi"] == "Cancel" } {
! 2465: cd $oldDir
! 2466: set gQuizTemp true
! 2467: return
! 2468: } else {
! 2469: set gQuizTemp false
! 2470: }
! 2471: }
! 2472: }
! 2473:
! 2474: set error [parseCapaConfig]
! 2475:
! 2476: if { $error != "OK" } {
! 2477: cd $oldDir
! 2478: set gQuizTemp true
! 2479: return
! 2480: }
! 2481:
! 2482: createEditingWindow 0
! 2483: $gTextWindow delete 0.0 end
! 2484: $gTextWindow insert 0.0 [read $fileId [file size $gFile]]
! 2485: $gTextWindow delete end-1c
! 2486:
! 2487: rename $gTextWindow .$gTextWindow
! 2488: trackChanges $gTextWindow 0
! 2489: set gUndo(0) 0
! 2490: set gUndo(0.cur) 0
! 2491:
! 2492: createImportLinks 0 0.0 end
! 2493: focus -force $gTextWindow
! 2494: set coord [$gTextWindow bbox 0.0]
! 2495: event generate $gTextWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
! 2496: event generate $gTextWindow <ButtonRelease-1>
! 2497: update
! 2498: close $fileId
! 2499:
! 2500: updatePrefsWindow
! 2501:
! 2502: set gSetNumberText [string range [file rootname [file tail $gFile]] 3 end ]
! 2503: checkIfValidFilename
! 2504: set gChanged 0
! 2505: }
! 2506:
! 2507: ###########################################################
! 2508: # includeReferenceFile
! 2509: ###########################################################
! 2510: ###########################################################
! 2511: ###########################################################
! 2512: proc includeReferenceFile { file num window } {
! 2513: set index [$window index "file.$num.first linestart"]
! 2514: if { ![file readable $file] } {
! 2515: displayError "Unable to read file $file"
! 2516: return
! 2517: }
! 2518: set impline [$window get $index "$index lineend"]
! 2519: set fileId [open $file r]
! 2520: $window insert $index /
! 2521: update idletasks
! 2522: if { [$window index end] == [$window index "$index + 1 lines"] } {
! 2523: $window insert "$index + 1 lines" "\n[read $fileId [file size $file]]"
! 2524: } else {
! 2525: $window insert "$index + 1 lines" [read $fileId [file size $file]]
! 2526: }
! 2527: close $fileId
! 2528: }
! 2529:
! 2530: ###########################################################
! 2531: # impMenuSaveAs
! 2532: ###########################################################
! 2533: ###########################################################
! 2534: ###########################################################
! 2535: proc impMenuSaveAs { file num window } {
! 2536: set index [$window index "file.$num.first linestart"]
! 2537: if { ![file readable $file] } {
! 2538: displayError "Unable to read file $file"
! 2539: return
! 2540: }
! 2541: set dir [file dirname $file]
! 2542: if { $dir != "." } {
! 2543: set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir $dir]
! 2544: } else {
! 2545: set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir [pwd]]
! 2546: }
! 2547: if { $dest == "" } {
! 2548: displayError "File not saved"
! 2549: return
! 2550: }
! 2551: if { [catch {file copy -force -- $file $dest} errorMsg ] } {
! 2552: displayError "Unable to copy $file to $dest: $errorMsg"
! 2553: return
! 2554: }
! 2555: $window delete $index "$index lineend"
! 2556: if { $dir != "." } {
! 2557: $window insert $index "/IMP \"$dest\""
! 2558: } else {
! 2559: $window insert $index "/IMP \"[file tail $dest]\""
! 2560: }
! 2561: }
! 2562:
! 2563: ###########################################################
! 2564: # createImpMenu
! 2565: ###########################################################
! 2566: ###########################################################
! 2567: ###########################################################
! 2568: proc createImpMenu { file num window } {
! 2569: set menuFrame [menu .impmenu -tearoff 0 -type tearoff ]
! 2570:
! 2571: # wm title $menuFrame "Quizzer"
! 2572: wm overrideredirect $menuFrame 1
! 2573: wm positionfrom $menuFrame program
! 2574: $menuFrame post [winfo pointerx .] [winfo pointery .]
! 2575: $menuFrame add command -label "Open" -command "openReferenceFile $file"
! 2576: $menuFrame add command -label "Include" -command \
! 2577: "includeReferenceFile $file $num $window"
! 2578: $menuFrame add command -label "saveAs" -command "impMenuSaveAs $file $num $window"
! 2579: grab $menuFrame
! 2580: bind all <ButtonRelease> "grab release $menuFrame;destroy $menuFrame"
! 2581: }
! 2582:
! 2583: ###########################################################
! 2584: # registerCreateImportLinks
! 2585: ###########################################################
! 2586: ###########################################################
! 2587: ###########################################################
! 2588: proc registerCreateImportLinks { num start end} {
! 2589: global gDoCreateImportLinks gCreateImportLinks
! 2590:
! 2591: if { $gCreateImportLinks && !$gDoCreateImportLinks($num) } {
! 2592: after idle "createImportLinks $num $start $end"
! 2593: set gDoCreateImportLinks($num) 1
! 2594: }
! 2595: }
! 2596:
! 2597: ###########################################################
! 2598: # createImportLinks
! 2599: ###########################################################
! 2600: ###########################################################
! 2601: ###########################################################
! 2602: proc createImportLinks { num start end } {
! 2603: global gTextWindow gUniqueNumber gDoCreateImportLinks gRefText gCapaConfig
! 2604:
! 2605: set gDoCreateImportLinks($num) 0
! 2606: if { $num } { set window $gRefText($num) } else { set window $gTextWindow }
! 2607: if { ![winfo exists $window] } { return }
! 2608: set end [$window index $end]
! 2609: set start [$window index $start]
! 2610: set lastline [lindex [split $end .] 0]
! 2611: set startline [lindex [split $start .] 0]
! 2612: foreach tag [$window tag names] {
! 2613: if { [regexp {file\..+} $tag ] } {
! 2614: if { [$window tag nextrange $tag "$start linestart" "$end lineend"] != "" } {
! 2615: $window tag delete $tag
! 2616: }
! 2617: }
! 2618: }
! 2619: for { set i $startline } { $i <= $lastline } { incr i } {
! 2620: set aline [$window get $i.0 "$i.0 lineend"]
! 2621: if { [regexp -nocase {(^[ ]*)(//.*)} $aline matchVar match1 match2] } {
! 2622: set tagnum [incr gUniqueNumber]
! 2623: set start [string length $match1]
! 2624: set end [expr $start + [string length $match2]]
! 2625: $window tag add file.$tagnum $i.$start $i.$end
! 2626: $window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
! 2627: } elseif { [regexp -nocase {(^.*/let.*[ ]+)(//.*)} $aline matchVar \
! 2628: match1 match2] } {
! 2629: set tagnum [incr gUniqueNumber]
! 2630: set start [string length $match1]
! 2631: set end [expr $start + [string length $match2]]
! 2632: $window tag add file.$tagnum $i.$start $i.$end
! 2633: $window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
! 2634: }
! 2635: if { [regexp -nocase "(.*/imp +)(\"\[^\"\]+\")(.*)" $aline matchVar \
! 2636: match1 match2 match3] } {
! 2637: set tagnum [incr gUniqueNumber]
! 2638: set start [string length $match1]
! 2639: set end [expr $start + [string length $match2]]
! 2640: $window tag add file.$tagnum $i.$start $i.$end
! 2641: $window tag configure file.$tagnum -foreground $gCapaConfig(IMP_color)
! 2642: $window tag bind file.$tagnum <Double-ButtonPress> \
! 2643: "eval openReferenceFile $match2"
! 2644: $window tag bind file.$tagnum <ButtonPress-3> \
! 2645: "eval createImpMenu $match2 $tagnum $window"
! 2646: }
! 2647: }
! 2648: }
! 2649:
! 2650: ###########################################################
! 2651: # isReferenceFileOpen
! 2652: ###########################################################
! 2653: ###########################################################
! 2654: ###########################################################
! 2655: proc isReferenceFileOpen { file } {
! 2656: global gWindowMenu
! 2657: # if { [catch {set index [$gWindowMenu index "Reference $file"]} ] } { return "" }
! 2658: set last [$gWindowMenu index end]
! 2659: # puts $last
! 2660: for { set index 1 } { $index <= $last } { incr index } {
! 2661: # puts $index
! 2662: catch {set entry [$gWindowMenu entrycget $index -label]}
! 2663: if { "Reference" == [set entryfile [lindex $entry 0]] } {
! 2664: set entryfile [lindex $entry 1]
! 2665: }
! 2666: # puts $entryfile
! 2667: if { [catch {file stat $entryfile a1}] } { puts skipped;continue }
! 2668: file stat $file a2
! 2669: # puts "$a2(ino) == $a1(ino)"
! 2670: if { $a2(ino) == $a1(ino) } {
! 2671: # puts "seems right"
! 2672: return [lindex [$gWindowMenu entrycget $index -command] 1]
! 2673: }
! 2674: }
! 2675: # puts "failed $index"
! 2676: return ""
! 2677: # puts $index
! 2678: # puts [$gWindowMenu entrycget $index -command]
! 2679: # return [lindex [$gWindowMenu entrycget $index -command] 1]
! 2680: }
! 2681:
! 2682: ###########################################################
! 2683: # newReferenceFile
! 2684: ###########################################################
! 2685: ###########################################################
! 2686: ###########################################################
! 2687: proc newReferenceFile { } {
! 2688: global gDir
! 2689: # if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
! 2690: set file [tk_getSaveFile -title "Enter the name of the New reference file" \
! 2691: -initialdir "$gDir(reference)" ]
! 2692: event generate .main <ButtonRelease-1>
! 2693: if { $file == "" } { return }
! 2694: set gDir(reference) [file dirname $file]
! 2695: if { [file isdirectory $file] } {
! 2696: displayError "You attempted to create $file which is already a directory."
! 2697: return
! 2698: }
! 2699: openReferenceFile $file 1
! 2700: }
! 2701:
! 2702: ###########################################################
! 2703: # openReferenceFile
! 2704: ###########################################################
! 2705: ###########################################################
! 2706: ###########################################################
! 2707: proc openReferenceFile { {file ""} {new 0}} {
! 2708: global gUniqueNumber gWindowMenu gDir
! 2709:
! 2710: set num [incr gUniqueNumber]
! 2711: global gRefCurLine gRefLine gRefText gRefChanged gRefFile gRefClosed \
! 2712: gUndo gRefChangedLast
! 2713: # the event generation is because of a bug in tk_getOpenFile
! 2714: # After double cliking the mouse Button one is thought to be left down.
! 2715: # this only seems to happen when a toplevel window is created
! 2716: # after getting the file
! 2717: if { $file == "" } {
! 2718: # if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
! 2719: set file [tk_getOpenFile -filetypes \
! 2720: { { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
! 2721: -title "Select the proper file" \
! 2722: -initialdir "$gDir(reference)" ]
! 2723: event generate .main <ButtonRelease-1>
! 2724: if { $file == "" } { return }
! 2725: set gDir(reference) [file dirname $file]
! 2726:
! 2727: if { [file isdirectory $file] } {
! 2728: displayError "You attempted to open $file which is a directory not a file."
! 2729: return
! 2730: }
! 2731: } else {
! 2732: if { !$new } {
! 2733: if { [set window [isReferenceFileOpen $file] ] != "" } {
! 2734: capaRaise $window
! 2735: return
! 2736: }
! 2737: # specifically opening the capa.config file
! 2738: if { $file == "capa.config" } {
! 2739: global gTextWindow gFile
! 2740: if { [catch {set gTextWindow}] } {
! 2741: set file [tk_getOpenFile -filetypes \
! 2742: {{{Capa.config file} {"capa.config"}}
! 2743: { {All Files} {"*"} } } \
! 2744: -title "Select the proper file" \
! 2745: -initialdir "$gDir(reference)" ]
! 2746: if { $file == "" } { return }
! 2747: } else {
! 2748: set file [file join [file dirname $gFile] capa.config]
! 2749: }
! 2750: } else {
! 2751: if { ![file isfile $file] && ![file readable $file] } {
! 2752: displayError "Unable to find $file"
! 2753: return
! 2754: }
! 2755: if { [file isdirectory $file] } {
! 2756: displayError "You attempted to open $file which is a directory not a file."
! 2757: return
! 2758: }
! 2759: }
! 2760: }
! 2761: }
! 2762:
! 2763: set gRefFile($num) $file
! 2764: set referenceFile [toplevel .reference$num]
! 2765: wm title $referenceFile "$file"
! 2766:
! 2767: $gWindowMenu add command -label "Reference $file" \
! 2768: -command "capaRaise $referenceFile"
! 2769:
! 2770: set menuFrame [frame $referenceFile.menu -borderwidth 3 -relief raised]
! 2771: set lineFrame [frame $referenceFile.lineFrame]
! 2772: set windowFrame [frame $referenceFile.windowFrame]
! 2773: pack $menuFrame $lineFrame $windowFrame
! 2774: pack configure $windowFrame -expand 1 -fill both
! 2775: pack configure $menuFrame -fill x
! 2776:
! 2777: label $lineFrame.msg -text "Current Line:"
! 2778: label $lineFrame.current -textvariable gRefCurLine($num)
! 2779: entry $lineFrame.line -width 8 -textvariable gRefLine($num)
! 2780: bind $lineFrame.line <KeyPress-Return> "+gotoRefLine $num"
! 2781: button $lineFrame.button -text "Goto" -command \
! 2782: "gotoRefLine $num"
! 2783: pack $lineFrame.msg $lineFrame.current $lineFrame.line \
! 2784: $lineFrame.button -side left
! 2785:
! 2786: set infoFrame [frame $windowFrame.infoFrame]
! 2787: set textFrame [frame $windowFrame.textFrame]
! 2788: pack $infoFrame $textFrame -side top
! 2789: pack configure $textFrame -expand 1 -fill both
! 2790:
! 2791: scrollbar $textFrame.scroll -orient vertical -command \
! 2792: "$textFrame.text yview"
! 2793: set textWindow [text $textFrame.text -yscrollcommand \
! 2794: "$textFrame.scroll set" -wrap char]
! 2795: pack $textFrame.scroll $textWindow -side left -expand 0
! 2796: pack configure $textFrame.scroll -expand 0 -fill y
! 2797: pack configure $textWindow -expand true -fill both
! 2798:
! 2799: # label $infoFrame.label -textvariable gRefFile($num)
! 2800: # pack $infoFrame.label -side left
! 2801:
! 2802: menubutton $menuFrame.file -text File -menu $menuFrame.file.m
! 2803: menubutton $menuFrame.edit -text Edit -menu $menuFrame.edit.m
! 2804: pack $menuFrame.file $menuFrame.edit -side left
! 2805:
! 2806: set fileMenu [ menu $menuFrame.file.m ]
! 2807: set editMenu [ menu $menuFrame.edit.m ]
! 2808:
! 2809: $fileMenu add command -label Save -command \
! 2810: "saveText $textWindow 0 $num" -accelerator "Alt+s"
! 2811: bind $referenceFile <Alt-s> \
! 2812: "saveText $textWindow 0 $num"
! 2813: $fileMenu add command -label "Save As" -command \
! 2814: "saveText $textWindow 1 $num" -accelerator "Alt+S"
! 2815: bind $referenceFile <Alt-Shift-s> "saveText $textWindow 1 $num"
! 2816: $fileMenu add command -label Delete -command "deleteFile $num"
! 2817: $fileMenu add command -label Print -command "printText $textWindow"
! 2818: $fileMenu add command -label Close -command "closeRefFile $num" \
! 2819: -accelerator "Alt+w"
! 2820: bind $referenceFile <Alt-w> "closeRefFile $num"
! 2821: # bind $referenceFile <Destroy> "closeRefFile $num 1"
! 2822: wm protocol $referenceFile WM_DELETE_WINDOW "closeRefFile $num 1"
! 2823: $editMenu add command -label "Cut" -command "tk_textCut $textWindow" \
! 2824: -accelerator "Alt+x"
! 2825: bind $referenceFile <Alt-x> "tk_textCut $textWindow"
! 2826: $editMenu add command -label "Copy" -command "tk_textCopy $textWindow" \
! 2827: -accelerator "Alt+c"
! 2828: bind $referenceFile <Alt-c> "tk_textCopy $textWindow"
! 2829: $editMenu add command -label "Paste" -command "tk_textPaste $textWindow" \
! 2830: -accelerator "Alt+v"
! 2831: bind $referenceFile <Alt-v> "tk_textPaste $textWindow"
! 2832: $editMenu add command -label "Select All " -command \
! 2833: "selectAll $num " -accelerator "Alt+a"
! 2834: bind $referenceFile <Alt-a> "selectAll $num"
! 2835: $editMenu add separator
! 2836: $editMenu add command -label "Undo" -command "undo $num" \
! 2837: -accelerator "Alt+u"
! 2838: bind $referenceFile <Alt-u> "undo $num"
! 2839: # $editMenu add command -label "Redo" -command "redo $num"
! 2840: $editMenu add separator
! 2841: $editMenu add command -label "Find" -command "createFindWindow $num" \
! 2842: -accelerator "Alt+f"
! 2843:
! 2844:
! 2845: if { !$new } {
! 2846: set fileId [open $file r]
! 2847: $textWindow insert 0.0 [read $fileId [file size $file]]
! 2848: $textWindow delete end-1c
! 2849: close $fileId
! 2850: }
! 2851:
! 2852: set gRefText($num) $textWindow
! 2853: rename $textWindow .$textWindow
! 2854: trackChanges $textWindow $num
! 2855: set gUndo($num) 0
! 2856: set gUndo($num.cur) 0
! 2857:
! 2858: createImportLinks $num 0.0 end
! 2859: focus -force $textWindow
! 2860: # update
! 2861: set coord [$textWindow bbox 0.0]
! 2862: event generate $textWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
! 2863: # update
! 2864: event generate $textWindow <ButtonRelease-1>
! 2865: # update
! 2866: # capaRaise $referenceFile
! 2867: after 1 "catch \{focus $textWindow;raise $referenceFile\}"
! 2868: selection clear
! 2869: #order is important here since gRefChanged has a trace on it the references
! 2870: #gRefChangedLast
! 2871: set gRefChangedLast($num) 0
! 2872: set gRefChanged($num) 0
! 2873: set gRefClosed($num) 0
! 2874: addFindList $num
! 2875: }
! 2876:
! 2877: ###########################################################
! 2878: ###########################################################
! 2879: ###########################################################
! 2880: ###########################################################
! 2881: proc trackChanges { procName num } {
! 2882: eval "proc $procName args {
! 2883: global gUndo gRefChanged gChanged
! 2884: if {\[regexp {^(ins|del).*} \[lindex \$args 0\]\]} {
! 2885: #puts \"\$args\"
! 2886: if { \$gUndo($num.cur) != \$gUndo($num) } {
! 2887: set i \[expr \$gUndo($num.cur) + 1 \]
! 2888: while { \[ info exists gUndo($num.\$i) \] } {
! 2889: unset gUndo($num.\$i)
! 2890: incr i
! 2891: }
! 2892: set gUndo($num) \$gUndo($num.cur)
! 2893: }
! 2894: set gUndo($num.cur) \$gUndo($num)
! 2895: set insertindex \[.$procName index \[lindex \$args 1 \] \]
! 2896: set numChange \[set gUndo($num.cur) \[incr gUndo($num) \] \]
! 2897: if { $num == 0 } { set gChanged 1 } else { set gRefChanged($num) 1 }
! 2898: }
! 2899: if {\[regexp {^(ins).*} \[lindex \$args 0\]\]} {
! 2900: set index2 \$insertindex+\[string length \[lindex \$args 2 \] \]chars
! 2901: set gUndo($num.\$numChange) \"delete \$insertindex \$index2 \"
! 2902: if {\[regexp {.*\[\"/\].*} \$args\] || \
! 2903: \[regexp {.*\[\"/\].*} \[.$procName get \"\$insertindex linestart\" \"\$index2 lineend\"\]\]} {
! 2904: registerCreateImportLinks $num \$insertindex \$index2
! 2905: }
! 2906: } elseif {\[regexp {^(del).*} \[lindex \$args 0\]\]} {
! 2907: if { \[catch { set insertindex2 \[.$procName index \
! 2908: \[lindex \$args 2 \] \] } \] } {
! 2909: set chars \[ .$procName get \$insertindex \]
! 2910: set insertindex2 \$insertindex+1c
! 2911: } else {
! 2912: set chars \[ .$procName get \$insertindex \$insertindex2 \]
! 2913: }
! 2914: set gUndo($num.\$numChange) \"insert \$insertindex \[list \$chars\] \"
! 2915: if {\[regexp \{.*\[\"/\].*\} \$chars\] || \
! 2916: \[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} {
! 2917: registerCreateImportLinks $num \$insertindex \$insertindex2
! 2918: }
! 2919: }
! 2920: set result \[uplevel .$procName \$args\]
! 2921: updateLocation $num
! 2922: return \$result
! 2923: }"
! 2924: }
! 2925:
! 2926: ###########################################################
! 2927: ###########################################################
! 2928: ###########################################################
! 2929: ###########################################################
! 2930: proc undo { num } {
! 2931: global gUndo gRefText gTextWindow
! 2932: if { $gUndo($num.cur) == 0 } { return }
! 2933: set undoInfo $gUndo($num.$gUndo($num.cur))
! 2934: if { [regexp {.*[\"/].*} $undoInfo] } {
! 2935: registerCreateImportLinks $num [lindex $undoInfo 1] end
! 2936: }
! 2937: if { [regexp {.*delete.*} $undoInfo] } {
! 2938: registerCreateImportLinks $num [lindex $undoInfo 1] [lindex $undoInfo 2]
! 2939: }
! 2940: if { $num == 0 } {
! 2941: if {[catch {eval ".$gTextWindow $gUndo($num.$gUndo($num.cur))"}]} { return }
! 2942: } else {
! 2943: if {[catch {eval ".$gRefText($num) $gUndo($num.$gUndo($num.cur))"}]} { return }
! 2944: }
! 2945: incr gUndo($num.cur) -1
! 2946: }
! 2947:
! 2948: ###########################################################
! 2949: ###########################################################
! 2950: ###########################################################
! 2951: ###########################################################
! 2952: proc redo { num } {
! 2953: global gUndo gRefText
! 2954: }
! 2955:
! 2956: ###########################################################
! 2957: ###########################################################
! 2958: ###########################################################
! 2959: ###########################################################
! 2960: proc gotoRefLine { number } {
! 2961: global gRefLine gRefText
! 2962: if { [catch {set gRefText($number)}] } { return }
! 2963: if { ![winfo exists $gRefText($number)] } { return }
! 2964:
! 2965: if { $gRefLine($number) == "" } {
! 2966: return
! 2967: } else {
! 2968: $gRefText($number) mark set insert $gRefLine($number).0
! 2969: catch {$gRefText($number) tag remove sel sel.first sel.last}
! 2970: $gRefText($number) tag add sel "insert linestart" "insert lineend"
! 2971: $gRefText($number) see insert
! 2972: }
! 2973: }
! 2974:
! 2975: ###########################################################
! 2976: # updateLocation
! 2977: ###########################################################
! 2978: ###########################################################
! 2979: ###########################################################
! 2980: proc updateLocation { number } {
! 2981: global gRefCurLine gRefText gTextWindow gLineNumber gCharacterNumber
! 2982:
! 2983: if {$number} {set window $gRefText($number)} {set window $gTextWindow}
! 2984: # if {![winfo exists $gRefText($number)]} {return};#do I need this
! 2985: set spot [split [.$window index insert] "."]
! 2986: if { $number } {
! 2987: set gRefCurLine($number) [lindex $spot 0 ]
! 2988: } else {
! 2989: set gLineNumber [lindex $spot 0]
! 2990: set gCharacterNumber [lindex $spot 0]
! 2991: }
! 2992: }
! 2993:
! 2994: ###########################################################
! 2995: ###########################################################
! 2996: ###########################################################
! 2997: ###########################################################
! 2998: proc askToSave { refNum mustClose } {
! 2999: global gPrompt
! 3000:
! 3001: set dialog [toplevel .askToSavePrompt -borderwidth 10]
! 3002: wm title $dialog "Do you wish to Save"
! 3003: wm geo $dialog "+200+200"
! 3004: if { $refNum } {
! 3005: global gRefFile
! 3006: set msg "Reference File: $gRefFile($refNum) has changed. Do you wish to save?"
! 3007: } else {
! 3008: set msg "Source has changed do you wish to save?"
! 3009: }
! 3010: message $dialog.msg -text $msg -aspect 800
! 3011:
! 3012: set gPrompt(result) ""
! 3013: set buttonFrame [frame $dialog.buttons -bd 10]
! 3014: pack $dialog.msg $buttonFrame -side top -fill x
! 3015:
! 3016: bind $dialog <Destroy> {
! 3017: set gPrompt(result) Cancel
! 3018: set gPrompt(yes) 0
! 3019: }
! 3020:
! 3021: button $buttonFrame.yes -text Yes -underline 0 -command {
! 3022: set gPrompt(yes) 1
! 3023: }
! 3024: button $buttonFrame.no -text No -underline 0 -command {
! 3025: set gPrompt(yes) 0
! 3026: }
! 3027: if { !$mustClose } {
! 3028: button $buttonFrame.cancel -text Cancel -underline 0 -command {
! 3029: set gPrompt(yes) 0
! 3030: set gPrompt(result) Cancel
! 3031: }
! 3032: pack $buttonFrame.yes $buttonFrame.no $buttonFrame.cancel -side left
! 3033: } else {
! 3034: pack $buttonFrame.yes $buttonFrame.no -side left
! 3035: }
! 3036: bind $dialog <Alt-Key> break
! 3037:
! 3038: Centre_Dialog $dialog default
! 3039: update
! 3040:
! 3041: focus $dialog
! 3042: capaRaise $dialog
! 3043: capaGrab $dialog
! 3044: vwait gPrompt(yes)
! 3045: capaGrab release $dialog
! 3046: bind $dialog <Destroy> ""
! 3047: destroy $dialog
! 3048: if {$gPrompt(yes)} {
! 3049: if { $refNum } {
! 3050: global gRefText
! 3051: saveText $gRefText($refNum) 0 $refNum
! 3052: } else {
! 3053: saveDocument
! 3054: }
! 3055: } else {
! 3056: return $gPrompt(result)
! 3057: }
! 3058: }
! 3059:
! 3060: ###########################################################
! 3061: ###########################################################
! 3062: ###########################################################
! 3063: ###########################################################
! 3064: proc saveDocument { {saveAs 0} } {
! 3065: global gFile gTextWindow gSetNumberText gChanged gEditWindow gWindowMenu \
! 3066: gCapaConfig
! 3067: if { [catch {set gTextWindow}] } { return }
! 3068: if { ![winfo exists $gTextWindow] } { return }
! 3069: if { $gFile == "" } { set saveAs 1 }
! 3070: if {$saveAs == 1} {
! 3071: set temp [tk_getSaveFile -title "Enter the name to Save As" \
! 3072: -initialdir "[pwd]" ]
! 3073: if { $temp == "" } {
! 3074: displayError "File not saved"
! 3075: return
! 3076: }
! 3077:
! 3078: catch {removeWindowEntry "$gFile*"}
! 3079: catch {removeFindList}
! 3080: set gFile $temp
! 3081: addFindList
! 3082: cd [file dirname $gFile]
! 3083: set gSetNumberText [string range [file rootname [file tail $gFile]] \
! 3084: 3 end ]
! 3085: checkIfValidFilename
! 3086: wm title [winfo toplevel $gEditWindow] $gFile
! 3087:
! 3088: $gWindowMenu add command -label "$gFile" -command \
! 3089: "capaRaise $gEditWindow"
! 3090: } else {
! 3091: if { ([array name gCapaConfig quizzerBackupQZ] == "") ||
! 3092: ($gCapaConfig(quizzerBackupQZ)!="off") } {
! 3093: if { [catch {file copy -force $gFile $gFile.bak} ] } {
! 3094: displayError "Unable to create backup for $gFile"
! 3095: }
! 3096: }
! 3097: }
! 3098:
! 3099: set fileId [open $gFile w]
! 3100:
! 3101: puts -nonewline $fileId [$gTextWindow get 0.0 end]
! 3102:
! 3103: close $fileId
! 3104:
! 3105: savePrefs
! 3106: set gChanged 0
! 3107: }
! 3108:
! 3109: ###########################################################
! 3110: ###########################################################
! 3111: ###########################################################
! 3112: ###########################################################
! 3113: proc closeDocument { { mustClose 0 } { save 1 } } {
! 3114: global gFile gEditWindow gChanged gPrefs \
! 3115: gPutLine gTryVal gProbVal gHintVal gQuizTemp \
! 3116: gNumberParsedText gSetNumberText gClosedDocument gTextWindow
! 3117: if { [catch {set gEditWindow}] } { return }
! 3118: if { ![winfo exists $gEditWindow] } { return }
! 3119: if { $gClosedDocument } { return }
! 3120: if { $save && $gChanged } {
! 3121: if { [askToSave 0 $mustClose] == "Cancel" && (! $mustClose ) } { return }
! 3122: }
! 3123: if {(!$mustClose)&&[makeSure "Are you sure you wish to stop editing?"]=="Cancel"} {
! 3124: return
! 3125: }
! 3126: set gClosedDocument 1
! 3127: removeFindList
! 3128: destroy $gEditWindow
! 3129: removeWindowEntry "$gFile*"
! 3130: set gFile ""
! 3131: set gChanged 0
! 3132: set gPrefs(info) "Problem"
! 3133: set gPrefs(TeXHeader) ""
! 3134: set gPrefs(TeXFooter) ""
! 3135: set gPutLine 1
! 3136: set gTryVal 99
! 3137: set gHintVal 1
! 3138: set gProbVal 1
! 3139: set gQuizTemp "true"
! 3140: set gNumberParsedText ""
! 3141: set gSetNumberText ""
! 3142: }
! 3143:
! 3144: ###########################################################
! 3145: ###########################################################
! 3146: ###########################################################
! 3147: ###########################################################
! 3148: proc closeRefFile { refNum { mustClose 0 } { save 1 } } {
! 3149: global gRefChanged gRefText gRefFile gRefClosed gRefCurLine gRefLine gRefChangedLast
! 3150: if { [catch {set gRefText($refNum)}] } { return }
! 3151: if { ![winfo exists $gRefText($refNum)] } { return }
! 3152: if { $gRefClosed($refNum) } { return }
! 3153: if { $save && $gRefChanged($refNum) } {
! 3154: if { [askToSave $refNum $mustClose] == "Cancel" && ( ! $mustClose ) } { return }
! 3155: }
! 3156:
! 3157: if { ( ! $mustClose ) && ( [makeSure "Are you sure you wish to stop editing $gRefFile($refNum)?"] == "Cancel" ) } {
! 3158: return
! 3159: }
! 3160: set gRefClosed($refNum) 1
! 3161: removeFindList $refNum
! 3162: destroy [winfo toplevel $gRefText($refNum)]
! 3163: removeWindowEntry "Reference $gRefFile($refNum)*"
! 3164: unset gRefText($refNum) gRefChanged($refNum) gRefClosed($refNum) gRefFile($refNum) \
! 3165: gRefCurLine($refNum) gRefLine($refNum) gRefChangedLast($refNum)
! 3166: }
! 3167:
! 3168: ###########################################################
! 3169: # quit
! 3170: ###########################################################
! 3171: # called when the quit option is selected on the menu, unmaps
! 3172: # all keys.
! 3173: ###########################################################
! 3174: # Arguments: None
! 3175: # Returns: Nothing
! 3176: # Globals: gChanged - whether or not the file has been modified
! 3177: ###########################################################
! 3178: proc quit { { mustClose 0 } } {
! 3179: global gChanged gRefChanged gRefText
! 3180:
! 3181: if { (! $mustClose ) && [makeSure "Are you sure you wish to quit?"] == "Cancel" } {
! 3182: return
! 3183: }
! 3184:
! 3185: if { $gChanged } {
! 3186: if { [askToSave 0 $mustClose] == "Cancel" && ( ! $mustClose ) } {
! 3187: return
! 3188: }
! 3189: }
! 3190:
! 3191: foreach refNum [array names gRefChanged] {
! 3192: if { $gRefChanged($refNum) == 1 } {
! 3193: if { [winfo exists $gRefText($refNum)] } {
! 3194: if { [askToSave $refNum $mustClose ] == "Cancel" && (! $mustClose ) } {
! 3195: return
! 3196: }
! 3197: }
! 3198: }
! 3199: }
! 3200:
! 3201: exec /bin/rm -f quiztemp.ps
! 3202: exec /bin/rm -f quiztemp.dvi
! 3203: exec /bin/rm -f quiztemp.tex
! 3204: exec /bin/rm -f quiztemp.log
! 3205: exec /bin/rm -f quiztemp.aux
! 3206: exec /bin/rm -f quiztemp.txt
! 3207:
! 3208: unmapAllKeys
! 3209:
! 3210: exit
! 3211: }
! 3212:
! 3213: ###########################################################
! 3214: # createStopButton
! 3215: ###########################################################
! 3216: ###########################################################
! 3217: ###########################################################
! 3218: proc createStopButton {} {
! 3219: global gStopStatus
! 3220: if {[winfo exists .stopbutton]} {destroy .stopbutton}
! 3221: set top [toplevel .stopbutton]
! 3222: button $top.stop -text "Stop Parser" -command "stopParser"
! 3223: label $top.status -textvariable gStopStatus -width 35
! 3224: pack $top.stop $top.status
! 3225: set gStopStatus ""
! 3226: grab $top
! 3227: Centre_Dialog $top default
! 3228: update
! 3229: }
! 3230:
! 3231: ###########################################################
! 3232: # destroyStopButton
! 3233: ###########################################################
! 3234: ###########################################################
! 3235: ###########################################################
! 3236: proc destroyStopButton {} {
! 3237: grab release .stopbutton
! 3238: destroy .stopbutton
! 3239: }
! 3240:
! 3241: ###########################################################
! 3242: # createDvi
! 3243: ###########################################################
! 3244: ###########################################################
! 3245: ###########################################################
! 3246: proc createDvi { {showXdvi 1} {showStopButton 0} {useqzparse 0}} {
! 3247: global gPreviewMode gCreateDviText gPrefs gSetNumberText \
! 3248: gStudentSelection gFile gWindowMenu gLatexId gParseErrorsText \
! 3249: gEditWindow gCreateDviTextTemp gXdviOpt \
! 3250: gLoadHeaderSet gCapaConfig gControlDates gNumberParsedText \
! 3251: gDonePrinting
! 3252:
! 3253: if { [catch {set gEditWindow}] } { return }
! 3254: if { ![winfo exists $gEditWindow] } { return }
! 3255:
! 3256: catch { destroy .createDviText }
! 3257: set gCreateDviTextTemp [text .createDviText]
! 3258:
! 3259: switch $gPrefs(info) {
! 3260: Problem { set type 0 }
! 3261: ProblemAnswer { set type 1 }
! 3262: Answer { set type 2 }
! 3263: }
! 3264:
! 3265: if { $useqzparse } {
! 3266: set gDonePrinting 0
! 3267: switch $gPrefs(info) {
! 3268: Problem { set type "-T" }
! 3269: Answer { set type "-Ta" }
! 3270: ProblemAnswer { set type "-Tb" }
! 3271: default { set type "-T" }
! 3272: }
! 3273: createCreateDviWin
! 3274: grab .createDvi
! 3275: $gCreateDviText delete 0.0 end
! 3276: if { [setupSetsToPrint set start end 0] == 1 } { return 1 }
! 3277: if { [set gStopPrinting [expr 2 == [runLatex \
! 3278: "echo [pwd] | $gCapaConfig(qzparse_command) \
! 3279: -stu $gStudentSelection(studentNumber) -set $set \
! 3280: -d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
! 3281: exec rm -f $gStudentSelection(studentNumber).tex quiztemp.tex
! 3282: if {$showStopping} {
! 3283: displayMessage "Printing has been stopped."
! 3284: set gDonePrinting 1
! 3285: set gStopPrinting 0
! 3286: }
! 3287: return 1
! 3288: }
! 3289: exec mv $gStudentSelection(studentNumber).tex quiztemp.tex
! 3290: exec /bin/rm -f quiztemp.dvi
! 3291: } else {
! 3292: createStopButton
! 3293: if { [catch {
! 3294: set numberParsed [ texParse $type $gSetNumberText \
! 3295: $gStudentSelection(type) $gStudentSelection(random) \
! 3296: $gStudentSelection(studentNumber) \
! 3297: $gStudentSelection(studentName) \
! 3298: gCreateDviTextTemp 1 ] }]} {
! 3299: return
! 3300: }
! 3301: destroyStopButton
! 3302: checkHeader $numberParsed
! 3303:
! 3304: if { [showParseErrors] != "" } {
! 3305: if { [makeSure "There were errors when parsing the .qz file, \
! 3306: continue to create the .dvi?"] =="Cancel" } {
! 3307: destroy $gCreateDviTextTemp
! 3308: return
! 3309: }
! 3310: }
! 3311:
! 3312: set error [catch { set fileId [open quiztemp.tex w] } ]
! 3313: if { $error } {
! 3314: displayError "Unable to create neccessary temp files, delete all the\
! 3315: quiztemp file from the class directory."
! 3316: return
! 3317: }
! 3318:
! 3319: set filename [file join [file dirname $gFile] TeXheader ]
! 3320: set texfileId [open $filename r]
! 3321: puts -nonewline $fileId [read $texfileId [file size $filename]]
! 3322: close $texfileId
! 3323:
! 3324: puts -nonewline $fileId "[$gCreateDviTextTemp get 0.0 end]"
! 3325:
! 3326: set filename [file join [file dirname $gFile] TeXfooter ]
! 3327: set texfileId [open $filename r]
! 3328: puts $fileId [read $texfileId [file size $filename]]
! 3329: close $texfileId
! 3330:
! 3331: close $fileId
! 3332: }
! 3333:
! 3334: destroy $gCreateDviTextTemp
! 3335:
! 3336: if { ![winfo exists .createDvi] } {
! 3337: set createDviWindow [toplevel .createDvi]
! 3338: $gWindowMenu add command -label "CreateDvi" -command \
! 3339: "capaRaise $createDviWindow"
! 3340: wm title $createDviWindow "LaTeX Output"
! 3341: addFindList -3
! 3342:
! 3343: set windowFrame [frame $createDviWindow.windowFrame]
! 3344: set buttonFrame [frame $createDviWindow.buttonFrame]
! 3345:
! 3346: pack $windowFrame $buttonFrame -side bottom
! 3347: pack configure $windowFrame -expand true -fill both
! 3348: pack configure $buttonFrame -anchor e
! 3349:
! 3350: scrollbar $windowFrame.scroll -orient vertical -command \
! 3351: "$windowFrame.text yview"
! 3352: set gCreateDviText [text $windowFrame.text -yscrollcommand \
! 3353: "$windowFrame.scroll set" -wrap char -height 40]
! 3354:
! 3355: pack $windowFrame.scroll $gCreateDviText -side left -expand 0
! 3356: pack configure $windowFrame.scroll -expand 0 -fill y
! 3357: pack configure $gCreateDviText -expand true -fill both
! 3358:
! 3359: set appearingFrame [frame $buttonFrame.appearingFrame]
! 3360: button $buttonFrame.ok -text Dismiss -command \
! 3361: "trace vdelete gFile w updateCreateDvi
! 3362: destroy $createDviWindow
! 3363: removeWindowEntry CreateDvi
! 3364: removeFindList -3"
! 3365: bind $createDviWindow <Destroy> \
! 3366: "trace vdelete gFile w updateCreateDvi
! 3367: removeWindowEntry CreateDvi
! 3368: removeFindList -3"
! 3369: pack $appearingFrame $buttonFrame.ok -side left
! 3370:
! 3371: button $appearingFrame.stop -text "Stop Creating Print Jobs"\
! 3372: -command "stopPrinting"
! 3373: set name [file rootname [file tail $gFile ] ].dvi
! 3374: button $appearingFrame.print -text \
! 3375: "Save.dvi file to $name" \
! 3376: -command saveDvi
! 3377: trace variable gFile w updateCreateDvi
! 3378:
! 3379: if { $showStopButton } {
! 3380: pack $appearingFrame.stop $appearingFrame.print -side left
! 3381: pack forget $appearingFrame.print
! 3382: } else {
! 3383: pack $appearingFrame.stop $appearingFrame.print -side left
! 3384: pack forget $appearingFrame.stop
! 3385: }
! 3386:
! 3387: Centre_Dialog $createDviWindow default
! 3388: update
! 3389: } else {
! 3390: if { $showStopButton } {
! 3391: pack forget .createDvi.buttonFrame.appearingFrame.print
! 3392: pack .createDvi.buttonFrame.appearingFrame.stop
! 3393: } else {
! 3394: pack forget .createDvi.buttonFrame.appearingFrame.stop
! 3395: pack .createDvi.buttonFrame.appearingFrame.print
! 3396: }
! 3397: if { !$useqzparse } { $gCreateDviText delete 0.0 end }
! 3398: }
! 3399:
! 3400: exec /bin/rm -f quiztemp.dvi
! 3401: $gCreateDviText insert end "$gCapaConfig(latex_command)\n"
! 3402: $gCreateDviText see end
! 3403: set createdDvi [ runLatex "pwd ; $gCapaConfig(latex_command) quiztemp.tex < \
! 3404: [file join / dev null ]" gCreateDviText]
! 3405:
! 3406: if { ($showXdvi == 1) && ( $createdDvi == 1 ) } {
! 3407: eval "exec $gCapaConfig(xdvi_command) $gXdviOpt quiztemp.dvi >& /dev/null & "
! 3408: }
! 3409:
! 3410: catch { capaRaise $gParseErrorsText }
! 3411: set gDonePrinting 1
! 3412: return $createdDvi
! 3413: }
! 3414:
! 3415: ###########################################################
! 3416: ###########################################################
! 3417: ###########################################################
! 3418: ###########################################################
! 3419: proc stopPrinting {} {
! 3420: global gStopPrinting
! 3421: set gStopPrinting 1
! 3422: }
! 3423:
! 3424: ###########################################################
! 3425: ###########################################################
! 3426: ###########################################################
! 3427: ###########################################################
! 3428: proc saveDvi { } {
! 3429: global gFile
! 3430:
! 3431: set name [file rootname [ file tail $gFile]].dvi
! 3432: catch { exec rm -f $name }
! 3433:
! 3434: if { [ catch { exec cp quiztemp.dvi $name } ] } {
! 3435: displayMessage "Unable to create $name "
! 3436: } else {
! 3437: displayMessage "Created $name "
! 3438: }
! 3439: }
! 3440:
! 3441:
! 3442: ###########################################################
! 3443: ###########################################################
! 3444: ###########################################################
! 3445: ###########################################################
! 3446: proc updateCreateDvi { name1 name2 op } {
! 3447: global gFile
! 3448:
! 3449: set name [file rootname [file tail $gFile ] ].dvi
! 3450: catch { .createDvi.buttonFrame.appearingFrame.print configure \
! 3451: -text "Save.dvi file to $name" }
! 3452: }
! 3453: ###########################################################
! 3454: ###########################################################
! 3455: ###########################################################
! 3456: ###########################################################
! 3457: proc printWindow {} {
! 3458: global gPrintSelection gWindowMenu gEditWindow gStopPrinting\
! 3459: gSetNumberText gMaxSet gFile gChanged
! 3460:
! 3461: set gStopPrinting 0
! 3462: if { [catch {set gEditWindow}] } { return }
! 3463: if { ![winfo exists $gEditWindow] } { return }
! 3464:
! 3465: if { [winfo exists .print] } {
! 3466: capaRaise .print
! 3467: return
! 3468: }
! 3469: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
! 3470:
! 3471: set print [toplevel .print]
! 3472: $gWindowMenu add command -label "Print" -command "capaRaise $print"
! 3473: wm title $print "Select a Print Method"
! 3474: message $print.msg -text "Please specify a print method." -aspect 10000
! 3475: set oneSetFrame [frame $print.frame1 -relief groove -borderwidth 4]
! 3476: set moreSetFrame [frame $print.frame2 -relief groove -borderwidth 4]
! 3477: set buttonFrame [frame $print.buttons]
! 3478: pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top
! 3479: pack configure $oneSetFrame $moreSetFrame -anchor w -fill x
! 3480:
! 3481: set infoFrame [frame $moreSetFrame.frame1]
! 3482: set setFrame [frame $moreSetFrame.frame2 -relief solid -borderwidth 1]
! 3483: pack $infoFrame $setFrame
! 3484: pack configure $infoFrame $setFrame -anchor w
! 3485:
! 3486: if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur}
! 3487: if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific}
! 3488: if {[catch {set gPrintSelection(setend)}]} {set gPrintSelection(setend) $gSetNumberText}
! 3489: radiobutton $setFrame.specific -text "Print Current Set ($gSetNumberText)" \
! 3490: -value "printCur" -variable gPrintSelection(sets)
! 3491: set scaleFrame [frame $setFrame.scales]
! 3492: pack $setFrame.specific $scaleFrame -anchor w
! 3493:
! 3494: for { set i 1 } { $i <= $gMaxSet } { incr i } {
! 3495: if { ! [file exists [file join [file dirname $gFile] records "set$i.db"]] } { break }
! 3496: }
! 3497: incr i -1
! 3498: set gPrintSelection(setend) $gSetNumberText
! 3499: radiobutton $scaleFrame.range -text "Print Set Range:" \
! 3500: -value "printRange" -variable gPrintSelection(sets)
! 3501: scale $scaleFrame.start -from 1 -to $i -variable gPrintSelection(setstart) \
! 3502: -orient h
! 3503: label $scaleFrame.msg -text "to"
! 3504: scale $scaleFrame.end -from 1 -to $i -variable gPrintSelection(setend) \
! 3505: -orient h
! 3506: pack $scaleFrame.range $scaleFrame.start $scaleFrame.msg \
! 3507: $scaleFrame.end -side left
! 3508:
! 3509: button $buttonFrame.ok -text "Select" -command selectedPrintMethod
! 3510: button $buttonFrame.cancel -text "Cancel" -command \
! 3511: "destroy .print
! 3512: removeWindowEntry Print"
! 3513: bind $print <Destroy> "removeWindowEntry Print"
! 3514: pack $buttonFrame.ok $buttonFrame.cancel -side left
! 3515:
! 3516: set currentDviFrame [frame $oneSetFrame.currentDvi]
! 3517: set currentPreviewFrame [frame $oneSetFrame.currentPreview]
! 3518: set randomFrame [frame $oneSetFrame.random]
! 3519: set specificFrame [frame $infoFrame.specific]
! 3520: set sectionFrame [frame $infoFrame.section]
! 3521: set multSectionFrame [frame $infoFrame.multsection]
! 3522: set wholeClassFrame [frame $infoFrame.wholeClass]
! 3523: pack $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \
! 3524: $sectionFrame $multSectionFrame $wholeClassFrame -anchor w \
! 3525: -side top
! 3526: pack configure $specificFrame -expand true -fill both
! 3527:
! 3528: radiobutton $currentDviFrame.currentDvi -text "Print current .dvi" \
! 3529: -value "printCurrentDvi" -variable gPrintSelection(type)
! 3530: pack $currentDviFrame.currentDvi -side left
! 3531:
! 3532: radiobutton $randomFrame.random -text \
! 3533: "Randomly select one student from section:" \
! 3534: -value "printRandom" -variable gPrintSelection(type)
! 3535: entry $randomFrame.entry -textvariable gPrintSelection(random) -width 3 \
! 3536: -validate key -validatecommand "limitEntry %W 3 number %P"
! 3537: pack $randomFrame.random $randomFrame.entry -side left
! 3538:
! 3539: radiobutton $specificFrame.specific -text "Specify the student by:" \
! 3540: -value "printSpecific" -variable gPrintSelection(type)
! 3541: set studentNumber [frame $specificFrame.studentNumber]
! 3542: set fullName [frame $specificFrame.fullName]
! 3543: pack $specificFrame.specific $studentNumber $fullName -side top
! 3544: pack configure $specificFrame.specific -anchor w
! 3545: pack configure $studentNumber $fullName -anchor e
! 3546:
! 3547: radiobutton $sectionFrame.section -text "Print section" \
! 3548: -value "printSection" -variable gPrintSelection(type)
! 3549: entry $sectionFrame.entry -textvariable gPrintSelection(section) -width 3 \
! 3550: -validate key -validatecommand "limitEntry %W 3 number %P"
! 3551: pack $sectionFrame.section $sectionFrame.entry -side left
! 3552:
! 3553: radiobutton $multSectionFrame.section -text "Print multiple sections" \
! 3554: -value "printMultipleSections" -variable gPrintSelection(type)
! 3555: pack $multSectionFrame.section -side left
! 3556:
! 3557: radiobutton $wholeClassFrame.wholeClass -text "Print whole class." \
! 3558: -value "printWholeClass" -variable gPrintSelection(type)
! 3559: pack $wholeClassFrame.wholeClass -side left
! 3560:
! 3561: message $studentNumber.msg -text "Student Number: " -aspect 10000
! 3562: entry $studentNumber.entry -textvariable gPrintSelection(studentNumber) -width 9 \
! 3563: -validate key -validatecommand "limitEntry %W 9 any %P"
! 3564: pack $studentNumber.msg $studentNumber.entry -side left
! 3565:
! 3566: message $fullName.msg -text "Student Name: " -aspect 10000
! 3567: entry $fullName.entry -textvariable gPrintSelection(studentName) -width 30 \
! 3568: -validate key -validatecommand "limitEntry %W 30 any %P"
! 3569: pack $fullName.msg $fullName.entry -side left
! 3570:
! 3571: trace variable gPrintSelection(studentNumber) w \
! 3572: "global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
! 3573: trace variable gPrintSelection(studentName) w \
! 3574: "global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
! 3575:
! 3576: # puts "trace info:[trace vinfo gPrintSelection(studentNumber)]"
! 3577:
! 3578: bind $studentNumber.entry <KeyPress-Return> \
! 3579: "fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 0"
! 3580: bind $fullName.entry <KeyPress-Return> \
! 3581: "fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 1"
! 3582:
! 3583:
! 3584: #Disable the entry boxes that are not selected, and enable the
! 3585: #ones that are
! 3586: # $specificFrame.specific configure -command "
! 3587: # $studentNumber.entry configure -state normal
! 3588: # $fullName.entry configure -state normal"
! 3589: # $randomFrame.random configure -command "
! 3590: # $studentNumber.entry configure -state disabled
! 3591: # $fullName.entry configure -state disabled"
! 3592:
! 3593: #If the window had been called up before we need to check the state
! 3594: #of the variable and disable/enable the correct enry boxes
! 3595: # if { $gPrintSelection(type) == "printSpecific" } {
! 3596: # $studentNumber.entry configure -state normal
! 3597: # $fullName.entry configure -state normal
! 3598: # }
! 3599: # if { $gPrintSelection(type) == "printRandom" } {
! 3600: # $studentNumber.entry configure -state disabled
! 3601: # $fullName.entry configure -state disabled
! 3602: # }
! 3603:
! 3604: Centre_Dialog $print default
! 3605: }
! 3606:
! 3607: proc selectedPrintMethod {} {
! 3608: global gStopPrinting gPrintSelection gStudentSelection
! 3609:
! 3610: switch $gPrintSelection(type) {
! 3611: printSpecific {
! 3612: if { $gPrintSelection(studentNumber) == "" } {
! 3613: displayError "You must specify a student number."
! 3614: return
! 3615: }
! 3616: }
! 3617: printSection {
! 3618: if { $gPrintSelection(section)== "" } {
! 3619: displayError "You must specify a section."
! 3620: return
! 3621: }
! 3622: }
! 3623: default {}
! 3624: }
! 3625:
! 3626: destroy .print
! 3627: removeWindowEntry Print
! 3628: [set gPrintSelection(type)]
! 3629: set gStopPrinting 0
! 3630: }
! 3631:
! 3632: ###########################################################
! 3633: # createCreateDviWin
! 3634: ###########################################################
! 3635: ###########################################################
! 3636: ###########################################################
! 3637: proc createCreateDviWin {} {
! 3638: global gWindowMenu gFile gCreateDviText
! 3639: if { ![winfo exists .createDvi] } {
! 3640: set createDviWindow [toplevel .createDvi]
! 3641: $gWindowMenu add command -label "CreateDvi" -command \
! 3642: "capaRaise $createDviWindow"
! 3643: wm title $createDviWindow "LaTeX Output"
! 3644:
! 3645: set windowFrame [frame $createDviWindow.windowFrame]
! 3646: set buttonFrame [frame $createDviWindow.buttonFrame]
! 3647:
! 3648: pack $windowFrame $buttonFrame -side bottom
! 3649: pack configure $windowFrame -expand true -fill both
! 3650: pack configure $buttonFrame -anchor e
! 3651:
! 3652: scrollbar $windowFrame.scroll -orient vertical -command \
! 3653: "$windowFrame.text yview"
! 3654: set gCreateDviText [text $windowFrame.text -yscrollcommand \
! 3655: "$windowFrame.scroll set" -wrap char -height 40]
! 3656:
! 3657: pack $windowFrame.scroll $gCreateDviText -side left -expand 0
! 3658: pack configure $windowFrame.scroll -expand 0 -fill y
! 3659: pack configure $gCreateDviText -expand true -fill both
! 3660:
! 3661: set appearingFrame [frame $buttonFrame.appearingFrame]
! 3662: button $buttonFrame.ok -text Dismiss -command \
! 3663: "checkDestroyPrint $createDviWindow"
! 3664: wm protocol $createDviWindow WM_DELETE_WINDOW \
! 3665: "checkDestroyPrint $createDviWindow"
! 3666: pack $appearingFrame $buttonFrame.ok -side left
! 3667:
! 3668: button $appearingFrame.stop -text "Stop Creating Print Jobs"\
! 3669: -command "stopPrinting"
! 3670: set name [file rootname [file tail $gFile ] ].dvi
! 3671: button $appearingFrame.print -text \
! 3672: "Save.dvi file to $name" \
! 3673: -command saveDvi
! 3674: trace variable gFile w updateCreateDvi
! 3675:
! 3676: pack $appearingFrame.stop $appearingFrame.print -side left
! 3677: pack forget $appearingFrame.print
! 3678:
! 3679: Centre_Dialog $createDviWindow default
! 3680: update
! 3681: } else {
! 3682: pack forget .createDvi.buttonFrame.appearingFrame.print
! 3683: pack .createDvi.buttonFrame.appearingFrame.stop
! 3684: }
! 3685: }
! 3686:
! 3687: ###########################################################
! 3688: # printBody
! 3689: ###########################################################
! 3690: # sends the file quiztemp.ps to the printer through lpr using
! 3691: # the option foud in gLprCommand
! 3692: ###########################################################
! 3693: # Arguments: none
! 3694: # Returns: Nothing
! 3695: # Globals: gCapaConfig -
! 3696: # gStopPrinting -
! 3697: # Files: quiztemp.ps - file containg info to print (removed)
! 3698: ###########################################################
! 3699: proc printBody { lprCommand { showCompletionMessage 1 } } {
! 3700: global gCapaConfig gStopPrinting gDonePrinting
! 3701:
! 3702: set errorMsg ""
! 3703: set error [ catch {exec $gCapaConfig(dvips_command) quiztemp.dvi \
! 3704: -o quiztemp.ps >& /dev/null} errorMsg ]
! 3705: if { $error } {
! 3706: displayError \
! 3707: "When attempting to run dvips an error occured : $errorMsg"
! 3708: return 1
! 3709: }
! 3710:
! 3711: if { $gStopPrinting } {
! 3712: displayMessage "Printing has been stopped."
! 3713: set gStopPrinting 0
! 3714: set gDonePrinting 1
! 3715: return 1
! 3716: }
! 3717:
! 3718: set errorMsg
! 3719: set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ]
! 3720:
! 3721: if { $error == 1 } {
! 3722: displayError "When attempting to print an error occured : $errorMsg"
! 3723: return 1
! 3724: } else {
! 3725: if { $showCompletionMessage } {
! 3726: displayMessage "Print job sent to the printer.\n $returnMessage"
! 3727: }
! 3728: }
! 3729:
! 3730: return 0
! 3731: }
! 3732:
! 3733:
! 3734:
! 3735: ###########################################################
! 3736: ###########################################################
! 3737: ###########################################################
! 3738: ###########################################################
! 3739: proc printCurrentDvi {} {
! 3740:
! 3741: set lprCommand [getLprCommand quiztemp.ps]
! 3742:
! 3743: if {$lprCommand == ""} {
! 3744: displayError "You must at least specify a print queue for lpr. \
! 3745: Nothing printed."
! 3746: return
! 3747: }
! 3748:
! 3749: if {$lprCommand == "Cancel"} {
! 3750: return
! 3751: }
! 3752:
! 3753: printBody $lprCommand
! 3754:
! 3755: return 0
! 3756: }
! 3757:
! 3758: ###########################################################
! 3759: ###########################################################
! 3760: ###########################################################
! 3761: ###########################################################
! 3762: proc printCurrentPreview {} {
! 3763:
! 3764: set lprCommand [getLprCommand quiztemp.ps]
! 3765:
! 3766: if {$lprCommand == ""} {
! 3767: displayError "You must at least specify a print queue for lpr. \
! 3768: Nothing printed."
! 3769: return
! 3770: }
! 3771:
! 3772: if {$lprCommand == "Cancel"} {
! 3773: return
! 3774: }
! 3775:
! 3776: if { [createDvi 0] == 2 } {
! 3777: displayMessage "Printing has been stopped"
! 3778: }
! 3779:
! 3780: printBody $lprCommand
! 3781:
! 3782: return 0
! 3783: }
! 3784:
! 3785: ###########################################################
! 3786: ###########################################################
! 3787: ###########################################################
! 3788: ###########################################################
! 3789: proc printRandom {} {
! 3790: global gStudentSelection gPrintSelection
! 3791:
! 3792: set lprCommand [getLprCommand quiztemp.ps]
! 3793:
! 3794: if {$lprCommand == ""} {
! 3795: displayError "You must at least specify a print queue for lpr. \
! 3796: Nothing printed."
! 3797: return
! 3798: }
! 3799:
! 3800: if {$lprCommand == "Cancel"} {
! 3801: return
! 3802: }
! 3803:
! 3804: set type $gStudentSelection(type)
! 3805: set random $gStudentSelection(random)
! 3806:
! 3807: set gStudentSelection(type) Random
! 3808: set gStudentSelection(random) $gPrintSelection(random)
! 3809:
! 3810: if { [createDvi 0 1] == 2 } {
! 3811: displayMessage "Printing has been stopped"
! 3812: }
! 3813:
! 3814: printBody $lprCommand
! 3815:
! 3816: set gStudentSelection(type) $type
! 3817: set gStudentSelection(random) $random
! 3818:
! 3819: return 0
! 3820: }
! 3821:
! 3822: ###########################################################
! 3823: ###########################################################
! 3824: ###########################################################
! 3825: ###########################################################
! 3826: proc printSpecific {} {
! 3827: global gStudentSelection gPrintSelection
! 3828:
! 3829: set lprCommand [getLprCommand quiztemp.ps]
! 3830:
! 3831: if {$lprCommand == ""} {
! 3832: displayError "You must at least specify a print queue for lpr. \
! 3833: Nothing printed."
! 3834: return
! 3835: }
! 3836:
! 3837: if {$lprCommand == "Cancel"} {
! 3838: return
! 3839: }
! 3840:
! 3841: set type $gStudentSelection(type)
! 3842: set studentNumber $gStudentSelection(studentNumber)
! 3843:
! 3844: set gStudentSelection(type) Specific
! 3845: set gStudentSelection(studentNumber) $gPrintSelection(studentNumber)
! 3846:
! 3847: if { [createDvi 0 1 1] == 2 } {
! 3848: displayMessage "Printing has been stopped"
! 3849: }
! 3850:
! 3851: printBody $lprCommand
! 3852:
! 3853: set gStudentSelection(type) $type
! 3854: set gStudentSelection(studentNumber) $studentNumber
! 3855:
! 3856: return 0
! 3857: }
! 3858:
! 3859: ###########################################################
! 3860: ###########################################################
! 3861: ###########################################################
! 3862: ###########################################################
! 3863: proc printStudent { studentNumber } {
! 3864: global gStudentSelection gStopPrinting gDonePrinting
! 3865:
! 3866: set type $gStudentSelection(type)
! 3867: set studentNumberOld $gStudentSelection(studentNumber)
! 3868:
! 3869: set gStudentSelection(type) Specific
! 3870: set gStudentSelection(studentNumber) $studentNumber
! 3871:
! 3872: set createdDvi [createDvi 0 1]
! 3873:
! 3874: if { $createdDvi == 1 } { printBody } else {
! 3875: displayMessage "Printing has been stopped"
! 3876: set gStopPrinting 0
! 3877: set gDonePrinting 1
! 3878: }
! 3879:
! 3880: set gStudentSelection(type) $type
! 3881: set gStudentSelection(studentNumber) $studentNumberOld
! 3882:
! 3883: return 0
! 3884: }
! 3885:
! 3886: proc checkDestroyPrint { createDviWindow } {
! 3887: global gDonePrinting
! 3888: if { !$gDonePrinting } {
! 3889: if { [makeSure "Do you really wish to stop printing?"] == "Yes" } {
! 3890: global gStopPrinting
! 3891: set gStopPrinting 1
! 3892: after 1000 "destroyPrint $createDviWindow"
! 3893: }
! 3894: return
! 3895: }
! 3896: destroyPrint $createDviWindow
! 3897: }
! 3898:
! 3899: proc destroyPrint { createDviWindow } {
! 3900: trace vdelete gFile w updateCreateDvi
! 3901: destroy $createDviWindow
! 3902: removeWindowEntry CreateDvi
! 3903: }
! 3904:
! 3905: ###########################################################
! 3906: ###########################################################
! 3907: ###########################################################
! 3908: ###########################################################
! 3909: proc setupSetsToPrint { setVar startVar endVar {checkForHeader 1}} {
! 3910: global gPrintSelection gSetNumberText gLoadHeaderSet
! 3911: upvar $setVar set $startVar start $endVar end
! 3912: if { $gPrintSelection(sets) == "printRange" } {
! 3913: set start $gPrintSelection(setstart)
! 3914: set end $gPrintSelection(setend)
! 3915: set set "$start:$end"
! 3916: set errors ""
! 3917: for {set i $start} {$i <= $end} {incr i} {
! 3918: set gLoadHeaderSet $i
! 3919: if {[catch {getHeaderInfo}]} { append errors ", $i" }
! 3920: }
! 3921: if { $checkForHeader && $errors != "" } {
! 3922: set errors [string range $errors 1 end]
! 3923: if { [llength $errors] > 1 } {
! 3924: set errors "s$errors"
! 3925: set errors [linsert $errors [expr [llength $errors] - 1] and]
! 3926: }
! 3927: displayError "DB header has not yet been set for set$errors. Please set the DB Header before printing Sections."
! 3928: return 1
! 3929: }
! 3930: } else {
! 3931: set start [set end [set set $gSetNumberText]]
! 3932: set gLoadHeaderSet $gSetNumberText
! 3933: if {$checkForHeader && [catch {getHeaderInfo}]} {
! 3934: displayError "DB header has not yet been set. Please set the DB Header before printing Sections."
! 3935: return 1
! 3936: }
! 3937: }
! 3938: }
! 3939:
! 3940: ###########################################################
! 3941: ###########################################################
! 3942: ###########################################################
! 3943: ###########################################################
! 3944: proc printSection { { lprCommand "" } } {
! 3945: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
! 3946: gCreateDviText gStopPrinting gPrefs gFile gDonePrinting \
! 3947: gLoadHeaderSet
! 3948:
! 3949: set gDonePrinting 0
! 3950: set showStopping 0
! 3951:
! 3952: if { [setupSetsToPrint set start end] == 1 } { return 1}
! 3953: if { $lprCommand == "" } {
! 3954: set showStopping 1
! 3955: set lprCommand [getLprCommand quiztemp.ps]
! 3956: if { $lprCommand == "" } {
! 3957: displayError "Print command was empty, unable to print."
! 3958: return 1
! 3959: }
! 3960: if {$lprCommand == "Cancel" } {
! 3961: return 1
! 3962: }
! 3963: }
! 3964:
! 3965: createCreateDviWin
! 3966:
! 3967: grab .createDvi
! 3968:
! 3969: $gCreateDviText delete 0.0 end
! 3970:
! 3971: switch $gPrefs(info) {
! 3972: Problem { set type "-T" }
! 3973: Answer { set type "-Ta" }
! 3974: ProblemAnswer { set type "-Tb" }
! 3975: default { set type "-T" }
! 3976: }
! 3977:
! 3978: if { [set gStopPrinting [expr 2 == [runLatex \
! 3979: "echo [pwd] | $gCapaConfig(qzparse_command) \
! 3980: -sec $gPrintSelection(section) -set $set \
! 3981: -d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
! 3982: for {set i $start} { $i <= $end} { incr i } {
! 3983: exec rm -f section$gPrintSelection(section)-set$i.tex
! 3984: }
! 3985: if {$showStopping} {
! 3986: displayMessage "Printing has been stopped."
! 3987: set gDonePrinting 1
! 3988: set gStopPrinting 0
! 3989: }
! 3990: return 1
! 3991: }
! 3992: if { $gStopPrinting } {
! 3993: displayMessage "Printing has been stopped."
! 3994: set gDonePrinting 1
! 3995: set gStopPrinting 0
! 3996: return 1
! 3997: }
! 3998:
! 3999: for { set i $start} { $i <= $end } { incr i } {
! 4000: if { ! [file exists section$gPrintSelection(section)-set$i.tex] } {
! 4001: if {$showStopping} {
! 4002: displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
! 4003: set gStopPrinting 0
! 4004: set gDonePrinting 1
! 4005: }
! 4006: return 2
! 4007: }
! 4008:
! 4009: exec mv section$gPrintSelection(section)-set$i.tex quiztemp.tex
! 4010: exec /bin/rm -f quiztemp.dvi
! 4011:
! 4012: $gCreateDviText insert end "$gCapaConfig(latex_command)\n"
! 4013: $gCreateDviText see end
! 4014:
! 4015: if { [set gStopPrinting [ expr 2 == [runLatex \
! 4016: "pwd ; $gCapaConfig(latex_command) \
! 4017: quiztemp.tex < [file join / dev null ]" gCreateDviText ] ] ] } {
! 4018: if {$showStopping} {
! 4019: displayError "The LaTeX command: $gCapaConfig(latex_command), was unable to produce the expected output. Printing stopped"
! 4020: set gStopPrinting 0
! 4021: set gDonePrinting 1
! 4022: }
! 4023: return 1
! 4024: }
! 4025:
! 4026: if { $gStopPrinting } {
! 4027: displayMessage "Printing has been stopped."
! 4028: set gDonePrinting 1
! 4029: set gStopPrinting 0
! 4030: return 1
! 4031: }
! 4032:
! 4033: set a [expr ($showStopping) && ($end == $i)]
! 4034: if { [set gStopPrinting [printBody $lprCommand $a ] ] } {
! 4035: if {$showStopping} {
! 4036: displayMessage "Printing has been stopped."
! 4037: set gDonePrinting 1
! 4038: set gStopPrinting 0
! 4039: }
! 4040: return 1
! 4041: }
! 4042: if { $gStopPrinting } {
! 4043: displayMessage "Printing has been stopped."
! 4044: set gDonePrinting 1
! 4045: set gStopPrinting 0
! 4046: return 1
! 4047: }
! 4048: }
! 4049:
! 4050: set gDonePrinting 1
! 4051: return 0
! 4052: }
! 4053:
! 4054: ###########################################################
! 4055: ###########################################################
! 4056: ###########################################################
! 4057: ###########################################################
! 4058: proc printMultipleSections { } {
! 4059: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
! 4060: gCreateDviText gStopPrinting gPrefs gDonePrinting
! 4061:
! 4062: #checks if the DB Header is set
! 4063: if { [setupSetsToPrint set start end] == 1 } { return 1}
! 4064:
! 4065: set sectionList [ getExistingSections ]
! 4066: set sectionsToPrint [ pickSections $sectionList "Select Sections to Print:" ]
! 4067:
! 4068: if { $sectionsToPrint == "" } {
! 4069: displayMessage "No sections selected, therefore nothing was printed."
! 4070: return 1
! 4071: }
! 4072: if { $sectionsToPrint == "Cancel" } {
! 4073: return 1
! 4074: }
! 4075:
! 4076: set lprCommand [getLprCommand quiztemp.ps]
! 4077: if { $lprCommand == "" } {
! 4078: displayError "Print command was empty, unable to print."
! 4079: return 1
! 4080: }
! 4081: if {$lprCommand == "Cancel" } {
! 4082: return 1
! 4083: }
! 4084:
! 4085: if { [makeSure "You have selected to print $gPrefs(info)s for sections: [string trim $sectionsToPrint], using the print command \"$lprCommand\", continue?"] == "Cancel" } {
! 4086: return 1
! 4087: }
! 4088:
! 4089: foreach section $sectionsToPrint {
! 4090: set gDonePrinting 0
! 4091: set gPrintSelection(section) $section
! 4092: if { [set gStopPrinting [printSection $lprCommand] ] } {
! 4093: set gDonePrinting 0
! 4094: if { $gStopPrinting == 2 } {
! 4095: displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
! 4096: } else {
! 4097: displayMessage "Printing has been stopped."
! 4098: }
! 4099: set gDonePrinting 1
! 4100: return 1
! 4101: }
! 4102: if { $gStopPrinting } {
! 4103: displayMessage "Printing has been stopped."
! 4104: set gStopPrinting 0
! 4105: set gDonePrinting 1
! 4106: return 1
! 4107: }
! 4108: }
! 4109: set gDonePrinting 1
! 4110: displayMessage "Print jobs sent to the printer."
! 4111: return 0
! 4112: }
! 4113:
! 4114: ###########################################################
! 4115: ###########################################################
! 4116: ###########################################################
! 4117: ###########################################################
! 4118: proc printWholeClass { } {
! 4119: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
! 4120: gCreateDviText gStopPrinting gPrefs gDonePrinting
! 4121:
! 4122: if {[catch {getHeaderInfo}]} {
! 4123: displayError "DB header has not yet been set, Please set DB Header before printing Sections."
! 4124: return 1
! 4125: }
! 4126: set sectionsToPrint [ getExistingSections ]
! 4127:
! 4128: if { $sectionsToPrint == "" } {
! 4129: displayMessage "No sections exist, therefore nothing was printed."
! 4130: return 1
! 4131: }
! 4132:
! 4133: set lprCommand [getLprCommand quiztemp.ps]
! 4134:
! 4135: if { $lprCommand == "" } {
! 4136: displayError "Print command was empty, unable to print."
! 4137: return 1
! 4138: }
! 4139: if {$lprCommand == "Cancel" } {
! 4140: return 1
! 4141: }
! 4142:
! 4143: if { [makeSure "You have selected to print $gPrefs(info)s for the entire class of [llength $sectionsToPrint] sections, using the print command $lprCommand, continue?"] == "Cancel" } {
! 4144: return 1
! 4145: }
! 4146:
! 4147: foreach section $sectionsToPrint {
! 4148: set section [lindex $section 0]
! 4149: set gPrintSelection(section) $section
! 4150: set gStopPrinting [printSection $lprCommand]
! 4151: if { $gStopPrinting } {
! 4152: if { $gStopPrinting == 2 } {
! 4153: displayError "$gCapaConfig(qzparse_command) was unable to produce the expected output. Printing stopped"
! 4154: } else {
! 4155: displayMessage "Printing has been stopped."
! 4156: }
! 4157: set gDonePrinting 1
! 4158: set gStopPrinting 0
! 4159: return 1
! 4160: }
! 4161: }
! 4162: set gDonePrinting 1
! 4163: displayMessage "Print jobs sent to the printer."
! 4164: return 0
! 4165: }
! 4166:
! 4167: ###########################################################
! 4168: # analyzeSet
! 4169: ###########################################################
! 4170: ###########################################################
! 4171: ###########################################################
! 4172: proc analyzeSet {} {
! 4173: global gChanged gWindowMenu gEditWindow gAnalyze gSetNumberText gNumberParsedText
! 4174:
! 4175: if { [catch {winfo exists $gEditWindow}] } { return }
! 4176: if { ![ winfo exists $gEditWindow ] } { return }
! 4177: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
! 4178: if { [winfo exists .analyzeSet] } {
! 4179: capaRaise .analyzeSet
! 4180: return
! 4181: }
! 4182:
! 4183: set analyze [toplevel .analyzeSet]
! 4184: $gWindowMenu add command -label "AnalyzeSet" \
! 4185: -command "capaRaise $analyze"
! 4186: wm title $analyze "Analyze Set"
! 4187:
! 4188: set settingsFrame [frame $analyze.settingsFrame]
! 4189: set dataFrame [frame $analyze.dataFrame]
! 4190: pack $settingsFrame $dataFrame -side top
! 4191:
! 4192: set classFrame [frame $settingsFrame.classFrame]
! 4193: set setFrame [frame $settingsFrame.setFrame]
! 4194: set probFrame [frame $settingsFrame.probFrame]
! 4195: set statusFrame [frame $settingsFrame.statusFrame]
! 4196: set statusBar [frame $settingsFrame.statusBar]
! 4197: set buttonFrame [frame $settingsFrame.buttonFrame]
! 4198: pack $classFrame $setFrame $probFrame $statusFrame $statusBar $buttonFrame \
! 4199: -side top
! 4200:
! 4201: set canvasFrame [frame $dataFrame.canvasFrame]
! 4202: set numberFrame [frame $dataFrame.numberFrame]
! 4203: pack $canvasFrame $numberFrame -side top
! 4204:
! 4205: set gAnalyze(class) [pwd]
! 4206: label $classFrame.label -textvariable gAnalyze(class)
! 4207: pack $classFrame.label
! 4208:
! 4209: set gAnalyze(set) $gSetNumberText
! 4210: label $setFrame.lbl -text "Set number:"
! 4211: label $setFrame.set -textvariable gAnalyze(set)
! 4212: # button $setFrame.change -text "Change" -command analyzeChangeSet
! 4213: pack $setFrame.lbl $setFrame.set -side left
! 4214:
! 4215: if { [set gAnalyze(maxprob) $gNumberParsedText] == "" } { set gAnalyze(maxprob) 1 }
! 4216:
! 4217: label $probFrame.label -text "Problem Number :"
! 4218: set gAnalyze(scale) [scale $probFrame.problem \
! 4219: -from 1 -to $gAnalyze(maxprob) \
! 4220: -variable gAnalyze(prob) -command analyzeUpdate \
! 4221: -orient h -length 150 -tickinterval 1]
! 4222: pack $probFrame.label $probFrame.problem -side left
! 4223:
! 4224: set gAnalyze(status) ""
! 4225: label $statusFrame.label -text "Status:"
! 4226: label $statusFrame.status -textvariable gAnalyze(status)
! 4227: pack $statusFrame.label $statusFrame.status -side left
! 4228:
! 4229: set gAnalyze(statcanvas) [canvas $statusBar.canvas -width 200 -height 20]
! 4230: pack $statusBar.canvas
! 4231: $gAnalyze(statcanvas) create rectangle 1 1 199 19 -outline black
! 4232: set gAnalyze(bar) [$gAnalyze(statcanvas) create rectangle 1 1 1 19 -fill red -outline black]
! 4233:
! 4234: button $buttonFrame.class -text "Run Class" -command "analyzeClass 1"
! 4235: button $buttonFrame.random -text "Run Random" -command analyzeRandom
! 4236: button $buttonFrame.stop -text "Stop" -command analyzeStop
! 4237: button $buttonFrame.close -text "Dismiss" -comman analyzeClose
! 4238: pack $buttonFrame.class $buttonFrame.random $buttonFrame.stop \
! 4239: $buttonFrame.close -side left
! 4240:
! 4241: set gAnalyze(canvaswidth) 600
! 4242: set gAnalyze(canvas) [canvas $canvasFrame.canvas -width $gAnalyze(canvaswidth) \
! 4243: -height 100]
! 4244: pack $gAnalyze(canvas)
! 4245:
! 4246: set hiFrame [frame $numberFrame.hiFrame]
! 4247: set lowFrame [frame $numberFrame.lowFrame]
! 4248: set uniqFrame [frame $numberFrame.uniqFrame]
! 4249: pack $lowFrame $hiFrame $uniqFrame -side left
! 4250: pack configure $hiFrame -anchor e
! 4251: pack configure $lowFrame -anchor w
! 4252:
! 4253: label $hiFrame.label -text "High End:"
! 4254: label $hiFrame.num -textvariable gAnalyze(highnum)
! 4255: pack $hiFrame.label $hiFrame.num -side left
! 4256:
! 4257: label $lowFrame.label -text "Low End:"
! 4258: label $lowFrame.num -textvariable gAnalyze(lownum)
! 4259: pack $lowFrame.label $lowFrame.num -side left
! 4260:
! 4261: label $uniqFrame.label -text "Num. Unique:"
! 4262: label $uniqFrame.num -textvariable gAnalyze(numuniq)
! 4263: pack $uniqFrame.label $uniqFrame.num -side left
! 4264:
! 4265: set gAnalyze(studentNumbers) [getStudentNumbers]
! 4266: set gAnalyze(exit) 0
! 4267: }
! 4268:
! 4269: ###########################################################
! 4270: # analyzeClass
! 4271: ###########################################################
! 4272: ###########################################################
! 4273: ###########################################################
! 4274: proc analyzeClass { {start 1} } {
! 4275: global gAnalyze gCapaConfig
! 4276: if { $gAnalyze(studentNumbers)=="" } { return }
! 4277: if { $start } {
! 4278: set gAnalyze(toprocess) $gAnalyze(studentNumbers)
! 4279: set gAnalyze(stop) 0
! 4280: set gAnalyze(update) 1
! 4281: set gAnalyze(done) 0
! 4282: set gAnalyze(total) [expr [llength $gAnalyze(toprocess)]/3]
! 4283: foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
! 4284: }
! 4285: set number [lindex $gAnalyze(toprocess) 0]
! 4286: set name [lindex $gAnalyze(toprocess) 1]
! 4287: set section [lindex $gAnalyze(toprocess) 2]
! 4288: set gAnalyze(toprocess) [lrange $gAnalyze(toprocess) 3 end]
! 4289: set command "$gCapaConfig(answers_command) $number \"$name\" $section $gAnalyze(set)"
! 4290: set fileId [open "|$command" "r"]
! 4291: set gAnalyze(pid) [pid $fileId]
! 4292: fconfigure $fileId -blocking 0
! 4293: fileevent $fileId readable "analyzeLine $fileId"
! 4294: set gAnalyze(status) "Processing $number"
! 4295: incr gAnalyze(done)
! 4296: $gAnalyze(statcanvas) coords $gAnalyze(bar) 1 1 [expr 200*($gAnalyze(done)/double($gAnalyze(total)))] 19
! 4297: update idletasks
! 4298: }
! 4299:
! 4300: ###########################################################
! 4301: # analyzeEatQuestion
! 4302: ###########################################################
! 4303: ###########################################################
! 4304: ###########################################################
! 4305: proc analyzeEatQuestion { fileId } {
! 4306: global gAnalyze
! 4307: if { $gAnalyze(exit) } {
! 4308: fileevent $fileId readable ""
! 4309: catch {close $fileId}
! 4310: return
! 4311: }
! 4312: set aline [gets $fileId]
! 4313: if { $aline != "" } {
! 4314: switch -- [lindex [split $aline :] 0] {
! 4315: EQES { fileevent $fileId readable "analyzeLine $fileId" }
! 4316: }
! 4317: }
! 4318: if { [eof $fileId] } { analyzeEnd $fileId }
! 4319: }
! 4320:
! 4321: ###########################################################
! 4322: # analyzeLine
! 4323: ###########################################################
! 4324: ###########################################################
! 4325: ###########################################################
! 4326: proc analyzeLine { fileId } {
! 4327: global gAnalyze
! 4328:
! 4329: if { $gAnalyze(exit) } {
! 4330: fileevent $fileId readable ""
! 4331: catch {close $fileId}
! 4332: return
! 4333: }
! 4334: set aline [gets $fileId]
! 4335: if { $aline != "" } {
! 4336: switch [lindex [split $aline :] 0] {
! 4337: ANS {
! 4338: incr gAnalyze(problemNum)
! 4339: set ans [string range $aline 4 end]
! 4340: set length [llength $ans]
! 4341: lappend gAnalyze($gAnalyze(problemNum).ans) \
! 4342: [lindex $ans 0]
! 4343: if { ($length == 2) || ($length == 4)} {
! 4344: lappend gAnalyze($gAnalyze(problemNum).unit) \
! 4345: [lindex $ans end]
! 4346: }
! 4347: if { ($length == 3) || ($length == 4) } {
! 4348: lappend gAnalyze($gAnalyze(problemNum).low) \
! 4349: [lindex $ans 1]
! 4350: lappend gAnalyze($gAnalyze(problemNum).high) \
! 4351: [lindex $ans 2]
! 4352: }
! 4353: }
! 4354: SET { set gAnalyze(problemNum) 0 }
! 4355: DONE {
! 4356: set gAnalyze(maxprob) $gAnalyze(problemNum)
! 4357: $gAnalyze(scale) configure -to $gAnalyze(maxprob)
! 4358: }
! 4359: ERROR {
! 4360: fileevent $fileId readable ""
! 4361: displayError "Answers returned invalid message: $aline"
! 4362: fileevent $fileId readable "analyzeLine $fileId"
! 4363: }
! 4364: BQES { fileevent $fileId readable "analyzeEatQuestion $fileId" }
! 4365: default {
! 4366: }
! 4367: }
! 4368: }
! 4369: if { [eof $fileId] } { analyzeEnd $fileId }
! 4370: }
! 4371:
! 4372: ###########################################################
! 4373: # analyzeEnd
! 4374: ###########################################################
! 4375: ###########################################################
! 4376: ###########################################################
! 4377: proc analyzeEnd { fileId } {
! 4378: global gAnalyze
! 4379: if { [eof $fileId] } {
! 4380: fileevent $fileId readable ""
! 4381: catch {close $fileId}
! 4382: if { $gAnalyze(stop) } { return }
! 4383: if { [llength $gAnalyze(toprocess)] > 0 } {
! 4384: analyzeClass 0
! 4385: } else {
! 4386: analyzeUpdate
! 4387: set gAnalyze(status) "Done"
! 4388: }
! 4389: if { !$gAnalyze(update) } {
! 4390: incr gAnalyze(update)
! 4391: analyzeUpdate
! 4392: } else {
! 4393: incr gAnalyze(update)
! 4394: if { $gAnalyze(update) == 10 } {
! 4395: set gAnalyze(update) 0
! 4396: }
! 4397: }
! 4398: }
! 4399: }
! 4400:
! 4401: ###########################################################
! 4402: # analyzeRandom
! 4403: ###########################################################
! 4404: ###########################################################
! 4405: ###########################################################
! 4406: proc analyzeRandom { } {
! 4407: global gAnalyze
! 4408: set numToRun [getString . "How many random students should be run?"]
! 4409: if { $numToRun == "" } { return }
! 4410: if { [catch {incr numToRun} ] } {
! 4411: displayMessage "Invalid number."
! 4412: }
! 4413: incr numToRun -1
! 4414: set gAnalyze(total) $numToRun
! 4415: catch {unset gAnalyze(toprocess)}
! 4416: for { set i 0 } { $i < $numToRun } { incr i } {
! 4417: append gAnalyze(toprocess) "[format "%09d" $i] Random 999 "
! 4418: }
! 4419: set gAnalyze(stop) 0
! 4420: set gAnalyze(update) 1
! 4421: set gAnalyze(done) 0
! 4422: foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
! 4423: analyzeClass 0
! 4424: }
! 4425:
! 4426: ###########################################################
! 4427: # analyzeUpdate
! 4428: ###########################################################
! 4429: ###########################################################
! 4430: ###########################################################
! 4431: proc analyzeUpdate { {newProbNumber 0} } {
! 4432: global gAnalyze
! 4433:
! 4434: if {[catch {set gAnalyze($gAnalyze(prob).ans)}]} { return }
! 4435: foreach problem [array names gAnalyze *.\[alh\]*] {
! 4436: if { [catch {set gAnalyze($problem) [lsort -real $gAnalyze($problem)]}]} {
! 4437: set gAnalyze($problem) [lsort $gAnalyze($problem)]
! 4438: }
! 4439: }
! 4440:
! 4441: set c $gAnalyze(canvas)
! 4442: $c delete all
! 4443: set gAnalyze(lownum) [set low [lindex $gAnalyze($gAnalyze(prob).ans) 0]]
! 4444: set gAnalyze(highnum) [set high [lindex $gAnalyze($gAnalyze(prob).ans) end]]
! 4445: set gAnalyze(numuniq) [llength [lunique $gAnalyze($gAnalyze(prob).ans)]]
! 4446: #don't draw anything if the answers aren't numbers
! 4447: if { [catch {expr $low + 1}]} { update idletask;return }
! 4448:
! 4449: $c create line 25 50 [expr $gAnalyze(canvaswidth) - 25] 50
! 4450: set diff [expr double($high-$low)]
! 4451: if { $diff == 0 } {
! 4452: set center [expr $gAnalyze(canvaswidth)/2.0]
! 4453: $c create oval [expr $center - 2] 48 [expr $center + 2] 52 -fill green
! 4454: update idletasks
! 4455: return
! 4456: }
! 4457: set delta [format "%1.e" [expr ($diff)/15.0]]
! 4458: set start [expr double(int($low/$delta)+1)*$delta]
! 4459: while { $start < $high } {
! 4460: set center [expr ($gAnalyze(canvaswidth)-50)*(($start-$low)/$diff)]
! 4461: set center [expr $center+25]
! 4462: $c create line $center 40 $center 60
! 4463: set start [expr $start + $delta]
! 4464: }
! 4465: if { ($low < 0) && ($high > 0) } {
! 4466: set center [expr ($gAnalyze(canvaswidth)-50)*((0-$low)/$diff)]
! 4467: set center [expr $center+25]
! 4468: $c create rectangle [expr $center - 1] 40 [expr $center + 1] 60
! 4469: }
! 4470: foreach point $gAnalyze($gAnalyze(prob).ans) {
! 4471: set center [expr ($gAnalyze(canvaswidth)-50)*(($point-$low)/$diff)]
! 4472: set center [expr $center+25]
! 4473: $c create oval [expr $center - 2] 48 [expr $center + 2] 52 -fill green
! 4474: }
! 4475:
! 4476: update idletasks
! 4477: }
! 4478:
! 4479: ###########################################################
! 4480: # analyzeStop
! 4481: ###########################################################
! 4482: ###########################################################
! 4483: ###########################################################
! 4484: proc analyzeStop {} {
! 4485: global gAnalyze
! 4486: set gAnalyze(stop) 1
! 4487: set gAnalyze(status) "Stopped"
! 4488: exec kill -SIGKILL $gAnalyze(pid)
! 4489: }
! 4490:
! 4491: ###########################################################
! 4492: # analyzeClose
! 4493: ###########################################################
! 4494: ###########################################################
! 4495: ###########################################################
! 4496: proc analyzeClose { } {
! 4497: global gAnalyze
! 4498: destroy [winfo toplevel $gAnalyze(canvas)]
! 4499: unset gAnalyze
! 4500: global gAnalyze
! 4501: set gAnalyze(exit) 1
! 4502: }
! 4503:
! 4504: ###########################################################
! 4505: # checkIfValidFilename
! 4506: ###########################################################
! 4507: ###########################################################
! 4508: ###########################################################
! 4509: proc checkIfValidFilename {} {
! 4510: global gSetNumberText gPreviewButton
! 4511: if { [regexp \[^0-9\]+ $gSetNumberText] } {
! 4512: displayError "This file is not properly named. \n\nA main assignment file must be named setX.qz, where X is replaced by a number between 1 and 99 inclusive. \n\nPlease do a \"Save .qz As\". \n\nUntil the file is properly named you will not be able to Preview, Create .dvi, or Print."
! 4513: $gPreviewButton configure -state disabled
! 4514: .main entryconfigure 5 -state disabled
! 4515: .main entryconfigure 7 -state disabled
! 4516: return 0
! 4517: }
! 4518: $gPreviewButton configure -state normal
! 4519: .main entryconfigure 5 -state normal
! 4520: .main entryconfigure 7 -state normal
! 4521: return 1
! 4522: }
! 4523:
! 4524: ###########################################################
! 4525: # updateChangeStatus
! 4526: ###########################################################
! 4527: ###########################################################
! 4528: ###########################################################
! 4529: proc updateChangeStatus { name1 name2 op } {
! 4530: global gChanged gRefChanged gRefText gChangedLast gRefChangedLast \
! 4531: gEditWindow gWindowMenu gRefFile
! 4532: if { $name1 == "gChanged" } {
! 4533: if { $gChanged != $gChangedLast } {
! 4534: set gChangedLast $gChanged
! 4535: global gFile
! 4536: if { [catch {set gEditWindow}] } { return }
! 4537: if { ![winfo exists $gEditWindow] } { return }
! 4538: if { $gChanged } {
! 4539: catch {removeWindowEntry "$gFile*"}
! 4540: wm title [winfo toplevel $gEditWindow] "$gFile (Modified)"
! 4541: $gWindowMenu add command -label "$gFile (Modified)" -command \
! 4542: "capaRaise $gEditWindow"
! 4543: } else {
! 4544: catch {removeWindowEntry "$gFile*"}
! 4545: wm title [winfo toplevel $gEditWindow] "$gFile"
! 4546: $gWindowMenu add command -label "$gFile" -command \
! 4547: "capaRaise $gEditWindow"
! 4548: }
! 4549: }
! 4550: } else {
! 4551: if { $gRefChanged($name2) != $gRefChangedLast($name2) } {
! 4552: if { [catch {set gRefText($name2)}] } { return }
! 4553: if { ![winfo exists $gRefText($name2)] } { return }
! 4554: if { $gRefChanged($name2) } {
! 4555: catch {removeWindowEntry "Reference $gRefFile($name2)*" }
! 4556: wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2) (Modified)"
! 4557: $gWindowMenu add command -label "Reference $gRefFile($name2) (Modified)" \
! 4558: -command "capaRaise [winfo toplevel $gRefText($name2)]"
! 4559: } else {
! 4560: catch {removeWindowEntry "Reference $gRefFile($name2)*" }
! 4561: wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2)"
! 4562: $gWindowMenu add command -label "Reference $gRefFile($name2)" \
! 4563: -command "capaRaise [winfo toplevel $gRefText($name2)]"
! 4564: }
! 4565: }
! 4566: }
! 4567: }
! 4568: ###########################################################
! 4569: # main
! 4570: ###########################################################
! 4571: # sets up the auto_path variable, some globals and adds some
! 4572: # options then calls createControlWindow to give the user something
! 4573: # to do
! 4574: ###########################################################
! 4575: # Arguments: None
! 4576: # Returns: Nothing
! 4577: # Globals:
! 4578: ###########################################################
! 4579:
! 4580: source quizzer.templates.tcl
! 4581:
! 4582: if { [lindex $auto_path 0] == "./lib/tcl7.5" } {
! 4583: set auto_path ""
! 4584: lappend auto_path [pwd]/lib/tcl7.5
! 4585: lappend auto_path [pwd]/lib/tk4.1
! 4586: }
! 4587:
! 4588: lappend auto_path /usr/local/lib/CAPA45/Quizzer
! 4589: lappend auto_path [pwd]
! 4590:
! 4591: set font 8x13bold
! 4592: catch {
! 4593: if { $argc > 0 } {
! 4594: switch -glob -- [lindex $argv 0] {
! 4595: {-[Ll]*} { set font 9x15bold }
! 4596: {-[Mm]*} -
! 4597: {-[Nn]*} { set font 8x13bold }
! 4598: {-[Ss]*} { set font fixed }
! 4599: }
! 4600: }
! 4601: }
! 4602: option add *font $font
! 4603: createControlWindow
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to quizzer.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools