#!/usr/local/bin/wish
global env gv

set gv(version)		"Visual Biff (Version 1.2 14may96)"
set gv(program)		vbiff
set gv(iconname)	[string toupper $gv(program)]
set gv(top)		.$gv(program)
set gv(author)		"John van Gulik"

proc errmess { pw {msg ""} } {
	global env gv
	pack [label .errmess -text $msg] -side top -expand true -fill both
	pack [button .ok -text "OK" -command "destroy .ok"] -side top
	tkwait window .ok
}

#########################################################################
#####	Set the required environment variables
#########################################################################

if {[info exists env(HOME)] && $env(HOME)=="/"} {set env(HOME) "/root"}

if {$tcl_platform(platform)=="windows"} {
	if {![info exists env(TKAPPS)]} {
		set env(TKAPPS) /TKAPPS
	}
	if {![file isdirectory $env(TKAPPS)]} {
		errmess . "Directory $env(TKAPPS) not found"
		exit 1
	}
} elseif {$tcl_platform(platform)=="unix"} {
	if {![info exists env(TKAPPS)]} {
		if {[file isdirectory $env(HOME)/TKAPPS]} {
			set env(TKAPPS) $env(HOME)/TKAPPS
		} elseif {[file isdirectory /opt/TKAPPS]} {
			set env(TKAPPS) /opt/TKAPPS
		} elseif {[file isdirectory /apps/TKAPPS]} {
			set env(TKAPPS) /apps/TKAPPS
		} else {
			set env(TKAPPS) /usr/local/TKAPPS
		}
	}
	if {![file isdirectory $env(TKAPPS)]} {
		errmess . "Directory $env(TKAPPS) not found"
		exit 1
	}
} else {
	errmess . "This application is not supported under $tcl_platform(platform)"
	exit 1
}

set auto_path [linsert $auto_path 0 $env(TKAPPS)/lib]

wm withdraw .

standard_startup $gv(program) $gv(version)
if {[winfo exists .startup]} {destroy .startup}
if {[info exists gv(startup.id)]} {image delete $gv(startup.id)}

#########################################################################
#####	Set required variables and options
#########################################################################

set gv(mailbox) ""
if {[info exists env(MAIL)]} {
	set gv(mailbox) $env(MAIL)
} elseif {[file isdirectory /usr/spool/mail]} {
	set gv(mailbox) "/usr/spool/mail/$env(USER)"
} elseif {[file isdirectory /usr/mail]} {
	set gv(mailbox) "/usr/mail/$env(USER)"
} elseif {[file isdirectory /var/spool/mail]} {
	set gv(mailbox) "/var/spool/mail/$env(USER)"
} elseif {[file isdirectory /var/mail]} {
	set gv(mailbox) "/var/mail/$env(USER)"
}

set gv(color.fg) red
set gv(color.bg) black

set gv(mtime) 0
set gv(count) 0
set gv(oldcount) 0
set gv(headcount) 0

set gv(bitmap) "$env(TKAPPS)/bitmaps/Postage.xbm"
set gv(bitmap.xoff) 83
set gv(bitmap.yoff) 54

set gv(nfont) "-adobe-helvetica-bold-r-normal--18-*-*-*-*-*-*"
set gv(lfont) "-adobe-courier-bold-r-normal--14-*-*-*-*-*-*"

set gv(delay) 20
if {[llength [split $gv(mailbox) "@"]]>1} {set gv(delay) 60}

#########################################################################
#####	SUBROUTINES
#########################################################################

proc HighLight { } {
	global env gv

	if {$gv(count)!=$gv(oldcount)} {
		set gv(oldcount) $gv(count)
		if {$gv(count)>0} {
			$gv(top).c itemconfigure $gv(item.bitmap) -foreground $gv(color.bg) \
				-background $gv(color.fg)
			$gv(top).c itemconfigure $gv(item.count) -fill $gv(color.bg) \
				-text [format "%03d" $gv(count)]
			bell
			wm deiconify $gv(top)
		} else {
			$gv(top).c itemconfigure $gv(item.bitmap) -foreground $gv(color.fg) \
				-background $gv(color.bg)
			$gv(top).c itemconfigure $gv(item.count) -fill $gv(color.fg) \
				-text [format "%03d" $gv(count)]
		}
	}

	if {$gv(count)!=$gv(headcount)} {
		set gv(headcount) $gv(count)
		if {[winfo exists $gv(top).details]} {
			$gv(top).details.list delete 0 end
			foreach message $gv(headerlist) {
				$gv(top).details.list insert 0 [format "%-22.22s  %-15.15s %s" \
					[lindex $message 0] [lindex $message 1] [lindex $message 2]]
			}
		}
	}
}

proc Click { } {
	global env gv

	$gv(top).c itemconfigure $gv(item.bitmap) -foreground $gv(color.fg) \
		-background $gv(color.bg)
	$gv(top).c itemconfigure $gv(item.count) -fill $gv(color.fg) \
		-text [format "%03d" $gv(count)]

	set gv(headerlist) {}
	set gv(headcount) 0
	if {[winfo exists $gv(top).details]} {
		destroy $gv(top).details
		return
	}

	toplevel $gv(top).details
	wm title $gv(top).details "VBiff -- Headers"
	pack [frame $gv(top).details.f] \
		-side right -fill y
	pack [button $gv(top).details.f.close -bitmap error -command Click] \
		-side top
	pack [scrollbar $gv(top).details.f.s -command "$gv(top).details.list yview"] \
		-side left -expand true -fill y
	pack [listbox $gv(top).details.list -font $gv(lfont) \
		-width 80 -height 12 \
		-yscrollcommand "$gv(top).details.f.s set" ] \
		-expand true -fill both

	set gv(mtime) 0
	MessageHeaders
}


#
# simple version -- used when only the postage window is visible
#
proc CountMessages {} {
	global env gv

	if {[winfo exists $gv(top).details]} {
		MessageHeaders
		return
	}

	if {[llength [split $gv(mailbox) "@"]]>1} {
		set gv(count) 0
		set temp [split $gv(mailbox) "@"]
		set user [lindex $temp 0]
		if {$user==""} {set user $env(USER)}
		set host [lindex $temp 1]
		if {$host==""} {set host localhost}
		set pass [lindex $temp 2]
		if {$pass==""} {
			set pass [getpass $gv(top) "Password for $user@$host"]
			set gv(mailbox) "$user@$host@$pass"
		}
		set res [pop $host 110 $user $pass]
		if {[string range $res 0 4]=="ERROR"} {
			errmess . $res
			set gv(mailbox) "$user@$host@$pass"
		} else {
			set gv(count) [lindex [split $res] 0]
		}
	} elseif {[file isdirectory $gv(mailbox)]} {
		set mtime [file mtime $gv(mailbox)]
		if {$mtime==$gv(mtime)} { return }
		set gv(mtime) $mtime
		if {[file exists $gv(mailbox)/.hdr]} {
			set files [glob -nocomplain $gv(mailbox)/msg.*]
			set gv(count) 0
			foreach file $files {
				if {[llength [split $file "."]]==2} {
					incr gv(count)
				}
			}
		} else {
			set gv(count) [llength [glob -nocomplain $gv(mailbox)/*]]
		}
	} elseif {[file exists $gv(mailbox)] && [file readable $gv(mailbox)]} {
		set mtime [file mtime $gv(mailbox)]
		if {$mtime==$gv(mtime)} { return }
		set gv(mtime) $mtime
		set gv(count) [llength [f_grep "^From " $gv(mailbox)]]
	} else {
		set gv(mtime) 0
		set gv(count) 0
	}

	HighLight
}

proc MessageHeaders {} {
	global env gv

	if {[llength [split $gv(mailbox) "@"]]>1} {
		set temp [split $gv(mailbox) "@"]
		set user [lindex $temp 0]
		if {$user==""} {set user $env(USER)}
		set host [lindex $temp 1]
		if {$host==""} {set host localhost}
		set pass [lindex $temp 2]
		if {$pass==""} {
			set pass [getpass $gv(top) "Password for $user@$host"]
			set gv(mailbox) "$user@$host@$pass"
		}
		set res [pop $host 110 $user $pass]
		if {[string range $res 0 4]=="ERROR"} {
			errmess . $res
			set gv(mailbox) "$user@$host@$pass"
			set gv(headerlist) {}
		} else {
			set gv(count) [lindex [split $res] 0]
			for {set i 1} {$i<=$gv(count)} {incr i} {
				lappend gv(headerlist) "Message $i"
			}
		}
	} elseif {[file isdirectory $gv(mailbox)]} {
		set mtime [file mtime $gv(mailbox)]
		if {$mtime==$gv(mtime)} { return }
		set gv(mtime) $mtime
		if {[file exists $gv(mailbox)/.hdr]} {
			set rawfiles [glob -nocomplain $gv(mailbox)/msg.*]
			set files {}
			foreach file $rawfiles {
				if {[llength [split $file "."]]==2} {
					lappend files $file
				}
			}
		} else {
			set files [glob -nocomplain $gv(mailbox)/*]
		}
		set gv(headerlist) {}
		foreach file $files {
			set res [f_read $file 4096]

			set date ""
			regexp {From [!-~]* ([ -~]*)} $res trash date
			set date [string trim $date]

			set from ""
			regexp "
From: (\[ -~\]*)" $res trash from
			regsub -all {\([ -~]*\)} $from {} from
			regsub -all {[ -~]*<} $from {} from
			regsub -all {>[ -~]*} $from {} from
			set from [string trim $from]

			set subject ""
			regexp "
Subject: (\[ -~\]*)" $res trash subject
			set subject [string trim $subject]

			lappend gv(headerlist) [list "$date" "$from" "$subject"]
		}
	} elseif {[file exists $gv(mailbox)] && [file readable $gv(mailbox)]} {
		set mtime [file mtime $gv(mailbox)]
		if {$mtime==$gv(mtime)} { return }
		set gv(mtime) $mtime

		set gv(headerlist) {}
		set fp [open $gv(mailbox) r]
		set foundEof 0
		while {[gets $fp mailText]>=0 && !$foundEof} {
			if {![regexp "^From " $mailText]} { continue }
			set fromLine {}
			set dateLine {}
			set toLine {}
			set subjectLine {}
			for {} {!$foundEof} {set foundEof [expr "[gets $fp mailText]==-1"]} {
				if [regexp "^$" $mailText] break
				if [regexp "^From:" $mailText] {
					#
					# this magic to extract the e-mail address from a
					# hopefully well-formatted from-line
					#
					regsub {^From:[ 	]*(.*)$} $mailText {\1} tmp1
					regsub {[ 	]*\([^)]*\)} $tmp1 {} tmp2
					regsub {^[^<]*<([^>]*)>.*$} $tmp2 {\1} fromLine
				}
				if [regexp "^Subject:" $mailText] {
					regsub {^Subject:[ 	]*(.*)$} $mailText {\1} subjectLine
				}
				if [regexp "^Date:" $mailText] {
					regsub {^Date:[ 	]*(.*)$} $mailText {\1} dateLine
				}
			}
			lappend gv(headerlist) [list $dateLine $fromLine $subjectLine]
		}
		close $fp
	} else {
		set gv(mtime) 0
		set gv(count) 0
		set gv(headerlist) {}
	}

	set gv(count) [llength $gv(headerlist)]

	HighLight

}


proc schedule {} {
	global env gv

	catch CountMessages
	after $gv(delay)000 schedule
}

#########################################################################
#####	MAIN Program
#########################################################################

set mailbox ""
set delay ""
set geometry ""
set iconbitmap ""
set iconmask ""
set iconname ""

set leftover [topgetopt {mailbox delay geometry iconbitmap iconmask iconname} $argv]

if {$mailbox=="" && [llength $leftover]>0} {set mailbox [lindex $leftover 0]}

if {$mailbox!=""} {set gv(mailbox) $mailbox}
if {$delay!=""} {set gv(delay) $delay}

if {$gv(mailbox)==""} {
	errmess . "Could not find a mailbox to monitor"
	exit
}


toplevel	$gv(top)
wm title	$gv(top) [file tail $gv(mailbox)]
wm protocol	$gv(top) WM_DELETE_WINDOW exit
if {$geometry!=""} {wm geometry $gv(top) $geometry}
if {$iconbitmap!=""} {wm iconbitmap $gv(top) $iconbitmap}
if {$iconmask!=""} {wm iconmask $gv(top) $iconmask}
if {$iconname!=""} {wm iconname $gv(top) $iconname}

pack [canvas $gv(top).c -background $gv(color.bg)]
set gv(item.bitmap) [$gv(top).c create bitmap 0 0 -bitmap "@$gv(bitmap)" -anchor nw \
	-foreground $gv(color.fg) -background $gv(color.bg)]

#
# read the bounding box of the bitmap and set the canvas size to
# exactly fit the bitmap
#
set tmp [$gv(top).c bbox $gv(item.bitmap)]
$gv(top).c configure -width [lindex $tmp 2] -height [lindex $tmp 3]

set gv(item.count) [$gv(top).c create text $gv(bitmap.xoff) $gv(bitmap.yoff) \
	-anchor sw -font $gv(nfont) \
	-text 000 -fill $gv(color.fg)]

bind $gv(top).c <Button-1> "Click"
bind $gv(top).c <Enter> "focus $gv(top).c"
bind $gv(top).c <Control-d> "exit"
bind $gv(top).c <Control-c> "exit"

pack $gv(top).c

schedule
