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