cvs.tcl

TKCVS Source Code For CVS。

  }
  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select a directory!" .workdir
    return 1
  } else {
    set mess "This will recursively add these directories:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }  
  }
  
  set v [viewer::new "CVS Add directory"]

  set awd [pwd]
  foreach file $filelist {
    if {[file isdirectory $file]} {
      set commandline "$cvs add \"$file\""
      $v\::do "$commandline"
      $v\::wait

      cd $file
      gen_log:log F "CD [pwd]"
      add_subdirs $binflag $v
    }
  }

  cd $awd
  gen_log:log F "[pwd]"
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc add_subdirs {binflag v} {
  global cvs
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER ($binflag $v)"
  set plainfiles {}
  foreach child  [glob -nocomplain $cvscfg(aster) .??*] {
    if [file isdirectory $child] {
      if {[regexp -nocase {^CVS$} [file tail $child]]} {
        gen_log:log D "Skipping $child"
        continue
      }
      set commandline "$cvs add \"$child\""
      $v\::do "$commandline"
      $v\::wait
      set awd [pwd]
      cd $child
      gen_log:log F "CD [pwd]"
      add_subdirs $binflag $v
      cd $awd
      gen_log:log F "CD [pwd]"
    } else {
      lappend plainfiles $child
    }
  }
  if {[llength $plainfiles] > 0} {
    # LJZ: get local ignore file filter list
    set ignore_file_filter $cvsglb(default_ignore_filter)
    if { [ file exists ".cvsignore" ] } {
      set fileId [ open ".cvsignore" "r" ]
      while { [ eof $fileId ] == 0 } {
        gets $fileId line
        append ignore_file_filter " $line"
      }
      close $fileId
    }

    # LJZ: ignore files if requested in recursive add
    if { $ignore_file_filter != "" } {
      foreach item $ignore_file_filter {
        # for each pattern
        if { $item != "*" } {
          # if not "*"
          while { [set idx [lsearch $plainfiles $item]] != -1 } {
            # for each occurence, delete
            catch { set plainfiles [ lreplace $plainfiles $idx $idx ] }
          }
        }
      }
    }

    # LJZ: any files left after filtering?
    if {[llength $plainfiles] > 0} {
      set commandline "$cvs add $binflag $plainfiles"
      $v\::do "$commandline"
      $v\::wait
    }
  }

  gen_log:log T "LEAVE"
}

proc rem_subdirs { v } {
  global cvs
  global incvs
  global cvscfg

  gen_log:log T "ENTER ($v)"
  set plainfiles {}
  foreach child  [glob -nocomplain $cvscfg(aster) .??*] {
    if [file isdirectory $child] {
      if {[regexp -nocase {^CVS$} [file tail $child]]} {
        gen_log:log D "Skipping $child"
        continue
      }
      set awd [pwd]
      cd $child
      gen_log:log F "CD [pwd]"
      rem_subdirs $v
      cd $awd
      gen_log:log F "CD [pwd]"
    } else {
      lappend plainfiles $child
    }
  }
  if {[llength $plainfiles] > 0} {
    foreach file $plainfiles {
      gen_log:log F "DELETE $file"    
      file delete -force -- $file
      if {[file exists $file]} {cvsfail "Remove $file failed" .workdir}
    }
    #set commandline "$cvs remove $plainfiles"
    #$v\::do "$commandline" 1
    #$v\::wait
  }

  gen_log:log T "LEAVE"
}

proc cvs_fileview_update {revision filename} {
#
# This views a specific revision of a file in the repository.
# For files checked out in the current sandbox.
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($revision $filename)"
  if {$revision == {}} {
    set commandline "$cvs -d $cvscfg(cvsroot) update -p \"$filename\""
    set v [viewer::new "$filename"]
    $v\::do "$commandline" 0
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) update -p -r $revision \"$filename\""
    set v [viewer::new "$filename Revision $revision"]
    $v\::do "$commandline" 0
  }
  gen_log:log T "LEAVE"
}

proc cvs_fileview_checkout {revision filename} {
#
# This looks at a revision of a file from the repository.
# Called from Repository Browser -> File Browse -> View
# For files not currently checked out
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($revision)"
  if {$revision == {}} {
    set commandline "$cvs -d $cvscfg(cvsroot) checkout -p \"$filename\""
    set v [viewer::new "$filename"]
    $v\::do "$commandline"
  } else {
    set commandline "$cvs -d $cvscfg(cvsroot) checkout -p -r $revision \"$filename\""
    set v [viewer::new "$filename Revision $revision"]
    $v\::do "$commandline"
  }
  gen_log:log T "LEAVE"
}

proc cvs_log {args} {
#
# This looks at a log from the repository.
# Called by Workdir menu Reports->"CVS log ..."
#
  global cvs
  global cvscfg

  set filelist [join $args]

  # Don't recurse
  set commandline "$cvs log -l "
  switch -- $cvscfg(ldetail) {
    latest {
      # -N means don't list tags
      append commandline "-Nr "
    }
    summary {
      append commandline "-Nt "
    }
  }
  append commandline "$filelist"

  set logcmd [viewer::new "CVS log ($cvscfg(ldetail))"]
  $logcmd\::do "$commandline" 0 hilight_rcslog
  busy_done .workdir.main

  gen_log:log T "LEAVE"
}

proc cvs_annotate {revision args} {
#
# This looks at a log from the repository.
# Called by Workdir menu Reports->"CVS log ..."
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($revision $args)"

  if {$revision == "trunk"} {
    set revision ""
  }
  if {$revision != ""} {
    # We were given a revision
    set revflag "-r$revision"
  } else {
    set revflag ""
  }

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Annotate:\nPlease select one or more files !" .workdir
    gen_log:log T "LEAVE (Unselected files)"
    return
  }
  foreach file $filelist {
    annotate::new $revflag $file "cvs"
  }
  gen_log:log T "LEAVE"
}

proc cvs_annotate_r {revision file} {
#
# This looks at a log from the repository.
# Called by Logcanvas when not in a CVS directory
#
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($revision $file)"

  if {$revision != ""} {
    # We were given a revision
    set revflag "-r$revision"
  } else {
    set revflag ""
  }

  annotate::new $revflag $file "cvs_r"
  gen_log:log T "LEAVE"
}

proc cvs_commit {revision comment args} {
#
# This commits changes to the repository.
#
# The parameters work differently here -- args is a list.  The first
# element of args is a list of file names.  This is because I can't
# use eval on the parameters, because comment contains spaces.
#
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($revision $comment $args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  set filelist [lindex $args 0]

  # changed the message to be a little more explicit.  -sj
  set commit_output ""
  if {$filelist == ""} {
    set mess "This will commit your changes to ** ALL ** files in"
    append mess " and under this directory."
  } else {
    foreach file $filelist {
      append commit_output "\n$file"
    }
    set mess "This will commit your changes to:$commit_output"
  }
  append mess "\n\nAre you sure?"
  set commit_output ""

  if {[cvsconfirm $mess .workdir] != "ok"} {
    return 1
  }

  set revflag ""
  if {$revision != ""} {
    set revflag "-r $revision"
  }

  if {$cvscfg(use_cvseditor)} {
    # Starts text editor of your choice to enter the log message.
    # This way a template in CVSROOT can be used.
    update idletasks
    set commandline \
      "$cvscfg(terminal) $cvs commit -R $revflag $filelist"
    gen_log:log C "$commandline"
    set ret [catch {eval "exec $commandline"} view_this]
    if {$ret} {
      cvsfail $view_this .workdir
      gen_log:log T "LEAVE ERROR ($view_this)"
      return
    }
  } else {
    if {$comment == ""} {
      cvsfail "You must enter a comment!" .commit
      return 1
    }
    set v [viewer::new "CVS Commit"]
    regsub -all "\"" $comment "\\\"" comment
    # Lets not show stderr as it does a lot of "examining"
    $v\::do "$cvs commit -R $revflag -m \"$comment\" $filelist" 0
    $v\::wait
  }

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_tag {tagname force branch update args} {
#
# This tags a file in a directory.
#
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($tagname $force $branch $update $args)"

  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$tagname == ""} {
    cvsfail "You must enter a tag name!" .workdir
    return 1
  }

  set filelist [join $args]

  set command "$cvs tag"
  if {$branch == "yes"} {
   append command " -b"
  }
  if {$force == "yes"} {
    append command " -F"
  }
  append command " $tagname $filelist"

  if {$branch == "yes" && $force == "yes"} {
    set too_new 0
    # As of 1.11.2, -F won't move branch tags without the -B option
    set cvsglb(cvs_version) [cvs_version_number]
    set versionsplit [split $cvsglb(cvs_version) {.}]
    set major [lindex $versionsplit 1]
    set minor [lindex $versionsplit 2]
    if {$major > 11} {
      set too_new 1
    } elseif {($major == 11) && ($minor >= 2)} {
      set too_new 1
    }
    if {$too_new} {
      cvsfail "In CVS version >= 1.11.2, you're not allowed to move a branch tag" .workdir
    }
    return
  }

  # If it refuses to tag, it can exit with 0 but still put out some stderr
  set v [viewer::new "CVS Tag"]
  $v\::do "$command" 1
  $v\::wait

  if {$update == "yes"} {
    # update so we're on the branch
    set command "$cvs update -r $tagname $filelist"
    $v\::do "$command" 0 status_colortags
    $v\::wait
  }

  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc cvs_update {tagname normal_binary action_if_no_tag get_all_dirs dir args} {
#
# This updates the files in the current directory.
#
  global cvs
  global cvscfg
  global incvs

  gen_log:log T "ENTER ($tagname $normal_binary $action_if_no_tag $get_all_dirs $dir $args)"

  if { $normal_binary == "Normal" } {
      set mess "Using normal (text) mode.\n"
  } elseif { $normal_binary == "Binary" } {
      set mess "Using binary mode.\n"
  } else {
      set mess "Unknown mode:  $normal_binary\n"
  }

  if { $tagname != "BASE"  && $tagname != "HEAD" } {
      append mess "\nIf a file does not have tag $tagname"
      if { $action_if_no_tag == "Remove" } {
          append mess " it will be removed from your local directory.\n"
      } elseif { $action_if_no_tag == "Get_head" } {
          append mess " the head revision will be retrieved.\n"
      } elseif { $action_if_no_tag == "Skip" } {
          append mess " it will be skipped.\n"
      }
  }

  if { $tagname == "HEAD" } {
    append mess "\nYour local files will be updated to the"
    append mess " latest main trunk (head) revision."
    append mess " CVS will try to preserve any local, un-committed changes.\n"
  }

  append mess "\nIf there is a directory in the repository"
  append mess " that is not in your local, working directory,"
  if { $get_all_dirs == "Yes" } {
    append mess " it will be checked out at this time.\n"
  } else {
    append mess " it will not be checked out.\n"
  }

  set filelist [join $args]
  if {$filelist == ""} {
    append mess "\nYou are about to download from"
    append mess " the repository to your local"
    append mess " filespace ** ALL ** files which"
    append mess " have changed in it."
  } else {
    append mess "\nYou are about to download from"
    append mess " the repository to your local"