removed resize1ScrollBar (moved to generic.tcl)
[dyninst.git] / paradyn / tcl / whereAxis.tcl
1 # whereAxis.tcl
2 # Ariel Tamches
3
4 #
5 # $Log: whereAxis.tcl,v $
6 # Revision 1.7  1996/01/11 00:54:46  tamches
7 # removed resize1ScrollBar (moved to generic.tcl)
8 # removed iconify menu
9 #
10 # Revision 1.6  1995/11/20 04:07:38  tamches
11 # fixed activeBackground and activeForeground colors which had made for
12 # ugly menu highlighting.
13 # Tips can be removed and re-drawn using whereAxisDrawTips and
14 # whereAxisEraseTips command.
15 #
16 # Revision 1.5  1995/10/17 22:25:57  tamches
17 # A few command names have "whereAxis" prepended to them, to differentiate
18 # them from shg tcl code.  Added tip4.
19 #
20 # Revision 1.4  1995/09/20 01:37:11  tamches
21 # Stupid hack to ensure middle-mouse-button can move scrollbars
22 # within the where axis.
23 #
24 # Revision 1.3  1995/07/24  21:38:07  tamches
25 # Implemented alt-freescroll feature
26 #
27 # Revision 1.2  1995/07/18  03:38:08  tamches
28 # Added ctrl-double-click to select/unselect an entire subtree (nonrecursive).
29 # Added "clear" menu item to clear all selections.
30 #
31 # Revision 1.1  1995/07/17  05:00:34  tamches
32 # First version of new where axis
33 #
34 #
35
36 # ##################################################################
37
38 proc whereAxisInitialize {} {
39    toplevel .whereAxis -class "WhereAxis"
40    option add *whereAxis*Background grey
41    option add *whereAxis*activeBackground LightGrey
42    option add *activeForeground black
43    wm protocol .whereAxis WM_DELETE_WINDOW {wm iconify .whereAxis}
44    
45    frame .whereAxis.top
46    pack  .whereAxis.top -side top -fill x -expand false -anchor n
47       # area for menubar
48    
49    frame .whereAxis.top.mbar -borderwidth 2 -relief raised
50    pack  .whereAxis.top.mbar -side top -fill both -expand false
51    
52    menubutton .whereAxis.top.mbar.sel -text Selections -menu .whereAxis.top.mbar.sel.m
53    menu .whereAxis.top.mbar.sel.m -selectcolor cornflowerblue
54    .whereAxis.top.mbar.sel.m add command -label "Clear" -command whereAxisClearSelections
55    
56    menubutton .whereAxis.top.mbar.nav -text Navigate -menu .whereAxis.top.mbar.nav.m
57    menu .whereAxis.top.mbar.nav.m -selectcolor cornflowerblue
58    
59    menubutton .whereAxis.top.mbar.abs -text Abstraction -menu .whereAxis.top.mbar.abs.m
60    menu .whereAxis.top.mbar.abs.m -selectcolor cornflowerblue
61    
62    pack .whereAxis.top.mbar.sel .whereAxis.top.mbar.nav .whereAxis.top.mbar.abs -side left -padx 4
63    
64    # -----------------------------------------------------------
65    
66    frame .whereAxis.nontop
67    pack  .whereAxis.nontop -side bottom -fill both -expand true
68    
69    # -----------------------------------------------------------
70    
71    frame .whereAxis.nontop.main -width 3i -height 2.5i
72    pack  .whereAxis.nontop.main -side top -fill both -expand true
73    
74    scrollbar .whereAxis.nontop.main.leftsb -orient vertical -width 16 -background gray \
75         -activebackground gray \
76         -command "whereAxisNewVertScrollPosition"
77    
78    pack .whereAxis.nontop.main.leftsb -side left -fill y -expand false
79    
80    scrollbar .whereAxis.nontop.main.bottsb -orient horizontal -width 16 \
81         -activebackground gray \
82         -command "whereAxisNewHorizScrollPosition"
83    
84    pack .whereAxis.nontop.main.bottsb -side bottom -fill x -expand false
85    
86    frame .whereAxis.nontop.main.all -relief flat -width 3i -height 2i
87    pack .whereAxis.nontop.main.all -side left -fill both -expand true
88    
89    # -----------------------------------------------------------
90
91    frame .whereAxis.nontop.find
92    pack  .whereAxis.nontop.find -side top -fill both -expand false
93    
94    label .whereAxis.nontop.find.label -relief sunken -font "*-Helvetica-*-r-*-12-*" -text "Search:"
95    pack  .whereAxis.nontop.find.label -side left -fill y -expand false
96    
97    entry .whereAxis.nontop.find.entry -relief sunken -font "*-Helvetica-*-r-*-12-*"
98    pack  .whereAxis.nontop.find.entry -side left -fill x -expand true
99    
100    bind  .whereAxis.nontop.find.entry <Return> {whereAxisFindHook [.whereAxis.nontop.find.entry get]}
101    
102    # -----------------------------------------------------------
103    
104    whereAxisDrawTipsBase
105    whereAxisDrawTips
106
107    # -----------------------------------------------------------
108    
109    # install resize, expose, and button event hooks for .whereAxis.nontop.main.all
110    bind .whereAxis.nontop.main.all <Configure> {whereAxisConfigureHook}
111    bind .whereAxis.nontop.main.all <Expose>    {whereAxisExposeHook %c}
112    bind .whereAxis.nontop.main.all <Button-1>  {whereAxisSingleClickHook %x %y}
113    bind .whereAxis.nontop.main.all <Button-2>  {whereAxisSingleClickHook %x %y}
114    bind .whereAxis.nontop.main.all <Double-Button-1> {whereAxisDoubleClickHook %x %y}
115    bind .whereAxis.nontop.main.all <Shift-Double-Button-1> {whereAxisShiftDoubleClickHook %x %y}
116    bind .whereAxis.nontop.main.all <Control-Double-Button-1> {whereAxisCtrlDoubleClickHook %x %y}
117    bind .whereAxis.nontop.main.all <Alt-Motion> {whereAxisAltPressHook %x %y}
118    bind .whereAxis.nontop.main.all <Motion> {whereAxisAltReleaseHook}
119    
120    set currMenuAbstraction 1
121 }
122
123 proc whereAxisDrawTipsBase {} {
124    frame .whereAxis.nontop.tips
125    pack .whereAxis.nontop.tips -side top -fill x -expand false
126 }
127
128 proc whereAxisDrawTips {} {
129    if { [winfo exists .whereAxis.nontop.tips.tip1] } {
130       return
131    }
132
133    label .whereAxis.nontop.tips.tip1 -relief groove \
134            -text "Click to select; double-click to expand/un-expand" \
135            -font "*-Helvetica-*-r-*-12-*"
136    pack  .whereAxis.nontop.tips.tip1 -side top -fill both -expand false
137       # fill both (instead of just x) seems needed to prevent from shrinking
138       # when window made shorter
139    
140    label .whereAxis.nontop.tips.tip2 -relief groove \
141            -text "Shift-double-click to expand/un-expand all subtrees of a node" \
142            -font "*-Helvetica-*-r-*-12-*"
143    pack  .whereAxis.nontop.tips.tip2 -side top -fill both -expand false
144       # fill both (instead of just x) seems needed to prevent from shrinking
145       # when window made shorter
146    
147    label .whereAxis.nontop.tips.tip3 -relief groove \
148            -text "Ctrl-double-click to select/un-select all subtrees of a node" \
149            -font "*-Helvetica-*-r-*-12-*"
150    pack  .whereAxis.nontop.tips.tip3 -side top -fill both -expand false
151       # fill both (instead of just x) seems needed to prevent from shrinking
152       # when window made shorter
153
154    label .whereAxis.nontop.tips.tip4 -relief groove \
155            -text "Hold down Alt and move the mouse to scroll freely" \
156            -font "*-Helvetica-*-r-*-12-*"
157    pack  .whereAxis.nontop.tips.tip4 -side top -fill both -expand false
158 }
159
160 proc whereAxisEraseTips {} {
161    if { ![winfo exists .whereAxis.nontop.tips.tip1] } {
162       return
163    }
164
165    destroy .whereAxis.nontop.tips
166    whereAxisDrawTipsBase
167 }