/trunk/libgui/library/sendpr.tcl
TCL | 348 lines | 315 code | 7 blank | 26 comment | 15 complexity | a04e8a913994bab5b23975d5b4ee3977 MD5 | raw file
- # 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
- }
- }