small cleanup to handle new button size
[dyninst.git] / paradyn / tcl / uimProcs.tcl
1 # utilities for UIM tcl functions
2 # $Log: uimProcs.tcl,v $
3 # Revision 1.18  1997/06/03 15:33:31  karavan
4 # small cleanup to handle new button size
5 #
6 # Revision 1.17  1996/08/05 07:34:15  tamches
7 # update for tcl 7.5
8 #
9 # Revision 1.16  1996/05/06 16:41:47  naim
10 # Adding window to confirm whether the user wants to exit paradyn - naim
11 #
12 # Revision 1.15  1996/04/15  16:18:41  naim
13 # Changing from global to local grab - naim
14 #
15 # Revision 1.14  1996/04/05  21:04:27  naim
16 # Chaging the way grabs are done to try to make sure they don't fail - naim
17 #
18 # Revision 1.13  1996/02/21  22:35:58  tamches
19 # created mkDialogWindowTitle
20 # revamped showError to eliminate duplicates (when empty-string 2d
21 # arg is passed) while generally displaying multiple errors in the
22 # same window
23 #
24 # Revision 1.12  1995/12/28 21:52:17  tamches
25 # error dialog box now puts its information in a scrollable, resizable
26 # text widget instead of a non-scrollable, non-resizable message widget
27 #
28 # Revision 1.11  1995/12/21 22:17:48  naim
29 # Changing "Paradyn Error #" by "Paradyn Message #", since not every message
30 # is an error message - naim
31 #
32 # Revision 1.10  1995/11/29  00:23:12  tamches
33 # removed mkLogo; removed references to PdBitmapDir; added call
34 # to makeLogo
35 #
36
37 proc mkEntry {w {pack {top expand fillx}} args} {
38         eval entry $w $args
39         pack append [winfo parent $w] $w $pack
40         return $w
41 }
42
43 proc mkFrame {w {pack {top expand fill}} args} {
44         eval frame $w $args
45         pack append [winfo parent $w] $w $pack
46         return $w
47 }
48
49 proc mkMessage {w {text ""} {pack {top fillx}} args} {
50         eval message $w -text \"$text\" $args
51         pack append [winfo parent $w] $w $pack
52         return $w
53 }
54
55 #----------------------------------------------------------------------------
56 #  Make a bar of buttons and pack into parent.  Embed the left button in an
57 #  additional sunken frame to indicaute that it is the default button, and
58 #  arrange for that button to be invoked as the default action for clicks 
59 #  and returns inthe dialog.
60 # **Changed order of every and other command klk**
61 #----------------------------------------------------------------------------
62 proc mkButtonBar {w every retval blist} {       
63         upvar $retval retv
64         set arg [lindex $blist 0]
65         focus $w
66
67         set i 1
68         foreach arg [lrange $blist 0 end] {
69             button $w.$i -text [lindex $arg 0]  -height 1 \
70                     -command "$every; [lindex $arg 1]"
71             pack append $w $w.$i {left expand padx 15 pady 4}
72             set i [expr $i+1]
73         }
74 }
75
76
77 #
78 #  Make a new dialog toplevel window
79 #
80 proc mkDialogWindow {w} {
81     catch {destroy $w}
82     toplevel $w -class Dialog -bd 0
83     wm title $w "Dialog box"
84     wm iconname $w "Dialog"
85     wm geometry $w +425+300
86 # Under 7.5/4.1, the tkwait causes the window to "flicker"
87 # noticably.
88 #    tkwait visibility $w
89     catch {grab $w}
90     focus $w
91     return $w
92 }
93
94 proc mkDialogWindowTitle {w theTitle} {
95     catch {destroy $w}
96     toplevel $w -class Dialog -bd 0 
97     wm title $w $theTitle
98     wm iconname $w $theTitle
99     label $w.la -text $theTitle \
100             -foreground white -anchor c \
101             -font *-New*Century*Schoolbook-Bold-R-*-14-* \
102             -relief raised \
103             -background red \
104             -width 40
105     pack $w.la -side top -fill x 
106     catch {grab $w}
107     focus $w
108     return $w
109 }
110
111 proc explError {errorCode} {
112     global pdError
113     set w .error2$errorCode
114
115     #lookup errorCode, get explanation
116     set etext [lindex $pdError($errorCode) 3]
117
118     mkDialogWindowTitle $w "Paradyn Error Explanation"
119     $w configure -bg red
120     frame $w.out 
121     pack $w.out -padx 5 -pady 5
122
123     # title
124 ## **** don't forget to use class for this font!!!!
125     label $w.out.top -text "Paradyn Message \#\ $errorCode Explanation" -fg red \
126         -font "-Adobe-times-bold-r-normal--*-120*"    
127     pack $w.out.top -pady 5 -padx 5
128
129     # explanation text
130     message $w.out.explain -width 300 -text $etext -relief groove
131     pack $w.out.explain -pady 5 -padx 5
132
133     # single button option
134     button $w.out.b0 -text "OK" -command "destroy $w" \
135             -width 10 
136     pack $w.out.b0 -pady 5
137 }
138
139 proc showErrorHistory {} {
140     global pdErrorHistory
141     set w .errorHist
142     mkDialogWindow $w
143     label $w.title -text "Paradyn Error History"
144     frame $w.list
145     listbox $w.list.hlist -relief groove 
146     scrollbar $w.list.s -orient vert -command "$w.hlist yview"
147     $w.hlist configure -yscrollcommand "$w.list.s set" 
148     pack $w.title -side top
149     pack $w.list.hlist $w.list.s -side left 
150     pack $w.list -side top
151     button $w.butt -text "OKAY" -command "destroy $w"
152     pack $w.butt -side top
153 }
154
155 #
156 # a simple help error screen for paradyn
157 #  errorStr: text for custom error message
158 #  errorCode: error ID from paradyn error database
159 #
160 proc showError {errorCode errorStr} {
161     global pdError pdErrorHistory
162     global numErrorsShown
163     global whichDefaultErrorsShown
164
165     set w .paradynErrorWindow
166     set windowOpened [winfo exists $w]
167     if {!$windowOpened} {
168        if {[array exists whichDefaultErrorsShown]} {
169           unset whichDefaultErrorsShown
170        }
171     }
172
173     # If "errorStr" is empty and whichDefaultErrorsShown() says that a
174     # default msg for this error code is already up, then we do nothing
175     if {$errorStr == ""} {
176        if {[array exists whichDefaultErrorsShown]} {
177           if {[llength [array get whichDefaultErrorsShown $errorCode]]!=0} {
178              return
179           }
180        }
181     }
182     set whichDefaultErrorsShown($errorCode) true
183    
184     set retval [catch {set errRec $pdError($errorCode)}]
185
186     if {$retval == 1} {
187         set errorStr "No entry in error database for this error code."
188         set etype serious
189     } else {
190         set etype [lindex $errRec 2]
191         if {$errorStr == ""} {
192             # No error string was passed in to this routine, so use
193             # the default one located in the database.
194             set errorStr [lindex $errRec 0]
195         }
196     }
197
198     
199     # If the main error window isn't already opened, then open it.
200     set theText $w.out.mid.msg
201
202     if {!$windowOpened} {
203        set numErrorsShown 0
204        
205        mkDialogWindowTitle $w "Paradyn Error Window"
206        $w configure -bg red
207        frame $w.out -class "Paradyn.Error" 
208        pack $w.out -padx 5 -pady 5 -fill both -expand true
209
210        # Error screen header: bitmap, title and Error Number
211        frame $w.out.top
212        pack $w.out.top -padx 5 -pady 5 -fill both -expand false
213
214        # specific error message text
215        frame $w.out.mid
216        pack $w.out.mid -expand yes -fill both  -padx 5
217
218        scrollbar $w.out.mid.msgsb -orient vertical -command "$w.out.mid.msg yview" \
219             -background lightgray -activebackground lightgray
220        pack $w.out.mid.msgsb -side right -fill y -expand false
221
222        text $theText -wrap word \
223             -yscrollcommand "$w.out.mid.msgsb set" \
224             -height 8 -width 50
225        pack $theText -fill both -expand true
226
227        # option buttons 
228        frame $w.out.buttons 
229        mkButtonBar $w.out.buttons {} retval {{CONTINUE ""} \
230             {EXIT PARADYN "destroy ."} }
231
232        $w.out.buttons.2 configure -command "errorExit $w"
233        $w.out.buttons.1 configure -command "destroy $w"
234        pack $w.out.buttons -fill both -padx 5 -expand false
235
236        $theText tag configure categoryTag -font "*-Helvetica-*-r-*-12-*"
237        $theText tag configure errorPrefixTag -foreground red -font \
238                "-*-times-bold-r-normal--*-120*"
239     } else {
240        #puts stderr "window already up"
241        #flush stderr
242
243        # Since the window is already up, at least one error is already
244        # being shown.  Hence, we want to insert a newline now to put some vertical
245        # space between us and the error above us
246        $theText insert end "\n"
247     }
248
249     incr numErrorsShown
250
251     # Now insert the information for this specific error code:
252     makeLogo $w.logo$numErrorsShown dont flat 0 red
253     $theText window create end -padx 5 -pady 5 -window $w.logo$numErrorsShown
254
255     $theText insert end "Paradyn message #$errorCode" errorPrefixTag
256     $theText insert end "  (category: $etype) " categoryTag
257
258     button $w.explain$numErrorsShown -text "Explain..." \
259             -command "explError $errorCode" \
260             -font "*-Helvetica-*-r-*-12-*" \
261             -relief groove
262     $theText window create end -padx 5 -pady 5 -window $w.explain$numErrorsShown
263     $theText insert end "\n"
264
265     $theText insert end "$errorStr\n"
266     
267     # add this error to error history list
268     lappend pdErrorHistory [list $errorCode $errorStr]
269 }
270
271 # Exit Paradyn, with or without core file per the user selection
272 # This is only called from an error condition.
273 #
274 proc errorExit {oldwin} {
275     set w .exerror
276
277     mkDialogWindowTitle $w "Exit Paradyn"
278     label $w.l -text "Generate Core File (Y/N)?"
279     frame $w.buttons
280     mkButtonBar $w.buttons {} retval {{YES ""} {NO ""}}
281     $w.buttons.1 configure -command "paradyn core -1; destroy ."
282     $w.buttons.2 configure -command "destroy ."
283     destroy $oldwin
284     pack $w.l $w.buttons -side top -padx 10 -pady 10 
285     focus $w
286 }
287
288 # Makes sure that the user wants to exit paradyn
289 #
290 proc procExit {} {
291     set w .exitWindow
292     mkDialogWindowTitle $w "Exit Paradyn"
293     frame $w.fr -borderwidth 2
294     pack $w.fr -side top
295     label $w.fr.l -text "Are you sure (Y/N)?"
296     pack $w.fr.l -side top -pady 10
297
298     frame $w.fr.buttons
299     mkButtonBar $w.fr.buttons {} retval {{YES ""} {NO ""}}
300     $w.fr.buttons.1 configure -command "paradyn exit"
301     $w.fr.buttons.2 configure -command "destroy $w"
302     pack $w.fr.buttons -side top -fill both
303
304     focus $w
305 }