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 gEnableDiscussion gFile
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 optionFrame [frame $dialog.options]
1186: set buttonFrame [frame $dialog.buttons -bd 10]
1187: pack $dialog.msg $loadFrame $infoFrame $optionFrame $buttonFrame -side top -fill x
1188:
1189: set legendFrame [frame $infoFrame.legendFrame]
1190: set listFrame [frame $infoFrame.listFrame]
1191: set commandFrame [frame $infoFrame.commandFrame]
1192: pack $legendFrame $listFrame $commandFrame -side top
1193:
1194: label $legendFrame.legend1 -text " Section# | Open | Due | Answer "
1195: label $legendFrame.legend2 -text "Start End| Date Time | Date Time | Date Time "
1196: pack $legendFrame.legend1 $legendFrame.legend2 -side top
1197:
1198: set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ]
1199: scrollbar $listFrame.scroll -command "$listbox yview"
1200: pack $listFrame.list $listFrame.scroll -side left
1201: updateDateBox $listbox
1202:
1203: button $commandFrame.add -text "Add" -command "addDate $listbox"
1204: button $commandFrame.change -text "Change" -command "changeDate $listbox"
1205: button $commandFrame.delete -text "Delete" -command "deleteDate $listbox"
1206: pack $commandFrame.add $commandFrame.change $commandFrame.delete -side left
1207: bind $listbox <Double-ButtonPress-1> "changeDate $listbox"
1208:
1209: message $loadFrame.msg -text "Load header information from set:" \
1210: -aspect 1000
1211: set gLoadHeaderSet $gSetNumberText
1212: entry $loadFrame.entry -textvariable gLoadHeaderSet -width 2
1213: button $loadFrame.load -text "load" -command "loadDates $listbox"
1214: pack $loadFrame.msg $loadFrame.entry $loadFrame.load -side left
1215:
1216: if { [file exists [file join [file dirname $gFile] discussion $gSetNumberText]] } {
1217: set gEnableDiscussion 1
1218: } else {
1219: set gEnableDiscussion 0
1220: }
1221: checkbutton $optionFrame.discuss -text "Enable Discussion Forum" \
1222: -variable gEnableDiscussion
1223: pack $optionFrame.discuss
1224:
1225: button $buttonFrame.ok -text Set -command { set gPrompt(ok) 1 } \
1226: -underline 0
1227: button $buttonFrame.cancel -text Cancel -command { set gPrompt(ok) 0 } \
1228: -underline 0
1229: pack $buttonFrame.ok $buttonFrame.cancel -side left
1230:
1231: bind $dialog <Destroy> "set gPrompt(ok) 0"
1232: Centre_Dialog $dialog default
1233: update
1234:
1235: focus $dialog
1236: capaRaise $dialog
1237: capaGrab $dialog
1238: bind $dialog <Destroy> ""
1239: set done 0
1240: while { $done != 1 } {
1241: vwait gPrompt(ok)
1242: if { $gPrompt(ok) == 1 } {
1243: set done [checkHeaderForDefault]
1244: if { $done == 0 } {
1245: displayError "Must have a Default setting."
1246: }
1247: } else {
1248: set done 1
1249: }
1250: }
1251: capaGrab release $dialog
1252: destroy $dialog
1253: if {$gPrompt(ok) == 1 } {
1254: updateDiscussion
1255: eval updateHeader [ eval concat $gControlDates ]
1256: }
1257:
1258: return
1259:
1260: }
1261:
1262: ###########################################################
1263: # updateDiscussion
1264: ###########################################################
1265: ###########################################################
1266: ###########################################################
1267: proc updateDiscussion {} {
1268: global gFile gSetNumberText gEnableDiscussion
1269: set dir [file dirname $gFile]
1270: set disDir [file join $dir discussion $gSetNumberText]
1271: set logDir [file join $dir discussion logs]
1272: if { $gEnableDiscussion } {
1273: if { ![file exists $disDir] } {
1274: if { [file exists $disDir.unavailable] } {
1275: exec mv $disDir.unavailable $disDir
1276: } else {
1277: file mkdir $disDir
1278: file attributes $disDir -permissions 0777
1279: }
1280: }
1281: if { ![file exists $logDir] } {
1282: file mkdir [file join $dir discussion logs]
1283: file attributes [file join $dir discussion logs] -permissions 0777
1284: }
1285: } else {
1286: if { [file exists $disDir] } { exec mv $disDir $disDir.unavailable }
1287: }
1288: }
1289:
1290: ###########################################################
1291: # allFieldsComplete2
1292: ###########################################################
1293: ###########################################################
1294: ###########################################################
1295: proc allFieldsComplete2 {} {
1296: global gLoadHeaderSet gControlDates
1297:
1298: if { [string length $gOpenDate] != 8 } {
1299: return 0
1300: } elseif { [string length $gOpenTime] != 5 } {
1301: return 0
1302: } elseif { [string length $gDueDate] != 8 } {
1303: return 0
1304: } elseif { [string length $gDueTime] != 5 } {
1305: return 0
1306: } elseif { [string length $gAnswerDate] != 8 } {
1307: return 0
1308: } elseif { [string length $gAnswerTime] != 5 } {
1309: return 0
1310: } else {
1311: return 1
1312: }
1313: }
1314:
1315: ###########################################################
1316: # createFindWindow
1317: ###########################################################
1318: ###########################################################
1319: ###########################################################
1320: proc createFindWindow { {num 0} } {
1321: global gFind gWindowMenu gFindListbox
1322:
1323: if { [winfo exists .find] } {
1324: capaRaise .find
1325: pickFindFile $num
1326: return
1327: }
1328:
1329: set find [toplevel .find]
1330: $gWindowMenu add command -label "Find" -command "capaRaise $find"
1331: wm title $find "Find"
1332:
1333: set findFrame [frame $find.findFrame -width 5i]
1334: set replaceFrame [frame $find.replaceFrame ]
1335: set optionsFrame [frame $find.optionsFrame ]
1336: set buttonFrame [frame $find.buttonsFrame ]
1337: pack $findFrame $replaceFrame $optionsFrame $buttonFrame -side top \
1338: -anchor e
1339: pack configure $buttonFrame -anchor center
1340:
1341: message $findFrame.msg -text "Find:" -aspect 10000
1342: entry $findFrame.entry -width 50 -textvariable gFind(find)
1343: pack $findFrame.msg $findFrame.entry -side left
1344:
1345: message $replaceFrame.msg -text "Replace with:" -aspect 10000
1346: entry $replaceFrame.entry -width 50 -textvariable gFind(replace)
1347: pack $replaceFrame.msg $replaceFrame.entry -side left
1348:
1349: set fileFrame [frame $optionsFrame.file]
1350: set scopeFrame [frame $optionsFrame.scope -relief groove -borderwidth 4]
1351: set findOptionsFrame [frame $optionsFrame.findOptionsFrame -relief \
1352: groove -borderwidth 4]
1353: pack $fileFrame $scopeFrame $findOptionsFrame -side left
1354:
1355: set fileList [ frame $fileFrame.list ]
1356: set fileScroll [frame $fileFrame.scroll ]
1357: pack $fileList $fileScroll -side left
1358: pack configure $fileScroll -fill y
1359:
1360: set gFindListbox [listbox $fileList.list -width 35 -height 4 \
1361: -xscrollcommand "$fileList.scroll set" \
1362: -yscrollcommand "$fileScroll.scroll set" \
1363: -exportselection no]
1364: scrollbar $fileList.scroll -orient h -command "$fileList.list xview"
1365: pack $fileList.list $fileList.scroll -side top
1366: pack configure $fileList.scroll -fill x
1367: pack configure $fileList.list -fill both -expand 1
1368: $fileList.list xview moveto 1
1369:
1370: scrollbar $fileScroll.scroll -orient v \
1371: -command "$fileList.list yview"
1372: pack $fileScroll.scroll -fill y -expand 1
1373:
1374: message $scopeFrame.msg -text "Replace All Scope" -aspect 10000
1375: radiobutton $scopeFrame.file -value "File" -variable gFind(scope) -text \
1376: "Entire File" \
1377:
1378: radiobutton $scopeFrame.selection -value "Selection" -variable \
1379: gFind(scope) -text "Selection"
1380: pack $scopeFrame.msg $scopeFrame.file $scopeFrame.selection
1381: pack configure $scopeFrame.file $scopeFrame.selection -anchor w
1382: set gFind(scope) File
1383:
1384: message $findOptionsFrame.msg -text "Find Options" -aspect 10000
1385: radiobutton $findOptionsFrame.ignoreCase -variable gFind(findOption) \
1386: -text "Ignore Case" -value "-nocase"
1387: radiobutton $findOptionsFrame.exactCase -variable gFind(findOption) \
1388: -text "Exact Case" -value "-exact"
1389: radiobutton $findOptionsFrame.regexp -variable gFind(findOption) \
1390: -text "Regular Expression" -value "-regexp"
1391: pack $findOptionsFrame.msg $findOptionsFrame.ignoreCase \
1392: $findOptionsFrame.exactCase $findOptionsFrame.regexp
1393: pack $findOptionsFrame.ignoreCase $findOptionsFrame.exactCase \
1394: $findOptionsFrame.regexp -anchor w
1395: set gFind(findOption) "-nocase"
1396:
1397: button $buttonFrame.replaceAll -text "Replace All" -command "replaceAll"
1398: button $buttonFrame.replace -text "Replace" -command "replace"
1399: button $buttonFrame.replaceFind -text "Replace and Find" -command \
1400: "replaceFind"
1401: button $buttonFrame.previous -text "Previous" -command "previous"
1402: button $buttonFrame.next -text "Next <Return>" -command "next"
1403: bind $find <KeyPress-Return> next
1404: button $buttonFrame.close -text "Close" -command "removeWindowEntry Find
1405: destroy $find"
1406: bind $find <Destroy> "removeWindowEntry Find"
1407: pack $buttonFrame.replaceAll $buttonFrame.replace \
1408: $buttonFrame.replaceFind $buttonFrame.previous \
1409: $buttonFrame.next $buttonFrame.close -side left
1410:
1411: Centre_Dialog $find default
1412: updateFindList
1413: pickFindFile $num
1414: }
1415:
1416: ###########################################################
1417: # pickFindFile
1418: ###########################################################
1419: ###########################################################
1420: ###########################################################
1421: proc pickFindFile { num } {
1422: global gFindListbox gFindList gRefFile gFile
1423: if { [catch {set gFindListbox}] } { return }
1424: if { ![winfo exists $gFindListbox] } { return }
1425: if { $num == 0 } {
1426: set newfile $gFile
1427: } else {
1428: set newfile $gRefFile($num)
1429: }
1430: for {set i 0} {$i<[llength $gFindList(files)]} {incr i} {
1431: set file [lindex $gFindList(files) $i]
1432: if { $file == $newfile } { break }
1433: }
1434: if { $i < [llength $gFindList(files)] } {
1435: $gFindListbox selection clear 0 end
1436: $gFindListbox selection set $i
1437: }
1438: }
1439:
1440: ###########################################################
1441: # updateFindList
1442: ###########################################################
1443: ###########################################################
1444: ###########################################################
1445: proc updateFindList {} {
1446: global gFindListbox gFindList
1447: if { [catch {set gFindListbox}] } { return }
1448: if { ![winfo exists $gFindListbox] } { return }
1449: $gFindListbox delete 0 end
1450: eval "$gFindListbox insert end $gFindList(files)"
1451: $gFindListbox xview moveto 1
1452: }
1453:
1454: ###########################################################
1455: # whichFile
1456: ###########################################################
1457: ###########################################################
1458: ###########################################################
1459: proc whichFile { refNum } {
1460: global gRefFile gFile
1461: if { $refNum > 0 } {
1462: return $gRefFile($refNum)
1463: } else {
1464: if { $refNum < 0 } {
1465: switch -- $refNum {
1466: -1 { return "Preview Window" }
1467: -2 { return "Parse Errors Window" }
1468: -3 { return "LaTeX Output Window" }
1469: }
1470: } else {
1471: return $gFile
1472: }
1473: }
1474: }
1475: ###########################################################
1476: # addFindList
1477: ###########################################################
1478: ###########################################################
1479: ###########################################################
1480: proc addFindList { {refNum 0} } {
1481: global gFindList gRefFile gFile
1482:
1483: set file [whichFile $refNum]
1484: lappend gFindList(files) $file
1485: lappend gFindList(refNum) $refNum
1486: updateFindList
1487: }
1488:
1489: ###########################################################
1490: # removeFindList
1491: ###########################################################
1492: ###########################################################
1493: ###########################################################
1494: proc removeFindList { {refNum 0} } {
1495: global gFindList gRefFile gFile
1496:
1497: set file [whichFile $refNum]
1498: set k [llength $gFindList(refNum)]
1499: for {set i 0} {$i < $k } { incr i } {
1500: if { $refNum == [lindex $gFindList(refNum) $i] } { break }
1501: }
1502: if { $i != $k } {
1503: set gFindList(refNum) [lreplace $gFindList(refNum) $i $i]
1504: set gFindList(files) [lreplace $gFindList(files) $i $i]
1505: }
1506: updateFindList
1507: }
1508:
1509: ###########################################################
1510: # getFindWindow
1511: ###########################################################
1512: ###########################################################
1513: ###########################################################
1514: proc getFindWindow { {refNumVar none} } {
1515: global gFindListbox gFindList gRefText gTextWindow \
1516: gPreviewText gParseErrorsText gCreateDviText
1517:
1518: set current [$gFindListbox curselection]
1519: if { $current == "" } { set current 0 }
1520: if { [set refNum [lindex $gFindList(refNum) $current] ] } {
1521: if { $refNum < 0 } {
1522: switch -- $refNum {
1523: -1 { set window $gPreviewText }
1524: -2 { set window $gParseErrorsText }
1525: -3 { set window $gCreateDviText }
1526: }
1527: } else {
1528: set window $gRefText($refNum)
1529: }
1530: } else {
1531: set window $gTextWindow
1532: }
1533: if { $refNumVar != "none" } {
1534: upvar $refNumVar refNumUp
1535: set refNumUp $refNum
1536: }
1537: return $window
1538: }
1539:
1540: ###########################################################
1541: # replaceAll
1542: ###########################################################
1543: ###########################################################
1544: ###########################################################
1545: proc replaceAll {} {
1546: global gFind gCreateImportLinks
1547:
1548: set window [getFindWindow]
1549: if { ![winfo exists $window] } { return }
1550:
1551: set gCreateImportLinks 0
1552: set num 0
1553: switch $gFind(scope) {
1554: File
1555: {
1556: $window mark set insert 0.0
1557: set begin 0.0
1558: while { [nextRegion $begin end] != "" } {
1559: incr num
1560: replace
1561: if { ! ($num%10) } { update idletasks }
1562: set begin sel.last
1563: }
1564: }
1565: Selection
1566: {
1567: set error [ catch {$window mark set replace sel.first}]
1568: if { $error != 0 } { return }
1569: $window mark set capaBegin sel.first
1570: $window mark set capaEnd sel.last
1571: while { [set begin [nextRegion capaBegin capaEnd]] != "" } {
1572: incr num
1573: replace
1574: $window mark set capaBegin $begin
1575: }
1576: }
1577: }
1578: if { $num == 1 } { set s {} } { set s s }
1579: update idletasks
1580: set gCreateImportLinks 1
1581: getFindWindow refNum
1582: if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end }
1583: displayMessage "Replaced $num occurance$s"
1584: }
1585:
1586: ###########################################################
1587: ###########################################################
1588: ###########################################################
1589: ###########################################################
1590: proc replace {} {
1591: global gFind
1592:
1593: set refNum 0
1594: set window [getFindWindow refNum]
1595: if { ![winfo exist $window] } { return }
1596:
1597: set error [ catch {$window mark set replace sel.first}]
1598: if { $error == 0 } {
1599: $window delete sel.first sel.last
1600: } else {
1601: $window mark set replace insert
1602: }
1603:
1604: $window insert replace "$gFind(replace)"
1605:
1606: catch {$window tag remove sel sel.first sel.last}
1607:
1608: $window tag add sel "replace - [string length "$gFind(replace)"] \
1609: chars " replace
1610: $window see replace
1611:
1612: $window mark unset replace
1613: }
1614:
1615: ###########################################################
1616: ###########################################################
1617: ###########################################################
1618: ###########################################################
1619: proc replaceFind {} {
1620: set window [getFindWindow]
1621: if { ![winfo exists $window] } { return }
1622: replace
1623: next
1624: }
1625:
1626: ###########################################################
1627: ###########################################################
1628: ###########################################################
1629: ###########################################################
1630: proc searchBody { found } {
1631: global gFind
1632:
1633: set window [getFindWindow refNum]
1634: if { ![winfo exists $window] } { return }
1635:
1636: catch {$window tag remove sel sel.first sel.last}
1637: $window tag add sel $found "$found + [string length $gFind(find)] \
1638: chars"
1639: $window see $found
1640: $window mark set insert "$found + [string length $gFind(find)] chars"
1641: }
1642:
1643: ###########################################################
1644: ###########################################################
1645: ###########################################################
1646: ###########################################################
1647: proc previous {} {
1648: global gFind
1649:
1650: set window [getFindWindow]
1651: if { ![winfo exists $window] } { return }
1652:
1653: if { [catch { set found [$window search $gFind(findOption) -backwards -- \
1654: $gFind(find) "sel.first - 1 c" ] } ] } {
1655: set found [ $window search $gFind(findOption) -backwards -- \
1656: $gFind(find) "insert - 1 c" ]
1657: }
1658: if { $found != "" } { searchBody $found }
1659: return $found
1660: }
1661:
1662: ###########################################################
1663: ###########################################################
1664: ###########################################################
1665: ###########################################################
1666: proc next {} {
1667: global gFind
1668:
1669: set window [getFindWindow]
1670: if { ![winfo exists $window] } { return }
1671:
1672: set found [ $window search $gFind(findOption) -forwards -- \
1673: $gFind(find) "insert + 1 c" ]
1674: if { $found != "" } {
1675: searchBody $found
1676: } else {
1677: displayMessage "Search String Not Found"
1678: }
1679: return $found
1680: }
1681:
1682: ###########################################################
1683: ###########################################################
1684: ###########################################################
1685: ###########################################################
1686: proc nextRegion { begin end } {
1687: global gFind
1688:
1689: set window [getFindWindow]
1690: if { ![winfo exists $window] } { return }
1691:
1692: set error [ catch {set found [ $window search $gFind(findOption) \
1693: -forwards -- $gFind(find) $begin $end ] } ]
1694: if { $error != 0 } { set found "" }
1695: if { $found != "" } {
1696: searchBody $found
1697: set found "$found + [string length $gFind(find)] chars"
1698: }
1699: return $found
1700: }
1701:
1702: ###########################################################
1703: ###########################################################
1704: ###########################################################
1705: ###########################################################
1706: proc createLineWindow {} {
1707: global gLineNumber gCharacterNumber gLineNumberGoto gCharacterNumberGoto
1708: global gWindowMenu
1709:
1710: if { [winfo exists .lineWindow] } {
1711: capaRaise .lineWindow
1712: return
1713: }
1714:
1715: set lineWindow [toplevel .lineWindow]
1716: $gWindowMenu add command -label "LineSelect" -command \
1717: "capaRaise $lineWindow"
1718: wm title $lineWindow "Select Line"
1719:
1720: label $lineWindow.line -text "Line:"
1721: grid $lineWindow.line -column 1 -row 0
1722: label $lineWindow.character -text "Character:"
1723: grid $lineWindow.character -column 2 -row 0
1724: label $lineWindow.current -text "Current:"
1725: grid $lineWindow.current -column 0 -row 1
1726: label $lineWindow.lineNumber -textvariable gLineNumber
1727: grid $lineWindow.lineNumber -column 1 -row 1
1728: label $lineWindow.characterNumber -textvariable gCharacterNumber
1729: grid $lineWindow.characterNumber -column 2 -row 1
1730: label $lineWindow.goto -text "Goto:"
1731: grid $lineWindow.goto -column 0 -row 2
1732: entry $lineWindow.lineEntry -textvariable gLineNumberGoto
1733: grid $lineWindow.lineEntry -column 1 -row 2
1734: set gLineNumberGoto ""
1735: entry $lineWindow.characterEntry -textvariable gCharacterNumberGoto
1736: grid $lineWindow.characterEntry -column 2 -row 2
1737: set gCharacterNumberGoto ""
1738: button $lineWindow.close -text "Close" -command "destroy $lineWindow
1739: removeWindowEntry LineSelect"
1740: bind $lineWindow <Destroy> "removeWindowEntry LineSelect"
1741: grid $lineWindow.close -column 1 -row 3
1742: button $lineWindow.gotoButton -text "Goto<Return>" -command "gotoLine"
1743: grid $lineWindow.gotoButton -column 2 -row 3
1744:
1745: bind $lineWindow <KeyPress-Return> gotoLine
1746:
1747: Centre_Dialog $lineWindow default
1748: }
1749:
1750: ###########################################################
1751: ###########################################################
1752: ###########################################################
1753: ###########################################################
1754: proc gotoLine {} {
1755: global gTextWindow gLineNumberGoto gCharacterNumberGoto
1756: if { [catch {set gTextWindow}] } { return }
1757: if { ![winfo exists $gTextWindow] } { return }
1758:
1759: if { $gCharacterNumberGoto == "" } {
1760: if { $gLineNumberGoto == "" } {
1761: return
1762: } else {
1763: $gTextWindow mark set insert $gLineNumberGoto.0
1764: catch {$gTextWindow tag remove sel sel.first sel.last}
1765: $gTextWindow tag add sel "insert linestart" "insert lineend"
1766: $gTextWindow see insert
1767: }
1768: } else {
1769: if { $gLineNumberGoto == "" } {
1770: $gTextWindow mark set insert "insert linestart + \
1771: $gCharacterNumberGoto chars"
1772: catch {$gTextWindow tag remove sel sel.first sel.last}
1773: $gTextWindow tag add sel "insert - 1 chars " insert
1774: $gTextWindow see insert
1775: } else {
1776: $gTextWindow mark set insert $gLineNumberGoto.$gCharacterNumberGoto
1777: catch {$gTextWindow tag remove sel sel.first sel.last}
1778: $gTextWindow tag add sel "$gLineNumberGoto.$gCharacterNumberGoto \
1779: - 1 chars " "$gLineNumberGoto.$gCharacterNumberGoto"
1780: $gTextWindow see insert
1781: }
1782: }
1783: }
1784:
1785: proc faster {} {
1786: global gFasterParsing
1787: puts $gFasterParsing
1788: }
1789:
1790: ###########################################################
1791: # createPrefsWindow
1792: ###########################################################
1793: ###########################################################
1794: ###########################################################
1795: proc createPrefsWindow {} {
1796: global gPrefs gWindowMenu gEditWindow gFile gWhichFile gPrefsEditWindow \
1797: gFasterParsing
1798: if { [catch {set gEditWindow}] } { return }
1799: if { ![winfo exists $gEditWindow] } { return }
1800: if { [winfo exists .prefs] } { capaRaise .prefs; return }
1801:
1802: set prefs [toplevel .prefs]
1803: $gWindowMenu add command -label "Prefrences" -command "capaRaise $prefs"
1804: wm title $prefs "Preferences"
1805:
1806: set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4]
1807: pack $frameAll -expand true -fill both
1808:
1809: set frameFile [frame $frameAll.file]
1810: set frameInfo [frame $frameAll.info -relief groove -borderwidth 4 ]
1811: set frameButton [frame $frameAll.button ]
1812: pack $frameButton $frameInfo $frameFile -side top -expand false
1813: pack configure $frameButton -expand false -anchor center
1814:
1815: message $frameInfo.msg -text "Print Out"
1816: radiobutton $frameInfo.problem -text "Problems Only" -value "Problem" \
1817: -variable gPrefs(info)
1818: radiobutton $frameInfo.problemandanswer -text "Problems and Answers" \
1819: -value "ProblemAnswer" -variable gPrefs(info)
1820: radiobutton $frameInfo.answer -text "Answers Only" -value "Answer" \
1821: -variable gPrefs(info)
1822: pack $frameInfo.msg $frameInfo.problem $frameInfo.problemandanswer \
1823: $frameInfo.answer -side left -expand false -anchor w
1824:
1825:
1826: set selectMenu [tk_optionMenu $frameFile.menu gWhichFile HTMLheader HTMLfooter \
1827: TeXheader TeXfooter]
1828: set frameEdit [frame $frameFile.edit]
1829: pack $frameFile.menu $frameEdit
1830: pack configure $frameEdit -expand true -fill both
1831: trace variable gWhichFile w changePrefFile
1832:
1833: scrollbar $frameEdit.scroll -orient vertical -command "$frameEdit.text yview"
1834: set gPrefsEditWindow [text $frameEdit.text -yscrollcommand \
1835: "$frameEdit.scroll set" -wrap char -height 20 -width 80]
1836: pack $frameEdit.scroll $frameEdit.text -side left
1837: pack configure $frameEdit.scroll -expand false -fill y
1838: pack configure $frameEdit.text -expand true -fill both
1839:
1840: checkbutton $frameButton.faster -text "Faster Parsing" -command faster \
1841: -variable gFasterParsing
1842: button $frameButton.impcolor -text "/IMP color" -command "getColor IMP_color"
1843: button $frameButton.commentcolor -text "// color" -command "getColor comment_color"
1844: button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig"
1845: button $frameButton.ok -text "Dismiss" -command "destroy $prefs
1846: trace vdelete gWhichFile w changePrefFile
1847: removeWindowEntry Prefrences"
1848: bind $prefs <Destroy> "removeWindowEntry Preferences"
1849: button $frameButton.save -text "Save All" -command "savePrefs"
1850: pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \
1851: $frameButton.ok $frameButton.save $frameButton.faster -side left
1852:
1853: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
1854: if { [ catch {
1855: set filename [file join [file dirname $gFile] $file ]
1856: set fileId [open $filename r]
1857: set gPrefs($file) [read $fileId [file size $filename ]]
1858: close $fileId } errors ] } {
1859: set gPrefs($file) ""
1860: }
1861: }
1862: set gPrefs(currentFile) ""
1863: set gWhichFile HTMLheader
1864:
1865:
1866: Centre_Dialog $prefs default
1867: }
1868:
1869: ###########################################################
1870: # getColor
1871: ###########################################################
1872: ###########################################################
1873: ###########################################################
1874: proc getColor { whatfor } {
1875: global gCapaConfig gUniqueNumber gRefText
1876: set color [tk_chooseColor -initialcolor $gCapaConfig($whatfor)]
1877: set gCapaConfig($whatfor) $color
1878: if { $color != "" } { updateColors }
1879: displayMessage "To keep this color, put \"$whatfor = $color\" in the capa.config file."
1880: }
1881:
1882: ###########################################################
1883: # updateColors
1884: ###########################################################
1885: ###########################################################
1886: ###########################################################
1887: proc updateColors {} {
1888: global gCapaConfig gUniqueNumber gRefText
1889: set todo [array names gRefText]
1890: lappend todo 0
1891: displayStatus "Updating Colors . . ." both
1892: set num 0
1893: foreach win $todo {
1894: createImportLinks $win 0.0 end
1895: incr num
1896: updateStatusBar [expr $num/double([llength $todo])]
1897: }
1898: removeStatus
1899: }
1900:
1901: ###########################################################
1902: # changePrefFile
1903: ###########################################################
1904: ###########################################################
1905: ###########################################################
1906: proc changePrefFile { var1 var2 op } {
1907: global gPrefs gPrefsEditWindow gFile gWhichFile
1908:
1909: if { $gPrefs(currentFile) != "" } {
1910: set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
1911: }
1912: set gPrefs(currentFile) $gWhichFile
1913: $gPrefsEditWindow delete 0.0 end
1914: $gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
1915: }
1916:
1917: ###########################################################
1918: # updatePrefsWindow
1919: ###########################################################
1920: ###########################################################
1921: ###########################################################
1922: proc updatePrefsWindow {} {
1923: global gPrefs gPrefsEditWindow gFile gWhichFile
1924: if { [catch {set gPrefsEditWindow}] } { return }
1925: if { ![winfo exists $gPrefsEditWindow] } { return }
1926:
1927: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
1928: if { [ catch {
1929: set filename [file join [file dirname $gFile] $file ]
1930: set fileId [open $filename r]
1931: set gPrefs($file) [read $fileId [file size $filename]]
1932: close $fileId } ] } {
1933: set gPrefs($file) ""
1934: }
1935: }
1936: $gPrefsEditWindow delete 0.0 end
1937: $gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
1938: }
1939:
1940: ###########################################################
1941: ###########################################################
1942: ###########################################################
1943: ###########################################################
1944: proc savePrefs {} {
1945: global gPrefsEditWindow gFile gPrefs
1946: if { [catch {set gPrefsEditWindow}] } { return }
1947: if { ![winfo exists $gPrefsEditWindow] } { return }
1948: if { $gPrefs(currentFile) != "" } {
1949: set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
1950: }
1951: foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
1952: if { $gPrefs($file) != "" } {
1953: set fileId [open [file join [file dirname $gFile] $file ] w]
1954: puts -nonewline $fileId $gPrefs($file)
1955: close $fileId
1956: } else {
1957: exec rm -f [file join [file dirname $gFile] $file ]
1958: }
1959: }
1960: }
1961:
1962: ###########################################################
1963: # checkHeader
1964: ###########################################################
1965: ###########################################################
1966: ###########################################################
1967: proc checkHeader { numberParsed } {
1968: global gWeightsDiffer gPartialDiffer gSetNumberText gHeaderQCount \
1969: gControlDates gLoadHeaderSet gFirstTime
1970:
1971: # if { $gFirstTime } { set gFirstTime 0; return }
1972: set gLoadHeaderSet $gSetNumberText
1973: set error [catch {getHeaderInfo}]
1974: if { $error == 1 } {
1975: set gHeaderQCount "0"
1976: set gControlDates ""
1977: displayError "The db file for this set does not yet exist."
1978: } else {
1979: set errortext ""
1980: if { ( $numberParsed != $gHeaderQCount ) } {
1981: set error 1
1982: append errortext "Number of questions ($numberParsed) is different from the number in setX.db ($gHeaderQCount). "
1983: }
1984: if { $gWeightsDiffer } {
1985: set error 1
1986: append errortext "The problem weights specified in the QZ file are different from the ones in the DB file. "
1987: }
1988: if { $gPartialDiffer } {
1989: set error 1
1990: append errortext "Whether or not a problem is hand graded as specified in the QZ file is different from the DB file. "
1991: }
1992: if { $error } {
1993: displayError "The curent DB Header does not match what the set file says it should be: $errortext. Set the DB Header!" red
1994: }
1995: }
1996: return $error
1997: }
1998:
1999: ###########################################################
2000: # fillInStudentName
2001: ###########################################################
2002: ###########################################################
2003: ###########################################################
2004: #proc notherefillInStudentName { v } {
2005: # global $v
2006:
2007: # set student [capaGetStudent [set ${v}(studentNumber)]]
2008: # set ${v}(studentName) [lindex $student [expr [llength $student] - 1] ]
2009: #}
2010:
2011: ###########################################################
2012: # studentSelectWindow
2013: ###########################################################
2014: ###########################################################
2015: ###########################################################
2016: proc studentSelectWindow { followupCommand } {
2017: global gStudentSelection gChanged gWindowMenu gEditWindow
2018: if { [catch {set gEditWindow}] } { return }
2019: if { ![winfo exists $gEditWindow] } { return }
2020: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
2021:
2022: if { [winfo exists .studentSelect] } {
2023: capaRaise .studentSelect
2024: return
2025: }
2026: set student [toplevel .studentSelect]
2027: $gWindowMenu add command -label "SelectStudent" \
2028: -command "capaRaise $student"
2029: wm title $student "Select Student"
2030:
2031: message $student.msg -text "Please specify a student to preview" \
2032: -aspect 10000
2033: set infoFrame [frame $student.frame -relief groove -borderwidth 4]
2034: set buttonFrame [frame $student.buttonFrame ]
2035: pack $student.msg $infoFrame $buttonFrame -side top
2036:
2037: button $buttonFrame.ok -text "Preview" -command \
2038: "selectStudentPreview $student $followupCommand"
2039: button $buttonFrame.cancel -text "Cancel" -command \
2040: "destroy $student
2041: trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
2042: trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
2043: removeWindowEntry SelectStudent"
2044: bind $student <Destroy> \
2045: "trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
2046: trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
2047: removeWindowEntry SelectStudent"
2048: pack $buttonFrame.ok $buttonFrame.cancel -side left
2049:
2050: set randomAnyFrame [frame $infoFrame.randomany]
2051: set randomFrame [frame $infoFrame.random]
2052: set specificFrame [frame $infoFrame.specific]
2053: set sectionFrame [frame $infoFrame.section]
2054: # pack $randomAnyFrame $randomFrame $specificFrame $sectionFrame -side top
2055: pack $randomFrame $specificFrame -side top
2056: pack configure $specificFrame -expand true -fill both
2057:
2058: radiobutton $randomAnyFrame.random -text "Randomly select a student" \
2059: -value "RandomAny" -variable gStudentSelection(type)
2060: pack $randomAnyFrame.random
2061:
2062: radiobutton $randomFrame.random -text "Randomly select one student \
2063: from section:" -value "Random" -variable gStudentSelection(type)
2064: entry $randomFrame.entry -textvariable gStudentSelection(random) -width 3
2065: pack $randomFrame.random $randomFrame.entry -side left
2066:
2067: radiobutton $specificFrame.specific -text "Specify the student by:" \
2068: -value "Specific" -variable gStudentSelection(type)
2069: set studentNumber [frame $specificFrame.studentNumber]
2070: set fullName [frame $specificFrame.fullName]
2071: pack $specificFrame.specific $studentNumber $fullName -side top
2072: pack configure $specificFrame.specific -anchor w
2073: pack configure $studentNumber $fullName -anchor e
2074:
2075: radiobutton $sectionFrame.section
2076: message $studentNumber.msg -text "Student Number: " -aspect 10000
2077: entry $studentNumber.entry -textvariable gStudentSelection(studentNumber) \
2078: -width 9 -validate key -validatecommand "limitEntry %W 9 any %P"
2079: pack $studentNumber.msg $studentNumber.entry -side left
2080:
2081: message $fullName.msg -text "Student Name: " -aspect 10000
2082: entry $fullName.msg2 -textvariable gStudentSelection(studentName) -width 35 \
2083: -validate key -validatecommand "limitEntry %W 35 any %P"
2084: pack $fullName.msg $fullName.msg2 -side left
2085:
2086: trace variable gStudentSelection(studentNumber) w \
2087: "global gStudentSelection; set gStudentSelection(type) Specific ;#"
2088: trace variable gStudentSelection(studentName) w \
2089: "global gStudentSelection; set gStudentSelection(type) Specific ;#"
2090:
2091: bind $studentNumber.entry <KeyPress-Return> \
2092: "fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 0"
2093: bind $fullName.msg2 <KeyPress-Return> \
2094: "fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 1"
2095: # $specificFrame.specific configure -command \
2096: "$studentNumber.entry configure -state normal"
2097: # $randomFrame.random configure -command \
2098: "$studentNumber.entry configure -state disabled"
2099:
2100: Centre_Dialog $student default
2101: }
2102:
2103: ###########################################################
2104: # selectStudentPreview
2105: ###########################################################
2106: ###########################################################
2107: ###########################################################
2108: proc selectStudentPreview { student followupCommand} {
2109: global gStudentSelection
2110: destroy $student
2111: if { $gStudentSelection(type) == "Specific" } {
2112: if {$gStudentSelection(studentNumber) == ""} {
2113: fillInStudent gStudentSelection(studentName) \
2114: gStudentSelection(studentNumber) 1
2115: } else {
2116: fillInStudent gStudentSelection(studentName) \
2117: gStudentSelection(studentNumber) 0
2118: }
2119: if {$gStudentSelection(studentNumber) == ""} { return }
2120: }
2121: removeWindowEntry SelectStudent
2122: $followupCommand
2123: }
2124:
2125: ###########################################################
2126: # createPreviewWindow
2127: ###########################################################
2128: ###########################################################
2129: ###########################################################
2130: proc createPreviewWindow {} {
2131: global gPreviewMode gPreviewText gPrefs gSetNumberText gStudentSelection
2132: global gWindowMenu gNumberParsedText gNumber
2133: global gLoadHeaderSet gHeaderQCount gControlDates
2134:
2135: if { ![winfo exists .preview] } {
2136:
2137: set previewWindow [toplevel .preview]
2138: $gWindowMenu add command -label "Preview" -command \
2139: "capaRaise $previewWindow"
2140: wm title $previewWindow "Preview"
2141: addFindList -1
2142:
2143: set windowFrame [frame $previewWindow.windowFrame]
2144: set buttonFrame [frame $previewWindow.buttonFrame]
2145:
2146: pack $windowFrame $buttonFrame -side bottom
2147: pack configure $windowFrame -expand true -fill both
2148: pack configure $buttonFrame -anchor e
2149:
2150: scrollbar $windowFrame.scroll -orient vertical -command \
2151: "$windowFrame.text yview"
2152: set gPreviewText [text $windowFrame.text -yscrollcommand \
2153: "$windowFrame.scroll set" -wrap char -height 40]
2154:
2155: pack $windowFrame.scroll $gPreviewText -side left -expand 0
2156: pack configure $windowFrame.scroll -expand 0 -fill y
2157: pack configure $gPreviewText -expand true -fill both
2158:
2159: button $buttonFrame.ok -text Dismiss -command "destroy $previewWindow
2160: removeWindowEntry Preview
2161: removeFindList -1"
2162: bind $previewWindow <Destroy> "removeWindowEntry Preview
2163: removeFindList -1"
2164: button $buttonFrame.save -text "Save Output" -command "saveText $gPreviewText"
2165: button $buttonFrame.stop -text "Stop Parser" -command "stopParser"
2166: button $buttonFrame.print -text "Print Output" -command "printText $gPreviewText"
2167: pack $buttonFrame.print $buttonFrame.save $buttonFrame.stop \
2168: $buttonFrame.ok -side left
2169:
2170: Centre_Dialog $previewWindow default
2171: wm withdraw $previewWindow
2172: update idletasks
2173: set win_width [winfo reqwidth $previewWindow]
2174: set win_height [winfo reqheight $previewWindow]
2175: wm geometry $previewWindow +[expr [winfo rootx $previewWindow] - \
2176: 100]+[winfo rooty $previewWindow]
2177: wm deiconify $previewWindow
2178: update
2179: } else {
2180: set previewWindow .preview
2181: $gPreviewText delete 0.0 end
2182: update
2183: }
2184:
2185: switch $gPrefs(info) {
2186: Problem { set type 0 }
2187: ProblemAnswer { set type 1 }
2188: Answer { set type 2 }
2189: }
2190: grab .preview
2191: if { [catch {
2192: switch $gPreviewMode {
2193: Enscript
2194: {
2195: set numberParsed [enscriptParse $type $gSetNumberText \
2196: $gStudentSelection(type) $gStudentSelection(random) \
2197: $gStudentSelection(studentNumber) \
2198: $gStudentSelection(studentName) gPreviewText]
2199: }
2200: TeX
2201: {
2202: set numberParsed [texParse $type $gSetNumberText \
2203: $gStudentSelection(type) $gStudentSelection(random) \
2204: $gStudentSelection(studentNumber) \
2205: $gStudentSelection(studentName) gPreviewText]
2206: }
2207: Web
2208: {
2209: set numberParsed [webParse $type $gSetNumberText \
2210: $gStudentSelection(type) $gStudentSelection(random) \
2211: $gStudentSelection(studentNumber) \
2212: $gStudentSelection(studentName) gPreviewText]
2213: }
2214: } }]} { return }
2215: grab release .preview
2216: if { $numberParsed == -1 } {
2217: destroy $previewWindow
2218: removeWindowEntry Preview
2219: return
2220: }
2221: checkHeader $numberParsed
2222: $gPreviewText tag configure problem
2223: $gPreviewText tag configure answer
2224: capaRaise $previewWindow
2225:
2226: set gNumberParsedText $numberParsed
2227: showParseErrors
2228: }
2229:
2230: ###########################################################
2231: ###########################################################
2232: ###########################################################
2233: ###########################################################
2234: proc showParseErrors {} {
2235: global gParseErrorsText gWindowMenu
2236:
2237: set parseErrors [getParseErrors]
2238:
2239: if { $parseErrors != "" } {
2240:
2241: if { ![winfo exists .parseErrors] } {
2242:
2243: set parseErrorsWindow [toplevel .parseErrors]
2244: $gWindowMenu add command -label "ParseErrors" -command "capaRaise \
2245: $parseErrorsWindow"
2246: wm title $parseErrorsWindow "Parse Errors"
2247: addFindList -2
2248:
2249: set windowFrame [frame $parseErrorsWindow.windowFrame]
2250: set buttonFrame [frame $parseErrorsWindow.buttonFrame]
2251:
2252: pack $windowFrame $buttonFrame -side bottom
2253: pack configure $windowFrame -expand true -fill both
2254: pack configure $buttonFrame -anchor e
2255:
2256: scrollbar $windowFrame.scroll -orient vertical -command \
2257: "$windowFrame.text yview"
2258: set gParseErrorsText [text $windowFrame.text -yscrollcommand \
2259: "$windowFrame.scroll set" -wrap char -height 40]
2260:
2261: pack $windowFrame.scroll $gParseErrorsText -side left -expand 0
2262: pack configure $windowFrame.scroll -expand 0 -fill y
2263: pack configure $gParseErrorsText -expand true -fill both
2264:
2265: button $buttonFrame.ok -text Dismiss -command \
2266: "destroy $parseErrorsWindow
2267: removeWindowEntry ParseErrors
2268: removeFindList -2"
2269: bind $parseErrorsWindow <Destroy> "removeWindowEntry ParseErrors
2270: removeFindList -2"
2271: button $buttonFrame.save -text "Save Output" \
2272: -command "saveText $gParseErrorsText"
2273: button $buttonFrame.print -text "Print Output" \
2274: -command "printText $gParseErrorsText"
2275: pack $buttonFrame.print $buttonFrame.save \
2276: $buttonFrame.ok -side left
2277:
2278: Centre_Dialog $parseErrorsWindow default
2279: update
2280: capaRaise $parseErrorsWindow
2281: } else {
2282: $gParseErrorsText delete 0.0 end
2283: capaRaise .parseErrors
2284: }
2285:
2286: $gParseErrorsText insert end $parseErrors
2287: } else {
2288: if { [winfo exists .parseErrors] } { $gParseErrorsText delete 0.0 end }
2289: }
2290:
2291: return $parseErrors
2292: }
2293:
2294: ###########################################################
2295: # printText
2296: ###########################################################
2297: # prints the contents of the text window, creates a temp file named
2298: # quiztemp.txt
2299: ###########################################################
2300: # Arguments: window (name of text window to print the contents of.
2301: # Returns : nothing
2302: # Globals :
2303: ###########################################################
2304: proc printText { window } {
2305:
2306: if { ![winfo exists $window] } {
2307: return
2308: }
2309: set lprCommand [getLprCommand quiztemp.txt]
2310:
2311: if {$lprCommand == "Cancel"} {
2312: return
2313: }
2314:
2315: set fileId [open "quiztemp.txt" w]
2316: puts -nonewline $fileId "[ $window get 0.0 end ]"
2317: close $fileId
2318:
2319: set errorMsg ""
2320: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
2321:
2322: if { $error == 1 } {
2323: displayError "An error occurred while printing: $errorMsg"
2324: } else {
2325: displayMessage "Print job sent to the printer.\n $output"
2326: }
2327: exec rm -f quiztemp.txt
2328: }
2329:
2330: ###########################################################
2331: # saveText
2332: ###########################################################
2333: # saves the contents of the text window
2334: ###########################################################
2335: # Arguments: window (name of text window to save the contents of.
2336: # saveAs (whether to ask to save)
2337: # refNum (if supplied reference file unique number
2338: # that is being saved)
2339: # Returns : name of the file saved
2340: # Globals :
2341: ###########################################################
2342: proc saveText { window {saveAs 1} {refNum 0} } {
2343: global gWindowMenu gRefFile gRefChanged gCapaConfig gFile
2344:
2345: if { ![winfo exists $window] } {return}
2346: if { $refNum } {
2347: if {$saveAs} {
2348: set dir [file dirname $gRefFile($refNum)]
2349: set file ""
2350: } else {
2351: set dir [file dirname $gRefFile($refNum)]
2352: set file [file tail $gRefFile($refNum)]
2353: }
2354: } else { set dir [ set file "" ] }
2355: # if { $dir == "" || $dir == "."} { set dir [pwd] }
2356: if { $file == "" } {
2357: set file [tk_getSaveFile -title "Enter the name to Save As" \
2358: -initialdir "$dir" ]
2359: if { $file == "" } {
2360: displayError "File not saved"
2361: return
2362: }
2363: } else {
2364: set file [file join $dir $file]
2365: }
2366:
2367: if { $refNum } {
2368: catch {removeWindowEntry "Reference $gRefFile($refNum)*" }
2369: catch {removeFindList $refNum}
2370: set gRefFile($refNum) $file
2371: addFindList $refNum
2372: wm title [winfo toplevel $window] $file
2373: $gWindowMenu add command -label "Reference $file" \
2374: -command "capaRaise [winfo toplevel $window]"
2375: if { !$saveAs } {
2376: if { ([array name gCapaConfig quizzerBackupRef] == "") ||
2377: ($gCapaConfig(quizzerBackupRef)!="off") } {
2378: if { [catch {file copy -force $file $file.bak} ] } {
2379: displayError "Unable to create backup for $file"
2380: }
2381: }
2382: }
2383: }
2384: set fileId [open $file w]
2385: puts -nonewline $fileId [$window get 0.0 end]
2386: close $fileId
2387: if { $refNum } { set gRefChanged($refNum) 0 }
2388: if { ([file tail $file] == "capa.config") && ($dir == [file dirname $gFile]) } {
2389: if { [makeSure "Reread capa.config settings into Quizzer?"] != "Cancel" } {
2390: rereadCapaConfig
2391: }
2392: }
2393:
2394: return $file
2395: }
2396:
2397: ###########################################################
2398: # deleteFile
2399: ###########################################################
2400: ###########################################################
2401: ###########################################################
2402: proc deleteFile { which } {
2403: global gFile gRefFile
2404: if { $which } { set file $gRefFile($which) } else { set file $gFile }
2405: if { [makeSure "Do you wish to Delete $file"] == "Cancel" } { return }
2406: if { $which } { closeRefFile $which 1 0 } else { closeDocument 1 0 }
2407: file delete -- $file
2408: }
2409:
2410: ###########################################################
2411: ###########################################################
2412: ###########################################################
2413: ###########################################################
2414: proc rereadCapaConfig { } {
2415: global gCapaConfig
2416: set printer_option $gCapaConfig(printer_option)
2417: unset gCapaConfig(printer_option)
2418: set error [parseCapaConfig]
2419: if { $error != "OK" } {
2420: displayError "Invalid capa.config file"
2421: set gCapaConfig(printer_option) $printer_option
2422: }
2423: updateColors
2424: }
2425:
2426: ###########################################################
2427: ###########################################################
2428: ###########################################################
2429: ###########################################################
2430: proc pickCapaConfig { } {
2431: set error NOTOK
2432: while { $error != "OK" } {
2433: set file [tk_getOpenFile -title "Pick a capa.config file" \
2434: -filetypes { { {CAPA configuration} {capa.config} } \
2435: { {All Files} {*} } }]
2436: if { $file == "" } { break }
2437: set oldDir [pwd]
2438: cd [file dirname $file]
2439: set error [parseCapaConfig]
2440: if { $error != "OK" } { displayError "Invalid capa.config file"; cd $oldDir }
2441: }
2442: }
2443:
2444: ###########################################################
2445: # openDocument
2446: ###########################################################
2447: ###########################################################
2448: ###########################################################
2449: proc openDocument {} {
2450: global gFile gTextWindow gSetNumberText gPrefs gChanged gQuizTemp gUndo
2451:
2452: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
2453: if { ![catch {set gTextWindow}] } {
2454: if { [winfo exists $gTextWindow] } { return }
2455: }
2456:
2457: # the event generation is because of a bug in tk_getOpenFile
2458: # After double cliking the mouse Button one is thought to be left down.
2459: # this only seems to happen when a toplevel window is created
2460: # after getting the file
2461: set gFile [tk_getOpenFile -filetypes \
2462: { { {Quizzer} {"*.qz"} } { {All Files} {"*"} } } \
2463: -title "Select the proper file" -initialdir "[pwd]" ]
2464: # event generate .main <ButtonRelease-1>
2465: if { $gFile == "" } { return }
2466: if { [file isdirectory $gFile] } {
2467: displayError "You attempted to open $gFile which is a directory not a file."
2468: return
2469: }
2470:
2471: set error [ catch {set fileId [open $gFile r] } ]
2472:
2473: if { $error } {
2474: displayError "Unable to read $gFile"
2475: return
2476: }
2477:
2478: set oldDir [pwd]
2479:
2480: cd [file dirname $gFile]
2481:
2482: set tempfiles ""
2483: catch {set tempfiles [glob quiztemp.*]}
2484: if { $tempfiles == "" } {
2485: set gQuizTemp true
2486: }
2487: foreach quiztempFile $tempfiles {
2488: if { ! ( [file isfile $quiztempFile] &&
2489: [file writable $quiztempFile] ) } {
2490: 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" } {
2491: cd $oldDir
2492: set gQuizTemp true
2493: return
2494: } else {
2495: set gQuizTemp false
2496: break
2497: }
2498: }
2499: }
2500:
2501: if { $tempfiles == "" } {
2502: if { ! [file writable $gFile] } {
2503: 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" } {
2504: cd $oldDir
2505: set gQuizTemp true
2506: return
2507: } else {
2508: set gQuizTemp false
2509: }
2510: }
2511: }
2512:
2513: set error [parseCapaConfig]
2514:
2515: if { $error != "OK" } {
2516: cd $oldDir
2517: set gQuizTemp true
2518: return
2519: }
2520:
2521: createEditingWindow 0
2522: $gTextWindow delete 0.0 end
2523: $gTextWindow insert 0.0 [read $fileId [file size $gFile]]
2524: $gTextWindow delete end-1c
2525:
2526: rename $gTextWindow .$gTextWindow
2527: trackChanges $gTextWindow 0
2528: set gUndo(0) 0
2529: set gUndo(0.cur) 0
2530:
2531: createImportLinks 0 0.0 end
2532: focus -force $gTextWindow
2533: set coord [$gTextWindow bbox 0.0]
2534: event generate $gTextWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
2535: event generate $gTextWindow <ButtonRelease-1>
2536: update
2537: close $fileId
2538:
2539: updatePrefsWindow
2540:
2541: set gSetNumberText [string range [file rootname [file tail $gFile]] 3 end ]
2542: checkIfValidFilename
2543: set gChanged 0
2544: }
2545:
2546: ###########################################################
2547: # includeReferenceFile
2548: ###########################################################
2549: ###########################################################
2550: ###########################################################
2551: proc includeReferenceFile { file num window } {
2552: set index [$window index "file.$num.first linestart"]
2553: if { ![file readable $file] } {
2554: displayError "Unable to read file $file"
2555: return
2556: }
2557: set impline [$window get $index "$index lineend"]
2558: set fileId [open $file r]
2559: $window insert $index /
2560: update idletasks
2561: if { [$window index end] == [$window index "$index + 1 lines"] } {
2562: $window insert "$index + 1 lines" "\n[read $fileId [file size $file]]"
2563: } else {
2564: $window insert "$index + 1 lines" [read $fileId [file size $file]]
2565: }
2566: close $fileId
2567: }
2568:
2569: ###########################################################
2570: # impMenuSaveAs
2571: ###########################################################
2572: ###########################################################
2573: ###########################################################
2574: proc impMenuSaveAs { file num window } {
2575: set index [$window index "file.$num.first linestart"]
2576: if { ![file readable $file] } {
2577: displayError "Unable to read file $file"
2578: return
2579: }
2580: set dir [file dirname $file]
2581: if { $dir != "." } {
2582: set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir $dir]
2583: } else {
2584: set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir [pwd]]
2585: }
2586: if { $dest == "" } {
2587: displayError "File not saved"
2588: return
2589: }
2590: if { [catch {file copy -force -- $file $dest} errorMsg ] } {
2591: displayError "Unable to copy $file to $dest: $errorMsg"
2592: return
2593: }
2594: $window delete $index "$index lineend"
2595: if { $dir != "." } {
2596: $window insert $index "/IMP \"$dest\""
2597: } else {
2598: $window insert $index "/IMP \"[file tail $dest]\""
2599: }
2600: }
2601:
2602: ###########################################################
2603: # createImpMenu
2604: ###########################################################
2605: ###########################################################
2606: ###########################################################
2607: proc createImpMenu { file num window } {
2608: set menuFrame [menu .impmenu -tearoff 0 -type tearoff ]
2609:
2610: # wm title $menuFrame "Quizzer"
2611: wm overrideredirect $menuFrame 1
2612: wm positionfrom $menuFrame program
2613: $menuFrame post [winfo pointerx .] [winfo pointery .]
2614: $menuFrame add command -label "Open" -command "openReferenceFile $file"
2615: $menuFrame add command -label "Include" -command \
2616: "includeReferenceFile $file $num $window"
2617: $menuFrame add command -label "saveAs" -command "impMenuSaveAs $file $num $window"
2618: grab $menuFrame
2619: bind all <ButtonRelease> "grab release $menuFrame;destroy $menuFrame"
2620: }
2621:
2622: ###########################################################
2623: # registerCreateImportLinks
2624: ###########################################################
2625: ###########################################################
2626: ###########################################################
2627: proc registerCreateImportLinks { num start end} {
2628: global gDoCreateImportLinks gCreateImportLinks
2629:
2630: if { $gCreateImportLinks && !$gDoCreateImportLinks($num) } {
2631: after idle "createImportLinks $num $start $end"
2632: set gDoCreateImportLinks($num) 1
2633: }
2634: }
2635:
2636: ###########################################################
2637: # createImportLinks
2638: ###########################################################
2639: ###########################################################
2640: ###########################################################
2641: proc createImportLinks { num start end } {
2642: global gTextWindow gUniqueNumber gDoCreateImportLinks gRefText gCapaConfig
2643:
2644: set gDoCreateImportLinks($num) 0
2645: if { $num } { set window $gRefText($num) } else { set window $gTextWindow }
2646: if { ![winfo exists $window] } { return }
2647: set end [$window index $end]
2648: set start [$window index $start]
2649: set lastline [lindex [split $end .] 0]
2650: set startline [lindex [split $start .] 0]
2651: foreach tag [$window tag names] {
2652: if { [regexp {file\..+} $tag ] } {
2653: if { [$window tag nextrange $tag "$start linestart" "$end lineend"] != "" } {
2654: $window tag delete $tag
2655: }
2656: }
2657: }
2658: for { set i $startline } { $i <= $lastline } { incr i } {
2659: set aline [$window get $i.0 "$i.0 lineend"]
2660: if { [regexp -nocase {(^[ ]*)(//.*)} $aline matchVar match1 match2] } {
2661: set tagnum [incr gUniqueNumber]
2662: set start [string length $match1]
2663: set end [expr $start + [string length $match2]]
2664: $window tag add file.$tagnum $i.$start $i.$end
2665: $window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
2666: } elseif { [regexp -nocase {(^.*/let.*[ ]+)(//.*)} $aline matchVar \
2667: match1 match2] } {
2668: set tagnum [incr gUniqueNumber]
2669: set start [string length $match1]
2670: set end [expr $start + [string length $match2]]
2671: $window tag add file.$tagnum $i.$start $i.$end
2672: $window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
2673: }
2674: if { [regexp -nocase "(.*/imp +)(\"\[^\"\]+\")(.*)" $aline matchVar \
2675: match1 match2 match3] } {
2676: set tagnum [incr gUniqueNumber]
2677: set start [string length $match1]
2678: set end [expr $start + [string length $match2]]
2679: $window tag add file.$tagnum $i.$start $i.$end
2680: $window tag configure file.$tagnum -foreground $gCapaConfig(IMP_color)
2681: $window tag bind file.$tagnum <Double-ButtonPress> \
2682: "eval openReferenceFile $match2"
2683: $window tag bind file.$tagnum <ButtonPress-3> \
2684: "eval createImpMenu $match2 $tagnum $window"
2685: }
2686: }
2687: }
2688:
2689: ###########################################################
2690: # isReferenceFileOpen
2691: ###########################################################
2692: ###########################################################
2693: ###########################################################
2694: proc isReferenceFileOpen { file } {
2695: global gWindowMenu
2696: # if { [catch {set index [$gWindowMenu index "Reference $file"]} ] } { return "" }
2697: set last [$gWindowMenu index end]
2698: # puts $last
2699: for { set index 1 } { $index <= $last } { incr index } {
2700: # puts $index
2701: catch {set entry [$gWindowMenu entrycget $index -label]}
2702: if { "Reference" == [set entryfile [lindex $entry 0]] } {
2703: set entryfile [lindex $entry 1]
2704: }
2705: # puts $entryfile
2706: if { [catch {file stat $entryfile a1}] } { puts skipped;continue }
2707: file stat $file a2
2708: # puts "$a2(ino) == $a1(ino)"
2709: if { $a2(ino) == $a1(ino) } {
2710: # puts "seems right"
2711: return [lindex [$gWindowMenu entrycget $index -command] 1]
2712: }
2713: }
2714: # puts "failed $index"
2715: return ""
2716: # puts $index
2717: # puts [$gWindowMenu entrycget $index -command]
2718: # return [lindex [$gWindowMenu entrycget $index -command] 1]
2719: }
2720:
2721: ###########################################################
2722: # newReferenceFile
2723: ###########################################################
2724: ###########################################################
2725: ###########################################################
2726: proc newReferenceFile { } {
2727: global gDir
2728: # if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
2729: set file [tk_getSaveFile -title "Enter the name of the New reference file" \
2730: -initialdir "$gDir(reference)" ]
2731: event generate .main <ButtonRelease-1>
2732: if { $file == "" } { return }
2733: set gDir(reference) [file dirname $file]
2734: if { [file isdirectory $file] } {
2735: displayError "You attempted to create $file which is already a directory."
2736: return
2737: }
2738: openReferenceFile $file 1
2739: }
2740:
2741: ###########################################################
2742: # openReferenceFile
2743: ###########################################################
2744: ###########################################################
2745: ###########################################################
2746: proc openReferenceFile { {file ""} {new 0}} {
2747: global gUniqueNumber gWindowMenu gDir
2748:
2749: set num [incr gUniqueNumber]
2750: global gRefCurLine gRefLine gRefText gRefChanged gRefFile gRefClosed \
2751: gUndo gRefChangedLast
2752: # the event generation is because of a bug in tk_getOpenFile
2753: # After double cliking the mouse Button one is thought to be left down.
2754: # this only seems to happen when a toplevel window is created
2755: # after getting the file
2756: if { $file == "" } {
2757: # if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
2758: set file [tk_getOpenFile -filetypes \
2759: { { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
2760: -title "Select the proper file" \
2761: -initialdir "$gDir(reference)" ]
2762: event generate .main <ButtonRelease-1>
2763: if { $file == "" } { return }
2764: set gDir(reference) [file dirname $file]
2765:
2766: if { [file isdirectory $file] } {
2767: displayError "You attempted to open $file which is a directory not a file."
2768: return
2769: }
2770: } else {
2771: if { !$new } {
2772: if { [set window [isReferenceFileOpen $file] ] != "" } {
2773: capaRaise $window
2774: return
2775: }
2776: # specifically opening the capa.config file
2777: if { $file == "capa.config" } {
2778: global gTextWindow gFile
2779: if { [catch {set gTextWindow}] } {
2780: set file [tk_getOpenFile -filetypes \
2781: {{{Capa.config file} {"capa.config"}}
2782: { {All Files} {"*"} } } \
2783: -title "Select the proper file" \
2784: -initialdir "$gDir(reference)" ]
2785: if { $file == "" } { return }
2786: } else {
2787: set file [file join [file dirname $gFile] capa.config]
2788: }
2789: } else {
2790: if { ![file isfile $file] && ![file readable $file] } {
2791: displayError "Unable to find $file"
2792: return
2793: }
2794: if { [file isdirectory $file] } {
2795: displayError "You attempted to open $file which is a directory not a file."
2796: return
2797: }
2798: }
2799: }
2800: }
2801:
2802: set gRefFile($num) $file
2803: set referenceFile [toplevel .reference$num]
2804: wm title $referenceFile "$file"
2805:
2806: $gWindowMenu add command -label "Reference $file" \
2807: -command "capaRaise $referenceFile"
2808:
2809: set menuFrame [frame $referenceFile.menu -borderwidth 3 -relief raised]
2810: set lineFrame [frame $referenceFile.lineFrame]
2811: set windowFrame [frame $referenceFile.windowFrame]
2812: pack $menuFrame $lineFrame $windowFrame
2813: pack configure $windowFrame -expand 1 -fill both
2814: pack configure $menuFrame -fill x
2815:
2816: label $lineFrame.msg -text "Current Line:"
2817: label $lineFrame.current -textvariable gRefCurLine($num)
2818: entry $lineFrame.line -width 8 -textvariable gRefLine($num)
2819: bind $lineFrame.line <KeyPress-Return> "+gotoRefLine $num"
2820: button $lineFrame.button -text "Goto" -command \
2821: "gotoRefLine $num"
2822: pack $lineFrame.msg $lineFrame.current $lineFrame.line \
2823: $lineFrame.button -side left
2824:
2825: set infoFrame [frame $windowFrame.infoFrame]
2826: set textFrame [frame $windowFrame.textFrame]
2827: pack $infoFrame $textFrame -side top
2828: pack configure $textFrame -expand 1 -fill both
2829:
2830: scrollbar $textFrame.scroll -orient vertical -command \
2831: "$textFrame.text yview"
2832: set textWindow [text $textFrame.text -yscrollcommand \
2833: "$textFrame.scroll set" -wrap char]
2834: pack $textFrame.scroll $textWindow -side left -expand 0
2835: pack configure $textFrame.scroll -expand 0 -fill y
2836: pack configure $textWindow -expand true -fill both
2837:
2838: # label $infoFrame.label -textvariable gRefFile($num)
2839: # pack $infoFrame.label -side left
2840:
2841: menubutton $menuFrame.file -text File -menu $menuFrame.file.m
2842: menubutton $menuFrame.edit -text Edit -menu $menuFrame.edit.m
2843: pack $menuFrame.file $menuFrame.edit -side left
2844:
2845: set fileMenu [ menu $menuFrame.file.m ]
2846: set editMenu [ menu $menuFrame.edit.m ]
2847:
2848: $fileMenu add command -label Save -command \
2849: "saveText $textWindow 0 $num" -accelerator "Alt+s"
2850: bind $referenceFile <Alt-s> \
2851: "saveText $textWindow 0 $num"
2852: $fileMenu add command -label "Save As" -command \
2853: "saveText $textWindow 1 $num" -accelerator "Alt+S"
2854: bind $referenceFile <Alt-Shift-s> "saveText $textWindow 1 $num"
2855: $fileMenu add command -label Delete -command "deleteFile $num"
2856: $fileMenu add command -label Print -command "printText $textWindow"
2857: $fileMenu add command -label Close -command "closeRefFile $num" \
2858: -accelerator "Alt+w"
2859: bind $referenceFile <Alt-w> "closeRefFile $num"
2860: # bind $referenceFile <Destroy> "closeRefFile $num 1"
2861: wm protocol $referenceFile WM_DELETE_WINDOW "closeRefFile $num 1"
2862: $editMenu add command -label "Cut" -command "tk_textCut $textWindow" \
2863: -accelerator "Alt+x"
2864: bind $referenceFile <Alt-x> "tk_textCut $textWindow"
2865: $editMenu add command -label "Copy" -command "tk_textCopy $textWindow" \
2866: -accelerator "Alt+c"
2867: bind $referenceFile <Alt-c> "tk_textCopy $textWindow"
2868: $editMenu add command -label "Paste" -command "tk_textPaste $textWindow" \
2869: -accelerator "Alt+v"
2870: bind $referenceFile <Alt-v> "tk_textPaste $textWindow"
2871: $editMenu add command -label "Select All " -command \
2872: "selectAll $num " -accelerator "Alt+a"
2873: bind $referenceFile <Alt-a> "selectAll $num"
2874: $editMenu add separator
2875: $editMenu add command -label "Undo" -command "undo $num" \
2876: -accelerator "Alt+u"
2877: bind $referenceFile <Alt-u> "undo $num"
2878: # $editMenu add command -label "Redo" -command "redo $num"
2879: $editMenu add separator
2880: $editMenu add command -label "Find" -command "createFindWindow $num" \
2881: -accelerator "Alt+f"
2882:
2883:
2884: if { !$new } {
2885: set fileId [open $file r]
2886: $textWindow insert 0.0 [read $fileId [file size $file]]
2887: $textWindow delete end-1c
2888: close $fileId
2889: }
2890:
2891: set gRefText($num) $textWindow
2892: rename $textWindow .$textWindow
2893: trackChanges $textWindow $num
2894: set gUndo($num) 0
2895: set gUndo($num.cur) 0
2896:
2897: createImportLinks $num 0.0 end
2898: focus -force $textWindow
2899: # update
2900: set coord [$textWindow bbox 0.0]
2901: event generate $textWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
2902: # update
2903: event generate $textWindow <ButtonRelease-1>
2904: # update
2905: # capaRaise $referenceFile
2906: after 1 "catch \{focus $textWindow;raise $referenceFile\}"
2907: selection clear
2908: #order is important here since gRefChanged has a trace on it the references
2909: #gRefChangedLast
2910: set gRefChangedLast($num) 0
2911: set gRefChanged($num) 0
2912: set gRefClosed($num) 0
2913: addFindList $num
2914: }
2915:
2916: ###########################################################
2917: ###########################################################
2918: ###########################################################
2919: ###########################################################
2920: proc trackChanges { procName num } {
2921: eval "proc $procName args {
2922: global gUndo gRefChanged gChanged
2923: if {\[regexp {^(ins|del).*} \[lindex \$args 0\]\]} {
2924: #puts \"\$args\"
2925: if { \$gUndo($num.cur) != \$gUndo($num) } {
2926: set i \[expr \$gUndo($num.cur) + 1 \]
2927: while { \[ info exists gUndo($num.\$i) \] } {
2928: unset gUndo($num.\$i)
2929: incr i
2930: }
2931: set gUndo($num) \$gUndo($num.cur)
2932: }
2933: set gUndo($num.cur) \$gUndo($num)
2934: set insertindex \[.$procName index \[lindex \$args 1 \] \]
2935: set numChange \[set gUndo($num.cur) \[incr gUndo($num) \] \]
2936: if { $num == 0 } { set gChanged 1 } else { set gRefChanged($num) 1 }
2937: }
2938: if {\[regexp {^(ins).*} \[lindex \$args 0\]\]} {
2939: set index2 \$insertindex+\[string length \[lindex \$args 2 \] \]chars
2940: set gUndo($num.\$numChange) \"delete \$insertindex \$index2 \"
2941: if {\[regexp {.*\[\"/\].*} \$args\] || \
2942: \[regexp {.*\[\"/\].*} \[.$procName get \"\$insertindex linestart\" \"\$index2 lineend\"\]\]} {
2943: registerCreateImportLinks $num \$insertindex \$index2
2944: }
2945: } elseif {\[regexp {^(del).*} \[lindex \$args 0\]\]} {
2946: if { \[catch { set insertindex2 \[.$procName index \
2947: \[lindex \$args 2 \] \] } \] } {
2948: set chars \[ .$procName get \$insertindex \]
2949: set insertindex2 \$insertindex+1c
2950: } else {
2951: set chars \[ .$procName get \$insertindex \$insertindex2 \]
2952: }
2953: set gUndo($num.\$numChange) \"insert \$insertindex \[list \$chars\] \"
2954: if {\[regexp \{.*\[\"/\].*\} \$chars\] || \
2955: \[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} {
2956: registerCreateImportLinks $num \$insertindex \$insertindex2
2957: }
2958: }
2959: set result \[uplevel .$procName \$args\]
2960: updateLocation $num
2961: return \$result
2962: }"
2963: }
2964:
2965: ###########################################################
2966: ###########################################################
2967: ###########################################################
2968: ###########################################################
2969: proc undo { num } {
2970: global gUndo gRefText gTextWindow
2971: if { $gUndo($num.cur) == 0 } { return }
2972: set undoInfo $gUndo($num.$gUndo($num.cur))
2973: if { [regexp {.*[\"/].*} $undoInfo] } {
2974: registerCreateImportLinks $num [lindex $undoInfo 1] end
2975: }
2976: if { [regexp {.*delete.*} $undoInfo] } {
2977: registerCreateImportLinks $num [lindex $undoInfo 1] [lindex $undoInfo 2]
2978: }
2979: if { $num == 0 } {
2980: if {[catch {eval ".$gTextWindow $gUndo($num.$gUndo($num.cur))"}]} { return }
2981: } else {
2982: if {[catch {eval ".$gRefText($num) $gUndo($num.$gUndo($num.cur))"}]} { return }
2983: }
2984: incr gUndo($num.cur) -1
2985: }
2986:
2987: ###########################################################
2988: ###########################################################
2989: ###########################################################
2990: ###########################################################
2991: proc redo { num } {
2992: global gUndo gRefText
2993: }
2994:
2995: ###########################################################
2996: ###########################################################
2997: ###########################################################
2998: ###########################################################
2999: proc gotoRefLine { number } {
3000: global gRefLine gRefText
3001: if { [catch {set gRefText($number)}] } { return }
3002: if { ![winfo exists $gRefText($number)] } { return }
3003:
3004: if { $gRefLine($number) == "" } {
3005: return
3006: } else {
3007: $gRefText($number) mark set insert $gRefLine($number).0
3008: catch {$gRefText($number) tag remove sel sel.first sel.last}
3009: $gRefText($number) tag add sel "insert linestart" "insert lineend"
3010: $gRefText($number) see insert
3011: }
3012: }
3013:
3014: ###########################################################
3015: # updateLocation
3016: ###########################################################
3017: ###########################################################
3018: ###########################################################
3019: proc updateLocation { number } {
3020: global gRefCurLine gRefText gTextWindow gLineNumber gCharacterNumber
3021:
3022: if {$number} {set window $gRefText($number)} {set window $gTextWindow}
3023: # if {![winfo exists $gRefText($number)]} {return};#do I need this
3024: set spot [split [.$window index insert] "."]
3025: if { $number } {
3026: set gRefCurLine($number) [lindex $spot 0 ]
3027: } else {
3028: set gLineNumber [lindex $spot 0]
3029: set gCharacterNumber [lindex $spot 0]
3030: }
3031: }
3032:
3033: ###########################################################
3034: ###########################################################
3035: ###########################################################
3036: ###########################################################
3037: proc askToSave { refNum mustClose } {
3038: global gPrompt
3039:
3040: set dialog [toplevel .askToSavePrompt -borderwidth 10]
3041: wm title $dialog "Do you wish to Save"
3042: wm geo $dialog "+200+200"
3043: if { $refNum } {
3044: global gRefFile
3045: set msg "Reference File: $gRefFile($refNum) has changed. Do you wish to save?"
3046: } else {
3047: set msg "Source has changed do you wish to save?"
3048: }
3049: message $dialog.msg -text $msg -aspect 800
3050:
3051: set gPrompt(result) ""
3052: set buttonFrame [frame $dialog.buttons -bd 10]
3053: pack $dialog.msg $buttonFrame -side top -fill x
3054:
3055: bind $dialog <Destroy> {
3056: set gPrompt(result) Cancel
3057: set gPrompt(yes) 0
3058: }
3059:
3060: button $buttonFrame.yes -text Yes -underline 0 -command {
3061: set gPrompt(yes) 1
3062: }
3063: button $buttonFrame.no -text No -underline 0 -command {
3064: set gPrompt(yes) 0
3065: }
3066: if { !$mustClose } {
3067: button $buttonFrame.cancel -text Cancel -underline 0 -command {
3068: set gPrompt(yes) 0
3069: set gPrompt(result) Cancel
3070: }
3071: pack $buttonFrame.yes $buttonFrame.no $buttonFrame.cancel -side left
3072: } else {
3073: pack $buttonFrame.yes $buttonFrame.no -side left
3074: }
3075: bind $dialog <Alt-Key> break
3076:
3077: Centre_Dialog $dialog default
3078: update
3079:
3080: focus $dialog
3081: capaRaise $dialog
3082: capaGrab $dialog
3083: vwait gPrompt(yes)
3084: capaGrab release $dialog
3085: bind $dialog <Destroy> ""
3086: destroy $dialog
3087: if {$gPrompt(yes)} {
3088: if { $refNum } {
3089: global gRefText
3090: saveText $gRefText($refNum) 0 $refNum
3091: } else {
3092: saveDocument
3093: }
3094: } else {
3095: return $gPrompt(result)
3096: }
3097: }
3098:
3099: ###########################################################
3100: ###########################################################
3101: ###########################################################
3102: ###########################################################
3103: proc saveDocument { {saveAs 0} } {
3104: global gFile gTextWindow gSetNumberText gChanged gEditWindow gWindowMenu \
3105: gCapaConfig
3106: if { [catch {set gTextWindow}] } { return }
3107: if { ![winfo exists $gTextWindow] } { return }
3108: if { $gFile == "" } { set saveAs 1 }
3109: if {$saveAs == 1} {
3110: set temp [tk_getSaveFile -title "Enter the name to Save As" \
3111: -initialdir "[pwd]" ]
3112: if { $temp == "" } {
3113: displayError "File not saved"
3114: return
3115: }
3116:
3117: catch {removeWindowEntry "$gFile*"}
3118: catch {removeFindList}
3119: set gFile $temp
3120: addFindList
3121: cd [file dirname $gFile]
3122: set gSetNumberText [string range [file rootname [file tail $gFile]] \
3123: 3 end ]
3124: checkIfValidFilename
3125: wm title [winfo toplevel $gEditWindow] $gFile
3126:
3127: $gWindowMenu add command -label "$gFile" -command \
3128: "capaRaise $gEditWindow"
3129: } else {
3130: if { ([array name gCapaConfig quizzerBackupQZ] == "") ||
3131: ($gCapaConfig(quizzerBackupQZ)!="off") } {
3132: if { [catch {file copy -force $gFile $gFile.bak} ] } {
3133: displayError "Unable to create backup for $gFile"
3134: }
3135: }
3136: }
3137:
3138: set fileId [open $gFile w]
3139:
3140: puts -nonewline $fileId [$gTextWindow get 0.0 end]
3141:
3142: close $fileId
3143:
3144: savePrefs
3145: set gChanged 0
3146: }
3147:
3148: ###########################################################
3149: ###########################################################
3150: ###########################################################
3151: ###########################################################
3152: proc closeDocument { { mustClose 0 } { save 1 } } {
3153: global gFile gEditWindow gChanged gPrefs \
3154: gPutLine gTryVal gProbVal gHintVal gQuizTemp \
3155: gNumberParsedText gSetNumberText gClosedDocument gTextWindow
3156: if { [catch {set gEditWindow}] } { return }
3157: if { ![winfo exists $gEditWindow] } { return }
3158: if { $gClosedDocument } { return }
3159: if { $save && $gChanged } {
3160: if { [askToSave 0 $mustClose] == "Cancel" && (! $mustClose ) } { return }
3161: }
3162: if {(!$mustClose)&&[makeSure "Are you sure you wish to stop editing?"]=="Cancel"} {
3163: return
3164: }
3165: set gClosedDocument 1
3166: removeFindList
3167: destroy $gEditWindow
3168: removeWindowEntry "$gFile*"
3169: set gFile ""
3170: set gChanged 0
3171: set gPrefs(info) "Problem"
3172: set gPrefs(TeXHeader) ""
3173: set gPrefs(TeXFooter) ""
3174: set gPutLine 1
3175: set gTryVal 99
3176: set gHintVal 1
3177: set gProbVal 1
3178: set gQuizTemp "true"
3179: set gNumberParsedText ""
3180: set gSetNumberText ""
3181: }
3182:
3183: ###########################################################
3184: ###########################################################
3185: ###########################################################
3186: ###########################################################
3187: proc closeRefFile { refNum { mustClose 0 } { save 1 } } {
3188: global gRefChanged gRefText gRefFile gRefClosed gRefCurLine gRefLine gRefChangedLast
3189: if { [catch {set gRefText($refNum)}] } { return }
3190: if { ![winfo exists $gRefText($refNum)] } { return }
3191: if { $gRefClosed($refNum) } { return }
3192: if { $save && $gRefChanged($refNum) } {
3193: if { [askToSave $refNum $mustClose] == "Cancel" && ( ! $mustClose ) } { return }
3194: }
3195:
3196: if { ( ! $mustClose ) && ( [makeSure "Are you sure you wish to stop editing $gRefFile($refNum)?"] == "Cancel" ) } {
3197: return
3198: }
3199: set gRefClosed($refNum) 1
3200: removeFindList $refNum
3201: destroy [winfo toplevel $gRefText($refNum)]
3202: removeWindowEntry "Reference $gRefFile($refNum)*"
3203: unset gRefText($refNum) gRefChanged($refNum) gRefClosed($refNum) gRefFile($refNum) \
3204: gRefCurLine($refNum) gRefLine($refNum) gRefChangedLast($refNum)
3205: }
3206:
3207: ###########################################################
3208: # quit
3209: ###########################################################
3210: # called when the quit option is selected on the menu, unmaps
3211: # all keys.
3212: ###########################################################
3213: # Arguments: None
3214: # Returns: Nothing
3215: # Globals: gChanged - whether or not the file has been modified
3216: ###########################################################
3217: proc quit { { mustClose 0 } } {
3218: global gChanged gRefChanged gRefText
3219:
3220: if { (! $mustClose ) && [makeSure "Are you sure you wish to quit?"] == "Cancel" } {
3221: return
3222: }
3223:
3224: if { $gChanged } {
3225: if { [askToSave 0 $mustClose] == "Cancel" && ( ! $mustClose ) } {
3226: return
3227: }
3228: }
3229:
3230: foreach refNum [array names gRefChanged] {
3231: if { $gRefChanged($refNum) == 1 } {
3232: if { [winfo exists $gRefText($refNum)] } {
3233: if { [askToSave $refNum $mustClose ] == "Cancel" && (! $mustClose ) } {
3234: return
3235: }
3236: }
3237: }
3238: }
3239:
3240: exec /bin/rm -f quiztemp.ps
3241: exec /bin/rm -f quiztemp.dvi
3242: exec /bin/rm -f quiztemp.tex
3243: exec /bin/rm -f quiztemp.log
3244: exec /bin/rm -f quiztemp.aux
3245: exec /bin/rm -f quiztemp.txt
3246:
3247: unmapAllKeys
3248:
3249: exit
3250: }
3251:
3252: ###########################################################
3253: # createStopButton
3254: ###########################################################
3255: ###########################################################
3256: ###########################################################
3257: proc createStopButton {} {
3258: global gStopStatus
3259: if {[winfo exists .stopbutton]} {destroy .stopbutton}
3260: set top [toplevel .stopbutton]
3261: button $top.stop -text "Stop Parser" -command "stopParser"
3262: label $top.status -textvariable gStopStatus -width 35
3263: pack $top.stop $top.status
3264: set gStopStatus ""
3265: grab $top
3266: Centre_Dialog $top default
3267: update
3268: }
3269:
3270: ###########################################################
3271: # destroyStopButton
3272: ###########################################################
3273: ###########################################################
3274: ###########################################################
3275: proc destroyStopButton {} {
3276: grab release .stopbutton
3277: destroy .stopbutton
3278: }
3279:
3280: ###########################################################
3281: # createDvi
3282: ###########################################################
3283: ###########################################################
3284: ###########################################################
3285: proc createDvi { {showXdvi 1} {showStopButton 0} {useqzparse 0}} {
3286: global gPreviewMode gCreateDviText gPrefs gSetNumberText \
3287: gStudentSelection gFile gWindowMenu gLatexId gParseErrorsText \
3288: gEditWindow gCreateDviTextTemp gXdviOpt \
3289: gLoadHeaderSet gCapaConfig gControlDates gNumberParsedText \
3290: gDonePrinting
3291:
3292: if { [catch {set gEditWindow}] } { return }
3293: if { ![winfo exists $gEditWindow] } { return }
3294:
3295: catch { destroy .createDviText }
3296: set gCreateDviTextTemp [text .createDviText]
3297:
3298: switch $gPrefs(info) {
3299: Problem { set type 0 }
3300: ProblemAnswer { set type 1 }
3301: Answer { set type 2 }
3302: }
3303:
3304: if { $useqzparse } {
3305: set gDonePrinting 0
3306: switch $gPrefs(info) {
3307: Problem { set type "-T" }
3308: Answer { set type "-Ta" }
3309: ProblemAnswer { set type "-Tb" }
3310: default { set type "-T" }
3311: }
3312: createCreateDviWin
3313: grab .createDvi
3314: $gCreateDviText delete 0.0 end
3315: if { [setupSetsToPrint set start end 0] == 1 } { return 1 }
3316: if { [set gStopPrinting [expr 2 == [runLatex \
3317: "echo [pwd] | $gCapaConfig(qzparse_command) \
3318: -stu $gStudentSelection(studentNumber) -set $set \
3319: -d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
3320: exec rm -f $gStudentSelection(studentNumber).tex quiztemp.tex
3321: if {$showStopping} {
3322: displayMessage "Printing has been stopped."
3323: set gDonePrinting 1
3324: set gStopPrinting 0
3325: }
3326: return 1
3327: }
3328: exec mv $gStudentSelection(studentNumber).tex quiztemp.tex
3329: exec /bin/rm -f quiztemp.dvi
3330: } else {
3331: createStopButton
3332: if { [catch {
3333: set numberParsed [ texParse $type $gSetNumberText \
3334: $gStudentSelection(type) $gStudentSelection(random) \
3335: $gStudentSelection(studentNumber) \
3336: $gStudentSelection(studentName) \
3337: gCreateDviTextTemp 1 ] }]} {
3338: return
3339: }
3340: destroyStopButton
3341: checkHeader $numberParsed
3342:
3343: if { [showParseErrors] != "" } {
3344: if { [makeSure "There were errors when parsing the .qz file, \
3345: continue to create the .dvi?"] =="Cancel" } {
3346: destroy $gCreateDviTextTemp
3347: return
3348: }
3349: }
3350:
3351: set error [catch { set fileId [open quiztemp.tex w] } ]
3352: if { $error } {
3353: displayError "Unable to create neccessary temp files, delete all the\
3354: quiztemp file from the class directory."
3355: return
3356: }
3357:
3358: set filename [file join [file dirname $gFile] TeXheader ]
3359: set texfileId [open $filename r]
3360: puts -nonewline $fileId [read $texfileId [file size $filename]]
3361: close $texfileId
3362:
3363: puts -nonewline $fileId "[$gCreateDviTextTemp get 0.0 end]"
3364:
3365: set filename [file join [file dirname $gFile] TeXfooter ]
3366: set texfileId [open $filename r]
3367: puts $fileId [read $texfileId [file size $filename]]
3368: close $texfileId
3369:
3370: close $fileId
3371: }
3372:
3373: destroy $gCreateDviTextTemp
3374:
3375: if { ![winfo exists .createDvi] } {
3376: set createDviWindow [toplevel .createDvi]
3377: $gWindowMenu add command -label "CreateDvi" -command \
3378: "capaRaise $createDviWindow"
3379: wm title $createDviWindow "LaTeX Output"
3380: addFindList -3
3381:
3382: set windowFrame [frame $createDviWindow.windowFrame]
3383: set buttonFrame [frame $createDviWindow.buttonFrame]
3384:
3385: pack $windowFrame $buttonFrame -side bottom
3386: pack configure $windowFrame -expand true -fill both
3387: pack configure $buttonFrame -anchor e
3388:
3389: scrollbar $windowFrame.scroll -orient vertical -command \
3390: "$windowFrame.text yview"
3391: set gCreateDviText [text $windowFrame.text -yscrollcommand \
3392: "$windowFrame.scroll set" -wrap char -height 40]
3393:
3394: pack $windowFrame.scroll $gCreateDviText -side left -expand 0
3395: pack configure $windowFrame.scroll -expand 0 -fill y
3396: pack configure $gCreateDviText -expand true -fill both
3397:
3398: set appearingFrame [frame $buttonFrame.appearingFrame]
3399: button $buttonFrame.ok -text Dismiss -command \
3400: "trace vdelete gFile w updateCreateDvi
3401: destroy $createDviWindow
3402: removeWindowEntry CreateDvi
3403: removeFindList -3"
3404: bind $createDviWindow <Destroy> \
3405: "trace vdelete gFile w updateCreateDvi
3406: removeWindowEntry CreateDvi
3407: removeFindList -3"
3408: pack $appearingFrame $buttonFrame.ok -side left
3409:
3410: button $appearingFrame.stop -text "Stop Creating Print Jobs"\
3411: -command "stopPrinting"
3412: set name [file rootname [file tail $gFile ] ].dvi
3413: button $appearingFrame.print -text \
3414: "Save.dvi file to $name" \
3415: -command saveDvi
3416: trace variable gFile w updateCreateDvi
3417:
3418: if { $showStopButton } {
3419: pack $appearingFrame.stop $appearingFrame.print -side left
3420: pack forget $appearingFrame.print
3421: } else {
3422: pack $appearingFrame.stop $appearingFrame.print -side left
3423: pack forget $appearingFrame.stop
3424: }
3425:
3426: Centre_Dialog $createDviWindow default
3427: update
3428: } else {
3429: if { $showStopButton } {
3430: pack forget .createDvi.buttonFrame.appearingFrame.print
3431: pack .createDvi.buttonFrame.appearingFrame.stop
3432: } else {
3433: pack forget .createDvi.buttonFrame.appearingFrame.stop
3434: pack .createDvi.buttonFrame.appearingFrame.print
3435: }
3436: if { !$useqzparse } { $gCreateDviText delete 0.0 end }
3437: }
3438:
3439: exec /bin/rm -f quiztemp.dvi
3440: $gCreateDviText insert end "$gCapaConfig(latex_command)\n"
3441: $gCreateDviText see end
3442: set createdDvi [ runLatex "pwd ; $gCapaConfig(latex_command) quiztemp.tex < \
3443: [file join / dev null ]" gCreateDviText]
3444:
3445: if { ($showXdvi == 1) && ( $createdDvi == 1 ) } {
3446: eval "exec $gCapaConfig(xdvi_command) $gXdviOpt quiztemp.dvi >& /dev/null & "
3447: }
3448:
3449: catch { capaRaise $gParseErrorsText }
3450: set gDonePrinting 1
3451: return $createdDvi
3452: }
3453:
3454: ###########################################################
3455: ###########################################################
3456: ###########################################################
3457: ###########################################################
3458: proc stopPrinting {} {
3459: global gStopPrinting
3460: set gStopPrinting 1
3461: }
3462:
3463: ###########################################################
3464: ###########################################################
3465: ###########################################################
3466: ###########################################################
3467: proc saveDvi { } {
3468: global gFile
3469:
3470: set name [file rootname [ file tail $gFile]].dvi
3471: catch { exec rm -f $name }
3472:
3473: if { [ catch { exec cp quiztemp.dvi $name } ] } {
3474: displayMessage "Unable to create $name "
3475: } else {
3476: displayMessage "Created $name "
3477: }
3478: }
3479:
3480:
3481: ###########################################################
3482: ###########################################################
3483: ###########################################################
3484: ###########################################################
3485: proc updateCreateDvi { name1 name2 op } {
3486: global gFile
3487:
3488: set name [file rootname [file tail $gFile ] ].dvi
3489: catch { .createDvi.buttonFrame.appearingFrame.print configure \
3490: -text "Save.dvi file to $name" }
3491: }
3492: ###########################################################
3493: ###########################################################
3494: ###########################################################
3495: ###########################################################
3496: proc printWindow {} {
3497: global gPrintSelection gWindowMenu gEditWindow gStopPrinting\
3498: gSetNumberText gMaxSet gFile gChanged
3499:
3500: set gStopPrinting 0
3501: if { [catch {set gEditWindow}] } { return }
3502: if { ![winfo exists $gEditWindow] } { return }
3503:
3504: if { [winfo exists .print] } {
3505: capaRaise .print
3506: return
3507: }
3508: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
3509:
3510: set print [toplevel .print]
3511: $gWindowMenu add command -label "Print" -command "capaRaise $print"
3512: wm title $print "Select a Print Method"
3513: message $print.msg -text "Please specify a print method." -aspect 10000
3514: set oneSetFrame [frame $print.frame1 -relief groove -borderwidth 4]
3515: set moreSetFrame [frame $print.frame2 -relief groove -borderwidth 4]
3516: set buttonFrame [frame $print.buttons]
3517: pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top
3518: pack configure $oneSetFrame $moreSetFrame -anchor w -fill x
3519:
3520: set infoFrame [frame $moreSetFrame.frame1]
3521: set setFrame [frame $moreSetFrame.frame2 -relief solid -borderwidth 1]
3522: pack $infoFrame $setFrame
3523: pack configure $infoFrame $setFrame -anchor w
3524:
3525: if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur}
3526: if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific}
3527: if {[catch {set gPrintSelection(setend)}]} {set gPrintSelection(setend) $gSetNumberText}
3528: radiobutton $setFrame.specific -text "Print Current Set ($gSetNumberText)" \
3529: -value "printCur" -variable gPrintSelection(sets)
3530: set scaleFrame [frame $setFrame.scales]
3531: pack $setFrame.specific $scaleFrame -anchor w
3532:
3533: for { set i 1 } { $i <= $gMaxSet } { incr i } {
3534: if { ! [file exists [file join [file dirname $gFile] records "set$i.db"]] } { break }
3535: }
3536: incr i -1
3537: set gPrintSelection(setend) $gSetNumberText
3538: radiobutton $scaleFrame.range -text "Print Set Range:" \
3539: -value "printRange" -variable gPrintSelection(sets)
3540: scale $scaleFrame.start -from 1 -to $i -variable gPrintSelection(setstart) \
3541: -orient h
3542: label $scaleFrame.msg -text "to"
3543: scale $scaleFrame.end -from 1 -to $i -variable gPrintSelection(setend) \
3544: -orient h
3545: pack $scaleFrame.range $scaleFrame.start $scaleFrame.msg \
3546: $scaleFrame.end -side left
3547:
3548: button $buttonFrame.ok -text "Select" -command selectedPrintMethod
3549: button $buttonFrame.cancel -text "Cancel" -command \
3550: "destroy .print
3551: removeWindowEntry Print"
3552: bind $print <Destroy> "removeWindowEntry Print"
3553: pack $buttonFrame.ok $buttonFrame.cancel -side left
3554:
3555: set currentDviFrame [frame $oneSetFrame.currentDvi]
3556: set currentPreviewFrame [frame $oneSetFrame.currentPreview]
3557: set randomFrame [frame $oneSetFrame.random]
3558: set specificFrame [frame $infoFrame.specific]
3559: set sectionFrame [frame $infoFrame.section]
3560: set multSectionFrame [frame $infoFrame.multsection]
3561: set wholeClassFrame [frame $infoFrame.wholeClass]
3562: pack $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \
3563: $sectionFrame $multSectionFrame $wholeClassFrame -anchor w \
3564: -side top
3565: pack configure $specificFrame -expand true -fill both
3566:
3567: radiobutton $currentDviFrame.currentDvi -text "Print current .dvi" \
3568: -value "printCurrentDvi" -variable gPrintSelection(type)
3569: pack $currentDviFrame.currentDvi -side left
3570:
3571: radiobutton $randomFrame.random -text \
3572: "Randomly select one student from section:" \
3573: -value "printRandom" -variable gPrintSelection(type)
3574: entry $randomFrame.entry -textvariable gPrintSelection(random) -width 3 \
3575: -validate key -validatecommand "limitEntry %W 3 number %P"
3576: pack $randomFrame.random $randomFrame.entry -side left
3577:
3578: radiobutton $specificFrame.specific -text "Specify the student by:" \
3579: -value "printSpecific" -variable gPrintSelection(type)
3580: set studentNumber [frame $specificFrame.studentNumber]
3581: set fullName [frame $specificFrame.fullName]
3582: pack $specificFrame.specific $studentNumber $fullName -side top
3583: pack configure $specificFrame.specific -anchor w
3584: pack configure $studentNumber $fullName -anchor e
3585:
3586: radiobutton $sectionFrame.section -text "Print section" \
3587: -value "printSection" -variable gPrintSelection(type)
3588: entry $sectionFrame.entry -textvariable gPrintSelection(section) -width 3 \
3589: -validate key -validatecommand "limitEntry %W 3 number %P"
3590: pack $sectionFrame.section $sectionFrame.entry -side left
3591:
3592: radiobutton $multSectionFrame.section -text "Print multiple sections" \
3593: -value "printMultipleSections" -variable gPrintSelection(type)
3594: pack $multSectionFrame.section -side left
3595:
3596: radiobutton $wholeClassFrame.wholeClass -text "Print whole class." \
3597: -value "printWholeClass" -variable gPrintSelection(type)
3598: pack $wholeClassFrame.wholeClass -side left
3599:
3600: message $studentNumber.msg -text "Student Number: " -aspect 10000
3601: entry $studentNumber.entry -textvariable gPrintSelection(studentNumber) -width 9 \
3602: -validate key -validatecommand "limitEntry %W 9 any %P"
3603: pack $studentNumber.msg $studentNumber.entry -side left
3604:
3605: message $fullName.msg -text "Student Name: " -aspect 10000
3606: entry $fullName.entry -textvariable gPrintSelection(studentName) -width 30 \
3607: -validate key -validatecommand "limitEntry %W 30 any %P"
3608: pack $fullName.msg $fullName.entry -side left
3609:
3610: trace variable gPrintSelection(studentNumber) w \
3611: "global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
3612: trace variable gPrintSelection(studentName) w \
3613: "global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
3614:
3615: # puts "trace info:[trace vinfo gPrintSelection(studentNumber)]"
3616:
3617: bind $studentNumber.entry <KeyPress-Return> \
3618: "fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 0"
3619: bind $fullName.entry <KeyPress-Return> \
3620: "fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 1"
3621:
3622:
3623: #Disable the entry boxes that are not selected, and enable the
3624: #ones that are
3625: # $specificFrame.specific configure -command "
3626: # $studentNumber.entry configure -state normal
3627: # $fullName.entry configure -state normal"
3628: # $randomFrame.random configure -command "
3629: # $studentNumber.entry configure -state disabled
3630: # $fullName.entry configure -state disabled"
3631:
3632: #If the window had been called up before we need to check the state
3633: #of the variable and disable/enable the correct enry boxes
3634: # if { $gPrintSelection(type) == "printSpecific" } {
3635: # $studentNumber.entry configure -state normal
3636: # $fullName.entry configure -state normal
3637: # }
3638: # if { $gPrintSelection(type) == "printRandom" } {
3639: # $studentNumber.entry configure -state disabled
3640: # $fullName.entry configure -state disabled
3641: # }
3642:
3643: Centre_Dialog $print default
3644: }
3645:
3646: proc selectedPrintMethod {} {
3647: global gStopPrinting gPrintSelection gStudentSelection
3648:
3649: switch $gPrintSelection(type) {
3650: printSpecific {
3651: if { $gPrintSelection(studentNumber) == "" } {
3652: displayError "You must specify a student number."
3653: return
3654: }
3655: }
3656: printSection {
3657: if { $gPrintSelection(section)== "" } {
3658: displayError "You must specify a section."
3659: return
3660: }
3661: }
3662: default {}
3663: }
3664:
3665: destroy .print
3666: removeWindowEntry Print
3667: [set gPrintSelection(type)]
3668: set gStopPrinting 0
3669: }
3670:
3671: ###########################################################
3672: # createCreateDviWin
3673: ###########################################################
3674: ###########################################################
3675: ###########################################################
3676: proc createCreateDviWin {} {
3677: global gWindowMenu gFile gCreateDviText
3678: if { ![winfo exists .createDvi] } {
3679: set createDviWindow [toplevel .createDvi]
3680: $gWindowMenu add command -label "CreateDvi" -command \
3681: "capaRaise $createDviWindow"
3682: wm title $createDviWindow "LaTeX Output"
3683:
3684: set windowFrame [frame $createDviWindow.windowFrame]
3685: set buttonFrame [frame $createDviWindow.buttonFrame]
3686:
3687: pack $windowFrame $buttonFrame -side bottom
3688: pack configure $windowFrame -expand true -fill both
3689: pack configure $buttonFrame -anchor e
3690:
3691: scrollbar $windowFrame.scroll -orient vertical -command \
3692: "$windowFrame.text yview"
3693: set gCreateDviText [text $windowFrame.text -yscrollcommand \
3694: "$windowFrame.scroll set" -wrap char -height 40]
3695:
3696: pack $windowFrame.scroll $gCreateDviText -side left -expand 0
3697: pack configure $windowFrame.scroll -expand 0 -fill y
3698: pack configure $gCreateDviText -expand true -fill both
3699:
3700: set appearingFrame [frame $buttonFrame.appearingFrame]
3701: button $buttonFrame.ok -text Dismiss -command \
3702: "checkDestroyPrint $createDviWindow"
3703: wm protocol $createDviWindow WM_DELETE_WINDOW \
3704: "checkDestroyPrint $createDviWindow"
3705: pack $appearingFrame $buttonFrame.ok -side left
3706:
3707: button $appearingFrame.stop -text "Stop Creating Print Jobs"\
3708: -command "stopPrinting"
3709: set name [file rootname [file tail $gFile ] ].dvi
3710: button $appearingFrame.print -text \
3711: "Save.dvi file to $name" \
3712: -command saveDvi
3713: trace variable gFile w updateCreateDvi
3714:
3715: pack $appearingFrame.stop $appearingFrame.print -side left
3716: pack forget $appearingFrame.print
3717:
3718: Centre_Dialog $createDviWindow default
3719: update
3720: } else {
3721: pack forget .createDvi.buttonFrame.appearingFrame.print
3722: pack .createDvi.buttonFrame.appearingFrame.stop
3723: }
3724: }
3725:
3726: ###########################################################
3727: # printBody
3728: ###########################################################
3729: # sends the file quiztemp.ps to the printer through lpr using
3730: # the option foud in gLprCommand
3731: ###########################################################
3732: # Arguments: none
3733: # Returns: Nothing
3734: # Globals: gCapaConfig -
3735: # gStopPrinting -
3736: # Files: quiztemp.ps - file containg info to print (removed)
3737: ###########################################################
3738: proc printBody { lprCommand { showCompletionMessage 1 } } {
3739: global gCapaConfig gStopPrinting gDonePrinting
3740:
3741: set errorMsg ""
3742: set error [ catch {exec $gCapaConfig(dvips_command) quiztemp.dvi \
3743: -o quiztemp.ps >& /dev/null} errorMsg ]
3744: if { $error } {
3745: displayError \
3746: "When attempting to run dvips an error occured : $errorMsg"
3747: return 1
3748: }
3749:
3750: if { $gStopPrinting } {
3751: displayMessage "Printing has been stopped."
3752: set gStopPrinting 0
3753: set gDonePrinting 1
3754: return 1
3755: }
3756:
3757: set errorMsg
3758: set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ]
3759:
3760: if { $error == 1 } {
3761: displayError "When attempting to print an error occured : $errorMsg"
3762: return 1
3763: } else {
3764: if { $showCompletionMessage } {
3765: displayMessage "Print job sent to the printer.\n $returnMessage"
3766: }
3767: }
3768:
3769: return 0
3770: }
3771:
3772:
3773:
3774: ###########################################################
3775: ###########################################################
3776: ###########################################################
3777: ###########################################################
3778: proc printCurrentDvi {} {
3779:
3780: set lprCommand [getLprCommand quiztemp.ps]
3781:
3782: if {$lprCommand == ""} {
3783: displayError "You must at least specify a print queue for lpr. \
3784: Nothing printed."
3785: return
3786: }
3787:
3788: if {$lprCommand == "Cancel"} {
3789: return
3790: }
3791:
3792: printBody $lprCommand
3793:
3794: return 0
3795: }
3796:
3797: ###########################################################
3798: ###########################################################
3799: ###########################################################
3800: ###########################################################
3801: proc printCurrentPreview {} {
3802:
3803: set lprCommand [getLprCommand quiztemp.ps]
3804:
3805: if {$lprCommand == ""} {
3806: displayError "You must at least specify a print queue for lpr. \
3807: Nothing printed."
3808: return
3809: }
3810:
3811: if {$lprCommand == "Cancel"} {
3812: return
3813: }
3814:
3815: if { [createDvi 0] == 2 } {
3816: displayMessage "Printing has been stopped"
3817: }
3818:
3819: printBody $lprCommand
3820:
3821: return 0
3822: }
3823:
3824: ###########################################################
3825: ###########################################################
3826: ###########################################################
3827: ###########################################################
3828: proc printRandom {} {
3829: global gStudentSelection gPrintSelection
3830:
3831: set lprCommand [getLprCommand quiztemp.ps]
3832:
3833: if {$lprCommand == ""} {
3834: displayError "You must at least specify a print queue for lpr. \
3835: Nothing printed."
3836: return
3837: }
3838:
3839: if {$lprCommand == "Cancel"} {
3840: return
3841: }
3842:
3843: set type $gStudentSelection(type)
3844: set random $gStudentSelection(random)
3845:
3846: set gStudentSelection(type) Random
3847: set gStudentSelection(random) $gPrintSelection(random)
3848:
3849: if { [createDvi 0 1] == 2 } {
3850: displayMessage "Printing has been stopped"
3851: }
3852:
3853: printBody $lprCommand
3854:
3855: set gStudentSelection(type) $type
3856: set gStudentSelection(random) $random
3857:
3858: return 0
3859: }
3860:
3861: ###########################################################
3862: ###########################################################
3863: ###########################################################
3864: ###########################################################
3865: proc printSpecific {} {
3866: global gStudentSelection gPrintSelection
3867:
3868: set lprCommand [getLprCommand quiztemp.ps]
3869:
3870: if {$lprCommand == ""} {
3871: displayError "You must at least specify a print queue for lpr. \
3872: Nothing printed."
3873: return
3874: }
3875:
3876: if {$lprCommand == "Cancel"} {
3877: return
3878: }
3879:
3880: set type $gStudentSelection(type)
3881: set studentNumber $gStudentSelection(studentNumber)
3882:
3883: set gStudentSelection(type) Specific
3884: set gStudentSelection(studentNumber) $gPrintSelection(studentNumber)
3885:
3886: if { [createDvi 0 1 1] == 2 } {
3887: displayMessage "Printing has been stopped"
3888: }
3889:
3890: printBody $lprCommand
3891:
3892: set gStudentSelection(type) $type
3893: set gStudentSelection(studentNumber) $studentNumber
3894:
3895: return 0
3896: }
3897:
3898: ###########################################################
3899: ###########################################################
3900: ###########################################################
3901: ###########################################################
3902: proc printStudent { studentNumber } {
3903: global gStudentSelection gStopPrinting gDonePrinting
3904:
3905: set type $gStudentSelection(type)
3906: set studentNumberOld $gStudentSelection(studentNumber)
3907:
3908: set gStudentSelection(type) Specific
3909: set gStudentSelection(studentNumber) $studentNumber
3910:
3911: set createdDvi [createDvi 0 1]
3912:
3913: if { $createdDvi == 1 } { printBody } else {
3914: displayMessage "Printing has been stopped"
3915: set gStopPrinting 0
3916: set gDonePrinting 1
3917: }
3918:
3919: set gStudentSelection(type) $type
3920: set gStudentSelection(studentNumber) $studentNumberOld
3921:
3922: return 0
3923: }
3924:
3925: proc checkDestroyPrint { createDviWindow } {
3926: global gDonePrinting
3927: if { !$gDonePrinting } {
3928: if { [makeSure "Do you really wish to stop printing?"] == "Yes" } {
3929: global gStopPrinting
3930: set gStopPrinting 1
3931: after 1000 "destroyPrint $createDviWindow"
3932: }
3933: return
3934: }
3935: destroyPrint $createDviWindow
3936: }
3937:
3938: proc destroyPrint { createDviWindow } {
3939: trace vdelete gFile w updateCreateDvi
3940: destroy $createDviWindow
3941: removeWindowEntry CreateDvi
3942: }
3943:
3944: ###########################################################
3945: ###########################################################
3946: ###########################################################
3947: ###########################################################
3948: proc setupSetsToPrint { setVar startVar endVar {checkForHeader 1}} {
3949: global gPrintSelection gSetNumberText gLoadHeaderSet
3950: upvar $setVar set $startVar start $endVar end
3951: if { $gPrintSelection(sets) == "printRange" } {
3952: set start $gPrintSelection(setstart)
3953: set end $gPrintSelection(setend)
3954: set set "$start:$end"
3955: set errors ""
3956: for {set i $start} {$i <= $end} {incr i} {
3957: set gLoadHeaderSet $i
3958: if {[catch {getHeaderInfo}]} { append errors ", $i" }
3959: }
3960: if { $checkForHeader && $errors != "" } {
3961: set errors [string range $errors 1 end]
3962: if { [llength $errors] > 1 } {
3963: set errors "s$errors"
3964: set errors [linsert $errors [expr [llength $errors] - 1] and]
3965: }
3966: displayError "DB header has not yet been set for set$errors. Please set the DB Header before printing Sections."
3967: return 1
3968: }
3969: } else {
3970: set start [set end [set set $gSetNumberText]]
3971: set gLoadHeaderSet $gSetNumberText
3972: if {$checkForHeader && [catch {getHeaderInfo}]} {
3973: displayError "DB header has not yet been set. Please set the DB Header before printing Sections."
3974: return 1
3975: }
3976: }
3977: }
3978:
3979: ###########################################################
3980: ###########################################################
3981: ###########################################################
3982: ###########################################################
3983: proc printSection { { lprCommand "" } } {
3984: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
3985: gCreateDviText gStopPrinting gPrefs gFile gDonePrinting \
3986: gLoadHeaderSet
3987:
3988: set gDonePrinting 0
3989: set showStopping 0
3990:
3991: if { [setupSetsToPrint set start end] == 1 } { return 1}
3992: if { $lprCommand == "" } {
3993: set showStopping 1
3994: set lprCommand [getLprCommand quiztemp.ps]
3995: if { $lprCommand == "" } {
3996: displayError "Print command was empty, unable to print."
3997: return 1
3998: }
3999: if {$lprCommand == "Cancel" } {
4000: return 1
4001: }
4002: }
4003:
4004: createCreateDviWin
4005:
4006: grab .createDvi
4007:
4008: $gCreateDviText delete 0.0 end
4009:
4010: switch $gPrefs(info) {
4011: Problem { set type "-T" }
4012: Answer { set type "-Ta" }
4013: ProblemAnswer { set type "-Tb" }
4014: default { set type "-T" }
4015: }
4016:
4017: if { [set gStopPrinting [expr 2 == [runLatex \
4018: "echo [pwd] | $gCapaConfig(qzparse_command) \
4019: -sec $gPrintSelection(section) -set $set \
4020: -d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
4021: for {set i $start} { $i <= $end} { incr i } {
4022: exec rm -f section$gPrintSelection(section)-set$i.tex
4023: }
4024: if {$showStopping} {
4025: displayMessage "Printing has been stopped."
4026: set gDonePrinting 1
4027: set gStopPrinting 0
4028: }
4029: return 1
4030: }
4031: if { $gStopPrinting } {
4032: displayMessage "Printing has been stopped."
4033: set gDonePrinting 1
4034: set gStopPrinting 0
4035: return 1
4036: }
4037:
4038: for { set i $start} { $i <= $end } { incr i } {
4039: if { ! [file exists section$gPrintSelection(section)-set$i.tex] } {
4040: if {$showStopping} {
4041: displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
4042: set gStopPrinting 0
4043: set gDonePrinting 1
4044: }
4045: return 2
4046: }
4047:
4048: exec mv section$gPrintSelection(section)-set$i.tex quiztemp.tex
4049: exec /bin/rm -f quiztemp.dvi
4050:
4051: $gCreateDviText insert end "$gCapaConfig(latex_command)\n"
4052: $gCreateDviText see end
4053:
4054: if { [set gStopPrinting [ expr 2 == [runLatex \
4055: "pwd ; $gCapaConfig(latex_command) \
4056: quiztemp.tex < [file join / dev null ]" gCreateDviText ] ] ] } {
4057: if {$showStopping} {
4058: displayError "The LaTeX command: $gCapaConfig(latex_command), was unable to produce the expected output. Printing stopped"
4059: set gStopPrinting 0
4060: set gDonePrinting 1
4061: }
4062: return 1
4063: }
4064:
4065: if { $gStopPrinting } {
4066: displayMessage "Printing has been stopped."
4067: set gDonePrinting 1
4068: set gStopPrinting 0
4069: return 1
4070: }
4071:
4072: set a [expr ($showStopping) && ($end == $i)]
4073: if { [set gStopPrinting [printBody $lprCommand $a ] ] } {
4074: if {$showStopping} {
4075: displayMessage "Printing has been stopped."
4076: set gDonePrinting 1
4077: set gStopPrinting 0
4078: }
4079: return 1
4080: }
4081: if { $gStopPrinting } {
4082: displayMessage "Printing has been stopped."
4083: set gDonePrinting 1
4084: set gStopPrinting 0
4085: return 1
4086: }
4087: }
4088:
4089: set gDonePrinting 1
4090: return 0
4091: }
4092:
4093: ###########################################################
4094: ###########################################################
4095: ###########################################################
4096: ###########################################################
4097: proc printMultipleSections { } {
4098: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
4099: gCreateDviText gStopPrinting gPrefs gDonePrinting
4100:
4101: #checks if the DB Header is set
4102: if { [setupSetsToPrint set start end] == 1 } { return 1}
4103:
4104: set sectionList [ getExistingSections ]
4105: set sectionsToPrint [ pickSections $sectionList "Select Sections to Print:" ]
4106:
4107: if { $sectionsToPrint == "" } {
4108: displayMessage "No sections selected, therefore nothing was printed."
4109: return 1
4110: }
4111: if { $sectionsToPrint == "Cancel" } {
4112: return 1
4113: }
4114:
4115: set lprCommand [getLprCommand quiztemp.ps]
4116: if { $lprCommand == "" } {
4117: displayError "Print command was empty, unable to print."
4118: return 1
4119: }
4120: if {$lprCommand == "Cancel" } {
4121: return 1
4122: }
4123:
4124: if { [makeSure "You have selected to print $gPrefs(info)s for sections: [string trim $sectionsToPrint], using the print command \"$lprCommand\", continue?"] == "Cancel" } {
4125: return 1
4126: }
4127:
4128: foreach section $sectionsToPrint {
4129: set gDonePrinting 0
4130: set gPrintSelection(section) $section
4131: if { [set gStopPrinting [printSection $lprCommand] ] } {
4132: set gDonePrinting 0
4133: if { $gStopPrinting == 2 } {
4134: displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
4135: } else {
4136: displayMessage "Printing has been stopped."
4137: }
4138: set gDonePrinting 1
4139: return 1
4140: }
4141: if { $gStopPrinting } {
4142: displayMessage "Printing has been stopped."
4143: set gStopPrinting 0
4144: set gDonePrinting 1
4145: return 1
4146: }
4147: }
4148: set gDonePrinting 1
4149: displayMessage "Print jobs sent to the printer."
4150: return 0
4151: }
4152:
4153: ###########################################################
4154: ###########################################################
4155: ###########################################################
4156: ###########################################################
4157: proc printWholeClass { } {
4158: global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
4159: gCreateDviText gStopPrinting gPrefs gDonePrinting
4160:
4161: if {[catch {getHeaderInfo}]} {
4162: displayError "DB header has not yet been set, Please set DB Header before printing Sections."
4163: return 1
4164: }
4165: set sectionsToPrint [ getExistingSections ]
4166:
4167: if { $sectionsToPrint == "" } {
4168: displayMessage "No sections exist, therefore nothing was printed."
4169: return 1
4170: }
4171:
4172: set lprCommand [getLprCommand quiztemp.ps]
4173:
4174: if { $lprCommand == "" } {
4175: displayError "Print command was empty, unable to print."
4176: return 1
4177: }
4178: if {$lprCommand == "Cancel" } {
4179: return 1
4180: }
4181:
4182: 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" } {
4183: return 1
4184: }
4185:
4186: foreach section $sectionsToPrint {
4187: set section [lindex $section 0]
4188: set gPrintSelection(section) $section
4189: set gStopPrinting [printSection $lprCommand]
4190: if { $gStopPrinting } {
4191: if { $gStopPrinting == 2 } {
4192: displayError "$gCapaConfig(qzparse_command) was unable to produce the expected output. Printing stopped"
4193: } else {
4194: displayMessage "Printing has been stopped."
4195: }
4196: set gDonePrinting 1
4197: set gStopPrinting 0
4198: return 1
4199: }
4200: }
4201: set gDonePrinting 1
4202: displayMessage "Print jobs sent to the printer."
4203: return 0
4204: }
4205:
4206: ###########################################################
4207: # analyzeSet
4208: ###########################################################
4209: ###########################################################
4210: ###########################################################
4211: proc analyzeSet {} {
4212: global gChanged gWindowMenu gEditWindow gAnalyze gSetNumberText gNumberParsedText
4213:
4214: if { [catch {winfo exists $gEditWindow}] } { return }
4215: if { ![ winfo exists $gEditWindow ] } { return }
4216: if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
4217: if { [winfo exists .analyzeSet] } {
4218: capaRaise .analyzeSet
4219: return
4220: }
4221:
4222: set analyze [toplevel .analyzeSet]
4223: $gWindowMenu add command -label "AnalyzeSet" \
4224: -command "capaRaise $analyze"
4225: wm title $analyze "Analyze Set"
4226:
4227: set settingsFrame [frame $analyze.settingsFrame]
4228: set dataFrame [frame $analyze.dataFrame]
4229: pack $settingsFrame $dataFrame -side top
4230:
4231: set classFrame [frame $settingsFrame.classFrame]
4232: set setFrame [frame $settingsFrame.setFrame]
4233: set probFrame [frame $settingsFrame.probFrame]
4234: set statusFrame [frame $settingsFrame.statusFrame]
4235: set statusBar [frame $settingsFrame.statusBar]
4236: set buttonFrame [frame $settingsFrame.buttonFrame]
4237: pack $classFrame $setFrame $probFrame $statusFrame $statusBar $buttonFrame \
4238: -side top
4239:
4240: set canvasFrame [frame $dataFrame.canvasFrame]
4241: set numberFrame [frame $dataFrame.numberFrame]
4242: pack $canvasFrame $numberFrame -side top
4243:
4244: set gAnalyze(class) [pwd]
4245: label $classFrame.label -textvariable gAnalyze(class)
4246: pack $classFrame.label
4247:
4248: set gAnalyze(set) $gSetNumberText
4249: label $setFrame.lbl -text "Set number:"
4250: label $setFrame.set -textvariable gAnalyze(set)
4251: # button $setFrame.change -text "Change" -command analyzeChangeSet
4252: pack $setFrame.lbl $setFrame.set -side left
4253:
4254: if { [set gAnalyze(maxprob) $gNumberParsedText] == "" } { set gAnalyze(maxprob) 1 }
4255:
4256: label $probFrame.label -text "Problem Number :"
4257: set gAnalyze(scale) [scale $probFrame.problem \
4258: -from 1 -to $gAnalyze(maxprob) \
4259: -variable gAnalyze(prob) -command analyzeUpdate \
4260: -orient h -length 150 -tickinterval 1]
4261: pack $probFrame.label $probFrame.problem -side left
4262:
4263: set gAnalyze(status) ""
4264: label $statusFrame.label -text "Status:"
4265: label $statusFrame.status -textvariable gAnalyze(status)
4266: pack $statusFrame.label $statusFrame.status -side left
4267:
4268: set gAnalyze(statcanvas) [canvas $statusBar.canvas -width 200 -height 20]
4269: pack $statusBar.canvas
4270: $gAnalyze(statcanvas) create rectangle 1 1 199 19 -outline black
4271: set gAnalyze(bar) [$gAnalyze(statcanvas) create rectangle 1 1 1 19 -fill red -outline black]
4272:
4273: button $buttonFrame.class -text "Run Class" -command "analyzeClass 1"
4274: button $buttonFrame.random -text "Run Random" -command analyzeRandom
4275: button $buttonFrame.stop -text "Stop" -command analyzeStop
4276: button $buttonFrame.close -text "Dismiss" -comman analyzeClose
4277: pack $buttonFrame.class $buttonFrame.random $buttonFrame.stop \
4278: $buttonFrame.close -side left
4279:
4280: set gAnalyze(canvaswidth) 600
4281: set gAnalyze(canvas) [canvas $canvasFrame.canvas -width $gAnalyze(canvaswidth) \
4282: -height 100]
4283: pack $gAnalyze(canvas)
4284:
4285: set hiFrame [frame $numberFrame.hiFrame]
4286: set lowFrame [frame $numberFrame.lowFrame]
4287: set uniqFrame [frame $numberFrame.uniqFrame]
4288: pack $lowFrame $hiFrame $uniqFrame -side left
4289: pack configure $hiFrame -anchor e
4290: pack configure $lowFrame -anchor w
4291:
4292: label $hiFrame.label -text "High End:"
4293: label $hiFrame.num -textvariable gAnalyze(highnum)
4294: pack $hiFrame.label $hiFrame.num -side left
4295:
4296: label $lowFrame.label -text "Low End:"
4297: label $lowFrame.num -textvariable gAnalyze(lownum)
4298: pack $lowFrame.label $lowFrame.num -side left
4299:
4300: label $uniqFrame.label -text "Num. Unique:"
4301: label $uniqFrame.num -textvariable gAnalyze(numuniq)
4302: pack $uniqFrame.label $uniqFrame.num -side left
4303:
4304: set gAnalyze(studentNumbers) [getStudentNumbers]
4305: set gAnalyze(exit) 0
4306: }
4307:
4308: ###########################################################
4309: # analyzeClass
4310: ###########################################################
4311: ###########################################################
4312: ###########################################################
4313: proc analyzeClass { {start 1} } {
4314: global gAnalyze gCapaConfig
4315: if { $gAnalyze(studentNumbers)=="" } { return }
4316: if { $start } {
4317: set gAnalyze(toprocess) $gAnalyze(studentNumbers)
4318: set gAnalyze(stop) 0
4319: set gAnalyze(update) 1
4320: set gAnalyze(done) 0
4321: set gAnalyze(total) [expr [llength $gAnalyze(toprocess)]/3]
4322: foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
4323: }
4324: set number [lindex $gAnalyze(toprocess) 0]
4325: set name [lindex $gAnalyze(toprocess) 1]
4326: set section [lindex $gAnalyze(toprocess) 2]
4327: set gAnalyze(toprocess) [lrange $gAnalyze(toprocess) 3 end]
4328: set command "$gCapaConfig(answers_command) $number \"$name\" $section $gAnalyze(set)"
4329: set fileId [open "|$command" "r"]
4330: set gAnalyze(pid) [pid $fileId]
4331: fconfigure $fileId -blocking 0
4332: fileevent $fileId readable "analyzeLine $fileId"
4333: set gAnalyze(status) "Processing $number"
4334: incr gAnalyze(done)
4335: $gAnalyze(statcanvas) coords $gAnalyze(bar) 1 1 [expr 200*($gAnalyze(done)/double($gAnalyze(total)))] 19
4336: update idletasks
4337: }
4338:
4339: ###########################################################
4340: # analyzeEatQuestion
4341: ###########################################################
4342: ###########################################################
4343: ###########################################################
4344: proc analyzeEatQuestion { fileId } {
4345: global gAnalyze
4346: if { $gAnalyze(exit) } {
4347: fileevent $fileId readable ""
4348: catch {close $fileId}
4349: return
4350: }
4351: set aline [gets $fileId]
4352: if { $aline != "" } {
4353: switch -- [lindex [split $aline :] 0] {
4354: EQES { fileevent $fileId readable "analyzeLine $fileId" }
4355: }
4356: }
4357: if { [eof $fileId] } { analyzeEnd $fileId }
4358: }
4359:
4360: ###########################################################
4361: # analyzeLine
4362: ###########################################################
4363: ###########################################################
4364: ###########################################################
4365: proc analyzeLine { fileId } {
4366: global gAnalyze
4367:
4368: if { $gAnalyze(exit) } {
4369: fileevent $fileId readable ""
4370: catch {close $fileId}
4371: return
4372: }
4373: set aline [gets $fileId]
4374: if { $aline != "" } {
4375: switch [lindex [split $aline :] 0] {
4376: ANS {
4377: incr gAnalyze(problemNum)
4378: set ans [string range $aline 4 end]
4379: set length [llength $ans]
4380: lappend gAnalyze($gAnalyze(problemNum).ans) \
4381: [lindex $ans 0]
4382: if { ($length == 2) || ($length == 4)} {
4383: lappend gAnalyze($gAnalyze(problemNum).unit) \
4384: [lindex $ans end]
4385: }
4386: if { ($length == 3) || ($length == 4) } {
4387: lappend gAnalyze($gAnalyze(problemNum).low) \
4388: [lindex $ans 1]
4389: lappend gAnalyze($gAnalyze(problemNum).high) \
4390: [lindex $ans 2]
4391: }
4392: }
4393: SET { set gAnalyze(problemNum) 0 }
4394: DONE {
4395: set gAnalyze(maxprob) $gAnalyze(problemNum)
4396: $gAnalyze(scale) configure -to $gAnalyze(maxprob)
4397: }
4398: ERROR {
4399: fileevent $fileId readable ""
4400: displayError "Answers returned invalid message: $aline"
4401: fileevent $fileId readable "analyzeLine $fileId"
4402: }
4403: BQES { fileevent $fileId readable "analyzeEatQuestion $fileId" }
4404: default {
4405: }
4406: }
4407: }
4408: if { [eof $fileId] } { analyzeEnd $fileId }
4409: }
4410:
4411: ###########################################################
4412: # analyzeEnd
4413: ###########################################################
4414: ###########################################################
4415: ###########################################################
4416: proc analyzeEnd { fileId } {
4417: global gAnalyze
4418: if { [eof $fileId] } {
4419: fileevent $fileId readable ""
4420: catch {close $fileId}
4421: if { $gAnalyze(stop) } { return }
4422: if { [llength $gAnalyze(toprocess)] > 0 } {
4423: analyzeClass 0
4424: } else {
4425: analyzeUpdate
4426: set gAnalyze(status) "Done"
4427: }
4428: if { !$gAnalyze(update) } {
4429: incr gAnalyze(update)
4430: analyzeUpdate
4431: } else {
4432: incr gAnalyze(update)
4433: if { $gAnalyze(update) == 10 } {
4434: set gAnalyze(update) 0
4435: }
4436: }
4437: }
4438: }
4439:
4440: ###########################################################
4441: # analyzeRandom
4442: ###########################################################
4443: ###########################################################
4444: ###########################################################
4445: proc analyzeRandom { } {
4446: global gAnalyze
4447: set numToRun [getString . "How many random students should be run?"]
4448: if { $numToRun == "" } { return }
4449: if { [catch {incr numToRun} ] } {
4450: displayMessage "Invalid number."
4451: }
4452: incr numToRun -1
4453: set gAnalyze(total) $numToRun
4454: catch {unset gAnalyze(toprocess)}
4455: for { set i 0 } { $i < $numToRun } { incr i } {
4456: append gAnalyze(toprocess) "[format "%09d" $i] Random 999 "
4457: }
4458: set gAnalyze(stop) 0
4459: set gAnalyze(update) 1
4460: set gAnalyze(done) 0
4461: foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
4462: analyzeClass 0
4463: }
4464:
4465: ###########################################################
4466: # analyzeUpdate
4467: ###########################################################
4468: ###########################################################
4469: ###########################################################
4470: proc analyzeUpdate { {newProbNumber 0} } {
4471: global gAnalyze
4472:
4473: if {[catch {set gAnalyze($gAnalyze(prob).ans)}]} { return }
4474: foreach problem [array names gAnalyze *.\[alh\]*] {
4475: if { [catch {set gAnalyze($problem) [lsort -real $gAnalyze($problem)]}]} {
4476: set gAnalyze($problem) [lsort $gAnalyze($problem)]
4477: }
4478: }
4479:
4480: set c $gAnalyze(canvas)
4481: $c delete all
4482: set gAnalyze(lownum) [set low [lindex $gAnalyze($gAnalyze(prob).ans) 0]]
4483: set gAnalyze(highnum) [set high [lindex $gAnalyze($gAnalyze(prob).ans) end]]
4484: set gAnalyze(numuniq) [llength [lunique $gAnalyze($gAnalyze(prob).ans)]]
4485: #don't draw anything if the answers aren't numbers
4486: if { [catch {expr $low + 1}]} { update idletask;return }
4487:
4488: $c create line 25 50 [expr $gAnalyze(canvaswidth) - 25] 50
4489: set diff [expr double($high-$low)]
4490: if { $diff == 0 } {
4491: set center [expr $gAnalyze(canvaswidth)/2.0]
4492: $c create oval [expr $center - 2] 48 [expr $center + 2] 52 -fill green
4493: update idletasks
4494: return
4495: }
4496: set delta [format "%1.e" [expr ($diff)/15.0]]
4497: set start [expr double(int($low/$delta)+1)*$delta]
4498: while { $start < $high } {
4499: set center [expr ($gAnalyze(canvaswidth)-50)*(($start-$low)/$diff)]
4500: set center [expr $center+25]
4501: $c create line $center 40 $center 60
4502: set start [expr $start + $delta]
4503: }
4504: if { ($low < 0) && ($high > 0) } {
4505: set center [expr ($gAnalyze(canvaswidth)-50)*((0-$low)/$diff)]
4506: set center [expr $center+25]
4507: $c create rectangle [expr $center - 1] 40 [expr $center + 1] 60
4508: }
4509: set lastpoint [lindex $gAnalyze($gAnalyze(prob).ans) 0]
4510: set num 0
4511: foreach point $gAnalyze($gAnalyze(prob).ans) {
4512: if { $lastpoint != $point } {
4513: set center [expr ($gAnalyze(canvaswidth)-50)*(($lastpoint-$low)/$diff)]
4514: set center [expr $center+25]
4515: $c create rectangle [expr $center - 2] [expr 49-$num] \
4516: [expr $center + 2] [expr 51+$num] -fill green
4517: set lastpoint $point
4518: set num 0
4519: } else {
4520: incr num
4521: }
4522: }
4523: set center [expr ($gAnalyze(canvaswidth)-50)*(($lastpoint-$low)/$diff)]
4524: set center [expr $center+25]
4525: $c create rectangle [expr $center - 2] [expr 49-$num] \
4526: [expr $center + 2] [expr 51+$num] -fill green
4527:
4528: update idletasks
4529: }
4530:
4531: ###########################################################
4532: # analyzeStop
4533: ###########################################################
4534: ###########################################################
4535: ###########################################################
4536: proc analyzeStop {} {
4537: global gAnalyze
4538: set gAnalyze(stop) 1
4539: set gAnalyze(status) "Stopped"
4540: exec kill -SIGKILL $gAnalyze(pid)
4541: }
4542:
4543: ###########################################################
4544: # analyzeClose
4545: ###########################################################
4546: ###########################################################
4547: ###########################################################
4548: proc analyzeClose { } {
4549: global gAnalyze
4550: destroy [winfo toplevel $gAnalyze(canvas)]
4551: unset gAnalyze
4552: global gAnalyze
4553: set gAnalyze(exit) 1
4554: }
4555:
4556: ###########################################################
4557: # checkIfValidFilename
4558: ###########################################################
4559: ###########################################################
4560: ###########################################################
4561: proc checkIfValidFilename {} {
4562: global gSetNumberText gPreviewButton
4563: if { [regexp \[^0-9\]+ $gSetNumberText] } {
4564: 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."
4565: $gPreviewButton configure -state disabled
4566: .main entryconfigure 5 -state disabled
4567: .main entryconfigure 7 -state disabled
4568: return 0
4569: }
4570: $gPreviewButton configure -state normal
4571: .main entryconfigure 5 -state normal
4572: .main entryconfigure 7 -state normal
4573: return 1
4574: }
4575:
4576: ###########################################################
4577: # updateChangeStatus
4578: ###########################################################
4579: ###########################################################
4580: ###########################################################
4581: proc updateChangeStatus { name1 name2 op } {
4582: global gChanged gRefChanged gRefText gChangedLast gRefChangedLast \
4583: gEditWindow gWindowMenu gRefFile
4584: if { $name1 == "gChanged" } {
4585: if { $gChanged != $gChangedLast } {
4586: set gChangedLast $gChanged
4587: global gFile
4588: if { [catch {set gEditWindow}] } { return }
4589: if { ![winfo exists $gEditWindow] } { return }
4590: if { $gChanged } {
4591: catch {removeWindowEntry "$gFile*"}
4592: wm title [winfo toplevel $gEditWindow] "$gFile (Modified)"
4593: $gWindowMenu add command -label "$gFile (Modified)" -command \
4594: "capaRaise $gEditWindow"
4595: } else {
4596: catch {removeWindowEntry "$gFile*"}
4597: wm title [winfo toplevel $gEditWindow] "$gFile"
4598: $gWindowMenu add command -label "$gFile" -command \
4599: "capaRaise $gEditWindow"
4600: }
4601: }
4602: } else {
4603: if { $gRefChanged($name2) != $gRefChangedLast($name2) } {
4604: if { [catch {set gRefText($name2)}] } { return }
4605: if { ![winfo exists $gRefText($name2)] } { return }
4606: if { $gRefChanged($name2) } {
4607: catch {removeWindowEntry "Reference $gRefFile($name2)*" }
4608: wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2) (Modified)"
4609: $gWindowMenu add command -label "Reference $gRefFile($name2) (Modified)" \
4610: -command "capaRaise [winfo toplevel $gRefText($name2)]"
4611: } else {
4612: catch {removeWindowEntry "Reference $gRefFile($name2)*" }
4613: wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2)"
4614: $gWindowMenu add command -label "Reference $gRefFile($name2)" \
4615: -command "capaRaise [winfo toplevel $gRefText($name2)]"
4616: }
4617: }
4618: }
4619: }
4620: ###########################################################
4621: # main
4622: ###########################################################
4623: # sets up the auto_path variable, some globals and adds some
4624: # options then calls createControlWindow to give the user something
4625: # to do
4626: ###########################################################
4627: # Arguments: None
4628: # Returns: Nothing
4629: # Globals:
4630: ###########################################################
4631:
4632: source quizzer.templates.tcl
4633:
4634: if { [lindex $auto_path 0] == "./lib/tcl7.5" } {
4635: set auto_path ""
4636: lappend auto_path [pwd]/lib/tcl7.5
4637: lappend auto_path [pwd]/lib/tk4.1
4638: }
4639:
4640: lappend auto_path /usr/local/lib/CAPA45/Quizzer
4641: lappend auto_path [pwd]
4642:
4643: set font 8x13bold
4644: catch {
4645: if { $argc > 0 } {
4646: switch -glob -- [lindex $argv 0] {
4647: {-[Ll]*} { set font 9x15bold }
4648: {-[Mm]*} -
4649: {-[Nn]*} { set font 8x13bold }
4650: {-[Ss]*} { set font fixed }
4651: }
4652: }
4653: }
4654: option add *font $font
4655: 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