/[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.5 by mcr, Thu Dec 19 04:17:54 2002 UTC revision 1.6 by mcr, Tue Apr 1 02:48:28 2003 UTC
# 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)
169      flush_multitext      flush_multitext
170    
171      #      #
# Line 174  proc real_file_report {} { Line 175  proc real_file_report {} {
175      headingMsg "Checking fields..." 0      headingMsg "Checking fields..." 0
176    
177      # Check mandatory fields for non-blank input      # Check mandatory fields for non-blank input
178      foreach f [concat $Tkeditpr(radioflds) $Tkeditpr(listboxflds) $Tkeditpr(singletextflds) $Tkeditpr(multitextflds)] {      foreach f [concat $Tkeditpr(radioflds) $Tkeditpr(listboxflds) $Tkeditpr(singletextflds) $Tkeditpr(multitextflds) $Tkeditpr(shorttextflds)] {
179          if {[check_suppressed_field $f]} {          if {[check_suppressed_field $f]} {
180              continue              continue
181          }          }
# Line 238  proc real_file_report {} { Line 239  proc real_file_report {} {
239          }          }
240      }      }
241    
242      foreach f $Tkeditpr(singletextflds) {      foreach f [concat $Tkeditpr(singletextflds) $Tkeditpr(shorttextflds)] {
243          # Check that singletext text fields do not have a | char. (not allowed in gnats index)          # Check that singletext text fields do not have a | char. (not allowed in gnats index)
244          if {[string first "|" $frm($f)] >= 0} {          if {[string first "|" $frm($f)] >= 0} {
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!"
# Line 334  proc real_file_report {} { Line 335  proc real_file_report {} {
335          # Send to the responsible person, original sender and the X-GNATS-Notify list          # Send to the responsible person, original sender and the X-GNATS-Notify list
336          merge_into_list mail_list $responsible_addr    $TkGnats(EmailAddr)          merge_into_list mail_list $responsible_addr    $TkGnats(EmailAddr)
337          merge_into_list mail_list $flds(Reply-To)      $TkGnats(EmailAddr)          merge_into_list mail_list $flds(Reply-To)      $TkGnats(EmailAddr)
338          merge_into_list mail_list $frm(X-GNATS-Notify) $TkGnats(EmailAddr)          if {[info exists $frm(X-GNATS-Notify)]} {
339                merge_into_list mail_list $frm(X-GNATS-Notify) $TkGnats(EmailAddr)
340            }
341          if {$frm(>Responsible) != $flds(>Responsible)} {          if {$frm(>Responsible) != $flds(>Responsible)} {
342              # Mail to the old responsible person too              # Mail to the old responsible person too
343              merge_into_list mail_list $old_responsible_addr $TkGnats(EmailAddr)              merge_into_list mail_list $old_responsible_addr $TkGnats(EmailAddr)
# Line 427  proc write_pr {fout} { Line 430  proc write_pr {fout} {
430  #puts "prefix before:$flds($tag)"  #puts "prefix before:$flds($tag)"
431              set lines [split $flds($tag) \n]              set lines [split $flds($tag) \n]
432              set idx   [lsearch -regexp $lines "^X-GNATS-Notify:"]              set idx   [lsearch -regexp $lines "^X-GNATS-Notify:"]
433              set repto "X-GNATS-Notify: [lindex [split $frm(X-GNATS-Notify) ,] 0]"              
434              foreach addr [lrange [split $frm(X-GNATS-Notify) ,] 1 end] {              if {[info exists frm(X-GNATS-Notify)]} {
435                  append repto ", [string trim $addr]"                  set repto "X-GNATS-Notify: [lindex [split $frm(X-GNATS-Notify) ,] 0]"
436              }                  foreach addr [lrange [split $frm(X-GNATS-Notify) ,] 1 end] {
437              set lines [lreplace $lines $idx [expr $idx + $flds(_prefix_len_X-GNATS-Notify) - 1] $repto\n]                      append repto ", [string trim $addr]"
438                    }
439                    set lines [lreplace $lines $idx [expr $idx + $flds(_prefix_len_X-GNATS-Notify) - 1] $repto\n]
440                }
441              #set frm($tag) "[string trim [join $lines \n]]\n"              #set frm($tag) "[string trim [join $lines \n]]\n"
442              set frm($tag) [join $lines \n]              set frm($tag) [join $lines \n]
443  #puts "prefix after:$flds($tag)"  #puts "prefix after:$flds($tag)"
# Line 440  proc write_pr {fout} { Line 446  proc write_pr {fout} {
446              #              #
447              # Taken care of above with the mail header              # Taken care of above with the mail header
448              #              #
449              unset still_left($tag)              if {[info exists still_left($tag)]} {
450                    unset still_left($tag)
451                }
452          } {>Unformatted} {          } {>Unformatted} {
453              #              #
454              # Taken care of later in the function...              # Taken care of later in the function...
# Line 467  proc write_pr {fout} { Line 475  proc write_pr {fout} {
475              #   Single line text fields are whitespace trimmed to a leading              #   Single line text fields are whitespace trimmed to a leading
476              #   tab and a trailing newline              #   tab and a trailing newline
477              #              #
478              case $tag $Tkeditpr(singletextflds) {              case $tag [concat $Tkeditpr(singletextflds) $Tkeditpr(shorttextflds)] {
479                  #puts $fout "$tag:\t[string trim [textget $tag] "\t\n "]"                  #puts $fout "$tag:\t[string trim [textget $tag] "\t\n "]"
480                  puts $fout "$tag:\t[string trim $frm($tag) "\t\n "]"                  puts $fout "$tag:\t[string trim $frm($tag) "\t\n "]"
481              } [concat >Category >Responsible >Submitter-Id $Tkeditpr(radioflds)] {              } [concat >Category >Responsible >Submitter-Id $Tkeditpr(radioflds)] {
# Line 698  proc fillfrm {} { Line 706  proc fillfrm {} {
706    
707      # listboxes and radio (enumerated) fields      # listboxes and radio (enumerated) fields
708      foreach tag [concat $Tkeditpr(listboxflds) $Tkeditpr(radioflds)] {      foreach tag [concat $Tkeditpr(listboxflds) $Tkeditpr(radioflds)] {
709          set  flds($tag) [string trim $flds($tag) "\t\n "]          if {[info exists flds($tag)]} {
710                set flds($tag) [string trim $flds($tag) "\t\n "]
711            } {
712                set flds($tag) ""
713            }
714          #unset frm($tag)          #unset frm($tag)
715          catch {set frm($tag) $flds($tag)}          catch {set frm($tag) $flds($tag)}
716      }      }
717    
718      # now the 1 line textual flds      # now the 1 line textual flds
719      foreach tag $Tkeditpr(singletextflds) {      foreach tag $Tkeditpr(singletextflds) {
720          set flds($tag) [string trim $flds($tag) "\t\n "]          if {[info exists flds($tag)]} {
721                set flds($tag) [string trim $flds($tag) "\t\n "]
722            } {
723                set flds($tag) ""
724            }
725          textset $tag $flds($tag)          textset $tag $flds($tag)
726      }      }
727    
728        # now the 1 line textual flds
729        foreach tag $Tkeditpr(shorttextflds) {
730            if {[info exists flds($tag)]} {
731                set flds($tag) [string trim $flds($tag) "\t\n "]
732            } {
733                set flds($tag) ""
734            }
735            #puts stderr "Setting $tag to $flds($tag)"
736            textset $tag $flds($tag) .eboxs.shortones
737        }
738    
739      # now the multi line textual flds      # now the multi line textual flds
740      foreach tag $Tkeditpr(multitextflds) {      foreach tag $Tkeditpr(multitextflds) {
741          if {[info exists flds($tag)]} {          if {[info exists flds($tag)]} {
# Line 736  proc reset_report {} { Line 763  proc reset_report {} {
763  proc edit_email_originator {} {  proc edit_email_originator {} {
764      global Tkeditpr flds frm      global Tkeditpr flds frm
765      flush_singletext $Tkeditpr(singletextflds)      flush_singletext $Tkeditpr(singletextflds)
766      email_originator [ftrim $frm(X-GNATS-Notify)] \      flush_singletext $Tkeditpr(shorttextflds)
767    
768        set gn ""
769        if {[info exists $frm(X-GNATS-Notify)]} {
770            set gn [ftrim $frm(X-GNATS-Notify)]
771        }
772        email_originator $gn \
773              [ftrim $frm(>Responsible)] [ftrim $flds(Reply-To)] \              [ftrim $frm(>Responsible)] [ftrim $flds(Reply-To)] \
774              [ftrim $frm(>Category)]/$Tkeditpr(prid) [ftrim $frm(>Synopsis)]              [ftrim $frm(>Category)]/$Tkeditpr(prid) [ftrim $frm(>Synopsis)]
775  }  }
# Line 776  proc edit_window {} { Line 809  proc edit_window {} {
809          >Submitter-Id          >Submitter-Id
810          >Responsible          >Responsible
811      }      }
812    
813        set Tkeditpr(shorttextflds) {
814            >Release
815            >Cost
816            >XrefPR
817        }
818            
819      set Tkeditpr(singletextflds) {      set Tkeditpr(singletextflds) {
820          >Originator          >Originator
         X-GNATS-Notify  
         >Release  
821          >Synopsis          >Synopsis
822            >IPsec-barf-location
823      }      }
824    
825      if {$TkGnats(ReleaseBased)} {      if {$TkGnats(ReleaseBased)} {
# Line 792  proc edit_window {} { Line 830  proc edit_window {} {
830          >Description          >Description
831          >How-To-Repeat          >How-To-Repeat
832          >Environment          >Environment
833          >Organization          >IPsec-look
834          >Fix          >Fix
835          >Audit-Trail          >Audit-Trail
836            >Organization
837          >Unformatted          >Unformatted
838          >Release-Note          >Release-Note
         >Cost  
839      }      }
840            
841      # List of entry widgets for traverse key binding      # List of entry widgets for traverse key binding
# Line 932  proc edit_window {} { Line 970  proc edit_window {} {
970              incr nboxes              incr nboxes
971          }          }
972      }      }
973        frame .eboxs.shortones -relief groove -borderwidth 2
974        foreach f $Tkeditpr(shorttextflds) {
975            if {[check_suppressed_field $f] == 1} {
976                continue
977            }
978            lappend Tkeditpr(tlist) [singletext .eboxs.shortones $f 20 "" 14]
979        }
980        pack .eboxs.shortones -side left
981    
982      if {$nboxes > 1} {      if {$nboxes > 1} {
983          pack .eboxs -side top  -anchor w -pady 2 -padx  0 -fill x          pack .eboxs -side top  -anchor w -pady 2 -padx  0 -fill x
984      }      }
985        
986      foreach f $Tkeditpr(singletextflds) {      foreach f $Tkeditpr(singletextflds) {
987          if {[check_suppressed_field $f] == 1} {          if {[check_suppressed_field $f] == 1} {
988              continue              continue

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

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