libgui/library/sendpr.tcl

   1 # sendpr.tcl - GUI to send-pr.
   2 # Copyright (C) 1997 Cygnus Solutions.
   3 # Written by Tom Tromey <tromey@cygnus.com>.
   4
   5 # FIXME:
   6 # * consider adding ability to set various options from outside,
   7 #   eg via the configure method.
   8 # * Have explanatory text at the top
   9 # * if synopsis not set, don't allow PR to be sent
  10 # * at least one text field must have text in it before PR can be sent
  11 # * see other fixme comments in text.
  12
  13 # FIXME: shouldn't have global variable.
  14 defarray SENDPR_state
  15
  16 itcl_class Sendpr {
  17   inherit Ide_window
  18
  19   # This array holds information about this site.  It is a private
  20   # common array.  Once initialized it is never changed.
  21   common _site
  22
  23   # Initialize the _site array.
  24   global Paths tcl_platform
  25
  26   # On Windows, there is no `send-pr' program.  For now, we just
  27   # hard-code things there to work in the most important case.
  28   if {$tcl_platform(platform) == "windows"} then {
  29     set _site(header) ""
  30     set _site(to) bugs@cygnus.com
  31     set _site(field,Submitter-Id) cygnus
  32     set _site(field,Originator) Nobody
  33     set _site(field,Release) "Internal"
  34     set _site(field,Organization) "Cygnus Solutions"
  35     set _site(field,Environment) ""
  36     foreach item {byteOrder machine os osVersion platform} {
  37       append _site(field,Environment) "$item = $tcl_platform($item)\n"
  38     }
  39     set _site(categories) foundry
  40   } else {
  41     set _site(sendpr) [file join $Paths(bindir) send-pr]
  42     # If it doesn't exist, try the user's path.  This is a hack for
  43     # developers.
  44     if {! [file exists $_site(sendpr)]} then {
  45       set _site(sendpr) send-pr
  46     }
  47
  48     set _site(header) {}
  49     set outList [split [exec $_site(sendpr) -P] \n]
  50     set lastField {}
  51     foreach line $outList {
  52       if {[string match SEND-PR* $line]} then {
  53         # Nothing.
  54       } elseif {[regexp {^$} $line] || [regexp "^\[ \t\]" $line]} then {
  55         # Empty lines and lines starting with a blank are skipped.
  56       } elseif {$lastField == "" &&
  57                 [regexp [format {^[^>]([^:]+):[ %s]+(.+)$} \t] \
  58                    $line dummy field value]} then {
  59         # A non-empty mail header line.  This can only occur when there
  60         # is no last field.
  61         if {[string tolower $field] == "to"} then {
  62           set _site(to) $value
  63         }
  64       } elseif {[regexp {^>([^:]*):(.*)$} $line dummy field value]} then {
  65         # Found a field.  Set it.
  66         set lastField $field
  67         if {$value != "" && ![string match <*> [string trim $value]]} then {
  68           set _site(field,$lastField) $value
  69         }
  70       } elseif {$lastField == ""} then {
  71         # No last field.
  72       } else {
  73         # Stuff into last field.
  74         if {[info exists _site(field,$lastField)]} then {
  75           append _site(field,$lastField) \n
  76         }
  77         append _site(field,$lastField) $line
  78       }
  79     }
  80     # Now find the categories.
  81     regsub -all -- {[()\"]} [exec $_site(sendpr) -CL] \
  82       "" _site(categories)
  83     set _site(categories) [lrmdups [concat foundry $_site(categories)]]
  84   }
  85
  86   # Internationalize some text.  We have to do this because of how
  87   # Tk's optionmenu works.  Indices here are the names that GNATS
  88   # wants; this is important.
  89   set _site(sw-bug) [gettext "Software bug"]
  90   set _site(doc-bug) [gettext "Documentation bug"]
  91   set _site(change-request) [gettext "Change request"]
  92   set _site(support) [gettext "Support"]
  93   set _site(non-critical) [gettext "Non-critical"]
  94   set _site(serious) [gettext "Serious"]
  95   set _site(critical) [gettext "Critical"]
  96   set _site(low) [gettext "Low"]
  97   set _site(medium) [gettext "Medium"]
  98   set _site(high) [gettext "High"]
  99
 100   # Any text passed to constructor is saved and put into Description
 101   # section of output.
 102   constructor {{text ""}} {
 103     Ide_window::constructor [gettext "Report Bug"]
 104   } {
 105     global SENDPR_state
 106
 107     # The standard widget-making trick.
 108     set class [$this info class]
 109     set hull [namespace tail $this]
 110     set old_name $this
 111     ::rename $this $this-tmp-
 112     # For now always make a toplevel.  Number 7 comes from Windows
 113     ::rename $hull $old_name-win-
 114     ::rename $this $old_name
 115     ::rename $this $this-win-
 116     ::rename $this-tmp- $this
 117
 118     wm withdraw  [namespace tail $this]
 119 ###FIXME - this constructor callout will cause the parent constructor to be called twice
 120
 121     ::set SENDPR_state($this,desc) $text
 122
 123     #
 124     # The Classification frame.
 125     #
 126
 127     Labelledframe [namespace tail $this].cframe -text [gettext "Classification"]
 128     set parent [[namespace tail $this].cframe get_frame]
 129
 130     tixComboBox $parent.category -dropdown 1 -editable 0 \
 131       -label [gettext "Category"] -variable SENDPR_state($this,category)
 132     foreach item $_site(categories) {
 133       $parent.category insert end $item
 134     }
 135     # FIXME: allow user of this class to set default category.
 136     ::set SENDPR_state($this,category) foundry
 137
 138     ::set SENDPR_state($this,secret) no
 139     checkbutton $parent.secret -text [gettext "Confidential"] \
 140       -variable SENDPR_state($this,secret) -onvalue yes -offvalue no \
 141       -anchor w
 142
 143     # FIXME: put labels on these?
 144     set m1 [_make_omenu $parent.class class 0 \
 145               sw-bug doc-bug change-request support]
 146     set m2 [_make_omenu $parent.severity severity 1 \
 147               non-critical serious critical]
 148     set m3 [_make_omenu $parent.priority priority 1 \
 149               low medium high]
 150     if {$m1 > $m2} then {
 151       set m2 $m1
 152     }
 153     if {$m2 > $m3} then {
 154       set m3 $m2
 155     }
 156     $parent.class configure -width $m3
 157     $parent.severity configure -width $m3
 158     $parent.priority configure -width $m3
 159
 160     grid $parent.category $parent.severity -sticky nw -padx 2
 161     grid $parent.secret $parent.class -sticky nw -padx 2
 162     grid x $parent.priority -sticky nw -padx 2
 163
 164     #
 165     # The text and entry frames.
 166     #
 167
 168     Labelledframe [namespace tail $this].synopsis -text [gettext "Synopsis"]
 169     set parent [[namespace tail $this].synopsis get_frame]
 170     entry $parent.synopsis -textvariable SENDPR_state($this,synopsis)
 171     pack $parent.synopsis -expand 1 -fill both
 172
 173     # Text fields.  Each is wrapped in its own label frame.
 174     # We decided to eliminate all the frames but one; the others are
 175     # just confusing.
 176     ::set SENDPR_state($this,repeat) [_make_text [namespace tail $this].desc \
 177                                         [gettext "Description"]]
 178
 179     # Some buttons.
 180     frame [namespace tail $this].buttons -borderwidth 0 -relief flat
 181     button [namespace tail $this].buttons.send -text [gettext "Send"] \
 182       -command [list $this _send]
 183     button [namespace tail $this].buttons.cancel -text [gettext "Cancel"] \
 184       -command [list destroy $this]
 185     button [namespace tail $this].buttons.help -text [gettext "Help"] -state disabled
 186     standard_button_box [namespace tail $this].buttons
 187
 188     # FIXME: we'd really like to have sashes between the text widgets.
 189     # iwidgets or tix will provide that for us.
 190     grid [namespace tail $this].cframe -sticky ew -padx 4 -pady 4
 191     grid [namespace tail $this].synopsis -sticky ew -padx 4 -pady 4
 192     grid [namespace tail $this].desc -sticky news -padx 4 -pady 4
 193     grid [namespace tail $this].buttons -sticky ew -padx 4
 194
 195     grid rowconfigure  [namespace tail $this] 0 -weight 0
 196     grid rowconfigure  [namespace tail $this] 1 -weight 0
 197     grid rowconfigure  [namespace tail $this] 2 -weight 1
 198     grid rowconfigure  [namespace tail $this] 3 -weight 1
 199     grid columnconfigure  [namespace tail $this] 0 -weight 1
 200
 201     bind [namespace tail $this].buttons <Destroy> [list $this delete]
 202
 203     wm deiconify  [namespace tail $this]
 204   }
 205
 206   destructor {
 207     global SENDPR_state
 208     foreach item [array names SENDPR_state $this,*] {
 209       ::unset SENDPR_state($item)
 210     }
 211     catch {destroy $this}
 212   }
 213
 214   method configure {config} {}
 215
 216   # Create an optionmenu and fill it.  Also, go through all the items
 217   # and find the one that makes the menubutton the widest.  Return the
 218   # max width.  Private method.
 219   method _make_omenu {name index def_index args} {
 220     global SENDPR_state
 221
 222     set max 0
 223     set values {}
 224     # FIXME: we can't actually examine which one makes the menubutton
 225     # widest.  Why not?  Because the menubutton's -width option is in
 226     # characters, but we can only look at the width in pixels.
 227     foreach item $args {
 228       lappend values $_site($item)
 229       if {[string length $_site($item)] > $max} then {
 230         set max [string length $_site($item)]
 231       }
 232     }
 233
 234     eval tk_optionMenu $name SENDPR_state($this,$index) $values
 235
 236     ::set SENDPR_state($this,$index) $_site([lindex $args $def_index])
 237
 238     return $max
 239   }
 240
 241   # Create a labelled frame and put a text widget in it.  Private
 242   # method.
 243   method _make_text {name text} {
 244     Labelledframe $name -text $text
 245     set parent [$name get_frame]
 246     text $parent.text -width 80 -height 15 -wrap word \
 247       -yscrollcommand [list $parent.vb set]
 248     scrollbar $parent.vb -orient vertical -command [list $parent.text yview]
 249     grid $parent.text -sticky news
 250     grid $parent.vb -row 0 -column 1 -sticky ns
 251     grid rowconfigure $parent 0 -weight 1
 252     grid columnconfigure $parent 0 -weight 1
 253     grid columnconfigure $parent 1 -weight 0
 254     return $parent.text
 255   }
 256
 257   # This takes a text string and finds the element of site which has
 258   # the same value.  It returns the corresponding key.  Private
 259   # method.
 260   method _invert {text values} {
 261     foreach item $values {
 262       if {$_site($item) == $text} then {
 263         return $item
 264       }
 265     }
 266     error "couldn't find \"$text\""
 267   }
 268
 269   # Send the PR.  Private method.
 270   method _send {} {
 271     global SENDPR_state
 272
 273     set email {}
 274
 275     if {[info exists _site(field,Submitter-Id)]} then {
 276       set _site(field,Customer-Id) $_site(field,Submitter-Id)
 277       unset _site(field,Submitter-Id)
 278     }
 279
 280     foreach field {Customer-Id Originator Release} {
 281       append email ">$field: $_site(field,$field)\n"
 282     }
 283     foreach field {Organization Environment} {
 284       append email ">$field:\n$_site(field,$field)\n"
 285     }
 286
 287     append email ">Confidential: "
 288     if {$SENDPR_state($this,secret)} then {
 289       append email yes\n
 290     } else {
 291       append email no\n
 292     }
 293
 294     append email ">Synopsis: $SENDPR_state($this,synopsis)\n"
 295
 296     foreach field {Severity Priority Class} \
 297             values {{non-critical serious critical} {low medium high}
 298               {sw-bug doc-bug change-request support}} {
 299       set name [string tolower $field]
 300       set value [_invert $SENDPR_state($this,$name) $values]
 301       append email ">$field: $value\n"
 302     }
 303
 304     append email ">Category: $SENDPR_state($this,category)\n"
 305
 306     # Now big things.
 307     append email ">How-To-Repeat:\n"
 308     append email "[$SENDPR_state($this,repeat) get 1.0 end]\n"
 309
 310     # This isn't displayed to the user, but can be set by the caller.
 311     append email ">Description:\n$SENDPR_state($this,desc)\n"
 312
 313     send_mail $_site(to) $SENDPR_state($this,synopsis) $email
 314
 315     destroy $this
 316   }
 317
 318   # Override from Ide_window.
 319   method idew_save {} {
 320     global SENDPR_state
 321
 322     foreach name {category secret severity priority class synopsis} {
 323       set result($name) $SENDPR_state($this,$name)
 324     }
 325     # Stop just before `end'; otherwise we add a newline each time.
 326     set result(repeat) [$SENDPR_state($this,repeat) get 1.0 {end - 1c}]
 327     set result(desc) $SENDPR_state($this,desc)
 328
 329     return [list Sendpr :: _restore [array get result]]
 330   }
 331
 332   # This is used to restore a bug report window.  Private proc.
 333   proc _restore {alist x y width height visibility} {
 334     global SENDPR_state
 335
 336     array set values $alist
 337
 338     set name .[gensym]
 339     Sendpr $name $values(desc)
 340     foreach name {category secret severity priority class synopsis} {
 341       ::set $SENDPR_state($this,$name) $values($name)
 342     }
 343     $SENDPR_state($name,repeat) insert end $desc
 344
 345     $name idew_set_geometry $x $y $width $height
 346     $name idew_set_visibility $visibility
 347   }
 348 }