NetNews Usenet Archive 1992 #26/NN_1992_26.iso/spool/comp/lang/tcl/1824

Text File | 1992-11-13 | 5.6 KB | 240 lines

Newsgroups: comp.lang.tcl
Path: sparky!uunet!caen!spencer
From: [e-mail] (Spencer W. Thomas)
Subject: Biff revisited
Message-ID: <[e-mail]>
Date: Fri, 13 Nov 92 05:53:57 EST
Organization: University of Michigan
Distribution: comp
Nntp-Posting-Host: guraldi.itn.med.umich.edu
Lines: 228

I once had an xbiff that had a really nice feature -- if you clicked
on it, it would pop up a list of the message headers.  I thought I'd
see if I could reproduce that behavior.  I started from the recently
posted tclbiff, but then switched to using 'xf' to build the
application.  (This no doubt accounts for the verbosity of the
resulting code...)  Here it is.  The usual disclaimers apply...

Press mouse 1 on the mailbox icon and hold it.  A "spring-loaded" list
of your message headers will pop up.

=S

#!/usr/local/bin/wish -f
# XF
# create the widget hierarchy
#
# startup source




# module inclusion

# initialize global variables
proc InitGlobals {} {
  global flagDownBitmap
  set flagDownBitmap {/usr/include/X11/bitmaps/flagdown}
  global bitmapState
  set bitmapState {0}
  global symbolicName
  set {symbolicName(root)} {.}
  set {symbolicName(headerList)} {.headers.frame2.listbox}
  global MAIL
  global flagUpBitmap
  set flagUpBitmap {/usr/include/X11/bitmaps/flagup}
}

proc ShowWindow.headers { args} {

  # build widget .headers

  catch "destroy .headers"

  toplevel .headers -class tclbiff
  .headers configure     -borderwidth {1}    -relief {raised}

  # Window manager configurations
  wm title .headers {headers}
  wm positionfrom .headers program
  wm sizefrom .headers program
  wm maxsize .headers 1000 900
  wm minsize .headers 10 10
  wm transient .headers .

  # build widget .headers.frame2
  frame .headers.frame2
  .headers.frame2 configure     -borderwidth {2}    -relief {raised}

  # build widget .headers.frame2.listbox
  listbox .headers.frame2.listbox
  .headers.frame2.listbox configure     -borderwidth {1}    -exportselection {false}    -font {-Adobe-Helvetica-Medium-R-Normal-*-120-*}    -geometry {10x1}    -relief {raised}

  # pack widget .headers.frame2
  pack append .headers.frame2    .headers.frame2.listbox   {top frame center}


  # pack widget .headers
  pack append .headers    .headers.frame2   {top frame center fill}

  wm geometry .headers +[expr [winfo rootx .]+10]+[expr [winfo rooty .]+10]
}

proc DestroyWindow.headers {} {
    catch "destroy .headers"
    update
}

# contents of .
proc ShowWindow. {args} {

  # Window manager configurations
  wm title . {biff}
  wm positionfrom . program
  wm sizefrom . program
  wm maxsize . 1000 900
  wm minsize . 10 10

  # build widget .mailbox
  label .mailbox
  .mailbox configure \
    -bitmap {@/usr/include/X11/bitmaps/flagdown}\
    -borderwidth {1}\
    -relief {raised}\
    -text {}
  # bindings
  bind .mailbox <ButtonRelease-1> {wm withdraw .headers}
  bind .mailbox <Button-1> {ShowWindow.headers
getheaders}


  # build widget .time
  label .time
  .time configure \
    -borderwidth {1}\
    -font {*fixed-medium-r-normal--*-200-*}\
    -relief {raised}\
    -text {03:56}

  # pack widget .
  pack append .\
    .mailbox   {top frame center expand fill} \
    .time   {top frame center expand fillx}
}


# Procedures

proc schedule {} {
    check_and_bark
    .time configure -text [fmtclock [getclock] "%H:%M"]
    after 60000 schedule
}


proc check_and_bark {} {
    global MAIL flagDownBitmap flagUpBitmap bitmapState

    if {[file exists $MAIL] && ([file size $MAIL] != 0)        && ([file mtime $MAIL] > [file atime $MAIL])} {
    if {$bitmapState != 1} {
        .mailbox configure -bitmap "@$flagUpBitmap"
        set bitmapState 1
    }
    } else {
    if {$bitmapState != 0} {
        .mailbox configure -bitmap "@$flagDownBitmap"
        set bitmapState 0
    }
    }
}

proc getheaders {} {
    global MAIL Inmessage Fromline

    set l [SymbolicName headerList]
    $l delete 0 end;
    set w 10;
    set Inmessage 0;
    set Fromline {}

    set scanc [scancontext create];
    scanmatch $scanc "^From " {
      global Inmessage Fromline;
      set Inmessage 1;
      set Fromline [lindex $matchInfo(line) 1];
    }
    scanmatch $scanc ^From: {
      global Inmessage Fromline
      if $Inmessage {
        expr {[regexp {<([^>]+)>} $matchInfo(line) x Fromline] ||
            [regexp "From: +(\[^ \t]+)" $matchInfo(line) x Fromline]}
      }
    }
    scanmatch $scanc ^Subject: {
      global Inmessage Fromline
      if $Inmessage {
        [SymbolicName headerList] insert end \
          [concat ${Fromline}:\
           [string trim [string range $matchInfo(line) 8 end]]];
      }
    }

    set m [open $MAIL r]
    scanfile $scanc $m
    close $m

    set n [$l size]
    loop i 0 $n {
        set w [max $w [string length [$l get $i]]]
    }
    set n [min $n 1]
    $l configure -geometry ${w}x$n
}


if {[string length [info procs SymbolicName]] == 0} {
proc SymbolicName { {xfName ""}} {
  global symbolicName

  if {[string length $xfName] > 0} {
    set xfArrayName ""
    append xfArrayName symbolicName ( $xfName )
    if {[catch "set \"$xfArrayName\"" xfValue] == 0} {
      return $xfValue
    } {
        puts stderr "XF error: unknown symbolic name:\n$xfName"
    }
  }
  return ""
}
}


# initialize global variables
# remove this call if there are problems at startup
InitGlobals


# stuff to display and remove toplevel windows
# call the procedures to create the toplevels.
ShowWindow.

# end source

    if [info exists env(MAIL)] {
    set MAIL $env(MAIL)
    } else {
    set MAIL "/usr/spool/mail/[id user]"
    }

    schedule


# eof
#
--
=Spencer W. Thomas         |  Info Tech and Networking, B1911 CFOB, 0704
   "Genome Informatician"    |  Univ of Michigan, Ann Arbor, MI 48109
[e-mail]    |  313-747-2778, FAX [phone]