You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
349 lines
11 KiB
Tcl
349 lines
11 KiB
Tcl
15 years ago
|
# sendpr.tcl - GUI to send-pr.
|
||
|
|
# Copyright (C) 1997 Cygnus Solutions.
|
||
|
|
# Written by Tom Tromey <tromey@cygnus.com>.
|
||
|
|
|
||
|
|
# FIXME:
|
||
|
|
# * consider adding ability to set various options from outside,
|
||
|
|
# eg via the configure method.
|
||
|
|
# * Have explanatory text at the top
|
||
|
|
# * if synopsis not set, don't allow PR to be sent
|
||
|
|
# * at least one text field must have text in it before PR can be sent
|
||
|
|
# * see other fixme comments in text.
|
||
|
|
|
||
|
|
# FIXME: shouldn't have global variable.
|
||
|
|
defarray SENDPR_state
|
||
|
|
|
||
|
|
itcl_class Sendpr {
|
||
|
|
inherit Ide_window
|
||
|
|
|
||
|
|
# This array holds information about this site. It is a private
|
||
|
|
# common array. Once initialized it is never changed.
|
||
|
|
common _site
|
||
|
|
|
||
|
|
# Initialize the _site array.
|
||
|
|
global Paths tcl_platform
|
||
|
|
|
||
|
|
# On Windows, there is no `send-pr' program. For now, we just
|
||
|
|
# hard-code things there to work in the most important case.
|
||
|
|
if {$tcl_platform(platform) == "windows"} then {
|
||
|
|
set _site(header) ""
|
||
|
|
set _site(to) bugs@cygnus.com
|
||
|
|
set _site(field,Submitter-Id) cygnus
|
||
|
|
set _site(field,Originator) Nobody
|
||
|
|
set _site(field,Release) "Internal"
|
||
|
|
set _site(field,Organization) "Red Hat, Inc."
|
||
|
|
set _site(field,Environment) ""
|
||
|
|
foreach item {byteOrder machine os osVersion platform} {
|
||
|
|
append _site(field,Environment) "$item = $tcl_platform($item)\n"
|
||
|
|
}
|
||
|
|
set _site(categories) foundry
|
||
|
|
} else {
|
||
|
|
set _site(sendpr) [file join $Paths(bindir) send-pr]
|
||
|
|
# If it doesn't exist, try the user's path. This is a hack for
|
||
|
|
# developers.
|
||
|
|
if {! [file exists $_site(sendpr)]} then {
|
||
|
|
set _site(sendpr) send-pr
|
||
|
|
}
|
||
|
|
|
||
|
|
set _site(header) {}
|
||
|
|
set outList [split [exec $_site(sendpr) -P] \n]
|
||
|
|
set lastField {}
|
||
|
|
foreach line $outList {
|
||
|
|
if {[string match SEND-PR* $line]} then {
|
||
|
|
# Nothing.
|
||
|
|
} elseif {[regexp {^$} $line] || [regexp "^\[ \t\]" $line]} then {
|
||
|
|
# Empty lines and lines starting with a blank are skipped.
|
||
|
|
} elseif {$lastField == "" &&
|
||
|
|
[regexp [format {^[^>]([^:]+):[ %s]+(.+)$} \t] \
|
||
|
|
$line dummy field value]} then {
|
||
|
|
# A non-empty mail header line. This can only occur when there
|
||
|
|
# is no last field.
|
||
|
|
if {[string tolower $field] == "to"} then {
|
||
|
|
set _site(to) $value
|
||
|
|
}
|
||
|
|
} elseif {[regexp {^>([^:]*):(.*)$} $line dummy field value]} then {
|
||
|
|
# Found a field. Set it.
|
||
|
|
set lastField $field
|
||
|
|
if {$value != "" && ![string match <*> [string trim $value]]} then {
|
||
|
|
set _site(field,$lastField) $value
|
||
|
|
}
|
||
|
|
} elseif {$lastField == ""} then {
|
||
|
|
# No last field.
|
||
|
|
} else {
|
||
|
|
# Stuff into last field.
|
||
|
|
if {[info exists _site(field,$lastField)]} then {
|
||
|
|
append _site(field,$lastField) \n
|
||
|
|
}
|
||
|
|
append _site(field,$lastField) $line
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Now find the categories.
|
||
|
|
regsub -all -- {[()\"]} [exec $_site(sendpr) -CL] \
|
||
|
|
"" _site(categories)
|
||
|
|
set _site(categories) [lrmdups [concat foundry $_site(categories)]]
|
||
|
|
}
|
||
|
|
|
||
|
|
# Internationalize some text. We have to do this because of how
|
||
|
|
# Tk's optionmenu works. Indices here are the names that GNATS
|
||
|
|
# wants; this is important.
|
||
|
|
set _site(sw-bug) [gettext "Software bug"]
|
||
|
|
set _site(doc-bug) [gettext "Documentation bug"]
|
||
|
|
set _site(change-request) [gettext "Change request"]
|
||
|
|
set _site(support) [gettext "Support"]
|
||
|
|
set _site(non-critical) [gettext "Non-critical"]
|
||
|
|
set _site(serious) [gettext "Serious"]
|
||
|
|
set _site(critical) [gettext "Critical"]
|
||
|
|
set _site(low) [gettext "Low"]
|
||
|
|
set _site(medium) [gettext "Medium"]
|
||
|
|
set _site(high) [gettext "High"]
|
||
|
|
|
||
|
|
# Any text passed to constructor is saved and put into Description
|
||
|
|
# section of output.
|
||
|
|
constructor {{text ""}} {
|
||
|
|
Ide_window::constructor [gettext "Report Bug"]
|
||
|
|
} {
|
||
|
|
global SENDPR_state
|
||
|
|
|
||
|
|
# The standard widget-making trick.
|
||
|
|
set class [$this info class]
|
||
|
|
set hull [namespace tail $this]
|
||
|
|
set old_name $this
|
||
|
|
::rename $this $this-tmp-
|
||
|
|
# For now always make a toplevel. Number 7 comes from Windows
|
||
|
|
::rename $hull $old_name-win-
|
||
|
|
::rename $this $old_name
|
||
|
|
::rename $this $this-win-
|
||
|
|
::rename $this-tmp- $this
|
||
|
|
|
||
|
|
wm withdraw [namespace tail $this]
|
||
|
|
###FIXME - this constructor callout will cause the parent constructor to be called twice
|
||
|
|
|
||
|
|
::set SENDPR_state($this,desc) $text
|
||
|
|
|
||
|
|
#
|
||
|
|
# The Classification frame.
|
||
|
|
#
|
||
|
|
|
||
|
|
Labelledframe [namespace tail $this].cframe -text [gettext "Classification"]
|
||
|
|
set parent [[namespace tail $this].cframe get_frame]
|
||
|
|
|
||
|
|
tixComboBox $parent.category -dropdown 1 -editable 0 \
|
||
|
|
-label [gettext "Category"] -variable SENDPR_state($this,category)
|
||
|
|
foreach item $_site(categories) {
|
||
|
|
$parent.category insert end $item
|
||
|
|
}
|
||
|
|
# FIXME: allow user of this class to set default category.
|
||
|
|
::set SENDPR_state($this,category) foundry
|
||
|
|
|
||
|
|
::set SENDPR_state($this,secret) no
|
||
|
|
checkbutton $parent.secret -text [gettext "Confidential"] \
|
||
|
|
-variable SENDPR_state($this,secret) -onvalue yes -offvalue no \
|
||
|
|
-anchor w
|
||
|
|
|
||
|
|
# FIXME: put labels on these?
|
||
|
|
set m1 [_make_omenu $parent.class class 0 \
|
||
|
|
sw-bug doc-bug change-request support]
|
||
|
|
set m2 [_make_omenu $parent.severity severity 1 \
|
||
|
|
non-critical serious critical]
|
||
|
|
set m3 [_make_omenu $parent.priority priority 1 \
|
||
|
|
low medium high]
|
||
|
|
if {$m1 > $m2} then {
|
||
|
|
set m2 $m1
|
||
|
|
}
|
||
|
|
if {$m2 > $m3} then {
|
||
|
|
set m3 $m2
|
||
|
|
}
|
||
|
|
$parent.class configure -width $m3
|
||
|
|
$parent.severity configure -width $m3
|
||
|
|
$parent.priority configure -width $m3
|
||
|
|
|
||
|
|
grid $parent.category $parent.severity -sticky nw -padx 2
|
||
|
|
grid $parent.secret $parent.class -sticky nw -padx 2
|
||
|
|
grid x $parent.priority -sticky nw -padx 2
|
||
|
|
|
||
|
|
#
|
||
|
|
# The text and entry frames.
|
||
|
|
#
|
||
|
|
|
||
|
|
Labelledframe [namespace tail $this].synopsis -text [gettext "Synopsis"]
|
||
|
|
set parent [[namespace tail $this].synopsis get_frame]
|
||
|
|
entry $parent.synopsis -textvariable SENDPR_state($this,synopsis)
|
||
|
|
pack $parent.synopsis -expand 1 -fill both
|
||
|
|
|
||
|
|
# Text fields. Each is wrapped in its own label frame.
|
||
|
|
# We decided to eliminate all the frames but one; the others are
|
||
|
|
# just confusing.
|
||
|
|
::set SENDPR_state($this,repeat) [_make_text [namespace tail $this].desc \
|
||
|
|
[gettext "Description"]]
|
||
|
|
|
||
|
|
# Some buttons.
|
||
|
|
frame [namespace tail $this].buttons -borderwidth 0 -relief flat
|
||
|
|
button [namespace tail $this].buttons.send -text [gettext "Send"] \
|
||
|
|
-command [list $this _send]
|
||
|
|
button [namespace tail $this].buttons.cancel -text [gettext "Cancel"] \
|
||
|
|
-command [list destroy $this]
|
||
|
|
button [namespace tail $this].buttons.help -text [gettext "Help"] -state disabled
|
||
|
|
standard_button_box [namespace tail $this].buttons
|
||
|
|
|
||
|
|
# FIXME: we'd really like to have sashes between the text widgets.
|
||
|
|
# iwidgets or tix will provide that for us.
|
||
|
|
grid [namespace tail $this].cframe -sticky ew -padx 4 -pady 4
|
||
|
|
grid [namespace tail $this].synopsis -sticky ew -padx 4 -pady 4
|
||
|
|
grid [namespace tail $this].desc -sticky news -padx 4 -pady 4
|
||
|
|
grid [namespace tail $this].buttons -sticky ew -padx 4
|
||
|
|
|
||
|
|
grid rowconfigure [namespace tail $this] 0 -weight 0
|
||
|
|
grid rowconfigure [namespace tail $this] 1 -weight 0
|
||
|
|
grid rowconfigure [namespace tail $this] 2 -weight 1
|
||
|
|
grid rowconfigure [namespace tail $this] 3 -weight 1
|
||
|
|
grid columnconfigure [namespace tail $this] 0 -weight 1
|
||
|
|
|
||
|
|
bind [namespace tail $this].buttons <Destroy> [list $this delete]
|
||
|
|
|
||
|
|
wm deiconify [namespace tail $this]
|
||
|
|
}
|
||
|
|
|
||
|
|
destructor {
|
||
|
|
global SENDPR_state
|
||
|
|
foreach item [array names SENDPR_state $this,*] {
|
||
|
|
::unset SENDPR_state($item)
|
||
|
|
}
|
||
|
|
catch {destroy $this}
|
||
|
|
}
|
||
|
|
|
||
|
|
method configure {config} {}
|
||
|
|
|
||
|
|
# Create an optionmenu and fill it. Also, go through all the items
|
||
|
|
# and find the one that makes the menubutton the widest. Return the
|
||
|
|
# max width. Private method.
|
||
|
|
method _make_omenu {name index def_index args} {
|
||
|
|
global SENDPR_state
|
||
|
|
|
||
|
|
set max 0
|
||
|
|
set values {}
|
||
|
|
# FIXME: we can't actually examine which one makes the menubutton
|
||
|
|
# widest. Why not? Because the menubutton's -width option is in
|
||
|
|
# characters, but we can only look at the width in pixels.
|
||
|
|
foreach item $args {
|
||
|
|
lappend values $_site($item)
|
||
|
|
if {[string length $_site($item)] > $max} then {
|
||
|
|
set max [string length $_site($item)]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
eval tk_optionMenu $name SENDPR_state($this,$index) $values
|
||
|
|
|
||
|
|
::set SENDPR_state($this,$index) $_site([lindex $args $def_index])
|
||
|
|
|
||
|
|
return $max
|
||
|
|
}
|
||
|
|
|
||
|
|
# Create a labelled frame and put a text widget in it. Private
|
||
|
|
# method.
|
||
|
|
method _make_text {name text} {
|
||
|
|
Labelledframe $name -text $text
|
||
|
|
set parent [$name get_frame]
|
||
|
|
text $parent.text -width 80 -height 15 -wrap word \
|
||
|
|
-yscrollcommand [list $parent.vb set]
|
||
|
|
scrollbar $parent.vb -orient vertical -command [list $parent.text yview]
|
||
|
|
grid $parent.text -sticky news
|
||
|
|
grid $parent.vb -row 0 -column 1 -sticky ns
|
||
|
|
grid rowconfigure $parent 0 -weight 1
|
||
|
|
grid columnconfigure $parent 0 -weight 1
|
||
|
|
grid columnconfigure $parent 1 -weight 0
|
||
|
|
return $parent.text
|
||
|
|
}
|
||
|
|
|
||
|
|
# This takes a text string and finds the element of site which has
|
||
|
|
# the same value. It returns the corresponding key. Private
|
||
|
|
# method.
|
||
|
|
method _invert {text values} {
|
||
|
|
foreach item $values {
|
||
|
|
if {$_site($item) == $text} then {
|
||
|
|
return $item
|
||
|
|
}
|
||
|
|
}
|
||
|
|
error "couldn't find \"$text\""
|
||
|
|
}
|
||
|
|
|
||
|
|
# Send the PR. Private method.
|
||
|
|
method _send {} {
|
||
|
|
global SENDPR_state
|
||
|
|
|
||
|
|
set email {}
|
||
|
|
|
||
|
|
if {[info exists _site(field,Submitter-Id)]} then {
|
||
|
|
set _site(field,Customer-Id) $_site(field,Submitter-Id)
|
||
|
|
unset _site(field,Submitter-Id)
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach field {Customer-Id Originator Release} {
|
||
|
|
append email ">$field: $_site(field,$field)\n"
|
||
|
|
}
|
||
|
|
foreach field {Organization Environment} {
|
||
|
|
append email ">$field:\n$_site(field,$field)\n"
|
||
|
|
}
|
||
|
|
|
||
|
|
append email ">Confidential: "
|
||
|
|
if {$SENDPR_state($this,secret)} then {
|
||
|
|
append email yes\n
|
||
|
|
} else {
|
||
|
|
append email no\n
|
||
|
|
}
|
||
|
|
|
||
|
|
append email ">Synopsis: $SENDPR_state($this,synopsis)\n"
|
||
|
|
|
||
|
|
foreach field {Severity Priority Class} \
|
||
|
|
values {{non-critical serious critical} {low medium high}
|
||
|
|
{sw-bug doc-bug change-request support}} {
|
||
|
|
set name [string tolower $field]
|
||
|
|
set value [_invert $SENDPR_state($this,$name) $values]
|
||
|
|
append email ">$field: $value\n"
|
||
|
|
}
|
||
|
|
|
||
|
|
append email ">Category: $SENDPR_state($this,category)\n"
|
||
|
|
|
||
|
|
# Now big things.
|
||
|
|
append email ">How-To-Repeat:\n"
|
||
|
|
append email "[$SENDPR_state($this,repeat) get 1.0 end]\n"
|
||
|
|
|
||
|
|
# This isn't displayed to the user, but can be set by the caller.
|
||
|
|
append email ">Description:\n$SENDPR_state($this,desc)\n"
|
||
|
|
|
||
|
|
send_mail $_site(to) $SENDPR_state($this,synopsis) $email
|
||
|
|
|
||
|
|
destroy $this
|
||
|
|
}
|
||
|
|
|
||
|
|
# Override from Ide_window.
|
||
|
|
method idew_save {} {
|
||
|
|
global SENDPR_state
|
||
|
|
|
||
|
|
foreach name {category secret severity priority class synopsis} {
|
||
|
|
set result($name) $SENDPR_state($this,$name)
|
||
|
|
}
|
||
|
|
# Stop just before `end'; otherwise we add a newline each time.
|
||
|
|
set result(repeat) [$SENDPR_state($this,repeat) get 1.0 {end - 1c}]
|
||
|
|
set result(desc) $SENDPR_state($this,desc)
|
||
|
|
|
||
|
|
return [list Sendpr :: _restore [array get result]]
|
||
|
|
}
|
||
|
|
|
||
|
|
# This is used to restore a bug report window. Private proc.
|
||
|
|
proc _restore {alist x y width height visibility} {
|
||
|
|
global SENDPR_state
|
||
|
|
|
||
|
|
array set values $alist
|
||
|
|
|
||
|
|
set name .[gensym]
|
||
|
|
Sendpr $name $values(desc)
|
||
|
|
foreach name {category secret severity priority class synopsis} {
|
||
|
|
::set $SENDPR_state($this,$name) $values($name)
|
||
|
|
}
|
||
|
|
$SENDPR_state($name,repeat) insert end $desc
|
||
|
|
|
||
|
|
$name idew_set_geometry $x $y $width $height
|
||
|
|
$name idew_set_visibility $visibility
|
||
|
|
}
|
||
|
|
}
|