ui-member.tcl

rtpmon-1.0a7.tar.gz for UNIX like

#
# Copyright (c) 1996 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice and the
# following two paragraphs appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE
# UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#
# $Id: ui-member.tcl,v 1.7 1997/01/11 20:24:05 aswan Exp $

#
# Update the information in the info display
#
# LATER: create a universal procedure to handle updating all info windows
proc updateInfoWindow {w u} {
    if {![winfo exists $w]} { return }

    set i 3
    foreach k [$u info] {
	set lbl [lindex $k 0]
	if {$lbl == "name" || $lbl == "cname"} {
	    $w.$lbl configure -text [lindex $k 1]
	} else {
	    $w.v$i configure -text [lindex $k 1]
	    incr i
	    
	    if {$lbl == "address" && [winfo exists $w.buttons.mtrace] \
		    && [$w.buttons.mtrace cget -state] == "disabled"} {
		$w.buttons.mtrace configure -state normal \
		    -command "CreateMtraceWindow $w.tracewin [lindex $k 1]"
	    }
	}
    }

    after 2500 updateInfoWindow $w $u
}

#
# Create the info display (for senders and listeners)
#
proc CreateInfoWindow {u} {
    global State

    set w .info$State(infoCount)
    incr State(infoCount)
    
    # Make sure we don't run into conflicts with existing windows
    DestroyInfoWindow $w
    
    toplevel $w
    wm title $w "info: [$u name]"
    wm transient $w .
    wm resizable $w 0 0
    
    set x [winfo pointerx .]
    set y [winfo pointery .]
    wm geometry $w +$x+$y

    set keys [$u info]

    label $w.name -text {} -font [resource smallfont] -anchor w
    grid $w.name -row 0 -column 0 -columnspan 2 -sticky ew
    label $w.cname -text {} -font [resource smallfont] -anchor w
    grid $w.cname -row 1 -column 0 -columnspan 2 -sticky ew
    
    frame $w.border0 -relief sunken -bd 1 -height 2
    grid $w.border0 -row 2 -column 0 -columnspan 2 -sticky ew
    
    frame $w.buttons

    if {$State(mtrace) == 1} {
	# The mtrace command is available, create an mtrace button
	#  the button command is setup below, when we know the IP address
	button $w.buttons.mtrace -text "Mtrace" -font [resource smallfont] \
	    -state disabled
	pack $w.buttons.mtrace -side left -expand 1
    }

    button $w.buttons.dismiss -text Dismiss -font [resource smallfont] \
	-command "DestroyInfoWindow $w"
    pack $w.buttons.dismiss -side left -expand 1
    
    set idx 3
    foreach k $keys {
	set lbl [lindex $k 0]
	set fname [join [string tolower $lbl] _]
	if {$lbl == "name" || $lbl == "cname"} {
	    $w.$lbl configure -text [lindex $k 1]
	} else {
	    set f [frame $w.$fname]
	    label $w.t$idx -text "[lindex $k 0]:" -anchor w \
		-font [resource smallfont] -pady 0
	    label $w.v$idx -text [lindex $k 1] -anchor w \
		-font [resource smallfont] -pady 0

	    grid $w.t$idx -row $idx -column 0 -sticky ewns
	    grid $w.v$idx -row $idx -column 1 -sticky ewns
	    incr idx

	    if {$lbl == "address" && [winfo exists $w.buttons.mtrace]} {
		$w.buttons.mtrace configure -state normal \
		    -command "CreateMtraceWindow $w.tracewin [lindex $k 1]"
	    }
	}
    }

    frame $w.border1 -relief sunken -bd 1 -height 2
    grid $w.border1 -row $idx -column 0 -columnspan 2 -sticky ew
    incr idx
    grid $w.buttons -row $idx -column 0 -columnspan 2 -sticky ew
    
    after 5000 updateInfoWindow $w $u
}

proc DestroyInfoWindow {w} { 
    catch {destroy $w}
}

proc CreateMtraceWindow {w src {dest {}}} {
    global mtraceactive
    if {[info exists mtraceactive($w)] && $mtraceactive($w)} {
	return;
    }

    set mtraceactive($w) 1

    if ![winfo exists $w] {
	toplevel $w
	wm title $w "mtrace: $src"

	frame $w.output
	pack $w.output -side top -expand 1 -fill both

	text $w.output.text -width 80 -height 24 -font fixed -relief sunken \
	    -yscrollcommand "$w.output.scrl set"
	scrollbar $w.output.scrl -command "$w.output.text yview"
	pack $w.output.text -side left -fill both -expand 1
	pack $w.output.scrl -side right -fill y
    
	button $w.dismiss -text Dismiss -font [resource smallfont] \
	    -command "destroy $w"
	pack $w.dismiss -side bottom
    }

    $w.output.text mark set here {end - 1 chars}
    $w.output.text mark gravity here left
    
    $w.output.text insert here "Running mtrace..."
    update idletasks

    set grp [lindex [split [option get . defaultHostSpec Rtpmon] /] 0]

    if {$dest != {}} {
	set mtraceFid [open "|mtrace $src $dest $grp" r]
    } else {
	set mtraceFid [open "|mtrace $src $grp" r]
    }
    # Set mtraceFid non-blocking
    fconfigure $mtraceFid -blocking 0
    
    $w.output.text delete here end
    set mtraceactive($w) [lindex [split [$w.output.text index end] "."] 0]

    # update the mtrace output
    fileevent $mtraceFid readable "updateMtrace $w $mtraceFid"
}

proc updateMtrace {w fid} {
    global mtraceactive
    # LATER: check for error conditions

    # If we've reached the end of the file, close it up
    if {[eof $fid] || ![winfo exists $w]} { 
	# Explicitly cancel the fileevent callback
	catch {fileevent $fid readable {} ; close $fid}
	if [winfo exists $w] {
	    set e [lindex [split [$w.output.text index end] "."] 0]
	    hiliteMtrace $w.output.text $mtraceactive($w) $e
	}
	set mtraceactive($w) 0
	return
    }

    $w.output.text insert end [read $fid]
    $w.output.text see end
}

proc hiliteMtrace {w start end} {
    set maxp 0
    set maxl $end

    $w tag configure bad -background red -foreground white
    $w tag configure med -background yellow
    $w tag configure rep -background blue -foreground white

    for {set line $start} {$line <= $end} {incr line} {
	set l [$w get $line.0 $line.end]

	if {![regexp -indices -- \
		{-?[0-9]+ */[0-9]+ *= *(-?[0-9]+)% *[0-9]* *pps$} \
		$l match percent]} {
	    continue
	}
	set p [string range $l [lindex $percent 0] [lindex $percent 1]]  
	if {$p < -1} {
	    set tag rep
	} elseif {$p < 2} {
	    continue
	} elseif {$p < 10} {
	    set tag med
	} else {
	    set tag bad
	}
	$w tag add $tag $line.[lindex $match 0] $line.end
	if {$p > $maxp} {
	    set maxp $p
	    set maxl $line
	}
    }
    $w see $maxl.0
}