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