ui-menu.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-menu.tcl,v 1.12 1997/01/13 22:25:22 aswan Exp $

# To Do:
#  dim sender and autosort entry widgets
#  


proc toggle-menu {} {
    if { ![winfo exists .menu] } { build-menu }

    if [winfo ismapped .menu] {
	wm withdraw .menu
    } else {
	wm deiconify .menu
    }
}

proc build-menu {} {
    toplevel .menu
    wm title .menu "rtpmon menu"
    wm geometry .menu +400+400   ;# XXX
    wm resizable .menu 0 0
    
    # Build the display parameter menu 
    build-display .menu.display
    
    # Build the sort parameter menu
    build-sort .menu.sort

    # Build the network parameter menu
    build-session .menu.session

    button .menu.dismiss -text Dismiss -font [resource smallfont] \
	-command toggle-menu
    
    pack .menu.display .menu.sort -side top -fill both -padx 1m -pady 1m
    pack .menu.session -side top -fill both -padx 1m -pady 1m	    
    pack .menu.dismiss -side top -pady 1m
}

proc build-display w {
    global Prefs State

    frame $w
    
    label $w.l -text "Display parameter" -font [resource smallfont]
    frame $w.f -relief sunken -borderwidth 2

    frame $w.f.what
    set count 0
    foreach i $State(displayParams) {
	set sname [lindex $i 0]
	set lname [lindex $i 1]
	radiobutton $w.f.what.$sname -text $lname -font [resource smallfont] \
	    -highlightthickness 0 -relief flat -borderwidth 2 -padx 2 -pady 2 \
	    -variable Prefs(displayindex) -value $count \
	    -command "displayCallback $w $sname"
	
	pack $w.f.what.$sname -side top -anchor w -padx 1m	
	incr count
    }

    frame $w.f.thresh
    label $w.f.thresh.l -text "Threshold:" -font [resource smallfont]
    entry $w.f.thresh.e -relief sunken -borderwidth 2 -width 5 \
	-highlightthickness 0 -font [resource entryFont]
    pack $w.f.thresh.l $w.f.thresh.e -side left -padx 1m -pady 1m

    #
    # LATER: fix the thresholds to conform to the displayParams abstraction
    #

    $w.f.thresh.e insert 0 $Prefs(threshold)

    # LATER: make the thresholds stick whenever focus leaves the entry widget
    bind $w.f.thresh.e <Return> {
	set t [.menu.display.f.thresh.e get]
	$mon thresh $t
	set Prefs(threshold) $t
	clean-display
    }

    pack $w.f.what $w.f.thresh -side left -fill y -expand yes

    frame $w.f2 -relief sunken -borderwidth 2

    frame $w.f2.interval
    checkbutton $w.f2.interval.auto -text "Autoclean" \
	-font [resource smallfont] -highlightthickness 0 -relief flat \
	-borderwidth 2 	-padx 2 -pady 2 -variable Prefs(autoclean) \
	-command "periodic-clean"
    label $w.f2.interval.l -text "interval:" -font [resource smallfont]
    entry $w.f2.interval.value -width 5 -font [resource entryFont] \
	-highlightthickness 0 -relief sunken -borderwidth 2 \
	-textvariable Prefs(autocleanInterval)
    label $w.f2.interval.secs -text "secs" -font [resource smallfont]
    pack $w.f2.interval.auto $w.f2.interval.l $w.f2.interval.value \
	    -side left -padx 2 -pady 1m
    pack $w.f2.interval.secs -side left -pady 1m
    pack $w.f2.interval -side top -fill both -anchor w -padx 1m

    bind $w.f2.interval.value <Return> {
	periodic-clean
    }

    pack $w.l $w.f $w.f2 -side top -fill x
}

proc displayCallback {w choice} {
    global mon Prefs State
    
    # Note: Prefs(displayindex) has already been set
    set Prefs(displayparam) $choice
    
    set i 0
    foreach p $State(displayParams) {
	if {[lindex $p 0] == $choice} {
	    $mon stat $i
	}
	incr i
    }

}

proc build-sort w {
    global mon Prefs Widgets State
    
    frame $w

    label $w.l -text "Sorting"
    frame $w.f1 -relief sunken -borderwidth 2
    
    label $w.f1.l -text "Sort receivers by:" \
	    -font -*-helvetica-bold-r-*-*-*-100-*-*-*-*-*-*    
    radiobutton $w.f1.max -text "Maximum Loss" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(sortparam) -value max \
	-command "sortCallback max"
    radiobutton $w.f1.avg -text "Average Loss" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(sortparam) -value avg \
	-command "sortCallback avg"
    radiobutton $w.f1.addr -text "IP address" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(sortparam) -value address \
	-command "sortCallback address"
    frame $w.f1.specific
    radiobutton $w.f1.specific.l -text "Sender:" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(sortparam) -value other \
	-command "sortCallback sender"
    menubutton $w.f1.specific.m -textvariable State(sortSender) \
	-font [resource smallfont] -indicatoron 1 -menu $w.f1.specific.m.menu\
	-relief raised -bd 2 -highlightthickness 0 -anchor w
    menu $w.f1.specific.m.menu

    pack $w.f1.specific.l $w.f1.specific.m -side left
    
    # Fill the sender menu with information
    set Widgets(menu:senderlist) $w.f1.specific.m
    refreshSenderMenu
    
    pack $w.f1.l -side top -padx 1m
    pack $w.f1.max $w.f1.avg $w.f1.addr -side top -anchor w -padx 1m
    pack $w.f1.specific -side top -anchor w -padx 1m -pady 1m	    

    frame $w.f2 -relief sunken -borderwidth 2

    # Create parameters for the autosort interval
    frame $w.f2.interval
    checkbutton $w.f2.interval.auto -text "Autosort" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(autosort) \
	-command "periodic-sort"
    label $w.f2.interval.l -text "interval:" -font [resource smallfont]
    entry $w.f2.interval.value -width 5 -font [resource entryFont] \
	-highlightthickness 0 -relief sunken -borderwidth 2 \
	-textvariable Prefs(autosortInterval)
    label $w.f2.interval.secs -text "secs" -font [resource smallfont]
    pack $w.f2.interval.auto $w.f2.interval.l $w.f2.interval.value \
	    -side left -padx 2 -pady 1m
    pack $w.f2.interval.secs -side left -pady 1m
    pack $w.f2.interval -side top -fill both -anchor w -padx 1m

    bind $w.f2.interval.value <Return> {
	# LATER: reset the autosortInterval
	periodic-sort
    }

    pack $w.l $w.f1 $w.f2 -side top -fill x
}

proc build-session {w} {
    global mon Prefs
    set addr [resource defaultHostSpec]
    set port [lindex [split $addr /] 1]
    set addr [lindex [split $addr /] 0]

    frame $w
    
    label $w.l -text "Session" -font [resource smallfont]
    frame $w.f -relief sunken -borderwidth 2
        
    frame $w.f.info
    label $w.f.info.dest -text "Dest: $addr" -padx 1 -pady 1 \
	-anchor w -font [resource smallfont]
    label $w.f.info.port -text "Port: $port" -padx 1 -pady 1 \
	-anchor w -font [resource smallfont]
    pack $w.f.info.dest $w.f.info.port -side left -anchor w -fill x -padx 1m

    # frame $w.f.encryption
    # checkbutton $w.f.encryption.on -text "Key:" \
	-highlightthickness 0 -relief flat -borderwidth 2 \
	-font [resource smallfont] \
	-padx 2 -pady 2 -variable Prefs(encrypted)
    # entry $w.f.encryption.key -width 30 -font [resource entryFont] \
	-highlightthickness 0 -relief sunken -borderwidth 1 \
	-textvariable Prefs(encryptionKey)
    # pack $w.f.encryption.on $w.f.encryption.key -side left -padx 1m

    frame $w.f.buttons
    button $w.f.buttons.global -text "Global Stats" \
	-font [resource smallfont] -highlightthickness 0 -relief raised \
	-borderwidth 2 -padx 2 -pady 2 -command toggleGlobalStats
    pack $w.f.buttons.global -side left -anchor n -expand 1 -padx 1m
    
    pack $w.f.info -side top -fill x -anchor center -pady 1m
    # pack $w.f.encryption -side top -fill x -anchor center -pady 1m
    pack $w.f.buttons -side top -fill x -anchor center -pady 2m -expand 1

    pack $w.l $w.f -side top -fill x
}

proc refreshSenderMenu {} {
    global mon Widgets State Prefs
    
    if {![info exists Widgets(menu:senderlist)]} { return }
    set m $Widgets(menu:senderlist)
    if {![winfo exists $m]} { return }

    if {$State(sortSender) == ""} {
	set n 0
    } else {
	set n [$m.menu index $State(sortSender)]
	if {$n == "none"} { set n 0 }
    }

    $m.menu delete 0 end
    set l {}
    foreach s $State(senders) {
	$m.menu add command -label [$s name] -font [resource smallfont] \
	    -command "set State(sortSender) \"[$s name]\"; if {\$Prefs(sortparam) == \"other\"} {sortCallback sender}"
	lappend l [$s name]
    }

    set State(sortSender) [lindex $l $n]
}

proc sortCallback {choice} {
    global mon

    if {$choice == "sender"} {
	global State Widgets

	if {![info exists State(sortSender)] || $State(sortSender) == ""} {
	    # XXX
	    return
	} else {
	    set n [$Widgets(menu:senderlist).menu index $State(sortSender)]
	    set choice [lindex $State(senders) $n]
	}
    }

    $mon sort $choice
    sort-display
}

proc toggleGlobalStats {} {
    if { ![winfo exists .stats] } { build-stats }

    if [winfo ismapped .stats] {
	wm withdraw .stats
    } else {
	wm deiconify .stats
    }
}

proc build-stats {} {
    global mon
    
    toplevel .stats
    wm title .stats "Global Statistics"
    wm geometry .stats +500+400        ;# XXX
    wm resizable .stats 0 0

    frame .stats.m
    
    set i 0
    foreach stat [$mon stats] {
	label .stats.m.n$i -text "[lindex $stat 0]:" \
	    -font [resource smallfont] -relief raised -bd 1 \
	    -anchor w -padx 2 -pady 2
	label .stats.m.v$i -text "[lindex $stat 1]" \
	    -font [resource smallfont] -relief sunken -bd 1 \
	    -anchor w -padx 2 -pady 2

	grid .stats.m.n$i -row $i -column 0 -sticky ew
	grid .stats.m.v$i -row $i -column 1 -sticky ew

	incr i
    }

    button .stats.dismiss -text "Dismiss" -font [resource smallfont] \
	-command "wm withdraw .stats"
    pack .stats.m .stats.dismiss -side top -fill x

    after 2000 update-stats
}

proc update-stats {} {
    global mon

    if [winfo ismapped .stats] {
	set i 0
	foreach stat [$mon stats] {
	    # assume the stats available and the order doesn't change
	    .stats.m.v$i conf -text "[lindex $stat 1]"
	    incr i
	}
    }

    after 2000 update-stats
}