Annotation of capa/capa51/GUITools/common.tcl, revision 1.1.1.1
1.1 albertel 1: set gMaxSet 99
2: ###########################################################
3: # capaRaise
4: ###########################################################
5: # tries to make sure that the window mostly definatley ends
6: # up on top. Needed to do this beacuase of how an Xserver
7: # for WinNT handles raise
8: ###########################################################
9: # Argument: window - name of the window to get on top
10: # Returns : nothing
11: # Globals : nothing
12: ###########################################################
13: proc capaRaise { window } {
14: if { $window == "" } { return }
15: wm withdraw $window
16: wm deiconify $window
17: # raise $window
18: }
19:
20: ###########################################################
21: # cleanWindowList
22: ###########################################################
23: ###########################################################
24: ###########################################################
25: proc cleanWindowList { } {
26: global gWindowMenu gCmd gUndoSize gUndo
27:
28: set gCmd "Tcl Commands executed: [info cmdcount]"
29: catch {set gUndoSize "Undo information size [array size gUndo]:[string length [array get gUndo]]"}
30: if { ![winfo exists $gWindowMenu] } {
31: after 1000 cleanWindowList
32: return
33: }
34: set num [$gWindowMenu index end]
35: for { set i 1 } { $i <= $num } { incr i } {
36: set window [lindex [$gWindowMenu entrycget $i -command] 1]
37: if { ![winfo exists $window] } {
38: $gWindowMenu delete $i
39: incr i -1
40: set num [$gWindowMenu index end]
41: }
42: }
43: after 1000 cleanWindowList
44: }
45:
46: ###########################################################
47: # createRemapWindow
48: ###########################################################
49: # creates the window to start the process of remapping or unmapping
50: # the xKeySym for a key
51: ###########################################################
52: # Argument: none
53: # Returns: nothing
54: # Globals: gWindowMenu - used to register the window under the windows
55: # menu
56: ###########################################################
57: proc createRemapWindow {} {
58: global gWindowMenu
59:
60: if { [winfo exists .remap] } {
61: capaRaise .remap
62: return
63: }
64:
65: set remap [toplevel .remap]
66: $gWindowMenu add command -label "Remap" -command "capaRaise $remap"
67: wm title $remap "Select Remap Command"
68:
69: label $remap.label -text "This requires that xmodmap be in your path"
70: button $remap.delete -text "Remap a key to delete" -command \
71: "remap Delete
72: destroy $remap
73: removeWindowEntry Remap"
74: button $remap.backspace -text "Remap a key to backspace" -command \
75: "remap BackSpace
76: destroy $remap
77: removeWindowEntry Remap"
78: button $remap.unmap -text "Unmap a remapped key" -command \
79: "remap unmap
80: destroy $remap
81: removeWindowEntry Remap"
82: button $remap.cancel -text "Cancel" -command \
83: "destroy $remap
84: removeWindowEntry Remap"
85: pack $remap.label $remap.delete $remap.backspace $remap.unmap \
86: $remap.cancel -side top
87:
88: Centre_Dialog $remap default
89: }
90:
91: ###########################################################
92: # remap
93: ###########################################################
94: # creates a window thaat tells the user to press a key, which globally
95: # grabs input, and the runs xmodmap to a file it creates in /tmp named
96: # gkc[pid].
97: ###########################################################
98: # Arguments: one of (Delete,Backspace,unmap), type of remap to preform
99: # Returns: nothing
100: # Globals: gOriginalKeySyms - stores the KeySyms and keycodes of
101: # remmapped keys.
102: # gPromptRemap - used to capture the keypress by the user.
103: # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap
104: # (created and removed)
105: ###########################################################
106: proc remap { type } {
107: global gOriginalKeySyms gPromptRemap
108:
109: set gPromptRemap(result) ""
110:
111: switch $type {
112: Delete
113: -
114: BackSpace
115: {
116: set dialog [toplevel .dialog]
117: wm title $dialog "Grabbing keypress"
118: label $dialog.label -text "Press the key that you want to remap \
119: to $type"
120: label $dialog.label2 -textvariable gPromptRemap(result)
121: pack $dialog.label $dialog.label2
122:
123: bind all <KeyPress> "set gPromptRemap(result) \"%k %K\""
124: Centre_Dialog $dialog default
125: capaRaise $dialog
126: focus $dialog
127: grab -global $dialog
128: vwait gPromptRemap(result)
129: grab release $dialog
130: destroy $dialog
131: bind all <KeyPress> ""
132: set oldKeyCode [lindex $gPromptRemap(result) 0]
133: set oldKeySym [lindex $gPromptRemap(result) 1]
134: set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ]
135: if { $error == 1 } {
136: set gOriginalKeySyms($oldKeyCode) $oldKeySym
137: }
138: exec echo "keycode $oldKeyCode = $type" > [ file join / tmp \
139: gkc[pid] ]
140: exec xmodmap [ file join / tmp gkc[pid] ]
141: displayMessage "Remapped $oldKeySym to $type"
142: }
143: unmap
144: {
145: set dialog [toplevel .dialog]
146: wm title $dialog "Grabbing keypress"
147: label $dialog.label -text "Press the key that you want to unmap"
148: label $dialog.label2 -textvariable gPromptRemap(result)
149: pack $dialog.label $dialog.label2
150:
151: bind all <KeyPress> "set gPromptRemap(result) \"%k %K\""
152: Centre_Dialog $dialog default
153: capaRaise $dialog
154: focus $dialog
155: grab -global $dialog
156: vwait gPromptRemap(result)
157: grab release $dialog
158: destroy $dialog
159: bind all <KeyPress> ""
160: set oldKeyCode [lindex $gPromptRemap(result) 0]
161: set oldKeySym [lindex $gPromptRemap(result) 1]
162: set error [catch { set a $gOriginalKeySyms($oldKeyCode) } ]
163: if { $error == 1 } {
164: displayMessage "Sorry, $oldKeySym has not been remapped \
165: since Quizzer has been started."
166: } else {
167: exec echo "keycode $oldKeyCode = \
168: $gOriginalKeySyms($oldKeyCode)" > \
169: [ file join / tmp gkc[pid] ]
170: exec xmodmap [ file join / tmp gkc[pid] ]
171: displayMessage "Remapped $oldKeySym back to \
172: $gOriginalKeySyms($oldKeyCode) "
173: }
174: }
175: }
176: catch { rm -f [file join / tmp gkc*]}
177: }
178:
179: ###########################################################
180: # unmapAllKeys
181: ###########################################################
182: # wanders through the gOriginalKeySyms var and unmap individually
183: # all of the keys that had been remmapped
184: ###########################################################
185: # Arguments: none
186: # Returns: nothing
187: # Globals: gOriginalKeySyms - stores the original KeySym values by
188: # keycodes that have been remmapped
189: # Files: /tmp/gkc[pid] - stores inforamtion to be run through xmodmap
190: # (created and removed)
191: ###########################################################
192: proc unmapAllKeys { } {
193: global gOriginalKeySyms
194:
195: set allKeyCodes [array names gOriginalKeySyms]
196:
197: while { $allKeyCodes != "" } {
198: set oldKeyCode [lindex $allKeyCodes 0]
199: set allKeyCodes [lrange $allKeyCodes 1 end]
200: exec echo "keycode $oldKeyCode = $gOriginalKeySyms($oldKeyCode)" \
201: > [ file join / tmp gkc[pid] ]
202: exec xmodmap [ file join / tmp gkc[pid] ]
203: catch { rm -rf [ file join / tmp gkc*] }
204: }
205: #displayMessage "Remapped all keys back to original value."
206: }
207:
208:
209: ###########################################################
210: # displayError
211: ###########################################################
212: # displays a modal dialog with an errormessage to the user
213: ###########################################################
214: # Arguments: the message to be displayed
215: # Returns: Nothing
216: # Globals: gPromptDE - used to detect when the user presses ok
217: ###########################################################
218: proc displayError { msg {color black} } {
219: global gPromptDE
220:
221: set dialog [toplevel .prompt -borderwidth 10]
222: wm geo $dialog "+200+200"
223: wm title $dialog "Error"
224:
225: message $dialog.warning -text "WARNING" -font 12x24 -aspect 700
226: message $dialog.msg -text "$msg" -aspect 700 -foreground $color
227: set buttonFrame [frame $dialog.buttons -bd 10]
228: pack $dialog.warning $dialog.msg $buttonFrame -side top -fill x
229:
230: button $buttonFrame.ok -text Dismiss -command { set gPromptDE(ok) 1 } \
231: -underline 0
232: pack $buttonFrame.ok -side left
233:
234: Centre_Dialog $dialog default
235: update
236:
237: capaRaise $dialog
238: focus $dialog
239: capaGrab $dialog
240: vwait gPromptDE(ok)
241: capaGrab release $dialog
242: destroy $dialog
243: return
244: }
245:
246: ###########################################################
247: # capaGrab
248: ###########################################################
249: # modification of tcl's grab, this one sets up a binding so that
250: # if you click anywhere else the window is reshuffled back to the
251: # top
252: ###########################################################
253: # Arguments: either "window" or "release window"
254: # Returns: Nothing
255: # Globals: None
256: ###########################################################
257: proc capaGrab { args } {
258: if { [lindex $args 0] == "release" } {
259: set window [lindex $args 1]
260: grab release $window
261: bind all <ButtonRelease> {}
262: } else {
263: set window [lindex $args 0]
264: grab $window
265: bind all <ButtonRelease> "capaAutoRaise $window %W"
266: }
267: }
268:
269: proc capaAutoRaise { window reportWin } {
270: if { $window == $reportWin } {
271: capaRaise $window
272: focus $window
273: }
274: }
275:
276: ###########################################################
277: # displayMessage
278: ###########################################################
279: # displays a modal dialog with a message to the user
280: ###########################################################
281: # Arguments: the message to be displayed
282: # Returns: Nothing
283: # Globals: gPromptDM - used to detect when the user presses ok
284: ###########################################################
285: proc displayMessage { msg {color black} } {
286: global gPromptDM
287:
288: set dialog [toplevel .prompt -borderwidth 10]
289: wm geo $dialog "+200+200"
290: wm title $dialog "Message"
291:
292: message $dialog.msg -text "$msg" -aspect 700 -foreground $color
293: set buttonFrame [frame $dialog.buttons -bd 10]
294: pack $dialog.msg $buttonFrame -side top -fill x
295:
296: button $buttonFrame.ok -text Dismiss -command { set gPromptDM(ok) 1 } \
297: -underline 0
298: pack $buttonFrame.ok -side left
299:
300: bind $buttonFrame.ok <Return> "set gPromptDM(ok) 1"
301: Centre_Dialog $dialog default
302: update
303:
304: focus $dialog
305: capaRaise $dialog
306: capaGrab $dialog
307: vwait gPromptDM(ok)
308: capaGrab release $dialog
309: destroy $dialog
310: return
311: }
312:
313: ###########################################################
314: # getLprCommand
315: ###########################################################
316: # builds a command string to print with
317: ###########################################################
318: # Arguments: name of the file to be printed
319: # num - index of options in gCapaConfig
320: # Returns: the print command if accepted, Cancel if cancel was hit
321: # Globals: gPrompt - the variable watched to control when to
322: # remove the dialog
323: # gLprCommand - the variable which stores a specified command
324: # gCapaConfig - the variable holding the print strings from
325: # the capa.config file
326: ###########################################################
327: proc getLprCommand { PS_file {num ""}} {
328: global gLprCommand gPrompt gCapaConfig Printer_selected
329:
330: if { $num != "" } { set prefix "$num." } else { set prefix "" }
331: set showPrinterList false
332: set dialog [toplevel .lprCommand -borderwidth 10]
333: wm title $dialog "Command to Print"
334: wm geo $dialog "+200+200"
335:
336: set infoFrame [ frame $dialog.infoFrame ]
337: set optionsFrame [ frame $dialog.optionsFrame ]
338: set buttonFrame [frame $dialog.buttons -bd 10]
339: pack $infoFrame $optionsFrame $buttonFrame -side top -fill x -anchor w
340:
341: message $infoFrame.msg -text "Select a printing method:" -aspect 5000
342: pack $infoFrame.msg
343:
344: set printInfo [frame $optionsFrame.info]
345: set printerList [frame $optionsFrame.list]
346: set printerListFrame [frame $optionsFrame.printFrame]
347: set oneSidedFrame [frame $optionsFrame.oneSided]
348: set twoSidedFrame [frame $optionsFrame.twoSided]
349: set spaceFrame [frame $optionsFrame.space -height 30]
350: set specifiedFrame [frame $optionsFrame.specified]
351: pack $printInfo $printerList $oneSidedFrame $twoSidedFrame \
352: $spaceFrame $specifiedFrame -side top -anchor w
353: pack configure $printInfo -anchor w
354: pack configure $printerList -anchor e
355:
356: if { [array names gLprCommand which] == "" } { set gLprCommand(which) "" }
357: radiobutton $oneSidedFrame.radio -text "One Sided" -value \
358: "OneSided" -variable gLprCommand(which)
359: message $oneSidedFrame.cmd -text $gCapaConfig([set prefix]lprOneSided_command) \
360: -relief raised -width 600 -aspect 5000
361: if { $gCapaConfig([set prefix]lprOneSided_command) != "" } {
362: if { $gLprCommand(which) == "" } { set gLprCommand(which) OneSided }
363: set showPrinterList true
364: pack $oneSidedFrame.radio $oneSidedFrame.cmd -side top
365: pack configure $oneSidedFrame.radio -anchor w
366: pack configure $oneSidedFrame.cmd -anchor e
367: }
368:
369: radiobutton $twoSidedFrame.radio -text "Two Sided" -value \
370: "TwoSided" -variable gLprCommand(which)
371: message $twoSidedFrame.cmd -text $gCapaConfig([set prefix]lprTwoSided_command) \
372: -relief raised -width 400 -aspect 5000
373: if { $gCapaConfig([set prefix]lprTwoSided_command) != "" } {
374: if { $gLprCommand(which) == "" } { set gLprCommand(which) TwoSided }
375: set showPrinterList true
376: pack $twoSidedFrame.radio $twoSidedFrame.cmd -side top
377: pack configure $twoSidedFrame.radio -anchor w
378: pack configure $twoSidedFrame.cmd -anchor e
379: }
380:
381: message $printInfo.text -text "\$Printer_selected = " -aspect 5000
382: message $printInfo.current -textvariable Printer_selected \
383: -aspect 5000
384: pack $printInfo.text $printInfo.current -side left
385:
386: set printerListbox [ listbox $printerList.list -width 20 \
387: -yscrollcommand "$printerList.scroll set" -height 3 ]
388: scrollbar $printerList.scroll -orient v -command "$printerList.list yview"
389: if { $showPrinterList && $gCapaConfig([set prefix]printer_option) != "" } {
390: pack $printerListbox $printerList.scroll -side left -anchor e
391: pack configure $printerList.scroll -fill y
392: foreach printer $gCapaConfig([set prefix]printer_option) {
393: $printerListbox insert end $printer
394: }
395: set Printer_selected [lindex $gCapaConfig([set prefix]printer_option) 0]
396: if { $gCapaConfig(Printer_selected) == "" } {
397: set gCapaConfig(Printer_selected) 0
398: }
399: $printerListbox selection set $gCapaConfig(Printer_selected)
400: $printerListbox see $gCapaConfig(Printer_selected)
401: set script "set Printer_selected \[$printerListbox get \[$printerListbox curselection \] \]"
402: eval $script
403: bind $printerListbox <B1-ButtonRelease> "eval $script"
404: bind $printerListbox <Key> "eval $script"
405: bind $printerListbox <Motion> "eval $script"
406: }
407:
408: radiobutton $specifiedFrame.radio -text "Specified" -value \
409: "Specified" -variable gLprCommand(which)
410: if { $gLprCommand(which) == "" } { set gLprCommand(which) Specified }
411: message $specifiedFrame.msg -text "Print command:" -aspect 5000
412: entry $specifiedFrame.entry -textvariable gLprCommand(Specified) \
413: -width 40 -xscrollcommand "$specifiedFrame.scroll set"
414: trace variable gLprCommand(Specified) w \
415: "global gLprCommand; set gLprCommand(which) Specified ;#"
416: scrollbar $specifiedFrame.scroll -command "$specifiedFrame.entry xview" \
417: -orient h
418: message $specifiedFrame.msg2 -text "Example: lpr -PlocalPrinter" \
419: -aspect 5000
420: pack $specifiedFrame.radio $specifiedFrame.msg $specifiedFrame.entry \
421: $specifiedFrame.scroll $specifiedFrame.msg2 -side top
422: pack configure $specifiedFrame.radio -anchor w
423: pack configure $specifiedFrame.entry -anchor w
424: pack configure $specifiedFrame.scroll -fill x
425:
426: button $buttonFrame.ok -text Print -command {set gPrompt(yes) 1} \
427: -underline 0
428: button $buttonFrame.cancel -text Cancel -command { set gPrompt(yes) 0 } \
429: -underline 0
430: pack $buttonFrame.ok $buttonFrame.cancel -side left
431:
432: bind $dialog <Alt-Key> break
433:
434: Centre_Dialog $dialog default
435: update
436:
437: focus $dialog
438: capaRaise $dialog
439: capaGrab $dialog
440: vwait gPrompt(yes)
441: capaGrab release $dialog
442: if {$gPrompt(yes)} {
443: switch $gLprCommand(which) {
444: Specified { set command "$gLprCommand(Specified)" }
445: OneSided { set command "$gCapaConfig([set prefix]lprOneSided_command)" }
446: TwoSided { set command "$gCapaConfig([set prefix]lprTwoSided_command)" }
447: default {
448: destroy $dialog
449: return "Cancel"
450: }
451: }
452: if { $command == "" } {
453: destroy $dialog
454: displayError "An empty print command can not be used."
455: return "Cancel"
456: }
457: set gCapaConfig(Printer_selected) [$printerListbox curselection]
458: if { [string first \$PS_file $command] == -1 } {
459: set command "$command $PS_file"
460: set command [subst $command]
461: } else {
462: set command [subst $command]
463: }
464: destroy $dialog
465: return "$command"
466: } else {
467: destroy $dialog
468: return "Cancel"
469: }
470: }
471:
472: ###########################################################
473: # makeSure
474: ###########################################################
475: # generalized Yes No question proc,
476: ###########################################################
477: # Arguments: a string containing the question to ask the user
478: # Returns: Yes, or Cancel
479: # Globals: gPrompt - used to watch for a response
480: ###########################################################
481: proc makeSure { question } {
482: global gPrompt
483:
484: set dialog [toplevel .makeSurePrompt -borderwidth 10]
485:
486: wm geo $dialog "+200+200"
487: message $dialog.msg -text "$question" -aspect 700
488:
489: set gPrompt(result) ""
490: set buttonFrame [frame $dialog.buttons -bd 10]
491: pack $dialog.msg $buttonFrame -side top -fill x
492:
493: button $buttonFrame.yes -text Yes -command {set gPrompt(yes) 1} \
494: -underline 0
495: frame $buttonFrame.spacer
496: button $buttonFrame.cancel -text No -command { set gPrompt(yes) 0 } \
497: -underline 0
498: pack $buttonFrame.yes $buttonFrame.spacer $buttonFrame.cancel -side left
499: pack configure $buttonFrame.spacer -expand 1 -fill x
500:
501: bind $dialog <Alt-Key> break
502:
503: Centre_Dialog $dialog default
504: update
505:
506: focus $dialog
507: capaRaise $dialog
508: capaGrab $dialog
509: vwait gPrompt(yes)
510: capaGrab release $dialog
511: destroy $dialog
512: if {$gPrompt(yes)} {
513: return Yes
514: } else {
515: return Cancel
516: }
517: }
518:
519: ###########################################################
520: # parseCapaConfig
521: ###########################################################
522: ###########################################################
523: ###########################################################
524: proc parseCapaConfig { {num "" } { path "" } } {
525: global gCapaConfig
526:
527: if { $num != "" } {
528: set prefix "$num."
529: } else {
530: set prefix ""
531: }
532: if { $path == "" } { set path [pwd] }
533: set filename [file join $path capa.config]
534: set error [ catch { set fileId [open $filename "r"] } ]
535: if { $error } {
536: displayError "Unable to find a capa.config file in $path."
537: error "No capa.config"
538: }
539:
540: set saveto ""
541: set saveline false
542:
543: while { 1 } {
544: gets $fileId aline
545: if { [eof $fileId ] } { break }
546: set error [ catch {
547: switch -glob -- "$aline" {
548: "printer_option *= *" {
549: lappend gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end]
550: }
551: "BeginStandardQuizzerHeader*" {
552: set saveto [set prefix]standardQuizzerHeader
553: set saveline true
554: set gCapaConfig($saveto) ""
555: set aline ""
556: }
557: "EndStandardQuizzerHeader*" {
558: set saveto ""
559: set saveline false
560: }
561: "quizzerBackupQZ *= *" -
562: "quizzerBackupRef *= *" -
563: "lprOneSided_command *= *" -
564: "lprTwoSided_command *= *" -
565: "latex_command *= *" -
566: "allcapaid_command *= *" -
567: "qzparse_command *= *" -
568: "answers_command *= *" -
569: "dvips_command *= *" -
570: "xdvi_command *= *" -
571: "IMP_color *= *" -
572: "comment_color *= *" -
573: "exam_path *= *" -
574: "quiz_path *= *" -
575: "supp_path *= *" -
576: "others_path *= *" {
577: set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end]
578: }
579: }
580: }
581: ]
582: if { $error } {
583: displayError "Error in capa.config file in line: $aline"
584: }
585: if { $saveline } {
586: append gCapaConfig($saveto) "$aline\n"
587: }
588: }
589: close $fileId
590: return OK
591: }
592:
593: ###########################################################
594: # parseCapaUtilsConfig
595: ###########################################################
596: ###########################################################
597: ###########################################################
598: proc parseCapaUtilsConfig { num path } {
599: global gCapaConfig
600:
601: set filename [file join $path capa.config]
602: set error [ catch { set fileId [open $filename "r"] } ]
603: if { $error } {
604: displayError "Unable to find a capautils.config file in $path."
605: error "No capautils.config"
606: }
607:
608: set saveto ""
609: set saveline false
610:
611: while { 1 } {
612: gets $fileId aline
613: if { [eof $fileId ] } { break }
614: set error [ catch {
615: switch -glob -- "$aline" {
616: "homework_scores_limit_set *= *" -
617: "exam_scores_limit_set *= *" -
618: "quiz_scores_limit_set *= *" -
619: "supp_scores_limit_set *= *" -
620: "others_scores_limit_set *= *" -
621: "master_scores_file *= *" -
622: "email_template_file *= *" -
623: "correction_factor *= *" -
624: "hw_percent *= *" -
625: "qz_percent *= *" -
626: "mt1_percent *= *" -
627: "mt2_percent *= *" -
628: "mt3_percent *= *" -
629: "final_percent *= *" -
630: "category_one_high *= *" -
631: "category_one_low *= *" -
632: "category_two_high *= *" -
633: "category_two_low *= *" -
634: "category_three_high *= *" -
635: "category_three_low *= *" -
636: "category_four_high *= *" -
637: "category_four_low *= *" -
638: "display_score_row_limit *= *"
639: {
640: set gCapaConfig($num.[lindex $aline 0]) [lindex $aline end]
641: }
642: }
643: }
644: ]
645: if { $error } {
646: displayError "Error in capautils.config file in line: $aline"
647: }
648: if { $saveline } {
649: append capaConfig($saveto) "$aline\n"
650: }
651: }
652: return OK
653: }
654:
655: ###########################################################
656: # removeWindowEntry
657: ###########################################################
658: # used to deregister a Window Menu entry
659: ###########################################################
660: # Arguments: the label the window was registered under
661: # Returns: nothing
662: # Globals: gWindowMenu - name of the WindowMenu
663: ###########################################################
664: proc removeWindowEntry { label } {
665: global gWindowMenu
666:
667: catch {$gWindowMenu delete $label}
668: }
669:
670: proc scrolltwo { firstcommand secondcommand args } {
671: eval "$firstcommand $args"
672: eval "$secondcommand $args"
673: }
674:
675: ###########################################################
676: # getTextTagged
677: ###########################################################
678: ###########################################################
679: ###########################################################
680: proc getTextTagged { window tag } {
681: if { $tag == "" } { return [$window get 0.0 end-1c] }
682: set result ""
683: set range [$window tag nextrange $tag 0.0]
684: while { $range != "" } {
685: set index [lindex $range 1]
686: append result [eval "$window get $range"]
687: append result "\n"
688: set range [$window tag nextrange $tag $index]
689: }
690: return $result
691: }
692:
693: ###########################################################
694: # getWhichTags
695: ###########################################################
696: ###########################################################
697: ###########################################################
698: proc getWhichTags { descriptions tags action } {
699: set whichtag [eval "tk_dialog .whichtag {Select which messages} \
700: {Select which set of messages will be $action.} \
701: {} 0 $descriptions"]
702: return [lindex $tags $whichtag]
703: }
704:
705: ###########################################################
706: # displayStatus
707: ###########################################################
708: # creates a window on the screen with one or both of a message
709: # or a canvas with a status bar, uses updateStatusMessage and
710: # updateStatusBar to update the respective parts of the status
711: # window, and use removeStatus to remove the status bar from
712: # the screen
713: ###########################################################
714: # Arguments: the message to be displayed (a blank if one is not wanted)
715: # and one of (both, bar, or message) to specify what
716: # parts one wnats in the status bar and optionally a number
717: # if there might be more than one Status at a time
718: # Returns: Nothing
719: # Globals: gStatus - an array containing information for the status
720: # ($num.type) - the type of status
721: # ($num.message) - the message in the status window
722: # ($num.bar) - the id number of the rectangle in the canvas
723: # (num) - (Optional) if there are multiple Statuses
724: # the number of the Status
725: ###########################################################
726: proc displayStatus { message type {num 0} } {
727: global gStatus
728: if { [winfo exists .status$num]} {
729: capaRaise .status$num
730: return
731: }
732:
733: set status [toplevel .status$num]
734:
735: set gStatus($num.type) $type
736: set gStatus($num.message) "$message"
737:
738: switch $type {
739: spinner {
740: message $status.msg -textvariable gStatus($num.message) -aspect 700
741: set gStatus($num.spinner) "-"
742: message $status.spinner -textvariable gStatus($num.spinner) -aspect 700
743: pack $status.msg $status.spinner -side top
744: }
745: both -
746: bar {
747: message $status.msg -textvariable gStatus($num.message) -aspect 700
748: canvas $status.canvas -width 200 -height 20
749: $status.canvas create rectangle 1 1 199 19 -outline black
750: set gStatus($num.bar) [$status.canvas create rectangle 1 1 1 19 \
751: -fill red -outline black]
752: pack $status.msg $status.canvas -side top
753: }
754: message {
755: message $status.msg -textvariable gStatus($num.message) -aspect 700
756: pack $status.msg
757: }
758: }
759: Centre_Dialog $status default
760: update idletasks
761: }
762:
763: ###########################################################
764: # updateStatusMessage
765: ###########################################################
766: # updates the message in the status bar
767: ###########################################################
768: # Arguments: the new message for the status bar and optionally a number
769: # if there might be more than one Status at a time
770: # Returns: Nothing
771: # Globals: gStatus - an array containing information for the status
772: # ($num.type) - the type of status
773: # ($num.message) - the message in the status window
774: # ($num.bar) - the id number of the rectangle in the canvas
775: # (num) - (Optional) if there are multiple Statuses
776: # the number of the Status
777: ###########################################################
778: proc updateStatusMessage { message { num 0 } } {
779: global gStatus
780: set gStatus($num.message) "$message"
781: update idletasks
782: }
783:
784: ###########################################################
785: # updateStatusBar
786: ###########################################################
787: # updates the bar in the status bar
788: ###########################################################
789: # Arguments: a floating point number between 0 and 1 that is
790: # the percentage done and optionally a number
791: # if there might be more than one Status at a time
792: # Returns: Nothing
793: # Globals: gStatus - an array containing information for the status
794: # ($num.type) - the type of status
795: # ($num.message) - the message in the status window
796: # ($num.bar) - the id number of the rectangle in the canvas
797: # (num) - (Optional) if there are multiple Statuses
798: # the number of the Status
799: ###########################################################
800: proc updateStatusBar { percent { num 0 } } {
801: global gStatus
802: .status$num.canvas coords $gStatus($num.bar) 1 1 [expr $percent * 200 ] 19
803: update idletasks
804: }
805:
806: ###########################################################
807: # updateStatusSpinner
808: ###########################################################
809: # updates the spinner in the status bar
810: ###########################################################
811: # Arguments: optionally a number if there might be more
812: # than one Status at a time
813: # Returns: Nothing
814: # Globals: gStatus - an array containing information for the status
815: # ($num.type) - the type of status
816: # ($num.message) - the message in the status window
817: # ($num.bar) - the id number of the rectangle in the canvas
818: # (num) - (Optional) if there are multiple Statuses
819: # the number of the Status
820: ###########################################################
821: proc updateStatusSpinner { { num 0 } } {
822: global gStatus
823: switch -- $gStatus($num.spinner) {
824: "-" { set gStatus($num.spinner) "\\" }
825: "\\" { set gStatus($num.spinner) "|" }
826: "|" { set gStatus($num.spinner) "/" }
827: "/" { set gStatus($num.spinner) "-" }
828: }
829: update idletasks
830: }
831:
832: ###########################################################
833: # removeStatus
834: ###########################################################
835: # takes the status message off of the screen, must be eventually
836: # called after a call to displayStatus
837: ###########################################################
838: # Arguments: and optionally a number if there might be more
839: # than one Status at a time
840: # Returns: Nothing
841: # Globals: gStatus - an array containing information for the status
842: # ($num.type) - the type of status
843: # ($num.message) - the message in the status window
844: # ($num.bar) - the id number of the rectangle in the canvas
845: ###########################################################
846: proc removeStatus { {num 0 } } {
847: global gStatus
848: foreach name [array names gStatus "$num.*"] { unset gStatus($name) }
849: destroy .status$num
850: update idletasks
851: }
852:
853: ###########################################################
854: # tkFDialogResolveFile
855: ###########################################################
856: # I don't like how this version of the Tcl dialog box code
857: # evaluates links, my code here makes it so that clicking
858: # on Open does the same thing as double clicking does, it
859: # returns the path in the top of the dialog box along with
860: # the new filename
861: ###########################################################
862: # I do this catch command to get Tcl to source the
863: # tkfbox.tcl file, then I change the tkFDialogResolveFile
864: # command
865: ###########################################################
866: catch {tkFDialogResolveFile}
867: proc tkFDialogResolveFile {context text defaultext} {
868: set appPWD [pwd]
869:
870: set path [tkFDialog_JoinFile $context $text]
871:
872: if {[file ext $path] == ""} {
873: set path "$path$defaultext"
874: }
875:
876: if [catch {file exists $path}] {
877: return [list ERROR $path ""]
878: }
879:
880: if [catch {if [file exists $path] {}}] {
881: # This "if" block can be safely removed if the following code returns
882: # an error. It currently (7/22/97) doesn't
883: #
884: # file exists ~nonsuchuser
885: #
886: return [list ERROR $path ""]
887: }
888:
889: if [file exists $path] {
890: if [file isdirectory $path] {
891: if [catch {
892: cd $path
893: }] {
894: return [list CHDIR $path ""]
895: }
896: set directory [pwd]
897: set file ""
898: set flag OK
899: cd $appPWD
900: } else {
901: if [catch {
902: cd [file dirname $path]
903: }] {
904: return [list CHDIR [file dirname $path] ""]
905: }
906: set directory [pwd]
907: set directory [file dirname $path]
908: set file [file tail $path]
909: set flag OK
910: cd $appPWD
911: }
912: } else {
913: set dirname [file dirname $path]
914: if [file exists $dirname] {
915: if [catch {
916: cd $dirname
917: }] {
918: return [list CHDIR $dirname ""]
919: }
920: set directory [pwd]
921: set file [file tail $path]
922: if [regexp {[*]|[?]} $file] {
923: set flag PATTERN
924: } else {
925: set flag FILE
926: }
927: cd $appPWD
928: } else {
929: set directory $dirname
930: set file [file tail $path]
931: set flag PATH
932: }
933: }
934:
935: return [list $flag $directory $file]
936: }
937:
938: ###########################################################
939: # tkIconList_Create
940: ###########################################################
941: # Ed wants a bigger default dialog box
942: ###########################################################
943: # I do this catch command to get Tcl to source the
944: # tkfbox.tcl file, then I change the tkIconList_Create
945: # command
946: ###########################################################
947: catch {tkIconList_Create}
948: proc tkIconList_Create {w} {
949: upvar #0 $w data
950:
951: frame $w
952: set data(sbar) [scrollbar $w.sbar -orient horizontal \
953: -highlightthickness 0 -takefocus 0]
954: set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
955: -width 600 -height 180 -takefocus 1]
956: pack $data(sbar) -side bottom -fill x -padx 2
957: pack $data(canvas) -expand yes -fill both
958:
959: $data(sbar) config -command "$data(canvas) xview"
960: $data(canvas) config -xscrollcommand "$data(sbar) set"
961:
962: # Initializes the max icon/text width and height and other variables
963: #
964: set data(maxIW) 1
965: set data(maxIH) 1
966: set data(maxTW) 1
967: set data(maxTH) 1
968: set data(numItems) 0
969: set data(curItem) {}
970: set data(noScroll) 1
971:
972: # Creates the event bindings.
973: #
974: bind $data(canvas) <Configure> "tkIconList_Arrange $w"
975:
976: bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
977: bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
978: bind $data(canvas) <Double-1> "tkIconList_Double1 $w %x %y"
979: bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
980: bind $data(canvas) <B1-Leave> "tkIconList_Leave1 $w %x %y"
981: bind $data(canvas) <B1-Enter> "tkCancelRepeat"
982:
983: bind $data(canvas) <Up> "tkIconList_UpDown $w -1"
984: bind $data(canvas) <Down> "tkIconList_UpDown $w 1"
985: bind $data(canvas) <Left> "tkIconList_LeftRight $w -1"
986: bind $data(canvas) <Right> "tkIconList_LeftRight $w 1"
987: bind $data(canvas) <Return> "tkIconList_ReturnKey $w"
988: bind $data(canvas) <KeyPress> "tkIconList_KeyPress $w %A"
989: bind $data(canvas) <Control-KeyPress> ";"
990: bind $data(canvas) <Alt-KeyPress> ";"
991:
992: bind $data(canvas) <FocusIn> "tkIconList_FocusIn $w"
993:
994: return $w
995: }
996:
997: ###########################################################
998: # findByStudentNumber
999: ###########################################################
1000: ###########################################################
1001: ###########################################################
1002: proc findByStudentNumber { pattern path } {
1003: set file [file join $path "classl"]
1004: if {[catch {set fileId [open $file "r"]}]} { return "" }
1005: set matched_entries ""
1006: set aline [gets $fileId]
1007: while { ! [eof $fileId] } {
1008: set aline [string trimright $aline]
1009: set tmp_sn [string range $aline 14 22]
1010: if { [regexp -nocase $pattern $tmp_sn] } {
1011: lappend matched_entries [ list $tmp_sn [string range $aline 24 53] ]
1012: }
1013: set aline [gets $fileId]
1014: }
1015: close $fileId
1016: return $matched_entries
1017: }
1018:
1019: ###########################################################
1020: # findByStudentName
1021: ###########################################################
1022: ###########################################################
1023: ###########################################################
1024: proc findByStudentName { pattern path } {
1025: set file [file join $path "classl"]
1026: if {[catch {set fileId [open $file "r"]}]} { return "" }
1027: set matched_entries ""
1028: set aline [gets $fileId]
1029: while { ! [eof $fileId] } {
1030: set aline [string trimright $aline]
1031: set tmp_name [string range $aline 24 53]
1032: if { [regexp -nocase $pattern $tmp_name] } {
1033: lappend matched_entries [list [string range $aline 14 22] $tmp_name]
1034: }
1035: set aline [gets $fileId]
1036: }
1037: close $fileId
1038: return $matched_entries
1039: }
1040:
1041: ###########################################################
1042: # fillInStudent
1043: ###########################################################
1044: ###########################################################
1045: ###########################################################
1046: proc fillInStudent { fullnameVar numberVar doname } {
1047: upvar $fullnameVar fullname $numberVar number
1048:
1049: if { !$doname } {
1050: set matched_entries [findByStudentNumber [string trim $number] .]
1051: } else {
1052: set matched_entries [findByStudentName [string trim $fullname] .]
1053: }
1054: if { [llength $matched_entries] == 0 } {
1055: displayMessage "No student found. Please re-enter student info."
1056: set id ""; set name ""
1057: } elseif { [llength $matched_entries] == 1 } {
1058: set id [lindex [lindex $matched_entries 0] 0]
1059: set name [lindex [lindex $matched_entries 0] 1]
1060: } else {
1061: set select [ multipleChoice .main "Matched Student Records, Select one" \
1062: $matched_entries ]
1063: if { $select == "" } {
1064: set id ""; set name ""
1065: } else {
1066: set id [lindex $select 0]
1067: set name [lindex $select 1]
1068: }
1069: }
1070: set fullname $name
1071: set number $id
1072: }
1073:
1074: ###########################################################
1075: # getOneStudent
1076: ###########################################################
1077: # Lets you pick a student by name or student number
1078: # then verifies that they are in the classlist
1079: ###########################################################
1080: ###########################################################
1081: proc getOneStudent { window path idVar nameVar {message "" } {message2 ""}} {
1082: upvar $idVar id
1083: upvar $nameVar name
1084:
1085: set select [tk_dialog $window.dialog "Student select method" \
1086: "$message Select student by:" "" "" "Student Number" \
1087: "Student Name" "Cancel"]
1088: if { $select == 2 } {
1089: set id ""
1090: set name ""
1091: return
1092: }
1093: set done 0
1094: while { ! $done } {
1095: if { $select } { set search "name" } { set search "number" }
1096: set pattern [ getString $window "$message Please enter a student $search." ]
1097: if {$pattern == "" } {
1098: set done 1
1099: set id ""
1100: set name ""
1101: continue
1102: }
1103: if { $select } {
1104: set matched_entries [findByStudentName $pattern $path]
1105: } else {
1106: set matched_entries [findByStudentNumber $pattern $path]
1107: }
1108: if { [llength $matched_entries] == 0 } {
1109: displayMessage "No student found. Please re-enter student $search."
1110: } elseif { [llength $matched_entries] == 1 } {
1111: set id [lindex [lindex $matched_entries 0] 0]
1112: set name [lindex [lindex $matched_entries 0] 1]
1113: set done 1
1114: } elseif { [llength $matched_entries] < 30 } {
1115: set select [ multipleChoice $window "Matched Student Records, Select one. $message2" \
1116: $matched_entries ]
1117: if { $select == "" } {
1118: set id ""; set name ""
1119: return
1120: }
1121: set id [lindex $select 0]
1122: set name [lindex $select 1]
1123: set done 1
1124: } else {
1125: displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
1126: }
1127: }
1128: }
1129:
1130: ###########################################################
1131: # getString
1132: ###########################################################
1133: ###########################################################
1134: ###########################################################
1135: proc getString { window message } {
1136: global gPrompt
1137: set setWin [toplevel $window.getstring]
1138:
1139: set msgFrame [frame $setWin.msgFrame]
1140: set valFrame [frame $setWin.valFrame]
1141: set buttonFrame [frame $setWin.buttonFrame]
1142: pack $msgFrame $valFrame $buttonFrame
1143:
1144:
1145: set gPrompt(val) ""
1146: entry $valFrame.val -textvariable gPrompt(val)
1147: pack $valFrame.val
1148:
1149: message $msgFrame.msg -text $message -aspect 3000
1150: pack $msgFrame.msg
1151:
1152: button $buttonFrame.select -text "Continue" -command { set gPrompt(ok) 1 }
1153: button $buttonFrame.cancel -text "Cancel" -command { set gPrompt(ok) 0 }
1154: pack $buttonFrame.select $buttonFrame.cancel -side left
1155:
1156:
1157: bind $setWin <Return> "set gPrompt(ok) 1"
1158: Centre_Dialog $setWin default
1159: update idletasks
1160: focus $setWin
1161: focus $valFrame.val
1162: capaRaise $setWin
1163: capaGrab $setWin
1164: vwait gPrompt(ok)
1165: capaGrab release $setWin
1166: destroy $setWin
1167: if { $gPrompt(ok) == 1 } {
1168: return $gPrompt(val)
1169: } else {
1170: return ""
1171: }
1172: }
1173:
1174: ###########################################################
1175: # multipleChoice
1176: ###########################################################
1177: ###########################################################
1178: ###########################################################
1179: proc multipleChoice { window message choices {single 1}} {
1180: global gPromptMC
1181:
1182: set setWin [toplevel $window.getstring]
1183:
1184: set msgFrame [frame $setWin.msgFrame]
1185: set valFrame [frame $setWin.valFrame]
1186: set buttonFrame [frame $setWin.buttonFrame]
1187: pack $msgFrame $valFrame $buttonFrame
1188: pack configure $valFrame -expand 1 -fill both
1189:
1190: message $msgFrame.msg -text $message -aspect 3000
1191: pack $msgFrame.msg
1192:
1193: set maxWidth 1
1194: foreach choice $choices {
1195: if {[string length $choice] > $maxWidth} {set maxWidth [string length $choice]}
1196: }
1197: set selectMode extended
1198: if { $single } { set selectMode single }
1199: listbox $valFrame.val -width [expr $maxWidth + 2] \
1200: -yscrollcommand "$valFrame.scroll set" -selectmode $selectMode
1201: scrollbar $valFrame.scroll -command "$valFrame.val yview"
1202: pack $valFrame.val $valFrame.scroll -side left
1203: pack configure $valFrame.val -expand 1 -fill both
1204: pack configure $valFrame.scroll -expand 0 -fill y
1205: foreach choice $choices { $valFrame.val insert end $choice }
1206:
1207: button $buttonFrame.select -text "Continue" -command { set gPromptMC(ok) 1 }
1208: frame $buttonFrame.spacer -width 10
1209: button $buttonFrame.selectall -text "SelectAll" -command \
1210: "$valFrame.val selection set 0 end"
1211: button $buttonFrame.cancel -text "Cancel" -command { set gPromptMC(ok) 0 }
1212: if { $single } {
1213: pack $buttonFrame.select $buttonFrame.cancel -side left
1214: } else {
1215: pack $buttonFrame.select $buttonFrame.spacer \
1216: $buttonFrame.selectall $buttonFrame.cancel -side left
1217: }
1218:
1219: bind $setWin <Return> "set gPromptMC(ok) 1"
1220: Centre_Dialog $setWin default
1221: update idletasks
1222: focus $setWin
1223: capaRaise $setWin
1224: capaGrab $setWin
1225: while { 1 } {
1226: update idletasks
1227: vwait gPromptMC(ok)
1228: if { $gPromptMC(ok) != 1 } { break }
1229: set select [$valFrame.val curselection]
1230: if { $select != "" } { break }
1231: }
1232: capaGrab release $setWin
1233: destroy $setWin
1234: if { $gPromptMC(ok) == 1 } {
1235: foreach selection $select { lappend result [lindex $choices $selection] }
1236: if { [llength $result] == 1 } { set result [lindex $result 0] }
1237: return $result
1238: } else {
1239: return ""
1240: }
1241: }
1242:
1243: ###########################################################
1244: # getSetRange
1245: ###########################################################
1246: ###########################################################
1247: ###########################################################
1248: proc getSetRange { window path } {
1249: global gMaxSet gPromptGSR
1250: for { set i 1 } { $i <= $gMaxSet } { incr i } {
1251: if { ! [file exists [file join $path records "set$i.db"]] } { break }
1252: }
1253: incr i -1
1254:
1255: set setWin [toplevel $window.setselect]
1256:
1257: set msgFrame [frame $setWin.msgFrame]
1258: set valFrame [frame $setWin.calFrame]
1259: set buttonFrame [frame $setWin.buttonFrame]
1260: pack $msgFrame $valFrame $buttonFrame
1261:
1262: message $msgFrame.msg -text "Please select a set range:" -aspect 1000
1263: pack $msgFrame.msg
1264:
1265: global gSetNumberStart gSetNumberEnd
1266: scale $valFrame.start -from 1 -to $i -variable gSetNumberStart -orient h
1267: scale $valFrame.end -from 1 -to $i -variable gSetNumberEnd -orient h
1268: pack $valFrame.start $valFrame.end
1269:
1270: button $buttonFrame.select -text "Select" -command { set gPromptGSR(ok) 1 }
1271: button $buttonFrame.cancel -text "Cancel" -command { set gPromptGSR(ok) 0 }
1272: pack $buttonFrame.select $buttonFrame.cancel -side left
1273:
1274: bind $setWin <Return> "set gPromptGSR(ok) 1"
1275: Centre_Dialog $setWin default
1276: update idletasks
1277: focus $setWin
1278: capaRaise $setWin
1279: capaGrab $setWin
1280: vwait gPromptGSR(ok)
1281: capaGrab release $setWin
1282: destroy $setWin
1283: if { $gPromptGSR(ok) == 1 } {
1284: set setIdStart $gSetNumberStart
1285: set setIdEnd $gSetNumberEnd
1286: if { $setIdStart > $setIdEnd } { set setIdEnd $setIdStart }
1287: unset gSetNumberStart
1288: unset gSetNumberEnd
1289: return [list $setIdStart $setIdEnd]
1290: } else {
1291: unset gSetNumberStart
1292: unset gSetNumberEnd
1293: return ""
1294: }
1295: }
1296:
1297: ###########################################################
1298: # getOneSet
1299: ###########################################################
1300: ###########################################################
1301: ###########################################################
1302: proc getOneSet { window path } {
1303: global gMaxSet gPromptGOS
1304: for { set i 1 } { $i <= $gMaxSet } { incr i } {
1305: if { ! [file exists [file join $path records "set$i.db"]] } { break }
1306: }
1307: incr i -1
1308:
1309: set setWin [toplevel $window.setselect]
1310:
1311: set msgFrame [frame $setWin.msgFrame]
1312: set valFrame [frame $setWin.calFrame]
1313: set buttonFrame [frame $setWin.buttonFrame]
1314: pack $msgFrame $valFrame $buttonFrame
1315:
1316: message $msgFrame.msg -text "Please select a set:" -aspect 1000
1317: pack $msgFrame.msg
1318:
1319: global gSetNumber
1320: scale $valFrame.val -from 1 -to $i -variable gSetNumber -orient h
1321: pack $valFrame.val
1322:
1323: button $buttonFrame.select -text "Select" -command { set gPromptGOS(ok) 1 }
1324: button $buttonFrame.cancel -text "Cancel" -command { set gPromptGOS(ok) 0 }
1325: pack $buttonFrame.select $buttonFrame.cancel -side left
1326:
1327: bind $setWin <Return> "set gPromptGOS(ok) 1"
1328: Centre_Dialog $setWin default
1329: update idletasks
1330: focus $setWin
1331: capaRaise $setWin
1332: capaGrab $setWin
1333: vwait gPromptGOS(ok)
1334: capaGrab release $setWin
1335: destroy $setWin
1336: if { $gPromptGOS(ok) == 1 } {
1337: set setId $gSetNumber
1338: unset gSetNumber
1339: return $setId
1340: } else {
1341: unset gSetNumber
1342: return ""
1343: }
1344: }
1345:
1346: ###########################################################
1347: # pickSections
1348: ###########################################################
1349: ###########################################################
1350: ###########################################################
1351: proc pickSections { sectionsToPickFrom {title "Select Sections"} {window ""}} {
1352: global gPromptPS
1353:
1354: set dialog [toplevel $window.pickSections -borderwidth 10]
1355: wm title $dialog "Which Sections"
1356:
1357: set infoFrame [frame $dialog.info ]
1358: set sectionListFrame [frame $dialog.list -relief groove -borderwidth 5]
1359: set buttonFrame [frame $dialog.buttons -bd 10]
1360: pack $infoFrame $sectionListFrame $buttonFrame -side top -fill x
1361:
1362: message $infoFrame.msg -text $title -aspect 5000
1363: pack $infoFrame.msg
1364:
1365: set headerFrame [frame $sectionListFrame.head ]
1366: set listboxFrame [frame $sectionListFrame.listboxframe]
1367: pack $headerFrame $listboxFrame -side top
1368: pack configure $headerFrame -anchor w
1369:
1370: message $headerFrame.msg -text "Section number # of students" \
1371: -aspect 5000
1372: pack $headerFrame.msg
1373:
1374: set sectionList [ listbox $listboxFrame.list \
1375: -yscrollcommand "$listboxFrame.scroll set" \
1376: -width 30 -height 10 -selectmode extended ]
1377: scrollbar $listboxFrame.scroll \
1378: -command "$listboxFrame.list yview" \
1379: -orient v
1380: pack $sectionList $listboxFrame.scroll -side left
1381: pack configure $listboxFrame.scroll -fill y
1382:
1383: foreach section $sectionsToPickFrom {
1384: $sectionList insert end \
1385: [format "%3d %4d" [lindex $section 0]\
1386: [lindex $section 1] ]
1387: }
1388:
1389: button $buttonFrame.yes -text Continue -command {set gPromptPS(yes) 1} \
1390: -underline 0
1391: frame $buttonFrame.spacer -width 10
1392: button $buttonFrame.selectall -text "SelectAll" -command \
1393: "$sectionList selection set 0 end"
1394: button $buttonFrame.cancel -text Cancel -command { set gPromptPS(yes) 0 } \
1395: -underline 0
1396: bind $dialog <Destroy> "set gPromptPS(yes) 0"
1397:
1398: pack $buttonFrame.yes $buttonFrame.spacer \
1399: $buttonFrame.selectall $buttonFrame.cancel -side left
1400:
1401: bind $dialog <Alt-Key> break
1402:
1403: Centre_Dialog $dialog default
1404: update
1405:
1406: focus $dialog
1407: capaRaise $dialog
1408: capaGrab $dialog
1409: vwait gPromptPS(yes)
1410: capaGrab release $dialog
1411: bind $dialog <Destroy> ""
1412: if {$gPromptPS(yes)} {
1413: set selectionList [ $sectionList curselection ]
1414: set sectionsToPrint ""
1415: foreach selection $selectionList {
1416: append sectionsToPrint "[lindex [$sectionList get $selection] 0] "
1417: }
1418: destroy $dialog
1419: return $sectionsToPrint
1420: } else {
1421: destroy $dialog
1422: return Cancel
1423: }
1424: }
1425:
1426: ###########################################################
1427: # getSet
1428: ###########################################################
1429: ###########################################################
1430: ###########################################################
1431: proc getSet { pid set followupCommand {start 1}} {
1432: global gCapaConfig gGetSet gUniqueNumber
1433: set num [incr gUniqueNumber]
1434: if { $start } {
1435: set gGetSet($num.toprocess) $pid
1436: set gGetSet($num.command) $followupCommand
1437: foreach name [array names gGetSet {*.[alhu]*}] { unset gGetSet($name) }
1438: if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }
1439: }
1440: if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}
1441: set command "$gCapaConfig(getSet.answers_command) $pid {} {} $set"
1442: foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }
1443: set fileId [open "|$command" "r"]
1444: fileevent $fileId readable "getSetLine $num $fileId"
1445: update idletasks
1446: }
1447:
1448: ###########################################################
1449: # getSetQuestion
1450: ###########################################################
1451: ###########################################################
1452: ###########################################################
1453: proc getSetQuestion { num fileId } {
1454: global gGetSet
1455: if { $gGetSet(exit) } {
1456: fileevent $fileId readable ""
1457: catch {close $fileId}
1458: return
1459: }
1460: set questNum $gGetSet($num.questNum)
1461: set aline [gets $fileId]
1462: if { $aline != "" } {
1463: switch [lindex [split $aline :] 0] {
1464: EQES { fileevent $fileId readable "getSetLine $num $fileId" }
1465: default { lappend gGetSet($num.$questNum.quest) $aline }
1466: }
1467: }
1468: if { [eof $fileId] } { getSetEnd $fileId }
1469: }
1470:
1471: ###########################################################
1472: # getSetLine
1473: ###########################################################
1474: ###########################################################
1475: ###########################################################
1476: proc getSetLine { num fileId } {
1477: global gGetSet
1478:
1479: if { $gGetSet(exit) } {
1480: fileevent $fileId readable ""
1481: catch {close $fileId}
1482: return
1483: }
1484: set aline [gets $fileId]
1485: if { $aline != "" } {
1486: switch [lindex [split $aline :] 0] {
1487: ANS {
1488: set questNum $gGetSet($num.questNum)
1489: set ans [string range $aline 4 end]
1490: set length [llength $ans]
1491: lappend gGetSet($num.$questNum.ans) [lindex $ans 0]
1492: if { ($length == 2) || ($length == 4)} {
1493: lappend gGetSet($num.$questNum.unit) [lindex $ans end]
1494: }
1495: if { ($length == 3) || ($length == 4) } {
1496: lappend gGetSet($num.$questNum.low) [lindex $ans 1]
1497: lappend gGetSet($num.$questNum.high) [lindex $ans 2]
1498: }
1499: }
1500: DONE { set gGetSet($num.maxprob) $gGetSet($num.questNum) }
1501: ERROR {
1502: fileevent $fileId readable ""
1503: displayError "Answers returned invalid message: $aline"
1504: fileevent $fileId readable "getSetLine $num $fileId"
1505: }
1506: BQES {
1507: incr gGetSet($num.questNum)
1508: fileevent $fileId readable "getSetQuestion $num $fileId"
1509: }
1510: SET { set gGetSet($num.questNum) 0 }
1511: default {}
1512: }
1513: }
1514: if { [eof $fileId] } { getSetEnd $num $fileId }
1515: }
1516:
1517: ###########################################################
1518: # getSetEnd
1519: ###########################################################
1520: ###########################################################
1521: ###########################################################
1522: proc getSetEnd { num fileId } {
1523: global gGetSet c
1524: if { [eof $fileId] } {
1525: catch {close $fileId}
1526: set command $gGetSet($num.command)
1527: foreach var [array names gGetSet "$num.*"] {
1528: set var2 [join [lrange [split $var .] 1 end] .]
1529: set array($var2) $gGetSet($var)
1530: unset gGetSet($var)
1531: }
1532: eval "$command array"
1533: }
1534: }
1535:
1536: ###########################################################
1537: # lunique --
1538: # order independent list unique proc. most efficient, but requires
1539: # __LIST never be an element of the input list
1540: # Arguments:
1541: # __LIST list of items to make unique
1542: # Returns:
1543: # list of only unique items, order not defined
1544: ###########################################################
1545: proc lunique __LIST {
1546: if {[llength $__LIST]} {
1547: foreach $__LIST $__LIST break
1548: unset __LIST
1549: return [info locals]
1550: }
1551: }
1552:
1553: proc splitline { line maxLength } {
1554: set length [string length $line]
1555: set lines [expr $length/$maxLength + 1]
1556: set i 0
1557: while { 1 } {
1558: if { [string length $line] > $maxLength } {
1559: set end [string wordstart $line $maxLength]
1560: while {1} {
1561: if {[string index $line $end] == " "} {break} {incr end -1}
1562: }
1563: append lin [string range $line 0 [expr int($end-1)]]\n
1564: set line [string range $line $end end]
1565: } else {
1566: append lin $line
1567: break
1568: }
1569: incr i
1570: }
1571: return $lin
1572: }
1573:
1574: ###########################################################
1575: # winputs
1576: ###########################################################
1577: ###########################################################
1578: ###########################################################
1579: proc winputs { num message {tag normal} } {
1580: global gOut
1581:
1582: lappend gOut(output.$num) [list $message $tag]
1583: }
1584:
1585: ###########################################################
1586: # winoutputWrap
1587: ###########################################################
1588: ###########################################################
1589: ###########################################################
1590: proc winoutputWrap { num } {
1591: global gOut
1592: if { $gOut($num.wrap) } {
1593: $gOut($num.output) configure -wrap char
1594: } else {
1595: $gOut($num.output) configure -wrap none
1596: }
1597: }
1598:
1599: ###########################################################
1600: # winoutput
1601: ###########################################################
1602: ###########################################################
1603: ###########################################################
1604: proc winoutput { num cmdnum window } {
1605: global gOut
1606:
1607: if { ![winfo exists $window.output$num] } {
1608: set outputWin [toplevel $window.output$num]
1609:
1610: set buttonFrame [frame $outputWin.button]
1611: set textFrame [frame $outputWin.text]
1612: set bottomFrame [frame $outputWin.bottom]
1613: pack $buttonFrame $textFrame $bottomFrame
1614: pack configure $buttonFrame -anchor e -expand 0 -fill x
1615: pack configure $textFrame -expand 1 -fill both
1616: pack configure $bottomFrame -expand 0 -fill x
1617:
1618: set gOut($num.output) [text $textFrame.text \
1619: -yscrollcommand "$textFrame.scroll set" \
1620: -xscrollcommand "$bottomFrame.scroll set"]
1621: scrollbar $textFrame.scroll -command "$textFrame.text yview"
1622: pack $gOut($num.output) $textFrame.scroll -side left
1623: pack configure $textFrame.text -expand 1 -fill both
1624: pack configure $textFrame.scroll -expand 0 -fill y
1625:
1626: scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h
1627: pack $bottomFrame.scroll -expand 0 -fill x
1628:
1629: set gOut($num.wrap) 1
1630: checkbutton $buttonFrame.wrap -text "Wrap" -command "winoutputWrap $num" \
1631: -variable gOut($num.wrap)
1632: # button $buttonFrame.save -text "Save Text" -command "CTsaveText $num"
1633: button $buttonFrame.print -text "Print Text" -command "winprintText $num"
1634: button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin"
1635: # pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \
1636: $buttonFrame.dismiss -side left
1637: pack $buttonFrame.wrap $buttonFrame.print $buttonFrame.dismiss -side left
1638: }
1639: set index [$gOut($num.output) index end]
1640: foreach line $gOut(output.$cmdnum) {
1641: eval $gOut($num.output) insert end $line
1642: }
1643: unset gOut(output.$cmdnum)
1644: capaRaise $window.output$num
1645: $gOut($num.output) see $index
1646: update idletasks
1647: }
1648:
1649: ###########################################################
1650: # winprintText
1651: ###########################################################
1652: # prints the contents of the text window, creates a temp file named
1653: # quiztemp.txt
1654: ###########################################################
1655: # Arguments: num (the unique number of the path, and window)
1656: # Returns : nothing
1657: # Globals : gFile gCT
1658: ###########################################################
1659: proc winprintText { num } {
1660: global gOut
1661:
1662: set window $gOut($num.output)
1663: if { ![winfo exists $window]} { return }
1664: catch {parseCapaConfig $num}
1665: set lprCommand [getLprCommand commontemp.txt $num]
1666: if {$lprCommand == "Cancel"} { return }
1667:
1668: set fileId [open commontemp.txt w]
1669: puts -nonewline $fileId [$window get 0.0 end-1c]
1670: close $fileId
1671:
1672: set errorMsg ""
1673: if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
1674: displayError "An error occurred while printing: $errorMsg"
1675: } else {
1676: displayMessage "Print job sent to the printer.\n $output"
1677: }
1678: exec rm -f commontemp.txt
1679: }
1680:
1681: ###########################################################
1682: # limitEntry
1683: ###########################################################
1684: ###########################################################
1685: ###########################################################
1686: proc limitEntry { window max type {newvalue ""}} {
1687: after idle "$window config -validate key"
1688: if {[string length $newvalue] > $max } { return 0 }
1689: switch $type {
1690: any {}
1691: number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } }
1692: letter {if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }}
1693: }
1694: return 1
1695: }
1696:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to common.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools