/[gnats]/gnats/contrib/tkgnats/tkeditpr.tcl
ViewVC logotype

Diff of /gnats/contrib/tkgnats/tkeditpr.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by mcr, Tue Apr 1 02:48:28 2003 UTC revision 1.7 by mcr, Wed Apr 2 04:52:47 2003 UTC
# Line 142  proc real_file_report_socket {rep} { Line 142  proc real_file_report_socket {rep} {
142          return -2          return -2
143      }      }
144    
145      puts $s "EDIT $Tkeditpr(prid)"      gnatsd_send $s "EDIT $Tkeditpr(prid)"
146      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
147      if {![string match 2* [lindex $rep 0]]} {      if {![string match 2* [lindex $rep 0]]} {
148          set errs "GNATSD error sending EDIT command for PRID $Tkeditpr(prid):\n[join $rep \n]"          set errs "GNATSD error sending EDIT command for PRID $Tkeditpr(prid):\n[join $rep \n]"
# Line 150  proc real_file_report_socket {rep} { Line 150  proc real_file_report_socket {rep} {
150      }      }
151    
152      write_pr $s      write_pr $s
153  #write_pr stdout      #write_pr stdout
154      puts     $s "."      puts     $s "."
155    
156      set rep [get_socket_reply $s]      set rep [get_socket_reply $s]
# Line 165  proc real_file_report_socket {rep} { Line 165  proc real_file_report_socket {rep} {
165  proc real_file_report {} {  proc real_file_report {} {
166      global TkGnats Tkeditpr flds frm errorCode whyText      global TkGnats Tkeditpr flds frm errorCode whyText
167      flush_singletext $Tkeditpr(singletextflds)      flush_singletext $Tkeditpr(singletextflds)
168      flush_singletext $Tkeditpr(shorttextflds)      flush_singletext $Tkeditpr(shorttextflds) .eboxs.shortones
169      flush_multitext      flush_multitext
170    
171      #      #
172      # do some local field checking..      # do some local field checking..
# Line 245  proc real_file_report {} { Line 245  proc real_file_report {} {
245              Msg " '|' is an illegal character for the '[get_field_alias $f]' field!"              Msg " '|' is an illegal character for the '[get_field_alias $f]' field!"
246              return -1              return -1
247          }          }
248          #dputs "Comparing frm($f) and flds($f): $frm($f) vs $flds($f)"          dputs "Comparing frm($f) and flds($f): $frm($f) vs $flds($f)"
249          if {$frm($f) != $flds($f)} {          if {$frm($f) != $flds($f)} {
250              foreach require {Audit Email Reason} {              foreach require {Audit Email Reason} {
251                  if {[check_audit_trail_opts $require $f]} {                  if {[check_audit_trail_opts $require $f]} {
# Line 420  proc write_pr {fout} { Line 420  proc write_pr {fout} {
420      #      #
421      # for each parsed field from the PR form...      # for each parsed field from the PR form...
422      #      #
423  #puts "tags:$Tkeditpr(parsed_flds)"      #puts "tags:$Tkeditpr(parsed_flds)"
424    
425      foreach tag $Tkeditpr(parsed_flds) {      foreach tag $Tkeditpr(parsed_flds) {
426          case $tag {_prefix_} {          case $tag {_prefix_} {
427              #              #
428              #   The mail header, stored under the _prefix_ tag, is written out              #   The mail header, stored under the _prefix_ tag, is written out
429              #   unadulterated, except for the edited X-GNATS-Notify field.              #   unadulterated, except for the edited X-GNATS-Notify field.
430              #              #
431  #puts "prefix before:$flds($tag)"              #puts "prefix before:$flds($tag)"
432              set lines [split $flds($tag) \n]              set lines [split $flds($tag) \n]
433              set idx   [lsearch -regexp $lines "^X-GNATS-Notify:"]              set idx   [lsearch -regexp $lines "^X-GNATS-Notify:"]
434                            
# Line 440  proc write_pr {fout} { Line 441  proc write_pr {fout} {
441              }              }
442              #set frm($tag) "[string trim [join $lines \n]]\n"              #set frm($tag) "[string trim [join $lines \n]]\n"
443              set frm($tag) [join $lines \n]              set frm($tag) [join $lines \n]
444  #puts "prefix after:$flds($tag)"              #puts "prefix after:$flds($tag)"
445              puts -nonewline $fout $frm($tag)              puts -nonewline $fout $frm($tag)
446          } {X-GNATS-Notify} {          } {X-GNATS-Notify} {
447              #              #
# Line 475  proc write_pr {fout} { Line 476  proc write_pr {fout} {
476              #   Single line text fields are whitespace trimmed to a leading              #   Single line text fields are whitespace trimmed to a leading
477              #   tab and a trailing newline              #   tab and a trailing newline
478              #              #
479              case $tag [concat $Tkeditpr(singletextflds) $Tkeditpr(shorttextflds)] {              case $tag $Tkeditpr(singletextflds) {
480                  #puts $fout "$tag:\t[string trim [textget $tag] "\t\n "]"                  #puts $fout "$tag:\t[string trim [textget $tag] "\t\n "]"
481                  puts $fout "$tag:\t[string trim $frm($tag) "\t\n "]"                  puts $fout "$tag:\t[string trim $frm($tag) "\t\n "]"
482                } $Tkeditpr(shorttextflds) {
483                    puts $fout "$tag:\t[string trim $frm($tag) "\t\n "]"
484              } [concat >Category >Responsible >Submitter-Id $Tkeditpr(radioflds)] {              } [concat >Category >Responsible >Submitter-Id $Tkeditpr(radioflds)] {
485                  puts $fout "$tag:\t$frm($tag)"                  puts $fout "$tag:\t$frm($tag)"
486              } $Tkeditpr(multitextflds) {              } $Tkeditpr(multitextflds) {
# Line 970  proc edit_window {} { Line 973  proc edit_window {} {
973              incr nboxes              incr nboxes
974          }          }
975      }      }
976    
977      frame .eboxs.shortones -relief groove -borderwidth 2      frame .eboxs.shortones -relief groove -borderwidth 2
978      foreach f $Tkeditpr(shorttextflds) {      foreach f $Tkeditpr(shorttextflds) {
979          if {[check_suppressed_field $f] == 1} {          if {[check_suppressed_field $f] == 1} {

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26