joincanvas.tcl

TKCVS Source Code For CVS。

            set py($ind) [expr {$py($ind) - $cvscanv(space)}]
            gen_log:log D "  just stacking it above the last one"
            set xlevel($rev) $px($ind)
          }
          set ylevel($rev) $py($ind)

          # For column 1, just draw a nondescript node
          if {$ind == 1} {
            #node $joincanvas $rev $px($ind) $py($ind)
            set py($ind) [expr {$py($ind) - ($nchildren($rev) - 1) * $cvscanv(space)}]
          } else {
            if {! [info exists tags($rev)]} {
              set tags($rev) ""
            }
            gen_log:log D "  tag:  $tags($rev)"
            rectangle $joincanvas $rev $px($ind) $py($ind)
            # Line linking it to parent
            if {$ind > 2} {
               set ly [expr {$ylevel($parent($rev)) + $cvscanv(midy)}]
            } else {
               set ly [expr {$py($ind) + $cvscanv(midy)}]
            }
            if {![info exists xlevel($parent($rev))]} {set xlevel($parent($rev)) $px([expr $ind-1])}
            $joincanvas.canvas create line \
              $xlevel($parent($rev)) [expr {$ly + 10}] \
              [expr {$xlevel($parent($rev)) + 10}] $ly \
              $px($ind) [expr {$py($ind) + $cvscanv(midy)}]
            set py($ind) [expr {$py($ind) - $nchildren($rev) * $cvscanv(space)}]
          }
        }

        set py(1) [expr {$cvscanv(boxy) - 4}]
        set maxyind 0
        foreach i [array names py] {
          if {$py($i) < $maxyind} {
            set maxyind $py($i)
          }
        }

        set tags($headrev) $cvscfg(mergetrunkname)
        gen_log:log D "HEAD  $headrev"
        gen_log:log D "tagtext \"$tags($headrev)\""
        # Make a box for top of trunk
        set ylevel(trunk) [expr {$maxyind - $cvscanv(boxy)}]
        set tagwidth [font measure {Helvetica -12 bold} \
           -displayof $joincanvas.canvas $cvscfg(mergetrunkname)]
        if {$tagwidth < $cvscanv(boxmin)} { set tagwidth $cvscanv(boxmin) }
        set boxid [$joincanvas.canvas create rectangle \
          [expr {$px(1) - $tagwidth / 2}] $ylevel(trunk) \
          [expr {$px(1) + 5 + $tagwidth / 2}] \
          [expr {$ylevel(trunk) - $cvscanv(boxy)}] \
          -width 3 \
          -fill gray90 \
          -tags b$headrev]
        $joincanvas.canvas lower $boxid
        $joincanvas.canvas create text \
           [expr {$px(1) + 2}] [expr {$ylevel(trunk) - 2}] \
           -text "$cvscfg(mergetrunkname)" \
           -anchor s -justify center -fill blue \
           -font {Helvetica -12 bold} \
           -tags b$headrev
        # Bottom then top
        $joincanvas.canvas create line \
           $px(1) [expr {$cvscanv(space) - 4}] \
           $px(1) $ylevel(trunk)

        # Bind button-press
        $joincanvas.canvas bind b$headrev <ButtonPress-1> \
           [namespace code "select_rectangle $headrev $cvscfg(mergetrunkname)"]
        # Clicking in a blank part of the canvas unselects boxes
        bind $joincanvas.canvas <ButtonPress-1> \
           [namespace code unselect_all]


        # You are Here
        if {$current_tagname == "trunk"} {
          you_are_here $headrev $tagwidth \
            [expr {$px(1) - $tagwidth / 2 }] \
            [expr {$ylevel(trunk) - $cvscanv(boxy)}]
        }

        # now calculate the bounding box using the canvas bbox function
        set bbox [$joincanvas.canvas bbox all]
        set boty [lindex $bbox 1]
        set topy [lindex $bbox 3]
        set bheight [expr {$topy - $boty}]

        set origheight [lindex [$joincanvas.canvas config -height] 4]

        set screenHeight [winfo vrootheight .]
        if {$bheight > $screenHeight} {
          set bheight $screenHeight
        }
        if {$bheight > $origheight} {
          $joincanvas.canvas config -height $bheight
        }

        $joincanvas.canvas config -scrollregion $bbox
        $joincanvas.canvas yview moveto 0

        set here [$joincanvas.up.rversTo get]
        if {$here == ""} {
          cvsfail "I can't find where I am.  Perhaps the working directory isn't at the head of a branch?" $joincanvas
        }
        gen_log:log T "LEAVE"
      }

      proc you_are_here {rev offset hx hy} {
        variable cvscanv
        variable joincanvas
        variable tags

        gen_log:log T "ENTER ($rev $offset $hx $hy)"
        gen_log:log D "tags($rev) $tags($rev)"
        $joincanvas.canvas create image \
          [expr {$hx + $offset + 16}] [expr {$hy + $cvscanv(boxy)}] \
          -image Man -anchor s \
          -tag you_are_here_icon
        $joincanvas.canvas create text \
          [expr {$hx + $offset + 26}] [expr {$hy + $cvscanv(boxy)}] \
          -text "You are\nhere" -anchor sw \
          -fill red3 \
          -font {Helvetica -10 bold} \
          -tag you_are_here_icon

        # Put the name in the "To" entry and disable it.  You can only
        # merge to where you are.
        $joincanvas.up.rversTo delete 0 end
        $joincanvas.up.rversTo insert end $tags($rev)
        $joincanvas.up.rversTo configure -state readonly
        $joincanvas.canvas bind b$rev <ButtonPress-1> {}
      }

      toplevel $joincanvas
      wm title $joincanvas "CVS Directory Merge"
      if {$tcl_platform(platform) != "windows"} {
        wm iconbitmap $joincanvas @$cvscfg(bitmapdir)/dirbranch.xbm
      }
      wm protocol $joincanvas WM_DELETE_WINDOW \
        [namespace code {$joincanvas.close invoke}]

      $joincanvas configure -menu $joincanvas.menubar
      menu $joincanvas.menubar

      $joincanvas.menubar add cascade -label "File" \
        -menu $joincanvas.menubar.file -underline 0
      menu $joincanvas.menubar.file -tearoff 0
      $joincanvas.menubar.file add command -label "Close" -underline 0 \
        -command [namespace code {$joincanvas.close invoke}]
      $joincanvas.menubar.file add command -label "Exit" -underline 1 \
        -command { exit_cleanup 1 }

      $joincanvas.menubar add cascade -label "Help" \
        -menu $joincanvas.menubar.help -underline 0
      menu $joincanvas.menubar.help -tearoff 0
      $joincanvas.menubar.help add command -label "Merge Tool" -underline 0 \
        -command directory_branch_viewer

      frame $joincanvas.up -relief groove -border 2
      pack $joincanvas.up -side top -fill x

      button $joincanvas.up.bworkdir -image Workdir -command { workdir_setup }
      button $joincanvas.up.bmodbrowse -image Modules_cvs -command { modbrowse_run cvs }

      label $joincanvas.up.lfname -text "Representative File" -anchor w
      entry $joincanvas.up.rfname -textvariable [namespace current]::repfile
      bind $joincanvas.up.rfname <Return> \
        [namespace code {join_getlog $repfile [namespace current]}]

      label $joincanvas.up.lversFrom -text "Merge From" -anchor w
      frame $joincanvas.up.eFrom -bg $cvscfg(colourA)
      entry $joincanvas.up.rversFrom

      label $joincanvas.up.lversSince -text "   Since" -anchor w
      frame $joincanvas.up.eSince -bg $cvscfg(colourB)
      ::picklist::clear alltags
      ::picklist::entry $joincanvas.up.rversSince "" alltags
      label $joincanvas.up.lversTo -text "Merge To" -anchor w
      entry $joincanvas.up.rversTo -relief groove \
        -readonlybackground $cvsglb(readonlybg)

      grid columnconf $joincanvas.up 1 -weight 1
      grid rowconf $joincanvas.up 3 -weight 1
      grid $joincanvas.up.lfname -column 0 -row 0 -sticky w
      grid $joincanvas.up.rfname -column 1 -row 0 -padx 3 -sticky ew
      grid $joincanvas.up.bworkdir -column 2 -row 0 -rowspan 2 \
        -sticky e -padx 2 -pady 1
      grid $joincanvas.up.lversFrom -column 0 -row 1 -sticky w
      grid $joincanvas.up.eFrom -column 1 -row 1 -sticky ew -padx 4
      grid $joincanvas.up.bmodbrowse -column 2 -row 2 -rowspan 2 \
        -sticky e -padx 2 -pady 1
      grid $joincanvas.up.lversSince -column 0 -row 2 -sticky w
      grid $joincanvas.up.eSince -column 1 -row 2 -sticky ew -padx 4
      grid $joincanvas.up.lversTo -column 0 -row 3 -sticky w
      grid $joincanvas.up.rversTo -column 1 -row 3 -padx 3 -sticky ew

      pack $joincanvas.up.rversFrom -in $joincanvas.up.eFrom \
        -padx 2 -pady 2 -fill x
      pack $joincanvas.up.rversSince -in $joincanvas.up.eSince \
        -padx 2 -pady 2 -fill x

      set textfont [$joincanvas.up.rfname cget -font]

      # Pack the bottom before the middle so it doesnt disappear if
      # the window is resized smaller
      frame $joincanvas.down -relief groove -border 2
      pack $joincanvas.down -side bottom -fill x

      set repfile $localfile

      # The canvas for the big picture
      canvas $joincanvas.canvas -relief sunken -border 2 \
        -yscrollcommand "$joincanvas.yscroll set" \
        -xscrollcommand "$joincanvas.xscroll set"
      scrollbar $joincanvas.xscroll -relief sunken -orient horizontal \
        -command "$joincanvas.canvas xview"
      scrollbar $joincanvas.yscroll -relief sunken \
        -command "$joincanvas.canvas yview"

      #
      # Create buttons
      #
      button $joincanvas.join -image Mergebranch \
          -command [namespace code {
                   set fromrev [$joincanvas.up.rversFrom get]
                   merge_dialog CVS \
                     $fromrev "" $fromrev .
                 }]
      button $joincanvas.delta -image Mergediff \
          -command [namespace code {
                 set fromrev [$joincanvas.up.rversFrom get]
                 set sincerev [$joincanvas.up.rversSince.e get]
                 merge_dialog CVS \
                   $fromrev $sincerev $fromrev .
                 }]

      button $joincanvas.down.blogfile -image Branches \
         -command "cvs_branches $repfile"
      frame $joincanvas.down.btnfm
      frame $joincanvas.down.closefm -relief groove -bd 2
      button $joincanvas.close -text "Close" \
        -command [namespace code "
                   destroy $joincanvas
                   namespace delete [namespace current]
                   exit_cleanup 0
                 "]

      pack $joincanvas.down.blogfile -side left \
        -ipadx 4 -ipady 4
      pack $joincanvas.down.btnfm -side left -fill y -expand 1
      pack $joincanvas.join \
           $joincanvas.delta \
        -in $joincanvas.down.btnfm -side left \
        -ipadx 4 -ipady 4
      pack $joincanvas.down.closefm -side right
      pack $joincanvas.close \
        -in $joincanvas.down.closefm -side right \
        -fill both -expand 1

      set_tooltips $joincanvas.down.blogfile \
         {"Revision Log and Branch Diagram of the current file"}
      set_tooltips $joincanvas.join \
         {"Merge to current"}
      set_tooltips $joincanvas.delta \
         {"Merge changes to current"}
      set_tooltips $joincanvas.up.bworkdir \
        {"Open the Working Directory Browser"}
      set_tooltips $joincanvas.up.bmodbrowse \
        {"Open the Repository Browser"}

      #
      # Put the canvas on to the display.
      #
      pack $joincanvas.xscroll -side bottom -fill x -padx 1 -pady 1
      pack $joincanvas.yscroll -side right -fill y -padx 1 -pady 1
      pack $joincanvas.canvas -fill both -expand 1

      $joincanvas.canvas delete all

      #
      # Window manager stuff.
      #
      wm minsize $joincanvas 1 1

      scrollbindings Canvas
      focus $joincanvas.canvas

      fillcanvas $localfile $filelog

      return [namespace current]
    }
  }
}

proc cvs_joincanvas { } {
# Find the bushiest file in the directory and diagram it
  global cvs
  global incvs
  global cvscfg
  global current_tagname

  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"]

  gen_log:log D "Directory tag: $current_tagname"
  foreach logline $log_lines {
    if {[string match "Working file:*" $logline]} {
      set filename [lrange [split $logline] 2 end]
      set nbranches($filename) 0
      continue
    }
    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} {
    join_getlog $bushiestfile
  } else {
    join_getlog $mostrevisedfile
  }

  gen_log:log T "LEAVE"
}

# Get the file log.  Make a new canvas or re-draw an existing one.
proc join_getlog {filename {name_idx {}}} {
  global cvscfg
  global cvs
  global current_tagname

  gen_log:log T "ENTER ($filename $name_idx)"
  set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\""
  gen_log:log C "$commandline"
  set ret [catch {eval "exec $commandline"} view_this]
  # If you bail, sometimes you discard a perfectly good log
  #if {$ret} {
    #cvsfail $view_this
    #gen_log:log T "LEAVE ERROR ($view_this)"
    #return
  #}
  if {$name_idx == ""} {
    joincanvas::new $filename $view_this $current_tagname
  } else {
    $name_idx\::fillcanvas $filename $view_this
  }
  gen_log:log T "LEAVE"
}