#!/usr/local/bin/wish -f

# CSci 5199
# Eric D. Hendrickson
# Wed Feb  2 20:17:18 CST 1994

# TkClassmail

#
# To Do:
#         0.  put under RCS.
#         1.  if just one section, auto-select it.
#         2.  fix so that if title is missing, no harm is done.
#         3.  display mailing list address upon successful addition to lists.
#         4.  display currently subscribed lists, also at exit.
#         5.  embed instructions on how to create a .forward file (durfee).
#         6.  use ls(1) instead of glob to build deptdirs.
#         7.  say "Done" when through scanning alias files.
#         8.  delete
#         9.  no duplicates (gray out groups already signed up for)
#        10.  use TAB for first whitespace in log file
#

#
# configuration
#

if [info exists env(USER)] {
    set user(user) $env(USER);		# works on most systems
} elseif [info exists env(LOGNAME)] {
    set user(user) $env(LOGNAME);	# works on HP/UX
}

# location of mailing list file system
set home "/home/inst";

if {! [file isdirectory "$home"]} {
    puts stderr "location of mailing lists not found";
    exit 1;
}

# assumes all dept hierarchies begin with capital letters
set deptdirs [glob $home/\[A-Z\]*]; # e.g. /home/inst/CSci, /home/inst/Math

if {[llength "$deptdirs"] == 0} {
    puts stderr "no mailing list file system to be found";
    exit 1;
}

# choose your font(s)
set number "-adobe-helvetica-*-r-*-*-*-*-*-*-*-*-*-*";
#set italic "-b&h-lucidabright-demibold-i-*-*-*-*-*-*-*-*-*-*";
set italic "-adobe-new century schoolbook-bold-i-*-*-*-*-*-*-*-*-*-*";
set smallitalic "-adobe-new century schoolbook-bold-i-*-*-10-*-*-*-*-*-*-*";
#set letter "8x16";
set letter "-adobe-new century schoolbook-bold-r-*-*-*-*-*-*-*-*-*-*";

# other globals
#set dept "";			# array of departmental data (keep commented)
set depts "";			# list of departments (e.g. CSci, Math, EE...)
set maxcol 7;			# adjust for width, height of window
set maxday 0;			# most day sections in any one course
set maxext 0;			# most extension sections in any one course
set maxcourses 0;		# max courses in any one deptartment

set helplist {{Select The Department Your Course Is In.}
	      {Select Your Course ID.}
	      {Select Your Section #.}
	      {Now Add or Delete Yourself.}};

#
# procedures
#

# return greater of {a b}
proc max {a b} {
    return [expr {($a > $b) ? $a : $b}];
}

# return lesser of {a b}
proc min {a b} {
    return [expr {($a < $b) ? $a : $b}];
}

# create mailing list data structure
proc init_data {} {
    global dept deptdirs depts maxday maxext maxcourses;
    puts stderr "Scanning mailing lists data.  Please wait....";
    foreach dir "$deptdirs" {
	if [file isdirectory "$dir"] {
	    set ids "";
	    set name [file tail "$dir"];
	    set dept($name,dir) "$dir";
	    set dept($name,lcase) [string tolower "$name"];
	    set idpaths [glob "$dir/\[0-9\]*"];
	    foreach idpath "$idpaths" {
		if [file isdirectory "$idpath"] {
		    lappend ids [file tail "$idpath"];
		}
	    }
	    set dept($name,courses) "$ids";
	    set dept($name,ncourses) [llength $dept($name,courses)];
	    set maxcourses [max $dept($name,ncourses) $maxcourses];
	    lappend depts "$name";
	}
    }
    foreach name "$depts" {
	foreach class "$dept($name,courses)" {
	    set dept($name,$class,day) \
	      [llength [glob -nocomplain $dept($name,dir)/$class/day-*]];
	    set maxday [max $dept($name,$class,day) $maxday];
	    set dept($name,$class,ext) \
	      [llength [glob -nocomplain $dept($name,dir)/$class/ext-*]];
	    set maxext [max $dept($name,$class,ext) $maxext];
	    if [file readable "$dept($name,dir)/$class/title"] {
		set f [open "$dept($name,dir)/$class/title" r];
		gets $f dept($name,$class,title);
		close $f;	# there is a limit to concurrently open files
	    }
	}
	if [file readable "$dept($name,dir)/title"] {
	    set f [open "$dept($name,dir)/title" r];
	    gets $f dept($name,title);
	    close $f;	# there is a limit to concurrently open files
	}
    }
}

#
# mass (de)activate a list of buttons
#
proc masstoggle "buttons state" {
    global dept depts;
    foreach b "$buttons" {
	$b config -state $state;
	$b deselect;
    }
}

#
# dept buttons command, also used by add/delete buttons
#
proc deptcmd "d" {
    global dept depts helplist maxext varhelp user;
    masstoggle $dept(buttons) "disabled";
    masstoggle $dept(daysect) "disabled";
    if {$maxext > 0} {
	masstoggle $dept(extsect) "disabled";
    }
    if {$d == ""} {		# if called by add/delete
	foreach b "$dept(deptbuttons)" {
	    $b deselect;
	}
    } else {			# else called by a dept button
	masstoggle $dept($d,buttons) "normal";
	set varhelp [lindex $helplist 1];
    }
    globalcmd "disabled";	# disable add/delete buttons
    set user(dept) $d;
}

#
# list file operations
#
proc listops {w} {
    global dept home user varhelp;
    set mf "$dept($user(dept),dir)/$user(course)/$user(school)-$user(sect)";
    set l [open "$home/log" a+];
    puts $l "$user(user) $mf [exec date] tk";
    close $l;
    set f [open "$mf" a+];
    puts $f "$user(user)";
    close $f
    set varhelp \
      "You have been added to $user(dept) $user(course), section $user(sect).";
    destroy $w;
}

#
#
#
proc cancel {w} {
    global helplist varhelp;
    set varhelp [lindex $helplist 0];
    destroy $w;
}

#
# add/delete command (see p. 244)
#
proc deladd {which} {
    global letter smallitalic;
    toplevel .t;
    wm title .t "TkClassmail: Confirm";
    wm iconname .t "confirm";
    frame .t.top -relief raised -border 1;
    label .t.top.l -bitmap "questhead";
    pack .t.top.l -in .t.top -side left;
    message .t.top.m -text "Are you sure you want to $which?" \
      -justify center -font $letter -width 3i;
    pack .t.top.m -in .t.top -padx 5 -pady 5 -expand yes -fill both -side left;
    label .t.top.r -bitmap "warning";
    pack .t.top.r -in .t.top -side left;
    pack .t.top -in .t -fill both -expand yes;

    frame .t.bot -relief raised -border 1;
    button .t.bot.yes -text "Yes" -font $letter -width 8 \
      -command {listops .t};
    pack .t.bot.yes -in .t.bot -side left -padx 5 -pady 5;
    button .t.bot.cancel -text "Cancel" -font $letter -width 8 \
      -command {cancel .t};
    pack .t.bot.cancel -in .t.bot -side right -padx 5 -pady 5;
    pack .t.bot -in .t -fill both -expand yes;

    label .t.about -font $smallitalic \
      -text "TkClassmail by Eric Hendrickson <edh> for CS 5199, Winter 1994";
    pack .t.about -in .t -fill both -expand yes;
    tkwait window .t;

    deptcmd "";
}

#
# course buttons command
#
proc coursecmd "c nd ne" {
    global dept helplist maxext user varhelp;
    masstoggle $dept(daysect) "disabled";
    for {set d 0} {$d < $nd} {incr d} {
	lappend dlist [lindex $dept(daysect) $d];
    }
    masstoggle $dlist "normal";	# activate correct day sections
    if {$maxext > 0} {
	masstoggle $dept(extsect) "disabled";
	for {set e 0} {$e < $ne} {incr e} {
	    lappend elist [lindex $dept(extsect) $e];
	}
	masstoggle $elist "normal"; # activate correct ext sections
    }
    set varhelp [lindex $helplist 2];
    globalcmd "disabled";	# disable add/delete buttons
    set user(course) $c;
}

#
# create buttons for depts
#
proc deptbuttons "d fd" {
    global vard dept letter maxcourses;
    radiobutton $fd.b -text $d -font $letter -anchor w \
      -variable vard -value $d -width 6 -border 3 -command "deptcmd $d";
    pack $fd.b -in $fd -side left -fill both;
# MAJOR hack using tk_butEnter and tk_butLeave like this....
    bind $fd.b <Enter> "set vartitle {$dept($d,title)}; tk_butEnter %W";
    bind $fd.b <Leave> "set vartitle {}; tk_butLeave %W";
    lappend dept(deptbuttons) $fd.b;
    coursebuttons $d $fd;
}

#
# create course buttons for a dept
#
proc coursebuttons "d fd" {
    global dept maxcol number var$d vartitle;
    set n $dept($d,ncourses);
    set cols [min $maxcol $n];
    for {set c 0} {$c < $cols} {incr c} {
	frame $fd.$c;
    }
    set c 0;
    for {set i 0} {$i < $n} {incr i} {
	set class [lindex $dept($d,courses) $i];
	radiobutton $fd.$c.$class -text $class \
	  -font $number -width 5 -variable var$d \
	    -command \
	      "coursecmd $class $dept($d,$class,day) $dept($d,$class,ext)";
	pack $fd.$c.$class -in $fd.$c -side top;
# MAJOR hack using tk_butEnter and tk_butLeave like this....
	bind $fd.$c.$class <Enter> \
	  "set vartitle {$d $class:  $dept($d,$class,title)}; tk_butEnter %W"
	bind $fd.$c.$class <Leave> "set vartitle {}; tk_butLeave %W"
	lappend dept(buttons) $fd.$c.$class;
	lappend dept($d,buttons) $fd.$c.$class;
	incr c;
	if {$c == $maxcol} {
	    set c 0;
	}
    }
    for {set c 0} {$c < $cols} {incr c} {
	pack $fd.$c -in $fd -side left -anchor n;
    }
    masstoggle $dept(buttons) "disabled";
}

#
# toggle add/delete buttons
#
proc globalcmd "state" {
    global globalbuttons;
    foreach b "$globalbuttons" {
	if {$b == ".dcs.add"} {
	    $b config -state $state;
	}
    }
}

#
# section buttons operations
#
proc sectcmd {s school} {
    global helplist user varhelp;
    set varhelp [lindex $helplist 3];
    globalcmd "normal";		# enable add/delete buttons
    set user(sect) $s;
    set user(school) $school;
}

#
# create section buttons
#
proc sectbuttons "f max school" {
    global dept helplist number varhelp;
    set c 1;
    frame $f.$c;
    for {set s 1} {$s <= $max} {incr s} {
	radiobutton $f.$c.$s -text $s -font $number -width 2 -value $s \
	  -variable vars -anchor w -command "sectcmd $s $school";
	pack $f.$c.$s -in $f.$c -side "top" -fill x;
	lappend list $f.$c.$s;
	if {![expr $s % 10]} {
	    pack $f.$c -in $f -side "left" -anchor n;
	    incr c;
	    frame $f.$c;
	}
    }
    pack $f.$c -in $f -side "left" -anchor n;
    if {$school == "day"} {
	set dept(daysect) $list;
    } else {
	set dept(extsect) $list;
    }
    masstoggle $list "disabled";
}

#
# exit operations
#
proc quit {} {
#   puts stderr "Thank you for using the TkClassmail program!";
    exit;
}

#
# main
#

# main window configuration
wm geometry . "-10+10";
wm title . "TkClassmail";
. config -cursor "hand2 red white";
#wm iconbitmap . "@spiff.xbm";

init_data;

# for testing (does not work right)
#set maxext 4;

message .help -font $letter -text [lindex $helplist 0] -width 7i \
  -textvariable varhelp -relief sunken -fg firebrick1 -bg gainsboro;
pack .help -fill both;

frame .dcs;
frame .dcs.dc;
foreach d "$depts" {
    set name "$dept($d,lcase)";
    frame .dcs.dc.$name -relief groove -border 2;
    deptbuttons $d .dcs.dc.$name;
    pack .dcs.dc.$name -in .dcs.dc -side top -fill both;
}
pack .dcs.dc -in .dcs -side left;

frame .dcs.s;
label .dcs.s.label -text "sections" -font $italic;
pack .dcs.s.label -in .dcs.s -expand yes;

frame .dcs.s.d;
label .dcs.s.d.label -text "day" -font $letter;
pack .dcs.s.d.label -in .dcs.s.d -expand yes;

sectbuttons .dcs.s.d $maxday "day";
pack .dcs.s.d -in .dcs.s -side left -expand yes -anchor n;

if {$maxext} {
    frame .dcs.s.e;
    label .dcs.s.e.label -text "ext" -font $letter;
    pack .dcs.s.e.label -in .dcs.s.e;
    sectbuttons .dcs.s.e $maxext "ext";
    pack .dcs.s.e -in .dcs.s -expand yes -anchor n;
}
pack .dcs.s -in .dcs -expand yes -side top;

button .dcs.quit -text "I'm Done!" -font $italic -command quit;
pack .dcs.quit -in .dcs -fill both -expand yes -side bottom;

button .dcs.del -text "DELETE" -font $letter -state "disabled" \
  -command {deladd "delete"};
lappend globalbuttons .dcs.del;
pack .dcs.del -in .dcs -fill both -expand yes -side bottom;

button .dcs.add -text "ADD" -font $letter -state "disabled" \
  -command {deladd "add"};
lappend globalbuttons .dcs.add;
pack .dcs.add -in .dcs -fill both -expand yes;

pack .dcs;

message .title -font $letter -width 7i -textvariable vartitle \
  -relief sunken -fg firebrick1 -bg gainsboro;
pack .title -fill both;

# bindings
bind . <Control-c> {destroy .};

# Local Variables:
# mode: tcl
# End: