File:  [LON-CAPA] / capa / capa51 / GUITools / classl.tcl
Revision 1.5: download - view: text, annotated - select for diffs
Mon Aug 7 20:47:29 2000 UTC (23 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_2_0, version_2_1_X, version_2_1_99_3, version_2_1_99_2, version_2_1_99_1, version_2_1_99_0, version_2_1_3, version_2_1_2, version_2_1_1, version_2_1_0, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, version_2_0_X, version_2_0_99_1, version_2_0_2, version_2_0_1, version_2_0_0, version_1_99_3, version_1_99_2, version_1_99_1_tmcc, version_1_99_1, version_1_99_0_tmcc, version_1_99_0, version_1_3_X, version_1_3_3, version_1_3_2, version_1_3_1, version_1_3_0, version_1_2_X, version_1_2_99_1, version_1_2_99_0, version_1_2_1, version_1_2_0, version_1_1_X, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, version_1_1_3, version_1_1_2, version_1_1_1, version_1_1_0, version_1_0_99_3, version_1_0_99_2, version_1_0_99_1, version_1_0_99, version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, version_0_99_3, version_0_99_2, version_0_99_1, version_0_99_0, version_0_6_2, version_0_6, version_0_5_1, version_0_5, version_0_4, stable_2002_spring, stable_2002_july, stable_2002_april, stable_2001_fall, release_5-1-3, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, conference_2003, bz6209-base, bz6209, STABLE, HEAD, GCI_3, GCI_2, GCI_1, CAPA_5-1-6, CAPA_5-1-5, CAPA_5-1-4_RC1, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- fixed license notices the reference the GNU GPL rather than the GNU LGPL

    1: # classl editor
    2: #  Copyright (C) 1992-2000 Michigan State University
    3: #
    4: #  The CAPA system is free software; you can redistribute it and/or
    5: #  modify it under the terms of the GNU General Public License as
    6: #  published by the Free Software Foundation; either version 2 of the
    7: #  License, or (at your option) any later version.
    8: #
    9: #  The CAPA system is distributed in the hope that it will be useful,
   10: #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   11: #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   12: #  General Public License for more details.
   13: #
   14: #  You should have received a copy of the GNU General Public
   15: #  License along with the CAPA system; see the file COPYING.  If not,
   16: #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   17: #  Boston, MA 02111-1307, USA.
   18: #
   19: #  As a special exception, you have permission to link this program
   20: #  with the TtH/TtM library and distribute executables, as long as you
   21: #  follow the requirements of the GNU GPL in regard to all of the
   22: #  software in the executable aside from TtH/TtM.
   23: 
   24: ###########################################################
   25: # createClasslEditor
   26: ###########################################################
   27: ###########################################################
   28: ###########################################################
   29: proc createClasslEditor { classlFile } {
   30:     global gUniqueNumber gWindowMenu gWindow gTitle gClassl gFile \
   31: 	    gClosed
   32: 
   33:     set error [ catch {set fileId [open $classlFile "r"]}]
   34:     if { $error } { 
   35: 	displayError "Unable to open a $classlFile."
   36: 	return
   37:     }
   38:     close $fileId
   39: 
   40:     set num [incr gUniqueNumber]
   41: 
   42:     set gFile($num) $classlFile
   43: 
   44:     set classlWin [toplevel .classlwindow$num]
   45:     $gWindowMenu add command -label "Classl $classlFile" \
   46: 	    -command "capaRaise $classlWin"
   47:     wm title $classlWin  "Classl $classlFile"
   48: 
   49:     set menuFrame [frame $classlWin.menu -borderwidth 3 -relief raised]
   50:     set infoFrame [frame $classlWin.infoFrame]
   51:     set actionFrame [frame $classlWin.actionFrame]
   52:     set windowFrame [frame $classlWin.windowFrame]
   53:     pack $menuFrame $infoFrame $actionFrame $windowFrame
   54:     pack configure $windowFrame -expand 1 -fill both
   55:     pack configure $menuFrame -fill x -anchor w
   56: 
   57: #menu
   58:     menubutton $menuFrame.file -text File -menu $menuFrame.file.m
   59:     menubutton $menuFrame.edit -text Copy -menu $menuFrame.edit.m
   60:     pack $menuFrame.file  $menuFrame.edit -side left
   61:     
   62:     set fileMenu [ menu $menuFrame.file.m ]
   63:     set editMenu [ menu $menuFrame.edit.m ]
   64: 
   65:     $fileMenu add command -label Open -accelerator "Alt+o" \
   66: 	    -command "specifyClass createClasslEditor"
   67:     bind $classlWin <Alt-o> "specifyClass createClasslEditor"
   68:     $fileMenu add command -label Save -command "saveClassl $num 0" \
   69: 	    -accelerator "Alt+s"
   70:     bind $classlWin <Alt-s> "saveClassl $num 0"
   71:     $fileMenu add command -label "Save As" -command "saveClassl $num 1" \
   72: 	    -accelerator "Alt+S"
   73:     bind $classlWin <Alt-Shift-s> "saveClassl $num 1" 
   74:     $fileMenu add command -label Print -command "printClassl $num"
   75:     $fileMenu add command -label Close -command "closeClassl $num" \
   76: 	    -accelerator "Alt+w"
   77:     bind $classlWin <Alt-w> "closeClassl $num"
   78:     
   79:     $editMenu add command -label "Copy StudentNum" -command "classlCopy $num stunum" \
   80: 	-accelerator "Alt+c"
   81:     bind $classlWin <Alt-c> "classlCopy $num stunum"
   82:     $editMenu add command -label "Copy Name" -command "classlCopy $num name" \
   83: 	-accelerator "Alt+n"
   84:     bind $classlWin <Alt-n> "classlCopy $num name"
   85:     $editMenu add command -label "Copy Email" -command "classlCopy $num email" \
   86: 	-accelerator "Alt+e"
   87:     bind $classlWin <Alt-e> "classlCopy $num email"
   88: 
   89: #info
   90: #action
   91:     button $actionFrame.add -text "Add" -command "classlAdd $num"
   92:     button $actionFrame.edit -text "Edit" -command "classlEdit $num"
   93:     button $actionFrame.save -text "Save" -command "saveClassl $num 1"
   94:     button $actionFrame.delete -text "Delete" -command "classlDelete $num"
   95:     button $actionFrame.section -text "Change Section" -command "classlSectionChange $num"
   96:     button $actionFrame.sort -text "Sort" -command "classlSort $num"
   97:     button $actionFrame.print -text "Print" -command "classlPrint $num"
   98:     button $actionFrame.find -text "Find" -command "classlFind $num"
   99:     button $actionFrame.merge -text "Merge" -command "classlMerge $num"
  100:     pack $actionFrame.add $actionFrame.edit $actionFrame.save $actionFrame.delete \
  101: 	$actionFrame.section $actionFrame.sort $actionFrame.print $actionFrame.find \
  102: 	$actionFrame.merge -side left
  103: 
  104: #window
  105:     set leftFrame [frame $windowFrame.left]
  106:     set rightFrame [frame $windowFrame.right]
  107:     pack $leftFrame $rightFrame -side left
  108:     pack configure $leftFrame -expand 1 -fill both
  109:     pack configure $rightFrame -fill y 
  110: 
  111: #FIXME need to set the title width based on the widest occuring element in
  112: #the listbox
  113:     scrollbar $rightFrame.scroll -orient v -command "$leftFrame.classl yview"
  114:     pack $rightFrame.scroll -fill y -expand 1 -pady 20
  115: 
  116:     set gTitle($num) [format "%-100s" "Class  Section  StuNum  Name                                E-mail"]
  117:     entry $leftFrame.title -textvariable gTitle($num) -width 80 \
  118: 	    -state disabled -xscrollcommand "$leftFrame.scroll set"
  119:     set gClassl($num) [ listbox $leftFrame.classl -width 80 -height 30 \
  120: 	    -xscrollcommand "$leftFrame.scroll set" \
  121: 	    -yscrollcommand "$rightFrame.scroll set" \
  122:             -exportselection 0]
  123:     scrollbar $leftFrame.scroll -orient h -command \
  124: 	    "scrolltwo {$leftFrame.classl xview} {$leftFrame.title  xview}"
  125:     pack $leftFrame.title $leftFrame.classl $leftFrame.scroll -side top
  126:     pack configure $leftFrame.title $leftFrame.scroll -fill x
  127:     pack configure $leftFrame.classl -fill both -expand 1
  128: 
  129:     set fileId [open $classlFile "r"]
  130:     while { 1 } {
  131: 	set aline [gets $fileId]
  132: 	if { [eof $fileId ] } { break }
  133: 	$gClassl($num) insert end [format "%-100s" $aline]
  134:     }
  135:     set gClassl($num.changed) 0
  136:     set gClassl($num.changedlast) 0
  137:     set gClosed($num) 0
  138:     Centre_Dialog $classlWin default
  139:     trace variable gClassl($num.changed) w updateClasslStatus
  140: }
  141: 
  142: ###########################################################
  143: # closeClassl
  144: ###########################################################
  145: ###########################################################
  146: ###########################################################
  147: proc closeClassl { num { mustClose 0 } } {
  148:     global gWindowMenu gWindow gTitle gClassl gFile gClosed
  149: 
  150:     if { ![winfo exists $gClassl($num)] } { return }
  151: 
  152:     if { $gClosed($num) } { return }
  153:     if { $gClassl($num.changed) == 1 } {
  154:         if { [askToSave "Do you wish to save $gFile($num)?" "saveClassl $num" ] == "Cancel" && ( ! $mustClose ) } { return }
  155:     }
  156: 
  157:     if { ( ! $mustClose ) && ( [makeSure "Are you sure you wish to stop editing
  158: $gFile($num)?"] == "Cancel" ) } {
  159:         return
  160:     }
  161:     set gClosed($num) 1
  162:     destroy [winfo toplevel $gClassl($num)]
  163:     removeWindowEntry "Classl $gFile($num)"
  164: }
  165: 
  166: ###########################################################
  167: # saveClassl
  168: ###########################################################
  169: ###########################################################
  170: ###########################################################
  171: proc saveClassl { num {saveAs 0}} {
  172:     global gFile gClassl
  173: 
  174:     if { ![winfo exists $gClassl($num)] } { return }
  175:     if { $saveAs } {
  176: 	set file [tk_getSaveFile -title "Enter name to Save As" \
  177: 		      -initialdir [file dirname "$gFile($num)"]]
  178: 	if {$file == "" } { return }
  179: 	set gFile($num) $file
  180:     }
  181:     set fileId [open "$gFile($num)" "w"]
  182:     foreach line [$gClassl($num) get 0 end] { puts $fileId $line }
  183:     close $fileId
  184:     set gClassl($num.changed) 0
  185: }
  186: 
  187: ###########################################################
  188: # classlSectionChange
  189: ###########################################################
  190: ###########################################################
  191: ###########################################################
  192: proc classlSectionChange { num } {
  193:     global gFile gClassl gWindowMenu
  194:     
  195:     if { [set which [$gClassl($num) curselection]] == "" } {
  196: 	displayMessage "Select a student first"
  197: 	return
  198:     }
  199:     if { [winfo exists .classlsection$num] } {
  200: 	capaRaise .classlsection$num
  201: 	return
  202:     }
  203:     set sectionChange [toplevel .classlsection$num]
  204:     $gWindowMenu add command -label "Section Change" \
  205: 	    -command "capaRaise $sectionChange"
  206:     wm title $sectionChange [file dirname $sectionChange]
  207: 
  208:     set infoFrame [frame $sectionChange.info]
  209:     set entryFrame [frame $sectionChange.entry]
  210:     set buttonFrame [frame $sectionChange.button]
  211:     pack $infoFrame $entryFrame $buttonFrame -side top
  212:     
  213:     label $infoFrame.label -text "Enter New Section Number"
  214:     pack $infoFrame.label
  215: 
  216:     label $entryFrame.label -text "Section:"
  217:     entry $entryFrame.section -textvariable gClassl($num.section) -width 3 \
  218: 	-validate key -validatecommand "limitEntry %W 3 number %P"
  219:     pack $entryFrame.label $entryFrame.section -side left
  220: 
  221:     set gClassl($num.done) 0
  222:     button $buttonFrame.change -text "Change" -command "set gClassl($num.done) 1"
  223:     button $buttonFrame.cancel -text "Cancel" -command "set gClassl($num.done) 0"
  224:     pack $buttonFrame.change $buttonFrame.cancel -side left
  225: 
  226:     Centre_Dialog $sectionChange default
  227:     update
  228: 
  229:     focus $sectionChange
  230:     capaGrab $sectionChange
  231:     vwait gClassl($num.done)
  232:     capaGrab release $sectionChange
  233:     
  234:     if { $gClassl($num.done) } {
  235: 	set record [$gClassl($num) get $which]
  236: 	set record "[string range $record 0 9][format %03d $gClassl($num.section)][string range $record 13 end]"
  237: 	$gClassl($num) delete $which
  238: 	$gClassl($num) insert $which $record
  239: 	set gClassl($num.changed) 1
  240:     }
  241: 
  242:     destroy $sectionChange
  243: }
  244: 
  245: ###########################################################
  246: # classlSort
  247: ###########################################################
  248: ###########################################################
  249: ###########################################################
  250: proc classlSort { num } {
  251:     global gFile gClassl gWindowMenu
  252:     if { [winfo exists .classlsort$num] } {
  253: 	capaRaise .classlsort$num
  254: 	return
  255:     }
  256: 
  257:     set sortClassl [toplevel .classlsort$num]
  258:     $gWindowMenu add command -label "Sort Classl" \
  259: 	    -command "capaRaise $sortClassl"
  260:     wm title $sortClassl [file dirname $sortClassl]
  261: 
  262:     set infoFrame [frame $sortClassl.info]
  263:     set buttonFrame [frame $sortClassl.button]
  264:     pack $infoFrame $buttonFrame -side top
  265:     
  266:     label $infoFrame.label -text "How would you like the classl sorted?"
  267:     pack $infoFrame.label
  268:     
  269:     set gClassl($num.done) 0
  270:     button $buttonFrame.section -text "Sort By Section" \
  271: 	-command "set gClassl($num.done) Section"
  272:     button $buttonFrame.name    -text "Sort By Name" \
  273: 	-command "set gClassl($num.done) Name"
  274:     button $buttonFrame.cancel  -text "Cancel" -command "set gClassl($num.done) 0"
  275:     pack $buttonFrame.section $buttonFrame.name $buttonFrame.cancel -side left
  276: 
  277:     Centre_Dialog $sortClassl default
  278:     update
  279: 
  280:     focus $sortClassl
  281:     capaGrab $sortClassl
  282:     vwait gClassl($num.done)
  283:     capaGrab release $sortClassl
  284:     
  285:     if { $gClassl($num.done) != 0 } {
  286: 	sortClassl$gClassl($num.done) $num
  287: 	set gClassl($num.changed) 1
  288:     }
  289:     destroy $sortClassl
  290: }
  291: 
  292: ###########################################################
  293: # classlCompare
  294: ###########################################################
  295: ###########################################################
  296: ###########################################################
  297: proc classlCompare { field1 field2 val1 val2 } {
  298:     switch $field1 {
  299: 	section {
  300: 	    set a [string range $val1 10 12]
  301: 	    set b [string range $val2 10 12]
  302: 	}
  303: 	name {
  304: 	    set a " [string range $val1 24 55]"
  305: 	    set b " [string range $val2 24 55]"
  306: 	}
  307:     }
  308:     switch $field2 {
  309: 	name {
  310: 	    append a " [string range $val1 24 55]"
  311: 	    append b " [string range $val2 24 55]"
  312: 	}
  313: 	default {}
  314:     }
  315:     return [string compare $a $b]
  316: }
  317: 
  318: ###########################################################
  319: # sortClasslSection
  320: ###########################################################
  321: ###########################################################
  322: ###########################################################
  323: proc sortClasslSection { num } {
  324:     global gClassl
  325:     set allitems [$gClassl($num) get 0 end]
  326:     set newitems [lsort -command "classlCompare section name" $allitems]
  327:     $gClassl($num) delete 0 end
  328:     eval "$gClassl($num) insert end $newitems"
  329: }
  330: 
  331: ###########################################################
  332: # sortClasslName
  333: ###########################################################
  334: ###########################################################
  335: ###########################################################
  336: proc sortClasslName { num } {
  337:     global gClassl
  338:     set allitems [$gClassl($num) get 0 end]
  339:     set newitems [lsort -command "classlCompare name {}" $allitems]
  340:     $gClassl($num) delete 0 end
  341:     eval "$gClassl($num) insert end $newitems"
  342: }
  343:  
  344: ###########################################################
  345: # makeClasslEntryEditor 
  346: ###########################################################
  347: ###########################################################
  348: ###########################################################
  349: proc makeClasslEntryEditor { num window title buttonname } {
  350:     global gClassl gWindowMenu
  351: 
  352:     if { [winfo exists $window] } {
  353: 	capaRaise $window
  354: 	return 1
  355:     }
  356: 
  357:     set add [toplevel $window]
  358:     $gWindowMenu add command -label "$title" -command "capaRaise $add"
  359:     wm title $add "$title"
  360: 
  361:     set infoFrame [frame $add.info]
  362:     set buttonFrame [frame $add.button]
  363:     pack $infoFrame $buttonFrame -side top -anchor w
  364: 
  365:     set classFrame [frame $infoFrame.class]
  366:     set sectionFrame [frame $infoFrame.section]
  367:     set stuFrame [frame $infoFrame.stu]
  368:     set nameFrame [frame $infoFrame.name]
  369:     set emailFrame [frame $infoFrame.email]
  370:     pack $classFrame $sectionFrame $stuFrame $nameFrame $emailFrame -side top -anchor w
  371: 
  372:     label $classFrame.label -text "Class Name" -width 20
  373:     entry $classFrame.entry -textvariable gClassl($num.editclass) -width 9 \
  374: 	-validate key -validatecommand "limitEntry %W 9 any %P"
  375:     pack $classFrame.label $classFrame.entry -side left
  376: 
  377:     label $sectionFrame.label -text "Section" -width 20
  378:     entry $sectionFrame.entry -textvariable gClassl($num.editsection) -width 3 \
  379: 	-validate key -validatecommand "limitEntry %W 3 number %P"
  380:     pack $sectionFrame.label $sectionFrame.entry -side left
  381: 
  382:     label $stuFrame.label -text "Student Number" -width 20
  383:     entry $stuFrame.entry -textvariable gClassl($num.editstu) -width 9 \
  384: 	-validate key -validatecommand "limitEntry %W 9 any %P"
  385:     pack $stuFrame.label $stuFrame.entry -side left
  386: 
  387:     label $nameFrame.label -text "Name(Last, First MI)" -width 20
  388:     entry $nameFrame.entry -textvariable gClassl($num.editname) -width 30 \
  389: 	-validate key -validatecommand "limitEntry %W 30 any %P"
  390:     pack $nameFrame.label $nameFrame.entry -side left
  391: 
  392:     label $emailFrame.label -text "Email" -width 20
  393:     entry $emailFrame.entry -textvariable gClassl($num.editemail) -width 40 \
  394: 	-validate key -validatecommand "limitEntry %W 40 any %P"
  395:     pack $emailFrame.label $emailFrame.entry -side left
  396: 
  397:     button $buttonFrame.add -text $buttonname -command "set gClassl($num.done) 1"
  398:     button $buttonFrame.cancel -text Cancel -command "set gClassl($num.done) 0"
  399:     pack $buttonFrame.add $buttonFrame.cancel -side left
  400: 
  401:     bind $add <Return> "set gClassl($num.done) 1"
  402: 
  403:     Centre_Dialog $add default
  404:     update
  405: 
  406:     focus $add
  407:     capaGrab $add
  408:     return 0
  409: }
  410: 
  411: ###########################################################
  412: # classlDelete
  413: ###########################################################
  414: ###########################################################
  415: ###########################################################
  416: proc classlDelete { num } {
  417:     global gClassl gWindowMenu
  418: 
  419:     if { [set which [$gClassl($num) curselection]] == "" } {
  420: 	displayMessage "Select a student first"
  421: 	return
  422:     } 
  423:     $gClassl($num) delete $which
  424:     set gClassl($num.changed) 1
  425: }
  426: 
  427: ###########################################################
  428: # classlEdit
  429: ###########################################################
  430: ###########################################################
  431: ###########################################################
  432: proc classlEdit { num } {
  433:     global gClassl gWindowMenu
  434: 
  435:     if { [set which [$gClassl($num) curselection]] == "" } {
  436: 	displayMessage "Select a student first"
  437: 	return
  438:     } 
  439:     set record [$gClassl($num) get $which]
  440:     
  441:     set gClassl($num.editclass) [string trimright [string range $record 0 8]]
  442:     set gClassl($num.editsection) [string trimright [string range $record 10 12]]
  443:     set gClassl($num.editstu) [string trimright [string range $record 14 22]]
  444:     set gClassl($num.editname) [string trimright [string range $record 24 53]]
  445:     set gClassl($num.editemail) [string trimright [string range $record 60 99]]
  446: 
  447:     if { [makeClasslEntryEditor $num ".classledit$num" "Editing Student" "Done"] } { return }
  448: 
  449:     vwait gClassl($num.done)
  450:     capaGrab release .classledit$num
  451:     destroy .classledit$num
  452:     if { $gClassl($num.done) } {
  453: 	set gClassl($num.editsection) [string trimleft $gClassl($num.editsection) "0"]
  454: 	set record [format "%-9s %03d %-9s %-30s      %-40s" $gClassl($num.editclass) \
  455: 		   $gClassl($num.editsection) $gClassl($num.editstu) \
  456: 		   $gClassl($num.editname) $gClassl($num.editemail)]
  457: 	$gClassl($num) delete $which
  458: 	$gClassl($num) insert $which $record
  459: 	set gClassl($num.changed) 1
  460:     }
  461: }
  462: 
  463: ###########################################################
  464: # findStuNumClassl 
  465: ###########################################################
  466: ###########################################################
  467: ###########################################################
  468: proc findStuNumClassl { num newstunum } {
  469:     global gClassl 
  470:     
  471:     set max [$gClassl($num) index end]
  472:     for {set i 0} {$i < $max} {incr i} {
  473: 	set teststunum [string range [$gClassl($num) get $i] 14 22]
  474: 	if { [regexp -nocase $newstunum $teststunum] } { return $i }
  475:     }
  476:     return -1
  477: }
  478: 
  479: ###########################################################
  480: # classlAdd
  481: ###########################################################
  482: ###########################################################
  483: ###########################################################
  484: proc classlAdd { num } {
  485:     global gClassl gWindowMenu
  486: 
  487:     set gClassl($num.editclass) ""
  488:     set gClassl($num.editsection) ""
  489:     set gClassl($num.editstu) ""
  490:     set gClassl($num.editname) ""
  491:     set gClassl($num.editemail) ""
  492: 
  493:     if { [makeClasslEntryEditor $num ".classladd$num" "Adding a Student" "Add"] } { 
  494: 	return 
  495:     }
  496:     vwait gClassl($num.done)
  497:     capaGrab release .classladd$num
  498:     destroy .classladd$num
  499:     
  500:     if { $gClassl($num.done) } {
  501: 	if { [set which [findStuNumClassl $num $gClassl($num.editstu)]] > -1 } {
  502: 	    if { "Cancel" == [makeSure "Found a duplicate student \n [$gClassl($num) get $which] \n Replace this one?"] } {
  503: 		set gClassl($num.done) 0
  504: 		displayMessage "Student was not added."
  505: 	    } else {
  506: 		$gClassl($num) delete $which
  507: 	    }
  508: 	}
  509:     }
  510:     if { $gClassl($num.done) } {
  511: 	set gClassl($num.editsection) [string trimleft $gClassl($num.editsection) "0"]
  512: 	set a [format "%-9s %03d %-9s %-30s      %-40s" $gClassl($num.editclass) \
  513: 		   $gClassl($num.editsection) $gClassl($num.editstu) \
  514: 		   $gClassl($num.editname) $gClassl($num.editemail)]
  515: 	$gClassl($num) insert 0 $a
  516: 	set gClassl($num.changed) 1
  517:     }
  518: }
  519: 
  520: ###########################################################
  521: # classlPrint
  522: ###########################################################
  523: ###########################################################
  524: ###########################################################
  525: proc classlPrint { num } {
  526:     global gClassl gWindowMenu gFile
  527: 
  528:     if { [set which [$gClassl($num) curselection]] == "" } {
  529: 	displayMessage "Select a student first"
  530: 	return
  531:     } 
  532:     if { $gClassl($num.changed) == 1 } {
  533:         if {[askToSave "Do you wish to save $gFile($num)?" "saveClassl $num"]=="Yes"} { 
  534: 	    saveClassl $num
  535: 	}
  536:     }
  537:     set record [$gClassl($num) get $which]
  538:     set stunum [string range $record 14 22]
  539: 
  540:     if { [winfo exists .capaprint$num] } {
  541: 	capaRaise .capaprint$num
  542: 	return 1
  543:     }
  544: 
  545:     set print [toplevel .capaprint$num]
  546:     $gWindowMenu add command -label "Printing a Student" -command "capaRaise $print"
  547:     wm title $print "Printing a Student"
  548: 
  549:     set infoFrame [frame $print.info]
  550:     set dataFrame [frame $print.data]
  551:     set buttonFrame [frame $print.button]
  552:     pack $infoFrame $dataFrame $buttonFrame -side top -anchor w
  553: 
  554:     label $infoFrame.label -text "Print For Student $stunum"
  555:     pack $infoFrame.label
  556: 
  557:     set setFrame [frame $dataFrame.set]
  558:     set printerFrame [frame $dataFrame.printer]
  559:     pack $setFrame $printerFrame -side top -anchor w
  560: 
  561:     label $setFrame.label -text "Set" -width 13
  562:     entry $setFrame.set -textvariable gClassl($num.printset) -width 2 \
  563: 		-validate key -validatecommand "limitEntry %W 9 any %P"
  564:     pack $setFrame.label $setFrame.set -side left
  565: 
  566:     label $printerFrame.label -text "Printer Name" -width 13
  567:     entry $printerFrame.printer -textvariable gClassl($num.printername) -width 20 
  568:     pack $printerFrame.label $printerFrame.printer -side left
  569: 
  570:     button $buttonFrame.print -text "Print" -command "set gClassl($num.done) 1"
  571:     button $buttonFrame.cancel -text "Cancel" -command "set gClassl($num.done) 0"
  572:     pack $buttonFrame.print $buttonFrame.cancel -side left
  573: 
  574:     bind $print <Return> "set gClassl($num.done) 1"
  575: 
  576:     Centre_Dialog $print default
  577:     update
  578: 
  579:     focus $print
  580:     capaGrab $print
  581:     vwait gClassl($num.done)
  582:     capaGrab release $print
  583: 
  584:     if { $gClassl($num.done) } {
  585: 	global gCapaConfig
  586: 	parseCapaConfig $num [file dirname $gFile($num)]
  587: 	if {[catch {printStudent $num $stunum $gClassl($num.printset) $gClassl($num.printername)} error ]} {
  588: 	    displayError "Unable to print  $stunum"
  589: 	}
  590: 	foreach name [array names gCapaConfig "$num.*"] {
  591: 	    unset gCapaConfig($name)
  592: 	}
  593:     }
  594:     destroy $print
  595: }
  596: 
  597: ###########################################################
  598: # printStudent
  599: ###########################################################
  600: ###########################################################
  601: ###########################################################
  602: proc printStudent { num stunum printset printername } {
  603:     global gCapaConfig gFile
  604:     set command "$gCapaConfig($num.qzparse_command) -c [file dirname $gFile($num)] \
  605:                      -set $printset -stu $stunum"
  606:     eval "exec $command"
  607:     set tex_file [file join [file dirname $gFile($num)] TeX $stunum.tex]
  608:     set command "$gCapaConfig($num.latex_command) $tex_file"
  609:     removeStatus $num
  610:     #if { "Yes" != [makeSure "Planning on running LaTeX, Continue?"] } { return }
  611:     displayStatus "Running LaTeX" message $num
  612:     set directory [pwd]
  613:     cd [file join [file dirname $gFile($num)] TeX]
  614:     eval "exec $command"
  615:     cd $directory
  616:     set dvi_file [file join [file dirname $gFile($num)] TeX $stunum.dvi]
  617:     set ps_file [file join [file dirname $gFile($num)] TeX $stunum.ps]
  618:     set command "$gCapaConfig($num.dvips_command) $dvi_file -o $ps_file >& /dev/null"
  619:     removeStatus $num
  620:     #if { "Yes" != [makeSure "Planning on running dvips, Continue?"] } { return }
  621:     displayStatus "Running dvips" message $num
  622:     eval "exec $command"
  623:     removeStatus $num
  624:     #if { "Cancel" == [set lprcmd [getLprCommand $ps_file $num]] } { return }
  625:     if { [catch { eval "exec lpr -P$printername $ps_file" } errors ] } {
  626: 	displayError "An error occurred while printing: $errors"
  627:     }
  628: }
  629: 
  630: ###########################################################
  631: # updateClasslStatus
  632: ###########################################################
  633: ###########################################################
  634: ###########################################################
  635: proc updateClasslStatus { name1 name2 op } {
  636:     global gClassl gWindowMenu
  637: 
  638:     set num [lindex [split $name2 .] 0]
  639:     if { $gClassl($num.changed) != $gClassl($num.changedlast)} {
  640: 	set gClassl($num.changedlast) $gClassl($num.changed)
  641: 	global gFile
  642: 	if { ![winfo exists $gClassl($num)] } { return }
  643: 	if { $gClassl($num.changed) } {
  644: 	    catch {removeWindowEntry "Classl $gFile($num)*"}
  645: 	    wm title [winfo toplevel $gClassl($num)] "Classl $gFile($num) (Modified)"
  646: 	    $gWindowMenu add command -label "Classl $gFile($num) (Modified)" -command \
  647: 		"capaRaise $gClassl($num)"
  648: 	} else {
  649: 	    catch {removeWindowEntry "Classl $gFile($num)*"}
  650: 	    wm title [winfo toplevel $gClassl($num)] "Classl $gFile($num)"
  651: 	    $gWindowMenu add command -label "Classl $gFile($num)" -command \
  652: 		"capaRaise $gClassl($num)"
  653: 	}
  654:     }
  655: }
  656: 
  657: ###########################################################
  658: # classlCopy
  659: ###########################################################
  660: ###########################################################
  661: ###########################################################
  662: proc classlCopy { num field } {
  663:     global gClassl
  664:     
  665:     if { ![winfo exists $gClassl($num)] } { return }
  666:     if { [set which [$gClassl($num) curselection]] == "" } {
  667: 	displayMessage "Select a student first"
  668: 	return
  669:     }
  670:     set entry [$gClassl($num) get $which]
  671:     set text ""
  672:     switch $field {
  673: 	stunum { set text [string trimright [string range $entry 14 22]] }
  674: 	name { set text [string trimright [string range $entry 24 53]] }
  675: 	email { set text [string trimright [string range $entry 60 99]] }
  676:     }
  677:     if { $text != "" } {
  678: 	set gClassl($num.selection) $text
  679: 	selection own $gClassl($num)
  680: 	selection handle $gClassl($num) "classlPaste $num"
  681: 	selection handle -selection CLIPBOARD $gClassl($num) "classlPaste $num"
  682: 	clipboard clear -displayof $gClassl($num)
  683: 	clipboard append -displayof $gClassl($num) -- $text
  684:     }
  685: }
  686: 
  687: ###########################################################
  688: # classlPaste
  689: ###########################################################
  690: ###########################################################
  691: ###########################################################
  692: proc classlPaste { num start length } {
  693:     global gClassl
  694:     return [string range $gClassl($num.selection) $start [expr $start + $length]]
  695: }
  696: 
  697: ###########################################################
  698: # classlFind
  699: ###########################################################
  700: ###########################################################
  701: ###########################################################
  702: proc classlFind { num } {
  703:     global gClassl gWindowMenu
  704: 
  705:     if { [winfo exists .classlfind$num] } {
  706: 	capaRaise .classlfind$num
  707: 	return
  708:     }
  709:     set classlFind [toplevel .classlfind$num]
  710:     $gWindowMenu add command -label "Find in Classl" \
  711: 	    -command "capaRaise $classlFind"
  712:     wm title $classlFind "Find"
  713: 
  714:     set infoFrame [frame $classlFind.info]
  715:     set entryFrame [frame $classlFind.entry]
  716:     set buttonFrame [frame $classlFind.button]
  717:     pack $infoFrame $entryFrame $buttonFrame -side top -anchor w
  718: 
  719:     set nameFrame [frame $entryFrame.name]
  720:     set stunumFrame [frame $entryFrame.stunum]
  721:     set emailFrame [frame $entryFrame.email]
  722:     pack $nameFrame $stunumFrame $emailFrame -side top -anchor w
  723: 
  724:     label $nameFrame.label -text "Name" -width 14 -anchor w
  725:     entry $nameFrame.name -textvariable gClassl($num.findname) -width 30 \
  726: 	-validate key -validatecommand "limitEntry %W 30 any %P"
  727:     frame $nameFrame.spacer -width 80
  728:     button $nameFrame.go -text "Find" -command "classlDoFind $num name"
  729:     pack $nameFrame.label $nameFrame.name $nameFrame.spacer $nameFrame.go \
  730: 	-side left -anchor w
  731: 
  732:     label $stunumFrame.label -text "Student Number" -width 14 -anchor w
  733:     entry $stunumFrame.stunum -textvariable gClassl($num.findstunum) -width 9 \
  734: 	-validate key -validatecommand "limitEntry %W 9 any %P"
  735:     frame $stunumFrame.spacer -width 248
  736:     button $stunumFrame.go -text "Find" -command "classlDoFind $num stunum"
  737:     pack $stunumFrame.label $stunumFrame.stunum $stunumFrame.spacer \
  738: 	$stunumFrame.go -side left -anchor w
  739: 
  740:     label $emailFrame.label -text "Email" -width 14 -anchor w
  741:     entry $emailFrame.email -textvariable gClassl($num.findemail) -width 40 \
  742: 	-validate key -validatecommand "limitEntry %W 40 any %P"
  743:     button $emailFrame.go -text "Find" -command "classlDoFind $num email"
  744:     pack $emailFrame.label $emailFrame.email $emailFrame.go -side left -anchor w
  745: 
  746:     button $buttonFrame.close -text "Close" -command "destroy $classlFind"
  747:     pack $buttonFrame.close
  748: 
  749:     Centre_Dialog $classlFind default
  750: }
  751: 
  752: ###########################################################
  753: # classlDoFind
  754: ###########################################################
  755: ###########################################################
  756: ###########################################################
  757: proc classlDoFind { num type } {
  758:     global gClassl 
  759: 
  760:     if {![winfo exists $gClassl($num)]} {return}
  761:     if { [set which [$gClassl($num) curselection]] == "" } { 
  762: 	set which 0 
  763:     } else {
  764: 	incr which
  765:     }
  766:     set max [$gClassl($num) index end]
  767:     for {set i 0} { $i < ($max)} {incr i} {
  768: 	set current [expr ($i+$which)%$max]
  769: 	set entry [$gClassl($num) get $current]
  770: 	switch $type {
  771: 	    name { set tmp [string range [$gClassl($num) get $current] 24 53] }
  772: 	    stunum { set tmp [string range [$gClassl($num) get $current] 14 22] }
  773: 	    email { set tmp [string range [$gClassl($num) get $current] 60 99] }
  774: 	}
  775: 	if { [regexp -nocase $gClassl($num.find$type) $tmp] } {
  776: 	    $gClassl($num) selection clear 0 end
  777: 	    $gClassl($num) selection set $current
  778: 	    $gClassl($num) see $current
  779: 	    return
  780: 	}
  781:     }
  782:     displayMessage "Not Found"
  783: }
  784: 
  785: ###########################################################
  786: # classlMerge
  787: ###########################################################
  788: ###########################################################
  789: ###########################################################
  790: proc classlMerge { num } {
  791:     global gClassl 
  792: 
  793:     set filename [tk_getOpenFile -title "Select a File to merge in"]
  794: 
  795:     if { $filename == "" } { return }
  796:     set fileId [open $filename "r"]
  797:     set maxlines [lindex [exec wc -l $filename] 0]
  798:     set linenum 0
  799:     set newentries 0
  800:     displayStatus "Merging $filename" both $num
  801:     set aline [gets $fileId]
  802:     while {![eof $fileId]} {
  803: 	incr linenum
  804: 	set found 0
  805: 	set stunum [string range $aline 14 22]
  806: 	set max [$gClassl($num) index end]
  807: 	for {set i 0} { $i < ($max)} {incr i} {
  808: 	    set tmp [string range [$gClassl($num) get $i] 14 22]
  809: 	    if { [regexp -nocase $stunum $tmp] } { 
  810: 		set found 1
  811: 		break 
  812: 	    }
  813: 	}
  814: 	if { !$found } { 
  815: 	    incr newentries
  816: 	    $gClassl($num) insert end $aline 
  817: 	}
  818: 	updateStatusBar [expr $linenum/double($maxlines)] $num
  819: 	set aline [gets $fileId]
  820:     }    
  821:     removeStatus $num
  822:     if { $newentries != 0 } { 
  823: 	$gClassl($num) see $max 
  824: 	$gClassl($num) selection set $max
  825:     }
  826:     displayMessage "Added $newentries students."
  827: }

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