cvs.tcl

TKCVS Source Code For CVS。

  set commandline "$cvs -d $cvscfg(cvsroot) checkout \"$filename\"" 
  # run a command, possibly creating the sandbox to play in
  set ret [cvs_sandbox_runcmd $commandline cmd_output]
  if {$cwd == $ret} {
    cvsfail $cmd_output $parent
    cd $cwd
    gen_log:log T "LEAVE ERROR ($cmd_output)"
    return $keepers
  }

  set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\""
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$ret} {
    cvsfail $view_this $parent
    cd $cwd
    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" } {
      set line [string trimleft $line]
      gen_log:log D "$line"
      append keepers "$line\n"
    }
  }
  if {$keepers == ""} {
    set keepers "No Tags"
  }

  cd $cwd
  gen_log:log T "LEAVE"
  return "$keepers"
}

proc cvs_release {delflag directory} {
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($directory)"
  if {! [file isdirectory $directory]} {
    cvsfail "$directory is not a directory" .workdir
    return
  }

  set commandline "$cvs -n -q update $directory"
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  if {$view_this != ""} {
    view_output::new "CVS Check" $view_this
    set mess "$directory is not up-to-date."
    append mess "\nRelease anyway?"
    if {[cvsconfirm $mess .workdir] != "ok"} {
      return
    }
  }
  set commandline "$cvs -Q release $delflag $directory"
  set ret [catch {eval "exec $commandline"} view_this]
  gen_log:log C "$commandline"
  if {$ret != 0} {
    view_output::new "CVS Release" $view_this
  }

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

proc cvs_rtag { cvsroot mcode branch force oldtag newtag } {
#
# This tags a module in the repository.
# Called by the tag commands in the Repository Browser
#
  global cvs
  global cvscfg
  
  gen_log:log T "ENTER ($cvsroot $mcode $branch $force $oldtag $newtag)"
  if {$newtag == ""} {
    cvsfail "You must enter a tag name!" .modbrowse
    return 1
  }

  set command "$cvs -d \"$cvsroot\" rtag"
  if {$branch == "yes"} {
    append command " -b"
  } 
  if {$force == "yes"} {
    append command " -F" 
  }   
  if {$oldtag != ""} {
    append command " -r \"$oldtag\""
  }
  append command " \"$newtag\" \"$mcode\""

  set v [::viewer::new "CVS Rtag"]
  $v\::do "$command"

  gen_log:log T "LEAVE"
}

# dialog for cvs commit - called from workdir browser
proc cvs_commit_dialog {} {
  global incvs
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER"

  if {! $incvs} {
    cvs_notincvs
    gen_log:log T "LEAVE"
    return
  }

  # If marked files, commit these.  If no marked files, then
  # commit any files selected via listbox selection mechanism.
  # The cvsglb(commit_list) list remembers the list of files
  # to be committed.
  set cvsglb(commit_list) [workdir_list_files]

  # If we want to use an external editor, just do it
  if {$cvscfg(use_cvseditor)} {
    cvs_commit "" "" $cvsglb(commit_list)
    return
  }

  if {[winfo exists .commit]} {
    destroy .commit
  }

  toplevel .commit
  grab set .commit

  frame .commit.top -border 8
  frame .commit.vers
  frame .commit.down -relief groove -border 2

  pack .commit.top -side top -fill x
  pack .commit.down -side bottom -fill x
  pack .commit.vers -side top -fill y

  label .commit.lvers -text "Specify Revision (-r) (usually ignore)" \
     -anchor w
  entry .commit.tvers -relief sunken -textvariable version

  pack .commit.lvers .commit.tvers -in .commit.vers \
    -side left -fill x -pady 3

  frame .commit.comment
  pack .commit.comment -side top -fill both -expand 1
  label .commit.lcomment
  text .commit.tcomment -relief sunken -width 70 -height 10 \
    -bg $cvsglb(textbg) -exportselection 1 \
    -wrap word -border 2 -setgrid yes


  # Explain what it means to "commit" files
  message .commit.message -justify left -aspect 500 -relief groove \
    -text "This will commit changes from your \
           local, working directory into the repository, recursively.

\
          For any local (sub)directories or files that are on a branch, \
           your changes will be added to the end of that branch.  \
           This includes new or deleted files as well as modifications.

\
          For any local (sub)directories or files that have \
           a non-branch tag, a branch will be created, and \
           your changes will be placed on that branch.  (CVS bug.) \

\
          For all other (sub)directories, your changes will be \
           added to the end of the main trunk."

  pack .commit.message -in .commit.top -padx 2 -pady 5


  button .commit.ok -text "OK" \
    -command {
      grab release .commit
      wm withdraw .commit
      set cvsglb(commit_comment) [.commit.tcomment get 1.0 end]
      cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list)
    }
  button .commit.apply -text "Apply" \
    -command {
      set cvsglb(commit_comment) [.commit.tcomment get 1.0 end]
      cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list)
    }
  button .commit.clear -text "ClearAll" \
    -command {
      set version ""
      .commit.tcomment delete 1.0 end
    }
  button .commit.quit \
    -command {
      grab release .commit
      wm withdraw .commit
    }
 
  .commit.lcomment configure -text "Your log message" \
    -anchor w
  .commit.ok configure -text "OK"
  .commit.quit configure -text "Close"
  pack .commit.lcomment -in .commit.comment \
    -side left -fill x -pady 3
  pack .commit.tcomment -in .commit.comment \
    -side left -fill both -expand 1 -pady 3

  pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \
    -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  # Fill in the most recent commit message
  .commit.tcomment insert end $cvsglb(commit_comment)

  wm title .commit "Commit Changes"
  wm minsize .commit 1 1

  gen_log:log T "LEAVE"
}

proc cvs_ascii { args } {
# This converts a binary file to ASCII
  global cvs
  global cvscfg
  global incvs
  global cvsglb

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]

  gen_log:log D "Changing sticky flag"
  gen_log:log D "$cvs admin -kkv $filelist"
  set cmd [exec::new "$cvs admin -kkv $filelist"]
  # gen_log:log D "Updating file list"
  # set cmd [exec::new "$cvs update $filelist"]
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    setup_dir
  }

  gen_log:log T "LEAVE"
}

proc cvs_binary { args } {
# This converts an ASCII file to binary
  global cvs
  global cvscfg
  global incvs
  global cvsglb

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set filelist [join $args]

  gen_log:log D "Changing sticky flag"
  gen_log:log D "$cvs admin -kb $filelist"
  set cmd [exec::new "$cvs admin -kb $filelist"]
  # gen_log:log D "Updating file list"
  # set cmd [exec::new "$cvs update $filelist"]
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    setup_dir
  }

  gen_log:log T "LEAVE"
}

# Revert a file to checked-in version by removing the local
# copy and updating it
proc cvs_revert {args} {
  global incvs
  global cvscfg
  global cvs

  gen_log:log T "ENTER ($args)"
  set filelist [join $args]

  gen_log:log D "Reverting $filelist"
  # update -C option appeared in 1.11
  set cvsglb(cvs_version) [cvs_version_number]
  set versionsplit [split $cvsglb(cvs_version) {.}]
  set major [lindex $versionsplit 1]
  if {$major < 11} {
    gen_log:log F "DELETE $filelist"
    file delete $filelist
    set cmd [exec::new "$cvs update $filelist"]
  } else {
    set cmd [exec::new "$cvs update -C $filelist"]
  }
  
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    setup_dir
  }

  gen_log:log T "LEAVE"
}

proc read_cvs_dir {dirname} {
#
# Reads a CVS "bookkeeping" directory
#
  global module_dir
  global cvscfg
  global cvsglb
  global current_tagname

  gen_log:log T "ENTER ($dirname)"
  set current_tagname "trunk"
  if {[file isdirectory $dirname]} {
    if {[file isfile [file join $dirname Repository]]} {
      gen_log:log F "OPEN CVS/Repository"
      set f [open [file join $dirname Repository] r]
      gets $f module_dir
      close $f
      gen_log:log D "  MODULE $module_dir"
      if {[file isfile [file join $dirname Root]]} {
        gen_log:log F "OPEN CVS/Root"
        set f [open [file join $dirname Root] r]
        gets $f cvscfg(cvsroot)
        close $f
        # On a PC, the cvsroot can be like C:\DosRepository.
        # This makes that workable.
        regsub -all {\\} $cvscfg(cvsroot) {\\\\} cvscfg(cvsroot)
        gen_log:log D " cvsroot: $cvscfg(cvsroot)"
      }
      if {[file isfile [file join $dirname Tag]]} {
        gen_log:log F "OPEN CVS/Tag"
        set f [open [file join $dirname Tag] r]
        gets $f current_tagname
        close $f
        # T = branch tag, N = non-branch, D = sticky date
        set current_tagname [string range $current_tagname 1 end]
        gen_log:log D "  BRANCH TAG $current_tagname"
      }
    } else {
      cvsfail "Repository file not found in $dirname" .workdir
    }
  } else {
    cvsfail "$dirname is not a directory" .workdir
  }
  set cvsglb(root) $cvscfg(cvsroot)
  #gen_log:log D "cvsglb(root) $cvsglb(root)"
  #gen_log:log D "cvscfg(cvsroot) $cvscfg(cvsroot)"
  gen_log:log T "LEAVE"
}

proc parse_cvsmodules {modules_file} {
  global cvs
  global modval
  global modtitle
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER"

  # Clear the arrays
  catch {unset modval}
  catch {unset modtitle}

  # Unescape newlines, compress repeated whitespace, and remove blank lines
  regsub -all {(\\\n|[ \t])+} $modules_file " " modules_file
  regsub -all {\n\s*\n+} $modules_file "\n" modules_file

  foreach line [split $modules_file "\n"] {
    if {[string index $line 0] == {#}} {
#     gen_log:log D "Comment: $line"
      if {[string index $line 1] == {D} || [string index $line 1] == {M}} {
        set text [split $line]
        set dname [lindex $text 1]
        set modtitle($dname) [lrange $text 2 end]
#       gen_log:log D "Directory: {$dname} {$modtitle($dname)}"
      }
    } else {
#     gen_log:log D "Data: $line"
      set text [split $line]
      set modname [lindex $text 0]
      set modstring [string trim [join [lrange $text 1 end]]]
      # A "#D ..." or "#M ..." entry _always_ overrides this default
      if {! [info exists modtitle($modname)]} {
        set modtitle($modname) $modstring
      }
      # Remove flags except for -a.  Luckily alias modules can't have
      # any other options.
#     gen_log:log D "{$modname} {$modstring}"
      regsub -- {^((-l\s*)|(-[ioestud]\s+((\\\s)|\S)+\s*))+} \
        $modstring {} modstring
      if {$modname != ""} {
        set modval($modname) $modstring
        gen_log:log D "{$modname} {$modstring}"
      }
    }
  }

  gen_log:log T "LEAVE"
}

proc cvs_lock {do files} {
  global cvscfg
  global cvscfg

  if {$files == {}} {
    cvsfail "Please select one or more files!" .workdir
    return
  }
  switch -- $do {
    lock { set commandline "cvs admin -l $files"}
    unlock { set commandline "cvs admin -u $files"}
  }
  set cmd [::exec::new "$commandline"]
  
  if {$cvscfg(auto_status)} {
    $cmd\::wait
    setup_dir
  }
}

# Sends directory "." to the directory-merge tool
# Find the bushiest file in the directory and diagram it
proc cvs_directory_merge {} {
  global cvscfg
  global cvsglb
  global cvs
  global incvs
  
  gen_log:log T "ENTER"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }
  set files [glob -nocomplain -types f -- .??* *]

  regsub -all {\$} $files {\$} files
  set commandline "$cvs -d $cvscfg(cvsroot) log $files"
  gen_log:log C "$commandline"
  catch {eval "exec $commandline"} raw_log
  set log_lines [split $raw_log "\n"]

  foreach logline $log_lines {
    if {[string match "Working file:*" $logline]} {
      set filename [lrange [split $logline] 2 end]
      set nbranches($filename) 0
      continue