Annotation of capa/capa51/GUITools/gradesubjective.tcl, revision 1.5
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.4 albertel 55: scrollbar $msglist.scroll -command "$msglist.list 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"
1.5 ! albertel 91: wm protocol $scoreandcom WM_DELETE_WINDOW "subjDone"
1.1 albertel 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:
1.5 ! albertel 210: proc checkGSubj {} {
! 211: global gSubj
! 212: if {[catch {set gSubj(stunums)}]} {
! 213: cd [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
! 214: set gSubj(stunums) [lsort -dictionary [glob *]]
! 215: if { [set num [lsearch $gSubj(stunums) gradingstatus]] != -1} {
! 216: set gSubj(stunums) [lreplace $gSubj(stunums) $num $num]
! 217: }
! 218: cd $gSubj(dir)
! 219: }
! 220: if {[catch {set gSubj(current)}]} {set gSubj(current) -1}
! 221: if {[catch {set gSubj(totalsec)}]} {set gSubj(totalsec) 0}
! 222: if {[catch {set gSubj(seconds)}]} {set gSubj(seconds) [clock seconds]}
! 223: if {[catch {set gSubj(togo)}]} {set gSubj(togo) [llength $gSubj(stunums)]}
! 224: if {[catch {set gSubj(allstunum)}] ||
! 225: [catch {set gSubj(allname)}] ||
! 226: [catch {set gSubj(allemail)}] } {
! 227: subjInitAllLists
! 228: }
! 229: }
! 230:
1.1 albertel 231: proc subjRestore {} {
232: global gSubj
233: source gradingstatus
234: subjCheckForNew
235: set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
236: cd $gSubj(dir)
1.5 ! albertel 237: if { [catch {incr gSubj(current) -1}]} { set gSubj(current) -1 }
1.4 albertel 238: if { $gSubj(redoalllists) } { subjInitAllLists; set gSubj(redoalllists) 0 }
1.5 ! albertel 239: checkGSubj
1.4 albertel 240: subjIndexResponse
1.1 albertel 241: subjNext
242: }
243:
244: proc subjSave {} {
245: global gSubj
246: set file [file join $gSubj(dir) records set$gSubj(set) \
247: problem$gSubj(quest) gradingstatus]
248: set fileId [open $file w]
1.4 albertel 249: puts $fileId "array set gSubj \{[array get gSubj]\}"
1.1 albertel 250: close $fileId
251: }
252:
253: proc subjDone {} {
254: global gSubj
1.5 ! albertel 255: if { [catch {subjSave}] } {
! 256: displayMessage "Unable to save."
! 257: }
1.1 albertel 258: unset gSubj
259: destroy .gradesubjective
260: }
261:
1.4 albertel 262: proc subjInitAllLists {} {
263: global gSubj
264: set i 0
265: catch {unset gSubj(allstunum)}
266: catch {unset gSubj(allname)}
267: catch {unset gSubj(allemail)}
268: set fileId [open classl r]
269: while { 1 } {
270: incr i
271: set aline [gets $fileId]
272: if { [eof $fileId]} {break}
273: lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
274: #lappend gSubj(allname) [string toupper [string range $aline 24 59]]
275: lappend gSubj(allname) [string range $aline 24 59]
276: lappend gSubj(allemail) [string range $aline 60 99]
277: }
278: }
279:
1.1 albertel 280: proc subjInit {} {
281: global gSubj
282:
283: set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
284: cd $dir
1.4 albertel 285: set gSubj(redoalllists) 0
1.1 albertel 286: if { [file exists gradingstatus] } { subjRestore } else {
287: set gSubj(stunums) [lsort -dictionary [glob *]]
288: cd $gSubj(dir)
289: set gSubj(current) -1
290: set gSubj(totalsec) 0
291: set gSubj(seconds) [clock seconds]
1.4 albertel 292: subjInitAllLists
1.1 albertel 293: set gSubj(togo) [llength $gSubj(stunums)]
294: subjNext
295: }
296: after 300 updateSecCount
297: }
298:
299: #FIXME check Ids when adding them to the list of ids
300: proc checkId { id } {
301: global gSubj
302: set score [getScore $gSubj(set) $gSubj(quest) $id]
303: if { $score == "-" || $score == "0" } { return 1 }
304: return 0
305: }
306:
307: proc subjPause {} {
308: global gSubj
309: if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] }
310: }
311:
312: proc subjStatusUpdate {} {
313: global gSubj
314:
315: set gSubj(done) [llength [array names gSubj "done.*.score"]]
316: set total [llength $gSubj(stunums)]
317: set gSubj(togo) [expr $total-$gSubj(done)]
318: incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}]
319: set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]]
320: # puts $gSubj(avgsec)
321: set gSubj(seconds) [clock seconds]
322: }
323:
324: proc subjSet {} {
325: global gSubj
326:
327: # if {$gSubj(togo) == 0} { return }
328: if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return }
329: set idlist [subjGetIdList]
330: foreach id $idlist {
331: setScore $gSubj(set) $gSubj(quest) $id $gSubj(score)
332: }
333: set id [lindex $gSubj(stunums) $gSubj(current)]
334: set gSubj(done.$id.idlist) $idlist
335: set gSubj(done.$id.score) $gSubj(score)
336: set gSubj(donestat) 1
337: subjStatusUpdate
338: subjSave
339: }
340:
341: proc subjNext {} {
342: global gSubj
343:
344: set gSubj(score) ""
345: set gSubj(pict) 0
346: subjPict
347: incr gSubj(current)
348: if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 }
349: set id [lindex $gSubj(stunums) $gSubj(current)]
350:
351: $gSubj(response) delete 0.0 end
352: $gSubj(idlist) delete 0 end
353:
354: if { $id != "" } {
355: set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id]
356: set fileId [open $file "r"]
357: $gSubj(response) insert 0.0 [read $fileId [file size $file]]
358: close $fileId
359: subjInsertIds $id
360: }
361:
1.3 albertel 362: append words [string trim [$gSubj(response) get 0.0 end-1c]] " "
363: set ws [format " \t\n"]
364: set gSubj(numwords) [regsub -all -- \[$ws\]+ $words {} b]
1.1 albertel 365: wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id"
366: if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } {
367: set gSubj(score) ""
368: set gSubj(donestat) 0
369: update idletasks
370: subjFindIds
371: } else {
372: set gSubj(donestat) 1
373: subjInsertIds $gSubj(done.$id.idlist)
374: update idletasks
375: }
376: subjPicts
377: }
378:
379: proc subjFindIds1 {} {
380: global gSubj
381:
382: set text [$gSubj(response) get 0.0 end]
383: set result ""
384: foreach id $gSubj(allstunum) {
385: if { [regexp -nocase -- $id $text] } {
386: lappend result $id
387: }
388: }
389: return $result
390: }
391:
392: proc subjFindIds2 {} {
393: global gSubj
394:
395: set text [string toupper [$gSubj(response) get 0.0 end]]
396: set result ""
397: if { [catch {lsearch $text a}] } {
398: puts badlist; return subjFindIds1
399: } else {
400: foreach id $gSubj(allstunum) {
401: if { [lsearch -glob $text *$id*] != -1 } {
402: lappend result $id
403: }
404: }
405: }
406: return $result
407: }
408:
409: proc subjFindIds3 {} {
410: global gSubj
411:
412: set text [string toupper [$gSubj(response) get 0.0 end]]
413: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
414: set result ""
415: foreach word $text {
416: if { [lsearch -exact $gSubj(allstunum) $word] != -1 } {
417: lappend result $word
418: }
419: }
420: return $result
421: }
422:
423: proc subjFindIds4 {} {
424: global gSubj
425:
426: set text [string toupper [$gSubj(response) get 0.0 end]]
427: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
428: set result ""
429: foreach id $gSubj(allstunum) {
430: if { [lsearch -exact $text $id] != -1 } {
431: lappend result $id
432: }
433: }
434: return $result
435: }
436:
437: proc subjFindId {} {
438: global gSubj
439: puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
440: subjPicts
441: }
442:
443: proc subjFindIds {} {
444: global gSubj
445: # puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
446: subjInsertIds [set ids [subjFindIds4]]
447: # puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]"
448: # puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]"
449: # puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]"
450:
451: }
452:
453: proc subjFindName {} {
454: global gSubj
455:
456: if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} {
457: set text [string toupper [$gSubj(response) get 0.0 end]]
458: }
459: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
460: set result ""
461: set length [llength $gSubj(allname)]
462: foreach word $text {
463: if { [string length $word] == 0 } { continue }
464: for { set i 0 } { $i < $length } { incr i } {
465: set name [string toupper [lindex $gSubj(allname) $i]]
466: if { [set find [lsearch -glob $name *$word*]] != -1 } {
467: lappend result $i
468: }
469: }
470: }
471: set result [lunique $result]
472: foreach index $result {
473: lappend temp [list [lindex $gSubj(allstunum) $index] \
474: [lindex $gSubj(allname) $index]]
475: }
476: if {[catch {set temp [lsort $temp]}]} {
477: displayMessage "No Student found."
478: return
479: }
480: set selected [multipleChoice {} "Select which student you want." $temp 1]
481: if {$selected == ""} { return }
482: set done 0
483: if { [llength $selected] == 2 } {
484: if { [lindex [lindex $selected 0] 0] == "" } {
485: set selected [lindex $selected 0]
486: set done 1
487: }
488: }
489: if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } }
490: subjInsertIds $idlist
491: subjPicts
492: }
493:
494: proc subjGetNameFromId { id } {
495: global gSubj
496: return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]]
497: }
498:
499: proc subjGetIdList {} {
500: global gSubj
501: set list [$gSubj(idlist) get 0 end]
502: set id ""
503: foreach element $list {
504: append id "[lindex $element 0] "
505: }
506: return $id
507: }
508:
509: proc subjInsertIds { selected } {
510: global gSubj
511: set current [subjGetIdList]
512: foreach person $selected {lappend current [lindex $person 0]}
513: set current [lsort [lunique $current]]
514: $gSubj(idlist) delete 0 end
515: foreach id $current {
516: $gSubj(idlist) insert end "$id [subjGetNameFromId $id]"
517: }
518: }
519:
520: proc subjDeleteId {} {
521: global gSubj
522: $gSubj(idlist) delete [$gSubj(idlist) curselection]
523: subjPicts
524: }
525:
526: proc subjAddId {} {
527: global gSubj
528: getOneStudent {} $gSubj(dir) id name
529: if { $id == "" } { return }
530: subjInsertIds $id
531: }
532:
533: proc subjPrev {} {
534: global gSubj
535: if { $gSubj(current) > 0 } {
536: incr gSubj(current) -2
537: subjNext
538: }
539: }
540:
541: proc subjMessage { mesg {tag normal} } {
542: global gSubj
1.5 ! albertel 543: displayMessage $mesg
1.1 albertel 544: # $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
545: # $gSubj(msg) see end
546: }
547:
548: proc subjAddPict { id } {
549: global gSubj
550: set gif [file join $gSubj(dir) photo gif $id.gif]
551: if { ![file exists $gif] } { return }
552: lappend gSubj(imagelist) [set image [image create photo]]
553: $image read $gif
554: set a [llength $gSubj(imagelist)]
555: $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw
556: $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw
557: $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \
558: -anchor nw
559: $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200"
560: update idletasks
561: return $a
562: }
563:
564: proc subjConvertPict { id } {
565: global gSubj
566: set gif [file join $gSubj(dir) photo gif $id.gif]
567: set jpg [file join $gSubj(dir) photo jpg $id.jpg]
568: if { ![file exists $gif] } {
569: if { [file exists $jpg] } {
570: exec djpeg -outfile $gif $jpg
571: }
572: }
573: }
574:
575: proc subjPicts {} {
576: global gSubj
577:
578: $gSubj(canvas) delete all
579: catch { foreach image $gSubj(imagelist) { catch {image delete $image} } }
580: set gSubj(imagelist) ""
581: set idlist [subjGetIdList]
582: foreach id $idlist {
583: subjConvertPict $id
584: set num [subjAddPict $id]
585: }
586: }
587:
588: proc subjPict {} {
589: global gSubj
590: if { $gSubj(pict) } {
591: pack $gSubj(pictFrame)
592: pack configure $gSubj(pictFrame) -fill x
593: } else {
594: pack forget $gSubj(pictFrame)
595: }
596: }
597:
598: proc subjPrint {} {
599: global gSubj
600: set lprCommand [getLprCommand quiztemp.txt]
601: if {$lprCommand == "Cancel"} { return }
602:
603: set fileId [open "quiztemp.txt" w]
604: set subid [lindex $gSubj(stunums) $gSubj(current)]
605: if { $subid != "" } {
606: set file [file join $gSubj(dir) records set$gSubj(set) \
607: problem$gSubj(quest) $subid]
608: puts $fileId "Submitted at [clock format [file mtime $file ]]"
609: puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)"
610: }
611: if { [llength [subjGetIdList]] > 1 } {
612: puts $fileId "Additional Authors:"
613: foreach id [subjGetIdList] {
614: if { $id == $subid } { continue }
615: puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)"
616: }
617: }
618: puts $fileId ""
619: puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]"
620: close $fileId
621:
622: set errorMsg ""
623: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
624:
625: if { $error == 1 } {
626: displayError "An error occurred while printing: $errorMsg"
627: } else {
628: displayMessage "Print job sent to the printer.\n $output"
629: }
630: exec rm -f quiztemp.txt
631: }
632:
633: proc subjGoto {} {
634: global gSubj
635: subjGetOneStudent {} $gSubj(dir) id name
636: if { $id == "" } { return }
637: if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } {
638: set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1]
639: subjNext
640: } else {
641: displayMessage "Student $id did not submit an answer."
642: }
643: }
644:
645: proc subjGetUngraded {} {
646: global gSubj
647:
648: set idlist ""
649: foreach stunum $gSubj(stunums) {
650: if {[catch {set gSubj(done.$stunum.score)}]} {
651: lappend idlist $stunum
652: }
653: }
654: return [multipleChoice {} "Select which student you want to grade." $idlist 1]
655: }
656:
657: proc subjGetOneStudent { window path idVar nameVar {message "" } } {
658: upvar $idVar id
659: upvar $nameVar name
660:
661: set select [tk_dialog $window.dialog "$message Student select method" \
662: "Select student by:" "" "" "Student Number" \
663: "Student Name" "Not Yet Graded" "Cancel"]
664: if { $select == 3 } {
665: set id ""
666: set name ""
667: return
668: }
669: if { $select == 2 } {
670: set id [subjGetUngraded]
671: set name [subjGetNameFromId $id]
672: return
673: }
674: set done 0
675: while { ! $done } {
676: if { $select } { set search "name" } { set search "number" }
677: set pattern [ getString $window "$message Please enter a student $search." ]
678: if {$pattern == "" } {
679: set done 1
680: set id ""
681: set name ""
682: continue
683: }
684: if { $select } {
685: set matched_entries [findByStudentName $pattern $path]
686: } else {
687: set matched_entries [findByStudentNumber $pattern $path]
688: }
689: if { [llength $matched_entries] == 0 } {
690: displayMessage "No student found. Please re-enter student $search."
691: } elseif { [llength $matched_entries] == 1 } {
692: set id [lindex [lindex $matched_entries 0] 0]
693: set name [lindex [lindex $matched_entries 0] 1]
694: set done 1
695: } elseif { [llength $matched_entries] < 30 } {
696: set select [ multipleChoice $window \
697: "Matched Student Records, Select one" \
698: $matched_entries ]
699: if { $select == "" } {
700: set id ""; set name ""
701: return
702: }
703: set id [lindex $select 0]
704: set name [lindex $select 1]
705: set done 1
706: } else {
707: displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
708: }
709: }
710: }
711:
712: ###########################################################
713: # subjSendResponse
714: ###########################################################
715: ###########################################################
716: ###########################################################
717: proc subjSendResponse {} {
718: global gSubj
1.4 albertel 719:
720: if { "" == [set which [$gSubj(responseList) curselection]]} {
721: displayMessage "Please select a message to send."
722: return
723: }
724: incr which
1.5 ! albertel 725:
! 726: set message ""
1.4 albertel 727:
728: set stuList [$gSubj(idlist) get 0 end]
729: foreach stu $stuList {
730: set stu [lindex $stu 0]
731: set index [lsearch $gSubj(allstunum) $stu]
732: set name [lindex $gSubj(allname) $index]
733: set email [lindex $gSubj(allemail) $index]
734: puts "$name:[split $name ,]:[lindex [split $name ,] 1]:[lindex [lindex [split $name ,] 1] 0]:$index:$stu"
735: puts [lsearch $gSubj(allemail) albertel@pilot.msu.edu]
736: set first_name [lindex [lindex [split $name ,] 1] 0]
737: set last_name [lindex [split $name , ] 0]
738: set score $gSubj(score)
739: regsub -all -- \\\$last_name $gSubj(response.$which) $last_name message
740: regsub -all -- \\\$first_name $message $first_name message
741: regsub -all -- \\\$score $message $score message
742: # set message [subst -nobackslashes -nocommands $gSubj(response.$which)]
743: if { [regexp -- (^Subject:\[^\n\]*)(\n)(.*) $message matchvar subjline newline messagebody] } {
744: set message "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$messagebody"
745: } else {
746: set message "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$message"
747: }
748: displayMessage "$message sent to $email"
749: exec echo $message | mail $email
750: }
1.1 albertel 751: }
752:
1.2 albertel 753: ###########################################################
754: # subjIndexResponse
755: ###########################################################
756: ###########################################################
757: ###########################################################
1.1 albertel 758: proc subjIndexResponse {} {
759: global gSubj
760:
1.2 albertel 761: $gSubj(responseList) delete 0 end
1.1 albertel 762:
763: set i 0
764: foreach element [lsort -dictionary [array names gSubj "response.*"]] {
1.4 albertel 765: regsub -all -- "\[\n\r\t\]+" [string range $gSubj($element) 0 37] " " head
766: $gSubj(responseList) insert end "[incr i].$head"
1.1 albertel 767: }
768: }
769:
770: ###########################################################
771: # subjSaveResponse
772: ###########################################################
773: ###########################################################
774: ###########################################################
775: proc subjSaveResponse {} {
776: global gSubj
777:
778: set num [incr gSubj(numresponse)]
1.4 albertel 779: set gSubj(response.$num) [$gSubj(responseNew) get 0.0 end-1c]
780: destroy [winfo toplevel $gSubj(responseNew)]
1.1 albertel 781: subjIndexResponse
1.4 albertel 782: $gSubj(responseList) selection set end
783: $gSubj(responseList) see end
1.1 albertel 784: }
785:
786: ###########################################################
787: # subjNewResponse
788: ###########################################################
789: ###########################################################
790: ###########################################################
791: proc subjNewResponse {} {
792: global gSubj gWindowMenu
793:
794: if { [winfo exists .addresponse] } {
795: capaRaise .addresponse
796: return
797: }
798: set response [toplevel .addresponse]
799: $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response"
800: wm title $response "Adding a New Response"
801:
802: set textFrame [frame $response.text]
803: set buttonFrame [frame $response.button]
1.2 albertel 804: pack $textFrame $buttonFrame
1.1 albertel 805:
1.4 albertel 806: set gSubj(responseNew) [text $textFrame.text -yscrollcommand \
1.1 albertel 807: "$textFrame.scroll set" -wrap char -height 15]
808: scrollbar $textFrame.scroll -command "$textFrame.text yview"
1.2 albertel 809: pack $textFrame.text $textFrame.scroll -side left -expand 1
810: pack configure $textFrame.scroll -fill y
1.1 albertel 811:
812: button $buttonFrame.save -text Save -command "subjSaveResponse"
813: button $buttonFrame.forget -text Cancel -command "destroy $response"
814: pack $buttonFrame.save $buttonFrame.forget -side left
815: }
816:
817: ###########################################################
818: # subjDeleteResponse
819: ###########################################################
820: ###########################################################
821: ###########################################################
822: proc subjDeleteResponse {} {
823: global gSubj
1.4 albertel 824: if { [winfo exists .editresponse] } {
825: displayMessage "Please finish with editing the response, before deleting responses."
826: return
827: }
828: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
829: incr which
830: if { [catch {unset gSubj(response.$which)}] } {
831: puts [array names gSubj response.*]
832: return
833: }
834: for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {
835: set j [expr $i - 1]
836: set gSubj(response.$j) $gSubj(response.$i)
837: unset gSubj(response.$i)
838: }
839: set gSubj(numresponse) [expr $i - 2]
840: subjIndexResponse
841: $gSubj(responseList) see [incr which -2]
1.1 albertel 842: }
843:
844: ###########################################################
845: # subjEditResponse
846: ###########################################################
847: ###########################################################
848: ###########################################################
849: proc subjEditResponse {} {
1.4 albertel 850: global gSubj gWindowMenu
851:
852: if { [winfo exists .editresponse] } { capaRaise .editresponse ; return }
853: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
854: incr which
855:
856: set response [toplevel .editresponse ]
857: $gWindowMenu add command -label "EditingResponse" -command "capaRaise $response"
858: wm title $response "Editing a Response"
859:
860: set textFrame [frame $response.text]
861: set buttonFrame [frame $response.button]
862: pack $textFrame $buttonFrame
863:
864: set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \
865: "$textFrame.scroll set" -wrap char -height 15]
866: scrollbar $textFrame.scroll -command "$textFrame.text yview"
867: pack $textFrame.text $textFrame.scroll -side left -expand 1
868: pack configure $textFrame.scroll -fill y
869: $gSubj(responseEdit) insert 0.0 $gSubj(response.$which)
870:
871: set gSubj(editresponsedone) 0
872: button $buttonFrame.save -text Save -command "set gSubj(editresponsedone) 1"
873: button $buttonFrame.forget -text Cancel -command "set gSubj(editresponsedone) 0"
874: pack $buttonFrame.save $buttonFrame.forget -side left
875: vwait gSubj(editresponsedone)
876: if { $gSubj(editresponsedone) } {
877: set gSubj(response.$which) [$gSubj(responseEdit) get 0.0 end-1c]
878: subjIndexResponse
879: $gSubj(responseList) selection set $which
880: $gSubj(responseList) see $which
881: }
882: destroy $response
1.1 albertel 883: }
884:
885: ###########################################################
886: # subjViewResponse
887: ###########################################################
888: ###########################################################
889: ###########################################################
890: proc subjViewResponse {} {
1.4 albertel 891: global gSubj gUniqueNumber gWindowMenu
892:
893: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
894: incr which
895: set num [incr gUniqueNumber]
896:
897: set response [toplevel .viewresponse$num ]
898: $gWindowMenu add command -label "ViewingResponse $which" \
899: -command "capaRaise $response"
900: wm title $response "Viewing Response $which"
901:
902: set textFrame [frame $response.text]
903: set buttonFrame [frame $response.button]
904: pack $textFrame $buttonFrame
905:
906: text $textFrame.text -yscrollcommand "$textFrame.scroll set" -wrap char -height 15
907: scrollbar $textFrame.scroll -command "$textFrame.text yview"
908: pack $textFrame.text $textFrame.scroll -side left -expand 1
909: pack configure $textFrame.scroll -fill y
910: $textFrame.text insert 0.0 $gSubj(response.$which)
911: $textFrame.text configure -state disabled
912:
913: button $buttonFrame.forget -text Dismiss -command "destroy $response"
914: pack $buttonFrame.forget -side left
1.1 albertel 915: }
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