branch_diagram.tcl

TKCVS Source Code For CVS。

#
# Tcl Library for TkCVS
#

# This is a major rewrite over the original version. It uses a
# top down, recursive, branch-at-a-time, latest-revision-first
# algorithm to layout the graph sensibly.
# -- Mike Jagdis <[e-mail]>
#

namespace eval ::logcanvas {
  variable instance 0

  proc new {filename how scope} {
    #
    # Creates a new log canvas.
    #
    variable instance
    set my_idx $instance
    incr instance
    global current_tagname
    global module_dir
    variable sys
    variable loc

    if {[catch "image type Modules"]} {
      workdir_images
    }
    if {[catch "image type Workdir"]} {
      modbrowse_images
    }

    namespace eval $my_idx {
      set my_idx [uplevel {concat $my_idx}]
      set how [uplevel {concat $how}]
      set filename [uplevel {concat $filename}]
      set scope [uplevel {concat $scope}]
      #variable cmd_log
      # Global constants scaled by current scaling factor for this instance
      variable curr
      global cvscfg
      global cvsglb
      global tcl_platform
      # User options for info display for this instance
      variable opt
      variable revwho
      variable revdate
      variable revtime
      variable revstate
      variable revbranches
      variable branchrevs
      variable revcomment
      variable revtags
      variable revbtags
      variable revpath
      variable sel_tag
      set sel_tag(A) {}
      set sel_tag(B) {}
      variable sel_rev
      set sel_rev(A) {}
      set sel_rev(B) {}
      variable logcanvas ".logcanvas$my_idx"

      set sys_loc [split $how {,}]
      set sys [lindex $sys_loc 0]
      set loc [lindex $sys_loc 1]

      proc ClearSelection {AorB} {
        variable logcanvas
        variable sel_tag
        variable sel_rev
        #catch {$logcanvas.canvas itemconfigure Sel$AorB -outline black}
        catch {$logcanvas.canvas itemconfigure Sel$AorB -fill gray90}
        $logcanvas.canvas dtag Sel$AorB
        $logcanvas.up.rev${AorB}_rvers configure -text {}
        $logcanvas.up.log${AorB}_rlogfm.rcomment delete 1.0 end
        $logcanvas.up.rev${AorB}_rwho configure -text {}
        $logcanvas.up.rev${AorB}_rdate configure -text {}
        set sel_tag($AorB) {}
        set sel_rev($AorB) {}
        return
      }

      proc SetSelection {AorB tag rev} {
        global cvscfg
        variable logcanvas
        variable revdate
        variable revtime
        variable revwho
        variable revcomment
        variable sel_tag
        variable sel_rev

        ClearSelection $AorB
        set other [expr {$AorB == "A" ? {B} : {A}}]
        if {$rev == $sel_rev($other)} { ClearSelection $other }
        if {! [info exists revcomment($rev)]} {
           set revcomment($rev) "*** empty log message ***"
        }
        if {$tag != {}} {
          $logcanvas.up.rev${AorB}_rvers configure -text $tag
        } else {
          $logcanvas.up.rev${AorB}_rvers configure -text $rev
        }
        if {$rev != {} && [info exists revwho($rev)]} {
          $logcanvas.up.rev${AorB}_rwho configure -text $revwho($rev)
          $logcanvas.up.rev${AorB}_rdate configure -text\
              "$revdate($rev) $revtime($rev)"
          $logcanvas.up.log${AorB}_rlogfm.rcomment insert end $revcomment($rev)
        }
        $logcanvas.canvas addtag Sel$AorB withtag rect$rev
        $logcanvas.canvas itemconfigure SelA -fill $cvscfg(colourA)
        $logcanvas.canvas itemconfigure SelB -fill $cvscfg(colourB)
        set sel_tag($AorB) $tag
        set sel_rev($AorB) $rev
        return
      }

      proc RevSelect {AorB} {
        variable logcanvas
        set t [$logcanvas.canvas gettags current]
        SetSelection $AorB \
          [string range [lindex $t [lsearch -glob $t {T*}]] 1 end] \
          [string range [lindex $t [lsearch -glob $t {R*}]] 1 end]
        return
      }

      proc Unselect {AorB} {
        variable logcanvas
        set t [$logcanvas.canvas gettags current]
        if {$t != {} } {return}
        ClearSelection $AorB
      }

      proc ConfigureButtons {fname} {
        global cvsglb
        variable logcanvas
        variable sys
        variable loc

        switch -- $sys {
          "SVN" {
            set kind ""
            set info_cmd [exec::new "svn info \"[file tail $fname]\""]
            set info_lines [split [$info_cmd\::output] "\n"]
            foreach infoline $info_lines {
              if {[string match "Node Kind:*" $infoline]} {
                gen_log:log D "$infoline"
                set kind [lindex $infoline end]
              }
            }
            $logcanvas.up.bmodbrowse configure -command {modbrowse_run svn} \
              -image Modules_svn
            $logcanvas.up.lfname configure -text "SVN Path"
            $logcanvas.up.rfname delete 0 end
            $logcanvas.up.rfname insert end "$fname"
            $logcanvas.up.rfname configure -state readonly -bg $cvsglb(textbg)
            if {$kind == "directory"} {
              $logcanvas.diff configure -state disabled
              $logcanvas.annotate configure -state disabled
              $logcanvas.view configure \
                 -command [namespace code {
                    set rev [$logcanvas.up.revA_rvers cget -text] 
                    svn_fileview $rev $revpath($rev) directory
                 }]
            } else {
              $logcanvas.view configure \
                 -command [namespace code {
                    set rev [$logcanvas.up.revA_rvers cget -text] 
                    svn_fileview $rev $revpath($rev) file
                 }]
              $logcanvas.diff configure \
                -command [namespace code {
                   set revA [$logcanvas.up.revA_rvers cget -text]
                   set revB [$logcanvas.up.revB_rvers cget -text]
                   set A [string trimleft $revA {r}]
                   set B [string trimleft $revB {r}]
                   if {$revB == ""} {
                     comparediff_files "$revpath($revA)@$A" [file tail $revpath($revA)]
                   } else {
                     comparediff_files "$revpath($revA)@$A" "$revpath($revB)@$B"
                   }
                }]
              $logcanvas.annotate configure \
                 -command [namespace code {
                   set rev [$logcanvas.up.revA_rvers cget -text]
                   set R [string trimleft $rev {r}]
                   svn_annotate_r $R $revpath($rev)
                 }]
            }
            $logcanvas.delta configure \
              -command [namespace code {
                 variable sys
                 set fromrev [$logcanvas.up.revA_rvers cget -text]
                 set sincerev [$logcanvas.up.revB_rvers cget -text]
                 set fromtag ""
                 if {[info exists revbtags($sincerev)]} {
                   set fromtag [lindex $revbtags($sincerev) 0]
                 }
                 if {$fromtag == ""} {
                   foreach brev [array names revbtags] {
                     set b $revbtags($brev)
                     foreach r $branchrevs($b) {
                       if {$r == $fromrev} {
                         set fromtag $b
                       }
                     }
                   }
                 }
                 merge_dialog $sys \
                   $fromrev $sincerev $fromtag \
                   [list $revpath($sincerev)]
                 }]
          }
         "CVS" {
           $logcanvas.up.bmodbrowse configure -command {modbrowse_run cvs} \
              -image Modules_cvs
           $logcanvas.up.lfname configure -text "RCS file"
           $logcanvas.up.rfname delete 0 end
           $logcanvas.up.rfname insert end "$fname,v"
           $logcanvas.up.rfname configure -state readonly -bg $cvsglb(textbg)

           if {$loc == "rep"} {
             # Working on repository files, not checked out
             $logcanvas.view configure \
                -command [namespace code {
                  cvs_fileview_checkout [$logcanvas.up.revA_rvers cget -text] $filename
                }]
             $logcanvas.annotate configure \
                -command [namespace code {
                   cvs_annotate_r [$logcanvas.up.revA_rvers cget\
                   -text] $filename
                }]
             $logcanvas.diff configure \
                -command [namespace code {
                   comparediff_sandbox [$logcanvas.up.revA_rvers cget -text] \
                     [$logcanvas.up.revB_rvers cget -text] $logcanvas \
                     $filename
                }]
             $logcanvas.delta configure -state disabled
           } else {
             # We have a checked-out local file
             $logcanvas.view configure \
               -command [namespace code {
                  cvs_fileview_update [$logcanvas.up.revA_rvers cget -text] \
                  $filename
               }]
             $logcanvas.annotate configure \
               -command [namespace code {
                 cvs_annotate [$logcanvas.up.revA_rvers cget -text] \
                 $filename
               }]
             $logcanvas.delta configure \
               -command [namespace code {
                 variable sys
                 set fromrev [$logcanvas.up.revA_rvers cget -text]
                 set sincerev [$logcanvas.up.revB_rvers cget -text]
                 set fromtag ""
                 if {[info exists revbtags($sincerev)]} {
                   set fromtag [lindex $revbtags($sincerev) 0]
                 }
                 if {$fromtag == ""} {
                   foreach brev [array names branchrevs] {
                     set b $branchrevs($brev)
                     if {$b == $fromrev} {
                       set fromtag $revbtags($brev)
                     }
                   }
                 }
                 merge_dialog $sys \
                   $fromrev $sincerev $fromtag \
                   [list $filename]
                }]
            }
         }
         "RCS" {
           $logcanvas.up.rfname delete 0 end
           $logcanvas.up.rfname insert end "$fname"
           $logcanvas.up.rfname configure -state readonly -bg $cvsglb(textbg)
           $logcanvas.view configure -state disabled
           $logcanvas.annotate configure -state disabled
           $logcanvas.delta configure -state disabled
          }
        }
      }

      proc PopupTags { x y } {
      #
      # Pop up a transient window with a listbox of the tags for a specific\
      # revision
      #
        global cvscfg
        variable logcanvas
        variable revtags
        foreach tag [$logcanvas.canvas gettags current] {
          if {[string index $tag 0] == {R}} {
            set rev [string range $tag 1 end]
            break
          }
        }
        set mname "$logcanvas.[join [split $rev {.}] {_}]"
        if {[winfo exists $mname]} {
          # Don't let them hit the button twice
          wm deiconify $mname
          raise $mname
        } else {
          toplevel $mname
          wm title $mname "Tags: $rev"
          wm transient $mname $logcanvas.canvas
          set ntags [llength $revtags($rev)]
          set h [expr {400 / [font metrics $cvscfg(listboxfont)\
              -displayof $mname -linespace]}]
          if {$h > $ntags} {
            set h $ntags
          }
          listbox $mname.lbx -font $cvscfg(listboxfont) \
            -width 0 -height $h \
            -listvar [namespace current]::revtags($rev)
          # Always have a scroll bar because a reload of the log might find
          # more tags and the list might not fit in the window any longer.
          scrollbar $mname.scroll -command "$mname.lbx yview"
          $mname.lbx configure -yscroll "$mname.scroll set"
          pack $mname.scroll -side right -fill y
          pack $mname.lbx -ipadx 10 -ipady 10 -expand y -fill both