~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/applications/pathfinder/prefs.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # prefs.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 #
 31 #  @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/pathfinder/prefs.tcl,v 1.4 2002/02/03 04:22:06 lim Exp $
 32 
 33 
 34 import WidgetClass Application
 35 
 36 
 37 WidgetClass PathFinderPrefs -default {
 38         { *background \#FFFFFF }
 39         { *highlightBackground \#FFFFFF }
 40         { *Button.borderWidth 1 }
 41         { *Checkbutton.borderWidth 1 }
 42         { *Radiobutton.borderWidth 1 }
 43         { *font WidgetDefault }
 44 }
 45 
 46 
 47 PathFinderPrefs public default_prefs { } {
 48         $self tkvar nomulticast_ usemega_ mega_conn_ mega_conn_other_ \
 49                         session_rate_ status_
 50 
 51         set nomulticast_ 0
 52         set usemega_ 0
 53         set mega_conn_ 128000
 54         set mega_conn_other_ 0
 55         set session_rate_ 64000
 56 
 57         set status_ "Reverting to default values...\n(Hit <Save> to save these\
 58                         preferences permanently)"
 59 }
 60 
 61 
 62 PathFinderPrefs public load_prefs { } {
 63         $self tkvar nomulticast_ usemega_ mega_conn_ mega_conn_other_ \
 64                         session_rate_ status_
 65 
 66         $self default_prefs
 67         set nomulticast_ [$self get_option pfl-nomulticast $nomulticast_]
 68         set usemega_ [$self get_option pfl-usemega $usemega_]
 69         set maxsbw [$self get_option pfl-maxsbw $mega_conn_]
 70         set list { 28800 128000 1500000 10000000 100000000 }
 71         if { [lsearch $list $maxsbw] != -1 } {
 72                 set mega_conn_ $maxsbw
 73                 set mega_conn_other_ 0
 74         } else {
 75                 set mega_conn_ other
 76                 set mega_conn_other_ $maxsbw
 77         }
 78 
 79         set session_rate_ [$self get_option pfl-srate $session_rate_]
 80 
 81         set status_ "Loaded preferences from disk..."
 82 }
 83 
 84 
 85 PathFinderPrefs private get_option { key default } {
 86         set value [$self next $key]
 87         if { $value == {} } { return $default } else { return $value }
 88 }
 89 
 90 
 91 PathFinderPrefs public save_prefs { } {
 92         $self tkvar nomulticast_ usemega_ mega_conn_ mega_conn_other_ \
 93                         session_rate_ status_
 94 
 95         set o [$self options]
 96         set f [$o open_preferences pfinder-local]
 97         $o write_preference $f pfl-nomulticast $nomulticast_
 98         $o write_preference $f pfl-usemega $usemega_
 99         $o write_preference $f pfl-srate $session_rate_
100         if { $mega_conn_ != "other" } { set maxsbw $mega_conn_ } \
101                         else { set maxsbw $mega_conn_other_ }
102         $o write_preference $f pfl-maxsbw $maxsbw
103         $o close_preferences $f
104 
105         # update our options database with the new values
106         $o load_preferences pfinder-local
107 
108         set status_ "Saved preferences to disk..."
109 }
110 
111 
112 PathFinderPrefs public build_widget { path } {
113         $self tkvar nomulticast_ usemega_ mega_conn_ mega_conn_other_ \
114                         session_rate_
115 
116         # load the preferences in from file
117         set o [$self options]
118         $o load_preferences pfinder-local
119 
120         # load the preferences into the tkvars
121         $self load_prefs
122 
123         checkbutton $path.nomulticast -variable [$self tkvarname nomulticast_]\
124                         -text "Do not use multicast" -anchor w
125         checkbutton $path.usemega -variable [$self tkvarname usemega_]\
126                         -text "Use Media Gateways to adapt session bandwidth" \
127                         -anchor w
128         pack $path.nomulticast $path.usemega -side top -anchor w -fill x
129 
130         upvar \#0 [$self tkvarname usemega_] global_usemega_
131         trace variable global_usemega_ w "$self change_usemega"
132 
133         upvar \#0 [$self tkvarname mega_conn_] global_mega_conn_
134         trace variable global_mega_conn_ w "$self change_mega_conn"
135 
136         frame $path.mega -bd 2 -relief ridge
137         label $path.crate -text "Connection Rate" -font \
138                         [WidgetClass widget_default -font] -anchor w
139         pack $path.crate -fill x -side top -in $path.mega -anchor w
140 
141         frame $path.rb
142         radiobutton $path.r0 -text "Modem (28.8 kb/s)" \
143                 -highlightthickness 0 \
144                 -variable [$self tkvarname mega_conn_] -value 28800 \
145                 -relief flat -anchor w -padx 10
146         radiobutton $path.r1 -text "ISDN (128 kb/s)" \
147                 -highlightthickness 0 \
148                 -variable [$self tkvarname mega_conn_] -value 128000 \
149                 -relief flat -anchor w -padx 10
150         radiobutton $path.r2 -text "T1 (1.5 Mb/s)" \
151                 -highlightthickness 0 \
152                 -variable [$self tkvarname mega_conn_] -value 1500000 \
153                 -relief flat -anchor w -padx 10
154         radiobutton $path.r3 -text "10BaseT (10 Mb/s)" \
155                 -highlightthickness 0 \
156                 -variable [$self tkvarname mega_conn_] -value 10000000 \
157                 -relief flat -anchor w -padx 10
158         radiobutton $path.r4 -text "100BaseT (100 Mb/s)" \
159                 -highlightthickness 0 \
160                 -variable [$self tkvarname mega_conn_] -value 100000000 \
161                 -relief flat -anchor w -padx 10
162         frame $path.r5frame
163         radiobutton $path.r5 -text "Other (bps)" \
164                 -highlightthickness 0 \
165                 -variable [$self tkvarname mega_conn_] -value other \
166                 -relief flat -anchor w -padx 10
167         entry $path.other -width 10 -relief sunken \
168                 -textvariable [$self tkvarname mega_conn_other_]
169         pack $path.r5 $path.other -side left -anchor w -in $path.r5frame
170         foreach i { 0 1 2 3 4 } {
171                 pack $path.r$i -side top -anchor w -in $path.rb -fill x
172         }
173         pack $path.r5frame -side top -anchor w -in $path.rb
174         pack $path.rb -side top -fill x -in $path.mega
175 
176         frame $path.bot
177         label $path.sratelabel -text "Session rate (bps): "
178         entry $path.srate -width 10 -relief sunken \
179                 -textvariable [$self tkvarname session_rate_]
180         pack $path.sratelabel $path.srate -side left -fill x -in $path.bot
181         pack $path.bot -side top -anchor w -fill x -in $path.mega
182 
183         pack $path.mega -side top -expand 1 -fill both -padx 5
184 
185         frame $path.buttons
186         button $path.save  -text "Save" -command "$self save_prefs"
187         button $path.reset -text "Reset" -command "$self load_prefs"
188         button $path.default -text "Load defaults" -command \
189                         "$self default_prefs"
190         pack $path.save $path.reset $path.default -in $path.buttons -side left\
191                         -anchor e
192         pack $path.buttons -side top -anchor e -pady 5 -padx 2
193 
194         label $path.status -textvariable [$self tkvarname status_] -anchor w \
195                         -justify left
196         pack $path.status -fill x -side top -anchor w
197 
198         $self change_usemega
199 }
200 
201 
202 PathFinderPrefs public change_usemega { args } {
203         $self tkvar usemega_
204 
205         if $usemega_ {
206                 set state normal
207                 set fg [WidgetClass widget_default -foreground]
208         } else {
209                 set state disabled
210                 set fg [WidgetClass widget_default -disabledforeground]
211         }
212 
213         set path [$self info path]
214         foreach i { 0 1 2 3 4 5 } {
215                 $path.r$i configure -state $state
216         }
217 
218         $path.other configure -foreground $fg
219         $path.srate configure -foreground $fg
220         $path.sratelabel configure -foreground $fg
221 
222         $path.other configure -state $state
223         $path.srate configure -state $state
224 }
225 
226 
227 PathFinderPrefs public change_mega_conn { args } {
228         $self tkvar mega_conn_ mega_conn_other_ session_rate_
229         if { $mega_conn_!="other" } { set session_rate_ [expr $mega_conn_/2] }\
230                         else { set session_rate_ [expr $mega_conn_other_/2] }
231 
232 }
233 
234 . configure -bg \#FFFFFF
235 PathFinderPrefs .f
236 pack .f -padx 5 -pady 5 -anchor nw
237 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.