vendor_merge.tcl

TKCVS Source Code For CVS。

  # Check for this and save the directory where the merge operation is to be done
  # later.
  if { [file tail [pwd]] == $modbrowse_module } {
     set dir4merge [pwd]
  } else {
     set tmpdir [glob -nocomplain $modbrowse_module]
     if { $tmpdir == "" } {
        cvsfail "You must invoke the merge command from the checked out 
directory of $modbrowse_module or one above it" .merge
        return
     }
     set dir4merge [file join [pwd] $tmpdir]
  }
  
  set mess "This will merge differences between $merge(from) and"
  append mess " $merge(to) of $merge(3rd_party) into $modbrowse_module"
  append mess "\n\n Are you sure?"
  if {[cvsconfirm $mess .merge] == 1} {
    return
  }
  # The CVS directory in the checked out $modbrowse_module are associated with
  # $modbrowse_module. Since we are going to merge in differences between 
  # $merge(from) & $merge(to) of $merge(3rd_party), the CVS directory to be used
  # later in directory $dir4merge needs to from directory $merge(3rd_party).
  # Do that next and save it into a temp directory mktemp_dir
  
  set mktemp "$cvscfg(tmpdir)/merge[pid]"
  set mktemp_dir $mktemp.dir
  set v [viewer::new "Vendor Merge"]
  $v\::log "CVS Checkout of temp sandbox for $merge(3rd_party)\n"
  set cmd "$cvs checkout -d $mktemp_dir -r$merge(from) $merge(3rd_party)"
  $v\::do "$cmd"
  $v\::wait
  update
    
  # CVS directory in $mktemp_dir will be copied later

  cd $dir4merge
  gen_log:log F "CD [pwd]"

  # Save CVS directory of $modbrowse_module which is to be restored after
  # the merge command has been completed. Save it to $mktemp_dir
  set sav_dir [file join $mktemp_dir CVS_save]
  gen_log:log F "COPY CVS $sav_dir"
  file copy CVS $sav_dir
  gen_log:log F "DELETE CVS"
  file delete -force CVS; # Need -force for a directory
  # Then copy the CVS file from $mktemp_dir
  set sav_cvs [file join $mktemp_dir CVS]
  gen_log:log F "COPY $sav_cvs CVS"
  file copy -force $sav_cvs CVS

  $v\::log "\nCVS Merge of $merge(3rd_party) into $modbrowse_module\n"
  set cmd "$cvs checkout -d [pwd] -j$merge(from) -j$merge(to) $merge(3rd_party)"
  $v\::do "$cmd"
  $v\::wait

  $v\::log "\nCVS rdiff from $merge(from) to $merge(to) for $merge(3rd_party)\n"
  set cmd "$cvs rdiff -s -r$merge(from) -r$merge(to) $merge(3rd_party)"
  $v\::do "$cmd"
  $v\::wait
  update

  # Restore CVS directory associated with #modbrowse_module
  gen_log:log F "DELETE CVS"
  file delete -force CVS
  file copy $sav_dir CVS
  gen_log:log F "COPY $sav_dir CVS"
  # Remove the temp directory
  gen_log:log F "DELETE $mktemp_dir"
  file delete -force $mktemp_dir
  gen_log:log T "LEAVE"
}

proc unpack_tag_word { tag_word type tag_message} {
  upvar $type typ $tag_message tag_m
#
# Unpacks vendor and release tag information obtained from an RCS ,v file.
# In an RCS ,v file, between the keywords "symbols" and "locks" keywords,
# there are packed words with the following format:
#
#            tag_info:tag_ident
#
# where: tag_info is either the vendortag or releasetag which was entered
#        when a cvs checkin or import command was invoked.
#        tag_ident is of the form:
#          x.y.z for a vendor tag (3 subfields or 2 dots)
#          x.y,  x.y.z.w, or x.y.z.w.u.v for a release tag
#
# Called by:
#
# input: tag_word - word from a RCS ,v file between the "symbols" and "locks"
#                   keywords
# output: type - 0 if tag_word contains packed info on a release tag
#                1 if tag_word contains packed info on a vendor tag
# output: tag_message - a vendortag or releasetag as entered when a cvs
#         checkin or import command was invoked
#
# By: Eugene A. Lee, Aerospace Corporation
# Date: Sept 15, 1995
#
  gen_log:log T "ENTER ($tag_word $type $tag_message)"

  set fields [split $tag_word :]
  set tag_m [string trimleft [lindex $fields 0]]
  set tag_num [string trimleft [lindex $fields 1]]

  # strip off any trailing ; character
  regsub {;$} $tag_num "" tag_num

  if { [llength [split $tag_num . ]]  == 3 } {
    set typ 1; # release tag
  } else {
    set typ 0; # vendor tag
  }
  gen_log:log T "LEAVE"
}

proc get_rv_tags { mcode r_tag_list v_tag_list } {
  global filenames
  upvar $v_tag_list vtag_list
  upvar $r_tag_list rtag_list
#
#  From the original code of E.A. Lee
# Rewrite by M.R. Koelewijn, trying to make this work with a remote repository
#  Assumption:
#    The caller has created the sandbox in a local tmpdir, containing the
#    relevant files for this 'mcode'
#    The global 'filenames' has been set up to contain the names of the files
#  So, with merge_taglist the filenames are passed to CVS, with the request
# to cough up some info. This info contains the tags (thanks, whoever did the
# logcanvas): one big list of tags. Than we sort out the uniqe ones.
#
# Packed releasetag word has the format:
#                releasetag:branch_id
#   where: releasetag was specified when the cvs import command was invoked.
#          branch_id is of the forms: x.y, x.y.z.w, x.y.z.w.u.v, etc,
#          (odd number or subfields)
#
# Packed vendortag word has the format:
#                vendortag:branch_id
#   where: vendortag was specified when the cvs import command was invoked.
#          branch_id is of the forms: x.y.z (3 subfields or 2 dots)
#
# Output: r_tag_list    - sorted releasetag list for the CVS module
# Output: v_tag_list    - sorted vendortag list for the CVS module
#
# Note: v_tag_list has no planned use for tkcvs yet. They are returned just
#       because this information was available.
#

  gen_log:log T "ENTER ($mcode $r_tag_list $v_tag_list)"

  set rlist ""  ;# easies way to allow lsearch to work without having to
  set vlist ""  ;# use info exists statements

  foreach tag [cvs_sandbox_filetags $mcode $filenames($mcode)] {
    gen_log:log D "Next tag: $tag"
    unpack_tag_word $tag type tag_message
    gen_log:log D "$tag is type $type message $tag_message"
    if {$type == 0 } {
      if {[lsearch -exact $rlist $tag_message] < 0} {
        gen_log:log D "New Release tag found: $tag_message"
        lappend rlist $tag_message
      }
    }
    if {$type == 1 } {
      if {[lsearch -exact $rlist $tag_message] < 0} {
        gen_log:log D "New Vendor tag found: $tag_message"
        lappend vlist $tag_message
      }
    }
  }
  # Unsorted master releasetag and versiontag lists have been found.
  if { [info exists rlist] == 1 } {
    set rtag_list [lsort $rlist]
  } else {
    gen_log:log D "no mrlist created"
  }
  if { [info exists vlist] == 1 } {
    set vtag_list [lsort $vlist]
  } else {
    gen_log:log D "no mvlist created"
  }
  gen_log:log T "LEAVE"
}

proc merge_taglist {files} {
  global cvscfg
  global cvs

  gen_log:log T "ENTER ($files)"
  set commandline "$cvs -d $cvscfg(cvsroot) log $files"
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  gen_log:log "C" "$view_this"
  if {$ret} {
    cvsfail $view_this .merge
    gen_log:log T "LEAVE ERROR"
    return $keepers
  }
  set view_lines [split $view_this "\n"]
  foreach line $view_lines {
    if {[string index $line 0] == "\t" } {
      regsub -all {[\t ]*} $line "" tag
      append keepers "$tag "
    }
  }
  gen_log:log T "LEAVE"
  return $keepers
}

proc vendorDialog {} {
  global ExModList ExModDirList
  global venselect_mcode
  set w .venDialog
  grab release .merge
  catch {destroy $w}
  toplevel $w
  wm title $w "Select A Vendor"
  grab set $w

  frame $w.buttons
  pack $w.buttons -side bottom -fill x -pady 2m
  button $w.buttons.ok -text Ok \
    -command {
      if {$venselect_mcode == ""} {
         return
      }
      put_rev_tags $venselect_mcode
      destroy .venDialog
      raise .merge
      #grab set .merge
    }
  button $w.buttons.cancel -text Cancel \
    -command {
      grab release .venDialog
      wm withdraw .venDialog
    }

  pack $w.buttons.ok -side left -expand 1
  pack $w.buttons.cancel -side left -expand 1

  frame $w.frame -borderwidth .5c
  pack $w.frame -side top -expand yes -fill y

  scrollbar $w.frame.scroll -command "$w.frame.list yview"
  listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 5
  pack $w.frame.scroll -side right -fill y
  pack $w.frame.list -side left -expand 1 -fill both

  getExistModDialog 
  set nModule [llength $ExModList]
  for {set i 0} {$i < $nModule} {incr i} {
    $w.frame.list insert end [lindex $ExModList $i]
  }

  bind $w.frame.list <Button-1> {
    set venselect_mcode [%W get [%W nearest %y] ]
  }
}