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