--- capa/capa51/GUITools/quizzer.tcl 1999/09/28 21:25:36 1.1 +++ capa/capa51/GUITools/quizzer.tcl 2000/07/12 15:57:08 1.18 @@ -1,6 +1,29 @@ +# student quiz editor and assembly tool +# Copyright (C) 1992-2000 Michigan State University +# +# The CAPA system is free software; you can redistribute it and/or +# modify it under the terms of the GNU Library General Public License as +# published by the Free Software Foundation; either version 2 of the +# License, or (at your option) any later version. +# +# The CAPA system is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public +# License along with the CAPA system; see the file COPYING. If not, +# write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. +# +# As a special exception, you have permission to link this program +# with the TtH/TtM library and distribute executables, as long as you +# follow the requirements of the GNU GPL in regard to all of the +# software in the executable aside from TtH/TtM. + ########################################################### # quizzer.tcl - -# Copyright Guy Albertelli II 1996 +# Created Guy Albertelli II 1996 ########################################################### set gTclVer 4.0 @@ -287,7 +310,7 @@ proc createInfoWindow {} { 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" \ + message $about.l2 -font 8x13 -text "Code by: Y. Tsai, G. Albertelli II Copyright Michigan State University Board of Trustees, 1992-2000, CAPA is released under to GNU GPL v2, and comes WITHOUT ANY WARRENTY, see COPYING for details" \ -pady 20 -aspect 300 label $about.l3 -font 8x13 -textvariable gDate label $about.l5 -font 8x13 -textvariable gCmd @@ -641,6 +664,7 @@ proc getProbValTryVal {} { ########################################################### # updateDateBox ########################################################### +# sticks the date information from gControlDates into the date listbox ########################################################### ########################################################### proc updateDateBox { listbox } { @@ -665,7 +689,11 @@ proc loadDates { listbox } { global gControlDates if { [catch {getHeaderInfo}]} { displayError "That set.db does not exist" - } + } else { + if { [llength $gControlDates] > 2 } { + set gControlDates [linsert [lreverse [lrange $gControlDates 1 end]] 0 [lindex $gControlDates 0]] + } + } updateDateBox $listbox } @@ -819,6 +847,50 @@ proc getday { kind } { } ########################################################### +# moveUpDate +########################################################### +########################################################### +########################################################### +proc moveUpDate { listbox } { + global gControlDates gDates + if { ![winfo exists $listbox] } { return } + if { [set which [$listbox curselection]] == "" } { + displayMessage "Please select a date to move." + return + } + if { $which > 1 } { + set element [lindex $gControlDates $which] + set gControlDates [lreplace $gControlDates $which $which] + set gControlDates [linsert $gControlDates [expr $which - 1] $element] + updateDateBox $listbox + $listbox selection set [expr {$which - 1}] + $listbox see [expr {$which -1}] + } +} + +########################################################### +# moveDownDate +########################################################### +########################################################### +########################################################### +proc moveDownDate { listbox } { + global gControlDates gDates + if { ![winfo exists $listbox] } { return } + if { [set which [$listbox curselection]] == "" } { + displayMessage "Please select a date to move." + return + } + if { ($which > 0) && ($which < ([llength $gControlDates]-1)) } { + set element [lindex $gControlDates $which] + set gControlDates [lreplace $gControlDates $which $which] + set gControlDates [linsert $gControlDates [expr $which + 1] $element] + updateDateBox $listbox + $listbox selection set [expr {$which + 1}] + $listbox see [expr {$which + 1}] + } +} + +########################################################### # enableDateValidation ########################################################### ########################################################### @@ -948,7 +1020,7 @@ proc createDateDialog { toplevel makedef 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) 1 + set gDates(viewbetween) 0 set gDates(inhibitresponse) 0 label $durationFrame.label -text "Duration" @@ -965,8 +1037,7 @@ proc createDateDialog { toplevel makedef 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 + pack $buttonFrame.set $buttonFrame.cancel $buttonFrame.options -side left bind $toplevel "set gPrompt2(ok) 0" bind $toplevel "getday open;getday due;getday answer" bind $toplevel {tkTabToWindow [tk_focusNext %W]} @@ -1096,7 +1167,7 @@ proc changeDate { listbox } { } } capaGrab release $changeDate - bind $changeDate "" + catch {bind $changeDate ""} destroy $changeDate if {$gPrompt2(ok) == 1 } { addCurrentDates $listbox $makedefault $which @@ -1147,7 +1218,7 @@ proc addDate { listbox } { } } capaGrab release $addDate - bind $addDate "" + catch {bind $addDate ""} destroy $addDate if {$gPrompt2(ok) == 1 } { addCurrentDates $listbox $makedefault @@ -1162,7 +1233,7 @@ proc addDate { listbox } { ########################################################### proc createDBHeader {} { global gNumberParsedText gPrompt gLoadHeaderSet gControlDates \ - gSetNumberText gHeaderQCount + gSetNumberText gHeaderQCount gEnableDiscussion gFile if { $gNumberParsedText == "" } { displayError "You must first preview the file before creating the \ @@ -1182,8 +1253,11 @@ proc createDBHeader {} { 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] + label $dialog.message -text "Later entries will override earlier entries" + set optionFrame [frame $dialog.options] set buttonFrame [frame $dialog.buttons -bd 10] - pack $dialog.msg $loadFrame $infoFrame $buttonFrame -side top -fill x + pack $dialog.msg $loadFrame $dialog.message $infoFrame $optionFrame \ + $buttonFrame -side top -fill x set legendFrame [frame $infoFrame.legendFrame] set listFrame [frame $infoFrame.listFrame] @@ -1197,12 +1271,16 @@ proc createDBHeader {} { set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ] scrollbar $listFrame.scroll -command "$listbox yview" pack $listFrame.list $listFrame.scroll -side left + pack configure $listFrame.scroll -fill y 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 + button $commandFrame.moveup -text "MoveUp" -command "moveUpDate $listbox" + button $commandFrame.movedown -text "MoveDown" -command "moveDownDate $listbox" + pack $commandFrame.add $commandFrame.change $commandFrame.delete \ + $commandFrame.moveup $commandFrame.movedown -side left bind $listbox "changeDate $listbox" message $loadFrame.msg -text "Load header information from set:" \ @@ -1212,6 +1290,15 @@ proc createDBHeader {} { 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 } \ @@ -1241,6 +1328,10 @@ proc createDBHeader {} { capaGrab release $dialog destroy $dialog if {$gPrompt(ok) == 1 } { + updateDiscussion + if { [llength $gControlDates] > 2 } { + set gControlDates [linsert [lreverse [lrange $gControlDates 1 end]] 0 [lindex $gControlDates 0]] + } eval updateHeader [ eval concat $gControlDates ] } @@ -1249,12 +1340,40 @@ proc createDBHeader {} { } ########################################################### +# 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 + global gLoadHeaderSet gControlDates if { [string length $gOpenDate] != 8 } { return 0 @@ -1541,7 +1660,7 @@ proc replaceAll {} { set gCreateImportLinks 1 getFindWindow refNum if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end } - displayMessage "Replaced $num occurance$s" + displayMessage "Replaced $num occurrence$s" } ########################################################### @@ -1761,7 +1880,7 @@ proc createPrefsWindow {} { if { [winfo exists .prefs] } { capaRaise .prefs; return } set prefs [toplevel .prefs] - $gWindowMenu add command -label "Prefrences" -command "capaRaise $prefs" + $gWindowMenu add command -label "Prefernces" -command "capaRaise $prefs" wm title $prefs "Preferences" set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4] @@ -1805,7 +1924,7 @@ proc createPrefsWindow {} { button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig" button $frameButton.ok -text "Dismiss" -command "destroy $prefs trace vdelete gWhichFile w changePrefFile - removeWindowEntry Prefrences" + removeWindowEntry Prefernces" bind $prefs "removeWindowEntry Preferences" button $frameButton.save -text "Save All" -command "savePrefs" pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \ @@ -1932,6 +2051,11 @@ proc checkHeader { numberParsed } { # if { $gFirstTime } { set gFirstTime 0; return } set gLoadHeaderSet $gSetNumberText set error [catch {getHeaderInfo}] + catch { + if { [llength $gControlDates] > 2 } { + set gControlDates [linsert [lreverse [lrange $gControlDates 1 end]] 0 [lindex $gControlDates 0]] + } + } if { $error == 1 } { set gHeaderQCount "0" set gControlDates "" @@ -2189,11 +2313,32 @@ proc createPreviewWindow {} { } ########################################################### +# 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 + global gParseErrorsText gWindowMenu gUniqueNumber gCapaConfig set parseErrors [getParseErrors] @@ -2243,8 +2388,29 @@ proc showParseErrors {} { $gParseErrorsText delete 0.0 end capaRaise .parseErrors } - - $gParseErrorsText insert end $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 \ + "eval openError $filename $linenum $tag" + } + } } else { if { [winfo exists .parseErrors] } { $gParseErrorsText delete 0.0 end } } @@ -2381,6 +2547,7 @@ proc rereadCapaConfig { } { displayError "Invalid capa.config file" set gCapaConfig(printer_option) $printer_option } + setDefaultValues updateColors } @@ -2399,16 +2566,24 @@ proc pickCapaConfig { } { 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 + global gFile gTextWindow gSetNumberText gPrefs gChanged gQuizTemp gUndo if { $gChanged } { if { [askToSave 0 0] == "Cancel" } { return } } if { ![catch {set gTextWindow}] } { @@ -2478,7 +2653,8 @@ proc openDocument {} { set gQuizTemp true return } - + setDefaultValues + createEditingWindow 0 $gTextWindow delete 0.0 end $gTextWindow insert 0.0 [read $fileId [file size $gFile]] @@ -2664,7 +2840,7 @@ proc isReferenceFileOpen { file } { set entryfile [lindex $entry 1] } # puts $entryfile - if { [catch {file stat $entryfile a1}] } { puts skipped;continue } + if { [catch {file stat $entryfile a1}] } { continue } file stat $file a2 # puts "$a2(ino) == $a1(ino)" if { $a2(ino) == $a1(ino) } { @@ -2721,18 +2897,19 @@ proc openReferenceFile { {file ""} {new -title "Select the proper file" \ -initialdir "$gDir(reference)" ] event generate .main - if { $file == "" } { return } + 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 + return 0 } } else { if { !$new } { if { [set window [isReferenceFileOpen $file] ] != "" } { + set num [lindex [split [lindex [split $window .] 1] e] end] capaRaise $window - return + return $num } # specifically opening the capa.config file if { $file == "capa.config" } { @@ -2743,18 +2920,18 @@ proc openReferenceFile { {file ""} {new { {All Files} {"*"} } } \ -title "Select the proper file" \ -initialdir "$gDir(reference)" ] - if { $file == "" } { return } + 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 + return 0 } if { [file isdirectory $file] } { displayError "You attempted to open $file which is a directory not a file." - return + return 0 } } } @@ -2872,6 +3049,7 @@ proc openReferenceFile { {file ""} {new set gRefChanged($num) 0 set gRefClosed($num) 0 addFindList $num + return $num } ########################################################### @@ -2912,11 +3090,15 @@ proc trackChanges { procName num } { 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 + if { \[string length \$chars\] > 100 } { + registerCreateImportLinks $num \$insertindex-1line \$insertindex2+1line + } else { + if {\[regexp \{.*\[\"/\].*\} \$chars\] || \ + \[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} { + registerCreateImportLinks $num \$insertindex \$insertindex2 + } } - } + } set result \[uplevel .$procName \$args\] updateLocation $num return \$result @@ -2928,7 +3110,7 @@ proc trackChanges { procName num } { ########################################################### ########################################################### proc undo { num } { - global gUndo gRefText gTextWindow + global gUndo gRefText gTextWindow gChanged gRefChanged if { $gUndo($num.cur) == 0 } { return } set undoInfo $gUndo($num.$gUndo($num.cur)) if { [regexp {.*[\"/].*} $undoInfo] } { @@ -2939,8 +3121,10 @@ proc undo { num } { } 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 } @@ -3220,7 +3404,7 @@ proc createStopButton {} { 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 + label $top.status -textvariable gStopStatus -width 35 -anchor w pack $top.stop $top.status set gStopStatus "" grab $top @@ -3478,10 +3662,11 @@ proc printWindow {} { pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top pack configure $oneSetFrame $moreSetFrame -anchor w -fill x + set msg2Frame [frame $moreSetFrame.msg2 -relief solid -borderwidth 2] set infoFrame [frame $moreSetFrame.frame1] - set setFrame [frame $moreSetFrame.frame2 -relief solid -borderwidth 1] - pack $infoFrame $setFrame - pack configure $infoFrame $setFrame -anchor w + set msg3Frame [frame $moreSetFrame.msg3 -relief solid -borderwidth 2] + set setFrame [frame $moreSetFrame.frame2] + pack $msg2Frame $setFrame $msg3Frame $infoFrame -anchor w if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur} if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific} @@ -3513,6 +3698,7 @@ proc printWindow {} { bind $print "removeWindowEntry Print" pack $buttonFrame.ok $buttonFrame.cancel -side left + set msgFrame [frame $oneSetFrame.msg -relief solid -borderwidth 2] set currentDviFrame [frame $oneSetFrame.currentDvi] set currentPreviewFrame [frame $oneSetFrame.currentPreview] set randomFrame [frame $oneSetFrame.random] @@ -3520,11 +3706,18 @@ proc printWindow {} { set sectionFrame [frame $infoFrame.section] set multSectionFrame [frame $infoFrame.multsection] set wholeClassFrame [frame $infoFrame.wholeClass] - pack $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \ + pack $msgFrame $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \ $sectionFrame $multSectionFrame $wholeClassFrame -anchor w \ -side top pack configure $specificFrame -expand true -fill both + label $msgFrame.msg -text "Select:" + pack $msgFrame.msg -anchor w + label $msg2Frame.msg -text "Or Select:" + pack $msg2Frame.msg -anchor w + label $msg3Frame.msg -text "For:" + pack $msg3Frame.msg -anchor w + radiobutton $currentDviFrame.currentDvi -text "Print current .dvi" \ -value "printCurrentDvi" -variable gPrintSelection(type) pack $currentDviFrame.currentDvi -side left @@ -3690,7 +3883,10 @@ proc createCreateDviWin {} { # sends the file quiztemp.ps to the printer through lpr using # the option foud in gLprCommand ########################################################### -# Arguments: none +# Arguments: lprCommand - actual command to be run to print +# showCompletionMessage - (defaults to 1 true) +# controls whether the print complete +# message gets shown # Returns: Nothing # Globals: gCapaConfig - # gStopPrinting - @@ -3700,11 +3896,11 @@ proc printBody { lprCommand { showComple global gCapaConfig gStopPrinting gDonePrinting set errorMsg "" - set error [ catch {exec $gCapaConfig(dvips_command) quiztemp.dvi \ + set error [ catch {eval exec $gCapaConfig(dvips_command) quiztemp.dvi \ -o quiztemp.ps >& /dev/null} errorMsg ] if { $error } { displayError \ - "When attempting to run dvips an error occured : $errorMsg" + "When attempting to run dvips an error occurred : $errorMsg" return 1 } @@ -3719,7 +3915,7 @@ proc printBody { lprCommand { showComple set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ] if { $error == 1 } { - displayError "When attempting to print an error occured : $errorMsg" + displayError "When attempting to print an error occurred : $errorMsg" return 1 } else { if { $showCompletionMessage } { @@ -3975,12 +4171,14 @@ proc printSection { { lprCommand "" } } default { set type "-T" } } + set prSection [string trimleft $gPrintSelection(section) 0] + if { [set gStopPrinting [expr 2 == [runLatex \ "echo [pwd] | $gCapaConfig(qzparse_command) \ - -sec $gPrintSelection(section) -set $set \ + -sec $prSection -set $set \ -d [pwd] -c [pwd] $type " gCreateDviText] ] ] } { for {set i $start} { $i <= $end} { incr i } { - exec rm -f section$gPrintSelection(section)-set$i.tex + exec rm -f section$prSection-set$i.tex } if {$showStopping} { displayMessage "Printing has been stopped." @@ -3997,7 +4195,7 @@ proc printSection { { lprCommand "" } } } for { set i $start} { $i <= $end } { incr i } { - if { ! [file exists section$gPrintSelection(section)-set$i.tex] } { + 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 @@ -4006,7 +4204,7 @@ proc printSection { { lprCommand "" } } return 2 } - exec mv section$gPrintSelection(section)-set$i.tex quiztemp.tex + exec mv section$prSection-set$i.tex quiztemp.tex exec /bin/rm -f quiztemp.dvi $gCreateDviText insert end "$gCapaConfig(latex_command)\n" @@ -4286,7 +4484,7 @@ proc analyzeClass { {start 1} } { 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 command "$gCapaConfig(answers_command) $number \"$name\" 0 $gAnalyze(set)" set fileId [open "|$command" "r"] set gAnalyze(pid) [pid $fileId] fconfigure $fileId -blocking 0 @@ -4424,6 +4622,67 @@ proc analyzeRandom { } { } ########################################################### +# 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 ########################################################### ########################################################### @@ -4444,13 +4703,21 @@ proc analyzeUpdate { {newProbNumber 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}]} { update idletask;return } + 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 oval [expr $center - 2] 48 [expr $center + 2] 52 -fill green + $c create rectangle [expr $center - 2] 48 [expr $center + 2] 52 -fill green update idletasks return } @@ -4467,11 +4734,24 @@ proc analyzeUpdate { {newProbNumber 0} } 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) { - set center [expr ($gAnalyze(canvaswidth)-50)*(($point-$low)/$diff)] - set center [expr $center+25] - $c create oval [expr $center - 2] 48 [expr $center + 2] 52 -fill green + 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 } @@ -4485,7 +4765,7 @@ proc analyzeStop {} { global gAnalyze set gAnalyze(stop) 1 set gAnalyze(status) "Stopped" - exec kill -SIGKILL $gAnalyze(pid) + catch {exec kill -SIGKILL $gAnalyze(pid)} } ###########################################################