Fixing wayward constness and general tidy-up.
[dyninst.git] / paradyn / tcl / whereAxis.tcl
1 # $Id: whereAxis.tcl,v 1.9 1998/03/03 23:09:53 wylie Exp $
2
3 # ##################################################################
4
5 proc whereAxisInitialize {} {
6    toplevel .whereAxis -class "WhereAxis"
7    option add *whereAxis*Background grey
8    option add *whereAxis*activeBackground LightGrey
9    option add *activeForeground black
10    wm protocol .whereAxis WM_DELETE_WINDOW {wm iconify .whereAxis}
11    
12    frame .whereAxis.top
13    pack  .whereAxis.top -side top -fill x -expand false -anchor n
14       # area for menubar
15    
16    frame .whereAxis.top.mbar -borderwidth 2 -relief raised
17    pack  .whereAxis.top.mbar -side top -fill both -expand false
18    
19    menubutton .whereAxis.top.mbar.sel -text Selections -menu .whereAxis.top.mbar.sel.m
20    menu .whereAxis.top.mbar.sel.m -selectcolor cornflowerblue
21    .whereAxis.top.mbar.sel.m add command -label "Clear" -command whereAxisClearSelections
22    
23    menubutton .whereAxis.top.mbar.nav -text Navigate -menu .whereAxis.top.mbar.nav.m
24    menu .whereAxis.top.mbar.nav.m -selectcolor cornflowerblue
25    
26    menubutton .whereAxis.top.mbar.abs -text Abstraction -menu .whereAxis.top.mbar.abs.m
27    menu .whereAxis.top.mbar.abs.m -selectcolor cornflowerblue
28    
29    pack .whereAxis.top.mbar.sel .whereAxis.top.mbar.nav .whereAxis.top.mbar.abs -side left -padx 4
30    
31    # -----------------------------------------------------------
32    
33    frame .whereAxis.nontop
34    pack  .whereAxis.nontop -side bottom -fill both -expand true
35    
36    # -----------------------------------------------------------
37    
38    frame .whereAxis.nontop.main -width 3i -height 2.5i
39    pack  .whereAxis.nontop.main -side top -fill both -expand true
40    
41    scrollbar .whereAxis.nontop.main.leftsb -orient vertical -width 16 -background gray \
42         -activebackground gray \
43         -command "whereAxisNewVertScrollPosition"
44    
45    pack .whereAxis.nontop.main.leftsb -side left -fill y -expand false
46    
47    scrollbar .whereAxis.nontop.main.bottsb -orient horizontal -width 16 \
48         -activebackground gray \
49         -command "whereAxisNewHorizScrollPosition"
50    
51    pack .whereAxis.nontop.main.bottsb -side bottom -fill x -expand false
52    
53    frame .whereAxis.nontop.main.all -relief flat -width 3i -height 2i
54    pack .whereAxis.nontop.main.all -side left -fill both -expand true
55    
56    # -----------------------------------------------------------
57
58    frame .whereAxis.nontop.find
59    pack  .whereAxis.nontop.find -side top -fill both -expand false
60    
61    label .whereAxis.nontop.find.label -relief sunken -text "Search:" \
62         -font { Helvetica 12 }
63    pack  .whereAxis.nontop.find.label -side left -fill y -expand false
64    
65    entry .whereAxis.nontop.find.entry -relief sunken -font { Helvetica 12 }
66    pack  .whereAxis.nontop.find.entry -side left -fill x -expand true
67    
68    bind  .whereAxis.nontop.find.entry <Return> {whereAxisFindHook [.whereAxis.nontop.find.entry get]}
69    
70    # -----------------------------------------------------------
71    
72    whereAxisDrawTipsBase
73    whereAxisDrawTips
74
75    # -----------------------------------------------------------
76    
77    # install resize, expose, and button event hooks for .whereAxis.nontop.main.all
78    bind .whereAxis.nontop.main.all <Configure> {whereAxisConfigureHook}
79    bind .whereAxis.nontop.main.all <Expose>    {whereAxisExposeHook %c}
80    bind .whereAxis.nontop.main.all <Visibility> {whereAxisVisibilityHook %s}
81    bind .whereAxis.nontop.main.all <Button-1>  {whereAxisSingleClickHook %x %y}
82    bind .whereAxis.nontop.main.all <Button-2>  {whereAxisSingleClickHook %x %y}
83    bind .whereAxis.nontop.main.all <Double-Button-1> {whereAxisDoubleClickHook %x %y}
84    bind .whereAxis.nontop.main.all <Shift-Double-Button-1> {whereAxisShiftDoubleClickHook %x %y}
85    bind .whereAxis.nontop.main.all <Control-Double-Button-1> {whereAxisCtrlDoubleClickHook %x %y}
86    bind .whereAxis.nontop.main.all <Alt-Motion> {whereAxisAltPressHook %x %y}
87    bind .whereAxis.nontop.main.all <Motion> {whereAxisAltReleaseHook}
88    
89    set currMenuAbstraction 1
90 }
91
92 proc whereAxisDrawTipsBase {} {
93    frame .whereAxis.nontop.tips
94    pack .whereAxis.nontop.tips -side top -fill x -expand false
95 }
96
97 proc whereAxisDrawTips {} {
98    if { [winfo exists .whereAxis.nontop.tips.tip1] } {
99       return
100    }
101
102    label .whereAxis.nontop.tips.tip1 -relief groove \
103            -text "Click to select; double-click to expand/un-expand" \
104            -font { Helvetica 12 }
105    pack  .whereAxis.nontop.tips.tip1 -side top -fill both -expand false
106       # fill both (instead of just x) seems needed to prevent from shrinking
107       # when window made shorter
108    
109    label .whereAxis.nontop.tips.tip2 -relief groove \
110            -text "Shift-double-click to expand/un-expand all subtrees of a node" \
111            -font { Helvetica 12 }
112    pack  .whereAxis.nontop.tips.tip2 -side top -fill both -expand false
113       # fill both (instead of just x) seems needed to prevent from shrinking
114       # when window made shorter
115    
116    label .whereAxis.nontop.tips.tip3 -relief groove \
117            -text "Ctrl-double-click to select/un-select all subtrees of a node" \
118            -font { Helvetica 12 }
119    pack  .whereAxis.nontop.tips.tip3 -side top -fill both -expand false
120       # fill both (instead of just x) seems needed to prevent from shrinking
121       # when window made shorter
122
123    label .whereAxis.nontop.tips.tip4 -relief groove \
124            -text "Hold down Alt and move the mouse to scroll freely" \
125            -font { Helvetica 12 }
126    pack  .whereAxis.nontop.tips.tip4 -side top -fill both -expand false
127 }
128
129 proc whereAxisEraseTips {} {
130    if { ![winfo exists .whereAxis.nontop.tips.tip1] } {
131       return
132    }
133
134    destroy .whereAxis.nontop.tips
135    whereAxisDrawTipsBase
136 }