neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

349 lines
11 KiB
Tcl

# 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
}
}