cvs.tcl

TKCVS Source Code For CVS。

    }
    if {[string match "total revisions:*" $logline]} {
      set nrevs($filename) [lindex [split $logline] end]
      continue
    }
    if { [regexp {^\t[-\w]+: .*\.0\.\d+$} $logline] } {
      incr nbranches($filename)
    }
  }
  set bushiestfile ""
  set mostrevisedfile ""
  set nbrmax 0
  foreach br [array names nbranches] {
    if {$nbranches($br) > $nbrmax} {
      set bushiestfile $br
      set nbrmax $nbranches($br)
    }
  }
  set nrevmax 0
  foreach br [array names nrevs] {
    if {$nrevs($br) > $nrevmax} {
      set mostrevisedfile $br
      set nrevmax $nrevs($br)
    }
  }
  gen_log:log F "Bushiest file \"$bushiestfile\" has $nbrmax branches"
  gen_log:log F "Most Revised file \"$mostrevisedfile\" has $nrevmax revisions"

  # Sometimes we don't find a file with any branches at all, so bushiest
  # is empty.  Fall back to mostrevised.  All files have at least one rev.
  if {[string length $bushiestfile] > 0} {
    set filename $bushiestfile
  } else {
    set filename $mostrevisedfile
  }

  ::cvs_branchlog::new "CVS,dir" "$filename"

  gen_log:log T "LEAVE"
}

# Sends files to the CVS branch browser one at a time.  Called from
# workdir browser
proc cvs_branches {files} {
  global cvs
  global cvscfg

  gen_log:log T "ENTER ($files)"

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

  foreach file $files {
    ::cvs_branchlog::new "CVS,loc" "$file"
  }

  gen_log:log T "LEAVE"
}

namespace eval ::cvs_branchlog {
  variable instance 0

  proc new {how filename} {
    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 how [uplevel {concat $how}]
      variable command
      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
      variable cwd

      gen_log:log T "ENTER [namespace current]"
      set sys_loc [split $how {,}]
      set sys [lindex $sys_loc 0]
      set loc [lindex $sys_loc 1]

      switch -- $sys {
        CVS {
          set command "cvs log \"$filename\""
          if {$loc == "dir"} {
            set newlc [mergecanvas::new $filename $how [namespace current]]
            # ln is the namespace, lc is the canvas
            set ln [lindex $newlc 0]
            set lc [lindex $newlc 1]
            set show_tags 0
          } else {
            set newlc [logcanvas::new $filename $how [namespace current]]
            set ln [lindex $newlc 0]
            set lc [lindex $newlc 1]
            set show_tags [set $ln\::opt(show_tags)]
          }
        }
        RCS {
          set command "rlog $filename"
          set newlc [logcanvas::new $filename "RCS,loc" [namespace current]]
          set ln [lindex $newlc 0]
          set lc [lindex $newlc 1]
          set show_tags [set $ln\::opt(show_tags)]
        }
      }

      proc reloadLog { } {
        variable command
        variable cmd_log
        variable lc
        variable revwho
        variable revdate
        variable revtime
        variable revlines
        variable revstate
        variable revcomment
        variable revtags
        variable revbtags
        variable revbranches
        variable branchrevs
        variable logstate

        gen_log:log T "ENTER"
        catch { $lc.canvas delete all }
        catch { unset revwho }
        catch { unset revdate }
        catch { unset revtime }
        catch { unset revlines }
        catch { unset revstate }
        catch { unset revcomment }
        catch { unset revtags }
        catch { unset revbtags }
        catch { unset revbranches }
        catch { unset branchrevs }
        set cwd [pwd]

        busy_start $lc
        set logstate {R}

        set cmd_log [::exec::new $command {} 0 [namespace current]::parse_cvslog]
        # wait for it to finish so our arrays are all populated
        $cmd_log\::wait

        [namespace current]::cvs_sort_it_all_out
        gen_log:log T "LEAVE"
        return
      }

      proc parse_cvslog { exec logline } {
        #
        # Splits the rcs file up and parses it using a simple state machine.
        #
        global module_dir
        global inrcs
        global cvsglb
        variable filename
        variable lc
        variable ln
        variable revwho
        variable revdate
        variable revtime
        variable revlines
        variable revstate
        variable revcomment
        variable revtags
        variable revbtags
        variable revbranches
        variable branchrevs
        variable logstate
        variable revkind
        variable rnum
        variable rootbranch
        variable revbranch
        #gen_log:log T "ENTER ($exec $logline)"

        #gen_log:log D "$logline"
        if {$logline != {}} {
          switch -exact -- $logstate {
            {R} {
              # Look for the first text line which should give the file name.
              if {[string match {RCS file: *} $logline]} {
                # I think the whole path to the "RCS file" from the log isn't
                # really what we want here.  More like module_dir, so we know
                # what to feed to cvs rdiff and rannotate.
                set fname [string range $logline 10 end]
                set fname [file tail $fname]
                if {[string range $fname end-1 end] == {,v}} {
                  set fname [string range $fname 0 end-2]
                }
                set fname [file join $module_dir $fname]
                if {$inrcs && [file isdir RCS]} {
                   set fname [file join RCS $fname]
                }
                $ln\::ConfigureButtons $fname
              } elseif {[string match {Working file: *} $logline]} {
                # If we care about a working copy we need to look
                # at the name of the working file here. It may be
                # different from what we were given if we were invoked
                # on a directory.
                #if {$localfile != "no file"} {
                  set localfile [string range $logline 14 end]
                #}
              } elseif {$logline == "symbolic names:"} {
                set logstate {T}
              }
            }
            {T} {
              # Any line with a tab leader is a tag
              if { [string index $logline 0] == "\t" } {
                set parts [split $logline {:}]
                set tagstring [string trim [lindex $parts 0]]
                set rnum [string trim [lindex $parts 1]]
  
                set parts [split $rnum {.}]
                if {[expr {[llength $parts] & 1}] == 1} {
                  set parts [linsert $parts end-1 {0}]
                  set rnum [join $parts {.}]
                }
                if {[lindex $parts end-1] == 0} {
                  # Branch tag
                  set rnum [join [lreplace $parts end-1 end-1] {.}]
                  set revkind($rnum) "branch"
                  set revbranch($tagstring) $rnum
                  set rbranch [join [lrange $parts 0 end-2] {.}]
                  set rootbranch($tagstring) $rbranch
                  lappend revbtags($rnum) $tagstring
                  lappend revbranches($rbranch) $rnum
                } else {
                  # Ordinary symbolic tag
                  lappend revtags($rnum) $tagstring
                  # Is it possible that this tag is the only surviving
                  # record that this revision ever existed?
                  if {[llength $parts] == 2} {
                    # A trunk revision but not necessarily 1.x because CVS allows
                    # the first part of the revision number to be changed. We have
                    # to assume that people always increase it if they change it
                    # at all.
                    lappend branchrevs(trunk) $rnum
                  } else {
                    set rbranch [join [lrange $parts 0 end-1] {.}]
                    lappend branchrevs($rbranch) $rnum
                  }
                  # Branches for this revision may have already been created
                  # during tag parsing
                  foreach "revwho($rnum) revdate($rnum) revtime($rnum)
                    revlines($rnum) revstate($rnum) revcomment($rnum)" \
                    {{} {} {} {} {dead} {}} \
                    { break }
                }
              } else {
                if {$logline == "description:"} {
                  set logstate {S}
                } elseif {$logline == "----------------------------"} {
                  # Oops, missed something.
                  set logstate {V}
                }
              }
            }
            {S} {
              # Look for the line that starts a revision message.
              if {$logline == "----------------------------"} {
                set logstate {V}
              }
            }
            {V} {
              # Look for a revision number line
              set rnum [lindex [split $logline] 1]
              set parts [split $rnum {.}]
              set revkind($rnum) "revision"
              if {[llength $parts] == 2} {
                # A trunk revision but not necessarily 1.x because CVS allows
                # the first part of the revision number to be changed. We have
                # to assume that people always increase it if they change it
                # at all.
                lappend branchrevs(trunk) $rnum
              } else {
                lappend branchrevs([join [lrange $parts 0 end-1] {.}]) $rnum
              }
              # Branches for this revision may have already been created
              # during tag parsing
              foreach "revwho($rnum) revdate($rnum) revtime($rnum)
                revlines($rnum) revstate($rnum) revcomment($rnum)" \
                {{} {} {} {} {} {}} \
                { break }
              set logstate {D}
            }
            {D} {
              # Look for a date line.  This also has the name of the author.
              set parts [split $logline]
	      if {[lindex $parts 4] == "author:"} {
                foreach [list \
                    revwho($rnum) revdate($rnum) revtime($rnum) \
                    revlines($rnum) revstate($rnum) \
                  ] \
                  [list \
                    [string trimright [lindex $parts 5] {;}] \
                    [lindex $parts 1] \
                    [string trimright [lindex $parts 2] {;}] \
                    [lrange $parts 11 end] \
                    [string trimright [lindex $parts 8] {;}] \
                  ] \
                  { break }
	      } else {
                foreach [list \
                    revwho($rnum) revdate($rnum) revtime($rnum) \
                    revlines($rnum) revstate($rnum) \
                  ] \
                  [list \
                    [string trimright [lindex $parts 6] {;}] \
                    [lindex $parts 1] \
                    [string trimright [lindex $parts 2] {;}] \
                    [lrange $parts 11 end] \
                    [string trimright [lindex $parts 8] {;}] \
                  ] \
                  { break }
	      }
              set logstate {L}
            }
            {L} {
              # See if there are branches off this revision
              if {[string match "branches:*" $logline]} {
                foreach br [lrange $logline 1 end] {
                  set br [string trimright $br {;}]
                  lappend revbranches($rnum) $br
                }
              } elseif {$logline == {----------------------------}} {
                set logstate {V}
              } elseif {$logline ==\
  {=============================================================================}} {
                set logstate {X}
              } else {
                append revcomment($rnum) $logline "\n"
              }
            }
            {X} {
              # ignore any further lines
            }
          }
        }
  
        if {$logstate == {X}} {
          gen_log:log D "********* Done parsing *********"
        }
        return [list {} $logline]
      }

      proc cvs_sort_it_all_out {} {
        global cvscfg
        global module_dir
        #global current_tagname
        variable filename
        variable sys
        variable lc
        variable ln
        variable revwho
        variable revdate
        variable revtime
        variable revlines
        variable revstate
        variable revcomment
        variable revtags
        variable revbtags
        variable revbranches
        variable branchrevs
        variable logstate
        variable rnum
        variable rootbranch
        variable revbranch
        variable revkind
  
        gen_log:log T "ENTER"

        if {[llength [array names revkind]] < 1} {
          cvsfail "Log empty.  Check error status of cvs log comand"
          return
        }

        set revkind(1) "root"

        foreach r [lsort -command sortrevs [array names revkind]] {
          gen_log:log D "revkind($r) $revkind($r)"
        }
        # Sort the revision and branch lists and remove duplicates
        foreach r [array names branchrevs] {
          set branchrevs($r) \
            [lsort -unique -decreasing -command sortrevs $branchrevs($r)]
          #gen_log:log D "branchrevs($r) $branchrevs($r)"
        }

        # Create a fake revision to be the trunk branchtag
        set revbtags(1) "trunk"
        set branchrevs(1) $branchrevs(trunk)

        foreach r [array names revbranches] {
          set revbranches($r) \
            [lsort -unique -command sortrevs $revbranches($r)]
          #gen_log:log D "revbranches($r) $revbranches($r)"
        }
        # Find out where to put the working revision icon (if anywhere)
        # FIXME: we don't know that the log parsed was derived from the
        # file in this directory. Maybe we should check CVS/{Root,Repository}?
        # Maybe this check should be done elsewhere?
        if {$sys != "rcs" && $filename != "no file"} {
          gen_log:log F "Reading CVS/Entries"
          set basename [file tail $filename]
          if {![catch {open [file join \
                              [file dirname $filename] {CVS}\
                        {Entries}] \
                        {r}} entries]} \
          {
            foreach line [split [read $entries] "\n"] {
              # What does the entry for an added/deleted file look like?
              set parts [split $line {/}]
              if {[lindex $parts 1] == $basename} {
                set rnum [lindex $parts 2]
                if {[string index $rnum 0] == {-}} {
                  # File has been locally removed and cvs removed but not
                  # committed.
                  set revstate(current) {dead}
                  set rnum [string range $rnum 1 end]
                } else {
                  set revstate(current) {Exp}
                }
  
                set root [join [lrange [split $rnum {.}] 0 end-1] {.}]
                gen_log:log D "root $root"
                set tag [string range [lindex $parts 5] 1 end]
                if {$rnum == {0}} {
                  # A locally added file has a revision of 0. Presumably
                  # there is no log and no revisions to show.
                  # FIXME: what if this is a resurrection?
                  lappend branchrevs(trunk) {current}
                  #set revbranches(current) {}
                } elseif {[info exists rootbranch($tag)] && \
                    $rootbranch($tag) == $rnum} {
                  # The sticky tag specifies a branch and the branch's
                  # root is the same as the source revision. Place the
                  # you-are-here box at the start of the branch.
                  lappend branchrevs($revbranch($tag)) {current}
                  #set revbranches(current) {}
                } else {
                  if {[catch {info exists $branc