Updated Tcl commands to remove errors exposed with port of front end to
[dyninst.git] / paradyn / tcl / whereAxis.tcl
1 # $Id: whereAxis.tcl,v 1.10 1999/03/03 18:18:31 pcroth 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    # we need notification when the whereAxis is to be
17    # destroyed so we can release the fonts it uses
18    bind .whereAxis.top <Destroy> +{whereAxisDestroyHook}
19
20    frame .whereAxis.top.mbar -borderwidth 2 -relief raised
21    pack  .whereAxis.top.mbar -side top -fill both -expand false
22    
23    menubutton .whereAxis.top.mbar.sel -text Selections -menu .whereAxis.top.mbar.sel.m
24    menu .whereAxis.top.mbar.sel.m -selectcolor cornflowerblue
25    .whereAxis.top.mbar.sel.m add command -label "Clear" -command whereAxisClearSelections
26    
27    menubutton .whereAxis.top.mbar.nav -text Navigate -menu .whereAxis.top.mbar.nav.m
28    menu .whereAxis.top.mbar.nav.m -selectcolor cornflowerblue
29    
30    menubutton .whereAxis.top.mbar.abs -text Abstraction -menu .whereAxis.top.mbar.abs.m
31    menu .whereAxis.top.mbar.abs.m -selectcolor cornflowerblue
32    
33    pack .whereAxis.top.mbar.sel .whereAxis.top.mbar.nav .whereAxis.top.mbar.abs -side left -padx 4
34    
35    # -----------------------------------------------------------
36    
37    frame .whereAxis.nontop
38    pack  .whereAxis.nontop -side bottom -fill both -expand true
39    
40    # -----------------------------------------------------------
41    
42    frame .whereAxis.nontop.main -width 3i -height 2.5i
43    pack  .whereAxis.nontop.main -side top -fill both -expand true
44    
45    scrollbar .whereAxis.nontop.main.leftsb -orient vertical -width 16 -background gray \
46         -activebackground gray \
47         -command "whereAxisNewVertScrollPosition"
48    
49    pack .whereAxis.nontop.main.leftsb -side left -fill y -expand false
50    
51    scrollbar .whereAxis.nontop.main.bottsb -orient horizontal -width 16 \
52         -activebackground gray \
53         -command "whereAxisNewHorizScrollPosition"
54    
55    pack .whereAxis.nontop.main.bottsb -side bottom -fill x -expand false
56    
57    frame .whereAxis.nontop.main.all -relief flat -width 3i -height 2i
58    pack .whereAxis.nontop.main.all -side left -fill both -expand true
59    
60    # -----------------------------------------------------------
61
62    frame .whereAxis.nontop.find
63    pack  .whereAxis.nontop.find -side top -fill both -expand false
64    
65    label .whereAxis.nontop.find.label -relief sunken -text "Search:" \
66         -font { Helvetica 12 }
67    pack  .whereAxis.nontop.find.label -side left -fill y -expand false
68    
69    entry .whereAxis.nontop.find.entry -relief sunken -font { Helvetica 12 }
70    pack  .whereAxis.nontop.find.entry -side left -fill x -expand true
71    
72    bind  .whereAxis.nontop.find.entry <Return> {whereAxisFindHook [.whereAxis.nontop.find.entry get]}
73    
74    # -----------------------------------------------------------
75    
76    whereAxisDrawTipsBase
77    whereAxisDrawTips
78
79    # -----------------------------------------------------------
80    
81    # install resize, expose, and button event hooks for .whereAxis.nontop.main.all
82    bind .whereAxis.nontop.main.all <Configure> {whereAxisConfigureHook}
83    bind .whereAxis.nontop.main.all <Expose>    {whereAxisExposeHook %c}
84    bind .whereAxis.nontop.main.all <Visibility> {whereAxisVisibilityHook %s}
85    bind .whereAxis.nontop.main.all <Button-1>  {whereAxisSingleClickHook %x %y}
86    bind .whereAxis.nontop.main.all <Button-2>  {whereAxisSingleClickHook %x %y}
87    bind .whereAxis.nontop.main.all <Double-Button-1> {whereAxisDoubleClickHook %x %y}
88    bind .whereAxis.nontop.main.all <Shift-Double-Button-1> {whereAxisShiftDoubleClickHook %x %y}
89    bind .whereAxis.nontop.main.all <Control-Double-Button-1> {whereAxisCtrlDoubleClickHook %x %y}
90    bind .whereAxis.nontop.main.all <Alt-Motion> {whereAxisAltPressHook %x %y}
91    bind .whereAxis.nontop.main.all <Motion> {whereAxisAltReleaseHook}
92    
93    set currMenuAbstraction 1
94 }
95
96 proc whereAxisDrawTipsBase {} {
97    frame .whereAxis.nontop.tips
98    pack .whereAxis.nontop.tips -side top -fill x -expand false
99 }
100
101 proc whereAxisDrawTips {} {
102    if { [winfo exists .whereAxis.nontop.tips.tip1] } {
103       return
104    }
105
106    label .whereAxis.nontop.tips.tip1 -relief groove \
107            -text "Click to select; double-click to expand/un-expand" \
108            -font { Helvetica 12 }
109    pack  .whereAxis.nontop.tips.tip1 -side top -fill both -expand false
110       # fill both (instead of just x) seems needed to prevent from shrinking
111       # when window made shorter
112    
113    label .whereAxis.nontop.tips.tip2 -relief groove \
114            -text "Shift-double-click to expand/un-expand all subtrees of a node" \
115            -font { Helvetica 12 }
116    pack  .whereAxis.nontop.tips.tip2 -side top -fill both -expand false
117       # fill both (instead of just x) seems needed to prevent from shrinking
118       # when window made shorter
119    
120    label .whereAxis.nontop.tips.tip3 -relief groove \
121            -text "Ctrl-double-click to select/un-select all subtrees of a node" \
122            -font { Helvetica 12 }
123    pack  .whereAxis.nontop.tips.tip3 -side top -fill both -expand false
124       # fill both (instead of just x) seems needed to prevent from shrinking
125       # when window made shorter
126
127    label .whereAxis.nontop.tips.tip4 -relief groove \
128            -text "Hold down Alt and move the mouse to scroll freely" \
129            -font { Helvetica 12 }
130    pack  .whereAxis.nontop.tips.tip4 -side top -fill both -expand false
131 }
132
133 proc whereAxisEraseTips {} {
134    if { ![winfo exists .whereAxis.nontop.tips.tip1] } {
135       return
136    }
137
138    destroy .whereAxis.nontop.tips
139    whereAxisDrawTipsBase
140 }