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