Fixing wayward constness and general tidy-up.
[dyninst.git] / paradyn / tcl / tclTunable.tcl
1 # tclTunable.tcl
2
3 # $Log: tclTunable.tcl,v $
4 # Revision 1.17  1996/02/23 22:10:31  tamches
5 # initial window geometry (in particular, width) should finally be correct
6 #
7 # Revision 1.16  1995/11/29 00:22:21  tamches
8 # removed refs to PdBitmapDir; we now call makeLogo (pdLogo.C)
9 #
10 # Revision 1.15  1995/11/16 00:48:25  tamches
11 # logo is now looked for in $PdBitmapDir, instead of being hard-coded in.
12 # selecting "tunable constants" when the window already exists will now
13 # de-iconify and raise it (instead of doing nothing)
14 #
15 # Revision 1.14  1995/10/12 18:34:10  tamches
16 # Got rid of boolTunableDescriptionU and floatTunableDescriptionUMM,
17 # which were causing mysterious tcl code crashes.  Replaced with the
18 # corresponding [uimpd tclTunable ...] calls, which is probably how it
19 # should have been all along.
20 #
21 # Revision 1.13  1995/07/13 03:24:41  tamches
22 # some geometry and scrollbar fixes for tk4.0
23 #
24 # Revision 1.12  1995/07/02  20:01:08  tamches
25 # port to tk4.0
26 #
27
28 # To do list:
29 # 1) if user deletes tunable descriptions window (using window mgr), then
30 #    we'll get confused because tunable descriptions will still be true.
31 #    Would like to detect when a window is destroyed, and set tunable descriptions
32 #    false.  Something tells me this is doable in tcl.
33
34 # #################### Some Misc Routines #####################
35 proc max {x y} {
36    if {$x > $y} {
37       return $x
38    } else {
39       return $y
40    }
41 }
42
43 # warning!  These routines will return an old number if an important
44 # event (i.e. resize) happened but idle routines haven't yet kicked in.
45 # --> *** In such cases, be sure to grab the latest information directly
46 #         from the event structure instead of calling these routines!!!!
47 proc getWindowWidth {wName} {
48    set result [winfo width $wName]
49    if {$result == 1} {
50       # hack for a window that hasn't yet been mapped
51       set result [winfo reqwidth $wName]
52    }
53    return $result
54 }
55
56 proc getWindowHeight {wName} {
57    set result [winfo height $wName]
58    if {$result == 1} {
59       set result [winfo reqheight $wName]
60    }
61    return $result
62 }
63 # #############################################################
64
65 proc tunableInitialize {} {
66    global tunableMinHeight
67    set tunableMinHeight 175
68
69    toplevel .tune -class Tunable
70    wm title .tune "Tunable Constants"
71    # one does not pack a toplevel window...
72
73    #  ################### Default options #################
74    option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-18-*
75    option add *Data*font *-Helvetica-*-r-*-12-*
76    option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
77
78    if {[winfo depth .] > 1} {
79       # You have a color monitor...
80       # change primary background color from 'bisque' to 'grey'
81       option add *tune*Background grey
82       option add *tune*activeBackground LightGrey
83       option add *tune*activeForeground black
84       option add *tune*Scale.activeForeground grey
85
86       option add *tunableDescriptions*Background grey
87       option add *tunableDescriptions*activeBackground LightGrey
88       option add *tunableDescriptions*activeForeground black
89       option add *tunableDescriptions*Scale.activeForeground grey
90    } else {
91       # You don't have a color monitor...
92       option add *tune*Background white
93       option add *tune*Foreground black
94
95       option add *tunableDescriptions*Background white
96       option add *tunableDescriptions*Foreground black
97    }
98
99    # .tune.top -- stuff at the top (menu bar, title bar, logo, other miscellanea)
100    frame .tune.top
101    pack  .tune.top -side top -fill x -expand false
102       # expand is false; if the window is made taller, we don't want the extra height
103    
104    # .tune.top.logo -- paradyn logo
105    makeLogo .tune.top.logo paradynLogo raised 2 cornflowerblue
106    pack  .tune.top.logo -side right
107       # expand is false; if the window is made wider, we don't want the extra width
108  
109    # .tune.top.left -- stuff to the left of the logo (title bar & menu bar)
110    frame .tune.top.left
111    pack  .tune.top.left -side left -fill both -expand true
112       # expand is true; we'll take extra height (don't worry, .tune.top won't get taller)
113
114    # .tune.top.left.mbar -- Menu Bar   
115    frame .tune.top.left.mbar -borderwidth 2 -relief raised
116    pack  .tune.top.left.mbar -side bottom -fill x -expand false
117       # expand is false; if the window is made taller, we don't want the extra height
118    
119    menubutton .tune.top.left.mbar.help -text Help -menu .tune.top.left.mbar.help.m
120    menu .tune.top.left.mbar.help.m
121    .tune.top.left.mbar.help.m add command -label "Show Tunable Descriptions" \
122                -command processShowTunableDescriptions
123
124    pack .tune.top.left.mbar.help -side right -padx 4
125
126    # .tune.top.left.titlebar -- Title ("Tunable Constants") (above menu bar)
127    label .tune.top.left.titlebar -text "Tunable Constants" -foreground white \
128            -background "cornflower blue" -font *-New*Century*Schoolbook-Bold-R-*-14-* \
129            -anchor c -relief raised
130    pack  .tune.top.left.titlebar -side top -fill both -expand true
131       # expand is true; we want to fill up .tune.top.left (which itself won't enlarge so OK)
132
133    # .tune.bottom (buttons)
134    frame .tune.bottom -relief sunken
135    pack  .tune.bottom -side bottom -fill x -expand false -ipadx 4 -ipady 4
136       # expand is false; if the window is made taller, we don't want the extra height
137
138    frame  .tune.bottom.buttonFrame
139    pack   .tune.bottom.buttonFrame -side top -fill y -expand true
140
141    button .tune.bottom.buttonFrame.accept -text "Accept" -anchor c \
142            -command processCommitFinalTunableValues
143    pack   .tune.bottom.buttonFrame.accept -side left -ipadx 10
144
145    frame  .tune.bottom.buttonFrame.middle -width 20
146    pack   .tune.bottom.buttonFrame.middle -side left
147
148    button .tune.bottom.buttonFrame.discard -text "Cancel" -anchor c \
149            -command processDiscardFinalTunableValues
150    pack   .tune.bottom.buttonFrame.discard -side right -ipadx 10
151    
152    # .tune.middle -- body of the window (scrollbar & tunable constants canvas)
153    frame .tune.middle
154    pack  .tune.middle -side top -fill both -expand true
155       # expand is true; we want extra width & height if the window is resized
156
157    scrollbar .tune.middle.scrollbar -orient vertical -width 16 \
158         -background gray -activebackground gray -relief sunken \
159         -command ".tune.middle.canvas yview"
160    pack      .tune.middle.scrollbar -side left -fill y -expand false
161       # expand is false; if the window is made wider, we don't want the extra width
162    
163    canvas .tune.middle.canvas -relief flat -yscrollcommand myScroll \
164            -yscrollincrement 1
165    pack   .tune.middle.canvas -side left -fill both -expand true
166
167    frame .tune.middle.canvas.names
168    frame .tune.middle.canvas.values
169
170    # the following line avoids flickering, but there is a cost: the window won't start off with
171    # exactly the right window size.  To be more specific, it won't intelligently
172    # set the size of the canvas subwindow to be exactly the sum of sizes of
173    # the children.  Instead, it will go with whatever the initial value is provided.
174    pack propagate .tune.middle.canvas false
175    pack   .tune.middle.canvas -side left -fill both -expand true
176       # expand is true; we want extra height & width is the window is resized
177 }
178
179 proc myScroll {left right} {
180    # gets called whenever the canvas view changes [scroll] or gets resized.
181    # Gives us a chance to rethink the bounds of the scrollbar
182 #   puts stderr "welcome to myScroll (canvas must have scrolled or been resized)"
183
184    global lastVisibleHeight lastVisibleWidth
185
186    set newWidth  [getWindowWidth  .tune.middle.canvas]
187    set newHeight [getWindowHeight .tune.middle.canvas]
188    
189    if {$lastVisibleHeight != $newHeight || $lastVisibleWidth != $newWidth} {
190 #      puts stderr "myScroll: redrawing tunables on canvas due to apparant resize"
191
192       drawTunables $newWidth $newHeight
193    }
194
195    .tune.middle.scrollbar set $left $right
196
197    set lastVisibleWidth $newWidth
198    set lastVisibleHeight $newHeight
199 }
200
201 proc tunableBoolLabelEnter {lcv} {
202    set buttonLabelWin .tune.middle.canvas.names.tunable$lcv.label
203    set dummyLabelWin  .tune.middle.canvas.values.tunable$lcv.dummy
204    set valuesLabelWin .tune.middle.canvas.values.tunable$lcv.box
205
206    $buttonLabelWin configure -background lightGray 
207    $dummyLabelWin  configure -background lightGray
208    $valuesLabelWin configure -background lightGray
209 }
210
211 proc tunableBoolLabelLeave {lcv} {
212    set buttonLabelWin .tune.middle.canvas.names.tunable$lcv.label
213    set dummyLabelWin .tune.middle.canvas.values.tunable$lcv.dummy
214    set valuesLabelWin .tune.middle.canvas.values.tunable$lcv.box
215
216    $buttonLabelWin configure -background gray
217    $dummyLabelWin  configure -background gray
218    $valuesLabelWin configure -background gray
219 }
220
221 proc tunableBoolLabelPress {lcv} {
222 #   set buttonLabelWin .tune.middle.canvas.names.tunable$lcv.label
223 #   set dummyLabelWin .tune.middle.canvas.values.tunable$lcv.dummy
224    set valuesLabelWin .tune.middle.canvas.values.tunable$lcv.box
225
226 #   $buttonLabelWin configure -relief sunken
227 #   $dummyLabelWin configure -relief sunken
228    $valuesLabelWin configure -relief sunken
229 }
230
231 proc tunableBoolLabelRelease {lcv} {
232    set buttonLabelWin .tune.middle.canvas.names.tunable$lcv.label
233    set dummyLabelWin .tune.middle.canvas.values.tunable$lcv.dummy
234    set valuesLabelWin .tune.middle.canvas.values.tunable$lcv.box
235
236 #   $buttonLabelWin invoke
237 #   $dummyLabelWin  invoke
238    $valuesLabelWin invoke
239
240    $buttonLabelWin configure -relief flat
241    $dummyLabelWin configure -relief flat
242    $valuesLabelWin configure -relief flat
243 }
244
245 proc buttonBindJustHighlight {theButton lcv} {
246    bind $theButton <Enter> "tunableBoolLabelEnter $lcv"
247    bind $theButton <Leave> "tunableBoolLabelLeave $lcv"
248 }
249 proc buttonBind {theButton lcv} {
250    buttonBindJustHighlight $theButton $lcv
251    bind $theButton <ButtonPress-1> "tunableBoolLabelPress $lcv"
252    bind $theButton <ButtonRelease-1> "tunableBoolLabelRelease $lcv"
253 }
254 proc drawBoolTunable {theName} {
255    global nextStartY
256    global namesWidth
257    global numTunablesDrawn
258
259    # the following important vrbles are (associative) arrays (indexed by name) of
260    # boolean tunable constant descriptions and newvalues.
261    global boolTunableNewValues
262
263    set namesWin  .tune.middle.canvas.names.tunable$numTunablesDrawn
264    set valuesWin .tune.middle.canvas.values.tunable$numTunablesDrawn
265
266    frame $namesWin
267    pack  $namesWin -side top -fill x -expand true
268
269    frame $valuesWin
270    pack  $valuesWin -side top -fill x -expand true
271
272    set buttonLabelWin $namesWin.label
273    set valuesLabelWin $valuesWin.box
274    
275    set labelFont *-Helvetica-*-r-*-14-*
276
277    # dummy label.  At first, I used a checkbutton to guarantee that
278    # all 3 widgets would have the same height.  But using
279    # -highlightthickness 0 for the realcheckbutton made them all the
280    # same anyway in tk 4.0
281    label $valuesWin.dummy -relief flat -font $labelFont 
282    pack  $valuesWin.dummy -side left -fill y
283
284    # In order to get the appearance of a checkbutton with the on/off red square
285    # on the right instead of on the left, we use 2 labels & a checkbutton.
286    # The second one is the checkbutton, it has an indicator but no text.
287
288    label $buttonLabelWin -text $theName -anchor w -relief flat -font $labelFont
289    pack  $buttonLabelWin -side left -fill x -expand true
290
291    checkbutton $valuesLabelWin -variable boolTunableNewValues($theName) -anchor w \
292            -relief flat -font $labelFont -highlightthickness 0 -selectcolor blue
293    pack $valuesLabelWin -side left -fill both -expand true
294
295    # now make the label and the checkbutton appear as 1; we play some bind tricks
296
297    set leftButton $buttonLabelWin
298    set dummyButton $valuesWin.dummy
299    set rightButton $valuesLabelWin
300
301    buttonBind $leftButton $numTunablesDrawn
302    buttonBind $dummyButton $numTunablesDrawn
303    buttonBindJustHighlight $rightButton $numTunablesDrawn
304
305    set namesWidth  [max $namesWidth [getWindowWidth $leftButton]]
306    set namesWidth  [max $namesWidth [getWindowWidth $namesWin]]
307
308    set theHeight [max [getWindowHeight $leftButton] [getWindowHeight $rightButton]]
309
310    set nextStartY [expr $nextStartY + $theHeight]
311    incr numTunablesDrawn
312 }
313
314 proc everyChangeCommand {name newValue} {
315    # A scale widget's value has changed.
316    # We are passed the tunable index # and the new integer value.
317  
318    # I repeat: integer value
319    # You may be wondering if this means it's impossible to do our scale
320    # widgets, since we need floating point numbers.  Well, we use some
321    # tricks to get around this limitation.  First of all, the scale widget
322    # does not show any ticks.  That means the numbers can be whatever we
323    # want them to be.  We choose to multiply the min and max by
324    # $integerScaleFactor and then divide it back here...
325
326    # the following important vrbles are (associative) arrays (indexed by name) of
327    # float tunable constant descriptions and newvalues.
328    global floatTunableNewValues
329
330    global integerScaleFactor
331
332    set newValue [expr 1.0 * $newValue / $integerScaleFactor]
333
334    set floatTunableNewValues($name) $newValue
335    # This command automagically updates the entry widget because the
336    # entry widget had its -textvariable set to newTunableValues($name)
337 }
338
339 proc bindFloatEnter {lcv} {
340    .tune.middle.canvas.names.tunable$lcv.label configure -background lightGray
341    if {[winfo exists .tune.middle.canvas.names.tunable$lcv.padding]} {
342       .tune.middle.canvas.names.tunable$lcv.padding configure -background lightGray
343    }
344
345    .tune.middle.canvas.values.tunable$lcv.label configure -background lightGray
346    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.top]} {
347       .tune.middle.canvas.values.tunable$lcv.left.top configure -background lightGray
348    }
349    .tune.middle.canvas.values.tunable$lcv.left configure -background lightGray
350    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.leftTick]} {
351       .tune.middle.canvas.values.tunable$lcv.left.leftTick configure -background lightGray
352       .tune.middle.canvas.values.tunable$lcv.left.rightTick configure -background lightGray
353    }
354    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.padAfterRightTick]} {
355       .tune.middle.canvas.values.tunable$lcv.left.padAfterRightTick configure -background lightGray
356    }
357
358    set entryWin .tune.middle.canvas.values.tunable$lcv.right.top.entry
359    if {[winfo exists $entryWin]} {
360       $entryWin configure -background lightGray
361    }
362 }
363 proc bindFloatLeave {lcv} {
364    .tune.middle.canvas.names.tunable$lcv.label configure -background gray
365    if {[winfo exists .tune.middle.canvas.names.tunable$lcv.padding]} {
366       .tune.middle.canvas.names.tunable$lcv.padding configure -background gray
367    }
368
369    .tune.middle.canvas.values.tunable$lcv.label configure -background gray
370    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.top]} {
371       .tune.middle.canvas.values.tunable$lcv.left.top configure -background gray
372    }
373    .tune.middle.canvas.values.tunable$lcv.left configure -background gray
374    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.leftTick]} {
375       .tune.middle.canvas.values.tunable$lcv.left.leftTick configure -background gray
376       .tune.middle.canvas.values.tunable$lcv.left.rightTick configure -background gray
377    }
378    if {[winfo exists .tune.middle.canvas.values.tunable$lcv.left.padAfterRightTick]} {
379       .tune.middle.canvas.values.tunable$lcv.left.padAfterRightTick configure -background gray
380    }
381
382    set entryWin .tune.middle.canvas.values.tunable$lcv.right.top.entry
383    if {[winfo exists $entryWin]} {
384       $entryWin configure -background gray
385    }
386 }
387
388 proc dummySuppressChar {} {
389 }
390 proc valueBind {theWindow lcv} {
391    bind $theWindow <Enter> "bindFloatEnter $lcv"
392    bind $theWindow <Leave> "bindFloatLeave $lcv"
393 }
394 proc drawFloatTunable {theName leftTickWidth rightTickWidth} {
395    global nextStartY
396    global namesWidth
397
398    global numTunablesDrawn
399    global integerScaleFactor
400
401    # the following important vrbles are (associative) arrays (indexed by name) of
402    # float tunable constant description/use/min/max and newvalues.
403    global floatTunableNewValues
404
405    set tunableDescription [uimpd tclTunable getdescription $theName]
406
407    # if both 0.0, then as far as we're concerned, there are no min/max values.
408    set tunableMin [lindex [uimpd tclTunable getfloatrangebyname $theName] 0]
409    set tunableMax [lindex [uimpd tclTunable getfloatrangebyname $theName] 1]
410
411    set namesWin  .tune.middle.canvas.names.tunable$numTunablesDrawn
412    set valuesWin .tune.middle.canvas.values.tunable$numTunablesDrawn
413    
414    # label widget for the floating tunable's name
415    frame $valuesWin
416    pack  $valuesWin -side top -fill x -expand true
417
418    # dummy label widget (so the right side of the screen will be as tall as the left)
419    set labelFont *-Helvetica-*-r-*-14-*
420    label $valuesWin.label -relief flat -height 1 -font $labelFont
421    pack  $valuesWin.label -side left -fill y
422    valueBind $valuesWin.label $numTunablesDrawn
423
424    frame $valuesWin.left
425    pack  $valuesWin.left -side left -fill both -expand true
426    valueBind $valuesWin.left $numTunablesDrawn
427
428    frame $valuesWin.right
429    pack  $valuesWin.right -side right -fill y
430
431    frame $valuesWin.right.top
432    pack  $valuesWin.right.top -side top -fill x
433    
434    frame $valuesWin.right.bottom
435    pack  $valuesWin.right.bottom -side bottom -fill both -expand true
436    
437    # entry widget
438    set entryWin $valuesWin.right.top.entry
439    entry $entryWin -relief sunken -textvariable floatTunableNewValues($theName) -width 8 -font $labelFont -highlightthickness 0
440
441    # turn off some useless characters (such as "return" key)
442 #   bind $entryWin <Key> {puts stderr "hello %K"}
443    bind $entryWin <Return>   {dummySuppressChar}
444    bind $entryWin <Tab>      {dummySuppressChar}
445    bind $entryWin <KP_Enter> {dummySuppressChar}
446    valueBind $entryWin $numTunablesDrawn
447
448    pack $entryWin -side right -expand false
449       # expand is false; if the window is made taller, we don't want the extra height
450
451    # scale widget 
452    set tickFont *-Helvetica-*-r-*-12-*
453
454    set tickWin $valuesWin.left
455    # a bit of padding between the rightmost tick and the entry widget
456    # (even if a rightmost tick doesn't exist)
457    frame $tickWin.padAfterRightTick -width 10
458    pack  $tickWin.padAfterRightTick -side right
459    valueBind $tickWin.padAfterRightTick $numTunablesDrawn
460
461    if {$tunableMin!=0 || $tunableMax!= 0} {
462       label $tickWin.leftTick -text $tunableMin -font $tickFont -width $leftTickWidth -anchor e
463       pack $tickWin.leftTick -side left
464       valueBind $tickWin.leftTick $numTunablesDrawn
465
466       label $tickWin.rightTick -text $tunableMax -font $tickFont -width $rightTickWidth -anchor w
467       pack $tickWin.rightTick -side right -fill y
468       valueBind $tickWin.rightTick $numTunablesDrawn
469
470       # [other options to try: -font -length -sliderlength -width -showValue]
471       set scaleWin $valuesWin.left.top
472
473       scale $scaleWin -orient horizontal \
474               -relief flat \
475               -command "everyChangeCommand $theName" \
476               -from [expr $integerScaleFactor * $tunableMin] \
477               -to   [expr $integerScaleFactor * $tunableMax] \
478               -showvalue false \
479               -highlightthickness 0
480
481 #             -width [winfo reqheight $entryWin] (makes it too tall for some reason)
482
483       valueBind $scaleWin $numTunablesDrawn
484
485       # initialize the scale setting
486       $scaleWin set [expr round($integerScaleFactor * $floatTunableNewValues($theName))]
487       pack $scaleWin -side top -fill x -expand true
488    }
489
490    # finding the height of the values window is difficult; the frames don't
491    # seem to have a size at this point, even though they and all their children
492    # have been packed.   
493    set valuesWinHeight [getWindowHeight $entryWin]
494    if {$tunableMin!=0 || $tunableMax!=0} {
495       set valuesWinHeight [max $valuesWinHeight [getWindowHeight $scaleWin]]
496    }
497
498    # Now for the left (the name label widget)
499    frame $namesWin -height $valuesWinHeight
500    pack  $namesWin -side top -fill x -expand true
501
502    label $namesWin.label -text $theName -anchor w -font $labelFont -height 1
503    pack  $namesWin.label -side top -fill x
504    valueBind $namesWin.label $numTunablesDrawn
505
506    set paddingHeight [expr $valuesWinHeight - [getWindowHeight $namesWin.label]]
507    if {$tunableMin==0 && $tunableMax==0} {
508       incr paddingHeight
509    }
510 #   puts stderr "paddingHeight for $theName is $paddingHeight"
511    if {$paddingHeight > 0} {
512       frame $namesWin.padding -height $paddingHeight
513       pack  $namesWin.padding -side bottom -fill both
514       valueBind $namesWin.padding $numTunablesDrawn
515    }
516
517    # finding the height of the left window is easy; it has no frames to confuse us
518    set namesWinHeight [max [getWindowHeight $namesWin] [getWindowHeight $namesWin.label]]
519
520    set theHeight [max $namesWinHeight $valuesWinHeight]
521
522    # update the frames' (plural) heights so they're equal
523 #   puts stderr "theHeight=$theHeight"
524
525    $namesWin  configure -height $theHeight
526    $valuesWin configure -height $theHeight
527
528    set namesWidth  [max $namesWidth  [getWindowWidth $namesWin.label]]
529
530    set nextStartY [expr $nextStartY + $theHeight]
531 #   puts stderr "nextStartY now $nextStartY"
532    incr numTunablesDrawn
533 }
534
535 proc drawTunables {newWidth newHeight} {
536    global numTunablesDrawn
537    global nextStartY
538    global namesWidth
539    global DeveloperModeFlag
540    global tunableMinWidth tunableMinHeight
541
542    global boolTunableNewValues
543    global floatTunableNewValues
544
545    # First, erase old stuff on the screen
546    .tune.middle.canvas delete tunableTag
547
548    destroy .tune.middle.canvas.names
549    destroy .tune.middle.canvas.values
550
551    frame .tune.middle.canvas.names
552    pack  .tune.middle.canvas.names -side left -expand false
553
554    frame .tune.middle.canvas.values
555    pack  .tune.middle.canvas.values -side left -fill x -expand true
556
557    set numTunablesDrawn 0
558
559    set nextStartY 0
560    set namesWidth 0
561
562    # Determine the max # chars needed for the ticks (min/max float strings)
563    # We simply loop through all float tc's (those with min/max defined), doing
564    # a "string length".
565    set leftTickWidth 0
566    set rightTickWidth 0
567    
568    set allFloatNames [uimpd tclTunable getfloatallnames]
569
570    set numFloats [llength $allFloatNames]
571
572    for {set floatlcv 0} {$floatlcv < $numFloats} {incr floatlcv} {
573       set floatName [lindex $allFloatNames $floatlcv]
574       set tunableUse [uimpd tclTunable getusebyname $floatName]
575       if {$tunableUse=="developer" && $DeveloperModeFlag==0} continue
576
577       set tunableBounds [uimpd tclTunable getfloatrangebyname $floatName]
578       set tunableMin [lindex $tunableBounds 0]
579       set tunableMax [lindex $tunableBounds 1]
580
581       if {$tunableMin!=0 || $tunableMax!=0} {
582          set leftTickWidth [max $leftTickWidth [string length $tunableMin]]
583          set rightTickWidth [max $rightTickWidth [string length $tunableMax]]
584       }
585    }
586
587    # make two passes---draw all boolean tunables, then all float tunables.
588    # (looks nicer on screen that way...)
589
590    set allBoolNames [uimpd tclTunable getboolallnames]
591    set numBoolNames [llength $allBoolNames]
592
593    for {set lcv 0} {$lcv < $numBoolNames} {incr lcv} {
594       set theName [lindex $allBoolNames $lcv]
595
596       set theDU [uimpd tclTunable getdescription $theName]
597       set tunableUse [uimpd tclTunable getusebyname $theName]
598
599       # If this tunable constant is a "developer" one, and if we
600       # are not in developer mode, then skip it.
601       if {$tunableUse=="developer" && $DeveloperModeFlag==0} continue
602       drawBoolTunable $theName
603    }
604
605    set numFloatNames [llength $allFloatNames]
606
607    for {set lcv 0} {$lcv < $numFloatNames} {incr lcv} {
608       set theName [lindex $allFloatNames $lcv]
609
610       set tunableUse [uimpd tclTunable getusebyname $theName]
611
612       if {$tunableUse=="developer" && $DeveloperModeFlag==0} continue
613       drawFloatTunable $theName $leftTickWidth $rightTickWidth
614    }
615
616    # the above calls will have updated variables:
617    # namesWidth
618    # nextStartY (will now be total height, in pixels, of the canvas)
619
620    set namesWidth  [max $namesWidth  [getWindowWidth .tune.middle.canvas.names]]
621    set valuesWidth [expr [getWindowWidth .tune.middle.canvas] - $namesWidth]
622
623    .tune.middle.canvas create window 0 0 \
624         -anchor nw -tag tunableTag \
625         -window .tune.middle.canvas.names
626
627    .tune.middle.canvas create window $namesWidth 0 \
628            -anchor nw -tag tunableTag \
629            -window .tune.middle.canvas.values \
630            -width $valuesWidth
631
632    set goodMinWidth [expr $namesWidth + [getWindowWidth .tune.middle.scrollbar] + 245]
633    wm minsize .tune $goodMinWidth $tunableMinHeight
634
635    rethinkScrollBarRegions [getWindowWidth .tune.middle.canvas] [getWindowHeight .tune.middle.canvas]
636
637    global lastVisibleHeight lastVisibleWidth
638    set lastVisibleHeight [getWindowHeight .tune.middle.canvas]
639    set lastVisibleWidth  [getWindowWidth .tune.middle.canvas]
640
641    return $goodMinWidth
642 }
643
644 proc rethinkScrollBarRegions {newWidth newHeight} {
645    # explicitly called by the program after putting up the tunable
646    # constants (e.g. first time, after changing to/from developer mode)
647    # We are passed how many pixels the tunables take up, and we adjust
648    # the canvas' scrollregion and the scrollbar settings accordingly.
649
650    global nextStartY
651
652 #   puts stderr "welcome to rethinkScrollbarRegion; window width=$newWidth, height=$newHeight; fullHeight=$nextStartY"
653
654    # update the scrollbar's scrollregion configuration
655    set regionList {0 0 0 0}
656    set regionList [lreplace $regionList 2 2 $newWidth]
657    set regionList [lreplace $regionList 3 3 $nextStartY]
658    .tune.middle.canvas configure -scrollregion $regionList
659
660    set newFirst 0
661    set fracVisible [expr 1.0 * $newHeight / $nextStartY]
662 #   puts stderr "rethinkScrollbarRegion: fracVisible=$fracVisible"
663    set newLast [expr $newFirst + $fracVisible]
664
665    .tune.middle.scrollbar set $newFirst $newLast
666 }
667
668 proc gatherInitialTunableValues {} {
669    # associative array (by name) of description/use
670    # associative array (by name) of bool value
671    global boolTunableOldValues boolTunableNewValues
672
673    # associative array (by name) of description/use/min/max
674    # associative array (by name) of float value
675    global floatTunableOldValues floatTunableNewValues
676
677    # First, we initialize all the boolean tunable constants:
678    set allBoolNames [uimpd tclTunable getboolallnames]
679    set numBoolNames [llength $allBoolNames]
680
681    for {set lcv 0} {$lcv < $numBoolNames} {incr lcv} {
682       set theName [lindex $allBoolNames $lcv]
683
684       set theDescription [uimpd tclTunable getdescription $theName]
685       set theUse         [uimpd tclTunable getusebyname $theName] 
686       set theList [list $theDescription $theUse]
687
688       set boolTunableOldValues($theName) [uimpd tclTunable getvaluebyname $theName]
689       set boolTunableNewValues($theName) $boolTunableOldValues($theName)
690    }
691
692 #   puts stderr "gatherInitialTunableValues -- bool tunable constants have been initialized"
693
694    # Next, we initialize all the float tunable constants:
695    set allFloatNames [uimpd tclTunable getfloatallnames]
696    set numFloatNames [llength $allFloatNames]
697    for {set lcv 0} {$lcv < $numFloatNames} {incr lcv} {
698       set theName [lindex $allFloatNames $lcv]
699
700       set floatTunableOldValues($theName) [uimpd tclTunable getvaluebyname $theName]
701       set floatTunableNewValues($theName) $floatTunableOldValues($theName)
702    }
703 }
704
705 proc processCommitFinalTunableValues {} {
706    global boolTunableOldValues boolTunableNewValues
707    global floatTunableOldValues floatTunableNewValues
708
709    set allBoolNames [uimpd tclTunable getboolallnames]
710    set numBoolNames [llength $allBoolNames]
711    for {set lcv 0} {$lcv < $numBoolNames} {incr lcv} {
712       set theName [lindex $allBoolNames $lcv]
713       if {$boolTunableNewValues($theName) != $boolTunableOldValues($theName)} {
714 #         puts stderr "processFinalTunableValues: tunable $theName has changed from $boolTunableOldValues($theName) to $boolTunableNewValues($theName)!"
715
716          uimpd tclTunable setvaluebyname $theName $boolTunableNewValues($theName)
717       }
718    }
719
720    # Now the same for float tunables:
721    set allFloatNames [uimpd tclTunable getfloatallnames]
722    set numFloatNames [llength $allFloatNames]
723    for {set lcv 0} {$lcv < $numFloatNames} {incr lcv} {
724       set theName [lindex $allFloatNames $lcv]
725       if {$floatTunableNewValues($theName) != $floatTunableOldValues($theName)} {
726 #         puts stderr "processFinalTunableValues: tunable $theName has changed from $floatTunableOldValues($theName) to $floatTunableNewValues($theName)!"
727
728          uimpd tclTunable setvaluebyname $theName $floatTunableNewValues($theName)
729       }
730    }
731   
732    tunableExitPoint
733 }
734
735 proc processDiscardFinalTunableValues {} {
736    tunableExitPoint
737 }
738
739 # ******************* Tunable Descriptions Stuff *****************
740
741 proc processShowTunableDescriptions {} {
742    global numTunableDescriptionsDrawn
743    global tunableTitleFont tunableDescriptionFont
744    global tunableDescriptionsMinWidth tunableDescriptionsMinHeight
745    global tunableDescriptionsMaxWidth tunableDescriptionsMaxHeight
746    global lastVisibleDescriptionsWidth lastVisibleDescriptionsHeight
747
748    if {[winfo exists .tunableDescriptions]} {
749       return
750    }
751
752    set numTunableDescriptionsDrawn 0
753
754    set tunableTitleFont *-Helvetica-*-r-*-14-*
755    set tunableDescriptionFont *-Helvetica-*-r-*-12-*
756
757    set tunableDescriptionsMinWidth  150
758    set tunableDescriptionsMinHeight 150
759
760    set lastVisibleDescriptionsWidth 0
761    set lastVisibleDescriptionsHeight 0
762
763    toplevel .tunableDescriptions -class TunableDescriptions
764    wm title .tunableDescriptions "Tunable Descriptions"
765    # one does not pack a toplevel window
766
767    frame .tunableDescriptions.bottom -relief groove
768    pack  .tunableDescriptions.bottom -side bottom -fill x -expand false
769       # expand is false; if the window is made taller, we don't want the extra height
770
771    frame .tunableDescriptions.bottom.frame
772    pack  .tunableDescriptions.bottom.frame -side bottom -fill y -expand true
773
774    button .tunableDescriptions.bottom.frame.okay -text "Dismiss" -command closeTunableDescriptions
775    pack   .tunableDescriptions.bottom.frame.okay -side left -pady 6
776
777    frame .tunableDescriptions.top
778    pack  .tunableDescriptions.top -side top -fill both -expand true
779       # expand is true; if the window is made taller, we want the extra height
780
781    scrollbar .tunableDescriptions.top.scrollbar -orient vertical -width 16 \
782            -background gray -activebackground gray -relief sunken \
783            -command ".tunableDescriptions.top.canvas yview"
784    pack      .tunableDescriptions.top.scrollbar -side left -fill y -expand false
785       # expand is false; if the window is made wider, we don't want the extra width
786
787    canvas .tunableDescriptions.top.canvas \
788         -yscrollcommand myDescriptionsScroll \
789         -yscrollincrement 1 \
790         -width 4i -height 3i
791    pack propagate .tunableDescriptions.top.canvas false
792    pack   .tunableDescriptions.top.canvas -side left -fill both -expand true
793       # expand is true; we want extra width & height if window is resized
794
795    wm minsize .tunableDescriptions $tunableDescriptionsMinWidth $tunableDescriptionsMinHeight
796
797    drawTunableDescriptions
798 }
799
800 proc draw1TunableDescription {theName theDescription} {
801    global numTunableDescriptionsDrawn
802    global tunableDescriptionsTotalHeight
803    global tunableTitleFont
804    global tunableDescriptionFont
805
806    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn
807    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn \
808            -side top -fill x -expand false
809       # we don't want extra height after resizing
810
811    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top
812    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top \
813            -side top -fill x -expand false
814
815    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.left
816    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.left \
817            -side left
818
819    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.right
820    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.right \
821            -side right -fill x
822
823    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom
824    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom \
825            -side top -fill x -expand false
826
827    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.left -width 20
828    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.left \
829            -side left
830
831    frame .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.right
832    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.right \
833            -side right -fill x -expand false
834
835    message .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.left.label \
836       -text $theName -foreground "blue" -justify left -width 3i \
837       -font $tunableTitleFont
838    pack  .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.left.label \
839       -side top -fill x -expand false
840       # we don't want extra height after resizing
841
842    set tunableDescriptionsTotalHeight [expr $tunableDescriptionsTotalHeight + [getWindowHeight .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.top.left.label]]
843
844    message .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.right.msg \
845          -width 3i -justify left -text "$theDescription" \
846          -font $tunableDescriptionFont
847
848    pack .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.right.msg \
849          -side top -fill x -expand false
850          # we don't want extra height after resizing
851
852    set tunableDescriptionsTotalHeight [expr $tunableDescriptionsTotalHeight + [getWindowHeight .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn.bottom.right.msg]]
853
854    .tunableDescriptions.top.canvas create window \
855               0 $tunableDescriptionsTotalHeight \
856               -anchor sw \
857               -window .tunableDescriptions.top.canvas.frame$numTunableDescriptionsDrawn \
858               -tag description
859               
860    incr numTunableDescriptionsDrawn
861 }
862
863 proc drawTunableDescriptions {} {
864    global DeveloperModeFlag
865    global numTunableDescriptionsDrawn
866    global tunableDescriptionsTotalHeight
867    global tunableDescriptionFont
868
869    # delete old stuff...
870    .tunableDescriptions.top.canvas delete description
871    for {set lcv 0} {$lcv<$numTunableDescriptionsDrawn} {incr lcv} {
872       destroy .tunableDescriptions.top.canvas.frame$lcv
873    }
874
875    set numTunableDescriptionsDrawn 0
876    set tunableDescriptionsTotalHeight 0
877
878    # First, draw boolean descriptions
879    set allBoolNames [uimpd tclTunable getboolallnames]
880    set numBoolNames [llength $allBoolNames]
881    for {set lcv 0} {$lcv < $numBoolNames} {incr lcv} {
882       set theName [lindex $allBoolNames $lcv]
883
884       set theDescription [uimpd tclTunable getdescription $theName]
885
886       set theUse [uimpd tclTunable getusebyname $theName]
887       
888       if {$theUse=="developer" && $DeveloperModeFlag==0} continue
889
890       draw1TunableDescription $theName $theDescription
891    }      
892
893    # Next, draw float descriptions
894    set allFloatNames [uimpd tclTunable getfloatallnames]
895    set numFloatNames [llength $allFloatNames]
896
897    for {set lcv 0} {$lcv < $numFloatNames} {incr lcv} {
898       set theName [lindex $allFloatNames $lcv]
899       
900       set theDescription [uimpd tclTunable getdescription $theName]
901       set theUse [uimpd tclTunable getusebyname $theName]
902       
903       if {$theUse=="developer" && $DeveloperModeFlag==0} continue
904
905       draw1TunableDescription $theName $theDescription
906    }      
907
908    rethinkTunableDescriptionsScrollbarRegion
909 }
910
911 proc rethinkTunableDescriptionsScrollbarRegion {} {
912    # Explicitly called by us.
913    # Recalculates the canvas region and adjusts the scrollbar accordingly
914    global tunableDescriptionsTotalHeight
915
916    # update the scrollbar's scrollregion configuration
917    set regionList {0 0 0 0}
918    set regionList [lreplace $regionList 2 2 [getWindowWidth .tunableDescriptions.top.canvas]]
919    set regionList [lreplace $regionList 3 3 $tunableDescriptionsTotalHeight]
920    .tunableDescriptions.top.canvas configure -scrollregion $regionList
921
922    set oldconfig [.tunableDescriptions.top.scrollbar get]
923    set oldTotalHeight [lindex $oldconfig 0]
924
925    if {$oldTotalHeight != $tunableDescriptionsTotalHeight} {
926       set firstUnit 0
927    } else {
928       # no change
929       set firstUnit [lindex $oldconfig 2]
930    }
931
932    set lastUnit [expr $firstUnit + $tunableDescriptionsTotalHeight - 1]
933    .tunableDescriptions.top.scrollbar set $tunableDescriptionsTotalHeight \
934            [getWindowHeight .tunableDescriptions.top.canvas] \
935            $firstUnit $lastUnit
936 }
937
938 proc myDescriptionsScroll {left right} {
939    # gets called whenever the canvas view changes or gets resized.
940    # gets called on each movement of scrollbar (ack!)
941    # we are supposed to rethink the scrollbar settings now.
942    global lastVisibleDescriptionsHeight
943    global lastVisibleDescriptionsWidth
944
945    set newWidth  [getWindowWidth  .tunableDescriptions.top.canvas]
946    set newHeight [getWindowHeight .tunableDescriptions.top.canvas]
947
948    if {$lastVisibleDescriptionsHeight != $newHeight || $lastVisibleDescriptionsWidth != $newWidth} {
949       drawTunableDescriptions
950    } else {
951       .tunableDescriptions.top.scrollbar set $left $right
952    }
953
954    set lastVisibleDescriptionsHeight $newHeight
955    set lastVisibleDescriptionsWidth $newWidth
956 }
957
958 proc closeTunableDescriptions {} {
959    global numTunableDescriptionsDrawn
960    set numTunableDescriptionsDrawn 0
961
962    destroy .tunableDescriptions
963 }
964
965 # ###################### Entrypoint Routine ####################
966
967 proc tunableEntryPoint {} {
968    global numTunablesDrawn
969    global nextStartY
970    global integerScaleFactor
971    global DeveloperModeFlag
972    global lastVisibleWidth lastVisibleHeight
973
974    if {[winfo exists .tune]} {
975       # tunable constants window already exists; let's de-iconify it
976       # (if necessary) and raise it to the front of all other toplevel windows.
977       wm deiconify .tune
978       raise .tune
979
980       return
981    }
982
983    set DeveloperModeFlag [uimpd tclTunable getvaluebyname developerMode]
984
985    set lastVisibleWidth 0
986    set lastVisibleHeight 0
987
988    tunableInitialize
989
990    gatherInitialTunableValues
991
992    set numTunablesDrawn 0
993    set nextStartY 0
994    set integerScaleFactor 20
995
996    set goodMinWidth [drawTunables [getWindowWidth .tune.middle.canvas] [getWindowHeight .tune.middle.canvas]]
997
998    set oldGeometry [wm geometry .tune]
999    if {$oldGeometry!="1x1+0+0"} {
1000       set numscanned [scan $oldGeometry "%dx%d+%d+%d" oldWidth oldHeight oldx oldy]
1001       if {$numscanned==4} {
1002          if {$oldWidth < $goodMinWidth} {
1003             puts stderr "resizing to $goodMinWidth"
1004             wm geometry .tune [format "%dx%d" $goodMinWidth $oldHeight]
1005          }
1006       } else {
1007          puts stderr "tclTunable.tcl: could not scan geometry...won't try to resize"
1008       }
1009    } else {
1010       # No geometry has been set yet; we have free reign
1011       set defaultHeight 330
1012       wm geometry .tune [format "%dx%d" $goodMinWidth $defaultHeight]
1013    }
1014 }
1015
1016 proc tunableExitPoint {} {
1017    # destroy our toplevel windows (and all their subwindows)
1018    destroy .tune
1019
1020    if {[winfo exists .tunableDescriptions]} {
1021       destroy .tunableDescriptions
1022    }
1023 }