now 7 eval states, divided among 4 eval states & an active flag
[dyninst.git] / paradyn / tcl / shg.tcl
1 # shg.tcl
2 # Ariel Tamches
3
4 #
5 # $Log: shg.tcl,v $
6 # Revision 1.7  1996/01/23 07:14:30  tamches
7 # now 7 eval states, divided among 4 eval states & an active flag
8 #
9 # Revision 1.6  1996/01/11 23:43:49  tamches
10 # there are now 6 node styles instead of 4
11 #
12 # Revision 1.5  1996/01/11 00:53:59  tamches
13 # removed resize1ScrollBar (now in generic.tcl)
14 # removed iconify menu
15 #
16 # Revision 1.4  1996/01/09 01:09:00  tamches
17 # the label area at the bottom of the shg window can now be 1 or
18 # 4 lines in height, depending on the status of the devel mode tc
19 #
20 # Revision 1.3  1995/11/29 00:21:56  tamches
21 # removed refs to PdBitmapDir; we now call makeLogo (pdLogo.C)
22 #
23 # Revision 1.2  1995/11/20 04:06:02  tamches
24 # fixed activeBackground/activeForeground colors that were making for ugly
25 # menu highlighting.
26 #
27 # Revision 1.1  1995/10/17 22:25:14  tamches
28 # First version of new search history graph
29 #
30 #
31
32 proc shgChangeCurrLabelHeight {numlines} {
33    if {[winfo exists .shg.nontop.labelarea.current]} {
34       .shg.nontop.labelarea.current config -height $numlines
35       pack .shg.nontop.labelarea.current -side left -fill both -expand true
36    }
37 }
38
39 proc shgInitialize {iDeveloperMode} {
40    global shgHack
41    
42    if {[winfo exists .shg]} {
43 #      puts stderr "(shg window already exists; not creating)"
44       wm deiconify .shg
45       raise .shg
46       return
47    }
48
49    toplevel .shg -class "Shg"
50    option add *shg*Background grey
51    option add *shg*activeBackground LightGrey
52    option add *shg*activeForeground black
53    wm protocol .shg WM_DELETE_WINDOW {wm iconify .shg}
54
55    # area for title, menubar, logo
56    frame .shg.titlearea
57    pack  .shg.titlearea -side top -fill x -expand false -anchor n
58
59    frame .shg.titlearea.right
60    pack  .shg.titlearea.right -side right -fill y -expand false
61
62    makeLogo .shg.titlearea.right.logo paradynLogo raised 2 mediumseagreen
63    pack  .shg.titlearea.right.logo -side top
64
65    frame .shg.titlearea.left
66    pack  .shg.titlearea.left -side left -fill both -expand true
67
68    label .shg.titlearea.left.title -text "The Performance Consultant" \
69            -foreground white -anchor c \
70            -font *-New*Century*Schoolbook-Bold-R-*-14-* \
71            -relief raised \
72            -background mediumseagreen
73    pack  .shg.titlearea.left.title -side top -fill both -expand true
74
75    # area for menubar:
76    frame .shg.titlearea.left.menu
77    pack  .shg.titlearea.left.menu -side top -fill x -expand false -anchor n
78
79    frame .shg.titlearea.left.menu.mbar -borderwidth 2 -relief raised
80    pack  .shg.titlearea.left.menu.mbar -side top -fill both -expand false
81
82    menubutton .shg.titlearea.left.menu.mbar.phase -text Searches -menu .shg.titlearea.left.menu.mbar.phase.m
83    menu .shg.titlearea.left.menu.mbar.phase.m -selectcolor cornflowerblue
84
85    pack .shg.titlearea.left.menu.mbar.phase -side left -padx 4
86
87    # -----------------------------------------------------------
88
89    frame .shg.nontop
90    pack  .shg.nontop -side bottom -fill both -expand true
91
92    # -----------------------------------------------------------
93
94    frame .shg.nontop.currphasearea
95    pack  .shg.nontop.currphasearea -side top -fill x -expand false
96
97    label .shg.nontop.currphasearea.label1 -text "Current Phase: " \
98            -font "*-Helvetica-*-r-*-12-*" -anchor e
99    pack  .shg.nontop.currphasearea.label1 -side left -fill both -expand true
100
101    label .shg.nontop.currphasearea.label2 -text "" \
102            -font "*-Helvetica-*-r-*-12-*" -anchor w
103    pack  .shg.nontop.currphasearea.label2 -side left -fill both -expand true
104
105    # -----------------------------------------------------------
106
107    frame .shg.nontop.textarea
108    pack  .shg.nontop.textarea -side top -fill x -expand false
109
110    text .shg.nontop.textarea.text -borderwidth 2 -width 40 -height 5 -relief sunken \
111            -font "*-Helvetica-*-r-*-12-*" \
112            -yscrollcommand ".shg.nontop.textarea.sb set"
113    pack .shg.nontop.textarea.text -side left -fill both -expand true
114
115    scrollbar .shg.nontop.textarea.sb -relief sunken \
116            -command ".shg.nontop.textarea.text yview"
117    pack .shg.nontop.textarea.sb -side right -fill y -expand false
118
119    # -----------------------------------------------------------
120
121    frame .shg.nontop.main -width 4i -height 3.5i
122    pack  .shg.nontop.main -side top -fill both -expand true
123
124    scrollbar .shg.nontop.main.leftsb -orient vertical -width 16 \
125            -background gray \
126            -activebackground gray \
127            -command "shgNewVertScrollPosition"
128
129    pack .shg.nontop.main.leftsb -side left -fill y -expand false
130
131    scrollbar .shg.nontop.main.bottsb -orient horizontal -width 16 \
132         -activebackground gray \
133         -command "shgNewHorizScrollPosition"
134
135    pack .shg.nontop.main.bottsb -side bottom -fill x -expand false
136
137    frame .shg.nontop.main.all -relief flat -width 3i -height 2i
138    pack .shg.nontop.main.all -side left -fill both -expand true
139
140    # -----------------------------------------------------------
141
142    frame .shg.nontop.labelarea
143    pack  .shg.nontop.labelarea -side top -fill x -expand false
144
145    text .shg.nontop.labelarea.current -relief sunken -height 1 \
146            -font "*-Helvetica-*-r-*-12-*" \
147            -wrap none
148    if {$iDeveloperMode} {
149       set numlines 4
150    } else {
151       set numlines 1
152    }
153    shgChangeCurrLabelHeight $numlines
154
155    # -----------------------------------------------------------
156
157    frame .shg.nontop.buttonarea
158    pack  .shg.nontop.buttonarea -side top -fill x -expand false
159
160    frame .shg.nontop.buttonarea.left
161    pack  .shg.nontop.buttonarea.left -side left -fill y -expand true
162
163    button .shg.nontop.buttonarea.left.search -text "Search" -anchor c \
164            -command {.shg.nontop.buttonarea.left.search config -state normal; \
165                      .shg.nontop.buttonarea.middle.pause config -state normal; \
166                      shgSearchCommand}
167    pack   .shg.nontop.buttonarea.left.search -side left -ipadx 10 -fill y -expand false
168
169    frame .shg.nontop.buttonarea.middle
170    pack  .shg.nontop.buttonarea.middle -side left -fill y -expand true
171
172    button .shg.nontop.buttonarea.middle.pause -text "Pause" -state disabled -anchor c \
173            -command {.shg.nontop.buttonarea.left.search config -state normal; \
174                      .shg.nontop.buttonarea.middle.pause config -state disabled; \
175                      shgPauseCommand}
176    pack   .shg.nontop.buttonarea.middle.pause -side left -fill y -expand false
177
178 #   frame .shg.nontop.buttonarea.right
179 #   pack  .shg.nontop.buttonarea.right -side left -fill y -expand true
180 #
181 #   button .shg.nontop.buttonarea.right.resume -text "Resume" -state disabled -anchor c \
182 #          -command {.shg.nontop.buttonarea.left.search config -state normal; \
183 #                    .shg.nontop.buttonarea.middle.pause config -state normal; \
184 #                    .shg.nontop.buttonarea.right.resume config -state disabled; \
185 #                    shgResumeCommand}
186 #   pack   .shg.nontop.buttonarea.right.resume -side right -fill y -expand false
187
188    # -----------------------------------------------------------
189
190    label .shg.nontop.tip0 -relief groove \
191            -text "Never Evaluated" -anchor c \
192            -font "*-Helvetica-*-r-*-12-*" \
193            -background grey
194    pack   .shg.nontop.tip0 -side top -fill both -expand false
195
196    label .shg.nontop.tip1 -relief groove \
197            -text "Unknown" -anchor c \
198            -font "*-Helvetica-*-r-*-12-*" \
199            -background "#e9fbb57aa3c9"
200               # yuck --ari
201    pack   .shg.nontop.tip1 -side top -fill both -expand false
202
203 #   label .shg.nontop.tip2 -relief groove \
204 #          -text "Instrumented; no decision yet" -anchor c \
205 #          -font "*-Helvetica-*-r-*-12-*" \
206 #          -background "#ffffbba5bba5"
207 #                # yuck --ari
208 ##         -background Tan
209 #   pack   .shg.nontop.tip2 -side top -fill both -expand false
210
211    label .shg.nontop.tip2 -relief groove \
212            -text "True" -anchor c \
213            -font "*-Helvetica-*-r-*-12-*" \
214            -background cornflowerblue
215 #          -background "#acbff48ff6c8"
216                 # yuck --ari
217    pack   .shg.nontop.tip2 -side top -fill both -expand false
218
219    label .shg.nontop.tip3 -relief groove \
220            -text "False" -anchor c \
221            -font "*-Helvetica-*-r-*-12-*" \
222            -background pink
223 #          -background "#cc85d5c2777d" 
224                 # yuck --ari
225    pack   .shg.nontop.tip3 -side top -fill both -expand false
226
227 #   label .shg.nontop.tip4 -relief groove \
228 #          -text "Uninstrumented; believed true" -anchor c \
229 #          -font "*-Helvetica-*-r-*-12-*" \
230 #          -background "green"
231 #   pack  .shg.nontop.tip4 -side top -fill both -expand false
232 #
233 #   label .shg.nontop.tip5 -relief groove \
234 #          -text "Instrumented; believed false" -anchor c \
235 #          -font "*-Helvetica-*-r-*-12-*" \
236 #          -background "plum"
237 #   pack  .shg.nontop.tip5 -side top -fill both -expand false
238 #
239 #
240 #   label .shg.nontop.tip6 -relief sunken \
241 #           -text "Hold down Alt and move the mouse to scroll freely" -anchor c \
242 #           -font "*-Helvetica-*-r-*-12-*"
243 #   pack  .shg.nontop.tip6 -side top -fill both -expand false
244
245    # -----------------------------------------------------------
246
247    bind .shg.nontop.main.all <Configure> {shgConfigureHook}
248    bind .shg.nontop.main.all <Expose>    {shgExposeHook %c}
249    bind .shg.nontop.main.all <Button-1>  {shgSingleClickHook %x %y}
250    bind .shg.nontop.main.all <Button-2>  {shgSingleClickHook %x %y}
251    bind .shg.nontop.main.all <Double-Button-1> {shgDoubleClickHook %x %y}
252 #   bind .shg.nontop.main.all <Shift-Double-Button-1> {shgShiftDoubleClickHook %x %y}
253 #   bind .shg.nontop.main.all <Control-Double-Button-1> {shgCtrlDoubleClickHook %x %y}
254    bind .shg.nontop.main.all <Alt-Motion> {shgAltPressHook %x %y}
255    bind .shg.nontop.main.all <Motion> {shgAltReleaseHook %x %y}
256
257    if {$shgHack} {
258 #      puts stderr "shgHack"
259       paradyn shg start global
260    }
261 }