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