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