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