Subversion Repositories or1k

# 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) "Cygnus Solutions"

    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

  }

}