#!/local/bin/expectk
#
# collect and display biff/comsat messages via a
# unix-domain socket in the user's home directory.
# 
# i'm a neophyte when it comes to X11-related things
# so this may not be pretty but it seems to work ok.
#	pkern@utcc.utoronto.ca
#
# $Header: /local/homes/pkern/xp/RCS/bifftk,v 1.18 1998/07/23 18:06:29 pkern Exp $
#

##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# configurable things.
#
# things are set quick-n-dirty here because i'm never sure what stuff
# to fetch from a user's .Xresources file (or whatever it's called).
#

#set title "bifftk"

#set font "9x15bold"
set font "7x14bold"

##### #####
# icon settings:
#####
# where to find the icon bitmaps ...
set icon(home)	"/usr/X11/include/X11/bitmaps/"
#####
# choose which email icon style to use ...
## [flagup, flagdown]
append icon(map,1) "@" $icon(home) "flagup"	; set icon(mask,1) ""
append icon(map,0) "@" $icon(home) "flagdown"	; set icon(mask,0) ""
## [letters, noletters]
#append icon(map,1) "@" $icon(home) "letters"	; set icon(mask,1) ""
#append icon(map,0) "@" $icon(home) "noletters"	; set icon(mask,0) ""
## [mailfull, mailempty]
#append icon(map,1) "@" $icon(home) "mailfull"
#append icon(mask,1) "@" $icon(home) "mailfullmsk"
#append icon(map,0) "@" $icon(home) "mailempty"
#append icon(mask,0) "@" $icon(home) "mailemptymsk"
#####
#?## icon pixmaps? no, not yet.
#?#set icon(home) "/usr/X11/include/X11/pixmaps/"
#?#append icon(map,1) "@" $icon(home) "xmail.xpm"  ; set icon(mask,1) ""
#?#append icon(map,0) "@" $icon(home) "xnomail.xpm"; set icon(mask,0) ""
##### #####

#
# "loud" choices: Loud or Hush
#
# this is a button label name, so its value
# means the opposite of the current state.
#

set loud Hush	; # ie. make it loud by default.

##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# prep work, building blocks and definitions.
#

# the socket itself.
set sockfile "$env(HOME)/.biff_me"

#wm title . $title

# start up in iconified mode.
wm iconify .

proc quit { } {
	global sockfile
	catch { exec rm -f $sockfile } errmsg
# for debugging.
#	send_error "\n$sockfile: $errmsg\n"
	exit -onexit {} ; exit
}

# try to catch every possible signal.
foreach sig [ split [ string toupper [ exec kill -l ]]] {
	# a signal mask ...?
	switch -- $sig {
		ALRM	{ }	KILL	{ }	URG	{ }
		STOP	{ }	TSTP	{ }	CONT	{ }
		CHLD	{ }	TTIN	{ }	TTOU	{ }
		IO	{ }	WINCH	{ }	INFO	{ }
		default { lappend traps $sig }
	}
}
trap quit $traps
#x#send_error "\ntraps {$traps}\n"
#x#foreach sig $traps { send_error "trap $sig = [ trap $sig ]\n" }

# quick exit(s).
#bind . <KeyPress-Escape> quit
#bind . <KeyPress-q> quit
bind . <KeyPress-Q> quit

# the menu bar.
frame .menubar -relief ridge -bd 2
button .menubar.list -text List -relief raised -command bifflist
button .menubar.okay -text Okay -relief raised -command "wm iconify ."
button .menubar.quit -text Quit -relief raised -command quit
button .menubar.help -text Help -relief raised -command menuhelp
button .menubar.done -text Clear -relief raised -command clear

button .menubar.loud -textvariable loud -relief raised -command hush

pack .menubar.list .menubar.okay .menubar.done \
	.menubar.loud .menubar.quit -side left
pack .menubar.help -side right

proc menuhelp {} {
	global sockfile

	set msgtxt "
This expectk script collects and displays biff/comsat messages.
It created a unix-domain socket at $sockfile
and it is listening to that socket for messages either from comsat(8)
(in which case comsat has been augmented to check for such sockets in
user home directories and, if they exist, connect to them and send them
the latest biff messages) or from a 'tbiff -relay' pipe which had been
added to your .forward file by the 'tbiff y' command.

To exit this script, press <Esc> or press 'q'.

button	meaning
------	-------
List	show a list of stored messages.
Okay	(re)iconify the display.
Clear	flush all messages and (re)iconify, all in one step.
Loud	make the window pop open with each new message.
Hush	do the opposite of Loud.
Quit	exit the script.

And since you're reading this, then obviously
you've already clicked on the Help button.
"
	append msglen [ string length $msgtxt ] "c"

	catch { destroy .help }
	set win ".help"
	toplevel $win -relief raised -height 40m
	bind $win <KeyPress-q> "destroy $win"
	bind $win <KeyPress-space> "destroy $win"
	bind $win <KeyPress-Escape> "destroy $win"
	message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
		-foreground blue -background goldenrod
	pack $win.msg -expand 1 -fill both
}

# toggle loud.
proc hush {} {
	global loud

	set loud [expr {$loud == "Hush"} ? {"Loud"} : {"Hush"}]
}

# indicate a status change by changing the icon name and mask
# if in "Loud" mode then deiconify for a new message.
proc indicate { type } {
	global icon nums loud

	switch -- $type {
	new {
		# new input.
		wm iconbitmap . $icon(map,1)
		wm iconmask . $icon(mask,1)
		wm iconname . " + $nums(unread) "
		if {$loud == "Hush"} {
			# pop up the window.
			if {[wm state .] == "iconic"} { wm deiconify . }
		}
	}
	empty {
		wm iconbitmap . $icon(map,0)
		wm iconmask . $icon(mask,0)
		wm iconname . [wm title .]
	}
	default {
		if {$nums(total) == 0} {
			wm iconbitmap . $icon(map,0)
			wm iconmask . $icon(mask,0)
		} elseif {$nums(unread) > 0} {
			wm iconname . " + $nums(unread) "
		} else {
			wm iconname . [wm title .]
		}
	}
	}
}

# reset the displays.
proc reset { } {
	global nums disp

	set nums(unread) 0
	set nums(seen) 0
	set nums(total) 0
	set disp(mesg) ""
	set disp(stamp) ""
	indicate empty
}

reset

# status bar.
frame .statbar -relief ridge -bd 2
label .statbar.new -text "new:"	-pady 2m
label .statbar.old -text "    read:"	-pady 2m
label .statbar.total -text "    total:"	-pady 2m
label .statbar.ttl -textvariable nums(total) -fg yellow -bg blue
label .statbar.just -textvariable nums(unread) -fg blue -bg green
label .statbar.seen -textvariable nums(seen) -fg blue
label .statbar.time -textvariable timestamp -fg blue
pack \
	.statbar.new .statbar.just \
	.statbar.old .statbar.seen \
	.statbar.total .statbar.ttl \
	-side left
pack .statbar.time -side right

# show the menu and status bars.
pack .menubar .statbar -side top -fill x

# .biff = the space for the info itself.
frame .biff -relief ridge -bd 2
label .biff.stamp -textvariable disp(stamp)
message .biff.msg -bd 1m -relief ridge -font $font \
	-foreground yellow -background blue \
	-width 80c -textvariable disp(mesg)
pack .biff.stamp -side top
pack .biff.msg -expand 1 -fill both
pack .biff -expand 1 -fill both

proc review { tag } {
	global stash disp nums flags

	regexp "^\[0-9]+" $tag secs

	set disp(mesg) $stash($tag)
	set disp(stamp) [ clock format $secs -format "%a %b %d %H:%M" ]
	incr nums($flags($tag)) -1
	set flags($tag) "seen"
	incr nums($flags($tag))
}

proc delete { tag } {
	global stash nums flags snips

	incr nums(total) -1
	incr nums($flags($tag)) -1
	unset flags($tag)
	unset stash($tag)
	unset snips($tag)
}

proc get_tag { item } { regexp "^\[0-9,]+" $item tag ; return $tag }

# look - a listbox menu button.
proc look { } {
	# get the selection index.
	set spot [ .list.data curselection ]
	if {"$spot" == ""} { return }

	# show the biff message.
	set tag [ get_tag [ selection get ] ]
	review $tag

	# refresh the selected line.
	.list.data delete $spot
	.list.data insert $spot [ listline $tag ]
	.list.data selection set $spot

	indicate seen
}

# drop - a listbox menu button.
proc drop { } {
	set item [ .list.data curselection ]
	if { $item == "" } { return }
	delete [ get_tag [ selection get ] ]
	.list.data delete $item
	indicate dropped
}

# listhelp - a listbox menu button.
proc listhelp {} {
	set msgtxt "
Click on an item to select it.
Left double-click on the item to look at it again.
Right double-click on the item to delete it.

Click on the Look button to view the selected message.
Click on the Drop button to delete the selected message.
Click on the Drain button to drop all the messages.
Click on the Done button to hide the list of stored messages.

And if you're reading this, then you've already
clicked on the Help button ... obviously.
"
	append msglen [ string length $msgtxt ] "c"

	catch { destroy .listhelp }
	set win ".listhelp"
	toplevel $win -relief raised -height 40m
	bind $win <KeyPress-q> "destroy $win"
	bind $win <KeyPress-space> "destroy $win"
	bind $win <KeyPress-Escape> "destroy $win"
	message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
		-foreground blue -background goldenrod
	pack $win.msg -expand 1 -fill both
}

# clean out the list.
proc drain { } {
	global stash flags snips

	if {[ info exists stash ]} {
		reset
		unset stash flags snips
		catch { .list.data delete 0 end }
	}
}

# drain, shrink and iconify - all in one swell foop.
proc clear { } {
	drain
	catch { destroy .list }
	wm iconify .
}

# choose a snippet for the listbox.
proc snippet { str } {
	set max 28

	# if it's a biff message, try to extract the "From:" line.
	if {[ regexp "New mail .*\n(From:\[^\n]+).*\n\n" $str x snip ] == 0} {
		# nothing -- so just snip out the first non-empty line.
		regexp "^\n*(\[^\n]+)\n" $str x snip
	}
	if {[ string length $snip ] > $max} {
		set snip [ string range $snip 0 [ string wordstart $snip $max ] ]
		append snip {[...]}
	}
	return $snip
}

# return a listbox line entry.
proc listline { tag } {
	global flags snips

	regsub ",\[0-9]+" $tag "" secs
	set when [ clock format $secs -format "%a %H:%M" ]
	return [ format "%-12s %6s  %s  \"%s\"" $tag $flags($tag) $when $snips($tag) ]
}

# bifflist - display a summary of stored messages.
proc bifflist { } {
	global stash font

	catch { destroy .list }
	set win ".list"
	frame $win -relief ridge -bd 2
	frame $win.buttons -relief ridge -bd 2
	button $win.buttons.look -text Look -relief raised -command look
	button $win.buttons.drop -text Drop -relief raised -command drop
	button $win.buttons.drain -text Drain -relief raised -command drain
	button $win.buttons.done -text Done -relief raised -command "destroy $win"
	button $win.buttons.help -text Help -relief raised -command listhelp
	bind $win.buttons <KeyPress-space> "destroy $win"

	pack \
		$win.buttons.look \
		$win.buttons.drop \
		$win.buttons.drain \
		$win.buttons.done \
			-side left
	pack $win.buttons.help -side right
	pack $win.buttons -expand 1 -fill both

	listbox $win.data -bd 2 -yscrollcommand "$win.s set" \
			-font $font -width 72 -height 4
	foreach tag [ lsort [ array names stash ] ] {
		$win.data insert end [ listline $tag ]
	}

	bind $win.data <KeyPress-space> "destroy $win"

	bind $win.data <Double-Button-1> look
	bind $win.data <Double-Button-3> drop
	scrollbar $win.s -command "$win.data yview"

	pack $win.s -side right -fill y
	pack $win.data -side left -expand 1 -fill both
	pack $win -before .biff -expand 1 -fill both
}

# biffy - the socket server.
proc biffy { fd addr port } {
	global stash timestamp disp nums flags snips

	fconfigure $fd -translation binary

	set raw [ read $fd ]
	if {[string length "$raw"] == 0} { return }

	set now [ clock seconds ]
	set timestamp [ clock format $now -format "%a %b %d %H:%M:%S" ]

	# allow for multiple biffs in a single second.
	set n 0 ; while {[ info exists stash($now,$n) ]} { incr n }
	set tag "$now,$n"

	# convert CR+LF or LF+CR combinations into LFs.
	regsub -all "(\n\r|\r\n)" $raw "\n" txt

	# delete a leading BEL (ctl-G, ascii-7).
	regsub [ format "^%c" 7 ] $txt "" bifftxt

	set stash($tag) $bifftxt
	set flags($tag) "unread"
	set snips($tag) [ snippet $bifftxt ]

	# update the displays.
	set nums(total) [ array size stash ]
	incr nums($flags($tag))
	set disp(mesg) $bifftxt
	set disp(stamp) $timestamp

	# update the listbox - if it's being displayed.
	if {[ lsearch -exact [ pack slaves . ] ".list" ] != -1} {
		bifflist
	}

	indicate new
}

##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# run it.
#

# check for an existing socket server.
if {[ catch { set sd [ socket -local "" $sockfile ]} ]} {
	# hmm, none. so clean up the dead socket, if any.
	exec rm -f $sockfile
} else {
	send_error "$sockfile: already in use.\n"
	exit 1
}

# start.
if {[ catch { set sd [ socket -server biffy -local $sockfile ]} errmsg ]} {
	# uh oh.
	send_error "$sockfile: $errmsg\n"
	exit 1
}

exit -onexit quit
exec chmod 600 $sockfile
vwait allDone