Fixing wayward constness and general tidy-up.
[dyninst.git] / paradyn / tcl / generic.tcl
1 # $Id: generic.tcl,v 1.2 1998/03/03 23:09:46 wylie Exp $
2 # Routines found useful across all tk4.0 programs
3
4 proc resize1Scrollbar {sbname newTotal newVisible} {
5    # This is a nice n' generic routine  --ari
6    # However, it is (currently) only called from C++ code.  If this
7    # situation doesn't change, then we might want to just
8    # zap this and turn it into C++ code...
9
10    # 'newTotal' and 'newVisible' are tentative values;
11    # We use them to calculate 'newFirst' and 'newLast'.
12    # We make an effort to keep 'newFirst' as close as possible to 'oldFirst'.
13
14    set oldConfig [$sbname get]
15    set oldFirst  [lindex $oldConfig 0]
16    set oldLast   [lindex $oldConfig 1]
17 #   puts stderr "newTotal=$newTotal; newVisible=$newVisible; oldFirst=$oldFirst; oldLast=$oldLast"
18
19    if {$newVisible < $newTotal} {
20       # The usual case: not everything fits
21       set fracVisible [expr 1.0 * $newVisible / $newTotal]
22 #      puts stderr "newVisible=$newVisible; newTotal=$newTotal; fracVisible=$fracVisible"
23
24       set newFirst $oldFirst
25       set newLast [expr $newFirst + $fracVisible]
26
27 #      puts stderr "tentative newFirst=$newFirst; newLast=$newLast"
28
29       if {$newLast > 1.0} {
30          set theOverflow [expr $newLast - 1.0]
31 #         puts stderr "resize1Scrollbar: would overflow by fraction of $theOverflow; moving newFirst back"
32
33          set newFirst [expr $oldFirst - $theOverflow]
34          set newLast  [expr $newFirst + $fracVisible]
35       } else {
36 #         puts stderr "resize1Scrollbar: yea, we were able to keep newFirst unchanged at $newFirst"
37       }
38    } else {
39       # the unusual case: everything fits (visible >= total)
40 #      puts stderr "everything fits"
41       set newFirst 0.0
42       set newLast  1.0
43    }
44
45    if {$newFirst < 0} {
46       # This is an assertion failure
47       puts stderr "resize1Scrollbar warning: newFirst is $newFirst"
48    }
49    if {$newLast > 1} {
50       # This is an assertion failure
51       puts stderr "resize1Scrollbar warning: newLast is $newLast"
52    }
53
54    $sbname set $newFirst $newLast
55    return $newFirst
56 }