Changing "Paradyn Error #" by "Paradyn Message #", since not every message
[dyninst.git] / paradyn / tcl / uimProcs.tcl
1 # utilities for UIM tcl functions
2 # $Log: uimProcs.tcl,v $
3 # Revision 1.11  1995/12/21 22:17:48  naim
4 # Changing "Paradyn Error #" by "Paradyn Message #", since not every message
5 # is an error message - naim
6 #
7 # Revision 1.10  1995/11/29  00:23:12  tamches
8 # removed mkLogo; removed references to PdBitmapDir; added call
9 # to makeLogo
10 #
11 # Revision 1.9  1994/11/05 01:52:00  karavan
12 # small improvements to min window sizes, resizing effects, button names,
13 # and change pack command in mkLogo to new version.
14 #
15 # Revision 1.8  1994/11/03  20:48:11  karavan
16 # removed error message
17 #
18 # Revision 1.7  1994/09/13  05:05:47  karavan
19 # improved error handling
20 #
21 # Revision 1.6  1994/08/01  20:26:34  karavan
22 # changes to accommodate new dag design.
23 #
24 # Revision 1.5  1994/07/07  05:57:04  karavan
25 # UIM error service implementation
26 #
27 # Revision 1.4  1994/06/29  21:47:39  hollings
28 # killed old background colors and switched to motif like greys.
29 # cleaned up option specification to use options data base.
30 #
31 # Revision 1.3  1994/06/13  16:53:06  karavan
32 # added mkLogo procedure
33 #
34 # Revision 1.2  1994/05/23  01:55:46  karavan
35 # its a whole new look for paradyn!
36 #
37 # Revision 1.1  1994/05/03  06:36:03  karavan
38 # Initial version.
39 #
40
41 proc mkEntry {w {pack {top expand fillx}} args} {
42         eval entry $w $args
43         pack append [winfo parent $w] $w $pack
44         return $w
45 }
46
47 proc mkFrame {w {pack {top expand fill}} args} {
48         eval frame $w $args
49         pack append [winfo parent $w] $w $pack
50         return $w
51 }
52
53 proc mkMessage {w {text ""} {pack {top fillx}} args} {
54         eval message $w -text \"$text\" $args
55         pack append [winfo parent $w] $w $pack
56         return $w
57 }
58
59 #----------------------------------------------------------------------------
60 #  Make a bar of buttons and pack into parent.  Embed the left button in an
61 #  additional sunken frame to indicaute that it is the default button, and
62 #  arrange for that button to be invoked as the default action for clicks 
63 #  and returns inthe dialog.
64 # **Changed order of every and other command klk**
65 #----------------------------------------------------------------------------
66 proc mkButtonBar {w every retval blist} {       
67         upvar $retval retv
68         set arg [lindex $blist 0]
69         focus $w
70
71         set i 1
72         foreach arg [lrange $blist 0 end] {
73             button $w.$i -text [lindex $arg 0] -width 10 -height 1\
74                     -command "$every; [lindex $arg 1]"
75             pack append $w $w.$i {left expand padx 20 pady 4}
76             set i [expr $i+1]
77         }
78 }
79
80
81 #
82 #  Make a new dialog toplevel window
83 #
84 proc mkDialogWindow {w} {
85     catch {destroy $w}
86     toplevel $w -class Dialog -bd 0
87     wm title $w "Dialog box"
88     wm iconname $w "Dialog"
89     wm geometry $w +425+300
90     grab $w
91     focus $w
92     return $w
93 }
94
95 proc explError {errorCode oldwin} {
96     
97     global pdError
98     set w .error2$errorCode
99
100     #lookup errorCode, get explanation
101     set etext [lindex $pdError($errorCode) 3]
102
103     mkDialogWindow $w
104     $w configure -bg red
105     frame $w.out 
106     pack $w.out -padx 5 -pady 5
107
108     # title
109 ## **** don't forget to use class for this font!!!!
110     label $w.out.top -text "Paradyn Message \#\ $errorCode Explanation" -fg red \
111         -font "-Adobe-times-bold-r-normal--*-120*"    
112     pack $w.out.top -pady 5 -padx 5
113
114     # explanation text
115     message $w.out.explain -width 300 -text $etext -relief groove
116     pack $w.out.explain -pady 5 -padx 5
117
118     # single button option
119     button $w.out.b0 -text "OK" -command "destroy $w" \
120             -width 10 
121     pack $w.out.b0 -pady 5
122 }
123
124 proc showErrorHistory {} {
125     global pdErrorHistory
126     set w .errorHist
127     mkDialogWindow $w
128     label $w.title -text "Paradyn Error History"
129     frame $w.list
130     listbox $w.list.hlist -relief groove 
131     scrollbar $w.list.s -orient vert -command "$w.hlist yview"
132     $w.hlist configure -yscrollcommand "$w.list.s set" 
133     pack $w.title -side top
134     pack $w.list.hlist $w.list.s -side left 
135     pack $w.list -side top
136     button $w.butt -text "OKAY" -command "destroy $w"
137     pack $w.butt -side top
138 }
139
140 #
141 # a simple help error screen for paradyn
142 #  errorStr: text for custom error message
143 #  errorCode: error ID from paradyn error database
144 #
145 proc showError {errorCode errorStr} {
146     global pdError pdErrorHistory
147     global PdBitmapDir
148     set buttonfg red
149     set buttonbg white
150     set retval [catch {set errRec $pdError($errorCode)}]
151 #    puts "showError $retval"
152     if {$retval == 1} {
153         set errorStr "No entry in error database for this error code."
154         set etype serious
155     } else {
156         set etype [lindex $errRec 2]
157         if {$errorStr == ""} {
158             set errorStr [lindex $errRec 0]
159         }
160     }
161     
162     # the main error window
163     set w .error$errorCode
164     mkDialogWindow $w
165     $w configure -bg red
166     frame $w.out -class "Paradyn.Error" 
167     pack $w.out -padx 5 -pady 5
168
169     # Error screen header: bitmap, title and Error Number
170     frame $w.out.top
171     pack $w.out.top -padx 5 -pady 5
172
173     makeLogo $w.out.top.exclaim dont flat 0 red
174
175 #    label $w.out.top.exclaim -bitmap @$PdBitmapDir/dont.xbm \
176 #           -fg red -height 40 -width 40
177
178     ## **** don't forget to use class for this font!!!!
179     label $w.out.top.title -text "Paradyn Message \#\ $errorCode" \
180             -anchor center \
181             -fg red -font "-Adobe-times-bold-r-normal--*-120*"
182     pack $w.out.top.exclaim $w.out.top.title -side left -pady 5 -padx 10
183
184     pack $w.out.top -expand yes -fill both
185
186     # specific error message text
187     frame $w.out.mid
188     message $w.out.mid.msg -width 300 -text $errorStr -relief groove \
189         -borderwidth 2
190     pack $w.out.mid.msg -expand yes -fill both -padx 5 -pady 5
191     pack $w.out.mid -expand yes -fill both  -padx 5
192     label $w.out.eclass -text "Message Category: $etype" -anchor center
193     pack $w.out.eclass -side top -pady 5
194
195     # option buttons 
196     frame $w.out.buttons 
197     mkButtonBar $w.out.buttons {} retval {{CONTINUE ""} \
198             {EXPLAIN ""} \
199             {EXIT PARADYN "destroy ."} }
200
201     $w.out.buttons.3 configure -command "errorExit $w"
202     $w.out.buttons.2 configure -command "explError $errorCode $w"
203     $w.out.buttons.1 configure -command "destroy $w"
204     pack $w.out.buttons -expand yes -fill both -padx 5
205
206     # add this error to error history list
207     lappend pdErrorHistory [list $errorCode $errorStr]
208 }
209
210 # Exit Paradyn, with or without core file per the user selection
211 # This is only called from an error condition.
212 #
213 proc errorExit {oldwin} {
214     set w .exerror
215
216     mkDialogWindow $w
217     $w configure -bg red
218     label $w.l -text "Generate Core File (Y/N)?"
219     frame $w.buttons
220     mkButtonBar $w.buttons {} retval {{YES ""} {NO ""}}
221     $w.buttons.1 configure -command "paradyn core -1; destroy ."
222     $w.buttons.2 configure -command "destroy ."
223     destroy $oldwin
224     pack $w.l $w.buttons -side top 
225     focus $w
226 }
227
228
229
230
231
232
233
234
235
236