Annotation of capa/capa51/GUITools/classl.tcl, revision 1.5
1.4 albertel 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
1.5 ! albertel 5: # modify it under the terms of the GNU General Public License as
1.4 albertel 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
1.5 ! albertel 12: # General Public License for more details.
1.4 albertel 13: #
1.5 ! albertel 14: # You should have received a copy of the GNU General Public
1.4 albertel 15: # License along with the CAPA system; see the file COPYING. If not,
16: # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17: # Boston, MA 02111-1307, USA.
18: #
19: # As a special exception, you have permission to link this program
20: # with the TtH/TtM library and distribute executables, as long as you
21: # follow the requirements of the GNU GPL in regard to all of the
22: # software in the executable aside from TtH/TtM.
23:
1.1 albertel 24: ###########################################################
25: # 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"
1.3 albertel 93: button $actionFrame.save -text "Save" -command "saveClassl $num 1"
1.1 albertel 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"
1.2 albertel 99: button $actionFrame.merge -text "Merge" -command "classlMerge $num"
1.3 albertel 100: pack $actionFrame.add $actionFrame.edit $actionFrame.save $actionFrame.delete \
101: $actionFrame.section $actionFrame.sort $actionFrame.print $actionFrame.find \
102: $actionFrame.merge -side left
1.1 albertel 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]
1.2 albertel 767: for {set i 0} { $i < ($max)} {incr i} {
1.1 albertel 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"
1.2 albertel 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."
1.4 albertel 827: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to classl.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools