Annotation of capa/capa51/GUITools/groupemail.tcl, revision 1.4
1.4 ! albertel 1: #Copyright 2000 by Guy Albertelli
1.1 albertel 2: proc runGroupEmail { capaConfigFile } {
1.2 albertel 3: global gUniqueNumber gFile gWindowMenu gCT
1.1 albertel 4: set num [incr gUniqueNumber]
5: set gFile($num) [file dirname $capaConfigFile]
6: parseCapaConfig $num $gFile($num)
7: parseCapaUtilsConfig $num $gFile($num)
8:
9: set emailwin [toplevel .email$num]
10: $gWindowMenu add command -label "Sending Email $gFile($num)" \
11: -command "capaRaise \"$emailwin\""
1.4 ! albertel 12: wm title $emailwin [file dirname $capaConfigFile]
1.2 albertel 13:
14: set fileFrame [frame $emailwin.file]
15: set sentFrame [frame $emailwin.sent]
16: set buttonFrame [frame $emailwin.button]
1.4 ! albertel 17: pack $fileFrame $sentFrame $buttonFrame -side top -anchor w
1.2 albertel 18:
19: label $fileFrame.label -text "Mail Template:"
20: entry $fileFrame.file -textvariable gCT($num.template)
21: button $fileFrame.select -text "Browse" \
1.4 ! albertel 22: -command "set gCT($num.template) \[tk_getOpenFile\]"
1.2 albertel 23: pack $fileFrame.label $fileFrame.file $fileFrame.select -side left
24:
25: label $sentFrame.text -text "Send To:"
26: set classFrame [frame $sentFrame.class]
27: set sectionFrame [frame $sentFrame.section]
28: set studentFrame [frame $sentFrame.student]
1.4 ! albertel 29: #unpacked
1.2 albertel 30: set scriptFrame [frame $sentFrame.script]
1.4 ! albertel 31: pack $sentFrame.text $classFrame $sectionFrame $studentFrame -side top -anchor w
1.2 albertel 32:
33: #class
34: radiobutton $classFrame.class -text "Whole Class" \
35: -variable gCT($num.emailtype) -value "Class"
36: pack $classFrame.class
37:
38: #sections
1.4 ! albertel 39: set gCT($num.emailsections) "None"
! 40: set top [frame $sectionFrame.top]
! 41: set bottom [frame $sectionFrame.bottom]
! 42: pack $top $bottom -side top -anchor w
! 43:
! 44: radiobutton $top.button -text "Sections" \
1.2 albertel 45: -variable gCT($num.emailtype) -value "Sections"
1.4 ! albertel 46: button $top.select -text "Select Section" -command "emailSelectSections $num"
! 47: message $bottom.sections -textvariable gCT($num.emailsections) \
! 48: -relief groove -width 350
! 49: frame $bottom.spacer -width 20
1.2 albertel 50:
1.4 ! albertel 51: pack $top.button $top.select -side left -anchor w
! 52: pack $bottom.spacer $bottom.sections -anchor w -side left
! 53:
1.2 albertel 54: #student
55: radiobutton $studentFrame.specific -text "Specify the student by:" \
56: -value "Specific" -variable gCT($num.emailtype)
57: set studentNumber [frame $studentFrame.studentNumber]
58: set fullName [frame $studentFrame.fullName]
59: pack $studentFrame.specific $studentNumber $fullName -side top
60: pack configure $studentFrame.specific -anchor w
61: pack configure $studentNumber $fullName -anchor e
62:
63: radiobutton $sectionFrame.section
64: label $studentNumber.msg -text "Student Number: "
65: entry $studentNumber.entry -textvariable gCT($num.studentNumber) \
66: -width 9 -validate key -validatecommand "limitEntry %W 9 any %P"
67: pack $studentNumber.msg $studentNumber.entry -side left
68:
69: label $fullName.msg -text "Student Name: "
70: entry $fullName.msg2 -textvariable gCT($num.studentName) -width 35 \
71: -validate key -validatecommand "limitEntry %W 35 any %P"
72: pack $fullName.msg $fullName.msg2 -side left
73:
74: trace variable gCT($num.studentNumber) w \
75: "global gCT; set gCT($num.emailtype) Specific ;#"
76: trace variable gCT($num.studentName) w \
77: "global gCT; set gCT($num.emailtype) Specific ;#"
78:
79: bind $studentNumber.entry <KeyPress-Return> \
80: "fillInStudent gCT($num.studentName) gCT($num.studentNumber) 0"
81: bind $fullName.msg2 <KeyPress-Return> \
82: "fillInStudent gCT($num.studentName) gCT($num.studentNumber) 1"
83:
84: #script
1.4 ! albertel 85: radiobutton $scriptFrame.label -text "Script Selection:" -value "Script" \
! 86: -variable gCT($num.emailtype)
! 87: entry $scriptFrame.file -textvariable gCT($num.emailscript)
1.2 albertel 88: button $scriptFrame.select -text "Browse" \
1.4 ! albertel 89: -command "set gCT($num.template) \[tk_getOpenFile\]"
1.2 albertel 90: pack $scriptFrame.label $scriptFrame.file $scriptFrame.select -side left
91:
92: button $buttonFrame.send -text "Send" -command "emailSend $num"
1.4 ! albertel 93: frame $buttonFrame.spacer -width 100
! 94: button $buttonFrame.cancel -text "Close" -command "emailClose $num"
! 95: pack $buttonFrame.send $buttonFrame.spacer $buttonFrame.cancel -side left
! 96: Centre_Dialog $emailwin default
! 97: }
! 98:
! 99: proc emailSelectSections { num } {
! 100: global gCT gFile
! 101: set pwd [pwd]; cd $gFile($num)
! 102: set gCT($num.emailsections) [string trim [pickSections [getExistingSections] "Select Sections to send an email to:"]]
! 103: cd $pwd
! 104: if { $gCT($num.emailsections) != "" } {
! 105: set gCT($num.emailtype) Sections
! 106: } else {
! 107: set gCT($num.emailsections) "None"
! 108: }
1.2 albertel 109: }
110:
111: proc emailSend { num } {
112: global gCT gFile
113:
1.4 ! albertel 114: if { [catch {set fileId [open $gCT($num.template) r]}]} {
! 115: displayMessage "Unable to open $gCT($num.template)"
! 116: return
! 117: }
! 118: set gCT($num.message) [read $fileId [file size $gCT($num.template)]]
! 119: close $fileId
! 120:
1.2 albertel 121: if { "Cancel" == [emailConfirm $num]} { return }
122: emailGetStudents $num
123:
1.4 ! albertel 124: set max [llength $gCT($num.studentlist)]
! 125: set i 0
! 126: displayStatus "Sending Messages" both $num
! 127: foreach student $gCT($num.studentlist) {
! 128: incr i
1.2 albertel 129: # foreach {email firstname lastname stunum} $student {break}
1.4 ! albertel 130: set message [emailMessage $num $student]
! 131: emailSendMessage $num $student $message
! 132: updateStatusBar [expr $i/double($max)] $num
1.2 albertel 133: }
1.4 ! albertel 134: removeStatus $num
! 135: }
! 136:
! 137: proc emailConfirm { num } {
! 138: global gCT
! 139: set msg "The message in $gCT($num.template) will be sent to"
! 140: switch $gCT($num.emailtype) {
! 141: Class { append msg " the whole class." }
! 142: Sections { append msg " the sections $gCT($num.emailsections)." }
! 143: Specific { append msg " to the students $gCT($num.emailstudents)." }
! 144: Script {
! 145: append msg " to the students generated by the script $gCT($num.emailscript)."
! 146: }
! 147: }
! 148: append msg "\n\n Continue?"
! 149: if { "Yes" == [makeSure $msg]} {
! 150: return "Yes"
! 151: }
! 152: return "Cancel"
1.3 albertel 153: }
154:
155: proc emailGetStudents { num } {
156: global gCT gFile
1.4 ! albertel 157:
! 158: switch $gCT($num.emailtype) {
1.3 albertel 159: Class { emailGetClass $num }
1.4 ! albertel 160: Sections { emailGetSections $num }
1.3 albertel 161: Specific { }
162: Script { }
163: }
164: }
165:
166: proc emailGetClass { num } {
167: global gCT gFile
168: set classlid [open [file join $gFile($num) classl] r]
1.4 ! albertel 169:
1.3 albertel 170: set aline [gets $classlid]
171: while { ![eof $classlid] } {
172: set email [string trim [string range $aline 60 99]]
173: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
174: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
175: set stunum [string trim [string range $aline 14 22]]
176: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum]
177: set aline [gets $classlid]
178: }
1.4 ! albertel 179: }
! 180:
! 181: proc emailGetSections { num } {
! 182: global gCT gFile
! 183: set classlid [open [file join $gFile($num) classl] r]
! 184:
! 185: set aline [gets $classlid]
! 186: while { ![eof $classlid] } {
! 187: set section [string trimleft [string trim [string range $aline 10 12]] "0"]
! 188: if { [lsearch $gCT($num.emailsections) $section] == -1 } {
! 189: set aline [gets $classlid]
! 190: continue
! 191: }
! 192: set email [string trim [string range $aline 60 99]]
! 193: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
! 194: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
! 195: set stunum [string trim [string range $aline 14 22]]
! 196: set section [string trimleft [string trim [string range $aline 10 12] ] 0]
! 197: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
! 198: set aline [gets $classlid]
! 199: }
! 200: }
! 201:
! 202: proc emailMessage { num student } {
! 203: global gCT gFile gCapaConfig
! 204: set message $gCT($num.message)
! 205:
! 206: regsub -all -- \\\$email $message [lindex $student 0] message
! 207: regsub -all -- \\\$first_name $message [lindex $student 1] message
! 208: regsub -all -- \\\$last_name $message [lindex $student 2] message
! 209: regsub -all -- \\\$student_number $message [lindex $student 3] message
! 210: set stunum [lindex $student 3]
! 211: set section [lindex $student 4]
! 212: while { [regexp {\$capaid\(([0-9all\.,]*)\)} $message match set] } {
! 213: set capaid [getCapaID $set $stunum $section $gFile($num)]
! 214: regsub -all -- \\\$capaid\\\($set\\\) $message $capaid message
! 215: }
! 216: while { [regexp {\$homework_score\(([0-9all\.,]*)\)} $message match set] } {
! 217: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
! 218: set max 99;set setmax 99
! 219: }
! 220: set scores [getScores $set $stunum $section $gFile($num) $max setmax]
! 221: regsub -all -- \\\$homework_score\\\($set\\\) $message $scores message
! 222: if { $set == "all" } {
! 223: set all(homework.score) $scores
! 224: set all(setmax.homework.score) $setmax
! 225: }
! 226: }
! 227: while { [regexp {\$homework_total\(([0-9all\.,]*)\)} $message match set] } {
! 228: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
! 229: set max 99;set setmax 99
! 230: }
! 231: set scores [getTotals $set $stunum $section $gFile($num) $max setmax]
! 232: regsub -all -- \\\$homework_total\\\($set\\\) $message $scores message
! 233: if { $set == "all" } {
! 234: set all(homework.total) $scores
! 235: set all(setmax.homework.total) $setmax
! 236: }
! 237: }
! 238: foreach {path limit} {quiz quiz_count supp none others none correction \
! 239: final_exam_set_number exam final_exam_set_number} {
! 240: if {[catch {set gCapaConfig($num.[set path]_path)}]} {
! 241: continue
! 242: } else {
! 243: if { ![file exists $gCapaConfig($num.[set path]_path)] } { continue }
! 244: }
! 245: if { [catch {set setmax [set max $gCapaConfig($num.$limit)]}]} {
! 246: set max 99 ; set setmax 99
! 247: }
! 248: foreach {type call} {score getScores total getTotals} {
! 249: set exp {\$};append exp $path;append exp _$type
! 250: append exp {\(([0-9all\.,]*)\)}
! 251: while { [regexp $exp $message match set]} {
! 252: set scores [$call $set $stunum $section \
! 253: $gCapaConfig($num.[set path]_path) $max setmax]
! 254: set replacexp {\$};append replacexp $path;append replacexp _$type
! 255: append replacexp {\(};append replacexp $set;append replacexp {\)}
! 256: regsub -all -- $replacexp $message $scores message
! 257: if { $set == "all" } {
! 258: set all($path.$type) $scores
! 259: set all(setmax.$path.$type) $setmax
! 260: }
! 261: }
! 262: }
! 263: }
! 264: if { [regexp {\$grade} $message match] } {
! 265: #homework
! 266: foreach {type func} {score getScores total getTotals} {
! 267: if { [catch {set all(homework.$type)}]} {
! 268: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
! 269: set max 99;set setmax 99
! 270: }
! 271: set all(homework.$type) [$func "all" $stunum $section $gFile($num) \
! 272: $max setmax]
! 273: # set all(setmax.homework.$type) $setmax
! 274: }
! 275: }
! 276: #quizzes
! 277: foreach {type func} {score getScores total getTotals} {
! 278: if { [catch {set all(quiz.$type)}]} {
! 279: if { [catch {set setmax [set max $gCapaConfig($num.quiz_count)]}]} {
! 280: set max 99;set setmax 99
! 281: }
! 282: set all(quiz.$type) [$func "all" $stunum $section \
! 283: $gCapaConfig($num.quiz_path) $max setmax]
! 284: # set all(setmax.quiz.$type) $setmax
! 285: }
! 286: }
! 287: #exams and final
! 288: if { [catch {set setmax [set max $gCapaConfig($num.final_exam_set_number)]}]} {
! 289: set max 99;set setmax 99
! 290: }
! 291: set finalset $setmax
! 292: set lastexam [expr $finalset - 1]
! 293: set totalexam 0
! 294: for { set i 1 } { $i <= $lastexam } { incr i } {
! 295: set exams [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
! 296: set examt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
! 297: set corrs [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
! 298: set corrt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
! 299: set exam [expr $exams/double($examt)]
! 300: set corr [expr $corrs/double($corrt)]
! 301: if { $corr > $exam } {
! 302: set totalexam [expr $totalexam + \
! 303: [expr $exam + $gCapaConfig($num.correction_weight) \
! 304: * ($corr - $exam)]]
! 305: } else {
! 306: set totalexam [expr $totalexam + $exam]
! 307: }
! 308: }
! 309: set totalexam [expr $totalexam / ($i-1)]
! 310: set finals [getScores $finalset $stunum $section $gCapaConfig($num.exam_path)]
! 311: set finalt [getTotals $finalset $stunum $section $gCapaConfig($num.exam_path)]
! 312: set final [expr $finals/double($finalt)]
! 313: set homework [expr $all(homework.score)/double($all(homework.total))]
! 314: set quiz [expr $all(quiz.score)/double($all(quiz.total))]
! 315: set grade [expr $gCapaConfig($num.homework_weight)*$homework +\
! 316: $gCapaConfig($num.quiz_weight)*$quiz +\
! 317: $gCapaConfig($num.exam_weight)*$totalexam +\
! 318: $gCapaConfig($num.final_weight)*$final]
! 319: set grade [format "%2.1f" [expr $grade * 100 ]]
! 320: regsub -all -- \\\$grade $message $grade message
! 321: }
! 322: return $message
! 323: }
! 324:
! 325: proc emailSendMessage { num student message } {
! 326: global gCT gCapaConfig
! 327: exec echo $message | $gCapaConfig($num.mail_command) [lindex $student 0]
! 328: }
! 329:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to groupemail.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools