branch_diagram.tcl

TKCVS Source Code For CVS。

        }
        gen_log:log D "set offset $view_xoff $view_yoff"
        $logcanvas.canvas xview moveto $view_xoff
        $logcanvas.canvas yview moveto $view_yoff
        update
        #gen_log:log T "LEAVE"
        return
      }
  
      proc DrawTree { {now {}} } {
        global cvscfg
        global logcfg
        variable scope
        variable after_id_draw
        variable logcanvas
        variable box_height
        variable root_info
        variable fromtags {}
        variable totags {}
        variable toprefix
        variable fromprefix
        variable xy
        variable boxwidth
        variable view_xoff
        variable view_yoff
        variable curr
        variable opt
        variable rev_info
        variable scale
        variable font_norm
        variable font_norm_h
        variable font_bold
        variable font_bold_h

        variable revwho
        variable revdate
        variable revtime
        variable revcomment
        variable revstate
        variable revtags
        variable revbtags
        variable revpath
        variable revkind
        variable revbranches
        variable branchrevs
        variable match

        gen_log:log T "ENTER ($now)"

        catch { unset revwho }
        foreach a [array names $scope\::revwho] {
          set revwho($a) [set $scope\::revwho($a)]
        }
        catch { unset revdate }
        foreach a [array names $scope\::revdate] {
          set revdate($a) [set $scope\::revdate($a)]
        }
        catch { unset revtime }
        foreach a [array names $scope\::revtime] {
          set revtime($a) [set $scope\::revtime($a)]
        }
        catch { unset revcomment }
        foreach a [array names $scope\::revcomment] {
          set revcomment($a) [set $scope\::revcomment($a)]
        }
        catch { unset revstate }
        foreach a [array names $scope\::revstate] {
          set revstate($a) [set $scope\::revstate($a)]
        }
        catch { unset revtags }
        foreach a [array names $scope\::revtags] {
          set revtags($a) [set $scope\::revtags($a)]
        }
        catch { unset revbtags }
        foreach a [array names $scope\::revbtags] {
          set revbtags($a) [set $scope\::revbtags($a)]
        }
        catch { unset revpath }
        foreach a [array names $scope\::revpath] {
          set revpath($a) [set $scope\::revpath($a)]
        }
        catch { unset revbranches }
        foreach a [array names $scope\::revbranches] {
          set revbranches($a) [set $scope\::revbranches($a)]
        }
        catch { unset revkind }
        foreach a [array names $scope\::revkind] {
          set revkind($a) [set $scope\::revkind($a)]
        }
        catch { unset branchrevs }
        foreach a [array names $scope\::branchrevs] {
          set branchrevs($a) [set $scope\::branchrevs($a)]
        }

        set totagbegin [string first "_BRANCH_" $cvscfg(mergetoformat) ]
        set fromtagbegin [string first "_BRANCH_" $cvscfg(mergefromformat) ]
        set fromprefix [string range $cvscfg(mergefromformat) 0 [expr {$fromtagbegin -1}]]
        set toprefix [string range $cvscfg(mergetoformat) 0 [expr {$totagbegin - 1}]]

        catch {after cancel $after_id_draw}
        busy_start $logcanvas
        if {$now != {now} && [info exists logcfg(draw_delay)]} {
          set after_id_draw \
            [after $logcfg(draw_delay) [namespace code {DrawTree now}]]
        } else {
          set view_xoff [lindex [$logcanvas.canvas xview] 0]
          set view_yoff [lindex [$logcanvas.canvas yview] 0]
          $logcanvas.canvas delete all
          # These put the names of variables into one variable to be passed.
          # Because they're in braces, we don't need to know about the
          # variables here.  But the proc they're evaluated in has to know
          # about them.
          set root_info {}
          if {$opt(show_root_tags)} {
            append root_info {$revbtags($root_rev) }
          }
          if {$opt(show_root_rev)} {
            append root_info {$root_rev }
          }
          set rev_info {}
          if {$opt(show_box_revtime)} {
            append rev_info {$revtime($revision) }
          }
          if {$opt(show_box_revdate)} {
            append rev_info {$revdate($revision) }
          }
          if {$opt(show_box_revwho)} {
            append rev_info {$revwho($revision) }
          }
          if {$opt(show_box_rev)} {
            append rev_info {$revision}
          }

          # Note: the boxes and tag lists are sized according to the font
          # so do not need to be scaled.
          set my_size [expr {round($logcfg(font_size) * $opt(scale))}]
          set font_norm [font create \
            -family Helvetica -size $my_size]
          set font_norm_h [font metrics \
            $font_norm -displayof $logcanvas -linespace]
          set font_bold [font create \
            -family Helvetica -size $my_size -weight bold]
          set font_bold_h [font metrics \
            $font_bold -displayof $logcanvas -linespace]
          # Scale the layout constants
          foreach x {spcx spcy yfudge boff} {
            set curr($x) [expr {round($logcfg($x) * $font_norm_h * $opt(scale))}]
            if {$curr($x) < 1} {
              set curr($x) 1
            }
          }
          foreach x {padx pady tspcb width} {
            set curr($x) [expr {round($logcfg($x) * $opt(scale))}]
            set curr($x,2) [expr {$curr($x) << 1}]
          }
          set curr(arrowshape) {}
          foreach x $logcfg(arrowshape) {
            lappend curr(arrowshape) [expr {$x * $opt(scale)}]
          }
          set box_height [expr {$curr(pady,2) + [llength $rev_info]*$font_norm_h}]

          # Find the root. (needed for SVN).  If there's a trunk, of course use that
          foreach a [array names revbtags] {
            foreach tag $revbtags($a) {
              if {$tag == "trunk"} {
                set trunkrev $a
                break
              }
            }
          }
          # If there's no trunk, find the beginning of a branch
          if {! [info exists trunkrev]} {
            set min 999999
            foreach a [array names revbtags] {
              if {$a == "" } {continue}
              foreach tag $revbtags($a) {
                if {$revbtags($a) != {} } {
                  set rnum [string trimleft $a {r}]
                  if {$rnum < $min} {set min $rnum}
                }
              }
            }
            if {$min != 999999} {
              set basebranch "r$min"
            }
          }

          # Start drawing, beginning with the trunk or the lowest branch
          if {[info exists trunkrev]} {
            gen_log:log D "Drawing trunkrev $trunkrev"
            foreach {lx y2 lbw rh lly} [DrawBranch 0 0 {} $trunkrev] {
              lappend bxys $lx $lbw $rh $lly
              break
            }
            set x2 [expr {$lx + $lbw + $curr(spcx)}]
            set mx [expr {$lx + $lbw/2}]
            #set ry [expr {$y2 - $rh/2 - $curr(spcy)}]
            set ry [expr {$y2 - $rh/4 - $curr(spcy)}]
            set by [expr {$y2 - $curr(boff)}]
            $logcanvas.canvas create line \
              $mx $ry $mx [expr {$by - $rh}] \
              -arrow last -arrowshape $curr(arrowshape) \
              -width $curr(width)

            foreach {rtw box_width root_height} [CalcRoot $trunkrev] { break }
            DrawRoot $lx $y2 $lbw $rh $trunkrev $trunkrev
            UpdateBndBox
          } elseif {[info exists basebranch]} {
            gen_log:log D "Drawing basebranch $basebranch"
            foreach {lx y2 lbw rh lly} [DrawBranch 0 0 {} $basebranch] {
              lappend bxys $lx $lbw $rh $lly
              break
            }
            set x2 [expr {$lx + $lbw + $curr(spcx)}]
            set mx [expr {$lx + $lbw/2}]
            set ry [expr {$y2 - $rh/2 - $curr(spcy)}]
            set by [expr {$y2 - $curr(boff)}]
            $logcanvas.canvas create line \
              $mx $ry $mx [expr {$by - $rh}] \
              -arrow last -arrowshape $curr(arrowshape) \
              -width $curr(width)

            foreach {rtw box_width root_height} [CalcRoot $basebranch] { break }
            DrawRoot $lx $y2 $lbw $rh $basebranch $basebranch
            UpdateBndBox
          }

          gen_log:log D "fromtags: $fromtags"
          gen_log:log D "totags: $totags"
          if {$opt(show_merges)} {
            foreach from $fromtags {
              gen_log:log D " $from"
              set xfrom [lindex $xy($from) 0]
              set yfrom [lindex $xy($from) 1]
              if {! [info exists match($from)]} {
                gen_log:log D "  No match for $match($from)"
                continue
              }
              gen_log:log D "  need a matching tag $match($from)"
              foreach to $totags {
                 gen_log:log D "    comparing $match($from) to $to"
                 if {[string equal $to $match($from)]} {
                    gen_log:log D "  to $to at $xy($to)"
                    set xto [lindex $xy($to) 0]
                    set yto [lindex $xy($to) 1]
                    set xmid $xto
                    set ymid $yto
                    if {$xto > $xfrom} {
                      set xfrom [expr {$xfrom + $boxwidth($from)}]
                      set yfrom [expr {$yfrom - ($box_height / 2)}]
                      set yto [expr {$yto - ($box_height / 2)}]
                      set xmid [expr {$xfrom + (($xto - $xfrom) / 2)}]
                      set ymid [expr {$yto - $box_height}]
                    } elseif {$xfrom > $xto} {
                      set xto [expr {$xto + $boxwidth($to)}]
                      set xmid [expr {$xto + (($xfrom - $xto) / 2)}]
                      set ymid [expr {$yto + ($box_height / 2)}]
                    }
                    if {$xto == $xfrom} {
                      set xmid [expr {$xto - ($boxwidth($from) / 2)}]
                      set ymid [expr {$yfrom - (($yfrom - $yto) / 2)}]
                    }
                    $logcanvas.canvas create line \
                      $xfrom $yfrom $xmid $ymid $xto $yto \
                      -arrow first -smooth 1
                 }
              }
            }
          }
          # Reselect the previously selected revisions
          variable sel_tag
          variable sel_rev
	  foreach AorB {A B} {
            SetSelection $AorB $sel_tag($AorB) $sel_rev($AorB)
          }
          busy_done $logcanvas
        }
        gen_log:log T "LEAVE"
        return
      }

      proc SaveOptions {} {
        global logcfg
        variable opt
        variable sys
        variable loc

        # Save the options to the global set
        set logcfg(update_drawing) $opt(update_drawing)
        foreach {key value} [array get opt] {
          gen_log:log D "logcfg($key) $value"
          set logcfg($key) $value
        }
        save_options
      }

      # Collect the user options from the global set
      set opt(update_drawing) $logcfg(update_drawing)
      set opt(scale) $logcfg(scale)
      foreach {key value} [array get logcfg show_*] {
        set opt($key) $value
      }
      toplevel $logcanvas
      wm title $logcanvas "$sys Log $filename"
      $logcanvas configure -menu $logcanvas.menubar
      menu $logcanvas.menubar
  
      $logcanvas.menubar add cascade -label "File"\
         -menu $logcanvas.menubar.file -underline 0
      menu $logcanvas.menubar.file -tearoff 0
      $logcanvas.menubar.file add command -label "Shell window" -underline 0 \
        -command {eval exec $cvscfg(shell) >& $cvscfg(null) &}
      $logcanvas.menubar.file add separator
      $logcanvas.menubar.file add command -label "Close" -underline 0 \
        -command [namespace code {$logcanvas.close invoke}]
      $logcanvas.menubar.file add command -label "Exit" -underline 1 \
        -command { exit_cleanup 1 }
      set selcolor [option get $logcanvas selectColor selectColor]
      $logcanvas.menubar add cascade -label "View"\
         -menu $logcanvas.menubar.view -underline 0
      menu $logcanvas.menubar.view -tearoff 0
      $logcanvas.menubar.view add cascade -label "Update When Drawing" \
        -menu $logcanvas.menubar.view.update
      menu $logcanvas.menubar.view.update