gitk: Eliminate diagonal arrows

This changes the optimizer to insert pads to straighten downward
pointing arrows so they point straight down.  When drawing the parent
link to the first child in drawlineseg, this draws it with 3 segments
like other parent links if it is only one row high with an arrow.
These two things mean we can dispense with the workarounds for arrows
on diagonal segments.  This also fixes a couple of other minor bugs.

Signed-off-by: Paul Mackerras <paulus@samba.org>

diff --git a/gitk b/gitk
index bc3022e69fe107c4dfa3a736b0360293722a55a7..7b62e98ec12876fb8a4324721a6ea14e0830807c 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -2600,7 +2600,7 @@ proc idcol {idlist id {i 0}} {
 proc makeuparrow {oid y x} {
     global rowidlist uparrowlen idrowranges displayorder
 
 proc makeuparrow {oid y x} {
     global rowidlist uparrowlen idrowranges displayorder
 

-    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
+    for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {

        incr y -1
        set idl [lindex $rowidlist $y]
        set x [idcol $idl $oid $x]
        incr y -1
        set idl [lindex $rowidlist $y]
        set x [idcol $idl $oid $x]


@@ -3005,7 +3005,14 @@ proc insert_pad {row col npad} {
     global rowidlist
 
     set pad [ntimes $npad {}]
     global rowidlist
 
     set pad [ntimes $npad {}]

-    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
+    set idlist [lindex $rowidlist $row]
+    set bef [lrange $idlist 0 [expr {$col - 1}]]
+    set aft [lrange $idlist $col end]
+    set i [lsearch -exact $aft {}]
+    if {$i > 0} {
+       set aft [lreplace $aft $i $i]
+    }
+    lset rowidlist $row [concat $bef $pad $aft]

 }
 
 proc optimize_rows {row col endrow} {
 }
 
 proc optimize_rows {row col endrow} {


@@ -3053,6 +3060,10 @@ proc optimize_rows {row col endrow} {
                    set isarrow 1
                }
            }
                    set isarrow 1
                }
            }

+           if {!$isarrow && $id ne [lindex $displayorder $row] &&
+               [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
+               set isarrow 1
+           }

            # Looking at lines from this row to the previous row,
            # make them go straight up if they end in an arrow on
            # the previous row; otherwise make them go straight up
            # Looking at lines from this row to the previous row,
            # make them go straight up if they end in an arrow on
            # the previous row; otherwise make them go straight up


@@ -3077,8 +3088,8 @@ proc optimize_rows {row col endrow} {
                # Line currently goes right too much;
                # insert pads in this line
                set npad [expr {$z - 1 + $isarrow}]
                # Line currently goes right too much;
                # insert pads in this line
                set npad [expr {$z - 1 + $isarrow}]

-               set pad [ntimes $npad {}]
-               set idlist [eval linsert \$idlist $col $pad]
+               insert_pad $row $col $npad
+               set idlist [lindex $rowidlist $row]

                incr col $npad
                set z [expr {$x0 - $col}]
                set haspad 1
                incr col $npad
                set z [expr {$x0 - $col}]
                set haspad 1


@@ -3169,31 +3180,9 @@ proc rowranges {id} {
     return $linenos
 }
 
     return $linenos
 }
 

-# work around tk8.4 refusal to draw arrows on diagonal segments
-proc adjarrowhigh {coords} {
-    global linespc
-
-    set x0 [lindex $coords 0]
-    set x1 [lindex $coords 2]
-    if {$x0 != $x1} {
-       set y0 [lindex $coords 1]
-       set y1 [lindex $coords 3]
-       if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
-           # we have a nearby vertical segment, just trim off the diag bit
-           set coords [lrange $coords 2 end]
-       } else {
-           set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
-           set xi [expr {$x0 - $slope * $linespc / 2}]
-           set yi [expr {$y0 - $linespc / 2}]
-           set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
-       }
-    }
-    return $coords
-}
-

 proc drawlineseg {id row endrow arrowlow} {
     global rowidlist displayorder iddrawn linesegs
 proc drawlineseg {id row endrow arrowlow} {
     global rowidlist displayorder iddrawn linesegs

-    global canv colormap linespc curview maxlinelen
+    global canv colormap linespc curview maxlinelen parentlist

 
     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
     set le [expr {$row + 1}]
 
     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
     set le [expr {$row + 1}]


@@ -3268,9 +3257,11 @@ proc drawlineseg {id row endrow arrowlow} {
        set itl [lindex $lines [expr {$i-1}] 2]
        set al [$canv itemcget $itl -arrow]
        set arrowlow [expr {$al eq "last" || $al eq "both"}]
        set itl [lindex $lines [expr {$i-1}] 2]
        set al [$canv itemcget $itl -arrow]
        set arrowlow [expr {$al eq "last" || $al eq "both"}]

-    } elseif {$arrowlow &&
-             [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
-       set arrowlow 0
+    } elseif {$arrowlow} {
+       if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
+           [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
+           set arrowlow 0
+       }

     }
     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
     for {set y $le} {[incr y -1] > $row} {} {
     }
     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
     for {set y $le} {[incr y -1] > $row} {} {


@@ -3289,8 +3280,19 @@ proc drawlineseg {id row endrow arrowlow} {
            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
            if {$xc < 0} {
                puts "oops: drawlineseg: child $ch not on row $row"
            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
            if {$xc < 0} {
                puts "oops: drawlineseg: child $ch not on row $row"

-           } else {
-               if {$xc < $x - 1} {
+           } elseif {$xc != $x} {
+               if {($arrowhigh && $le == $row + 1) || $dir == 0} {
+                   set d [expr {int(0.5 * $linespc)}]
+                   set x1 [xc $row $x]
+                   if {$xc < $x} {
+                       set x2 [expr {$x1 - $d}]
+                   } else {
+                       set x2 [expr {$x1 + $d}]
+                   }
+                   set y2 [yc $row]
+                   set y1 [expr {$y2 + $d}]
+                   lappend coords $x1 $y1 $x2 $y2
+               } elseif {$xc < $x - 1} {

                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
                } elseif {$xc > $x + 1} {
                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
                } elseif {$xc > $x + 1} {
                    lappend coords [xc $row [expr {$x+1}]] [yc $row]


@@ -3301,23 +3303,9 @@ proc drawlineseg {id row endrow arrowlow} {
        } else {
            set xn [xc $row $xp]
            set yn [yc $row]
        } else {
            set xn [xc $row $xp]
            set yn [yc $row]

-           # work around tk8.4 refusal to draw arrows on diagonal segments
-           if {$arrowlow && $xn != [lindex $coords end-1]} {
-               if {[llength $coords] < 4 ||
-                   [lindex $coords end-3] != [lindex $coords end-1] ||
-                   [lindex $coords end] - $yn > 2 * $linespc} {
-                   set xn [xc $row [expr {$xp - 0.5 * $dir}]]
-                   set yo [yc [expr {$row + 0.5}]]
-                   lappend coords $xn $yo $xn $yn
-               }
-           } else {
-               lappend coords $xn $yn
-           }
+           lappend coords $xn $yn

        }
        if {!$joinhigh} {
        }
        if {!$joinhigh} {

-           if {$arrowhigh} {
-               set coords [adjarrowhigh $coords]
-           }

            assigncolor $id
            set t [$canv create line $coords -width [linewidth $id] \
                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
            assigncolor $id
            set t [$canv create line $coords -width [linewidth $id] \
                       -fill $colormap($id) -tags lines.$id -arrow $arrow]


@@ -3341,9 +3329,6 @@ proc drawlineseg {id row endrow arrowlow} {
        set coords [concat $coords $clow]
        if {!$joinhigh} {
            lset lines [expr {$i-1}] 1 $le
        set coords [concat $coords $clow]
        if {!$joinhigh} {
            lset lines [expr {$i-1}] 1 $le

-           if {$arrowhigh} {
-               set coords [adjarrowhigh $coords]
-           }

        } else {
            # coalesce two pieces
            $canv delete $ith
        } else {
            # coalesce two pieces
            $canv delete $ith


@@ -3373,7 +3358,7 @@ proc drawparentlinks {id row} {
     set x [xc $row $col]
     set y [yc $row]
     set y2 [yc $row2]
     set x [xc $row $col]
     set y [yc $row]
     set y2 [yc $row2]

-    set d [expr {int(0.4 * $linespc)}]
+    set d [expr {int(0.5 * $linespc)}]

     set ymid [expr {$y + $d}]
     set ids [lindex $rowidlist $row2]
     # rmx = right-most X coord used
     set ymid [expr {$y + $d}]
     set ids [lindex $rowidlist $row2]
     # rmx = right-most X coord used