#!/usr/local/bin/wish

# which perl to use
set perl /usr/local/bin/perl

###############################################################
#
# I used to use the following three lines to start up phimail,
# but it causes problems if you try to use something like
# 'xon' with phimail.
#
#   #!/bin/sh
#   #the next line restarts using wish \
#   exec wish "$0" "$@"
#
###############################################################

###############################################################
###
### Paul LeMahieu
### 1 Oct 1996
### 
### phimail
###
### A tcl/tk script for alerting the user when mail
### arrives.  It's my opinion that far too many people in the
### world are still using xbiff with those very poor bitmaps.
### You may set the images that are displayed for no mail
### (flagDownPic), unread/new mail (flagUpPic), and mail being
### read (boxOpenPic).  You may specify a sound command to be
### executed when new mail arrives (soundCommand). 
### The command to execute to read mail (mailCommand) may
### also be set.
###
### For specifying command line options, use
###
###    phimail [standard X options] [options] 
###
###############################################################
###
### Things the user may want to set.  If this is being installed
### at a site, set the defaults here.
###
##
#

# mailFile is the mail file to report on

set mailFile /var/spool/mail/[exec whoami]

# Fairly self-explanatory.  If you don't want/have a special
# image to show when mail is being read (boxOpenPic), just
# set it to flagDownPic

set flagDownPic /usr/local/images/mboxes/flagdown.gif
set flagUpPic /usr/local/images/mboxes/flagup.gif
set boxOpenPic /usr/local/images/mboxes/boxopen.gif 

# This is the name of a sound command to execute when
# new mail arrives.  For example, "cat song.au > /dev/audio".
# If it is "", then the computer will just beep if beepOn is 1.

set soundCommand ""
set beepOn 1

# Set this for whatever mail program you use

set mailCommand "xterm -e /usr/local/bin/pine -i"

# Delay between checking for new mail, in seconds

set checkDelay 60 

# Set this if you turn bells off globally with xset 0
# (if you don't know what I'm talking about, you probably want 1)

set globalBells 1 

# Set this to 1 if you want a full parse of the mail file.
# Only choose a setting of 0 if phimail crashes out when parsing
# your mail file.  If set to 0, phimail uses a simpler time-stamp
# method to determine the status of your mail box, and no
# information will be displayed about current mail (num read/unread,
# last received).

set fullParse 1

# If you want the flagUp shown whenever any unread mail is around,
# set this to 1.  Many people prefer flagUp only for new mail,
# and they should set flagUpUnread 0

set flagUpUnread 0 

# If you want more than just a simple beep

set fancyBell 0

# If you want to adjust color usage; good for 8-bit displays
# Welch suggests settings like "5/5/4" or "6/6/5", where
# the format is "red/green/blue".

set palette ""

# the default rc file and cmd file

set rcFile ~/.phimailrc
set cmdFile ~/.phimailcmd

#
##
###
###############################################################
### And now onto the rest of the program ...
###
##
#

# set the current version of phimail
# First number is major release, second is minor release (new features),
# third is bug fixes

set version 1.1.1

# settings of these by checkMailFile or parseMailFile
# affect the setting of the mailbox image and beeping
set anyMail 0
set unreadMail 0
set newMail 0

# used when invoking the mail reader
set dummyPipe ""
set readingMail 0

# used by checkMailFile 
set oldSize 0

# used by parseMailFile
set oldNumMsgs 0
set numMsgs 0
set numUnreadMsgs 0
set numNewMsgs 0
set lastFrom ""
set lastSubject ""

# what to call the about window
set about .about

# play a more elaborate series of bells
proc ringBell {} {
   global fancyBell

   if {$fancyBell == 0} {
      bell
   } elseif {$fancyBell == 1} {
      set vol 10 
      set dur 100
      set pause 20
      exec xset b $vol 300 $dur; bell; after $pause
      exec xset b $vol 400 $dur; bell; after $pause
      exec xset b      ;# reset bell to default
   }
}

# invoke the read mail command, change the image to boxOpen
proc readMail {} {
   global m mailCommand boxOpen dummyPipe readingMail

   if {$readingMail == 0} {
      set readingMail 1
      $m configure -image $boxOpen; update
      set dummyPipe [open "|$mailCommand" r]
      fileevent $dummyPipe readable {endReadMail}
   }
}

# read mail command done, so change image back (could be flagUp or flagDown)
proc endReadMail {} {
   global dummyPipe readingMail

   set dummyStr ""
   set dummy [gets $dummyPipe dummyStr]
   if {$dummy == -1} {
      set readingMail 0
      catch {close $dummyPipe}
      checkMail
   }
}

# A simple way to see if there is new mail.  It's not sophisticated
# enough to report number of unread messages, etc, since it relies
# solely on time stamps and file size
proc checkMailFile {mailFile} {
   global oldSize anyMail unreadMail newMail

   if {![file exists $mailFile]} {puts "mail file '$mailFile' not found"; exit}
   set aTime [file atime $mailFile]
   set mTime [file mtime $mailFile]
   set newSize [file size $mailFile]
   if {$newSize > 0} {set anyMail 1} else {set anyMail 0}
   if {($mTime >= $aTime) && ($newSize > 0)} \
      {set unreadMail 1} else {set unreadMail 0}
   if {($newSize > $oldSize) && $unreadMail} \
      {set newMail 1} else {set newMail 0}
   set oldSize $newSize
}

# A little perl program to extract headers from the mail file.
# It looks hideous because I have to \ everything to stop tcl from
# interpreting things. Is there a better way to do this?  A clearer
# version of this script is visible as the seperate 'mhdrs' program.
set perlCmd \
   " \" \$nl = \\\\n; \$/ = \\\"\\\"; \$* = 1; open(IN,\$ARGV\[0\]); while(\$_ = <IN>) { if (/(^From )(.|\$nl)*/) { print \$_; if (/^Content-Length: (.*)\$nl/) { \$clength = \$1; \$/ = \$nl; while (\$clength > 0) {\$_ = <IN>; \$clength -= length(\$_);} } \$/ = \\\"\\\"; } } \" " 

# A more complicated way to check for new mail.
# Parse the mail file for number of messages, etc.
# This relies on there being a "From " starting each
# new mail message in the mail file, and that no "From " occur
# elsewhere (I think sendmail guarantees this?)
proc parseMailFile {mailFile} {
   global oldNumMsgs numMsgs numUnreadMsgs numNewMsgs lastFrom lastSubject \
          anyMail unreadMail newMail newSize oldSize flagUpUnread perl perlCmd
   set numMsgs 0
   set numUnreadMsgs 0
   set numNewMsgs 0
   set numReadMsgs 0
   set lastFrom ""
   set lastSubject ""
   set keyWord ""
   set infoStr ""

   # use of mhdrs breaks phimail when mhdrs is not in the path, for example, when
   # using xon 
   #set grepIn [open "|mhdrs $mailFile" r]

   set grepIn [open "|$perl -e $perlCmd $mailFile" r]

   while {![eof $grepIn]} {
      set keyWord ""
      set keyLen 0
      set From ""
      set infoStr ""
      set grepLine [gets $grepIn]
      set From [string range $grepLine 0 4]
      if {$From == "From "} {
         set keyWord "From "
      } else {
         scan $grepLine "%s" keyWord
         set keyLen [string length $keyWord]
         set infoStr [string range $grepLine $keyLen end]
         set infoStr [string trim $infoStr]         
      }
      switch -exact -- $keyWord \
         "From " {
            set realMsgHdr 1 
            set lastFrom ""
            set lastSubject ""
            set lastStatus ""
            incr numMsgs
         } \
         "From:" {
            if {$lastFrom == ""} {
               set lastFrom $infoStr 
            }
         } \
         "Subject:" {
            if {$lastSubject == ""} {
               set lastSubject $infoStr
            }
         } \
         "Status:" {
            set status [string trim $infoStr]
            # Assume any Status containing an "R" is a read message,
            # and anything else is unread.  Anything without a Status line
            # will then be new mail.
            if {[string match *R* $status] && ($lastStatus == "")} {
               set lastStatus $status
               incr numReadMsgs
            } elseif {$lastStatus == ""} {
               set lastStatus $status
               incr numUnreadMsgs
            }
         } \
         default {
            # ignore it, it's something we don't want
         }
   }
   catch {close $grepIn}

   set numNewMsgs [expr $numMsgs-$numReadMsgs-$numUnreadMsgs]

   if {$numMsgs > 0} {set anyMail 1} else {set anyMail 0}
   if {$flagUpUnread} {
      if {($numUnreadMsgs > 0) || ($numNewMsgs > 0)} {set unreadMail 1} else {set unreadMail 0}
   } else {
      if {$numNewMsgs > 0} {set unreadMail 1} else {set unreadMail 0}
   }
   #if {($numMsgs > $oldNumMsgs) && $unreadMail} {set newMail 1} else {set newMail 0}
   if {($numMsgs > $oldNumMsgs) && ($numNewMsgs > 0)} {set newMail 1} else {set newMail 0}

   set oldNumMsgs $numMsgs
}

# check mail file and do the appropriate thing to alert the user
proc checkMail {} {
   global m anyMail unreadMail newMail flagUp flagDown readingMail mailFile \
          soundCommand beepOn audioDev fullParse globalBells \
          cmdFile lastFrom lastSubject

   # don't update anything if mail is being read 
   if {$readingMail} {return}

   if {$fullParse} {
      parseMailFile $mailFile
   } else {
      checkMailFile $mailFile
   }

   if {$anyMail} {
      # show letters in the box or something
   }
   if {$unreadMail} { 
      # show the 'flag up' picture
      $m configure -image $flagUp
   } else {
      # show the 'flag down' picture
      $m configure -image $flagDown
   }
   if {$newMail} { 
      # show the 'flag up' picture
      $m configure -image $flagUp
      # play a sound file, or just beep
      if {$soundCommand != "" } {
         exec $soundCommand
      } else {
         if {$beepOn} {
            if {$globalBells} {
               ringBell
            } else {
               # The xset commands below are a bit of a hack, if you turn off bells in general.
               exec xset b on 
               ringBell
               exec xset b off 
            }
         }
      }
      if {[file exists $cmdFile]} {
         source $cmdFile
      }
   }
}

proc checkMailD {} {
   global checkDelay
   checkMail
   after [expr int($checkDelay*1000)] checkMailD
}

proc showStats {} {
   global m pop numMsgs numUnreadMsgs numNewMsgs lastFrom lastSubject

   catch {destroy $pop}
   menu $pop -tearoff off

   $pop add command -label "Messages" 
   $pop add command -label "   Total:        $numMsgs" 
   $pop add command -label "   Unread:       $numUnreadMsgs" 
   $pop add command -label "   New:          $numNewMsgs" 
   $pop add separator
   $pop add command -label "Most Recent"
   $pop add command -label "   From:         $lastFrom" 
   $pop add command -label "   Subject:     $lastSubject" 

   set screenx [winfo screenheight $m]
   set screeny [winfo screenwidth $m]
   set rootx [winfo rootx $m]
   set rooty [winfo rooty $m]
   set popw [winfo height $pop]
   set poph [winfo width $pop]
   update idletasks

   if {[expr $rootx + $popw] > $screenx} {
      set x [expr $screenx - $popw]
   } else { set x $rootx } 
   if {[expr $rooty + $poph] > $screeny} {
      set y [expr $screeny - $poph]
   } else { set y $rooty } 

   $pop post $x $y 
}

# the about window

set oldFocus [focus]
proc showAbout {} {
   global about flagUp oldFocus version
   toplevel $about 
   #set aboutImage [image create photo -file /home/lemahieu/work/tk/eye/eye.gif]
   set aboutImage $flagUp
   label $about.i -image $aboutImage -relief ridge 
   label $about.title -font *-times-bold-r-normal--*-240-*-*-*-*-*-* \
      -text "phimail"
   label $about.version -font *-times-medium-r-normal--*-120-*-*-*-*-*-* \
      -text "Version $version" 
   label $about.auth -font *-times-medium-i-normal--*-180-*-*-*-*-*-* \
      -text "Author:  Paul LeMahieu"
   label $about.email -font *-times-medium-r-normal--*-120-*-*-*-*-*-* \
      -text "lemahieu@paradise.caltech.edu"
   #button $about.ok -image $aboutImage -command {destroy $about; focus $oldFocus;} 
   button $about.ok -text Dismiss -command {destroy $about; focus $oldFocus;} 

   pack $about.i -side left -padx 3m -pady 3m -ipadx 1m -ipady 1m
   pack $about.title $about.version -side top -padx 2m -pady 2m
   pack $about.auth $about.email -side top -padx 4m -pady 1m 
   pack $about.ok -side bottom -pady 1m
   update idletasks

   set oldFocus [focus]
   grab set $about
   focus $about
}

#
##
###
###############################################################
###
### This parses the command line and starts things off.
###
### First, the default rcFile file is read, if it exists.
### Then, the command line settings are read.  If an alternate
### rcFile is specified, it is read in as the command line is parsed.
### So, if the user gives a -rf option, the options specified in that
### file override any options specified before the -rf option, and any
### options specified later on the command line override those
### specified in the rcFile.
###
##
#

set allOk 1
set i 0

if {[file exists $rcFile]} {source $rcFile}
while {$i < $argc} {
   set arg1 [lindex $argv $i]
   set arg2 [lindex $argv [expr $i+1]]
   switch -- $arg1 \
   "-mf" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set mailFile $arg2} 
   } \
   "-rf" {
      incr i;
      if {$arg2 == ""} {
         set allOk 0
      } else {
         set rcFile $arg2
         if {[file exists $rcFile]} {source $rcFile}
      }
   } \
   "-cf" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set cmdFile $arg2} 
   } \
   "-fdp" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set flagDownPic $arg2} 
   } \
   "-fup" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set flagUpPic $arg2}
   } \
   "-bop" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set boxOpenPic $arg2} 
   } \
   "-mc" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set mailCommand $arg2}
   } \
   "-sc" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set soundCommand $arg2} 
   } \
   "-t" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set checkDelay $arg2} 
   } \
   "-beepOn" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set beepOn $arg2} 
   } \
   "-globalBells" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set globalBells $arg2} 
   } \
   "-fullParse" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set fullParse $arg2} 
   } \
   "-flagUpUnread" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set flagUpUnread $arg2} 
   } \
   "-fancyBell" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set fancyBell $arg2} 
   } \
   "-palette" {
      incr i; if {$arg2 == ""} {set allOk 0} else {set palette $arg2} 
   } \
   "-h" {set allOk 0} \
   "-help" {set allOk 0} \
   default {
      set allOk 0 
      puts "Unknown command line option $arg1"
   }
   incr i
}

if {$allOk} {
   if {$palette != ""} {
      set flagDown [image create photo -file $flagDownPic -palette $palette]
      set flagUp [image create photo -file $flagUpPic -palette $palette] 
      set boxOpen [image create photo -file $boxOpenPic -palette $palette]
   } else {
      set flagDown [image create photo -file $flagDownPic]
      set flagUp [image create photo -file $flagUpPic] 
      set boxOpen [image create photo -file $boxOpenPic]
   }
   set m .m
   set pop $m.pop
   button $m -image $flagDown -command {readMail}
   pack $m -ipadx 1m -ipady 1m -expand 1 -fill both
   bind $m <ButtonPress-2> {showAbout}
   bind $m <ButtonPress-3> {if {$fullParse} {showStats}}
   bind $m <ButtonRelease-3> {if {$fullParse} {$pop unpost}}
   bind . <Control-c> {exit}
   bind . q {exit}
   bind . r {if {[file exists $rcFile]} {source $rcFile}}
   bind . c {if {[file exists $cmdFile]} {source $cmdFile}}
   checkMailD
} else {
   puts "usage: $argv0 \[standard X options\] \[options\]"
   puts "version: $version"
   puts "standard X options:"
   puts "   -colormap: Colormap for main window"
   puts "   -display:  Display to use"
   puts "   -geometry: Initial geometry for window"
   puts "   -name:     Name to use for application"
   puts "   -sync:     Use synchronous mode for display server"
   puts "   -visual:   Visual for main window"
   puts "options:"
   puts "   -mf <mail file>                (default = $mailFile)"
   puts "   -rf <rc file>                  (default = $rcFile)"
   puts "   -cf <cmd file>                 (default = $cmdFile)"
   puts "   -fdp <flagdown picture>        (default = $flagDownPic)"
   puts "   -fup <flagup picture>          (default = $flagUpPic)"
   puts "   -bop <boxopen picture>         (default = $boxOpenPic)"
   puts "   -mc <mail reader command>      (default = $mailCommand)"
   puts "   -t <check delay, in secs>      (default = $checkDelay)"
   puts "   -sc <new mail sound command>   (default = $soundCommand)"
   puts "   -beepOn <0,1>                  (default = $beepOn)"
   puts "   -globalBells <0,1>             (default = $globalBells)"
   puts "   -fullParse <0,1>               (default = $fullParse)"
   puts "   -flagUpUnread <0,1>            (default = $flagUpUnread)"
   puts "   -fancyBell <0,1>               (default = $fancyBell)"
   puts "   -palette <reds/greens/blues>   (default = $palette)"
   puts "Left button in window calls mail reader."
   puts "Right button in window pops up mailbox info." 
   puts "Middle button in window tells about phimail."
   puts "Ctrl-C or 'q' in window quits." 
   puts "'r' in window re-reads $rcFile" 
   puts "'c' in window executes $cmdFile (good for debugging that file)" 
   exit
}
