#!/usr/bin/wish -f
###############################################
#
# Copyright Ralf Mueller 1995
# email Ralf.Mueller@rz.tu-ilmenau.de
#
###############################################


# this path must match to your position of browse.dat

set browseDat "/usr/local/samba/var/locks/browse.dat"



###############################################
#
# DO NOT CHANGE AFTER THIS LINE
#
###############################################

option add *background lightgray
option add *borderWidth 1
option add *Button*padX 1
option add *Button*padY 1
option add *highlightThickness 0
set tk_strictMotif 1
. configure -background lightgray


proc unfocusFramed { name } {
  $name configure -relief flat
}

proc focusFramed { name } {
  $name configure -relief groove
}

proc framed { name widget args } {
  global tk_version
  frame $name -borderwidth 2
  eval $widget $name.w [ join $args ]
  bind $name.w <FocusOut> "unfocusFramed $name"
  bind $name.w <FocusIn> "focusFramed $name"
  pack $name 
  pack $name.w 
}

proc removeFocus {} {
  if { "[ focus ]" == ".t.text.w" } {
    focusFramed .t.text 
    unfocusFramed .t.f.ok
    unfocusFramed .t.f.cancel
  } else {
    after 1000 removeFocus
  }
}

proc sendPopup { textW name} {
  set fw [ open "|cat" r+ ]
  set fr [ open "|smbclient -M $name <@$fw" r ]
  puts $fw [ $textW get 1.0 end ]
  close $fw
  while { ![ eof $fr ] } {
    gets $fr tmp
    if { [ string match {*status*} "$tmp" ] } {
      destroy .t.f.cancel
      destroy .t.text
      if { [ string match {* 0-0*} "$tmp" ] } {
        label .t.l -text "Message sent" -width 30
      } else {
        label .t.l -text "Send message failed" -width 30
      }
      pack .t.l -before .t.f
    }
  }
  .t.f.ok.w configure -command "destroy .t"
  close $fr
  after 10000 { if [ winfo exists .t ] { destroy .t } }
}

proc popup { butName } {

  set name [ lindex [ $butName configure -text ] 4 ]
  if [ winfo exists .t ] {
    destroy .t
  }
  toplevel .t
  wm title .t "Send message to $name"
  framed .t.text text { -relief sunken }
  bind .t.text.w <Key-Tab> { focus .t.f.ok.w; 
    if { [ set tk_version ] >= 4.0 } { break }
  }
  frame .t.f
  framed .t.f.ok button " -text    Ok -width 10 \
    -command \" sendPopup .t.text.w $name \" "
  bind .t.f.ok.w <Key-Tab> { focus .t.f.cancel.w }
  bind .t.f.ok.w <Return> { %W invoke }
  framed .t.f.cancel button { -text Cancel -command { destroy .t } -width 10 }
  bind .t.f.cancel.w <Key-Tab> { focus .t.text.w }
  bind .t.f.cancel.w <Return> { %W invoke }
  pack .t.text .t.f -fill x -expand 1 -pady 4
  pack .t.f.ok .t.f.cancel -side left -expand 1
  tkwait visibility .t
  focus .t.text.w
}

proc netmon {} {
  global browseDat
  set f [ open $browseDat ]
  while { ![ eof $f ] } {
    gets $f tmp
    set tmp [ string toupper $tmp ]
    if { ![ string match {*"?00000000*} $tmp ] } {
      if { ![ string match {*"?8[0-9,A-F]*?"} $tmp ] } {
        regsub {^"} $tmp "" tmp
        regsub {".[0-9,a-f,A-F].*$} $tmp "" tmp
        if { "$tmp" != "" } {
          lappend userList $tmp
        }
      }
    }
  }
  set userList [ lsort $userList ]
  close $f
  set butList " [ winfo children .users ] "
  set butLLength [ llength $butList ]
  set newBut [ expr ( [ llength $userList ] - $butLLength ) ]
  if { $newBut < 0 } {
    for { set i [ expr ( - $newBut ) ] } { $i > 0 } { incr i -1 } {
      destroy [ lindex $butList [ expr ( [ llength $butList ] -1 ) ] ]
    }
  }
  if { $newBut > 0 } {
    for { set i 0 } { $i < $newBut } { incr i } {
      set butName .users.b[ expr ( $i + $butLLength ) ]
      button $butName
      bind $butName <Button-3> { popup %W }
      set butFont [ split [ lindex [ $butName configure -font ] 3 ] - ]
      set butFont [ lreplace $butFont 3 3 medium ]
      set butFont [ lreplace $butFont 8 8 100 ]
      $butName configure -font [ join $butFont - ]
    }
  }
  set j 0
  foreach i $userList {
    set uName [ string tolower $i ]
    .users.b$j configure -command "exec xterm -e talk $uName@$i"
    .users.b$j configure -text $i
    pack .users.b$j -fill x -expand 1 -padx 1p -pady 1p
    incr j
  }
  update idletasks
  global oldUserList
  if { "$oldUserList" != "$userList" } {
    wm geometry . "-0+20";  wm geometry . "-0+21"
  }
  set oldUserList $userList
  after 10000 netmon
}

proc time {} {
  global fDate
  puts $fDate "date +%H:%M"
  flush $fDate
  gets $fDate tmp
  .top.time configure -text $tmp
  set butFont [ split [ lindex [ .top.time configure -font ] 3 ] - ]
  set butFont [ lreplace $butFont 3 3 medium ]
  set butFont [ lreplace $butFont 8 8 100 ]
  .top.time configure -font [ join $butFont - ]
  pack .top.time
  after 10000 time
}
wm geometry . "-0+21"

frame .top -relief sunken
pack .top -fill x -padx 1p -pady 1p
label .top.time
frame .users
pack .users
set oldUserList ""

set fDate [ open "| sh" r+ ]
time
netmon

