svn.tcl

TKCVS Source Code For CVS。

  }

  set v [viewer::new "$wintitle $url"]
  $v\::do "$command"
}

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

  set url [safe_url $root/$path]
  set command "svn log \"$url\""
  set wintitle "SVN Log"

  set v [viewer::new "$wintitle $url"]
  $v\::do "$command"
}

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

  gen_log:log T "ENTER ($revision $filename $kind)"
  set cmd "cat"
  if {$kind == "directory"} {
     set cmd "ls"
  }
  if {$revision == {}} {
    set command "svn $cmd \"$filename\""
    set v [viewer::new "$filename"]
    $v\::do "$command"
  } else {
    set command "svn $cmd -$revision \"$filename\""
    set v [viewer::new "$filename Revision $revision"]
    $v\::do "$command"
  }
  gen_log:log T "LEAVE"
}

# Sends directory "." to the directory-merge tool
proc svn_directory_merge {} {
  global cvscfg
  global cvsglb
  
  gen_log:log T "ENTER"

  gen_log:log D "Relative Path: $cvsglb(relpath)"
  ::svn_branchlog::new $cvsglb(relpath) . 1

  gen_log:log T "LEAVE"
}

# Sends files to the SVN branch browser one at a time
proc svn_branches {files} {
  global cvscfg
  global cvsglb
  
  gen_log:log T "ENTER ($files)"
  set filelist [join $files]

  if {$files == {}} {
    cvsfail "Please select one or more files!" .workdir
    return
  }

  gen_log:log D "Relative Path: $cvsglb(relpath)"

  foreach file $files {
    ::svn_branchlog::new $cvsglb(relpath) $file
  }

  gen_log:log T "LEAVE"
}

proc safe_url { url } {
  regsub -all {%} $url {%25} url
  regsub -all {&} $url {%26} url
  regsub -all { } $url {%20} url
  # These don't seem to be necessary
  #regsub -all {\+} $url {%2B} url
  #regsub -all {\-} $url {%2D} url
  return $url
}

namespace eval ::svn_branchlog {
  variable instance 0

  proc new {relpath filename {directory_merge {0}} } {
    variable instance
    set my_idx $instance
    incr instance

    namespace eval $my_idx {
      set my_idx [uplevel {concat $my_idx}]
      set filename [uplevel {concat $filename}]
      set relpath [uplevel {concat $relpath}]
      set directory_merge [uplevel {concat $directory_merge}]
      variable cmd_log
      variable lc
      variable revwho
      variable revdate
      variable revtime
      variable revlines
      variable revstate
      variable revcomment
      variable tags
      variable revbranches
      variable branchrevs
      variable logstate

      gen_log:log T "ENTER [namespace current]"
      if {$directory_merge} {
        set newlc [logcanvas::new . "SVN,loc" [namespace current]]
        set ln [lindex $newlc 0]
        set lc [lindex $newlc 1]
        set show_tags 0
      } else {
        set newlc [logcanvas::new $filename "SVN,loc" [namespace current]]
        set ln [lindex $newlc 0]
        set lc [lindex $newlc 1]
        set show_tags [set $ln\::opt(show_tags)]
      }

      proc reloadLog { } {
        global cvscfg
        global cvsglb
        variable filename
        variable cmd_log
        variable lc
        variable ln
        variable revwho
        variable revdate
        variable revtime
        variable revcomment
        variable revkind
        variable revpath
        variable revname
        variable revtags
        variable revbtags
        variable branchrevs
        variable allrevs
        variable revbranches
        variable logstate
        variable relpath
        variable filename
        variable show_tags

        gen_log:log T "ENTER"
        catch { $lc.canvas delete all }
        catch { unset revwho }
        catch { unset revdate }
        catch { unset revtime }
        catch { unset revcomment }
        catch { unset revtags }
        catch { unset revbtags }
        catch { unset branchrevs }
        catch { unset revbranches }
        catch { unset revkind }
        catch { unset revpath }
        catch { unset revname }

        # Can't use file join or it will mess up the URL
        set safe_filename [safe_url $filename]
        set path "$cvscfg(url)/$safe_filename"
        $ln\::ConfigureButtons $path

        # Find out where to put the working revision icon (if anywhere)
        set command "svn log -q --stop-on-copy \"$filename\""
        set cmd [exec::new $command]
        set log_output [$cmd\::output]
        set loglines [split $log_output "\n"]
        set svnstat [lindex $loglines 1]
        set revnum_current [lindex $svnstat 0]
        gen_log:log D "revnum_current $revnum_current"

        busy_start $lc
        if { $relpath == {} } {
          set path "$cvscfg(svnroot)/trunk/$safe_filename"
        } else {
          set path "$cvscfg(svnroot)/trunk/$relpath/$safe_filename"
        }
        # The trunk
        set branchrevs(trunk) {}
        # if the file was added on a branch, this will error out.
        # Come to think of it, there's nothing especially privileged
        #  about the trunk
        set command "svn log $path"
        gen_log:log C "$command"
        set ret [catch {eval exec $command} log_output]
        update idletasks
        if {$ret == 0} {
          set trunk_lines [split $log_output "\n"]
          set rr [parse_svnlog $trunk_lines trunk]
          # See if the current revision is on the trunk
          set curr 0
          set brevs $branchrevs(trunk)
          set tip [lindex $brevs 0]
          set revpath($tip) $path
          set revkind($tip) "revision"
          set brevs [lreplace $brevs 0 0]
          if {$tip == $revnum_current} {
            # If current is at end of trunk do this.
            set branchrevs(trunk) [linsert $branchrevs(trunk) 0 {current}]
            set curr 1
          }
          foreach r $brevs {
            if {$r == $revnum_current} {
              # We need to make a new artificial branch off of $r
              lappend revbranches($r) {current}
            }
            gen_log:log D " $r $revdate($r) ($revcomment($r))"
            set revkind($r) "revision"
            set revpath($r) $path
          }
          #set branchrevs($rr) [lrange $branchrevs(trunk) 0 end-1]
          set branchrevs($rr) $branchrevs(trunk)
          set revkind($rr) "root"
          set revname($rr) "trunk"
          set revbtags($rr) "trunk"
          set revpath($rr) $path
        }

        # Branches
        set command "svn list $cvscfg(svnroot)/branches"
        gen_log:log C "$command"
        set ret [catch {eval "exec $command"} branches]
        if {$ret != 0} {
          gen_log:log E "$branches"
          set branches ""
        }
        foreach branch $branches {
          gen_log:log D "$branch"
          # There can be files such as "README" here that aren't branches
          if {![string match {*/} $branch]} {continue}
          set branch [string trimright $branch "/"]
          # Can't use file join or it will mess up the URL
          gen_log:log D "BRANCHES: RELPATH $relpath"
          if { $relpath == {} } {
            set path "$cvscfg(svnroot)/branches/$branch/$safe_filename"
          } else {
            set path "$cvscfg(svnroot)/branches/$branch/$relpath/$safe_filename"
          }
          set command "svn log --stop-on-copy $path"
          gen_log:log C "$command"
          set ret [catch {eval exec $command} log_output]
          update idletasks
          if {$ret != 0} {
            # This can happen a lot -let's not let it stop us
            gen_log:log E "$log_output"
            continue
          }
          set loglines [split $log_output "\n"]
          set rb [parse_svnlog $loglines $branch]
          # See if the current revision is on this branch
          set curr 0
          set brevs $branchrevs($branch)
          set tip [lindex $brevs 0]
          set revpath($tip) $path
          set revkind($tip) "revision"
          set brevs [lreplace $brevs 0 0]
          if {$tip == $revnum_current} {
            # If current is at end of the branch do this.
            set branchrevs($branch) [linsert $branchrevs($branch) 0 {current}]
            set curr 1
          }
          foreach r $brevs {
            if {$r == $revnum_current} {
              # We need to make a new artificial branch off of $r
              lappend revbranches($r) {current}
            }
            gen_log:log D "  $r $revdate($r) ($revcomment($r))"
            set revkind($r) "revision"
            set revpath($r) $path
          }
          #set branchrevs($rb) [lrange $branchrevs($branch) 0 end-1]
          set branchrevs($rb) $branchrevs($branch)
          set revkind($rb) "branch"
          set revname($rb) $branch
          lappend revbtags($rb) $branch
          set revpath($rb) $path

          set command "svn log -q $path"
          gen_log:log C "$command"
          set ret [catch {eval exec $command} log_output]
          update idletasks
          if {$ret != 0} {
            cvsfail "$log_output"
            return
          }
          set loglines [split $log_output "\n"]
          parse_q $loglines $branch

          # If current is HEAD of branch, move the branchpoint
          # back one, before You are Here
          set idx [llength $branchrevs($branch)]
          if {$curr} {
            incr idx -1
          }
          set bp [lindex $allrevs($branch) $idx]
          lappend revbranches($bp) $rb
          update idletasks
        }
        # Tags
        if {$show_tags} {
          set command "svn list $cvscfg(svnroot)/tags"
          gen_log:log C "$command"
          set ret [catch {eval "exec $command"} tags]
          if {$ret != 0} {
              gen_log:log E "$tags"
              set tags ""
          }
          set n_tags [llength $tags]
          if {$n_tags > $cvscfg(toomany_tags)} {
            # If confirm is on, give them a chance to say yes or no to tags
            if {$cvscfg(confirm_prompt)} {
              set mess    "There are $n_tags tags.  It could take a long time "
              append mess "to process them. If you're willing to wait, "
              append mess " press OK and get a cup of coffee.\n"
              append mess "Otherwise, press Cancel and I will draw the "
              append mess "diagram now without showing tags.  "
              append mess "You may wish to turn off\n"
              append mess "View -> Revision Layout -> Show Tags\n"
              append mess " and\n"
              append mess "View -> Save Options"
              if {[cvsconfirm $mess $lc] != "ok"} {
                set tags ""
              }
            } else {
            # Otherwise, just don't process tags
              set tags ""
              gen_log:log E "Skipping tags: $n_tags > cvscfg(toomany_tags) ($cvscfg(toomany_tags)"
            }
          }
          foreach tag $tags {
            gen_log:log D "$tag"
            # There can be files such as "README" here that aren't tags
            if {![string match {*/} $tag]} {continue}
            set tag [string trimright $tag "/"]
            # Can't use file join or it will mess up the URL
            gen_log:log D "TAGS: RELPATH $relpath"
            if { $relpath == {} } {
              set path "$cvscfg(svnroot)/tags/$tag/$safe_filename"
            } else {
              set path "$cvscfg(svnroot)/tags/$tag/$relpath/$safe_filename"
            }
            set command "svn log --stop-on-copy $path"
            gen_log:log C "$command"
            set ret [catch {eval exec $command} log_output]
            update idletasks
            if {$ret != 0} {
              # This can happen a lot -let's not let it stop us
              gen_log:log E "$log_output"
              continue
            }
            set loglines [split $log_output "\n"]
            set rb [parse_svnlog $loglines $tag]
            foreach r $branchrevs($tag) {
              gen_log:log D "  $r $revdate($r) ($revcomment($r))"
              set revkind($r) "revision"
              set revpath($r) $path
            }
            set revkind($rb) "tag"
            set revname($rb) "$tag"
            set revpath($rb) $path
  
            set command "svn log -q $path"
            gen_log:log C "$command"
            set ret [catch {eval exec $command} log_output]
            update idletasks
            if {$ret != 0} {
              cvsfail "$log_output"
              return
            }
            set loglines [split $log_output "\n"]
            parse_q $loglines $tag
            set bp [lindex $allrevs($tag) [llength $branchrevs($tag)]]
            lappend revtags($bp) $tag
            update idletasks
          }
        }

        set branchrevs(current) {}
        [namespace current]::svn_sort_it_all_out
        gen_log:log T "LEAVE"
        return
      }

      proc parse_svnlog {lines r} {
        variable revwho
        variable revdate
        variable revtime
        variable revcomment
        variable branchrevs

        set i 0
        set l [llength $lines]
        while {$i < $l} {
          set line [lindex $lines $i]
          gen_log:log D "$i of $l:  $line"
          if [regexp {^--*$} $line] {
            # Next line is new revision
            incr i
            if {[expr {$l - $i}] <= 1} {break}
            set line [lindex $lines $i]
            set splitline [split $line "|"]
            set revnum [string trim [lindex $splitline 0]]
            lappend branchrevs($r) $revnum
            set revwho($revnum) [string trim [lindex $splitline 1]]
            set date_and_time [string trim [lindex $splitline 2]]
            set revdate($revnum) [lindex $date_and_time 0]
            set revtime($revnum) [lindex $date_and_time 1]
            set notelen [lindex [string trim [lindex $splitline 3]] 0]
            gen_log:log D "revnum $revnum"
            gen_log:log D "revwho($revnum) $revwho($revnum)"
            gen_log:log D "revdate($revnum) $revdate($revnum)"
            gen_log:log D "revtime($revnum) $revtime($revnum)"
            gen_log:log D "notelen $notelen"
            
            incr i 2
            set revcomment($revnum) ""
            set c 0
            while {$c < $notelen} {
              append revcomment($revnum) "[lindex $lines [expr {$c + $i}]]\n"
              incr c
            }
            set revcomment($revnum) [string trimright $revcomment($revnum)]
            gen_log:log D "revcomment($revnum) $revcomment($revnum)"
          }
          incr i
        }
        return $revnum
      }

      proc parse_q {lines r} {
        variable allrevs

        set allrevs($r) ""
        foreach line $lines {
          if [regexp {^r} $line] {
            gen_log:log D "$line"
            set splitline [split $line "|"]
            set revnum [string trim [lindex $splitline 0]]
            lappend allrevs($r) $revnum
          }
        }
      }

      proc svn_sort_it_all_out {} {
        global cvscfg
        global current_tagname
        variable filename
        variable lc
        variable ln
        variable revwho
        variable revdate
        variable revtime
        variable revcomment
        variable revkind
        variable revpath
        variable revname
        variable revtags
        variable revbtags
        variable branchrevs
        variable revbranches
        variable logstate
        variable revnum
        variable rootbranch
        variable revbranch
  
        gen_log:log T "ENTER"

        # Sort the revision and branch lists and remove duplicates
        foreach r [lsort -dictionary [array names revkind]] {
           gen_log:log D "revkind($r) $revkind($r)"
           #if {![info exists revbranches($r)]} {set revbranches($r) {} }
        }
        foreach r [lsort -dictionary [array names revpath]] {
           gen_log:log D "revpath($r) $revpath($r)"
           #if {![info exists revbranches($r)]} {set revbranches($r) {} }
        }
        gen_log:log D ""
        foreach a [lsort -dictionary [array names branchrevs]] {
           gen_log:log D "branchrevs($a) $branchrevs($a)"
        }
        gen_log:log D ""
           foreach a [lsort -dictionary [array names revbranches]] {
           gen_log:log D "revbranches($a) $revbranches($a)"
        }
        gen_log:log D ""
           foreach a [lsort -dictionary [array names revbtags]] {
           gen_log:log D "revbtags($a) $revbtags($a)"
        }
        gen_log:log D ""
           foreach a [lsort -dictionary [array names revtags]] {
           gen_log:log D "revtags($a) $revtags($a)"
        }
        # We only needed these to place the you-are-here box.
        catch {unset rootbranch revbranch}
        $ln\::DrawTree now
        gen_log:log T "LEAVE"
      }

      [namespace current]::reloadLog
      return [namespace current]
    }
  }
}