branch_diagram.tcl

TKCVS Source Code For CVS。

          bind $mname.lbx <Button-1> [namespace code "
                variable revtags
                set i \[$mname.lbx nearest %y\]
                SetSelection A \[lindex \$revtags($rev) \$i\] $rev
                $mname.lbx selection clear 0 end
                $mname.lbx selection set \$i"]
          bind $mname.lbx <Button-2> [namespace code "
                variable revtags
                set i \[$mname.lbx nearest %y\]
                SetSelection A \[lindex \$revtags($rev) \$i\] $rev
                $mname.lbx selection clear 0 end
                $mname.lbx selection set \$i"]
          bind $mname.lbx <Button-3> [namespace code "
                variable revtags
                set i \[$mname.lbx nearest %y\]
                SetSelection B \[lindex \$revtags($rev) \$i\] $rev
                $mname.lbx selection clear 0 end
                $mname.lbx selection set \$i"]
          # FIXME: add capability to delete a tag here?
          # We need it to get laid out before we query its geometry.
          update
        }
        # Centre the pop up on the cursor position then adjust so it doesn't
        # run off the edge of the screen (if possible!).
        set w [winfo width $mname]
        set h [winfo height $mname]
        set x [expr {$x - $w/2}]
        set y [expr {$y - $h/2}]
        set sx [expr {[winfo vrootx $mname] + [winfo vrootwidth $mname]}]
        if {[expr {$x + $w}] >= $sx} {
          set x [expr {$sx - $w}]
        }
        if {$x < 0} {
          set x 0
        }
        set sy [expr {[winfo vrooty $mname] + [winfo vrootheight $mname]}]
        if {[expr {$y + $h}] >= $sy} {
          set y [expr {$sy - $h}]
        }
        if {$y < 0} {
          set y 0
        }
        wm geometry $mname +$x+$y
        return
      }

      proc CalcCurrent { revision } {
        variable curr
        variable font_bold
        variable font_bold_h
        variable logcanvas

        #gen_log:log T "ENTER ($revision)"
        set box_width \
          [expr {[image width Man] \
                 + $curr(padx) \
                 + [font measure $font_bold \
                     -displayof $logcanvas.canvas {You are}] \
                 + $curr(padx,2)}]
        set box_height [image height Man]
        set h [expr {2 * $font_bold_h}]
        if {$h > $box_height} {
          set box_height $h
        }
        incr box_height $curr(pady,2)
        #gen_log:log T "LEAVE"
        return [list $box_width $box_height]
      }

      proc DrawCurrent { x y box_width box_height revision } {
        variable curr
        variable revstate
        variable font_bold
        variable logcanvas
        variable curr_x
        variable curr_y

        #gen_log:log T "ENTER ($x $y $box_width $box_height $revision)"
        set curr_x $x
        set curr_y $y
        # draw the box
        set tx [expr {$x + $box_width}]
        set ty [expr {$y - $box_height}]
        $logcanvas.canvas create rectangle \
          $x $y $tx $ty \
          -width $curr(width) -fill gray90 -outline red3
        if {[info exists revstate(current)]} {
          if {$revstate(current) == {dead}} {
            $logcanvas.canvas create line \
              $x $y $tx $ty -fill red -width $curr(width)
            $logcanvas.canvas create line \
              $tx $y $x $ty -fill red -width $curr(width)
          }
        }
        set pad \
          [expr {($box_width - [image width Man] - \
            [font measure $font_bold -displayof $logcanvas.canvas {You are}]) \
            / 3}]
        set ty [expr {$y - [expr {$box_height/2}]}]
        # add the contents
        $logcanvas.canvas create image \
          [expr {$x + $pad}] $ty \
          -image Man -anchor w
        $logcanvas.canvas create text \
          [expr {$x + $box_width - $pad}] $ty \
          -text "You are\nhere" -anchor e \
          -fill red3 \
          -font $font_bold
        #gen_log:log T "LEAVE"
        return
      }

      proc CalcRoot { root_rev } {
        global cvscfg
        variable opt
        variable curr
        variable box_height
        variable font_bold
        variable font_norm
        variable font_norm_h
        variable logcanvas
        variable root_info
        variable revtags
        variable revbtags
        variable tlist

        #gen_log:log T "ENTER ($root_rev)"
        gen_log:log D "CalcRoot ($root_rev)"
        set height $box_height
        set tag_width 0
        set box_width 0
        set tlist($root_rev) {}
        if {[info exists revtags($root_rev)]} {
          # We want to show all the coloured tags plus others to take
          # the total to at least cvscfg(tagdepth)
          set tag_colour {}
          set tag_black {}
          foreach tag $revtags($root_rev) {
            if {[info exists cvscfg(tagcolour,$tag)]} {
              lappend tag_colour $tag
            } else {
              lappend tag_black $tag
            }
          }
          set tlist($root_rev) [concat $tag_colour $tag_black]

          if {$opt(show_tags)} {
            if {[info exists cvscfg(tagdepth)] && $cvscfg(tagdepth) != 0} {
              set n [expr {$cvscfg(tagdepth) - [llength $tag_colour]}]
              if {$n < [llength $tag_black]} {
                set tag_black [concat [lrange $tag_black 0 [expr {$n-1}]] {more...}]
              }
            }
            foreach tag $tlist($root_rev) {
              if {$tag == {more...}} {
                set my_font $font_bold
              } else {
                set my_font $font_norm
              }
              set w [font measure $my_font -displayof $logcanvas.canvas $tag]
              if {$w > $tag_width} {
                set tag_width $w
              }
            }
            incr tag_width $curr(tspcb,2)
            set h [expr {[llength $tlist($root_rev)] * $font_norm_h}]
            if {$h > $height} {
              set height $h
            }
          }
        }
        if {![info exists revbtags($root_rev)]} {set revbtags($root_rev) {}}
        foreach s [subst $root_info] {
          set w [font measure $font_norm -displayof $logcanvas.canvas $s]
          if {$w > $box_width} {
            set box_width $w
          }
        }
        incr box_width $curr(padx,2)
        set text_height [expr {$curr(pady,2) + \
          [llength [subst $root_info]] * $font_norm_h}]
        return [list $tag_width $box_width $text_height]
      }

      proc DrawRoot { x y box_width box_height cur_rev root_rev } {
        global cvscfg
        variable curr
        variable opt
        variable font_norm
        variable font_norm_h
        variable font_bold
        variable logcanvas
        variable root_info
        variable revbtags
        variable revbranches
        variable tlist

        #gen_log:log T "ENTER ($x $y $box_width $box_height $cur_rev $root_rev )"
        gen_log:log D "Drawing Root for \"$root_rev\" \"$cur_rev\""

        # draw the box
        $logcanvas.canvas create rectangle \
          $x $y \
          [expr {$x + $box_width}] [expr {$y - $box_height}] \
          -width $curr(width) \
          -fill gray90 -outline blue

        set tx [expr {$x + $box_width/2}]
        set ty [expr {$y - $curr(pady)}]
        gen_log:log D "[subst $root_info]"
        foreach s [subst $root_info] {
          $logcanvas.canvas create text \
            $tx $ty \
            -text $s \
            -anchor s \
            -font $font_norm -fill navy \
            -tags [list R$root_rev box active]
          incr ty -$font_norm_h
        }
        #gen_log:log T "LEAVE"
        return
      }

      proc CalcRevision { revision } {
        global cvscfg
        variable opt
        variable curr
        variable box_height
        variable rev_info
        variable revdate
        variable revtime
        variable revwho
        variable font_norm
        variable font_norm_h
        variable font_bold
        variable logcanvas
        variable revtags
        variable tlist

        #gen_log:log T "ENTER ($revision)"
        set height $box_height
        set tag_width 0
        set box_width 0
        set tlist($revision) {}
        if {[info exists revtags($revision)]} {
          # We want to show all the coloured tags plus others to take
          # the total to at least cvscfg(tagdepth)
          set tag_colour {}
          set tag_black {}
          foreach tag $revtags($revision) {
            if {[info exists cvscfg(tagcolour,$tag)]} {
              lappend tag_colour $tag
            } else {
              lappend tag_black $tag
            }
          }
          if {[info exists cvscfg(tagdepth)] && $cvscfg(tagdepth) != 0} {
            set n [expr {$cvscfg(tagdepth) - [llength $tag_colour]}]
            if {$n < [llength $tag_black]} {
              set tag_black [concat [lrange $tag_black 0 [expr {$n-1}]] {more...}]
            }
          }
          set tlist($revision) [concat $tag_colour $tag_black]
          if {$opt(show_tags)} {
            foreach tag $tlist($revision) {
              if {$tag == {more...}} {
                set my_font $font_bold
              } else {
                set my_font $font_norm
              }
              set w [font measure $my_font -displayof $logcanvas.canvas $tag]
              if {$w > $tag_width} {
                set tag_width $w
              }
            }
            incr tag_width $curr(tspcb,2)
            set h [expr {[llength $tlist($revision)] * $font_norm_h}]
            if {$h > $height} {
              set height $h
            }
          }
        }

        if {![info exists revtime($revision)]} {set revtime($revision) {}}
        if {![info exists revdate($revision)]} {set revdate($revision) {}}
        if {![info exists revinfo($revision)]} {set revinfo($revision) {}}
        if {![info exists revwho($revision)]} {set revwho($revision) {}}
        foreach s [subst $rev_info] {
          set w [font measure $font_norm -displayof $logcanvas.canvas $s]
          if {$w > $box_width} {
            set box_width $w
          }
        }
        incr box_width $curr(padx,2)
        #gen_log:log T "LEAVE"
        return [list $tag_width $box_width $height]
      }

      proc DrawRevision { x y box_width height revision} {
        global cvscfg
        variable opt
        variable curr
        variable box_height
        variable rev_info
        variable revdate
        variable revtime
        variable revwho
        variable revstate
        variable revkind
        variable revtags
        variable revbtags
        variable font_norm
        variable font_norm_h
        variable font_bold
        variable logcanvas
        variable tlist
        variable match
        variable fromtags
        variable totags
        variable xy
        variable boxwidth
        variable fromprefix
        variable toprefix
        upvar branch branch