vendor_merge.tcl

TKCVS Source Code For CVS。

# Tcl Library for TkCVS

#
# Modifications by Eugene Lee 10/16/03 
# 1. .merge window made more robust so user cannot key in incorrect data.
# 2. Name of Vendor Module is selectable by user (no longer hardcoded to Vendor). 
#    proc vendor_wait no longer used
# 3. Added proc vendorDialog
 

proc merge_run {mcode} {
# By: Eugene Lee, Aerospace Corporation, 11/12/95
# Modified by E. Lee 10/16/03
  global cvs
  global modbrowse_module
  global from_to
  global sel_to
  global cwd
  global module_dir
  global merge
  gen_log:log T "ENTER ($mcode)"

  if {$mcode == ""} {
    cvsfail "Please select a module!" .modbrowse
    gen_log:log T "LEAVE"
    return
  }

  if {[winfo exists .merge]} {
    .merge.right.tcwd configure -textvariable cwd
    .merge.right.tmodule configure -textvariable modbrowse_module
    wm deiconify .merge
    raise .merge
    #grab set .merge
    gen_log:log T "LEAVE"
    return
  }

  toplevel .merge
  #grab set .merge

  frame .merge.left
  frame .merge.right
  frame .merge.vendor -relief groove -border 2
  frame .merge.down -relief groove -border 2

  pack .merge.down -side bottom -fill x -expand yes
  pack .merge.vendor -side bottom -fill x -expand yes
  pack .merge.left   -side left
  pack .merge.right  -side right -fill x -expand yes

  label .merge.left.lcwd      -text "Current Directory" -width 16  -anchor w
  label .merge.left.lmodule   -text "Module"  -width 16  -anchor w
  label .merge.right.tcwd  -textvariable cwd   -relief sunken -width 40 -anchor w
  label .merge.right.tmodule -textvariable modbrowse_module -relief sunken -width 40 -anchor w

  pack .merge.left.lcwd       -side top   -fill x -pady 3
  pack .merge.left.lmodule    -side top   -fill x
  pack .merge.right.tcwd      -side top   -fill x -pady 3
  pack .merge.right.tmodule   -side top   -fill x

  frame .merge.vendor.name
  pack .merge.vendor.name -side top -fill x -expand yes
  label .merge.vendor.name.l -text "Vendor Module" -width 16 -anchor w
  label .merge.vendor.name.e -relief sunken -textvariable venselect_mcode -anchor w
  button .merge.vendor.name.b -text "Browse ..." -command "vendorDialog"
  pack .merge.vendor.name.l -side left -fill x -pady 3
  pack .merge.vendor.name.b -side right -anchor w -fill x 
  pack .merge.vendor.name.e -side right -anchor w -fill x -pady 3 -expand yes
  #.merge.vendor.name.e config -state disabled
  bind .merge.vendor.name.e <Return> { put_rev_tags $venselect_mcode }

  frame .merge.vendor.l
  frame .merge.vendor.r
  pack .merge.vendor.l .merge.vendor.r -side left

  foreach i {l r} {
    if { $i == "l" } {
      set x "From"
    } else {
      set x "To"
    }
    label .merge.vendor.$i.rev -text "$x Revision Tags"
    pack .merge.vendor.$i.rev -side top

    frame .merge.vendor.$i.scroll
      eval {listbox .merge.vendor.$i.scroll.list \
              -yscrollcommand [list .merge.vendor.$i.scroll.sy set] \
              -xscrollcommand [list .merge.vendor.$i.scroll.sx set]} \
      -relief sunken -width 40 -height 8
    scrollbar .merge.vendor.$i.scroll.sx -orient horizontal \
      -command [list .merge.vendor.$i.scroll.list xview] \
      -relief sunken
    scrollbar .merge.vendor.$i.scroll.sy -orient vertical \
      -command [list .merge.vendor.$i.scroll.list yview] \
      -relief sunken
    pack .merge.vendor.$i.scroll.sx -side bottom -fill x
    pack .merge.vendor.$i.scroll.sy -side right -fill y
    pack .merge.vendor.$i.scroll.list -side left -fill both -expand true
    pack .merge.vendor.$i.scroll -side top

    frame .merge.vendor.$i.f
    pack .merge.vendor.$i.f -side bottom
    label .merge.vendor.$i.f.l -text $x
    if { $i == "l" } {
      label .merge.vendor.$i.f.s \
        -textvariable merge(from) -relief sunken -width 15
    } else {
      label .merge.vendor.$i.f.s \
        -textvariable merge(to) -relief sunken -width 15
    }

    pack .merge.vendor.$i.f.l -side left -padx 3 -pady 3
    pack .merge.vendor.$i.f.s -side left -pady 3
  }

  button .merge.ok -text "OK" \
    -command {
      if { $venselect_mcode == "" } {
         cvsfail "Please select a Vendor" .merge
         return
      }
      catch do_merge results
      if { $results == "err" } { return }
      grab release .merge
      wm withdraw .merge
    }
  button .merge.quit -text "Cancel" \
    -command {
      grab release .merge
      wm withdraw .merge
    }
  pack .merge.ok .merge.quit -in .merge.down -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both 

  bind .merge.vendor.l.scroll.list <<ListboxSelect>> {
    get_j .merge.vendor.l.scroll.list left
  }
  bind .merge.vendor.r.scroll.list <<ListboxSelect>> {
    get_j .merge.vendor.r.scroll.list right
  }

  # Needed for slower framebuffers
  #tkwait visibility .merge

  wm title .merge "Module Level Merge With Vendor Code"
  wm minsize .merge 30 10

  gen_log:log T "LEAVE"
}

proc get_j { list side} {
# Written by Eugene A. Lee, Aerospace Corp., 12/20/94
  global merge

  gen_log:log T "ENTER ($list $side)"
  gen_log:log D "[$list curselection]"
  if {[string compare [$list curselection] ""] == 0} return
  set Sel [$list get [$list curselection]]

  if {$side == "left"} {
    set merge(from) [lindex [split $Sel] 0]
  } else {
    set merge(to) [lindex [split $Sel] 0]
  }
  gen_log:log T "LEAVE"
}

proc put_rev_tags {code} {
# Written by Eugene A. Lee, Aerospace Corp., 11/12/95
# Called by button .venselect.ok in venget.tcl
# Made usable for remote repositories by MK
#
# Go to the tmpdir aka cvs.tcl
# Retrieve the whole friggin stuff into the directory (update from head)
# Get the tags for all the files by calling put_rv_tags
# Parse that result
#
  global cvscfg
  global merge
  global venselect_mcode
  global cwd
  global cvs
  global filenames

  set tmpwdir [pwd]

  gen_log:log T "ENTER"
  .merge.vendor.l.scroll.list delete 0 end
  .merge.vendor.r.scroll.list delete 0 end

  set ret [cvs_sandbox_runcmd \
     "$cvs -d $cvscfg(cvsroot) checkout $venselect_mcode" cmd_output]
  if {$ret == $cwd} {
    cd $cwd
    gen_log:log T "leave -- failed cvs checkout statement"
    return
  }
  cd $venselect_mcode
  gen_log:log F "CD [pwd]"

  set view_lines [split $cmd_output "\n"]
  foreach line $view_lines {
    gen_log:log D "Evaluating line $line"
    if {[string match "U *" $line]} {
      set dname [lindex [split $line] 1]
      regsub "$venselect_mcode/" $dname "" fname
      if {[info exists filenames($venselect_mcode)]} {
        lappend filenames($venselect_mcode) $fname
      } else {
        set filenames($venselect_mcode) $fname
      }
    }
  }

  gen_log:log F "filenames($venselect_mcode) existence:[info exists filenames($venselect_mcode)]"

  #  get the module into the source
  if {[info exists filenames($venselect_mcode)]}  {
    get_rv_tags $venselect_mcode r_tag_list v_tag_list
  }

  cd $tmpwdir
  if { [info exists r_tag_list] == 0 } {
    foreach i {l r} {
      .merge.vendor.$i.scroll.list insert end "No revision tags found"
    }
  } else {
    for {set i 0} {$i < [llength $r_tag_list]} {incr i} {
      set tmp [lindex $r_tag_list $i]
      .merge.vendor.l.scroll.list insert end $tmp
      .merge.vendor.r.scroll.list insert end $tmp
    }
  }
  cd $cwd
  gen_log:log T "LEAVE"
}

proc do_merge {} {
  global merge
  global cvscfg
  global cvs
  global venselect_mcode
  global modbrowse_module
  
  gen_log:log T "ENTER"
  set merge(3rd_party) $venselect_mcode
  if { $merge(3rd_party) == "" } {
    cvsfail "Vendor Module not specified" .merge
    return err
  }

  if { $merge(from) == "" || $merge(to) == "" } {
    cvsfail "not all entries filled" .merge
    return err
  }
  
  # In order to merge difference between tags of 3rd_party into $modbrowse_module
  # the directory where the merge is to be done later must be in the checkout 
  # directory of $modbrowse_module. If the user just checked out the 
  # $modbrowse_module and invoked the merge command, the current directory at this
  # point in the script is most likely one above directory $modbrowse_module.