[BACK]Return to quizzer.tcl CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / GUITools

Diff for /capa/capa51/GUITools/quizzer.tcl between versions 1.8 and 1.19

version 1.8, 1999/11/17 21:34:40 version 1.19, 2000/08/07 20:47:29
Line 1 Line 1
   # 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 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
   #  General Public License for more details.
   #
   #  You should have received a copy of the GNU 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 -   # quizzer.tcl - 
 # Copyright Guy Albertelli II 1996  # Created Guy Albertelli II 1996
 ###########################################################  ###########################################################
 set gTclVer 4.0  set gTclVer 4.0
   
Line 287  proc createInfoWindow {} { Line 310  proc createInfoWindow {} {
     label $about.l1  -font 12x24 -text "Quizzer $gVer" -pady 20      label $about.l1  -font 12x24 -text "Quizzer $gVer" -pady 20
     label $about.l4  -font 8x13 -text "Quizzer.tcl version $gTclVer" -pady 20      label $about.l4  -font 8x13 -text "Quizzer.tcl version $gTclVer" -pady 20
     label $about.l6  -font 8x13 -text "$gCompileDate"       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   -pady 20 -aspect 300
     label $about.l3  -font 8x13 -textvariable gDate       label $about.l3  -font 8x13 -textvariable gDate 
     label $about.l5  -font 8x13 -textvariable gCmd      label $about.l5  -font 8x13 -textvariable gCmd
Line 641  proc getProbValTryVal {} { Line 664  proc getProbValTryVal {} {
 ###########################################################  ###########################################################
 # updateDateBox   # updateDateBox 
 ###########################################################  ###########################################################
   # sticks the date information from gControlDates into the date listbox
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc updateDateBox { listbox } {  proc updateDateBox { listbox } {
Line 665  proc loadDates { listbox } { Line 689  proc loadDates { listbox } {
     global gControlDates      global gControlDates
     if { [catch {getHeaderInfo}]} {       if { [catch {getHeaderInfo}]} { 
  displayError "That set.db does not exist"   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      updateDateBox $listbox
 }  }
   
Line 819  proc getday { kind } { Line 847  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  # enableDateValidation
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
Line 965  proc createDateDialog { toplevel makedef Line 1037  proc createDateDialog { toplevel makedef
     button $buttonFrame.cancel -text "Cancel" -command "set gPrompt2(ok) 0"      button $buttonFrame.cancel -text "Cancel" -command "set gPrompt2(ok) 0"
     set gDates(optBut) [ button $buttonFrame.options -text "More Options" \      set gDates(optBut) [ button $buttonFrame.options -text "More Options" \
      -command "addDateOptions"]       -command "addDateOptions"]
     pack $buttonFrame.help $buttonFrame.set $buttonFrame.cancel $buttonFrame.options \      pack $buttonFrame.set $buttonFrame.cancel $buttonFrame.options -side left
  -side left  
     bind $toplevel <Destroy> "set gPrompt2(ok) 0"      bind $toplevel <Destroy> "set gPrompt2(ok) 0"
     bind $toplevel <KeyPress> "getday open;getday due;getday answer"      bind $toplevel <KeyPress> "getday open;getday due;getday answer"
     bind $toplevel <Return> {tkTabToWindow [tk_focusNext %W]}      bind $toplevel <Return> {tkTabToWindow [tk_focusNext %W]}
Line 1096  proc changeDate { listbox } { Line 1167  proc changeDate { listbox } {
  }   }
     }      }
     capaGrab release $changeDate      capaGrab release $changeDate
     bind $changeDate <Destroy> ""      catch {bind $changeDate <Destroy> ""}
     destroy $changeDate      destroy $changeDate
     if {$gPrompt2(ok) == 1 } {      if {$gPrompt2(ok) == 1 } {
  addCurrentDates $listbox $makedefault $which   addCurrentDates $listbox $makedefault $which
Line 1147  proc addDate { listbox } { Line 1218  proc addDate { listbox } {
  }   }
     }      }
     capaGrab release $addDate      capaGrab release $addDate
     bind $addDate <Destroy> ""      catch {bind $addDate <Destroy> ""}
     destroy $addDate      destroy $addDate
     if {$gPrompt2(ok) == 1 } {      if {$gPrompt2(ok) == 1 } {
  addCurrentDates $listbox $makedefault   addCurrentDates $listbox $makedefault
Line 1182  proc createDBHeader {} { Line 1253  proc createDBHeader {} {
     message $dialog.msg -text "Header Information" -aspect 1000      message $dialog.msg -text "Header Information" -aspect 1000
     set loadFrame [frame $dialog.loadFrame -borderwidth 4 -relief sunken]      set loadFrame [frame $dialog.loadFrame -borderwidth 4 -relief sunken]
     set infoFrame [frame $dialog.infoFrame -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 optionFrame [frame $dialog.options]
     set buttonFrame [frame $dialog.buttons -bd 10]      set buttonFrame [frame $dialog.buttons -bd 10]
     pack $dialog.msg $loadFrame $infoFrame $optionFrame $buttonFrame -side top -fill x      pack $dialog.msg $loadFrame $dialog.message $infoFrame $optionFrame \
    $buttonFrame -side top -fill x
   
     set legendFrame [frame $infoFrame.legendFrame]      set legendFrame [frame $infoFrame.legendFrame]
     set listFrame [frame $infoFrame.listFrame]      set listFrame [frame $infoFrame.listFrame]
Line 1198  proc createDBHeader {} { Line 1271  proc createDBHeader {} {
     set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ]      set listbox [listbox $listFrame.list -width 63 -yscrollcommand "$listFrame.scroll set" ]
     scrollbar $listFrame.scroll -command "$listbox yview"      scrollbar $listFrame.scroll -command "$listbox yview"
     pack $listFrame.list $listFrame.scroll -side left      pack $listFrame.list $listFrame.scroll -side left
       pack configure $listFrame.scroll -fill y
     updateDateBox $listbox      updateDateBox $listbox
           
     button $commandFrame.add -text "Add" -command "addDate $listbox"      button $commandFrame.add -text "Add" -command "addDate $listbox"
     button $commandFrame.change -text "Change" -command "changeDate $listbox"      button $commandFrame.change -text "Change" -command "changeDate $listbox"
     button $commandFrame.delete -text "Delete" -command "deleteDate $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 <Double-ButtonPress-1> "changeDate $listbox"      bind $listbox <Double-ButtonPress-1> "changeDate $listbox"
   
     message $loadFrame.msg -text "Load header information from set:"  \      message $loadFrame.msg -text "Load header information from set:"  \
Line 1252  proc createDBHeader {} { Line 1329  proc createDBHeader {} {
     destroy $dialog      destroy $dialog
     if {$gPrompt(ok) == 1 } {      if {$gPrompt(ok) == 1 } {
  updateDiscussion   updateDiscussion
    if { [llength $gControlDates] > 2 } {
       set gControlDates [linsert [lreverse [lrange $gControlDates 1 end]] 0 [lindex $gControlDates 0]] 
    } 
  eval updateHeader [ eval concat $gControlDates ]   eval updateHeader [ eval concat $gControlDates ]
     }      }
           
Line 1580  proc replaceAll {} { Line 1660  proc replaceAll {} {
     set gCreateImportLinks 1      set gCreateImportLinks 1
     getFindWindow refNum      getFindWindow refNum
     if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end }      if { $refNum >= 0 } { registerCreateImportLinks $refNum 0.0 end }
     displayMessage "Replaced $num occurance$s"      displayMessage "Replaced $num occurrence$s"
 }  }
   
 ###########################################################  ###########################################################
Line 1800  proc createPrefsWindow {} { Line 1880  proc createPrefsWindow {} {
     if { [winfo exists .prefs] } { capaRaise .prefs; return }      if { [winfo exists .prefs] } { capaRaise .prefs; return }
   
     set prefs [toplevel .prefs]      set prefs [toplevel .prefs]
     $gWindowMenu add command -label "Prefrences" -command "capaRaise $prefs"      $gWindowMenu add command -label "Prefernces" -command "capaRaise $prefs"
     wm title $prefs "Preferences"      wm title $prefs "Preferences"
   
     set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4]      set frameAll [frame $prefs.frameAll -relief groove -borderwidth 4]
Line 1844  proc createPrefsWindow {} { Line 1924  proc createPrefsWindow {} {
     button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig"      button $frameButton.config -text "Reread capa.config" -command "rereadCapaConfig"
     button $frameButton.ok -text "Dismiss" -command "destroy $prefs      button $frameButton.ok -text "Dismiss" -command "destroy $prefs
                                                 trace vdelete gWhichFile w changePrefFile                                                  trace vdelete gWhichFile w changePrefFile
                                                 removeWindowEntry Prefrences"                                                  removeWindowEntry Prefernces"
     bind $prefs <Destroy> "removeWindowEntry Preferences"      bind $prefs <Destroy> "removeWindowEntry Preferences"
     button $frameButton.save -text "Save All" -command "savePrefs"      button $frameButton.save -text "Save All" -command "savePrefs"
     pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \      pack $frameButton.impcolor $frameButton.commentcolor $frameButton.config \
Line 1971  proc checkHeader { numberParsed } { Line 2051  proc checkHeader { numberParsed } {
 #    if { $gFirstTime } { set gFirstTime 0; return }  #    if { $gFirstTime } { set gFirstTime 0; return }
     set gLoadHeaderSet $gSetNumberText      set gLoadHeaderSet $gSetNumberText
     set error [catch {getHeaderInfo}]      set error [catch {getHeaderInfo}]
       catch { 
    if { [llength $gControlDates] > 2 } {
       set gControlDates [linsert [lreverse [lrange $gControlDates 1 end]] 0 [lindex $gControlDates 0]] 
    } 
       }
     if { $error == 1 } {      if { $error == 1 } {
  set gHeaderQCount "0"   set gHeaderQCount "0"
  set gControlDates ""   set gControlDates ""
Line 3005  proc trackChanges { procName num } { Line 3090  proc trackChanges { procName num } {
  set chars \[ .$procName get \$insertindex \$insertindex2 \]   set chars \[ .$procName get \$insertindex \$insertindex2 \]
     }      }
     set gUndo($num.\$numChange) \"insert \$insertindex \[list \$chars\] \"      set gUndo($num.\$numChange) \"insert \$insertindex \[list \$chars\] \"
             if {\[regexp \{.*\[\"/\].*\} \$chars\] || \              if { \[string length \$chars\] > 100 } {
                 \[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} {                      registerCreateImportLinks $num \$insertindex-1line \$insertindex2+1line
                registerCreateImportLinks $num \$insertindex \$insertindex2              } else {
                   if {\[regexp \{.*\[\"/\].*\} \$chars\] || \
                       \[regexp \{.*\[\"/\].*\} \[.$procName get \"\$insertindex linestart\" \"\$insertindex2 lineend\"\]\]} { 
                      registerCreateImportLinks $num \$insertindex \$insertindex2
                   }
             }              }
  }          }
  set result \[uplevel .$procName \$args\]   set result \[uplevel .$procName \$args\]
         updateLocation $num          updateLocation $num
         return \$result          return \$result
Line 3573  proc printWindow {} { Line 3662  proc printWindow {} {
     pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top       pack $print.msg $oneSetFrame $moreSetFrame $buttonFrame -side top 
     pack configure $oneSetFrame $moreSetFrame -anchor w -fill x      pack configure $oneSetFrame $moreSetFrame -anchor w -fill x
         
       set msg2Frame [frame $moreSetFrame.msg2 -relief solid -borderwidth 2]
     set infoFrame [frame $moreSetFrame.frame1]      set infoFrame [frame $moreSetFrame.frame1]
     set setFrame [frame $moreSetFrame.frame2 -relief solid -borderwidth 1]      set msg3Frame [frame $moreSetFrame.msg3 -relief solid -borderwidth 2]
     pack $infoFrame $setFrame       set setFrame [frame $moreSetFrame.frame2] 
     pack configure $infoFrame $setFrame -anchor w      pack $msg2Frame $setFrame $msg3Frame $infoFrame -anchor w
           
     if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur}      if {[catch {set gPrintSelection(sets)}]} {set gPrintSelection(sets) printCur}
     if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific}      if {[catch {set gPrintSelection(type)}]} {set gPrintSelection(type) printSpecific}
Line 3608  proc printWindow {} { Line 3698  proc printWindow {} {
     bind $print <Destroy> "removeWindowEntry Print"      bind $print <Destroy> "removeWindowEntry Print"
     pack $buttonFrame.ok $buttonFrame.cancel -side left      pack $buttonFrame.ok $buttonFrame.cancel -side left
           
       set msgFrame [frame $oneSetFrame.msg -relief solid -borderwidth 2]
     set currentDviFrame [frame $oneSetFrame.currentDvi]      set currentDviFrame [frame $oneSetFrame.currentDvi]
     set currentPreviewFrame [frame $oneSetFrame.currentPreview]      set currentPreviewFrame [frame $oneSetFrame.currentPreview]
     set randomFrame [frame $oneSetFrame.random]      set randomFrame [frame $oneSetFrame.random]
Line 3615  proc printWindow {} { Line 3706  proc printWindow {} {
     set sectionFrame [frame $infoFrame.section]      set sectionFrame [frame $infoFrame.section]
     set multSectionFrame [frame $infoFrame.multsection]      set multSectionFrame [frame $infoFrame.multsection]
     set wholeClassFrame [frame $infoFrame.wholeClass]      set wholeClassFrame [frame $infoFrame.wholeClass]
     pack $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \      pack $msgFrame $currentDviFrame $currentPreviewFrame $randomFrame $specificFrame \
     $sectionFrame $multSectionFrame $wholeClassFrame -anchor w \      $sectionFrame $multSectionFrame $wholeClassFrame -anchor w \
     -side top      -side top
     pack configure $specificFrame -expand true -fill both      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" \      radiobutton $currentDviFrame.currentDvi -text "Print current .dvi" \
     -value "printCurrentDvi" -variable gPrintSelection(type)       -value "printCurrentDvi" -variable gPrintSelection(type) 
     pack $currentDviFrame.currentDvi -side left       pack $currentDviFrame.currentDvi -side left 
Line 3653  proc printWindow {} { Line 3751  proc printWindow {} {
  -value "printWholeClass" -variable gPrintSelection(type)    -value "printWholeClass" -variable gPrintSelection(type) 
     pack $wholeClassFrame.wholeClass -side left      pack $wholeClassFrame.wholeClass -side left
           
 i   message $studentNumber.msg -text "Student Number: "  -aspect 10000      message $studentNumber.msg -text "Student Number: "  -aspect 10000
     entry $studentNumber.entry -textvariable gPrintSelection(studentNumber) -width 9 \      entry $studentNumber.entry -textvariable gPrintSelection(studentNumber) -width 9 \
  -validate key -validatecommand "limitEntry %W 9 any %P"   -validate key -validatecommand "limitEntry %W 9 any %P"
     pack $studentNumber.msg $studentNumber.entry -side left      pack $studentNumber.msg $studentNumber.entry -side left
Line 3785  proc createCreateDviWin {} { Line 3883  proc createCreateDviWin {} {
 # sends the file quiztemp.ps to the printer through lpr using  # sends the file quiztemp.ps to the printer through lpr using
 # the option foud in gLprCommand  # 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  # Returns: Nothing
 # Globals: gCapaConfig -  # Globals: gCapaConfig -
 #          gStopPrinting -  #          gStopPrinting -
 # Files: quiztemp.ps - file containg info to print (removed)  # Files: quiztemp.ps - file containg info to print (removed)
 ###########################################################  ###########################################################
 proc printBodon(section  proc printBody { lprCommand { showCompletionMessage 1 } } {
 ionMessage 1 } } {  
     global gCapaConfig gStopPrinting gDonePrinting      global gCapaConfig gStopPrinting gDonePrinting
   
     set errorMsg ""      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 ]      -o quiztemp.ps >& /dev/null} errorMsg ]
     if { $error } {      if { $error } {
  displayError \   displayError \
  "When attempting to run dvips an error occured : $errorMsg"   "When attempting to run dvips an error occurred : $errorMsg"
  return 1   return 1
     }      }
   
Line 3815  ionMessage 1 } } { Line 3915  ionMessage 1 } } {
     set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ]      set error [catch {set returnMessage [eval "exec $lprCommand"] } errorMsg ]
           
     if { $error == 1 } {      if { $error == 1 } {
         displayError "When attempting to print an error occured : $errorMsg"          displayError "When attempting to print an error occurred : $errorMsg"
  return 1   return 1
     } else {      } else {
  if { $showCompletionMessage } {   if { $showCompletionMessage } {
Line 4384  proc analyzeClass { {start 1} } { Line 4484  proc analyzeClass { {start 1} } {
     set name [lindex $gAnalyze(toprocess) 1]      set name [lindex $gAnalyze(toprocess) 1]
     set section [lindex $gAnalyze(toprocess) 2]      set section [lindex $gAnalyze(toprocess) 2]
     set gAnalyze(toprocess) [lrange $gAnalyze(toprocess) 3 end]      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 fileId [open "|$command" "r"]
     set gAnalyze(pid) [pid $fileId]      set gAnalyze(pid) [pid $fileId]
     fconfigure $fileId -blocking 0      fconfigure $fileId -blocking 0
Line 4665  proc analyzeStop {} { Line 4765  proc analyzeStop {} {
     global gAnalyze      global gAnalyze
     set gAnalyze(stop) 1      set gAnalyze(stop) 1
     set gAnalyze(status) "Stopped"      set gAnalyze(status) "Stopped"
     exec kill -SIGKILL $gAnalyze(pid)      catch {exec kill -SIGKILL $gAnalyze(pid)}
 }  }
   
 ###########################################################  ###########################################################
Removed from v.1.8  
changed lines
  Added in v.1.19

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>