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