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