1 # sendpr.tcl - GUI to send-pr.
2 # Copyright (C) 1997 Cygnus Solutions.
3 # Written by Tom Tromey <tromey@cygnus.com>.
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.
13 # FIXME: shouldn't have global variable.
19 # This array holds information about this site. It is a private
20 # common array. Once initialized it is never changed.
23 # Initialize the _site array.
24 global Paths tcl_platform
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 {
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"
39 set _site(categories) foundry
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
44 if {! [file exists $_site(sendpr)]} then {
45 set _site(sendpr) send-pr
49 set outList [split [exec $_site(sendpr) -P] \n]
51 foreach line $outList {
52 if {[string match SEND-PR* $line]} then {
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
61 if {[string tolower $field] == "to"} then {
64 } elseif {[regexp {^>([^:]*):(.*)$} $line dummy field value]} then {
65 # Found a field. Set it.
67 if {$value != "" && ![string match <*> [string trim $value]]} then {
68 set _site(field,$lastField) $value
70 } elseif {$lastField == ""} then {
73 # Stuff into last field.
74 if {[info exists _site(field,$lastField)]} then {
75 append _site(field,$lastField) \n
77 append _site(field,$lastField) $line
80 # Now find the categories.
81 regsub -all -- {[()\"]} [exec $_site(sendpr) -CL] \
83 set _site(categories) [lrmdups [concat foundry $_site(categories)]]
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"]
100 # Any text passed to constructor is saved and put into Description
102 constructor {{text ""}} {
103 Ide_window::constructor [gettext "Report Bug"]
107 # The standard widget-making trick.
108 set class [$this info class]
109 set hull [namespace tail $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
118 wm withdraw [namespace tail $this]
119 ###FIXME - this constructor callout will cause the parent constructor to be called twice
121 ::set SENDPR_state($this,desc) $text
124 # The Classification frame.
127 Labelledframe [namespace tail $this].cframe -text [gettext "Classification"]
128 set parent [[namespace tail $this].cframe get_frame]
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
135 # FIXME: allow user of this class to set default category.
136 ::set SENDPR_state($this,category) foundry
138 ::set SENDPR_state($this,secret) no
139 checkbutton $parent.secret -text [gettext "Confidential"] \
140 -variable SENDPR_state($this,secret) -onvalue yes -offvalue no \
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 \
150 if {$m1 > $m2} then {
153 if {$m2 > $m3} then {
156 $parent.class configure -width $m3
157 $parent.severity configure -width $m3
158 $parent.priority configure -width $m3
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
165 # The text and entry frames.
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
173 # Text fields. Each is wrapped in its own label frame.
174 # We decided to eliminate all the frames but one; the others are
176 ::set SENDPR_state($this,repeat) [_make_text [namespace tail $this].desc \
177 [gettext "Description"]]
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
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
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
201 bind [namespace tail $this].buttons <Destroy> [list $this delete]
203 wm deiconify [namespace tail $this]
208 foreach item [array names SENDPR_state $this,*] {
209 ::unset SENDPR_state($item)
211 catch {destroy $this}
214 method configure {config} {}
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} {
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.
228 lappend values $_site($item)
229 if {[string length $_site($item)] > $max} then {
230 set max [string length $_site($item)]
234 eval tk_optionMenu $name SENDPR_state($this,$index) $values
236 ::set SENDPR_state($this,$index) $_site([lindex $args $def_index])
241 # Create a labelled frame and put a text widget in it. Private
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
257 # This takes a text string and finds the element of site which has
258 # the same value. It returns the corresponding key. Private
260 method _invert {text values} {
261 foreach item $values {
262 if {$_site($item) == $text} then {
266 error "couldn't find \"$text\""
269 # Send the PR. Private method.
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)
280 foreach field {Customer-Id Originator Release} {
281 append email ">$field: $_site(field,$field)\n"
283 foreach field {Organization Environment} {
284 append email ">$field:\n$_site(field,$field)\n"
287 append email ">Confidential: "
288 if {$SENDPR_state($this,secret)} then {
294 append email ">Synopsis: $SENDPR_state($this,synopsis)\n"
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"
304 append email ">Category: $SENDPR_state($this,category)\n"
307 append email ">How-To-Repeat:\n"
308 append email "[$SENDPR_state($this,repeat) get 1.0 end]\n"
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"
313 send_mail $_site(to) $SENDPR_state($this,synopsis) $email
318 # Override from Ide_window.
319 method idew_save {} {
322 foreach name {category secret severity priority class synopsis} {
323 set result($name) $SENDPR_state($this,$name)
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)
329 return [list Sendpr :: _restore [array get result]]
332 # This is used to restore a bug report window. Private proc.
333 proc _restore {alist x y width height visibility} {
336 array set values $alist
339 Sendpr $name $values(desc)
340 foreach name {category secret severity priority class synopsis} {
341 ::set $SENDPR_state($this,$name) $values($name)
343 $SENDPR_state($name,repeat) insert end $desc
345 $name idew_set_geometry $x $y $width $height
346 $name idew_set_visibility $visibility