Annotation of capa/capa51/GUITools/gradesubjective.tcl, revision 1.1.1.1
1.1 albertel 1: set gMaxSet 99
2:
3: proc gradeSubjective {} {
4: global gSubj
5:
6: if { [winfo exists .gradeSubjective] } { return }
7: set var [tk_getOpenFile -title "Please select a capa.config file" -filetypes \
8: { { {Capa Config} {capa.config} } }]
9:
10: if { $var != "" } {
11: set gSubj(dir) [file dirname $var]
12: cd $gSubj(dir)
13: } else {
14: return
15: }
16: parseCapaConfig
17: if { "" == [set gSubj(set) [getOneSet {} $gSubj(dir)]] } return
18: if { "" == [set gSubj(quest) [getString {} "Which question?"]] } return
19: set fileid [open "records/set$gSubj(set).db" r]
20: gets $fileid aline
21: gets $fileid aline
22: set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
23: createGradeSubjWindow
24: }
25:
26: proc createGradeSubjWindow {} {
27: global gSubj
28:
29: set gradSubj [toplevel .gradesubjective]
30: wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"
31:
32: set info [frame $gradSubj.info]
33: set grade [frame $gradSubj.grade]
34: set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]]
35: pack $info $grade -side top
36:
37: set msg [frame $info.msg]
38: set id [frame $info.id]
39: pack $msg $id -side left
40:
41: # set gSubj(msg) [text $msg.text -width 40 -height 8 -yscrollcommand "$msg.scroll set"]
42: # scrollbar $msg.scroll -command "$msg.text yview"
43: # pack $gSubj(msg) $msg.scroll -side left
44: # pack configure $msg.scroll -fill y
45: # $gSubj(msg) tag configure error -foreground red
46: # $gSubj(msg) tag configure info -foreground #006c00
47:
48: set msglist [frame $msg.msglist]
49: set msgbutton [frame $msg.msgbutton]
50: pack $msglist $msgbutton -side top
51: pack configure $msgbutton -anchor w
52:
53: set gSubj(response) [listbox $msglist.list -width 40 -height 5 \
54: -yscrollcommand "$msglist.scroll set"]
55: scrollbar $msglist.scroll -command "$msglist.text yview"
56: pack $gSubj(response) $msglist.scroll -side left
57: pack configure $msglist.scroll -fill y
58:
59: set gSubj(numresponse) 0
60:
61: button $msgbutton.send -text Send -command subjSendResponse
62: button $msgbutton.new -text New -command subjNewResponse
63: button $msgbutton.delete -text Delete -command subjDeleteResponse
64: button $msgbutton.view -text View -command subjViewResponse
65: button $msgbutton.edit -text Edit -command subjEditResponse
66: pack $msgbutton.send $msgbutton.new $msgbutton.delete $msgbutton.view \
67: $msgbutton.edit -side left
68:
69: set idlist [frame $id.idlist]
70: set idbutton [frame $id.idbutton]
71: pack $idlist $idbutton -side top
72: pack configure $idbutton -anchor w
73:
74: set gSubj(idlist) [listbox $idlist.list -width 34 -height 5 \
75: -yscrollcommand "$idlist.scroll set"]
76: scrollbar $idlist.scroll -command "$idlist.list yview"
77: pack $idlist.list $idlist.scroll -side left
78: pack configure $idlist.scroll -fill y
79:
80: button $idbutton.delete -text Delete -command subjDeleteId
81: pack $idbutton.delete
82:
83: set response [frame $grade.response]
84: pack $response
85:
86: set scoreandcom [toplevel $gradSubj.scoreandcom]
87: wm title $scoreandcom "Control Panel"
88: wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"
89:
90: set score [frame $scoreandcom.score]
91: set command [frame $scoreandcom.command]
92: set morebut [frame $scoreandcom.morebut]
93: set stat [frame $scoreandcom.stat]
94: pack $score $command $morebut $stat -side top
95:
96: set command1 [frame $command.command1]
97: set command2 [frame $command.command2]
98: pack $command1 $command2 -side left
99:
100: set top [frame $response.top]
101: set bot [frame $response.bot]
102: pack $top $bot -side top
103: pack configure $bot -expand 0 -fill x
104:
105: set gSubj(response) [text $top.response -width 80 -height 21 \
106: -yscrollcommand "$top.scroll set" \
107: -xscrollcommand "$bot.scroll set"]
108: scrollbar $top.scroll -command "$top.response yview"
109: pack $gSubj(response) $top.scroll -side left
110: pack configure $top.scroll -fill y
111:
112: scrollbar $bot.scroll -orient h -command "$top.response xview"
113: pack $bot.scroll
114: pack configure $bot.scroll -expand 0 -fill x
115:
116: wm geometry $gradSubj "-10+0"
117:
118: set score0 [frame $score.score0]
119: set score1 [frame $score.score1]
120: pack $score0 $score1 -side top
121:
122: for {set i 0} {$i < 10 } { incr i } {
123: set parent [eval set "score[expr $i/5]"]
124: set a [frame $parent.score$i -relief sunken -borderwidth 1]
125: if { $gSubj(max) < $i} {
126: radiobutton $a.score$i -text $i -variable gSubj(score) \
127: -value $i -state disabled
128: } else {
129: radiobutton $a.score$i -text $i -variable gSubj(score) -value $i
130: }
131: pack $parent.score$i $a.score$i -side left
132: }
133:
134: set buttonwidth 8
135: set gSubj(wrap) 1;set gSubj(pict) 0
136: button $command1.setnext -text "Grade&Next" -command "subjSet;subjNext" \
137: -width $buttonwidth
138: button $command2.set -text "Grade" -command subjSet -width $buttonwidth
139: frame $command1.space1 -height 30
140: frame $command2.space2 -height 30
141: frame $command2.space22 -height 5
142: button $command1.next -text "Next" -command subjNext -width $buttonwidth
143: button $command2.prev -text "Prev" -command subjPrev -width $buttonwidth
144: button $command1.findid -text "Find ID" -command subjFindId -width $buttonwidth
145: button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth
146: button $command1.findname -text "Find Name" -command subjFindName -width $buttonwidth
147: button $command2.goto -text "GoTo" -command subjGoto -width $buttonwidth
148: button $command1.exit -text "Exit" -command subjDone -width $buttonwidth
149: checkbutton $command2.wrap -text wrap -command subjWrap -variable gSubj(wrap)
150: checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)
151: checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled
152: pack $command1.setnext $command2.set $command1.space1 $command2.space2 \
153: $command1.next $command2.prev $command1.findid \
154: $command2.addid $command1.findname $command1.exit $command2.goto \
155: $command2.wrap $command2.pict $command1.done $command2.space22
156:
157: button $morebut.print -text "Print Response" -command subjPrint \
158: -width [expr $buttonwidth*2]
159: pack $morebut.print
160:
161: set gSubj(done) 0
162: set gSubj(togo) 0
163: set gSubj(secAvg) 0.0
164: set gSubj(sec) 0
165: set gSubj(pause) 0
166: label $stat.done -text Done:
167: label $stat.donenum -textvariable gSubj(done) -width 4
168: label $stat.togo -text "To Go:"
169: label $stat.togonum -textvariable gSubj(togo) -width 4
170: label $stat.sec -text Sec:
171: label $stat.secnum -textvariable gSubj(sec) -width 4
172: label $stat.avgsec -text AvgSec:
173: label $stat.avgsecnum -textvariable gSubj(avgsec) -width 4
174: checkbutton $stat.pause -variable gSubj(pause) -text "Pause" -command subjPause
175: pack $stat.done $stat.donenum $stat.togo $stat.togonum -side left
176: #not packed
177: #$stat.sec $stat.secnum $stat.avgsec $stat.avgsecnum $stat.pause
178:
179: set gSubj(canvas) [canvas $picts.canvas -height 220 \
180: -xscrollcommand "$picts.scroll set"]
181: scrollbar $picts.scroll -orient h -command "$picts.canvas xview"
182: pack $picts.scroll $gSubj(canvas) -fill x
183: subjInit
184: }
185:
186: proc subjWrap {} {
187: global gSubj
188: if { $gSubj(wrap) } {
189: $gSubj(response) configure -wrap char
190: } else {
191: $gSubj(response) configure -wrap none
192: }
193: }
194:
195: proc updateSecCount {} {
196: global gSubj
197:
198: if { [catch {set gSubj(pause)}] } { return }
199: if { !$gSubj(pause) } {set gSubj(sec) [expr {[clock seconds] - $gSubj(seconds)}]}
200: after 300 updateSecCount
201: }
202:
203: proc subjCheckForNew {} {
204: global gSubj
205: }
206:
207: proc subjRestore {} {
208: global gSubj
209: source gradingstatus
210: subjCheckForNew
211: set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
212: cd $gSubj(dir)
213: incr gSubj(current) -1
214: subjNext
215: }
216:
217: proc subjSave {} {
218: global gSubj
219: set file [file join $gSubj(dir) records set$gSubj(set) \
220: problem$gSubj(quest) gradingstatus]
221: set fileId [open $file w]
222: puts $fileId "array set gSubj \"[array get gSubj]\""
223: close $fileId
224: }
225:
226: proc subjDone {} {
227: global gSubj
228: subjSave
229: unset gSubj
230: destroy .gradesubjective
231: }
232:
233: proc subjInit {} {
234: global gSubj
235:
236: set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
237: cd $dir
238: if { [file exists gradingstatus] } { subjRestore } else {
239: set gSubj(stunums) [lsort -dictionary [glob *]]
240: cd $gSubj(dir)
241: set gSubj(current) -1
242: set gSubj(totalsec) 0
243: set gSubj(seconds) [clock seconds]
244: set fileId [open classl r]
245: while { 1 } {
246: set aline [gets $fileId]
247: if { [eof $fileId]} {break}
248: lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
249: # lappend gSubj(allname) [string toupper [string range $aline 24 59]]
250: lappend gSubj(allname) [string range $aline 24 59]
251: }
252: set gSubj(togo) [llength $gSubj(stunums)]
253: subjNext
254: }
255: after 300 updateSecCount
256: }
257:
258: #FIXME check Ids when adding them to the list of ids
259: proc checkId { id } {
260: global gSubj
261: set score [getScore $gSubj(set) $gSubj(quest) $id]
262: if { $score == "-" || $score == "0" } { return 1 }
263: return 0
264: }
265:
266: proc subjPause {} {
267: global gSubj
268: if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] }
269: }
270:
271: proc subjStatusUpdate {} {
272: global gSubj
273:
274: set gSubj(done) [llength [array names gSubj "done.*.score"]]
275: set total [llength $gSubj(stunums)]
276: set gSubj(togo) [expr $total-$gSubj(done)]
277: incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}]
278: set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]]
279: # puts $gSubj(avgsec)
280: set gSubj(seconds) [clock seconds]
281: }
282:
283: proc subjSet {} {
284: global gSubj
285:
286: # if {$gSubj(togo) == 0} { return }
287: if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return }
288: set idlist [subjGetIdList]
289: foreach id $idlist {
290: setScore $gSubj(set) $gSubj(quest) $id $gSubj(score)
291: }
292: set id [lindex $gSubj(stunums) $gSubj(current)]
293: set gSubj(done.$id.idlist) $idlist
294: set gSubj(done.$id.score) $gSubj(score)
295: set gSubj(donestat) 1
296: subjStatusUpdate
297: subjSave
298: }
299:
300: proc subjNext {} {
301: global gSubj
302:
303: set gSubj(score) ""
304: set gSubj(pict) 0
305: subjPict
306: incr gSubj(current)
307: if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 }
308: set id [lindex $gSubj(stunums) $gSubj(current)]
309:
310: $gSubj(response) delete 0.0 end
311: $gSubj(idlist) delete 0 end
312:
313: if { $id != "" } {
314: set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id]
315: set fileId [open $file "r"]
316: $gSubj(response) insert 0.0 [read $fileId [file size $file]]
317: close $fileId
318: subjInsertIds $id
319: }
320:
321: wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id"
322: if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } {
323: set gSubj(score) ""
324: set gSubj(donestat) 0
325: update idletasks
326: subjFindIds
327: } else {
328: set gSubj(donestat) 1
329: subjInsertIds $gSubj(done.$id.idlist)
330: update idletasks
331: }
332: subjPicts
333: }
334:
335: proc subjFindIds1 {} {
336: global gSubj
337:
338: set text [$gSubj(response) get 0.0 end]
339: set result ""
340: foreach id $gSubj(allstunum) {
341: if { [regexp -nocase -- $id $text] } {
342: lappend result $id
343: }
344: }
345: return $result
346: }
347:
348: proc subjFindIds2 {} {
349: global gSubj
350:
351: set text [string toupper [$gSubj(response) get 0.0 end]]
352: set result ""
353: if { [catch {lsearch $text a}] } {
354: puts badlist; return subjFindIds1
355: } else {
356: foreach id $gSubj(allstunum) {
357: if { [lsearch -glob $text *$id*] != -1 } {
358: lappend result $id
359: }
360: }
361: }
362: return $result
363: }
364:
365: proc subjFindIds3 {} {
366: global gSubj
367:
368: set text [string toupper [$gSubj(response) get 0.0 end]]
369: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
370: set result ""
371: foreach word $text {
372: if { [lsearch -exact $gSubj(allstunum) $word] != -1 } {
373: lappend result $word
374: }
375: }
376: return $result
377: }
378:
379: proc subjFindIds4 {} {
380: global gSubj
381:
382: set text [string toupper [$gSubj(response) get 0.0 end]]
383: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
384: set result ""
385: foreach id $gSubj(allstunum) {
386: if { [lsearch -exact $text $id] != -1 } {
387: lappend result $id
388: }
389: }
390: return $result
391: }
392:
393: proc subjFindId {} {
394: global gSubj
395: puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
396: subjPicts
397: }
398:
399: proc subjFindIds {} {
400: global gSubj
401: # puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
402: subjInsertIds [set ids [subjFindIds4]]
403: # puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]"
404: # puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]"
405: # puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]"
406:
407: }
408:
409: proc subjFindName {} {
410: global gSubj
411:
412: if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} {
413: set text [string toupper [$gSubj(response) get 0.0 end]]
414: }
415: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
416: set result ""
417: set length [llength $gSubj(allname)]
418: foreach word $text {
419: if { [string length $word] == 0 } { continue }
420: for { set i 0 } { $i < $length } { incr i } {
421: set name [string toupper [lindex $gSubj(allname) $i]]
422: if { [set find [lsearch -glob $name *$word*]] != -1 } {
423: lappend result $i
424: }
425: }
426: }
427: set result [lunique $result]
428: foreach index $result {
429: lappend temp [list [lindex $gSubj(allstunum) $index] \
430: [lindex $gSubj(allname) $index]]
431: }
432: if {[catch {set temp [lsort $temp]}]} {
433: displayMessage "No Student found."
434: return
435: }
436: set selected [multipleChoice {} "Select which student you want." $temp 1]
437: if {$selected == ""} { return }
438: set done 0
439: if { [llength $selected] == 2 } {
440: if { [lindex [lindex $selected 0] 0] == "" } {
441: set selected [lindex $selected 0]
442: set done 1
443: }
444: }
445: if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } }
446: subjInsertIds $idlist
447: subjPicts
448: }
449:
450: proc subjGetNameFromId { id } {
451: global gSubj
452: return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]]
453: }
454:
455: proc subjGetIdList {} {
456: global gSubj
457: set list [$gSubj(idlist) get 0 end]
458: set id ""
459: foreach element $list {
460: append id "[lindex $element 0] "
461: }
462: return $id
463: }
464:
465: proc subjInsertIds { selected } {
466: global gSubj
467: set current [subjGetIdList]
468: foreach person $selected {lappend current [lindex $person 0]}
469: set current [lsort [lunique $current]]
470: $gSubj(idlist) delete 0 end
471: foreach id $current {
472: $gSubj(idlist) insert end "$id [subjGetNameFromId $id]"
473: }
474: }
475:
476: proc subjDeleteId {} {
477: global gSubj
478: $gSubj(idlist) delete [$gSubj(idlist) curselection]
479: subjPicts
480: }
481:
482: proc subjAddId {} {
483: global gSubj
484: getOneStudent {} $gSubj(dir) id name
485: if { $id == "" } { return }
486: subjInsertIds $id
487: }
488:
489: proc subjPrev {} {
490: global gSubj
491: if { $gSubj(current) > 0 } {
492: incr gSubj(current) -2
493: subjNext
494: }
495: }
496:
497: proc subjMessage { mesg {tag normal} } {
498: global gSubj
499: displayMessage $message
500: # $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
501: # $gSubj(msg) see end
502: }
503:
504: proc subjAddPict { id } {
505: global gSubj
506: set gif [file join $gSubj(dir) photo gif $id.gif]
507: if { ![file exists $gif] } { return }
508: lappend gSubj(imagelist) [set image [image create photo]]
509: $image read $gif
510: set a [llength $gSubj(imagelist)]
511: $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw
512: $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw
513: $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \
514: -anchor nw
515: $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200"
516: update idletasks
517: return $a
518: }
519:
520: proc subjConvertPict { id } {
521: global gSubj
522: set gif [file join $gSubj(dir) photo gif $id.gif]
523: set jpg [file join $gSubj(dir) photo jpg $id.jpg]
524: if { ![file exists $gif] } {
525: if { [file exists $jpg] } {
526: exec djpeg -outfile $gif $jpg
527: }
528: }
529: }
530:
531: proc subjPicts {} {
532: global gSubj
533:
534: $gSubj(canvas) delete all
535: catch { foreach image $gSubj(imagelist) { catch {image delete $image} } }
536: set gSubj(imagelist) ""
537: set idlist [subjGetIdList]
538: foreach id $idlist {
539: subjConvertPict $id
540: set num [subjAddPict $id]
541: }
542: }
543:
544: proc subjPict {} {
545: global gSubj
546: if { $gSubj(pict) } {
547: pack $gSubj(pictFrame)
548: pack configure $gSubj(pictFrame) -fill x
549: } else {
550: pack forget $gSubj(pictFrame)
551: }
552: }
553:
554: proc subjPrint {} {
555: global gSubj
556: set lprCommand [getLprCommand quiztemp.txt]
557: if {$lprCommand == "Cancel"} { return }
558:
559: set fileId [open "quiztemp.txt" w]
560: set subid [lindex $gSubj(stunums) $gSubj(current)]
561: if { $subid != "" } {
562: set file [file join $gSubj(dir) records set$gSubj(set) \
563: problem$gSubj(quest) $subid]
564: puts $fileId "Submitted at [clock format [file mtime $file ]]"
565: puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)"
566: }
567: if { [llength [subjGetIdList]] > 1 } {
568: puts $fileId "Additional Authors:"
569: foreach id [subjGetIdList] {
570: if { $id == $subid } { continue }
571: puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)"
572: }
573: }
574: puts $fileId ""
575: puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]"
576: close $fileId
577:
578: set errorMsg ""
579: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
580:
581: if { $error == 1 } {
582: displayError "An error occurred while printing: $errorMsg"
583: } else {
584: displayMessage "Print job sent to the printer.\n $output"
585: }
586: exec rm -f quiztemp.txt
587: }
588:
589: proc subjGoto {} {
590: global gSubj
591: subjGetOneStudent {} $gSubj(dir) id name
592: if { $id == "" } { return }
593: if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } {
594: set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1]
595: subjNext
596: } else {
597: displayMessage "Student $id did not submit an answer."
598: }
599: }
600:
601: proc subjGetUngraded {} {
602: global gSubj
603:
604: set idlist ""
605: foreach stunum $gSubj(stunums) {
606: if {[catch {set gSubj(done.$stunum.score)}]} {
607: lappend idlist $stunum
608: }
609: }
610: return [multipleChoice {} "Select which student you want to grade." $idlist 1]
611: }
612:
613: proc subjGetOneStudent { window path idVar nameVar {message "" } } {
614: upvar $idVar id
615: upvar $nameVar name
616:
617: set select [tk_dialog $window.dialog "$message Student select method" \
618: "Select student by:" "" "" "Student Number" \
619: "Student Name" "Not Yet Graded" "Cancel"]
620: if { $select == 3 } {
621: set id ""
622: set name ""
623: return
624: }
625: if { $select == 2 } {
626: set id [subjGetUngraded]
627: set name [subjGetNameFromId $id]
628: return
629: }
630: set done 0
631: while { ! $done } {
632: if { $select } { set search "name" } { set search "number" }
633: set pattern [ getString $window "$message Please enter a student $search." ]
634: if {$pattern == "" } {
635: set done 1
636: set id ""
637: set name ""
638: continue
639: }
640: if { $select } {
641: set matched_entries [findByStudentName $pattern $path]
642: } else {
643: set matched_entries [findByStudentNumber $pattern $path]
644: }
645: if { [llength $matched_entries] == 0 } {
646: displayMessage "No student found. Please re-enter student $search."
647: } elseif { [llength $matched_entries] == 1 } {
648: set id [lindex [lindex $matched_entries 0] 0]
649: set name [lindex [lindex $matched_entries 0] 1]
650: set done 1
651: } elseif { [llength $matched_entries] < 30 } {
652: set select [ multipleChoice $window \
653: "Matched Student Records, Select one" \
654: $matched_entries ]
655: if { $select == "" } {
656: set id ""; set name ""
657: return
658: }
659: set id [lindex $select 0]
660: set name [lindex $select 1]
661: set done 1
662: } else {
663: displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
664: }
665: }
666: }
667:
668: ###########################################################
669: # subjSendResponse
670: ###########################################################
671: ###########################################################
672: ###########################################################
673: proc subjSendResponse {} {
674: global gSubj
675: }
676:
677: proc subjIndexResponse {} {
678: global gSubj
679:
680: $gSubj(response) delete 0 end
681:
682: set i 0
683: foreach element [lsort -dictionary [array names gSubj "response.*"]] {
684: set head [string range $gSubj($element) 0 30]
685: $gSubj(response) insert end "[incr i]. $head"
686: }
687: }
688:
689: ###########################################################
690: # subjSaveResponse
691: ###########################################################
692: ###########################################################
693: ###########################################################
694: proc subjSaveResponse {} {
695: global gSubj
696:
697: set num [incr gSubj(numresponse)]
698: set gSubj(response.$num) [$gSubj(responseEdit) get 0.0 end]
699: subjIndexResponse
700: }
701:
702: ###########################################################
703: # subjNewResponse
704: ###########################################################
705: ###########################################################
706: ###########################################################
707: proc subjNewResponse {} {
708: global gSubj gWindowMenu
709:
710: if { [winfo exists .addresponse] } {
711: capaRaise .addresponse
712: return
713: }
714: set response [toplevel .addresponse]
715: $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response"
716: wm title $response "Adding a New Response"
717:
718: set textFrame [frame $response.text]
719: set buttonFrame [frame $response.button]
720:
721: set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \
722: "$textFrame.scroll set" -wrap char -height 15]
723: scrollbar $textFrame.scroll -command "$textFrame.text yview"
724: pack $textFrame.scroll $textFrame.text -side left -expand 1
725:
726: button $buttonFrame.save -text Save -command "subjSaveResponse"
727: button $buttonFrame.forget -text Cancel -command "destroy $response"
728: pack $buttonFrame.save $buttonFrame.forget -side left
729: }
730:
731: ###########################################################
732: # subjDeleteResponse
733: ###########################################################
734: ###########################################################
735: ###########################################################
736: proc subjDeleteResponse {} {
737: global gSubj
738: }
739:
740: ###########################################################
741: # subjEditResponse
742: ###########################################################
743: ###########################################################
744: ###########################################################
745: proc subjEditResponse {} {
746: global gSubj
747: }
748:
749: ###########################################################
750: # subjViewResponse
751: ###########################################################
752: ###########################################################
753: ###########################################################
754: proc subjViewResponse {} {
755: global gSubj
756: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to gradesubjective.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools