svn.tcl

TKCVS Source Code For CVS。

    gen_log:log F "CLOSE $outfile"
  }
  gen_log:log T "LEAVE"
  return
}

# Called from module browser filebrowse button
proc svn_list {module} {
  global cvscfg

  gen_log:log T "ENTER ($module)"
  set v [viewer::new "SVN list -R"]
  $v\::do "svn list -Rv \"$cvscfg(svnroot)/$module\""
  gen_log:log T "LEAVE"
}

# Called from the module browser
proc svn_delete {root path} {

  gen_log:log T "ENTER ($root $path)"

  set mess "Really delete $path from the SVN repository?"
  if {[cvsconfirm $mess .modbrowse] != "ok"} {
    return
  }
  set url [safe_url $root/$path]
  set v [viewer::new "SVN delete"]
  set command "svn delete \"$url\" -m\"Removed_using_TkSVN\""
  $v\::do "$command"
  modbrowse_run
  gen_log:log T "LEAVE"
}

# This is the callback for the folder-opener in ModTree
proc svn_jit_listdir { tf into } {
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($tf $into)"
  set cvscfg(svnroot) $cvsglb(root)
  #puts "\nEntering svn_jit_listdir ($into)"
  set dir [string trimleft $into / ]
  set command "svn list -v \"$cvscfg(svnroot)/$dir\""
  #puts "$command"
  set cmd(svnlist) [exec::new "$command"]
  if {[info exists cmd(svnlist)]} {
    set contents [split [$cmd(svnlist)\::output] "\n"]
  }
  set dirs {}
  set fils {}
  foreach logline $contents {
    if {$logline == "" } continue
    gen_log:log D "$logline"
    if [string match {*/} $logline] {
      set item [lrange $logline 5 end]
      set item [string trimright $item "/"]
      lappend dirs "$item"
      set info($item) [lrange $logline 0 4]
    } else {
      set item [lrange $logline 6 end]
      lappend fils "$item"
      set info($item) [lrange $logline 0 5]
    }
  }

  busy_start $tf
  ModTree:close $tf /$dir
  #puts "<- delitem /$dir/d"
  ModTree:delitem $tf /$dir/d
  foreach f $fils {
    set command "ModTree:newitem $tf \"/$dir/$f\" \"$f\" \"$info($f)\" -image Fileview"
    set r [catch "$command" err]
  }
  foreach d $dirs {
    svn_jit_dircmd $tf $dir/$d
  }
  gen_log:log D "ModTree:open $tf /$dir"
  ModTree:open $tf /$dir

  #puts "\nLeaving svn_jit_listdir"
  busy_done $tf
  gen_log:log T "LEAVE"
}

proc svn_jit_dircmd { tf dir } {
  global cvscfg

  gen_log:log T "ENTER ($tf $dir)"
  #puts "\nEntering svn_jit_dircmd ($dir)"

  # Here we are just figuring out if the top level directory is empty or not.
  # We don't have to collect any other information, so no -v flag
  set command "svn list \"$cvscfg(svnroot)/$dir\""
  #puts "$command"
  set cmd(svnlist) [exec::new "$command"]
  if {[info exists cmd(svnlist)]} {
    set contents [$cmd(svnlist)\::output]
  }
  set lbl "[file tail $dir]/"
  set exp "([llength $contents] items)"

  set dirs {}
  set fils {}
  foreach logline [split $contents "\n"] {
    if {$logline == ""} continue
    #gen_log:log D "$logline"
    if [string match {*/} $logline] {
      set item [string trimright $logline "/"]
      lappend dirs $item
    } else {
      lappend fils $logline
    }
  }

  if {$dirs == {} && $fils == {}} {
    #puts "  $dir is empty"
    catch "ModTree:newitem $tf \"/$dir\" \"$lbl\" \"$exp\" -image Folder"
  } else {
    #puts "  $dir has contents"
    set r [catch "ModTree:newitem $tf \"/$dir\" \"$lbl\" \"$exp\" -image Folder" err]
    if {! $r} {
      #puts "-> newitem /$dir/d"
      catch "ModTree:newitem $tf \"/$dir/d\" d d -image {}"
    }
  }

  gen_log:log T "LEAVE"
  #puts "Leaving svn_jit_dircmd\n"
}

# called from module browser - list branches & tags
proc parse_svnmodules {tf svnroot} {
  global cvscfg
  global modval

  gen_log:log T "ENTER ($tf $svnroot)"

  if {[catch "image type fileview"]} {
    workdir_images
  }

  set cvscfg(svnroot) $svnroot
  set command "svn list -v $svnroot"
  #puts "$command"
  set cmd(svnlist) [exec::new "$command"]
  if {[info exists cmd(svnlist)]} {
    set contents [$cmd(svnlist)\::output]
  }
  set dirs {}
  set fils {}

  foreach logline [split $contents "\n"] {
    if {$logline == "" } continue
    gen_log:log D "$logline"
    if [string match {*/} $logline] {
      set item [lrange $logline 5 end]
      lappend dirs [string trimright $item "/"]
    } else {
      set item [lrange $logline 6 end]
      lappend fils $item
      set info($item) [lrange $logline 0 5]
    }
  }

  foreach f $fils {
    catch "ModTree:newitem $tf \"/$f\" \"$f\" \"$info($f)\" -image Fileview"
  }
  foreach d $dirs {
    svn_jit_dircmd $tf $d
  }

  gen_log:log T "LEAVE"
}

proc svn_cat {rev file} {
  gen_log:log T "ENTER ($rev $file)"

  set cat_cmd [viewer::new "SVN cat $rev $file"]
  set command "svn -r $rev cat $file"
  $cat_cmd\::do "$command" 0

  gen_log:log T "LEAVE"
}
 
# called from workdir Reports menu
proc svn_log {args} {
  global cvscfg
  gen_log:log T "ENTER ($args)"

  set filelist [join $args]
  set command "svn log "
  if {$cvscfg(ldetail) == "latest"} {
    append command "-r COMMITTED "
  }
  if {$cvscfg(ldetail) == "summary"} {
    append command "-q "
  }
  append command $filelist

  set logcmd [viewer::new "SVN Log ($cvscfg(ldetail))"]
  $logcmd\::do "$command"
  busy_done .workdir.main
  gen_log:log T "LEAVE"
}

proc svn_merge_conflict {args} {
  global cvscfg

  gen_log:log T "ENTER ($args)"

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select some files to merge first!"
    return
  }

  foreach file $filelist {
    gen_log:log F "OPEN $file"
    set f [open $file]
    set match 0
    while { [eof $f] == 0 } {
      gets $f line
      if { [string match "<<<<<<< *" $line] } {
        set match 1
        break
      }
    }
    gen_log:log F "CLOSE $file"
    close $f
   
    if { $match != 1 } { 
      cvsfail "This file does not appear to have a conflict." .workdir
      return
    }
    # Invoke tkdiff with the proper option for a conflict file
    # and have it write to the original file
    set command "$cvscfg(tkdiff) -conflict -o \"$file\" \"$file\""
    gen_log:log C "$command"
    set ret [catch {eval "exec $command"} view_this]
    if {$ret == 0} {
      set mess "Mark $file resolved?"
      if {[cvsconfirm $mess .workdir] != "ok"} {
        continue
      }
      set command "svn resolved \"$file\""
      exec::new $command
    } else {
      cvsfail "$view_this" .workdir
    }
  }
  
  if {$cvscfg(auto_status)} {
    setup_dir
  }
  gen_log:log T "LEAVE"
}

proc svn_revert {args} {
  global cvscfg

  gen_log:log T "ENTER ($args)"
  set filelist [join $args]
  if {$filelist == ""} {
    set filelist "-R ."
  }
  gen_log:log D "Reverting $filelist"
  set cmd [exec::new "svn revert $filelist"]

  if {$cvscfg(auto_status)} {
    $cmd\::wait
    setup_dir
  }

  gen_log:log T "LEAVE"
}

proc svn_tag {tagname force branch update args} {
#
# This tags a file or directory.
#
  global cvscfg
  global cvsglb

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

  if {$tagname == ""} {
    cvsfail "You must enter a tag name!" .workdir
    return 1
  }
  set filelist [join $args]

  set v [viewer::new "SVN Tag (Copy)"]

  # Can't use file join or it will mess up the URL
  if {$branch == "yes"} {
    set to_path "$cvscfg(svnroot)/branches/$tagname"
    set comment "Branched_using_TkSVN"
  } else {
    set to_path "$cvscfg(svnroot)/tags/$tagname"
    set comment "Tagged_using_TkSVN"
  }
  set ret [catch "eval exec svn list $to_path" err]
  if {$ret} {
    set command "svn mkdir -m\"$comment\" $to_path"
    $v\::do "$command"
    $v\::wait
  }

  # We may need to construct a path to copy the file to
  set cum_path ""
  set pathelements [file split $cvsglb(relpath)]
  set depth [llength $pathelements]
  if {$filelist == ""} {
    incr depth -1
  }
  for {set i 0} {$i < $depth} {incr i} {
    set cum_path [file join $cum_path [lindex $pathelements $i]]
    gen_log:log D "  $i $cum_path"
    set ret [catch "eval exec svn list $to_path/$cum_path" err]
    if {$ret} {
      set command "svn mkdir -m\"$comment\" $to_path/$cum_path"
      $v\::do "$command"
      $v\::wait
    }
  }

  if {$cvsglb(relpath) == "" && $args == "{}" } {
    set ret [catch "eval exec svn ls" view_this]
    if {$ret} {
      cvsfail "$view_this" .workdir
    } else {
      set flist [split $view_this "\n"]
      foreach f $flist {
        $v\::do "svn copy \"$f\" \"$to_path/$cum_path\" -m\"$comment\""
      }
      $v\::wait
    }
  } else {
    set command "svn copy $filelist -m\"$comment\" $to_path/$cum_path"
    $v\::do "$command"
    $v\::wait
  }

  if {$update == "yes"} {
    # update so we're on the branch
    set command "svn switch $to_path"
    $v\::do "$command" 0 status_colortags
    $v\::wait
  }

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

proc svn_rcopy {from_path to_path} {
#
# makes a tag or branch.  Called from the module browser
#
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($from_path $to_path)"

  set v [viewer::new "SVN Copy"]
  set command "svn copy [safe_url $from_path]"
  # Can't use file join or it will mess up the URL
  set comment "Copied_using_TkSVN"
  append command " [safe_url $to_path] -m\"$comment\""
  $v\::do "$command"
  $v\::wait

  modbrowse_run svn
  gen_log:log T "LEAVE"
}

proc svn_merge {fromrev sincerev frombranch mtag ftag url} {
#
# This does a join (merge) of a chosen revision of localfile to the
# current revision.
#
  global cvscfg
  global cvsglb

  gen_log:log T "ENTER ($fromrev $sincerev $frombranch $mtag $ftag $url)"

  set v [viewer::new "SVN Merge"]

  if {$cvscfg(auto_tag)} {
    set tagpath $cvscfg(svnroot)/tags/$mtag
    set comment "Tagged_using_TkSVN"
    set ret [catch "eval exec svn list $tagpath" err]
    if {$ret} {
      set command "svn mkdir -m\"$comment\" $tagpath"
      $v\::do "$command"
      $v\::wait
    }
    # We may need to construct a path to copy the file to
    set cum_path ""
    set pathelements [file split $cvsglb(relpath)]
    set depth [llength $pathelements]
    incr depth -1
    for {set i 0} {$i < $depth} {incr i} {
      set cum_path [file join $cum_path [lindex $pathelements $i]]
      gen_log:log D "  $i $cum_path"
      set ret [catch "eval exec svn list $tagpath/$cum_path" err]
      if {$ret} {
        set command "svn mkdir -m\"$comment\" $tagpath/$cum_path"
        $v\::do "$command"
        $v\::wait
      }
    }

    set comment "Copied_using_TkSVN"
    if {$cvsglb(relpath) == "" && [string range $url end-1 end] == "/."} {
      set ret [catch "eval exec svn ls" view_this]
      if {$ret} {
        cvsfail "$view_this" .
      } else {
        set flist [split $view_this "\n"]
        set trimurl [string range $url 0 end-2]
        foreach f $flist {
          $v\::do "svn copy \"$trimurl/$f\" \"$tagpath/$cum_path\" -m\"$comment\""
        }
        $v\::wait
      }
    } else {
      $v\::do "svn copy \"$url\" $tagpath/$cum_path -m\"$comment\""
      $v\::wait
    }

    toplevel .reminder
    message .reminder.m1 -aspect 600 -text \
      "When you are finished checking in your merges, \
      you should apply the tag"
    entry .reminder.ent -width 32 -relief groove \
       -font $cvscfg(guifont) -readonlybackground $cvsglb(readonlybg)
    .reminder.ent insert end $ftag 
    .reminder.ent configure -state readonly
    message .reminder.m2 -aspect 600 -text \
      "using the \"Tag the selected files\" button"
    frame .reminder.bottom -relief raised -bd 2
    button .reminder.bottom.close -text "Dismiss" \
      -command {destroy .reminder}
    pack .reminder.bottom -side bottom -fill x
    pack .reminder.bottom.close -side bottom -expand yes
    pack .reminder.m1 -side top
    pack .reminder.ent -side top -padx 2
    pack .reminder.m2 -side top
  }

  set fromrev [string trimleft $fromrev {r}]
  set sincerev [string trimleft $sincerev {r}]
  set command "svn merge -r$sincerev\:$fromrev $url"
    
  $v\::do "$command" 0 status_colortags
  $v\::wait

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

# SVN Checkout or Export.  Called from Repository Browser
proc svn_checkout {dir url path rev target cmd} {
  gen_log:log T "ENTER ($dir $url $path $rev $target $cmd)"

  foreach {incvs insvn inrcs} [cvsroot_check $dir] { break }
  if {$insvn} { 
    set mess "This is already a SVN controlled directory.  Are you\
              sure that you want to export into this directory?"
    if {[cvsconfirm $mess .modbrowse] != "ok"} {
      return
    }
  }

  set command "svn $cmd"
  if {$rev != {} } {
    # Let them get away with saying r3 instead of 3
    set rev [string trimleft $rev {r}] 
    append command " -r$rev"
  }
  set path [safe_url $path]
  append command " $url/$path"
  if {$target != {} } {
    append command " $target"
  }
  gen_log:log C "$command"

  set v [viewer::new "SVN $cmd"]
  $v\::do "$command"
  $v\::wait
  gen_log:log T "LEAVE"
}

# SVN cat or ls.  Called from module browser
proc svn_filecat {root path title} {
  gen_log:log T "ENTER ($root $path $title)"

  set url [safe_url $root/$path]
  # Should do cat if it's a file and ls if it's a path
  if {[string match {*/} $title]} {
    set command "svn ls \"$url\""
    set wintitle "SVN ls"
  } else {
    set command "svn cat \"$url\""
    set wintitle "SVN cat"