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