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