###########################################################
# quizzer.tcl -
# Copyright Guy Albertelli II 1996
###########################################################
set gTclVer 4.0
###########################################################
# createControlWindow
###########################################################
# Creates the menu window
###########################################################
# Arguments: none
# Returns: nothing
###########################################################
proc createControlWindow {} {
global gPrefs gDate gFind gChanged gWindowMenu gStudentSelection gFile \
gUniqueNumber gXdviOpt gHeaderQCount gDir gHintVal gTryVal gProbVal \
gPutLine gQuizTemp gCapaConfig gStopPrinting gFindList gFirstTime \
gRefChanged gChangedLast gCreateImportLinks gFasterParsing
after 500 { dateUpdate }
after 1000 { cleanWindowList }
set gFasterParsing 1
set gFirstTime 1
set gPrefs(info) "Problem"
set gPrefs(TeXHeader) ""
set gPrefs(TeXFooter) ""
set gFind(find) ""
set gFind(replace) ""
set gFind(findOption) "-nocase"
set gFind(scope) File
set gChanged 0
set gChangedLast 0
trace variable gChanged w updateChangeStatus
trace variable gRefChanged w updateChangeStatus
set gStudentSelection(type) "Random"
set gStudentSelection(random) "1"
set gStudentSelection(studentNumber) ""
set gStudentSelection(studentName) ""
set gFile ""
set gUniqueNumber 1
set gXdviOpt "-geometry 800x650"
set gHeaderQCount 0
set gPutLine 1
set gTryVal 99
set gHintVal 1
set gProbVal 1
set gStopPrinting 0
set gDir(class) [pwd]
set gDir(import) [pwd]
set gDir(include) [pwd]
set gDir(reference) [pwd]
set gQuizTemp "true"
set gFindList(files) ""
set gFindList(refNum) ""
set gCreateImportLinks 1
set gCapaConfig(IMP_color) #0000ff
set gCapaConfig(comment_color) #008400
set gCapaConfig(Printer_selected) "0"
set gCapaConfig(latex_command) "latex"
set gCapaConfig(qzparse_command) "qzparse"
set gCapaConfig(dvips_command) "dvips"
set gCapaConfig(xdvi_command) "xdvi"
set gCapaConfig(lprOneSided_command) "lpr "
set gCapaConfig(lprTwoSided_command) ""
set gCapaConfig(printer_option) ""
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"
wm withdraw .
# there is code later on that depends upon .main existing and being visable
set menuFrame [menu .main -tearoff 0 -type tearoff ]
wm title $menuFrame "Quizzer"
$menuFrame post 0 0
wm geometry $menuFrame "+0+20"
$menuFrame add command -label "Quizzer" -foreground grey85 -background \
black -state disabled
$menuFrame add command -label "Info" -command { createInfoWindow }
$menuFrame add cascade -label "File" -menu $menuFrame.file
#$menuFrame add cascade -label "Edit .qz" -menu $menuFrame.edit
#$menuFrame add cascade -label "Find" -menu $menuFrame.find
$menuFrame add command -label "Prefs" -command { createPrefsWindow }
$menuFrame add cascade -label "Windows" -menu $menuFrame.windows
$menuFrame add command -label "Create .dvi" -command {
studentSelectWindow createDvi } -accelerator "Alt+D"
bind all <Alt-Shift-D> "studentSelectWindow createDvi"
$menuFrame add command -label "Analyze Set" -command {
analyzeSet } -accelerator "Alt+A"
bind all <Alt-Shift-A> "analyzeSet"
$menuFrame add command -label "Print" -command { printWindow }
$menuFrame add command -label "Remap" -command { createRemapWindow }
$menuFrame add command -label "Xdvi Options" -command { createXdviOpt }
#$menuFrame add command -label "Change font" -command { changeFont }
$menuFrame add command -label "Quit" -command { quit } \
-accelerator "Alt+q"
bind all <Alt-q> quit
bind $menuFrame <Destroy> "quit 1"
set file [menu $menuFrame.file -tearoff 1 ]
set edit [menu $menuFrame.edit -tearoff 1 ]
#set find [menu $menuFrame.find -tearoff 1 ]
set windows [menu $menuFrame.windows -tearoff 1 ]
set gWindowMenu $windows
$file add command -label "Set.qz File" -foreground grey50 -background \
black -state disabled
$file add command -label "New" -command {
createEditingWindow
pickCapaConfig
} -accelerator "Alt+n"
bind all <Alt-n> {
createEditingWindow
pickCapaConfig
}
$file add command -label "Open" -command { openDocument } -accelerator "Alt+o"
bind all <Alt-o> openDocument
$file add command -label "Save" -command { saveDocument } -accelerator "Alt+s"
# binding moved to the creation of the editwindow
# bind $menuFrame <Alt-s> saveDocument
$file add command -label "Save As..." -command { saveDocument 1 } \
-accelerator "Alt+S"
# binding moved to the creation of the editwindow
# bind $menuFrame <Alt-Shift-s> { saveDocument 1 }
$file add command -label "Delete" -command { deleteFile 0 }
$file add command -label "Close" -command { closeDocument } -accelerator "Alt+w"
# binding moved to the creation of the editwindow
# bind .main <Alt-w> closeDocument
$file add command -label "Reference File" -foreground grey90 -background \
black -state disabled
$file add command -label "New Reference File..." \
-command { newReferenceFile } -accelerator "Alt+t"
bind all <Alt-t> openReferenceFile
$file add command -label "Open Reference File..." \
-command { openReferenceFile } -accelerator "Alt+r"
bind all <Alt-r> openReferenceFile
$file add command -label "Open capa.config" \
-command { openReferenceFile capa.config }
$edit add command -label "Cut" -command { cut } -accelerator "Alt+x"
# binding moved to the creation of the editwindow
# bind $menuFrame <Alt-x> cut
$edit add command -label "Copy" -command { copy } -accelerator "Alt+c"
# binding moved to the creation of the editwindow
# bind $menuFrame <Alt-c> copy
$edit add command -label "Paste" -command { paste } -accelerator "Alt+v"
# binding moved to the creation of the editwindow
# bind .main <Alt-v> paste
$edit add command -label "Select All " -command { selectAll } \
-accelerator "Alt+a"
# binding moved to the creation of the editwindow
# bind $menuFrame <Alt-a> selectAll
$edit add separator
$edit add command -label "Undo" -command "undo 0" \
-accelerator "Alt+u"
# $edit add command -label "Redo" -command "redo $num"
$edit add separator
$edit add command -label "Find" -command { createFindWindow } \
-accelerator "Alt+f"
bind all <Alt-f> createFindWindow
# $find add command -label "Find Panel.." -command { createFindWindow } \
-accelerator "Alt+f"
# bind all <Alt-f> createFindWindow
# $find add command -label "Find Next" -command { next }
# $find add command -label "Find Previous" -command { previous }
# $find add command -label "Enter Selecton" -command { enterSelection }
# $find add command -label "Jump to Selection" -command { jumpToSelection }
# $find add command -label "Line Range..." -command { createLineWindow } \
-accelerator "Alt+l"
# bind all <Alt-l> createLineWindow
bind all <Alt-0> printInfo
bind all <Alt-KeyPress> { #unbind tkTraverseToMenu
}
bind all <Control-Tab> {tkTabToWindow [tk_focusPrev %W]}
catch {bind all <ISO_Left_Tab> {tkTabToWindow [tk_focusPrev %W]}}
catch {bind all <KP_Tab> {tkTabToWindow [tk_focusPrev %W]}}
trace variable gQuizTemp w "changeMenuStatus $menuFrame"
}
###########################################################
# changeMenuStatus
###########################################################
# either enables or disable printing or creation of Dvi files
# based on the value of the gQuizTemp global
###########################################################
# Argument: menuFrame (path name of the menu window)
# name1 (name of traced varaiable, gQuizTemp)
# name2 (empty argument from trace)
# op (tracing on writes so this should be "w")
# Returns : nothing
# Globals : gQuizTemp (r)
###########################################################
proc changeMenuStatus { menuFrame name1 name2 op } {
global gQuizTemp
if { $gQuizTemp } {
$menuFrame entryconfigure 5 -state normal
$menuFrame entryconfigure 6 -state normal
} else {
$menuFrame entryconfigure 5 -state disabled
$menuFrame entryconfigure 6 -state disabled
}
}
###########################################################
# printInfo
###########################################################
# gets called by Alt-0, used to print out variable while
# still running
###########################################################
# Argument: none
# Returns : nothing
# Globals : auto_path
###########################################################
proc printInfo { } {
global auto_path gUndo gRefText
set num [lindex [array names gRefText] 0]
set a "updateLocation 0"
puts [list Main2: [time $a 20000]]
set a "updateLocation $num"
puts [list Ref : [time $a 20000]]
}
###########################################################
# createXdviOpt
###########################################################
###########################################################
###########################################################
proc createXdviOpt {} {
global gXdviOpt gWindowMenu
if { [winfo exists .xdviOpt] } {
capaRaise .xdviOpt
return
}
set xdviOpt [toplevel .xdviOpt]
$gWindowMenu add command -label "XdviOptions" -command "capaRaise $xdviOpt"
wm title $xdviOpt "Options for Xdvi"
set messageFrame [frame $xdviOpt.msg]
message $xdviOpt.msg2 -text "Example: -geometry 800x700" -aspect 5000
set buttonFrame [frame $xdviOpt.buttons -bd 10]
pack $messageFrame $xdviOpt.msg2 $buttonFrame -side top -fill x
message $messageFrame.msg -text "Options to xdvi:" -aspect 5000
entry $messageFrame.entry -textvariable gXdviOpt
pack $messageFrame.msg $messageFrame.entry -side left -fill x
button $buttonFrame.ok -text Dismiss -command "destroy $xdviOpt
removeWindowEntry XdviOptions" -underline 0
pack $buttonFrame.ok -side left
bind $xdviOpt <Destroy> "removeWindowEntry XdviOptions"
}
###########################################################
# createInfoWindow
###########################################################
# creates the Information window
###########################################################
# Arguments: None
# Returns: Nothing
# Globals: gDate - the variable containg the current date
# gWindowMenu - used to register the new window in the
# windows menu
# gVer - Stores the current version of Quizzer (set in
# C init code
###########################################################
proc createInfoWindow {} {
global gDate gWindowMenu gVer gTclVer gCmd gCompileDate gUndoSize gUniqueNumber
if { [winfo exists .about] } {
capaRaise .about
return
}
set about [toplevel .about]
$gWindowMenu add command -label "About" -command "capaRaise $about"
wm title $about "About"
label $about.l1 -font 12x24 -text "Quizzer $gVer" -pady 20
label $about.l4 -font 8x13 -text "Quizzer.tcl version $gTclVer" -pady 20
label $about.l6 -font 8x13 -text "$gCompileDate"
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" \
-pady 20 -aspect 300
label $about.l3 -font 8x13 -textvariable gDate
label $about.l5 -font 8x13 -textvariable gCmd
label $about.l7 -font 8x13 -textvariable gUndoSize
label $about.l8 -font 8x13 -textvariable gUniqueNumber
button $about.close -text "Close" -command "destroy $about
removeWindowEntry About"
pack $about.l1 $about.l4 $about.l6 $about.l2 $about.l3 $about.l5 $about.l7 $about.l8\
$about.close -side top
bind $about <Destroy> "removeWindowEntry About"
Centre_Dialog $about default
}
###########################################################
# enterSelection
###########################################################
###########################################################
###########################################################
proc enterSelection {} {
global gTextWindow gFind
if { [catch {set gTextWindow}] } { return }
if { ![winfo exists $gTextWindow] } { return }
createFindWindow
catch {set gFind(find) [$gTextWindow get sel.first sel.last]}
}
###########################################################
# jumpToSelection
###########################################################
###########################################################
###########################################################
proc jumpToSelection {} {
global gTextWindow
catch {$gTextWindow see sel.first}
}
proc cut {} {global gTextWindow;tk_textCut $gTextWindow}
proc copy {} {global gTextWindow;tk_textCopy $gTextWindow}
proc paste {} {global gTextWindow;tk_textPaste $gTextWindow}
###########################################################
# selectAll
###########################################################
###########################################################
###########################################################
proc selectAll { { refNum 0 } } {
global gTextWindow gRefText
if { $refNum } { set window $gRefText($refNum) } else {
catch {set window $gTextWindow}
}
if { ![winfo exists $window] } { return }
$window tag add sel 0.0 end
}
###########################################################
# creatEditingWindow
###########################################################
###########################################################
# Arguments: none
# Returns: a one if the Editing window existed and a zero
# if it created a new window
# Globals:
###########################################################
proc createEditingWindow { {setupUndo 1} } {
global gEditWindow gPreviewMode gTextWindow gSetNumberText gFile \
gWindowMenu gNumberParsedText gLineNumberGoto gUndo \
gCharacterNumberGoto gLineNumberGoto gClosedDocument \
gPreviewButton gFirstTime
if { [winfo exists .editwindow] } {
capaRaise .editwindow
return 1
}
set gFirstTime 1
set gEditWindow [toplevel .editwindow]
$gWindowMenu add command -label "$gFile" -command "capaRaise $gEditWindow"
wm title $gEditWindow $gFile
set gClosedDocument 0
set editWindow [frame $gEditWindow.frame -borderwidth 10]
pack $editWindow -expand 1 -fill both
set editTop [frame $editWindow.editTop]
set editBottom [frame $editWindow.editBottom]
pack $editTop $editBottom -side top
pack configure $editBottom -expand 1 -fill both
set menuFrame [frame $editTop.menu -borderwidth 2 -relief raised]
set assignInfo [frame $editTop.assignInfo -borderwidth 4 -relief groove]
set mode [frame $editTop.mode -borderwidth 4 -relief groove]
set buttonAndGoto [frame $editTop.buttonAndGoto ]
pack $menuFrame $assignInfo $mode $buttonAndGoto -side left
pack configure $menuFrame -anchor n
menubutton $menuFrame.edit -text Edit -menu $menuFrame.edit.m
pack $menuFrame.edit -side left
set edit [ menu $menuFrame.edit.m ]
$edit add command -label "Cut" -command { cut } -accelerator "Alt+x"
$edit add command -label "Copy" -command { copy } -accelerator "Alt+c"
$edit add command -label "Paste" -command { paste } -accelerator "Alt+v"
$edit add command -label "Select All " -command { selectAll } -accelerator "Alt+a"
$edit add separator
$edit add command -label "Undo" -command "undo 0" -accelerator "Alt+u"
$edit add separator
$edit add command -label "Find" -command { createFindWindow } -accelerator "Alt+f"
bind all <Alt-f> createFindWindow
set buttons [frame $buttonAndGoto.buttons ]
set gotoFrame [ frame $buttonAndGoto.gotoFrame ]
pack $buttons $gotoFrame -side top
set button1 [frame $buttons.button1]
set button2 [frame $buttons.button2]
pack $button1 $button2 -side top
set gPreviewButton [button $button1.preview -text "Preview" -command \
{ studentSelectWindow createPreviewWindow }]
button $button1.dbHeader -text "DB Header" -command createDBHeader
button $button1.include -text "Include" -command includeFile
pack $button1.preview $button1.dbHeader $button1.include -side left
button $button2.header -text "Std. Header" \
-command insertStandardHeader
button $button2.import -text "Import" -command importFile
button $button2.end -text "Endline" -command insertEndline
pack $button2.header $button2.import $button2.end -side left
label $gotoFrame.msg -text "Current Line:"
label $gotoFrame.current -textvariable gLineNumber
entry $gotoFrame.line -width 8 -textvariable gLineNumberGoto
bind $gotoFrame.line <KeyPress-Return> "gotoLine"
button $gotoFrame.button -text "Goto" -command "gotoLine"
pack $gotoFrame.msg $gotoFrame.current $gotoFrame.line \
$gotoFrame.button -side left
# variable used by gotoLine, needs to be set if it doesn't exist
if { [ catch { set gCharacterNumberGoto } ] } {
set gCharacterNumberGoto ""
}
label $assignInfo.time -textvariable gDate
set setNum [frame $assignInfo.setNum -borderwidth 2]
set probsParsed [frame $assignInfo.probsParsed -borderwidth 2]
pack $assignInfo.time $setNum $probsParsed -side top
pack configure $setNum $probsParsed -anchor e
message $setNum.msg -text "Problem Set Number" -aspect 10000
set setNumberWindow [message $setNum.num -relief sunken -width 70 \
-textvariable gSetNumberText]
pack $setNum.num $setNum.msg -side right -anchor e
label $probsParsed.msg -text "Number of Questions Parsed"
set numberParsedWindow [label $probsParsed.num -relief sunken \
-textvariable gNumberParsedText]
pack $probsParsed.num $probsParsed.msg -side right -anchor e
message $mode.msg -text "Mode" -aspect 10000
radiobutton $mode.enscript -text "Enscript" -value "Enscript" \
-variable gPreviewMode
radiobutton $mode.tex -text "TeX" -value "TeX" -variable gPreviewMode
radiobutton $mode.web -text "Web" -value "Web" -variable gPreviewMode
pack $mode.msg $mode.enscript $mode.tex $mode.web -side top
pack configure $mode.enscript $mode.tex $mode.web -anchor w
set gPreviewMode Enscript
scrollbar $editBottom.scroll -orient vertical -command \
"$editBottom.text yview"
set gTextWindow [text $editBottom.text -yscrollcommand \
"$editBottom.scroll set" -wrap char -height 40]
pack $editBottom.scroll $editBottom.text -side left -expand 0
pack configure $editBottom.scroll -expand 0 -fill y
pack configure $editBottom.text -expand true -fill both
if { $setupUndo} {
rename $gTextWindow .$gTextWindow
trackChanges $gTextWindow 0
set gUndo(0) 0
set gUndo(0.cur) 0
}
bind $gTextWindow <Alt-s> saveDocument
bind $gTextWindow <Alt-Shift-s> { saveDocument 1 }
bind $gEditWindow <Alt-w> closeDocument
# bind $gEditWindow <Destroy> "closeDocument 1"
wm protocol $gEditWindow WM_DELETE_WINDOW "closeDocument 1"
bind $gTextWindow <Alt-x> "tk_textCut %W"
bind $gTextWindow <Alt-c> "tk_textCopy %W"
bind $gTextWindow <Alt-v> "tk_textPaste %W"
bind $gTextWindow <Alt-a> selectAll
bind $gTextWindow <Alt-u> "undo 0"
addFindList
Centre_Dialog $gEditWindow default
createImportLinks 0 0.0 end
return 0
}
###########################################################
# includeFile
###########################################################
###########################################################
###########################################################
proc includeFile {} {
global gTextWindow gDir
if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
return
}
# if { $gDir(include) == "." } { set gDir(include) [pwd] }
set file [tk_getOpenFile -filetypes \
{ { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
-title "Select the proper file" \
-initialdir "$gDir(include)" ]
if { $file == "" } { return }
set gDir(include) [file dirname $file]
if { $file == "" } { return }
set fileId [open $file "r"]
$gTextWindow insert insert [read $fileId [file size $file]]
}
###########################################################
# insertStandardHeader
###########################################################
###########################################################
###########################################################
proc insertStandardHeader {} {
global gTextWindow gCapaConfig
if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
return
}
$gTextWindow insert insert $gCapaConfig(standardQuizzerHeader)
}
###########################################################
# importFile
###########################################################
###########################################################
###########################################################
proc importFile {} {
global gTextWindow gDir gProbVal gTryVal gHintVal gPutLine
if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
return
}
# if { $gDir(import) == "." } { set gDir(import) [pwd] }
set file [tk_getOpenFile -filetypes \
{ { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
-title "Select the proper file" -initialdir "$gDir(import)" ]
if { $file == "" } { return }
set gDir(import) [file dirname $file]
if { [getProbValTryVal] == "Cancel" } { return }
$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"
if { $gPutLine } {
$gTextWindow insert insert "/DIS(stdline)\n"
} else {
$gTextWindow insert insert "/DIS(webonlyline)\n"
}
$gTextWindow see insert
}
###########################################################
# insertEndline
###########################################################
###########################################################
###########################################################
proc insertEndline {} {
global gTextWindow
if { [makeSure "Is the cursor in the correct position?"] == "Cancel" } {
return
}
$gTextWindow insert insert "/END(stdendline)\n"
}
###########################################################
# getProbValTryVal
###########################################################
###########################################################
###########################################################
proc getProbValTryVal {} {
global gPrompt gProbVal gTryVal gHintVal gPutLine
set dialog [toplevel .getProbValTryVal -borderwidth 10]
wm title $dialog "Getting Problem Value and Try Value"
wm geo $dialog "+200+200"
message $dialog.msg -text "Set the weight of the problem and the number of tries allowed." -aspect 700
set gPrompt(result) ""
scale $dialog.probVal -orient horizontal -variable gProbVal \
-from 0 -to 9 -label "Problem Value" -length 150
scale $dialog.tryVal -orient horizontal -variable gTryVal \
-from 0 -to 99 -label "Try Value" -length 150
scale $dialog.hintVal -orient horizontal -variable gHintVal \
-from 1 -to 99 -label "Number of Tries Before Showing Hint" -length 150
set gPrompt(stdline.1) "Put a stdline after this problem."
set gPrompt(stdline.0) "Put a webonlyline after this problem."
checkbutton $dialog.putLine -variable gPutLine \
-width 38 \
-textvariable gPrompt(displayLine) \
-command { set gPrompt(displayLine) $gPrompt(stdline.$gPutLine) }
set gPrompt(displayLine) $gPrompt(stdline.$gPutLine)
set buttonFrame [frame $dialog.buttons -bd 10]
pack $dialog.msg $dialog.probVal $dialog.tryVal $dialog.hintVal $dialog.putLine \
$buttonFrame -side top -fill x
button $buttonFrame.yes -text Import -command {set gPrompt(yes) 1} \
-underline 0
button $buttonFrame.cancel -text Cancel -command { set gPrompt(yes) 0 } \
-underline 0
pack $buttonFrame.yes $buttonFrame.cancel -side left
bind $dialog <Alt-Key> break
bind $dialog <Destroy> "set gPrompt(yes) 0"
Centre_Dialog $dialog default
update
focus $dialog
capaRaise $dialog
capaGrab $dialog
vwait gPrompt(yes)
capaGrab release $dialog
bind $dialog <Destroy> ""
destroy $dialog
if {$gPrompt(yes)} {
return Done
} else {
return Cancel
}
}
###########################################################
# updateDateBox
###########################################################
###########################################################
###########################################################
proc updateDateBox { listbox } {
global gControlDates
$listbox delete 0 end
for {set i 0} {$i < [llength $gControlDates]} {incr i } {
set date [lindex $gControlDates $i]
if { $i != 0 } {
$listbox insert end [eval format {"%4d %4d %s %s %s"} $date]
} else {
$listbox insert end [eval format {" DEFAULT %s %s %s"} [lrange $date 2 end]]
}
}
}
###########################################################
# loadDates
###########################################################
###########################################################
###########################################################
proc loadDates { listbox } {
global gControlDates
if { [catch {getHeaderInfo}]} {
displayError "That set.db does not exist"
}
updateDateBox $listbox
}
###########################################################
# deleteDate
###########################################################
###########################################################
###########################################################
proc deleteDate { listbox } {
global gControlDates
if { [set a [$listbox index anchor]] != 0 } {
catch {$listbox delete anchor}
set gControlDates [lreplace $gControlDates $a $a]
} else {
displayError "You can not delete the default setting, only change it."
}
}
###########################################################
# checkHeaderForDefault
###########################################################
###########################################################
###########################################################
proc checkHeaderForDefault { } {
global gControlDates
if { [lindex [lindex $gControlDates 0] 0] == 0 && \
[lindex [lindex $gControlDates 0] 1] == 0 } {
return 1
}
return 0
}
###########################################################
# dueAnswerOrder
###########################################################
###########################################################
###########################################################
proc dueAnswerOrder { } {
global gDates
set duetime [clock scan "$gDates(duemonth)/$gDates(dueday)/$gDates(dueyear) $gDates(duehour):$gDates(dueminute)"]
set answertime [clock scan "$gDates(answermonth)/$gDates(answerday)/$gDates(answeryear) $gDates(answerhour):$gDates(answerminute)"]
if { $duetime > $answertime } { return 1 } { return 0 }
}
###########################################################
# checkDateFields
###########################################################
###########################################################
###########################################################
proc checkDateFields { } {
global gDates
set result 1
foreach kind { open due answer } {
foreach type { year month day hour minute } {
if { [validate $kind $type] != 1 } {
return $kind$type
}
}
}
if { [validate "" durationhour] != 1 } { return durationhour }
if { [validate duration minute] != 1 } { return durationminute }
if { [catch { expr $gDates(sectionstart) }] } { return sectionstart } else {
if {[string length $gDates(sectionstart)] <1} { return sectionstart } else {
if { [catch { expr $gDates(sectionend) }] } { return sectionend } else {
if {[string length $gDates(sectionend)] <1} { return sectionend }
}
}
}
return $result
}
###########################################################
# validate
###########################################################
###########################################################
###########################################################
proc validate { kind type {newvalue novalue} } {
global gDates
#tcl interprets all strings of digits with 0 as the first number as being
#in octal, need to prevent this from causing an error
if { $newvalue == "novalue" } {
set temp $gDates($kind$type)
set lowfail -1
} else {
if { $newvalue == "" } { return 1 }
set temp $newvalue
set lowfail 1
}
if { [string length $temp] > 1 && [string index $temp 0] == 0 } {
set test [string range $temp 1 end]
} else {
set test $temp
}
if { [catch { expr $test }] } { return 0 } else {
switch $type {
year {
if { $test < 1990 } { return $lowfail }
if { $test > 9999 } { return 0 }
if { [string length $temp] > 4 } { return 0 }
}
month {
if { $test < 1 } { return $lowfail }
if { $test > 12 } { return 0 }
if { [string length $temp] > 2 } { return 0 }
}
day {
if { $test < 1 } { return $lowfail }
if { $test > 31 } { return 0 }
if { [string length $temp] > 2 } { return 0 }
}
hour {
if { $test < 0 } { return 0 }
if { $test > 23 } { return 0 }
if { [string length $temp] > 2 } { return 0 }
}
minute {
if { $test < 0 } { return 0 }
if { $test > 59 } { return 0 }
if { [string length $temp] > 2 } { return 0 }
}
durationhour {
if { $test < 0 } { return 0 }
if { [string length $temp] > 4 } { return 0 }
}
}
}
return 1
}
###########################################################
# getday
###########################################################
###########################################################
###########################################################
proc getday { kind } {
global gDates
if { [set day $gDates([set kind]day)] != ""} {
if { [set month $gDates([set kind]month)] != ""} {
if { [set year $gDates([set kind]year)] != ""} {
if { [ catch { set gDates($kind.dayoweek) \
[clock format [clock scan "$month/$day/$year"] \
-format %a] } error ] } {
set gDates($kind.dayoweek) ""
}
return
}
}
}
set gDates($kind.dayoweek) ""
}
###########################################################
# enableDateValidation
###########################################################
###########################################################
###########################################################
proc enableDateValidation { toplevel } {
global gDates
set dateFrame $toplevel.dateFrame
foreach type { open due answer } {
$dateFrame.[set type]date.year configure -validate key \
-validatecommand "validate $type year %P"
$dateFrame.[set type]date.month configure -validate key \
-validatecommand "validate $type month %P"
$dateFrame.[set type]date.day configure -validate key \
-validatecommand "validate $type day %P"
$dateFrame.[set type]time.hour configure -validate key \
-validatecommand "validate $type hour %P"
$dateFrame.[set type]time.minute configure -validate key \
-validatecommand "validate $type minute %P"
}
$gDates(optFrame).duration.hour configure -validate key \
-validatecommand "validate {} durationhour %P"
$gDates(optFrame).duration.minute configure -validate key \
-validatecommand "validate duration minute %P"
}
###########################################################
# addDateOptions
###########################################################
###########################################################
###########################################################
proc addDateOptions {} {
global gDates
pack $gDates(optFrame2)
$gDates(optBut) configure -text "Less Options" -command "removeDateOptions"
}
###########################################################
# removeDateOptions
###########################################################
###########################################################
###########################################################
proc removeDateOptions {} {
global gDates
pack forget $gDates(optFrame2)
$gDates(optBut) configure -text "More Options" -command "addDateOptions"
}
###########################################################
# createDateDialog
###########################################################
###########################################################
###########################################################
proc createDateDialog { toplevel makedefault } {
global gDates gPrompt2
catch [unset gDates]
set infoFrame [frame $toplevel.infoFrame]
set sectionFrame [frame $toplevel.sectionFrame -borderwidth 4]
set dateFrame [frame $toplevel.dateFrame]
set optionsFrame [frame $toplevel.optionsFrame]
set buttonFrame [frame $toplevel.buttonFrame]
pack $infoFrame $sectionFrame $dateFrame $buttonFrame -side top
if { $makedefault } {
label $sectionFrame.sectionl -text "Default value for all sections:"
pack $sectionFrame.sectionl
set gDates(sectionstart) 0
set gDates(sectionend) 0
} else {
grid [label $sectionFrame.sectionl -text "Dates and times are for"] \
-column 0 -columnspan 4 -row 0
grid [label $sectionFrame.section12 -text "section:"] -column 0 -row 1
grid [entry $sectionFrame.start -width 3 -textvariable gDates(sectionstart)] \
-column 1 -row 1
grid [label $sectionFrame.sectionl3 -text "through section: "] -column 2 -row 1
grid [entry $sectionFrame.end -width 3 -textvariable gDates(sectionend)] \
-column 3 -row 1
button $buttonFrame.getdefaults -text "Get Defaults" -command \
"setValues 0 0;enableDateValidation $toplevel"
pack $buttonFrame.getdefaults -side left
}
grid [label $dateFrame.datel -text "Date"] -column 1 -row 0
grid [label $dateFrame.timel -text "Time"] -column 2 -row 0
grid [label $dateFrame.helpd -text "yyyy/mm/dd"] -column 1 -row 1
grid [label $dateFrame.helpt -text "hh:mm"] -column 2 -row 1
grid [label $dateFrame.openl -text "Open"] -column 0 -row 2
grid [set openDate [frame $dateFrame.opendate -borderwidth 2 -relief sunken]] -column 1 -row 2
grid [set openTime [frame $dateFrame.opentime -borderwidth 2 -relief sunken]] -column 2 -row 2
grid [label $dateFrame.openday -textvariable gDates(open.dayoweek)] -column 3 -row 2
grid [label $dateFrame.duel -text "Due"] -column 0 -row 3
grid [set dueDate [frame $dateFrame.duedate -borderwidth 2 -relief sunken]] -column 1 -row 3
grid [set dueTime [frame $dateFrame.duetime -borderwidth 2 -relief sunken]] -column 2 -row 3
grid [label $dateFrame.dueday -textvariable gDates(due.dayoweek)] -column 3 -row 3
grid [label $dateFrame.answerl -text "Answer"] -column 0 -row 4
grid [set answerDate [frame $dateFrame.answerdate -borderwidth 2 -relief sunken]] -column 1 -row 4
grid [set answerTime [frame $dateFrame.answertime -borderwidth 2 -relief sunken]] -column 2 -row 4
grid [label $dateFrame.ansday -textvariable gDates(answer.dayoweek)] -column 3 -row 4
foreach type { open due answer } {
entry [set [set type]Date].year -width 4 -textvariable gDates([set type]year)
label [set [set type]Date].sl1 -text "/"
entry [set [set type]Date].month -width 2 -textvariable gDates([set type]month)
label [set [set type]Date].sl2 -text "/"
entry [set [set type]Date].day -width 2 -textvariable gDates([set type]day)
entry [set [set type]Time].hour -width 2 -textvariable gDates([set type]hour)
label [set [set type]Time].colon -text ":"
entry [set [set type]Time].minute -width 2 -textvariable gDates([set type]minute)
pack [set [set type]Date].year [set [set type]Date].sl1 \
[set [set type]Date].month [set [set type]Date].sl2 \
[set [set type]Date].day -side left
pack [set [set type]Time].hour [set [set type]Time].colon \
[set [set type]Time].minute -side left
}
set optionsFrame3 [frame $optionsFrame.options]
set gDates(optFrame) [ set optionsFrame2 [frame $optionsFrame3.options ] ]
pack $gDates(optFrame) $optionsFrame3
set gDates(optFrame2) $optionsFrame
set durationFrame [frame $optionsFrame2.duration]
checkbutton $optionsFrame2.view -variable gDates(viewbetween) \
-text "Allow Viewing between Due and Answer dates"
checkbutton $optionsFrame2.response -variable gDates(inhibitresponse) \
-text "Inhibit Correct/Incorrect response \n(normally only for exams/quizzes)"
pack $durationFrame $optionsFrame2.view $optionsFrame2.response -side top
set gDates(viewbetween) 0
set gDates(inhibitresponse) 0
label $durationFrame.label -text "Duration"
entry $durationFrame.hour -width 4 -textvariable gDates(durationhour)
label $durationFrame.colon -text ":"
entry $durationFrame.minute -width 2 -textvariable gDates(durationminute)
pack $durationFrame.label $durationFrame.hour $durationFrame.colon \
$durationFrame.minute -side left
set gDates(durationhour) 0
set gDates(durationminute) 0
button $buttonFrame.help -text "Help" -command "showHelp dateEntry"
button $buttonFrame.set -text "Ok" -command "set gPrompt2(ok) 1"
button $buttonFrame.cancel -text "Cancel" -command "set gPrompt2(ok) 0"
set gDates(optBut) [ button $buttonFrame.options -text "More Options" \
-command "addDateOptions"]
pack $buttonFrame.help $buttonFrame.set $buttonFrame.cancel $buttonFrame.options \
-side left
bind $toplevel <Destroy> "set gPrompt2(ok) 0"
bind $toplevel <KeyPress> "getday open;getday due;getday answer"
bind $toplevel <Return> {tkTabToWindow [tk_focusNext %W]}
}
###########################################################
# addCurrentDates
###########################################################
###########################################################
###########################################################
proc addCurrentDates { listbox makedefault {which -1} } {
global gControlDates gDates
foreach kind { open due answer } {
foreach type { year month day hour minute } {
#tcl interprets all strings of digits with 0 as the first number as
#being in octal, need to prevent this from causing an error
if { [string length $gDates($kind$type)] > 1 && \
[string index $gDates($kind$type) 0] == 0 } {
set gDates($kind$type) [string range $gDates($kind$type) 1 end]
}
}
}
set datestring [list $gDates(sectionstart) $gDates(sectionend) \
[format "%04d/%02d/%02d %02d:%02d" $gDates(openyear) \
$gDates(openmonth) $gDates(openday) \
$gDates(openhour) $gDates(openminute) ] \
[format "%04d/%02d/%02d %02d:%02d" $gDates(dueyear) \
$gDates(duemonth) $gDates(dueday) \
$gDates(duehour) $gDates(dueminute) ] \
[format "%04d/%02d/%02d %02d:%02d" $gDates(answeryear) \
$gDates(answermonth) $gDates(answerday) \
$gDates(answerhour) $gDates(answerminute) ] \
[format "%d:%d" $gDates(durationhour) $gDates(durationminute)] \
$gDates(inhibitresponse) $gDates(viewbetween) ]
if { $makedefault } {
if { ([info globals gControlDates] == "") || ($gControlDates == "") } {
set gControlDates [list $datestring]
} else {
set gControlDates [lreplace $gControlDates 0 0 $datestring]
}
} else {
if { $which > -1 } {
# puts "$gControlDates=$which=$which=$datestring"
set gControlDates [lreplace $gControlDates $which $which $datestring]
} else {
lappend gControlDates $datestring
}
}
updateDateBox $listbox
}
###########################################################
# setValues
###########################################################
###########################################################
###########################################################
proc setValues { which {doSections 1} } {
global gControlDates gDates
set datestring [lindex $gControlDates $which]
if { $doSections } {
set gDates(sectionstart) [lindex $datestring 0]
set gDates(sectionend) [lindex $datestring 1]
}
foreach type {open due answer} element {2 3 4} {
set gDates([set type]year) [lindex [split [lindex $datestring $element] "/" ] 0]
set gDates([set type]month) [lindex [split [lindex $datestring $element] "/" ] 1]
set gDates([set type]day) [lindex [split [lindex [lindex $datestring $element] 0] "/" ] 2]
set gDates([set type]hour) [lindex [split [lindex [lindex $datestring $element] 1] ":" ] 0]
set gDates([set type]minute) [lindex [split [lindex [lindex $datestring $element] 1] ":" ] 1]
}
set gDates(durationhour) [lindex [split [lindex $datestring 5] ":" ] 0]
set gDates(durationminute) [lindex [split [lindex $datestring 5] ":" ] 1]
set gDates(inhibitresponse) [lindex $datestring 6]
set gDates(viewbetween) [lindex $datestring 7]
getday open
getday due
getday answer
}
###########################################################
# changeDate
###########################################################
###########################################################
###########################################################
proc changeDate { listbox } {
global gDates gPrompt2 gControlDates
if { ![winfo exists $listbox] } { return }
if { [winfo exists .adddate] } { return }
if { [set which [$listbox index anchor]] == 0 } { set makedefault 1 } else {
set makedefault 0 }
if { $which == [$listbox index end] } {addDate $listbox;return}
set changeDate [toplevel .changeDate]
createDateDialog $changeDate $makedefault
setValues $which
enableDateValidation $changeDate
if { $makedefault } {
set gDates(sectionstart) 0
set gDates(sectionend) 0
}
Centre_Dialog $changeDate default
update
focus $changeDate
capaRaise $changeDate
capaGrab $changeDate
set done 0
while { $done != 1 } {
vwait gPrompt2(ok)
if { $gPrompt2(ok) == 1 } {
if { 1 != [set done [checkDateFields]] } {
displayError "Please correct field: $done"
set done 0
} else {
if { [dueAnswerOrder] } {
if { "Yes" == [makeSure "Right now answers are available before an assignment is due. Would you like to change this?."]} {
set done 0
} else {
set done 1
}
}
}
} else {
set done 1
}
}
capaGrab release $changeDate
bind $changeDate <Destroy> ""
destroy $changeDate
if {$gPrompt2(ok) == 1 } {
addCurrentDates $listbox $makedefault $which
}
return
}
###########################################################
# addDate
###########################################################
###########################################################
###########################################################
proc addDate { listbox } {
global gDates gPrompt2
if { ![winfo exists $listbox ] } { return }
if { [winfo exists .adddate ] } { return }
if { [$listbox index end] == 0 } { set makedefault 1 } else { set makedefault 0 }
set addDate [toplevel .adddate]
createDateDialog $addDate $makedefault
enableDateValidation $addDate
Centre_Dialog $addDate default
update
focus $addDate
capaRaise $addDate
capaGrab $addDate
set done 0
while { $done != 1 } {
vwait gPrompt2(ok)
if { $gPrompt2(ok) == 1 } {
if { 1 != [set done [checkDateFields]] } {
displayError "Please correct field: $done"
set done 0
} else {
if { [dueAnswerOrder] } {
if { "Yes" == [makeSure "Right now answers are available before an assignment is due. Would you like to change this?."]} {
set done 0
} else {
set done 1
}
}
}
} else {
set done 1
}
}
capaGrab release $addDate
bind $addDate <Destroy> ""
destroy $addDate
if {$gPrompt2(ok) == 1 } {
addCurrentDates $listbox $makedefault
}
return
}
###########################################################
# createDBHeader
###########################################################
###########################################################
###########################################################
proc createDBHeader {} {
global gNumberParsedText gPrompt gLoadHeaderSet gControlDates \
gSetNumberText gHeaderQCount gEnableDiscussion gFile
if { $gNumberParsedText == "" } {
displayError "You must first preview the file before creating the \
DB header."
return
}
if { [winfo exists .headerPrompt] } {
capaRaise .headerPrompt
return
}
set dialog [toplevel .headerPrompt -borderwidth 10]
wm geo $dialog "+200+200"
wm title $dialog "Creating DB Header"
message $dialog.msg -text "Header Information" -aspect 1000
set loadFrame [frame $dialog.loadFrame -borderwidth 4 -relief sunken]
set infoFrame [frame $dialog.infoFrame -borderwidth 4 -relief sunken]
set optionFrame [frame $dialog.options]
set buttonFrame [frame $dialog.buttons -bd 10]
pack $dialog.msg $loadFrame $infoFrame $optionFrame $buttonFrame -side top -fill x
set legendFrame [frame $infoFrame.legendFrame]
set listFrame [frame $infoFrame.listFrame]
set commandFrame [frame $infoFrame.commandFrame]
pack $legendFrame $listFrame $commandFrame -side top
label $legendFrame.legend1 -text " Section# | Open | Due | Answer "
label $legendFrame.legend2 -text "Start End| Date Time | Date Time | Date Time "
pack $legendFrame.legend1 $legendFrame.legend2 -side top
set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ]
scrollbar $listFrame.scroll -command "$listbox yview"
pack $listFrame.list $listFrame.scroll -side left
updateDateBox $listbox
button $commandFrame.add -text "Add" -command "addDate $listbox"
button $commandFrame.change -text "Change" -command "changeDate $listbox"
button $commandFrame.delete -text "Delete" -command "deleteDate $listbox"
pack $commandFrame.add $commandFrame.change $commandFrame.delete -side left
bind $listbox <Double-ButtonPress-1> "changeDate $listbox"
message $loadFrame.msg -text "Load header information from set:" \
-aspect 1000
set gLoadHeaderSet $gSetNumberText
entry $loadFrame.entry -textvariable gLoadHeaderSet -width 2
button $loadFrame.load -text "load" -command "loadDates $listbox"
pack $loadFrame.msg $loadFrame.entry $loadFrame.load -side left
if { [file exists [file join [file dirname $gFile] discussion $gSetNumberText]] } {
set gEnableDiscussion 1
} else {
set gEnableDiscussion 0
}
checkbutton $optionFrame.discuss -text "Enable Discussion Forum" \
-variable gEnableDiscussion
pack $optionFrame.discuss
button $buttonFrame.ok -text Set -command { set gPrompt(ok) 1 } \
-underline 0
button $buttonFrame.cancel -text Cancel -command { set gPrompt(ok) 0 } \
-underline 0
pack $buttonFrame.ok $buttonFrame.cancel -side left
bind $dialog <Destroy> "set gPrompt(ok) 0"
Centre_Dialog $dialog default
update
focus $dialog
capaRaise $dialog
capaGrab $dialog
bind $dialog <Destroy> ""
set done 0
while { $done != 1 } {
vwait gPrompt(ok)
if { $gPrompt(ok) == 1 } {
set done [checkHeaderForDefault]
if { $done == 0 } {
displayError "Must have a Default setting."
}
} else {
set done 1
}
}
capaGrab release $dialog
destroy $dialog
if {$gPrompt(ok) == 1 } {
updateDiscussion
eval updateHeader [ eval concat $gControlDates ]
}
return
}
###########################################################
# updateDiscussion
###########################################################
###########################################################
###########################################################
proc updateDiscussion {} {
global gFile gSetNumberText gEnableDiscussion
set dir [file dirname $gFile]
set disDir [file join $dir discussion $gSetNumberText]
set logDir [file join $dir discussion logs]
if { $gEnableDiscussion } {
if { ![file exists $disDir] } {
if { [file exists $disDir.unavailable] } {
exec mv $disDir.unavailable $disDir
} else {
file mkdir $disDir
file attributes $disDir -permissions 0777
}
}
if { ![file exists $logDir] } {
file mkdir [file join $dir discussion logs]
file attributes [file join $dir discussion logs] -permissions 0777
}
} else {
if { [file exists $disDir] } { exec mv $disDir $disDir.unavailable }
}
}
###########################################################
# allFieldsComplete2
###########################################################
###########################################################
###########################################################
proc allFieldsComplete2 {} {
global gLoadHeaderSet gControlDates
if { [string length $gOpenDate] != 8 } {
return 0
} elseif { [string length $gOpenTime] != 5 } {
return 0
} elseif { [string length $gDueDate] != 8 } {
return 0
} elseif { [string length $gDueTime] != 5 } {
return 0
} elseif { [string length $gAnswerDate] != 8 } {
return 0
} elseif { [string length $gAnswerTime] != 5 } {
return 0
} else {
return 1
}
}
###########################################################
# createFindWindow
###########################################################
###########################################################
###########################################################
proc createFindWindow { {num 0} } {
global gFind gWindowMenu gFindListbox
if { [winfo exists .find] } {
capaRaise .find
pickFindFile $num
return
}
set find [toplevel .find]
$gWindowMenu add command -label "Find" -command "capaRaise $find"
wm title $find "Find"
set findFrame [frame $find.findFrame -width 5i]
set replaceFrame [frame $find.replaceFrame ]
set optionsFrame [frame $find.optionsFrame ]
set buttonFrame [frame $find.buttonsFrame ]
pack $findFrame $replaceFrame $optionsFrame $buttonFrame -side top \
-anchor e
pack configure $buttonFrame -anchor center
message $findFrame.msg -text "Find:" -aspect 10000
entry $findFrame.entry -width 50 -textvariable gFind(find)
pack $findFrame.msg $findFrame.entry -side left
message $replaceFrame.msg -text "Replace with:" -aspect 10000
entry $replaceFrame.entry -width 50 -textvariable gFind(replace)
pack $replaceFrame.msg $replaceFrame.entry -side left
set fileFrame [frame $optionsFrame.file]
set scopeFrame [frame $optionsFrame.scope -relief groove -borderwidth 4]
set findOptionsFrame [frame $optionsFrame.findOptionsFrame -relief \
groove -borderwidth 4]
pack $fileFrame $scopeFrame $findOptionsFrame -side left
set fileList [ frame $fileFrame.list ]
set fileScroll [frame $fileFrame.scroll ]
pack $fileList $fileScroll -side left
pack configure $fileScroll -fill y
set gFindListbox [listbox $fileList.list -width 35 -height 4 \
-xscrollcommand "$fileList.scroll set" \
-yscrollcommand "$fileScroll.scroll set" \
-exportselection no]
scrollbar $fileList.scroll -orient h -command "$fileList.list xview"
pack $fileList.list $fileList.scroll -side top
pack configure $fileList.scroll -fill x
pack configure $fileList.list -fill both -expand 1
$fileList.list xview moveto 1
scrollbar $fileScroll.scroll -orient v \
-command "$fileList.list yview"
pack $fileScroll.scroll -fill y -expand 1
message $scopeFrame.msg -text "Replace All Scope" -aspect 10000
radiobutton $scopeFrame.file -value "File" -variable gFind(scope) -text \
"Entire File" \
radiobutton $scopeFrame.selection -value "Selection" -variable \
gFind(scope) -text "Selection"
pack $scopeFrame.msg $scopeFrame.file $scopeFrame.selection
pack configure $scopeFrame.file $scopeFrame.selection -anchor w
set gFind(scope) File
message $findOptionsFrame.msg -text "Find Options" -aspect 10000
radiobutton $findOptionsFrame.ignoreCase -variable gFind(findOption) \
-text "Ignore Case" -value "-nocase"
radiobutton $findOptionsFrame.exactCase -variable gFind(findOption) \
-text "Exact Case" -value "-exact"
radiobutton $findOptionsFrame.regexp -variable gFind(findOption) \
-text "Regular Expression" -value "-regexp"
pack $findOptionsFrame.msg $findOptionsFrame.ignoreCase \
$findOptionsFrame.exactCase $findOptionsFrame.regexp
pack $findOptionsFrame.ignoreCase $findOptionsFrame.exactCase \
$findOptionsFrame.regexp -anchor w
set gFind(findOption) "-nocase"
button $buttonFrame.replaceAll -text "Replace All" -command "replaceAll"
button $buttonFrame.replace -text "Replace" -command "replace"
button $buttonFrame.replaceFind -text "Replace and Find" -command \
"replaceFind"
button $buttonFrame.previous -text "Previous" -command "previous"
button $buttonFrame.next -text "Next <Return>" -command "next"
bind $find <KeyPress-Return> next
button $buttonFrame.close -text "Close" -command "removeWindowEntry Find
destroy $find"
bind $find <Destroy> "removeWindowEntry Find"
pack $buttonFrame.replaceAll $buttonFrame.replace \
$buttonFrame.replaceFind $buttonFrame.previous \
$buttonFrame.next $buttonFrame.close -side left
Centre_Dialog $find default
updateFindList
pickFindFile $num
}
###########################################################
# pickFindFile
###########################################################
###########################################################
###########################################################
proc pickFindFile { num } {
global gFindListbox gFindList gRefFile gFile
if { [catch {set gFindListbox}] } { return }
if { ![winfo exists $gFindListbox] } { return }
if { $num == 0 } {
set newfile $gFile
} else {
set newfile $gRefFile($num)
}
for {set i 0} {$i<[llength $gFindList(files)]} {incr i} {
set file [lindex $gFindList(files) $i]
if { $file == $newfile } { break }
}
if { $i < [llength $gFindList(files)] } {
$gFindListbox selection clear 0 end
$gFindListbox selection set $i
}
}
###########################################################
# updateFindList
###########################################################
###########################################################
###########################################################
proc updateFindList {} {
global gFindListbox gFindList
if { [catch {set gFindListbox}] } { return }
if { ![winfo exists $gFindListbox] } { return }
$gFindListbox delete 0 end
eval "$gFindListbox insert end $gFindList(files)"
$gFindListbox xview moveto 1
}
###########################################################
# whichFile
###########################################################
###########################################################
###########################################################
proc whichFile { refNum } {
global gRefFile gFile
if { $refNum > 0 } {
return $gRefFile($refNum)
} else {
if { $refNum < 0 } {
switch -- $refNum {
-1 { return "Preview Window" }
-2 { return "Parse Errors Window" }
-3 { return "LaTeX Output Window" }
}
} else {
return $gFile
}
}
}
###########################################################
# addFindList
###########################################################
###########################################################
###########################################################
proc addFindList { {refNum 0} } {
global gFindList gRefFile gFile
set file [whichFile $refNum]
lappend gFindList(files) $file
lappend gFindList(refNum) $refNum
updateFindList
}
###########################################################
# removeFindList
###########################################################
###########################################################
###########################################################
proc removeFindList { {refNum 0} } {
global gFindList gRefFile gFile
set file [whichFile $refNum]
set k [llength $gFindList(refNum)]
for {set i 0} {$i < $k } { incr i } {
if { $refNum == [lindex $gFindList(refNum) $i] } { break }
}
if { $i != $k } {
set gFindList(refNum) [lreplace $gFindList(refNum) $i $i]
set gFindList(files) [lreplace $gFindList(files) $i $i]
}
updateFindList
}
###########################################################
# getFindWindow
###########################################################
###########################################################
###########################################################
proc getFindWindow { {refNumVar none} } {
global gFindListbox gFindList gRefText gTextWindow \
gPreviewText gParseErrorsText gCreateDviText
set current [$gFindListbox curselection]
if { $current == "" } { set current 0 }
if { [set refNum [lindex $gFindList(refNum) $current] ] } {
if { $refNum < 0 } {
switch -- $refNum {
-1 { set window $gPreviewText }
-2 { set window $gParseErrorsText }
-3 { set window $gCreateDviText }
}
} else {
set window $gRefText($refNum)
}
} else {
set window $gTextWindow
}
if { $refNumVar != "none" } {
upvar $refNumVar refNumUp
set refNumUp $refNum
}
return $window
}
###########################################################
# replaceAll
###########################################################
###########################################################
###########################################################
proc replaceAll {} {
global gFind gCreateImportLinks
set window [getFindWindow]
if { ![winfo exists $window] } { return }
set gCreateImportLinks 0
set num 0
switch $gFind(scope) {
File
{
$window mark set insert 0.0
set begin 0.0
while { [nextRegion $begin end] != "" } {
incr num
replace
if { ! ($num%10) } { update idletasks }
set begin sel.last
}
}
Selection
{
set error [ catch {$window mark set replace sel.first}]
if { $error != 0 } { return }
$window mark set capaBegin sel.first
$window mark set capaEnd sel.last
while { [set begin [nextRegion capaBegin capaEnd]] != "" } {
incr num
replace
$window mark set capaBegin $begin
}
}
}
if { $num == 1 } { set s {} } { set s s }
update idletasks
set gCreateImportLinks 1
getFindWindow refNum
if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end }
displayMessage "Replaced $num occurance$s"
}
###########################################################
###########################################################
###########################################################
###########################################################
proc replace {} {
global gFind
set refNum 0
set window [getFindWindow refNum]
if { ![winfo exist $window] } { return }
set error [ catch {$window mark set replace sel.first}]
if { $error == 0 } {
$window delete sel.first sel.last
} else {
$window mark set replace insert
}
$window insert replace "$gFind(replace)"
catch {$window tag remove sel sel.first sel.last}
$window tag add sel "replace - [string length "$gFind(replace)"] \
chars " replace
$window see replace
$window mark unset replace
}
###########################################################
###########################################################
###########################################################
###########################################################
proc replaceFind {} {
set window [getFindWindow]
if { ![winfo exists $window] } { return }
replace
next
}
###########################################################
###########################################################
###########################################################
###########################################################
proc searchBody { found } {
global gFind
set window [getFindWindow refNum]
if { ![winfo exists $window] } { return }
catch {$window tag remove sel sel.first sel.last}
$window tag add sel $found "$found + [string length $gFind(find)] \
chars"
$window see $found
$window mark set insert "$found + [string length $gFind(find)] chars"
}
###########################################################
###########################################################
###########################################################
###########################################################
proc previous {} {
global gFind
set window [getFindWindow]
if { ![winfo exists $window] } { return }
if { [catch { set found [$window search $gFind(findOption) -backwards -- \
$gFind(find) "sel.first - 1 c" ] } ] } {
set found [ $window search $gFind(findOption) -backwards -- \
$gFind(find) "insert - 1 c" ]
}
if { $found != "" } { searchBody $found }
return $found
}
###########################################################
###########################################################
###########################################################
###########################################################
proc next {} {
global gFind
set window [getFindWindow]
if { ![winfo exists $window] } { return }
set found [ $window search $gFind(findOption) -forwards -- \
$gFind(find) "insert + 1 c" ]
if { $found != "" } {
searchBody $found
} else {
displayMessage "Search String Not Found"
}
return $found
}
###########################################################
###########################################################
###########################################################
###########################################################
proc nextRegion { begin end } {
global gFind
set window [getFindWindow]
if { ![winfo exists $window] } { return }
set error [ catch {set found [ $window search $gFind(findOption) \
-forwards -- $gFind(find) $begin $end ] } ]
if { $error != 0 } { set found "" }
if { $found != "" } {
searchBody $found
set found "$found + [string length $gFind(find)] chars"
}
return $found
}
###########################################################
###########################################################
###########################################################
###########################################################
proc createLineWindow {} {
global gLineNumber gCharacterNumber gLineNumberGoto gCharacterNumberGoto
global gWindowMenu
if { [winfo exists .lineWindow] } {
capaRaise .lineWindow
return
}
set lineWindow [toplevel .lineWindow]
$gWindowMenu add command -label "LineSelect" -command \
"capaRaise $lineWindow"
wm title $lineWindow "Select Line"
label $lineWindow.line -text "Line:"
grid $lineWindow.line -column 1 -row 0
label $lineWindow.character -text "Character:"
grid $lineWindow.character -column 2 -row 0
label $lineWindow.current -text "Current:"
grid $lineWindow.current -column 0 -row 1
label $lineWindow.lineNumber -textvariable gLineNumber
grid $lineWindow.lineNumber -column 1 -row 1
label $lineWindow.characterNumber -textvariable gCharacterNumber
grid $lineWindow.characterNumber -column 2 -row 1
label $lineWindow.goto -text "Goto:"
grid $lineWindow.goto -column 0 -row 2
entry $lineWindow.lineEntry -textvariable gLineNumberGoto
grid $lineWindow.lineEntry -column 1 -row 2
set gLineNumberGoto ""
entry $lineWindow.characterEntry -textvariable gCharacterNumberGoto
grid $lineWindow.characterEntry -column 2 -row 2
set gCharacterNumberGoto ""
button $lineWindow.close -text "Close" -command "destroy $lineWindow
removeWindowEntry LineSelect"
bind $lineWindow <Destroy> "removeWindowEntry LineSelect"
grid $lineWindow.close -column 1 -row 3
button $lineWindow.gotoButton -text "Goto<Return>" -command "gotoLine"
grid $lineWindow.gotoButton -column 2 -row 3
bind $lineWindow <KeyPress-Return> gotoLine
Centre_Dialog $lineWindow default
}
###########################################################
###########################################################
###########################################################
###########################################################
proc gotoLine {} {
global gTextWindow gLineNumberGoto gCharacterNumberGoto
if { [catch {set gTextWindow}] } { return }
if { ![winfo exists $gTextWindow] } { return }
if { $gCharacterNumberGoto == "" } {
if { $gLineNumberGoto == "" } {
return
} else {
$gTextWindow mark set insert $gLineNumberGoto.0
catch {$gTextWindow tag remove sel sel.first sel.last}
$gTextWindow tag add sel "insert linestart" "insert lineend"
$gTextWindow see insert
}
} else {
if { $gLineNumberGoto == "" } {
$gTextWindow mark set insert "insert linestart + \
$gCharacterNumberGoto chars"
catch {$gTextWindow tag remove sel sel.first sel.last}
$gTextWindow tag add sel "insert - 1 chars " insert
$gTextWindow see insert
} else {
$gTextWindow mark set insert $gLineNumberGoto.$gCharacterNumberGoto
catch {$gTextWindow tag remove sel sel.first sel.last}
$gTextWindow tag add sel "$gLineNumberGoto.$gCharacterNumberGoto \
- 1 chars " "$gLineNumberGoto.$gCharacterNumberGoto"
$gTextWindow see insert
}
}
}
proc faster {} {
global gFasterParsing
puts $gFasterParsing
}
###########################################################
# createPrefsWindow
###########################################################
###########################################################
###########################################################
proc createPrefsWindow {} {
global gPrefs gWindowMenu gEditWindow gFile gWhichFile gPrefsEditWindow \
gFasterParsing
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
if { [winfo exists .prefs] } { capaRaise .prefs; return }
set prefs [toplevel .prefs]
$gWindowMenu add command -label "Prefrences" -command "capaRaise $prefs"
wm title $prefs "Preferences"
set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4]
pack $frameAll -expand true -fill both
set frameFile [frame $frameAll.file]
set frameInfo [frame $frameAll.info -relief groove -borderwidth 4 ]
set frameButton [frame $frameAll.button ]
pack $frameButton $frameInfo $frameFile -side top -expand false
pack configure $frameButton -expand false -anchor center
message $frameInfo.msg -text "Print Out"
radiobutton $frameInfo.problem -text "Problems Only" -value "Problem" \
-variable gPrefs(info)
radiobutton $frameInfo.problemandanswer -text "Problems and Answers" \
-value "ProblemAnswer" -variable gPrefs(info)
radiobutton $frameInfo.answer -text "Answers Only" -value "Answer" \
-variable gPrefs(info)
pack $frameInfo.msg $frameInfo.problem $frameInfo.problemandanswer \
$frameInfo.answer -side left -expand false -anchor w
set selectMenu [tk_optionMenu $frameFile.menu gWhichFile HTMLheader HTMLfooter \
TeXheader TeXfooter]
set frameEdit [frame $frameFile.edit]
pack $frameFile.menu $frameEdit
pack configure $frameEdit -expand true -fill both
trace variable gWhichFile w changePrefFile
scrollbar $frameEdit.scroll -orient vertical -command "$frameEdit.text yview"
set gPrefsEditWindow [text $frameEdit.text -yscrollcommand \
"$frameEdit.scroll set" -wrap char -height 20 -width 80]
pack $frameEdit.scroll $frameEdit.text -side left
pack configure $frameEdit.scroll -expand false -fill y
pack configure $frameEdit.text -expand true -fill both
checkbutton $frameButton.faster -text "Faster Parsing" -command faster \
-variable gFasterParsing
button $frameButton.impcolor -text "/IMP color" -command "getColor IMP_color"
button $frameButton.commentcolor -text "// color" -command "getColor comment_color"
button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig"
button $frameButton.ok -text "Dismiss" -command "destroy $prefs
trace vdelete gWhichFile w changePrefFile
removeWindowEntry Prefrences"
bind $prefs <Destroy> "removeWindowEntry Preferences"
button $frameButton.save -text "Save All" -command "savePrefs"
pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \
$frameButton.ok $frameButton.save $frameButton.faster -side left
foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
if { [ catch {
set filename [file join [file dirname $gFile] $file ]
set fileId [open $filename r]
set gPrefs($file) [read $fileId [file size $filename ]]
close $fileId } errors ] } {
set gPrefs($file) ""
}
}
set gPrefs(currentFile) ""
set gWhichFile HTMLheader
Centre_Dialog $prefs default
}
###########################################################
# getColor
###########################################################
###########################################################
###########################################################
proc getColor { whatfor } {
global gCapaConfig gUniqueNumber gRefText
set color [tk_chooseColor -initialcolor $gCapaConfig($whatfor)]
set gCapaConfig($whatfor) $color
if { $color != "" } { updateColors }
displayMessage "To keep this color, put \"$whatfor = $color\" in the capa.config file."
}
###########################################################
# updateColors
###########################################################
###########################################################
###########################################################
proc updateColors {} {
global gCapaConfig gUniqueNumber gRefText
set todo [array names gRefText]
lappend todo 0
displayStatus "Updating Colors . . ." both
set num 0
foreach win $todo {
createImportLinks $win 0.0 end
incr num
updateStatusBar [expr $num/double([llength $todo])]
}
removeStatus
}
###########################################################
# changePrefFile
###########################################################
###########################################################
###########################################################
proc changePrefFile { var1 var2 op } {
global gPrefs gPrefsEditWindow gFile gWhichFile
if { $gPrefs(currentFile) != "" } {
set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
}
set gPrefs(currentFile) $gWhichFile
$gPrefsEditWindow delete 0.0 end
$gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
}
###########################################################
# updatePrefsWindow
###########################################################
###########################################################
###########################################################
proc updatePrefsWindow {} {
global gPrefs gPrefsEditWindow gFile gWhichFile
if { [catch {set gPrefsEditWindow}] } { return }
if { ![winfo exists $gPrefsEditWindow] } { return }
foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
if { [ catch {
set filename [file join [file dirname $gFile] $file ]
set fileId [open $filename r]
set gPrefs($file) [read $fileId [file size $filename]]
close $fileId } ] } {
set gPrefs($file) ""
}
}
$gPrefsEditWindow delete 0.0 end
$gPrefsEditWindow insert 0.0 $gPrefs($gWhichFile)
}
###########################################################
###########################################################
###########################################################
###########################################################
proc savePrefs {} {
global gPrefsEditWindow gFile gPrefs
if { [catch {set gPrefsEditWindow}] } { return }
if { ![winfo exists $gPrefsEditWindow] } { return }
if { $gPrefs(currentFile) != "" } {
set gPrefs($gPrefs(currentFile)) [$gPrefsEditWindow get 0.0 end-1c]
}
foreach file {HTMLheader HTMLfooter TeXheader TeXfooter} {
if { $gPrefs($file) != "" } {
set fileId [open [file join [file dirname $gFile] $file ] w]
puts -nonewline $fileId $gPrefs($file)
close $fileId
} else {
exec rm -f [file join [file dirname $gFile] $file ]
}
}
}
###########################################################
# checkHeader
###########################################################
###########################################################
###########################################################
proc checkHeader { numberParsed } {
global gWeightsDiffer gPartialDiffer gSetNumberText gHeaderQCount \
gControlDates gLoadHeaderSet gFirstTime
# if { $gFirstTime } { set gFirstTime 0; return }
set gLoadHeaderSet $gSetNumberText
set error [catch {getHeaderInfo}]
if { $error == 1 } {
set gHeaderQCount "0"
set gControlDates ""
displayError "The db file for this set does not yet exist."
} else {
set errortext ""
if { ( $numberParsed != $gHeaderQCount ) } {
set error 1
append errortext "Number of questions ($numberParsed) is different from the number in setX.db ($gHeaderQCount). "
}
if { $gWeightsDiffer } {
set error 1
append errortext "The problem weights specified in the QZ file are different from the ones in the DB file. "
}
if { $gPartialDiffer } {
set error 1
append errortext "Whether or not a problem is hand graded as specified in the QZ file is different from the DB file. "
}
if { $error } {
displayError "The curent DB Header does not match what the set file says it should be: $errortext. Set the DB Header!" red
}
}
return $error
}
###########################################################
# fillInStudentName
###########################################################
###########################################################
###########################################################
#proc notherefillInStudentName { v } {
# global $v
# set student [capaGetStudent [set ${v}(studentNumber)]]
# set ${v}(studentName) [lindex $student [expr [llength $student] - 1] ]
#}
###########################################################
# studentSelectWindow
###########################################################
###########################################################
###########################################################
proc studentSelectWindow { followupCommand } {
global gStudentSelection gChanged gWindowMenu gEditWindow
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
if { [winfo exists .studentSelect] } {
capaRaise .studentSelect
return
}
set student [toplevel .studentSelect]
$gWindowMenu add command -label "SelectStudent" \
-command "capaRaise $student"
wm title $student "Select Student"
message $student.msg -text "Please specify a student to preview" \
-aspect 10000
set infoFrame [frame $student.frame -relief groove -borderwidth 4]
set buttonFrame [frame $student.buttonFrame ]
pack $student.msg $infoFrame $buttonFrame -side top
button $buttonFrame.ok -text "Preview" -command \
"selectStudentPreview $student $followupCommand"
button $buttonFrame.cancel -text "Cancel" -command \
"destroy $student
trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
removeWindowEntry SelectStudent"
bind $student <Destroy> \
"trace vdelete gStudentSelection(studentNumber) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
trace vdelete gStudentSelection(studentName) w \"global gStudentSelection; set gStudentSelection(type) Specific ;#\"
removeWindowEntry SelectStudent"
pack $buttonFrame.ok $buttonFrame.cancel -side left
set randomAnyFrame [frame $infoFrame.randomany]
set randomFrame [frame $infoFrame.random]
set specificFrame [frame $infoFrame.specific]
set sectionFrame [frame $infoFrame.section]
# pack $randomAnyFrame $randomFrame $specificFrame $sectionFrame -side top
pack $randomFrame $specificFrame -side top
pack configure $specificFrame -expand true -fill both
radiobutton $randomAnyFrame.random -text "Randomly select a student" \
-value "RandomAny" -variable gStudentSelection(type)
pack $randomAnyFrame.random
radiobutton $randomFrame.random -text "Randomly select one student \
from section:" -value "Random" -variable gStudentSelection(type)
entry $randomFrame.entry -textvariable gStudentSelection(random) -width 3
pack $randomFrame.random $randomFrame.entry -side left
radiobutton $specificFrame.specific -text "Specify the student by:" \
-value "Specific" -variable gStudentSelection(type)
set studentNumber [frame $specificFrame.studentNumber]
set fullName [frame $specificFrame.fullName]
pack $specificFrame.specific $studentNumber $fullName -side top
pack configure $specificFrame.specific -anchor w
pack configure $studentNumber $fullName -anchor e
radiobutton $sectionFrame.section
message $studentNumber.msg -text "Student Number: " -aspect 10000
entry $studentNumber.entry -textvariable gStudentSelection(studentNumber) \
-width 9 -validate key -validatecommand "limitEntry %W 9 any %P"
pack $studentNumber.msg $studentNumber.entry -side left
message $fullName.msg -text "Student Name: " -aspect 10000
entry $fullName.msg2 -textvariable gStudentSelection(studentName) -width 35 \
-validate key -validatecommand "limitEntry %W 35 any %P"
pack $fullName.msg $fullName.msg2 -side left
trace variable gStudentSelection(studentNumber) w \
"global gStudentSelection; set gStudentSelection(type) Specific ;#"
trace variable gStudentSelection(studentName) w \
"global gStudentSelection; set gStudentSelection(type) Specific ;#"
bind $studentNumber.entry <KeyPress-Return> \
"fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 0"
bind $fullName.msg2 <KeyPress-Return> \
"fillInStudent gStudentSelection(studentName) gStudentSelection(studentNumber) 1"
# $specificFrame.specific configure -command \
"$studentNumber.entry configure -state normal"
# $randomFrame.random configure -command \
"$studentNumber.entry configure -state disabled"
Centre_Dialog $student default
}
###########################################################
# selectStudentPreview
###########################################################
###########################################################
###########################################################
proc selectStudentPreview { student followupCommand} {
global gStudentSelection
destroy $student
if { $gStudentSelection(type) == "Specific" } {
if {$gStudentSelection(studentNumber) == ""} {
fillInStudent gStudentSelection(studentName) \
gStudentSelection(studentNumber) 1
} else {
fillInStudent gStudentSelection(studentName) \
gStudentSelection(studentNumber) 0
}
if {$gStudentSelection(studentNumber) == ""} { return }
}
removeWindowEntry SelectStudent
$followupCommand
}
###########################################################
# createPreviewWindow
###########################################################
###########################################################
###########################################################
proc createPreviewWindow {} {
global gPreviewMode gPreviewText gPrefs gSetNumberText gStudentSelection
global gWindowMenu gNumberParsedText gNumber
global gLoadHeaderSet gHeaderQCount gControlDates
if { ![winfo exists .preview] } {
set previewWindow [toplevel .preview]
$gWindowMenu add command -label "Preview" -command \
"capaRaise $previewWindow"
wm title $previewWindow "Preview"
addFindList -1
set windowFrame [frame $previewWindow.windowFrame]
set buttonFrame [frame $previewWindow.buttonFrame]
pack $windowFrame $buttonFrame -side bottom
pack configure $windowFrame -expand true -fill both
pack configure $buttonFrame -anchor e
scrollbar $windowFrame.scroll -orient vertical -command \
"$windowFrame.text yview"
set gPreviewText [text $windowFrame.text -yscrollcommand \
"$windowFrame.scroll set" -wrap char -height 40]
pack $windowFrame.scroll $gPreviewText -side left -expand 0
pack configure $windowFrame.scroll -expand 0 -fill y
pack configure $gPreviewText -expand true -fill both
button $buttonFrame.ok -text Dismiss -command "destroy $previewWindow
removeWindowEntry Preview
removeFindList -1"
bind $previewWindow <Destroy> "removeWindowEntry Preview
removeFindList -1"
button $buttonFrame.save -text "Save Output" -command "saveText $gPreviewText"
button $buttonFrame.stop -text "Stop Parser" -command "stopParser"
button $buttonFrame.print -text "Print Output" -command "printText $gPreviewText"
pack $buttonFrame.print $buttonFrame.save $buttonFrame.stop \
$buttonFrame.ok -side left
Centre_Dialog $previewWindow default
wm withdraw $previewWindow
update idletasks
set win_width [winfo reqwidth $previewWindow]
set win_height [winfo reqheight $previewWindow]
wm geometry $previewWindow +[expr [winfo rootx $previewWindow] - \
100]+[winfo rooty $previewWindow]
wm deiconify $previewWindow
update
} else {
set previewWindow .preview
$gPreviewText delete 0.0 end
update
}
switch $gPrefs(info) {
Problem { set type 0 }
ProblemAnswer { set type 1 }
Answer { set type 2 }
}
grab .preview
if { [catch {
switch $gPreviewMode {
Enscript
{
set numberParsed [enscriptParse $type $gSetNumberText \
$gStudentSelection(type) $gStudentSelection(random) \
$gStudentSelection(studentNumber) \
$gStudentSelection(studentName) gPreviewText]
}
TeX
{
set numberParsed [texParse $type $gSetNumberText \
$gStudentSelection(type) $gStudentSelection(random) \
$gStudentSelection(studentNumber) \
$gStudentSelection(studentName) gPreviewText]
}
Web
{
set numberParsed [webParse $type $gSetNumberText \
$gStudentSelection(type) $gStudentSelection(random) \
$gStudentSelection(studentNumber) \
$gStudentSelection(studentName) gPreviewText]
}
} }]} { return }
grab release .preview
if { $numberParsed == -1 } {
destroy $previewWindow
removeWindowEntry Preview
return
}
checkHeader $numberParsed
$gPreviewText tag configure problem
$gPreviewText tag configure answer
capaRaise $previewWindow
set gNumberParsedText $numberParsed
showParseErrors
}
###########################################################
# openError
###########################################################
###########################################################
###########################################################
proc openError { file line type} {
global gRefLine gLineNumberGoto gTextWindow
if { $type == 2 } {
set gLineNumberGoto $line
gotoLine
capaRaise [winfo toplevel $gTextWindow]
} else {
if {[set num [openReferenceFile $file]]} {
update idletasks
set gRefLine($num) $line
gotoRefLine $num
}
}
}
###########################################################
# showParseErrors
###########################################################
###########################################################
###########################################################
proc showParseErrors {} {
global gParseErrorsText gWindowMenu gUniqueNumber gCapaConfig
set parseErrors [getParseErrors]
if { $parseErrors != "" } {
if { ![winfo exists .parseErrors] } {
set parseErrorsWindow [toplevel .parseErrors]
$gWindowMenu add command -label "ParseErrors" -command "capaRaise \
$parseErrorsWindow"
wm title $parseErrorsWindow "Parse Errors"
addFindList -2
set windowFrame [frame $parseErrorsWindow.windowFrame]
set buttonFrame [frame $parseErrorsWindow.buttonFrame]
pack $windowFrame $buttonFrame -side bottom
pack configure $windowFrame -expand true -fill both
pack configure $buttonFrame -anchor e
scrollbar $windowFrame.scroll -orient vertical -command \
"$windowFrame.text yview"
set gParseErrorsText [text $windowFrame.text -yscrollcommand \
"$windowFrame.scroll set" -wrap char -height 40]
pack $windowFrame.scroll $gParseErrorsText -side left -expand 0
pack configure $windowFrame.scroll -expand 0 -fill y
pack configure $gParseErrorsText -expand true -fill both
button $buttonFrame.ok -text Dismiss -command \
"destroy $parseErrorsWindow
removeWindowEntry ParseErrors
removeFindList -2"
bind $parseErrorsWindow <Destroy> "removeWindowEntry ParseErrors
removeFindList -2"
button $buttonFrame.save -text "Save Output" \
-command "saveText $gParseErrorsText"
button $buttonFrame.print -text "Print Output" \
-command "printText $gParseErrorsText"
pack $buttonFrame.print $buttonFrame.save \
$buttonFrame.ok -side left
Centre_Dialog $parseErrorsWindow default
update
capaRaise $parseErrorsWindow
} else {
$gParseErrorsText delete 0.0 end
capaRaise .parseErrors
}
foreach line [split $parseErrors "\n"] {
set tag 0
if { [regexp -indices {File:.+->(.+), Line ([0-9]+): ERROR:} $line result file linenum]} {
set tag 1
} else {
if { [regexp -indices {File:(.+), Line ([0-9]+): ERROR:} $line result file linenum]} {
set tag 2
}
}
if { $tag } {
set tagnum [incr gUniqueNumber]
set linenum [eval [list string range $line] $linenum]
set filename [eval [list string range $line] $file]
set i [expr [lindex [split [$gParseErrorsText index end] .] 0] - 1]
}
$gParseErrorsText insert end "$line\n"
if { $tag } {
$gParseErrorsText tag add error.$tagnum $i.[lindex $file 0] $i.[expr [lindex $file 1] + 1]
$gParseErrorsText tag configure error.$tagnum -foreground $gCapaConfig(IMP_color)
$gParseErrorsText tag bind error.$tagnum <Double-ButtonPress> \
"eval openError $filename $linenum $tag"
}
}
} else {
if { [winfo exists .parseErrors] } { $gParseErrorsText delete 0.0 end }
}
return $parseErrors
}
###########################################################
# printText
###########################################################
# prints the contents of the text window, creates a temp file named
# quiztemp.txt
###########################################################
# Arguments: window (name of text window to print the contents of.
# Returns : nothing
# Globals :
###########################################################
proc printText { window } {
if { ![winfo exists $window] } {
return
}
set lprCommand [getLprCommand quiztemp.txt]
if {$lprCommand == "Cancel"} {
return
}
set fileId [open "quiztemp.txt" w]
puts -nonewline $fileId "[ $window get 0.0 end ]"
close $fileId
set errorMsg ""
set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
if { $error == 1 } {
displayError "An error occurred while printing: $errorMsg"
} else {
displayMessage "Print job sent to the printer.\n $output"
}
exec rm -f quiztemp.txt
}
###########################################################
# saveText
###########################################################
# saves the contents of the text window
###########################################################
# Arguments: window (name of text window to save the contents of.
# saveAs (whether to ask to save)
# refNum (if supplied reference file unique number
# that is being saved)
# Returns : name of the file saved
# Globals :
###########################################################
proc saveText { window {saveAs 1} {refNum 0} } {
global gWindowMenu gRefFile gRefChanged gCapaConfig gFile
if { ![winfo exists $window] } {return}
if { $refNum } {
if {$saveAs} {
set dir [file dirname $gRefFile($refNum)]
set file ""
} else {
set dir [file dirname $gRefFile($refNum)]
set file [file tail $gRefFile($refNum)]
}
} else { set dir [ set file "" ] }
# if { $dir == "" || $dir == "."} { set dir [pwd] }
if { $file == "" } {
set file [tk_getSaveFile -title "Enter the name to Save As" \
-initialdir "$dir" ]
if { $file == "" } {
displayError "File not saved"
return
}
} else {
set file [file join $dir $file]
}
if { $refNum } {
catch {removeWindowEntry "Reference $gRefFile($refNum)*" }
catch {removeFindList $refNum}
set gRefFile($refNum) $file
addFindList $refNum
wm title [winfo toplevel $window] $file
$gWindowMenu add command -label "Reference $file" \
-command "capaRaise [winfo toplevel $window]"
if { !$saveAs } {
if { ([array name gCapaConfig quizzerBackupRef] == "") ||
($gCapaConfig(quizzerBackupRef)!="off") } {
if { [catch {file copy -force $file $file.bak} ] } {
displayError "Unable to create backup for $file"
}
}
}
}
set fileId [open $file w]
puts -nonewline $fileId [$window get 0.0 end]
close $fileId
if { $refNum } { set gRefChanged($refNum) 0 }
if { ([file tail $file] == "capa.config") && ($dir == [file dirname $gFile]) } {
if { [makeSure "Reread capa.config settings into Quizzer?"] != "Cancel" } {
rereadCapaConfig
}
}
return $file
}
###########################################################
# deleteFile
###########################################################
###########################################################
###########################################################
proc deleteFile { which } {
global gFile gRefFile
if { $which } { set file $gRefFile($which) } else { set file $gFile }
if { [makeSure "Do you wish to Delete $file"] == "Cancel" } { return }
if { $which } { closeRefFile $which 1 0 } else { closeDocument 1 0 }
file delete -- $file
}
###########################################################
###########################################################
###########################################################
###########################################################
proc rereadCapaConfig { } {
global gCapaConfig
set printer_option $gCapaConfig(printer_option)
unset gCapaConfig(printer_option)
set error [parseCapaConfig]
if { $error != "OK" } {
displayError "Invalid capa.config file"
set gCapaConfig(printer_option) $printer_option
}
setDefaultValues
updateColors
}
###########################################################
###########################################################
###########################################################
###########################################################
proc pickCapaConfig { } {
set error NOTOK
while { $error != "OK" } {
set file [tk_getOpenFile -title "Pick a capa.config file" \
-filetypes { { {CAPA configuration} {capa.config} } \
{ {All Files} {*} } }]
if { $file == "" } { break }
set oldDir [pwd]
cd [file dirname $file]
set error [parseCapaConfig]
if { $error != "OK" } { displayError "Invalid capa.config file"; cd $oldDir }
setDefaultValues
}
}
proc setDefaultValues {} {
global gProbVal gTryVal gHintVal gCapaConfig
catch {set gProbVal $gCapaConfig(default_prob_val)}
catch {set gTryVal $gCapaConfig(default_try_val)}
catch {set gHintVal $gCapaConfig(default_hint_val)}
}
###########################################################
# openDocument
###########################################################
###########################################################
###########################################################
proc openDocument {} {
global gFile gTextWindow gSetNumberText gPrefs gChanged gQuizTemp gUndo
if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
if { ![catch {set gTextWindow}] } {
if { [winfo exists $gTextWindow] } { return }
}
# the event generation is because of a bug in tk_getOpenFile
# After double cliking the mouse Button one is thought to be left down.
# this only seems to happen when a toplevel window is created
# after getting the file
set gFile [tk_getOpenFile -filetypes \
{ { {Quizzer} {"*.qz"} } { {All Files} {"*"} } } \
-title "Select the proper file" -initialdir "[pwd]" ]
# event generate .main <ButtonRelease-1>
if { $gFile == "" } { return }
if { [file isdirectory $gFile] } {
displayError "You attempted to open $gFile which is a directory not a file."
return
}
set error [ catch {set fileId [open $gFile r] } ]
if { $error } {
displayError "Unable to read $gFile"
return
}
set oldDir [pwd]
cd [file dirname $gFile]
set tempfiles ""
catch {set tempfiles [glob quiztemp.*]}
if { $tempfiles == "" } {
set gQuizTemp true
}
foreach quiztempFile $tempfiles {
if { ! ( [file isfile $quiztempFile] &&
[file writable $quiztempFile] ) } {
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" } {
cd $oldDir
set gQuizTemp true
return
} else {
set gQuizTemp false
break
}
}
}
if { $tempfiles == "" } {
if { ! [file writable $gFile] } {
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" } {
cd $oldDir
set gQuizTemp true
return
} else {
set gQuizTemp false
}
}
}
set error [parseCapaConfig]
if { $error != "OK" } {
cd $oldDir
set gQuizTemp true
return
}
setDefaultValues
createEditingWindow 0
$gTextWindow delete 0.0 end
$gTextWindow insert 0.0 [read $fileId [file size $gFile]]
$gTextWindow delete end-1c
rename $gTextWindow .$gTextWindow
trackChanges $gTextWindow 0
set gUndo(0) 0
set gUndo(0.cur) 0
createImportLinks 0 0.0 end
focus -force $gTextWindow
set coord [$gTextWindow bbox 0.0]
event generate $gTextWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
event generate $gTextWindow <ButtonRelease-1>
update
close $fileId
updatePrefsWindow
set gSetNumberText [string range [file rootname [file tail $gFile]] 3 end ]
checkIfValidFilename
set gChanged 0
}
###########################################################
# includeReferenceFile
###########################################################
###########################################################
###########################################################
proc includeReferenceFile { file num window } {
set index [$window index "file.$num.first linestart"]
if { ![file readable $file] } {
displayError "Unable to read file $file"
return
}
set impline [$window get $index "$index lineend"]
set fileId [open $file r]
$window insert $index /
update idletasks
if { [$window index end] == [$window index "$index + 1 lines"] } {
$window insert "$index + 1 lines" "\n[read $fileId [file size $file]]"
} else {
$window insert "$index + 1 lines" [read $fileId [file size $file]]
}
close $fileId
}
###########################################################
# impMenuSaveAs
###########################################################
###########################################################
###########################################################
proc impMenuSaveAs { file num window } {
set index [$window index "file.$num.first linestart"]
if { ![file readable $file] } {
displayError "Unable to read file $file"
return
}
set dir [file dirname $file]
if { $dir != "." } {
set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir $dir]
} else {
set dest [tk_getSaveFile -title "Enter the name to Save As" -initialdir [pwd]]
}
if { $dest == "" } {
displayError "File not saved"
return
}
if { [catch {file copy -force -- $file $dest} errorMsg ] } {
displayError "Unable to copy $file to $dest: $errorMsg"
return
}
$window delete $index "$index lineend"
if { $dir != "." } {
$window insert $index "/IMP \"$dest\""
} else {
$window insert $index "/IMP \"[file tail $dest]\""
}
}
###########################################################
# createImpMenu
###########################################################
###########################################################
###########################################################
proc createImpMenu { file num window } {
set menuFrame [menu .impmenu -tearoff 0 -type tearoff ]
# wm title $menuFrame "Quizzer"
wm overrideredirect $menuFrame 1
wm positionfrom $menuFrame program
$menuFrame post [winfo pointerx .] [winfo pointery .]
$menuFrame add command -label "Open" -command "openReferenceFile $file"
$menuFrame add command -label "Include" -command \
"includeReferenceFile $file $num $window"
$menuFrame add command -label "saveAs" -command "impMenuSaveAs $file $num $window"
grab $menuFrame
bind all <ButtonRelease> "grab release $menuFrame;destroy $menuFrame"
}
###########################################################
# registerCreateImportLinks
###########################################################
###########################################################
###########################################################
proc registerCreateImportLinks { num start end} {
global gDoCreateImportLinks gCreateImportLinks
if { $gCreateImportLinks && !$gDoCreateImportLinks($num) } {
after idle "createImportLinks $num $start $end"
set gDoCreateImportLinks($num) 1
}
}
###########################################################
# createImportLinks
###########################################################
###########################################################
###########################################################
proc createImportLinks { num start end } {
global gTextWindow gUniqueNumber gDoCreateImportLinks gRefText gCapaConfig
set gDoCreateImportLinks($num) 0
if { $num } { set window $gRefText($num) } else { set window $gTextWindow }
if { ![winfo exists $window] } { return }
set end [$window index $end]
set start [$window index $start]
set lastline [lindex [split $end .] 0]
set startline [lindex [split $start .] 0]
foreach tag [$window tag names] {
if { [regexp {file\..+} $tag ] } {
if { [$window tag nextrange $tag "$start linestart" "$end lineend"] != "" } {
$window tag delete $tag
}
}
}
for { set i $startline } { $i <= $lastline } { incr i } {
set aline [$window get $i.0 "$i.0 lineend"]
if { [regexp -nocase {(^[ ]*)(//.*)} $aline matchVar match1 match2] } {
set tagnum [incr gUniqueNumber]
set start [string length $match1]
set end [expr $start + [string length $match2]]
$window tag add file.$tagnum $i.$start $i.$end
$window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
} elseif { [regexp -nocase {(^.*/let.*[ ]+)(//.*)} $aline matchVar \
match1 match2] } {
set tagnum [incr gUniqueNumber]
set start [string length $match1]
set end [expr $start + [string length $match2]]
$window tag add file.$tagnum $i.$start $i.$end
$window tag configure file.$tagnum -foreground $gCapaConfig(comment_color)
}
if { [regexp -nocase "(.*/imp +)(\"\[^\"\]+\")(.*)" $aline matchVar \
match1 match2 match3] } {
set tagnum [incr gUniqueNumber]
set start [string length $match1]
set end [expr $start + [string length $match2]]
$window tag add file.$tagnum $i.$start $i.$end
$window tag configure file.$tagnum -foreground $gCapaConfig(IMP_color)
$window tag bind file.$tagnum <Double-ButtonPress> \
"eval openReferenceFile $match2"
$window tag bind file.$tagnum <ButtonPress-3> \
"eval createImpMenu $match2 $tagnum $window"
}
}
}
###########################################################
# isReferenceFileOpen
###########################################################
###########################################################
###########################################################
proc isReferenceFileOpen { file } {
global gWindowMenu
# if { [catch {set index [$gWindowMenu index "Reference $file"]} ] } { return "" }
set last [$gWindowMenu index end]
# puts $last
for { set index 1 } { $index <= $last } { incr index } {
# puts $index
catch {set entry [$gWindowMenu entrycget $index -label]}
if { "Reference" == [set entryfile [lindex $entry 0]] } {
set entryfile [lindex $entry 1]
}
# puts $entryfile
if { [catch {file stat $entryfile a1}] } { continue }
file stat $file a2
# puts "$a2(ino) == $a1(ino)"
if { $a2(ino) == $a1(ino) } {
# puts "seems right"
return [lindex [$gWindowMenu entrycget $index -command] 1]
}
}
# puts "failed $index"
return ""
# puts $index
# puts [$gWindowMenu entrycget $index -command]
# return [lindex [$gWindowMenu entrycget $index -command] 1]
}
###########################################################
# newReferenceFile
###########################################################
###########################################################
###########################################################
proc newReferenceFile { } {
global gDir
# if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
set file [tk_getSaveFile -title "Enter the name of the New reference file" \
-initialdir "$gDir(reference)" ]
event generate .main <ButtonRelease-1>
if { $file == "" } { return }
set gDir(reference) [file dirname $file]
if { [file isdirectory $file] } {
displayError "You attempted to create $file which is already a directory."
return
}
openReferenceFile $file 1
}
###########################################################
# openReferenceFile
###########################################################
###########################################################
###########################################################
proc openReferenceFile { {file ""} {new 0}} {
global gUniqueNumber gWindowMenu gDir
set num [incr gUniqueNumber]
global gRefCurLine gRefLine gRefText gRefChanged gRefFile gRefClosed \
gUndo gRefChangedLast
# the event generation is because of a bug in tk_getOpenFile
# After double cliking the mouse Button one is thought to be left down.
# this only seems to happen when a toplevel window is created
# after getting the file
if { $file == "" } {
# if { $gDir(reference) == "." } { set gDir(reference) [pwd] }
set file [tk_getOpenFile -filetypes \
{ { {All Files} {"*"} } { {Quizzer} {"*.qz"} } } \
-title "Select the proper file" \
-initialdir "$gDir(reference)" ]
event generate .main <ButtonRelease-1>
if { $file == "" } { return 0 }
set gDir(reference) [file dirname $file]
if { [file isdirectory $file] } {
displayError "You attempted to open $file which is a directory not a file."
return 0
}
} else {
if { !$new } {
if { [set window [isReferenceFileOpen $file] ] != "" } {
set num [lindex [split [lindex [split $window .] 1] e] end]
capaRaise $window
return $num
}
# specifically opening the capa.config file
if { $file == "capa.config" } {
global gTextWindow gFile
if { [catch {set gTextWindow}] } {
set file [tk_getOpenFile -filetypes \
{{{Capa.config file} {"capa.config"}}
{ {All Files} {"*"} } } \
-title "Select the proper file" \
-initialdir "$gDir(reference)" ]
if { $file == "" } { return 0 }
} else {
set file [file join [file dirname $gFile] capa.config]
}
} else {
if { ![file isfile $file] && ![file readable $file] } {
displayError "Unable to find $file"
return 0
}
if { [file isdirectory $file] } {
displayError "You attempted to open $file which is a directory not a file."
return 0
}
}
}
}
set gRefFile($num) $file
set referenceFile [toplevel .reference$num]
wm title $referenceFile "$file"
$gWindowMenu add command -label "Reference $file" \
-command "capaRaise $referenceFile"
set menuFrame [frame $referenceFile.menu -borderwidth 3 -relief raised]
set lineFrame [frame $referenceFile.lineFrame]
set windowFrame [frame $referenceFile.windowFrame]
pack $menuFrame $lineFrame $windowFrame
pack configure $windowFrame -expand 1 -fill both
pack configure $menuFrame -fill x
label $lineFrame.msg -text "Current Line:"
label $lineFrame.current -textvariable gRefCurLine($num)
entry $lineFrame.line -width 8 -textvariable gRefLine($num)
bind $lineFrame.line <KeyPress-Return> "+gotoRefLine $num"
button $lineFrame.button -text "Goto" -command \
"gotoRefLine $num"
pack $lineFrame.msg $lineFrame.current $lineFrame.line \
$lineFrame.button -side left
set infoFrame [frame $windowFrame.infoFrame]
set textFrame [frame $windowFrame.textFrame]
pack $infoFrame $textFrame -side top
pack configure $textFrame -expand 1 -fill both
scrollbar $textFrame.scroll -orient vertical -command \
"$textFrame.text yview"
set textWindow [text $textFrame.text -yscrollcommand \
"$textFrame.scroll set" -wrap char]
pack $textFrame.scroll $textWindow -side left -expand 0
pack configure $textFrame.scroll -expand 0 -fill y
pack configure $textWindow -expand true -fill both
# label $infoFrame.label -textvariable gRefFile($num)
# pack $infoFrame.label -side left
menubutton $menuFrame.file -text File -menu $menuFrame.file.m
menubutton $menuFrame.edit -text Edit -menu $menuFrame.edit.m
pack $menuFrame.file $menuFrame.edit -side left
set fileMenu [ menu $menuFrame.file.m ]
set editMenu [ menu $menuFrame.edit.m ]
$fileMenu add command -label Save -command \
"saveText $textWindow 0 $num" -accelerator "Alt+s"
bind $referenceFile <Alt-s> \
"saveText $textWindow 0 $num"
$fileMenu add command -label "Save As" -command \
"saveText $textWindow 1 $num" -accelerator "Alt+S"
bind $referenceFile <Alt-Shift-s> "saveText $textWindow 1 $num"
$fileMenu add command -label Delete -command "deleteFile $num"
$fileMenu add command -label Print -command "printText $textWindow"
$fileMenu add command -label Close -command "closeRefFile $num" \
-accelerator "Alt+w"
bind $referenceFile <Alt-w> "closeRefFile $num"
# bind $referenceFile <Destroy> "closeRefFile $num 1"
wm protocol $referenceFile WM_DELETE_WINDOW "closeRefFile $num 1"
$editMenu add command -label "Cut" -command "tk_textCut $textWindow" \
-accelerator "Alt+x"
bind $referenceFile <Alt-x> "tk_textCut $textWindow"
$editMenu add command -label "Copy" -command "tk_textCopy $textWindow" \
-accelerator "Alt+c"
bind $referenceFile <Alt-c> "tk_textCopy $textWindow"
$editMenu add command -label "Paste" -command "tk_textPaste $textWindow" \
-accelerator "Alt+v"
bind $referenceFile <Alt-v> "tk_textPaste $textWindow"
$editMenu add command -label "Select All " -command \
"selectAll $num " -accelerator "Alt+a"
bind $referenceFile <Alt-a> "selectAll $num"
$editMenu add separator
$editMenu add command -label "Undo" -command "undo $num" \
-accelerator "Alt+u"
bind $referenceFile <Alt-u> "undo $num"
# $editMenu add command -label "Redo" -command "redo $num"
$editMenu add separator
$editMenu add command -label "Find" -command "createFindWindow $num" \
-accelerator "Alt+f"
if { !$new } {
set fileId [open $file r]
$textWindow insert 0.0 [read $fileId [file size $file]]
$textWindow delete end-1c
close $fileId
}
set gRefText($num) $textWindow
rename $textWindow .$textWindow
trackChanges $textWindow $num
set gUndo($num) 0
set gUndo($num.cur) 0
createImportLinks $num 0.0 end
focus -force $textWindow
# update
set coord [$textWindow bbox 0.0]
event generate $textWindow <1> -x [lindex $coord 0] -y [lindex $coord 1]
# update
event generate $textWindow <ButtonRelease-1>
# update
# capaRaise $referenceFile
after 1 "catch \{focus $textWindow;raise $referenceFile\}"
selection clear
#order is important here since gRefChanged has a trace on it the references
#gRefChangedLast
set gRefChangedLast($num) 0
set gRefChanged($num) 0
set gRefClosed($num) 0
addFindList $num
return $num
}
###########################################################
###########################################################
###########################################################
###########################################################
proc trackChanges { procName num } {
eval "proc $procName args {
global gUndo gRefChanged gChanged
if {\[regexp {^(ins|del).*} \[lindex \$args 0\]\]} {
#puts \"\$args\"
if { \$gUndo($num.cur) != \$gUndo($num) } {
set i \[expr \$gUndo($num.cur) + 1 \]
while { \[ info exists gUndo($num.\$i) \] } {
unset gUndo($num.\$i)
incr i
}
set gUndo($num) \$gUndo($num.cur)
}
set gUndo($num.cur) \$gUndo($num)
set insertindex \[.$procName index \[lindex \$args 1 \] \]
set numChange \[set gUndo($num.cur) \[incr gUndo($num) \] \]
if { $num == 0 } { set gChanged 1 } else { set gRefChanged($num) 1 }
}
if {\[regexp {^(ins).*} \[lindex \$args 0\]\]} {
set index2 \$insertindex+\[string length \[lindex \$args 2 \] \]chars
set gUndo($num.\$numChange) \"delete \$insertindex \$index2 \"
if {\[regexp {.*\[\"/\].*} \$args\] || \
\[regexp {.*\[\"/\].*} \[.$procName get \"\$insertindex linestart\" \"\$index2 lineend\"\]\]} {
registerCreateImportLinks $num \$insertindex \$index2
}
} elseif {\[regexp {^(del).*} \[lindex \$args 0\]\]} {
if { \[catch { set insertindex2 \[.$procName index \
\[lindex \$args 2 \] \] } \] } {
set chars \[ .$procName get \$insertindex \]
set insertindex2 \$insertindex+1c
} else {
set chars \[ .$procName get \$insertindex \$insertindex2 \]
}
set gUndo($num.\$numChange) \"insert \$insertindex \[list \$chars\] \"
if {\[regexp \{.*\[\"/\].*\} \$chars\] || \
\[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} {
registerCreateImportLinks $num \$insertindex \$insertindex2
}
}
set result \[uplevel .$procName \$args\]
updateLocation $num
return \$result
}"
}
###########################################################
###########################################################
###########################################################
###########################################################
proc undo { num } {
global gUndo gRefText gTextWindow gChanged gRefChanged
if { $gUndo($num.cur) == 0 } { return }
set undoInfo $gUndo($num.$gUndo($num.cur))
if { [regexp {.*[\"/].*} $undoInfo] } {
registerCreateImportLinks $num [lindex $undoInfo 1] end
}
if { [regexp {.*delete.*} $undoInfo] } {
registerCreateImportLinks $num [lindex $undoInfo 1] [lindex $undoInfo 2]
}
if { $num == 0 } {
if {[catch {eval ".$gTextWindow $gUndo($num.$gUndo($num.cur))"}]} { return }
set gChanged 1
} else {
if {[catch {eval ".$gRefText($num) $gUndo($num.$gUndo($num.cur))"}]} { return }
set gRefChanged($num) 1
}
incr gUndo($num.cur) -1
}
###########################################################
###########################################################
###########################################################
###########################################################
proc redo { num } {
global gUndo gRefText
}
###########################################################
###########################################################
###########################################################
###########################################################
proc gotoRefLine { number } {
global gRefLine gRefText
if { [catch {set gRefText($number)}] } { return }
if { ![winfo exists $gRefText($number)] } { return }
if { $gRefLine($number) == "" } {
return
} else {
$gRefText($number) mark set insert $gRefLine($number).0
catch {$gRefText($number) tag remove sel sel.first sel.last}
$gRefText($number) tag add sel "insert linestart" "insert lineend"
$gRefText($number) see insert
}
}
###########################################################
# updateLocation
###########################################################
###########################################################
###########################################################
proc updateLocation { number } {
global gRefCurLine gRefText gTextWindow gLineNumber gCharacterNumber
if {$number} {set window $gRefText($number)} {set window $gTextWindow}
# if {![winfo exists $gRefText($number)]} {return};#do I need this
set spot [split [.$window index insert] "."]
if { $number } {
set gRefCurLine($number) [lindex $spot 0 ]
} else {
set gLineNumber [lindex $spot 0]
set gCharacterNumber [lindex $spot 0]
}
}
###########################################################
###########################################################
###########################################################
###########################################################
proc askToSave { refNum mustClose } {
global gPrompt
set dialog [toplevel .askToSavePrompt -borderwidth 10]
wm title $dialog "Do you wish to Save"
wm geo $dialog "+200+200"
if { $refNum } {
global gRefFile
set msg "Reference File: $gRefFile($refNum) has changed. Do you wish to save?"
} else {
set msg "Source has changed do you wish to save?"
}
message $dialog.msg -text $msg -aspect 800
set gPrompt(result) ""
set buttonFrame [frame $dialog.buttons -bd 10]
pack $dialog.msg $buttonFrame -side top -fill x
bind $dialog <Destroy> {
set gPrompt(result) Cancel
set gPrompt(yes) 0
}
button $buttonFrame.yes -text Yes -underline 0 -command {
set gPrompt(yes) 1
}
button $buttonFrame.no -text No -underline 0 -command {
set gPrompt(yes) 0
}
if { !$mustClose } {
button $buttonFrame.cancel -text Cancel -underline 0 -command {
set gPrompt(yes) 0
set gPrompt(result) Cancel
}
pack $buttonFrame.yes $buttonFrame.no $buttonFrame.cancel -side left
} else {
pack $buttonFrame.yes $buttonFrame.no -side left
}
bind $dialog <Alt-Key> break
Centre_Dialog $dialog default
update
focus $dialog
capaRaise $dialog
capaGrab $dialog
vwait gPrompt(yes)
capaGrab release $dialog
bind $dialog <Destroy> ""
destroy $dialog
if {$gPrompt(yes)} {
if { $refNum } {
global gRefText
saveText $gRefText($refNum) 0 $refNum
} else {
saveDocument
}
} else {
return $gPrompt(result)
}
}
###########################################################
###########################################################
###########################################################
###########################################################
proc saveDocument { {saveAs 0} } {
global gFile gTextWindow gSetNumberText gChanged gEditWindow gWindowMenu \
gCapaConfig
if { [catch {set gTextWindow}] } { return }
if { ![winfo exists $gTextWindow] } { return }
if { $gFile == "" } { set saveAs 1 }
if {$saveAs == 1} {
set temp [tk_getSaveFile -title "Enter the name to Save As" \
-initialdir "[pwd]" ]
if { $temp == "" } {
displayError "File not saved"
return
}
catch {removeWindowEntry "$gFile*"}
catch {removeFindList}
set gFile $temp
addFindList
cd [file dirname $gFile]
set gSetNumberText [string range [file rootname [file tail $gFile]] \
3 end ]
checkIfValidFilename
wm title [winfo toplevel $gEditWindow] $gFile
$gWindowMenu add command -label "$gFile" -command \
"capaRaise $gEditWindow"
} else {
if { ([array name gCapaConfig quizzerBackupQZ] == "") ||
($gCapaConfig(quizzerBackupQZ)!="off") } {
if { [catch {file copy -force $gFile $gFile.bak} ] } {
displayError "Unable to create backup for $gFile"
}
}
}
set fileId [open $gFile w]
puts -nonewline $fileId [$gTextWindow get 0.0 end]
close $fileId
savePrefs
set gChanged 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc closeDocument { { mustClose 0 } { save 1 } } {
global gFile gEditWindow gChanged gPrefs \
gPutLine gTryVal gProbVal gHintVal gQuizTemp \
gNumberParsedText gSetNumberText gClosedDocument gTextWindow
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
if { $gClosedDocument } { return }
if { $save && $gChanged } {
if { [askToSave 0 $mustClose] == "Cancel" && (! $mustClose ) } { return }
}
if {(!$mustClose)&&[makeSure "Are you sure you wish to stop editing?"]=="Cancel"} {
return
}
set gClosedDocument 1
removeFindList
destroy $gEditWindow
removeWindowEntry "$gFile*"
set gFile ""
set gChanged 0
set gPrefs(info) "Problem"
set gPrefs(TeXHeader) ""
set gPrefs(TeXFooter) ""
set gPutLine 1
set gTryVal 99
set gHintVal 1
set gProbVal 1
set gQuizTemp "true"
set gNumberParsedText ""
set gSetNumberText ""
}
###########################################################
###########################################################
###########################################################
###########################################################
proc closeRefFile { refNum { mustClose 0 } { save 1 } } {
global gRefChanged gRefText gRefFile gRefClosed gRefCurLine gRefLine gRefChangedLast
if { [catch {set gRefText($refNum)}] } { return }
if { ![winfo exists $gRefText($refNum)] } { return }
if { $gRefClosed($refNum) } { return }
if { $save && $gRefChanged($refNum) } {
if { [askToSave $refNum $mustClose] == "Cancel" && ( ! $mustClose ) } { return }
}
if { ( ! $mustClose ) && ( [makeSure "Are you sure you wish to stop editing $gRefFile($refNum)?"] == "Cancel" ) } {
return
}
set gRefClosed($refNum) 1
removeFindList $refNum
destroy [winfo toplevel $gRefText($refNum)]
removeWindowEntry "Reference $gRefFile($refNum)*"
unset gRefText($refNum) gRefChanged($refNum) gRefClosed($refNum) gRefFile($refNum) \
gRefCurLine($refNum) gRefLine($refNum) gRefChangedLast($refNum)
}
###########################################################
# quit
###########################################################
# called when the quit option is selected on the menu, unmaps
# all keys.
###########################################################
# Arguments: None
# Returns: Nothing
# Globals: gChanged - whether or not the file has been modified
###########################################################
proc quit { { mustClose 0 } } {
global gChanged gRefChanged gRefText
if { (! $mustClose ) && [makeSure "Are you sure you wish to quit?"] == "Cancel" } {
return
}
if { $gChanged } {
if { [askToSave 0 $mustClose] == "Cancel" && ( ! $mustClose ) } {
return
}
}
foreach refNum [array names gRefChanged] {
if { $gRefChanged($refNum) == 1 } {
if { [winfo exists $gRefText($refNum)] } {
if { [askToSave $refNum $mustClose ] == "Cancel" && (! $mustClose ) } {
return
}
}
}
}
exec /bin/rm -f quiztemp.ps
exec /bin/rm -f quiztemp.dvi
exec /bin/rm -f quiztemp.tex
exec /bin/rm -f quiztemp.log
exec /bin/rm -f quiztemp.aux
exec /bin/rm -f quiztemp.txt
unmapAllKeys
exit
}
###########################################################
# createStopButton
###########################################################
###########################################################
###########################################################
proc createStopButton {} {
global gStopStatus
if {[winfo exists .stopbutton]} {destroy .stopbutton}
set top [toplevel .stopbutton]
button $top.stop -text "Stop Parser" -command "stopParser"
label $top.status -textvariable gStopStatus -width 35 -anchor w
pack $top.stop $top.status
set gStopStatus ""
grab $top
Centre_Dialog $top default
update
}
###########################################################
# destroyStopButton
###########################################################
###########################################################
###########################################################
proc destroyStopButton {} {
grab release .stopbutton
destroy .stopbutton
}
###########################################################
# createDvi
###########################################################
###########################################################
###########################################################
proc createDvi { {showXdvi 1} {showStopButton 0} {useqzparse 0}} {
global gPreviewMode gCreateDviText gPrefs gSetNumberText \
gStudentSelection gFile gWindowMenu gLatexId gParseErrorsText \
gEditWindow gCreateDviTextTemp gXdviOpt \
gLoadHeaderSet gCapaConfig gControlDates gNumberParsedText \
gDonePrinting
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
catch { destroy .createDviText }
set gCreateDviTextTemp [text .createDviText]
switch $gPrefs(info) {
Problem { set type 0 }
ProblemAnswer { set type 1 }
Answer { set type 2 }
}
if { $useqzparse } {
set gDonePrinting 0
switch $gPrefs(info) {
Problem { set type "-T" }
Answer { set type "-Ta" }
ProblemAnswer { set type "-Tb" }
default { set type "-T" }
}
createCreateDviWin
grab .createDvi
$gCreateDviText delete 0.0 end
if { [setupSetsToPrint set start end 0] == 1 } { return 1 }
if { [set gStopPrinting [expr 2 == [runLatex \
"echo [pwd] | $gCapaConfig(qzparse_command) \
-stu $gStudentSelection(studentNumber) -set $set \
-d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
exec rm -f $gStudentSelection(studentNumber).tex quiztemp.tex
if {$showStopping} {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
}
return 1
}
exec mv $gStudentSelection(studentNumber).tex quiztemp.tex
exec /bin/rm -f quiztemp.dvi
} else {
createStopButton
if { [catch {
set numberParsed [ texParse $type $gSetNumberText \
$gStudentSelection(type) $gStudentSelection(random) \
$gStudentSelection(studentNumber) \
$gStudentSelection(studentName) \
gCreateDviTextTemp 1 ] }]} {
return
}
destroyStopButton
checkHeader $numberParsed
if { [showParseErrors] != "" } {
if { [makeSure "There were errors when parsing the .qz file, \
continue to create the .dvi?"] =="Cancel" } {
destroy $gCreateDviTextTemp
return
}
}
set error [catch { set fileId [open quiztemp.tex w] } ]
if { $error } {
displayError "Unable to create neccessary temp files, delete all the\
quiztemp file from the class directory."
return
}
set filename [file join [file dirname $gFile] TeXheader ]
set texfileId [open $filename r]
puts -nonewline $fileId [read $texfileId [file size $filename]]
close $texfileId
puts -nonewline $fileId "[$gCreateDviTextTemp get 0.0 end]"
set filename [file join [file dirname $gFile] TeXfooter ]
set texfileId [open $filename r]
puts $fileId [read $texfileId [file size $filename]]
close $texfileId
close $fileId
}
destroy $gCreateDviTextTemp
if { ![winfo exists .createDvi] } {
set createDviWindow [toplevel .createDvi]
$gWindowMenu add command -label "CreateDvi" -command \
"capaRaise $createDviWindow"
wm title $createDviWindow "LaTeX Output"
addFindList -3
set windowFrame [frame $createDviWindow.windowFrame]
set buttonFrame [frame $createDviWindow.buttonFrame]
pack $windowFrame $buttonFrame -side bottom
pack configure $windowFrame -expand true -fill both
pack configure $buttonFrame -anchor e
scrollbar $windowFrame.scroll -orient vertical -command \
"$windowFrame.text yview"
set gCreateDviText [text $windowFrame.text -yscrollcommand \
"$windowFrame.scroll set" -wrap char -height 40]
pack $windowFrame.scroll $gCreateDviText -side left -expand 0
pack configure $windowFrame.scroll -expand 0 -fill y
pack configure $gCreateDviText -expand true -fill both
set appearingFrame [frame $buttonFrame.appearingFrame]
button $buttonFrame.ok -text Dismiss -command \
"trace vdelete gFile w updateCreateDvi
destroy $createDviWindow
removeWindowEntry CreateDvi
removeFindList -3"
bind $createDviWindow <Destroy> \
"trace vdelete gFile w updateCreateDvi
removeWindowEntry CreateDvi
removeFindList -3"
pack $appearingFrame $buttonFrame.ok -side left
button $appearingFrame.stop -text "Stop Creating Print Jobs"\
-command "stopPrinting"
set name [file rootname [file tail $gFile ] ].dvi
button $appearingFrame.print -text \
"Save.dvi file to $name" \
-command saveDvi
trace variable gFile w updateCreateDvi
if { $showStopButton } {
pack $appearingFrame.stop $appearingFrame.print -side left
pack forget $appearingFrame.print
} else {
pack $appearingFrame.stop $appearingFrame.print -side left
pack forget $appearingFrame.stop
}
Centre_Dialog $createDviWindow default
update
} else {
if { $showStopButton } {
pack forget .createDvi.buttonFrame.appearingFrame.print
pack .createDvi.buttonFrame.appearingFrame.stop
} else {
pack forget .createDvi.buttonFrame.appearingFrame.stop
pack .createDvi.buttonFrame.appearingFrame.print
}
if { !$useqzparse } { $gCreateDviText delete 0.0 end }
}
exec /bin/rm -f quiztemp.dvi
$gCreateDviText insert end "$gCapaConfig(latex_command)\n"
$gCreateDviText see end
set createdDvi [ runLatex "pwd ; $gCapaConfig(latex_command) quiztemp.tex < \
[file join / dev null ]" gCreateDviText]
if { ($showXdvi == 1) && ( $createdDvi == 1 ) } {
eval "exec $gCapaConfig(xdvi_command) $gXdviOpt quiztemp.dvi >& /dev/null & "
}
catch { capaRaise $gParseErrorsText }
set gDonePrinting 1
return $createdDvi
}
###########################################################
###########################################################
###########################################################
###########################################################
proc stopPrinting {} {
global gStopPrinting
set gStopPrinting 1
}
###########################################################
###########################################################
###########################################################
###########################################################
proc saveDvi { } {
global gFile
set name [file rootname [ file tail $gFile]].dvi
catch { exec rm -f $name }
if { [ catch { exec cp quiztemp.dvi $name } ] } {
displayMessage "Unable to create $name "
} else {
displayMessage "Created $name "
}
}
###########################################################
###########################################################
###########################################################
###########################################################
proc updateCreateDvi { name1 name2 op } {
global gFile
set name [file rootname [file tail $gFile ] ].dvi
catch { .createDvi.buttonFrame.appearingFrame.print configure \
-text "Save.dvi file to $name" }
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printWindow {} {
global gPrintSelection gWindowMenu gEditWindow gStopPrinting\
gSetNumberText gMaxSet gFile gChanged
set gStopPrinting 0
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
if { [winfo exists .print] } {
capaRaise .print
return
}
if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
set print [toplevel .print]
$gWindowMenu add command -label "Print" -command "capaRaise $print"
wm title $print "Select a Print Method"
message $print.msg -text "Please specify a print method." -aspect 10000
set oneSetFrame [frame $print.frame1 -relief groove -borderwidth 4]
set moreSetFrame [frame $print.frame2 -relief groove -borderwidth 4]
set buttonFrame [frame $print.buttons]
pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top
pack configure $oneSetFrame $moreSetFrame -anchor w -fill x
set infoFrame [frame $moreSetFrame.frame1]
set setFrame [frame $moreSetFrame.frame2 -relief solid -borderwidth 1]
pack $infoFrame $setFrame
pack configure $infoFrame $setFrame -anchor w
if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur}
if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific}
if {[catch {set gPrintSelection(setend)}]} {set gPrintSelection(setend) $gSetNumberText}
radiobutton $setFrame.specific -text "Print Current Set ($gSetNumberText)" \
-value "printCur" -variable gPrintSelection(sets)
set scaleFrame [frame $setFrame.scales]
pack $setFrame.specific $scaleFrame -anchor w
for { set i 1 } { $i <= $gMaxSet } { incr i } {
if { ! [file exists [file join [file dirname $gFile] records "set$i.db"]] } { break }
}
incr i -1
set gPrintSelection(setend) $gSetNumberText
radiobutton $scaleFrame.range -text "Print Set Range:" \
-value "printRange" -variable gPrintSelection(sets)
scale $scaleFrame.start -from 1 -to $i -variable gPrintSelection(setstart) \
-orient h
label $scaleFrame.msg -text "to"
scale $scaleFrame.end -from 1 -to $i -variable gPrintSelection(setend) \
-orient h
pack $scaleFrame.range $scaleFrame.start $scaleFrame.msg \
$scaleFrame.end -side left
button $buttonFrame.ok -text "Select" -command selectedPrintMethod
button $buttonFrame.cancel -text "Cancel" -command \
"destroy .print
removeWindowEntry Print"
bind $print <Destroy> "removeWindowEntry Print"
pack $buttonFrame.ok $buttonFrame.cancel -side left
set currentDviFrame [frame $oneSetFrame.currentDvi]
set currentPreviewFrame [frame $oneSetFrame.currentPreview]
set randomFrame [frame $oneSetFrame.random]
set specificFrame [frame $infoFrame.specific]
set sectionFrame [frame $infoFrame.section]
set multSectionFrame [frame $infoFrame.multsection]
set wholeClassFrame [frame $infoFrame.wholeClass]
pack $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \
$sectionFrame $multSectionFrame $wholeClassFrame -anchor w \
-side top
pack configure $specificFrame -expand true -fill both
radiobutton $currentDviFrame.currentDvi -text "Print current .dvi" \
-value "printCurrentDvi" -variable gPrintSelection(type)
pack $currentDviFrame.currentDvi -side left
radiobutton $randomFrame.random -text \
"Randomly select one student from section:" \
-value "printRandom" -variable gPrintSelection(type)
entry $randomFrame.entry -textvariable gPrintSelection(random) -width 3 \
-validate key -validatecommand "limitEntry %W 3 number %P"
pack $randomFrame.random $randomFrame.entry -side left
radiobutton $specificFrame.specific -text "Specify the student by:" \
-value "printSpecific" -variable gPrintSelection(type)
set studentNumber [frame $specificFrame.studentNumber]
set fullName [frame $specificFrame.fullName]
pack $specificFrame.specific $studentNumber $fullName -side top
pack configure $specificFrame.specific -anchor w
pack configure $studentNumber $fullName -anchor e
radiobutton $sectionFrame.section -text "Print section" \
-value "printSection" -variable gPrintSelection(type)
entry $sectionFrame.entry -textvariable gPrintSelection(section) -width 3 \
-validate key -validatecommand "limitEntry %W 3 number %P"
pack $sectionFrame.section $sectionFrame.entry -side left
radiobutton $multSectionFrame.section -text "Print multiple sections" \
-value "printMultipleSections" -variable gPrintSelection(type)
pack $multSectionFrame.section -side left
radiobutton $wholeClassFrame.wholeClass -text "Print whole class." \
-value "printWholeClass" -variable gPrintSelection(type)
pack $wholeClassFrame.wholeClass -side left
i message $studentNumber.msg -text "Student Number: " -aspect 10000
entry $studentNumber.entry -textvariable gPrintSelection(studentNumber) -width 9 \
-validate key -validatecommand "limitEntry %W 9 any %P"
pack $studentNumber.msg $studentNumber.entry -side left
message $fullName.msg -text "Student Name: " -aspect 10000
entry $fullName.entry -textvariable gPrintSelection(studentName) -width 30 \
-validate key -validatecommand "limitEntry %W 30 any %P"
pack $fullName.msg $fullName.entry -side left
trace variable gPrintSelection(studentNumber) w \
"global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
trace variable gPrintSelection(studentName) w \
"global gPrintSelection; set gPrintSelection(type) printSpecific ;#"
# puts "trace info:[trace vinfo gPrintSelection(studentNumber)]"
bind $studentNumber.entry <KeyPress-Return> \
"fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 0"
bind $fullName.entry <KeyPress-Return> \
"fillInStudent gPrintSelection(studentName) gPrintSelection(studentNumber) 1"
#Disable the entry boxes that are not selected, and enable the
#ones that are
# $specificFrame.specific configure -command "
# $studentNumber.entry configure -state normal
# $fullName.entry configure -state normal"
# $randomFrame.random configure -command "
# $studentNumber.entry configure -state disabled
# $fullName.entry configure -state disabled"
#If the window had been called up before we need to check the state
#of the variable and disable/enable the correct enry boxes
# if { $gPrintSelection(type) == "printSpecific" } {
# $studentNumber.entry configure -state normal
# $fullName.entry configure -state normal
# }
# if { $gPrintSelection(type) == "printRandom" } {
# $studentNumber.entry configure -state disabled
# $fullName.entry configure -state disabled
# }
Centre_Dialog $print default
}
proc selectedPrintMethod {} {
global gStopPrinting gPrintSelection gStudentSelection
switch $gPrintSelection(type) {
printSpecific {
if { $gPrintSelection(studentNumber) == "" } {
displayError "You must specify a student number."
return
}
}
printSection {
if { $gPrintSelection(section)== "" } {
displayError "You must specify a section."
return
}
}
default {}
}
destroy .print
removeWindowEntry Print
[set gPrintSelection(type)]
set gStopPrinting 0
}
###########################################################
# createCreateDviWin
###########################################################
###########################################################
###########################################################
proc createCreateDviWin {} {
global gWindowMenu gFile gCreateDviText
if { ![winfo exists .createDvi] } {
set createDviWindow [toplevel .createDvi]
$gWindowMenu add command -label "CreateDvi" -command \
"capaRaise $createDviWindow"
wm title $createDviWindow "LaTeX Output"
set windowFrame [frame $createDviWindow.windowFrame]
set buttonFrame [frame $createDviWindow.buttonFrame]
pack $windowFrame $buttonFrame -side bottom
pack configure $windowFrame -expand true -fill both
pack configure $buttonFrame -anchor e
scrollbar $windowFrame.scroll -orient vertical -command \
"$windowFrame.text yview"
set gCreateDviText [text $windowFrame.text -yscrollcommand \
"$windowFrame.scroll set" -wrap char -height 40]
pack $windowFrame.scroll $gCreateDviText -side left -expand 0
pack configure $windowFrame.scroll -expand 0 -fill y
pack configure $gCreateDviText -expand true -fill both
set appearingFrame [frame $buttonFrame.appearingFrame]
button $buttonFrame.ok -text Dismiss -command \
"checkDestroyPrint $createDviWindow"
wm protocol $createDviWindow WM_DELETE_WINDOW \
"checkDestroyPrint $createDviWindow"
pack $appearingFrame $buttonFrame.ok -side left
button $appearingFrame.stop -text "Stop Creating Print Jobs"\
-command "stopPrinting"
set name [file rootname [file tail $gFile ] ].dvi
button $appearingFrame.print -text \
"Save.dvi file to $name" \
-command saveDvi
trace variable gFile w updateCreateDvi
pack $appearingFrame.stop $appearingFrame.print -side left
pack forget $appearingFrame.print
Centre_Dialog $createDviWindow default
update
} else {
pack forget .createDvi.buttonFrame.appearingFrame.print
pack .createDvi.buttonFrame.appearingFrame.stop
}
}
###########################################################
# printBody
###########################################################
# sends the file quiztemp.ps to the printer through lpr using
# the option foud in gLprCommand
###########################################################
# Arguments: none
# Returns: Nothing
# Globals: gCapaConfig -
# gStopPrinting -
# Files: quiztemp.ps - file containg info to print (removed)
###########################################################
proc printBodon(section
ionMessage 1 } } {
global gCapaConfig gStopPrinting gDonePrinting
set errorMsg ""
set error [ catch {exec $gCapaConfig(dvips_command) quiztemp.dvi \
-o quiztemp.ps >& /dev/null} errorMsg ]
if { $error } {
displayError \
"When attempting to run dvips an error occured : $errorMsg"
return 1
}
if { $gStopPrinting } {
displayMessage "Printing has been stopped."
set gStopPrinting 0
set gDonePrinting 1
return 1
}
set errorMsg
set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ]
if { $error == 1 } {
displayError "When attempting to print an error occured : $errorMsg"
return 1
} else {
if { $showCompletionMessage } {
displayMessage "Print job sent to the printer.\n $returnMessage"
}
}
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printCurrentDvi {} {
set lprCommand [getLprCommand quiztemp.ps]
if {$lprCommand == ""} {
displayError "You must at least specify a print queue for lpr. \
Nothing printed."
return
}
if {$lprCommand == "Cancel"} {
return
}
printBody $lprCommand
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printCurrentPreview {} {
set lprCommand [getLprCommand quiztemp.ps]
if {$lprCommand == ""} {
displayError "You must at least specify a print queue for lpr. \
Nothing printed."
return
}
if {$lprCommand == "Cancel"} {
return
}
if { [createDvi 0] == 2 } {
displayMessage "Printing has been stopped"
}
printBody $lprCommand
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printRandom {} {
global gStudentSelection gPrintSelection
set lprCommand [getLprCommand quiztemp.ps]
if {$lprCommand == ""} {
displayError "You must at least specify a print queue for lpr. \
Nothing printed."
return
}
if {$lprCommand == "Cancel"} {
return
}
set type $gStudentSelection(type)
set random $gStudentSelection(random)
set gStudentSelection(type) Random
set gStudentSelection(random) $gPrintSelection(random)
if { [createDvi 0 1] == 2 } {
displayMessage "Printing has been stopped"
}
printBody $lprCommand
set gStudentSelection(type) $type
set gStudentSelection(random) $random
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printSpecific {} {
global gStudentSelection gPrintSelection
set lprCommand [getLprCommand quiztemp.ps]
if {$lprCommand == ""} {
displayError "You must at least specify a print queue for lpr. \
Nothing printed."
return
}
if {$lprCommand == "Cancel"} {
return
}
set type $gStudentSelection(type)
set studentNumber $gStudentSelection(studentNumber)
set gStudentSelection(type) Specific
set gStudentSelection(studentNumber) $gPrintSelection(studentNumber)
if { [createDvi 0 1 1] == 2 } {
displayMessage "Printing has been stopped"
}
printBody $lprCommand
set gStudentSelection(type) $type
set gStudentSelection(studentNumber) $studentNumber
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printStudent { studentNumber } {
global gStudentSelection gStopPrinting gDonePrinting
set type $gStudentSelection(type)
set studentNumberOld $gStudentSelection(studentNumber)
set gStudentSelection(type) Specific
set gStudentSelection(studentNumber) $studentNumber
set createdDvi [createDvi 0 1]
if { $createdDvi == 1 } { printBody } else {
displayMessage "Printing has been stopped"
set gStopPrinting 0
set gDonePrinting 1
}
set gStudentSelection(type) $type
set gStudentSelection(studentNumber) $studentNumberOld
return 0
}
proc checkDestroyPrint { createDviWindow } {
global gDonePrinting
if { !$gDonePrinting } {
if { [makeSure "Do you really wish to stop printing?"] == "Yes" } {
global gStopPrinting
set gStopPrinting 1
after 1000 "destroyPrint $createDviWindow"
}
return
}
destroyPrint $createDviWindow
}
proc destroyPrint { createDviWindow } {
trace vdelete gFile w updateCreateDvi
destroy $createDviWindow
removeWindowEntry CreateDvi
}
###########################################################
###########################################################
###########################################################
###########################################################
proc setupSetsToPrint { setVar startVar endVar {checkForHeader 1}} {
global gPrintSelection gSetNumberText gLoadHeaderSet
upvar $setVar set $startVar start $endVar end
if { $gPrintSelection(sets) == "printRange" } {
set start $gPrintSelection(setstart)
set end $gPrintSelection(setend)
set set "$start:$end"
set errors ""
for {set i $start} {$i <= $end} {incr i} {
set gLoadHeaderSet $i
if {[catch {getHeaderInfo}]} { append errors ", $i" }
}
if { $checkForHeader && $errors != "" } {
set errors [string range $errors 1 end]
if { [llength $errors] > 1 } {
set errors "s$errors"
set errors [linsert $errors [expr [llength $errors] - 1] and]
}
displayError "DB header has not yet been set for set$errors. Please set the DB Header before printing Sections."
return 1
}
} else {
set start [set end [set set $gSetNumberText]]
set gLoadHeaderSet $gSetNumberText
if {$checkForHeader && [catch {getHeaderInfo}]} {
displayError "DB header has not yet been set. Please set the DB Header before printing Sections."
return 1
}
}
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printSection { { lprCommand "" } } {
global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
gCreateDviText gStopPrinting gPrefs gFile gDonePrinting \
gLoadHeaderSet
set gDonePrinting 0
set showStopping 0
if { [setupSetsToPrint set start end] == 1 } { return 1}
if { $lprCommand == "" } {
set showStopping 1
set lprCommand [getLprCommand quiztemp.ps]
if { $lprCommand == "" } {
displayError "Print command was empty, unable to print."
return 1
}
if {$lprCommand == "Cancel" } {
return 1
}
}
createCreateDviWin
grab .createDvi
$gCreateDviText delete 0.0 end
switch $gPrefs(info) {
Problem { set type "-T" }
Answer { set type "-Ta" }
ProblemAnswer { set type "-Tb" }
default { set type "-T" }
}
set prSection [string trimleft $gPrintSelection(section) 0]
if { [set gStopPrinting [expr 2 == [runLatex \
"echo [pwd] | $gCapaConfig(qzparse_command) \
-sec $prSection -set $set \
-d [pwd] -c [pwd] $type " gCreateDviText] ] ] } {
for {set i $start} { $i <= $end} { incr i } {
exec rm -f section$prSection-set$i.tex
}
if {$showStopping} {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
}
return 1
}
if { $gStopPrinting } {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
return 1
}
for { set i $start} { $i <= $end } { incr i } {
if { ! [file exists section$prSection-set$i.tex] } {
if {$showStopping} {
displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
set gStopPrinting 0
set gDonePrinting 1
}
return 2
}
exec mv section$prSection-set$i.tex quiztemp.tex
exec /bin/rm -f quiztemp.dvi
$gCreateDviText insert end "$gCapaConfig(latex_command)\n"
$gCreateDviText see end
if { [set gStopPrinting [ expr 2 == [runLatex \
"pwd ; $gCapaConfig(latex_command) \
quiztemp.tex < [file join / dev null ]" gCreateDviText ] ] ] } {
if {$showStopping} {
displayError "The LaTeX command: $gCapaConfig(latex_command), was unable to produce the expected output. Printing stopped"
set gStopPrinting 0
set gDonePrinting 1
}
return 1
}
if { $gStopPrinting } {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
return 1
}
set a [expr ($showStopping) && ($end == $i)]
if { [set gStopPrinting [printBody $lprCommand $a ] ] } {
if {$showStopping} {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
}
return 1
}
if { $gStopPrinting } {
displayMessage "Printing has been stopped."
set gDonePrinting 1
set gStopPrinting 0
return 1
}
}
set gDonePrinting 1
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printMultipleSections { } {
global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
gCreateDviText gStopPrinting gPrefs gDonePrinting
#checks if the DB Header is set
if { [setupSetsToPrint set start end] == 1 } { return 1}
set sectionList [ getExistingSections ]
set sectionsToPrint [ pickSections $sectionList "Select Sections to Print:" ]
if { $sectionsToPrint == "" } {
displayMessage "No sections selected, therefore nothing was printed."
return 1
}
if { $sectionsToPrint == "Cancel" } {
return 1
}
set lprCommand [getLprCommand quiztemp.ps]
if { $lprCommand == "" } {
displayError "Print command was empty, unable to print."
return 1
}
if {$lprCommand == "Cancel" } {
return 1
}
if { [makeSure "You have selected to print $gPrefs(info)s for sections: [string trim $sectionsToPrint], using the print command \"$lprCommand\", continue?"] == "Cancel" } {
return 1
}
foreach section $sectionsToPrint {
set gDonePrinting 0
set gPrintSelection(section) $section
if { [set gStopPrinting [printSection $lprCommand] ] } {
set gDonePrinting 0
if { $gStopPrinting == 2 } {
displayError "The qzparse command: $gCapaConfig(qzparse_command), was unable to produce the expected output. Printing stopped"
} else {
displayMessage "Printing has been stopped."
}
set gDonePrinting 1
return 1
}
if { $gStopPrinting } {
displayMessage "Printing has been stopped."
set gStopPrinting 0
set gDonePrinting 1
return 1
}
}
set gDonePrinting 1
displayMessage "Print jobs sent to the printer."
return 0
}
###########################################################
###########################################################
###########################################################
###########################################################
proc printWholeClass { } {
global gPrintSelection gCapaConfig gSetNumberText gWindowMenu \
gCreateDviText gStopPrinting gPrefs gDonePrinting
if {[catch {getHeaderInfo}]} {
displayError "DB header has not yet been set, Please set DB Header before printing Sections."
return 1
}
set sectionsToPrint [ getExistingSections ]
if { $sectionsToPrint == "" } {
displayMessage "No sections exist, therefore nothing was printed."
return 1
}
set lprCommand [getLprCommand quiztemp.ps]
if { $lprCommand == "" } {
displayError "Print command was empty, unable to print."
return 1
}
if {$lprCommand == "Cancel" } {
return 1
}
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" } {
return 1
}
foreach section $sectionsToPrint {
set section [lindex $section 0]
set gPrintSelection(section) $section
set gStopPrinting [printSection $lprCommand]
if { $gStopPrinting } {
if { $gStopPrinting == 2 } {
displayError "$gCapaConfig(qzparse_command) was unable to produce the expected output. Printing stopped"
} else {
displayMessage "Printing has been stopped."
}
set gDonePrinting 1
set gStopPrinting 0
return 1
}
}
set gDonePrinting 1
displayMessage "Print jobs sent to the printer."
return 0
}
###########################################################
# analyzeSet
###########################################################
###########################################################
###########################################################
proc analyzeSet {} {
global gChanged gWindowMenu gEditWindow gAnalyze gSetNumberText gNumberParsedText
if { [catch {winfo exists $gEditWindow}] } { return }
if { ![ winfo exists $gEditWindow ] } { return }
if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } }
if { [winfo exists .analyzeSet] } {
capaRaise .analyzeSet
return
}
set analyze [toplevel .analyzeSet]
$gWindowMenu add command -label "AnalyzeSet" \
-command "capaRaise $analyze"
wm title $analyze "Analyze Set"
set settingsFrame [frame $analyze.settingsFrame]
set dataFrame [frame $analyze.dataFrame]
pack $settingsFrame $dataFrame -side top
set classFrame [frame $settingsFrame.classFrame]
set setFrame [frame $settingsFrame.setFrame]
set probFrame [frame $settingsFrame.probFrame]
set statusFrame [frame $settingsFrame.statusFrame]
set statusBar [frame $settingsFrame.statusBar]
set buttonFrame [frame $settingsFrame.buttonFrame]
pack $classFrame $setFrame $probFrame $statusFrame $statusBar $buttonFrame \
-side top
set canvasFrame [frame $dataFrame.canvasFrame]
set numberFrame [frame $dataFrame.numberFrame]
pack $canvasFrame $numberFrame -side top
set gAnalyze(class) [pwd]
label $classFrame.label -textvariable gAnalyze(class)
pack $classFrame.label
set gAnalyze(set) $gSetNumberText
label $setFrame.lbl -text "Set number:"
label $setFrame.set -textvariable gAnalyze(set)
# button $setFrame.change -text "Change" -command analyzeChangeSet
pack $setFrame.lbl $setFrame.set -side left
if { [set gAnalyze(maxprob) $gNumberParsedText] == "" } { set gAnalyze(maxprob) 1 }
label $probFrame.label -text "Problem Number :"
set gAnalyze(scale) [scale $probFrame.problem \
-from 1 -to $gAnalyze(maxprob) \
-variable gAnalyze(prob) -command analyzeUpdate \
-orient h -length 150 -tickinterval 1]
pack $probFrame.label $probFrame.problem -side left
set gAnalyze(status) ""
label $statusFrame.label -text "Status:"
label $statusFrame.status -textvariable gAnalyze(status)
pack $statusFrame.label $statusFrame.status -side left
set gAnalyze(statcanvas) [canvas $statusBar.canvas -width 200 -height 20]
pack $statusBar.canvas
$gAnalyze(statcanvas) create rectangle 1 1 199 19 -outline black
set gAnalyze(bar) [$gAnalyze(statcanvas) create rectangle 1 1 1 19 -fill red -outline black]
button $buttonFrame.class -text "Run Class" -command "analyzeClass 1"
button $buttonFrame.random -text "Run Random" -command analyzeRandom
button $buttonFrame.stop -text "Stop" -command analyzeStop
button $buttonFrame.close -text "Dismiss" -comman analyzeClose
pack $buttonFrame.class $buttonFrame.random $buttonFrame.stop \
$buttonFrame.close -side left
set gAnalyze(canvaswidth) 600
set gAnalyze(canvas) [canvas $canvasFrame.canvas -width $gAnalyze(canvaswidth) \
-height 100]
pack $gAnalyze(canvas)
set hiFrame [frame $numberFrame.hiFrame]
set lowFrame [frame $numberFrame.lowFrame]
set uniqFrame [frame $numberFrame.uniqFrame]
pack $lowFrame $hiFrame $uniqFrame -side left
pack configure $hiFrame -anchor e
pack configure $lowFrame -anchor w
label $hiFrame.label -text "High End:"
label $hiFrame.num -textvariable gAnalyze(highnum)
pack $hiFrame.label $hiFrame.num -side left
label $lowFrame.label -text "Low End:"
label $lowFrame.num -textvariable gAnalyze(lownum)
pack $lowFrame.label $lowFrame.num -side left
label $uniqFrame.label -text "Num. Unique:"
label $uniqFrame.num -textvariable gAnalyze(numuniq)
pack $uniqFrame.label $uniqFrame.num -side left
set gAnalyze(studentNumbers) [getStudentNumbers]
set gAnalyze(exit) 0
}
###########################################################
# analyzeClass
###########################################################
###########################################################
###########################################################
proc analyzeClass { {start 1} } {
global gAnalyze gCapaConfig
if { $gAnalyze(studentNumbers)=="" } { return }
if { $start } {
set gAnalyze(toprocess) $gAnalyze(studentNumbers)
set gAnalyze(stop) 0
set gAnalyze(update) 1
set gAnalyze(done) 0
set gAnalyze(total) [expr [llength $gAnalyze(toprocess)]/3]
foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
}
set number [lindex $gAnalyze(toprocess) 0]
set name [lindex $gAnalyze(toprocess) 1]
set section [lindex $gAnalyze(toprocess) 2]
set gAnalyze(toprocess) [lrange $gAnalyze(toprocess) 3 end]
set command "$gCapaConfig(answers_command) $number \"$name\" $section $gAnalyze(set)"
set fileId [open "|$command" "r"]
set gAnalyze(pid) [pid $fileId]
fconfigure $fileId -blocking 0
fileevent $fileId readable "analyzeLine $fileId"
set gAnalyze(status) "Processing $number"
incr gAnalyze(done)
$gAnalyze(statcanvas) coords $gAnalyze(bar) 1 1 [expr 200*($gAnalyze(done)/double($gAnalyze(total)))] 19
update idletasks
}
###########################################################
# analyzeEatQuestion
###########################################################
###########################################################
###########################################################
proc analyzeEatQuestion { fileId } {
global gAnalyze
if { $gAnalyze(exit) } {
fileevent $fileId readable ""
catch {close $fileId}
return
}
set aline [gets $fileId]
if { $aline != "" } {
switch -- [lindex [split $aline :] 0] {
EQES { fileevent $fileId readable "analyzeLine $fileId" }
}
}
if { [eof $fileId] } { analyzeEnd $fileId }
}
###########################################################
# analyzeLine
###########################################################
###########################################################
###########################################################
proc analyzeLine { fileId } {
global gAnalyze
if { $gAnalyze(exit) } {
fileevent $fileId readable ""
catch {close $fileId}
return
}
set aline [gets $fileId]
if { $aline != "" } {
switch [lindex [split $aline :] 0] {
ANS {
incr gAnalyze(problemNum)
set ans [string range $aline 4 end]
set length [llength $ans]
lappend gAnalyze($gAnalyze(problemNum).ans) \
[lindex $ans 0]
if { ($length == 2) || ($length == 4)} {
lappend gAnalyze($gAnalyze(problemNum).unit) \
[lindex $ans end]
}
if { ($length == 3) || ($length == 4) } {
lappend gAnalyze($gAnalyze(problemNum).low) \
[lindex $ans 1]
lappend gAnalyze($gAnalyze(problemNum).high) \
[lindex $ans 2]
}
}
SET { set gAnalyze(problemNum) 0 }
DONE {
set gAnalyze(maxprob) $gAnalyze(problemNum)
$gAnalyze(scale) configure -to $gAnalyze(maxprob)
}
ERROR {
fileevent $fileId readable ""
displayError "Answers returned invalid message: $aline"
fileevent $fileId readable "analyzeLine $fileId"
}
BQES { fileevent $fileId readable "analyzeEatQuestion $fileId" }
default {
}
}
}
if { [eof $fileId] } { analyzeEnd $fileId }
}
###########################################################
# analyzeEnd
###########################################################
###########################################################
###########################################################
proc analyzeEnd { fileId } {
global gAnalyze
if { [eof $fileId] } {
fileevent $fileId readable ""
catch {close $fileId}
if { $gAnalyze(stop) } { return }
if { [llength $gAnalyze(toprocess)] > 0 } {
analyzeClass 0
} else {
analyzeUpdate
set gAnalyze(status) "Done"
}
if { !$gAnalyze(update) } {
incr gAnalyze(update)
analyzeUpdate
} else {
incr gAnalyze(update)
if { $gAnalyze(update) == 10 } {
set gAnalyze(update) 0
}
}
}
}
###########################################################
# analyzeRandom
###########################################################
###########################################################
###########################################################
proc analyzeRandom { } {
global gAnalyze
set numToRun [getString . "How many random students should be run?"]
if { $numToRun == "" } { return }
if { [catch {incr numToRun} ] } {
displayMessage "Invalid number."
}
incr numToRun -1
set gAnalyze(total) $numToRun
catch {unset gAnalyze(toprocess)}
for { set i 0 } { $i < $numToRun } { incr i } {
append gAnalyze(toprocess) "[format "%09d" $i] Random 999 "
}
set gAnalyze(stop) 0
set gAnalyze(update) 1
set gAnalyze(done) 0
foreach name [array names gAnalyze *.\[alhu\]*] { unset gAnalyze($name) }
analyzeClass 0
}
###########################################################
# analyzeStrings
###########################################################
###########################################################
###########################################################
proc analyzeStrings { prob window create} {
global gAnalyze
if { ![winfo exists $window.analyzestrings] } { if {!$create} { return } }
if { ![catch {set setWin [toplevel $window.analyzestrings]}] } {
set msgFrame [frame $setWin.msgFrame]
set valFrame [frame $setWin.valFrame]
set buttonFrame [frame $setWin.buttonFrame]
pack $msgFrame $valFrame $buttonFrame
pack configure $valFrame -expand 1 -fill both
message $msgFrame.msg -text "Correct Answers" -aspect 3000
pack $msgFrame.msg
set maxWidth 1
foreach choice $gAnalyze($prob.ans) {
if {[string length $choice]>$maxWidth} {set maxWidth [string length $choice]}
}
set maxStringWidth $maxWidth
incr maxWidth 6
set selectMode none
listbox $valFrame.val -width [expr $maxWidth + 2] \
-yscrollcommand "$valFrame.scroll set" -selectmode $selectMode
scrollbar $valFrame.scroll -command "$valFrame.val yview"
pack $valFrame.val $valFrame.scroll -side left
pack configure $valFrame.val -expand 1 -fill both
pack configure $valFrame.scroll -expand 0 -fill y
button $buttonFrame.cancel -text "Dismiss" -command "destroy $setWin"
pack $buttonFrame.cancel
} else {
set maxWidth 1
set valFrame $window.analyzestrings.valFrame
$valFrame.val delete 0 end
foreach choice $gAnalyze($prob.ans) {
if {[string length $choice]>$maxWidth} {set maxWidth [string length $choice]}
}
set maxStringWidth $maxWidth
incr maxWidth 6
}
set lastchoice [lindex $gAnalyze($gAnalyze(prob).ans) 0]
set num 1
foreach choice [lsort $gAnalyze($gAnalyze(prob).ans)] {
if { $lastchoice != $choice } {
$valFrame.val insert end \
"[format %-[set maxStringWidth]s $lastchoice] [format %5d $num]"
set lastchoice $choice
set num 1
} else {
incr num
}
}
$valFrame.val insert end \
"[format %-[set maxStringWidth]s $lastchoice] [format %5d $num]"
}
###########################################################
# analyzeUpdate
###########################################################
###########################################################
###########################################################
proc analyzeUpdate { {newProbNumber 0} } {
global gAnalyze
if {[catch {set gAnalyze($gAnalyze(prob).ans)}]} { return }
foreach problem [array names gAnalyze *.\[alh\]*] {
if { [catch {set gAnalyze($problem) [lsort -real $gAnalyze($problem)]}]} {
set gAnalyze($problem) [lsort $gAnalyze($problem)]
}
}
set c $gAnalyze(canvas)
$c delete all
set gAnalyze(lownum) [set low [lindex $gAnalyze($gAnalyze(prob).ans) 0]]
set gAnalyze(highnum) [set high [lindex $gAnalyze($gAnalyze(prob).ans) end]]
set gAnalyze(numuniq) [llength [lunique $gAnalyze($gAnalyze(prob).ans)]]
#don't draw anything if the answers aren't numbers
if { [catch {expr $low + 1}]} {
catch {destroy $c.button}
update idletask
button $c.button -text "List of strings" -command \
"analyzeStrings $gAnalyze(prob) $c 1"
$c create window [expr $gAnalyze(canvaswidth)/2.0] 40 -window $c.button
analyzeStrings $gAnalyze(prob) $c 0
return
}
$c create line 25 50 [expr $gAnalyze(canvaswidth) - 25] 50
set diff [expr double($high-$low)]
if { $diff == 0 } {
set center [expr $gAnalyze(canvaswidth)/2.0]
$c create rectangle [expr $center - 2] 48 [expr $center + 2] 52 -fill green
update idletasks
return
}
set delta [format "%1.e" [expr ($diff)/15.0]]
set start [expr double(int($low/$delta)+1)*$delta]
while { $start < $high } {
set center [expr ($gAnalyze(canvaswidth)-50)*(($start-$low)/$diff)]
set center [expr $center+25]
$c create line $center 40 $center 60
set start [expr $start + $delta]
}
if { ($low < 0) && ($high > 0) } {
set center [expr ($gAnalyze(canvaswidth)-50)*((0-$low)/$diff)]
set center [expr $center+25]
$c create rectangle [expr $center - 1] 40 [expr $center + 1] 60
}
set lastpoint [lindex $gAnalyze($gAnalyze(prob).ans) 0]
set num 0
foreach point $gAnalyze($gAnalyze(prob).ans) {
if { $lastpoint != $point } {
set center [expr ($gAnalyze(canvaswidth)-50)*(($lastpoint-$low)/$diff)]
set center [expr $center+25]
$c create rectangle [expr $center - 2] [expr 48-$num] \
[expr $center + 2] [expr 52+$num] -fill green
set lastpoint $point
set num 0
} else {
incr num
}
}
set center [expr ($gAnalyze(canvaswidth)-50)*(($lastpoint-$low)/$diff)]
set center [expr $center+25]
$c create rectangle [expr $center - 2] [expr 48-$num] \
[expr $center + 2] [expr 52+$num] -fill green
update idletasks
}
###########################################################
# analyzeStop
###########################################################
###########################################################
###########################################################
proc analyzeStop {} {
global gAnalyze
set gAnalyze(stop) 1
set gAnalyze(status) "Stopped"
catch {exec kill -SIGKILL $gAnalyze(pid)}
}
###########################################################
# analyzeClose
###########################################################
###########################################################
###########################################################
proc analyzeClose { } {
global gAnalyze
destroy [winfo toplevel $gAnalyze(canvas)]
unset gAnalyze
global gAnalyze
set gAnalyze(exit) 1
}
###########################################################
# checkIfValidFilename
###########################################################
###########################################################
###########################################################
proc checkIfValidFilename {} {
global gSetNumberText gPreviewButton
if { [regexp \[^0-9\]+ $gSetNumberText] } {
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."
$gPreviewButton configure -state disabled
.main entryconfigure 5 -state disabled
.main entryconfigure 7 -state disabled
return 0
}
$gPreviewButton configure -state normal
.main entryconfigure 5 -state normal
.main entryconfigure 7 -state normal
return 1
}
###########################################################
# updateChangeStatus
###########################################################
###########################################################
###########################################################
proc updateChangeStatus { name1 name2 op } {
global gChanged gRefChanged gRefText gChangedLast gRefChangedLast \
gEditWindow gWindowMenu gRefFile
if { $name1 == "gChanged" } {
if { $gChanged != $gChangedLast } {
set gChangedLast $gChanged
global gFile
if { [catch {set gEditWindow}] } { return }
if { ![winfo exists $gEditWindow] } { return }
if { $gChanged } {
catch {removeWindowEntry "$gFile*"}
wm title [winfo toplevel $gEditWindow] "$gFile (Modified)"
$gWindowMenu add command -label "$gFile (Modified)" -command \
"capaRaise $gEditWindow"
} else {
catch {removeWindowEntry "$gFile*"}
wm title [winfo toplevel $gEditWindow] "$gFile"
$gWindowMenu add command -label "$gFile" -command \
"capaRaise $gEditWindow"
}
}
} else {
if { $gRefChanged($name2) != $gRefChangedLast($name2) } {
if { [catch {set gRefText($name2)}] } { return }
if { ![winfo exists $gRefText($name2)] } { return }
if { $gRefChanged($name2) } {
catch {removeWindowEntry "Reference $gRefFile($name2)*" }
wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2) (Modified)"
$gWindowMenu add command -label "Reference $gRefFile($name2) (Modified)" \
-command "capaRaise [winfo toplevel $gRefText($name2)]"
} else {
catch {removeWindowEntry "Reference $gRefFile($name2)*" }
wm title [winfo toplevel $gRefText($name2)] "$gRefFile($name2)"
$gWindowMenu add command -label "Reference $gRefFile($name2)" \
-command "capaRaise [winfo toplevel $gRefText($name2)]"
}
}
}
}
###########################################################
# main
###########################################################
# sets up the auto_path variable, some globals and adds some
# options then calls createControlWindow to give the user something
# to do
###########################################################
# Arguments: None
# Returns: Nothing
# Globals:
###########################################################
source quizzer.templates.tcl
if { [lindex $auto_path 0] == "./lib/tcl7.5" } {
set auto_path ""
lappend auto_path [pwd]/lib/tcl7.5
lappend auto_path [pwd]/lib/tk4.1
}
lappend auto_path /usr/local/lib/CAPA45/Quizzer
lappend auto_path [pwd]
set font 8x13bold
catch {
if { $argc > 0 } {
switch -glob -- [lindex $argv 0] {
{-[Ll]*} { set font 9x15bold }
{-[Mm]*} -
{-[Nn]*} { set font 8x13bold }
{-[Ss]*} { set font fixed }
}
}
}
option add *font $font
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