gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005 Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return ".git"
  16     }
  17 }
  18
  19 proc parse_args {rargs} {
  20     global parsed_args
  21
  22     if [catch {
  23         set parse_args [concat --default HEAD $rargs]
  24         set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  25     }] {
  26         # if git-rev-parse failed for some reason...
  27         if {$rargs == {}} {
  28             set rargs HEAD
  29         }
  30         set parsed_args $rargs
  31     }
  32     return $parsed_args
  33 }
  34
  35 proc getcommits {rargs} {
  36     global oldcommits commits commfd phase canv mainfont env
  37     global startmsecs nextupdate ncmupdate
  38     global ctext maincursor textcursor leftover gitencoding
  39
  40     # check that we can find a .git directory somewhere...
  41     set gitdir [gitdir]
  42     if {![file isdirectory $gitdir]} {
  43         error_popup "Cannot find the git directory \"$gitdir\"."
  44         exit 1
  45     }
  46     set oldcommits {}
  47     set commits {}
  48     set phase getcommits
  49     set startmsecs [clock clicks -milliseconds]
  50     set nextupdate [expr {$startmsecs + 100}]
  51     set ncmupdate 1
  52     set parsed_args [parse_args $rargs]
  53     if [catch {
  54         set commfd [open "|git-rev-list --header --topo-order --parents $parsed_args" r]
  55     } err] {
  56         puts stderr "Error executing git-rev-list: $err"
  57         exit 1
  58     }
  59     set leftover {}
  60     fconfigure $commfd -blocking 0 -translation lf -encoding $gitencoding
  61     fileevent $commfd readable [list getcommitlines $commfd]
  62     $canv delete all
  63     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  64         -font $mainfont -tags textitems
  65     . config -cursor watch
  66     settextcursor watch
  67 }
  68
  69 proc getcommitlines {commfd}  {
  70     global oldcommits commits parents cdate children nchildren
  71     global commitlisted phase nextupdate
  72     global stopped redisplaying leftover
  73     global canv
  74
  75     set stuff [read $commfd]
  76     if {$stuff == {}} {
  77         if {![eof $commfd]} return
  78         # set it blocking so we wait for the process to terminate
  79         fconfigure $commfd -blocking 1
  80         if {![catch {close $commfd} err]} {
  81             after idle finishcommits
  82             return
  83         }
  84         if {[string range $err 0 4] == "usage"} {
  85             set err \
  86                 "Gitk: error reading commits: bad arguments to git-rev-list.\
  87                 (Note: arguments to gitk are passed to git-rev-list\
  88                 to allow selection of commits to be displayed.)"
  89         } else {
  90             set err "Error reading commits: $err"
  91         }
  92         error_popup $err
  93         exit 1
  94     }
  95     set start 0
  96     while 1 {
  97         set i [string first "\0" $stuff $start]
  98         if {$i < 0} {
  99             append leftover [string range $stuff $start end]
 100             return
 101         }
 102         set cmit [string range $stuff $start [expr {$i - 1}]]
 103         if {$start == 0} {
 104             set cmit "$leftover$cmit"
 105             set leftover {}
 106         }
 107         set start [expr {$i + 1}]
 108         set j [string first "\n" $cmit]
 109         set ok 0
 110         if {$j >= 0} {
 111             set ids [string range $cmit 0 [expr {$j - 1}]]
 112             set ok 1
 113             foreach id $ids {
 114                 if {![regexp {^[0-9a-f]{40}$} $id]} {
 115                     set ok 0
 116                     break
 117                 }
 118             }
 119         }
 120         if {!$ok} {
 121             set shortcmit $cmit
 122             if {[string length $shortcmit] > 80} {
 123                 set shortcmit "[string range $shortcmit 0 80]..."
 124             }
 125             error_popup "Can't parse git-rev-list output: {$shortcmit}"
 126             exit 1
 127         }
 128         set id [lindex $ids 0]
 129         set olds [lrange $ids 1 end]
 130         set cmit [string range $cmit [expr {$j + 1}] end]
 131         if {$phase == "updatecommits"} {
 132             $canv delete all
 133             set oldcommits $commits
 134             set commits {}
 135             unset children
 136             unset nchildren
 137             set phase getcommits
 138         }
 139         lappend commits $id
 140         set commitlisted($id) 1
 141         parsecommit $id $cmit 1 [lrange $ids 1 end]
 142         drawcommit $id 1
 143         if {[clock clicks -milliseconds] >= $nextupdate} {
 144             doupdate 1
 145         }
 146         while {$redisplaying} {
 147             set redisplaying 0
 148             if {$stopped == 1} {
 149                 set stopped 0
 150                 set phase "getcommits"
 151                 foreach id $commits {
 152                     drawcommit $id 1
 153                     if {$stopped} break
 154                     if {[clock clicks -milliseconds] >= $nextupdate} {
 155                         doupdate 1
 156                     }
 157                 }
 158             }
 159         }
 160     }
 161 }
 162
 163 proc doupdate {reading} {
 164     global commfd nextupdate numcommits ncmupdate
 165
 166     if {$reading} {
 167         fileevent $commfd readable {}
 168     }
 169     update
 170     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 171     if {$numcommits < 100} {
 172         set ncmupdate [expr {$numcommits + 1}]
 173     } elseif {$numcommits < 10000} {
 174         set ncmupdate [expr {$numcommits + 10}]
 175     } else {
 176         set ncmupdate [expr {$numcommits + 100}]
 177     }
 178     if {$reading} {
 179         fileevent $commfd readable [list getcommitlines $commfd]
 180     }
 181 }
 182
 183 proc readcommit {id} {
 184     if [catch {set contents [exec git-cat-file commit $id]}] return
 185     parsecommit $id $contents 0 {}
 186 }
 187
 188 proc updatechildren {id olds} {
 189     global children nchildren parents nparents ncleft
 190
 191     if {![info exists nchildren($id)]} {
 192         set children($id) {}
 193         set nchildren($id) 0
 194         set ncleft($id) 0
 195     }
 196     set parents($id) $olds
 197     set nparents($id) [llength $olds]
 198     foreach p $olds {
 199         if {![info exists nchildren($p)]} {
 200             set children($p) [list $id]
 201             set nchildren($p) 1
 202             set ncleft($p) 1
 203         } elseif {[lsearch -exact $children($p) $id] < 0} {
 204             lappend children($p) $id
 205             incr nchildren($p)
 206             incr ncleft($p)
 207         }
 208     }
 209 }
 210
 211 proc parsecommit {id contents listed olds} {
 212     global commitinfo cdate
 213
 214     set inhdr 1
 215     set comment {}
 216     set headline {}
 217     set auname {}
 218     set audate {}
 219     set comname {}
 220     set comdate {}
 221     updatechildren $id $olds
 222     set hdrend [string first "\n\n" $contents]
 223     if {$hdrend < 0} {
 224         # should never happen...
 225         set hdrend [string length $contents]
 226     }
 227     set header [string range $contents 0 [expr {$hdrend - 1}]]
 228     set comment [string range $contents [expr {$hdrend + 2}] end]
 229     foreach line [split $header "\n"] {
 230         set tag [lindex $line 0]
 231         if {$tag == "author"} {
 232             set audate [lindex $line end-1]
 233             set auname [lrange $line 1 end-2]
 234         } elseif {$tag == "committer"} {
 235             set comdate [lindex $line end-1]
 236             set comname [lrange $line 1 end-2]
 237         }
 238     }
 239     set headline {}
 240     # take the first line of the comment as the headline
 241     set i [string first "\n" $comment]
 242     if {$i >= 0} {
 243         set headline [string trim [string range $comment 0 $i]]
 244     } else {
 245         set headline $comment
 246     }
 247     if {!$listed} {
 248         # git-rev-list indents the comment by 4 spaces;
 249         # if we got this via git-cat-file, add the indentation
 250         set newcomment {}
 251         foreach line [split $comment "\n"] {
 252             append newcomment "    "
 253             append newcomment $line
 254             append newcomment "\n"
 255         }
 256         set comment $newcomment
 257     }
 258     if {$comdate != {}} {
 259         set cdate($id) $comdate
 260     }
 261     set commitinfo($id) [list $headline $auname $audate \
 262                              $comname $comdate $comment]
 263 }
 264
 265 proc readrefs {} {
 266     global tagids idtags headids idheads tagcontents
 267     global otherrefids idotherrefs
 268
 269     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 270         catch {unset $v}
 271     }
 272     set refd [open [list | git-ls-remote [gitdir]] r]
 273     while {0 <= [set n [gets $refd line]]} {
 274         if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 275             match id path]} {
 276             continue
 277         }
 278         if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 279             set type others
 280             set name $path
 281         }
 282         if {$type == "tags"} {
 283             set tagids($name) $id
 284             lappend idtags($id) $name
 285             set obj {}
 286             set type {}
 287             set tag {}
 288             catch {
 289                 set commit [exec git-rev-parse "$id^0"]
 290                 if {"$commit" != "$id"} {
 291                     set tagids($name) $commit
 292                     lappend idtags($commit) $name
 293                 }
 294             }
 295             catch {
 296                 set tagcontents($name) [exec git-cat-file tag "$id"]
 297             }
 298         } elseif { $type == "heads" } {
 299             set headids($name) $id
 300             lappend idheads($id) $name
 301         } else {
 302             set otherrefids($name) $id
 303             lappend idotherrefs($id) $name
 304         }
 305     }
 306     close $refd
 307 }
 308
 309 proc error_popup msg {
 310     set w .error
 311     toplevel $w
 312     wm transient $w .
 313     message $w.m -text $msg -justify center -aspect 400
 314     pack $w.m -side top -fill x -padx 20 -pady 20
 315     button $w.ok -text OK -command "destroy $w"
 316     pack $w.ok -side bottom -fill x
 317     bind $w <Visibility> "grab $w; focus $w"
 318     tkwait window $w
 319 }
 320
 321 proc makewindow {rargs} {
 322     global canv canv2 canv3 linespc charspc ctext cflist textfont
 323     global findtype findtypemenu findloc findstring fstring geometry
 324     global entries sha1entry sha1string sha1but
 325     global maincursor textcursor curtextcursor
 326     global rowctxmenu mergemax
 327
 328     menu .bar
 329     .bar add cascade -label "File" -menu .bar.file
 330     menu .bar.file
 331     .bar.file add command -label "Update" -command [list updatecommits $rargs]
 332     .bar.file add command -label "Reread references" -command rereadrefs
 333     .bar.file add command -label "Quit" -command doquit
 334     menu .bar.edit
 335     .bar add cascade -label "Edit" -menu .bar.edit
 336     .bar.edit add command -label "Preferences" -command doprefs
 337     menu .bar.help
 338     .bar add cascade -label "Help" -menu .bar.help
 339     .bar.help add command -label "About gitk" -command about
 340     . configure -menu .bar
 341
 342     if {![info exists geometry(canv1)]} {
 343         set geometry(canv1) [expr {45 * $charspc}]
 344         set geometry(canv2) [expr {30 * $charspc}]
 345         set geometry(canv3) [expr {15 * $charspc}]
 346         set geometry(canvh) [expr {25 * $linespc + 4}]
 347         set geometry(ctextw) 80
 348         set geometry(ctexth) 30
 349         set geometry(cflistw) 30
 350     }
 351     panedwindow .ctop -orient vertical
 352     if {[info exists geometry(width)]} {
 353         .ctop conf -width $geometry(width) -height $geometry(height)
 354         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 355         set geometry(ctexth) [expr {($texth - 8) /
 356                                     [font metrics $textfont -linespace]}]
 357     }
 358     frame .ctop.top
 359     frame .ctop.top.bar
 360     pack .ctop.top.bar -side bottom -fill x
 361     set cscroll .ctop.top.csb
 362     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 363     pack $cscroll -side right -fill y
 364     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 365     pack .ctop.top.clist -side top -fill both -expand 1
 366     .ctop add .ctop.top
 367     set canv .ctop.top.clist.canv
 368     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 369         -bg white -bd 0 \
 370         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 371     .ctop.top.clist add $canv
 372     set canv2 .ctop.top.clist.canv2
 373     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 374         -bg white -bd 0 -yscrollincr $linespc
 375     .ctop.top.clist add $canv2
 376     set canv3 .ctop.top.clist.canv3
 377     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 378         -bg white -bd 0 -yscrollincr $linespc
 379     .ctop.top.clist add $canv3
 380     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 381
 382     set sha1entry .ctop.top.bar.sha1
 383     set entries $sha1entry
 384     set sha1but .ctop.top.bar.sha1label
 385     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 386         -command gotocommit -width 8
 387     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 388     pack .ctop.top.bar.sha1label -side left
 389     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 390     trace add variable sha1string write sha1change
 391     pack $sha1entry -side left -pady 2
 392
 393     image create bitmap bm-left -data {
 394         #define left_width 16
 395         #define left_height 16
 396         static unsigned char left_bits[] = {
 397         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 398         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 399         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 400     }
 401     image create bitmap bm-right -data {
 402         #define right_width 16
 403         #define right_height 16
 404         static unsigned char right_bits[] = {
 405         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 406         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 407         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 408     }
 409     button .ctop.top.bar.leftbut -image bm-left -command goback \
 410         -state disabled -width 26
 411     pack .ctop.top.bar.leftbut -side left -fill y
 412     button .ctop.top.bar.rightbut -image bm-right -command goforw \
 413         -state disabled -width 26
 414     pack .ctop.top.bar.rightbut -side left -fill y
 415
 416     button .ctop.top.bar.findbut -text "Find" -command dofind
 417     pack .ctop.top.bar.findbut -side left
 418     set findstring {}
 419     set fstring .ctop.top.bar.findstring
 420     lappend entries $fstring
 421     entry $fstring -width 30 -font $textfont -textvariable findstring
 422     pack $fstring -side left -expand 1 -fill x
 423     set findtype Exact
 424     set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 425                           findtype Exact IgnCase Regexp]
 426     set findloc "All fields"
 427     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 428         Comments Author Committer Files Pickaxe
 429     pack .ctop.top.bar.findloc -side right
 430     pack .ctop.top.bar.findtype -side right
 431     # for making sure type==Exact whenever loc==Pickaxe
 432     trace add variable findloc write findlocchange
 433
 434     panedwindow .ctop.cdet -orient horizontal
 435     .ctop add .ctop.cdet
 436     frame .ctop.cdet.left
 437     set ctext .ctop.cdet.left.ctext
 438     text $ctext -bg white -state disabled -font $textfont \
 439         -width $geometry(ctextw) -height $geometry(ctexth) \
 440         -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
 441     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 442     pack .ctop.cdet.left.sb -side right -fill y
 443     pack $ctext -side left -fill both -expand 1
 444     .ctop.cdet add .ctop.cdet.left
 445
 446     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 447     $ctext tag conf hunksep -fore blue
 448     $ctext tag conf d0 -fore red
 449     $ctext tag conf d1 -fore "#00a000"
 450     $ctext tag conf m0 -fore red
 451     $ctext tag conf m1 -fore blue
 452     $ctext tag conf m2 -fore green
 453     $ctext tag conf m3 -fore purple
 454     $ctext tag conf m4 -fore brown
 455     $ctext tag conf mmax -fore darkgrey
 456     set mergemax 5
 457     $ctext tag conf mresult -font [concat $textfont bold]
 458     $ctext tag conf msep -font [concat $textfont bold]
 459     $ctext tag conf found -back yellow
 460
 461     frame .ctop.cdet.right
 462     set cflist .ctop.cdet.right.cfiles
 463     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 464         -yscrollcommand ".ctop.cdet.right.sb set"
 465     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 466     pack .ctop.cdet.right.sb -side right -fill y
 467     pack $cflist -side left -fill both -expand 1
 468     .ctop.cdet add .ctop.cdet.right
 469     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 470
 471     pack .ctop -side top -fill both -expand 1
 472
 473     bindall <1> {selcanvline %W %x %y}
 474     #bindall <B1-Motion> {selcanvline %W %x %y}
 475     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 476     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 477     bindall <2> "allcanvs scan mark 0 %y"
 478     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 479     bind . <Key-Up> "selnextline -1"
 480     bind . <Key-Down> "selnextline 1"
 481     bind . <Key-Right> "goforw"
 482     bind . <Key-Left> "goback"
 483     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 484     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 485     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 486     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 487     bindkey <Key-space> "$ctext yview scroll 1 pages"
 488     bindkey p "selnextline -1"
 489     bindkey n "selnextline 1"
 490     bindkey z "goback"
 491     bindkey x "goforw"
 492     bindkey i "selnextline -1"
 493     bindkey k "selnextline 1"
 494     bindkey j "goback"
 495     bindkey l "goforw"
 496     bindkey b "$ctext yview scroll -1 pages"
 497     bindkey d "$ctext yview scroll 18 units"
 498     bindkey u "$ctext yview scroll -18 units"
 499     bindkey / {findnext 1}
 500     bindkey <Key-Return> {findnext 0}
 501     bindkey ? findprev
 502     bindkey f nextfile
 503     bind . <Control-q> doquit
 504     bind . <Control-f> dofind
 505     bind . <Control-g> {findnext 0}
 506     bind . <Control-r> findprev
 507     bind . <Control-equal> {incrfont 1}
 508     bind . <Control-KP_Add> {incrfont 1}
 509     bind . <Control-minus> {incrfont -1}
 510     bind . <Control-KP_Subtract> {incrfont -1}
 511     bind $cflist <<ListboxSelect>> listboxsel
 512     bind . <Destroy> {savestuff %W}
 513     bind . <Button-1> "click %W"
 514     bind $fstring <Key-Return> dofind
 515     bind $sha1entry <Key-Return> gotocommit
 516     bind $sha1entry <<PasteSelection>> clearsha1
 517
 518     set maincursor [. cget -cursor]
 519     set textcursor [$ctext cget -cursor]
 520     set curtextcursor $textcursor
 521
 522     set rowctxmenu .rowctxmenu
 523     menu $rowctxmenu -tearoff 0
 524     $rowctxmenu add command -label "Diff this -> selected" \
 525         -command {diffvssel 0}
 526     $rowctxmenu add command -label "Diff selected -> this" \
 527         -command {diffvssel 1}
 528     $rowctxmenu add command -label "Make patch" -command mkpatch
 529     $rowctxmenu add command -label "Create tag" -command mktag
 530     $rowctxmenu add command -label "Write commit to file" -command writecommit
 531 }
 532
 533 # when we make a key binding for the toplevel, make sure
 534 # it doesn't get triggered when that key is pressed in the
 535 # find string entry widget.
 536 proc bindkey {ev script} {
 537     global entries
 538     bind . $ev $script
 539     set escript [bind Entry $ev]
 540     if {$escript == {}} {
 541         set escript [bind Entry <Key>]
 542     }
 543     foreach e $entries {
 544         bind $e $ev "$escript; break"
 545     }
 546 }
 547
 548 # set the focus back to the toplevel for any click outside
 549 # the entry widgets
 550 proc click {w} {
 551     global entries
 552     foreach e $entries {
 553         if {$w == $e} return
 554     }
 555     focus .
 556 }
 557
 558 proc savestuff {w} {
 559     global canv canv2 canv3 ctext cflist mainfont textfont
 560     global stuffsaved findmergefiles maxgraphpct
 561     global maxwidth
 562
 563     if {$stuffsaved} return
 564     if {![winfo viewable .]} return
 565     catch {
 566         set f [open "~/.gitk-new" w]
 567         puts $f [list set mainfont $mainfont]
 568         puts $f [list set textfont $textfont]
 569         puts $f [list set findmergefiles $findmergefiles]
 570         puts $f [list set maxgraphpct $maxgraphpct]
 571         puts $f [list set maxwidth $maxwidth]
 572         puts $f "set geometry(width) [winfo width .ctop]"
 573         puts $f "set geometry(height) [winfo height .ctop]"
 574         puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 575         puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 576         puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 577         puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 578         set wid [expr {([winfo width $ctext] - 8) \
 579                            / [font measure $textfont "0"]}]
 580         puts $f "set geometry(ctextw) $wid"
 581         set wid [expr {([winfo width $cflist] - 11) \
 582                            / [font measure [$cflist cget -font] "0"]}]
 583         puts $f "set geometry(cflistw) $wid"
 584         close $f
 585         file rename -force "~/.gitk-new" "~/.gitk"
 586     }
 587     set stuffsaved 1
 588 }
 589
 590 proc resizeclistpanes {win w} {
 591     global oldwidth
 592     if [info exists oldwidth($win)] {
 593         set s0 [$win sash coord 0]
 594         set s1 [$win sash coord 1]
 595         if {$w < 60} {
 596             set sash0 [expr {int($w/2 - 2)}]
 597             set sash1 [expr {int($w*5/6 - 2)}]
 598         } else {
 599             set factor [expr {1.0 * $w / $oldwidth($win)}]
 600             set sash0 [expr {int($factor * [lindex $s0 0])}]
 601             set sash1 [expr {int($factor * [lindex $s1 0])}]
 602             if {$sash0 < 30} {
 603                 set sash0 30
 604             }
 605             if {$sash1 < $sash0 + 20} {
 606                 set sash1 [expr {$sash0 + 20}]
 607             }
 608             if {$sash1 > $w - 10} {
 609                 set sash1 [expr {$w - 10}]
 610                 if {$sash0 > $sash1 - 20} {
 611                     set sash0 [expr {$sash1 - 20}]
 612                 }
 613             }
 614         }
 615         $win sash place 0 $sash0 [lindex $s0 1]
 616         $win sash place 1 $sash1 [lindex $s1 1]
 617     }
 618     set oldwidth($win) $w
 619 }
 620
 621 proc resizecdetpanes {win w} {
 622     global oldwidth
 623     if [info exists oldwidth($win)] {
 624         set s0 [$win sash coord 0]
 625         if {$w < 60} {
 626             set sash0 [expr {int($w*3/4 - 2)}]
 627         } else {
 628             set factor [expr {1.0 * $w / $oldwidth($win)}]
 629             set sash0 [expr {int($factor * [lindex $s0 0])}]
 630             if {$sash0 < 45} {
 631                 set sash0 45
 632             }
 633             if {$sash0 > $w - 15} {
 634                 set sash0 [expr {$w - 15}]
 635             }
 636         }
 637         $win sash place 0 $sash0 [lindex $s0 1]
 638     }
 639     set oldwidth($win) $w
 640 }
 641
 642 proc allcanvs args {
 643     global canv canv2 canv3
 644     eval $canv $args
 645     eval $canv2 $args
 646     eval $canv3 $args
 647 }
 648
 649 proc bindall {event action} {
 650     global canv canv2 canv3
 651     bind $canv $event $action
 652     bind $canv2 $event $action
 653     bind $canv3 $event $action
 654 }
 655
 656 proc about {} {
 657     set w .about
 658     if {[winfo exists $w]} {
 659         raise $w
 660         return
 661     }
 662     toplevel $w
 663     wm title $w "About gitk"
 664     message $w.m -text {
 665 Gitk version 1.2
 666
 667 Copyright © 2005 Paul Mackerras
 668
 669 Use and redistribute under the terms of the GNU General Public License} \
 670             -justify center -aspect 400
 671     pack $w.m -side top -fill x -padx 20 -pady 20
 672     button $w.ok -text Close -command "destroy $w"
 673     pack $w.ok -side bottom
 674 }
 675
 676 proc assigncolor {id} {
 677     global colormap commcolors colors nextcolor
 678     global parents nparents children nchildren
 679     global cornercrossings crossings
 680
 681     if [info exists colormap($id)] return
 682     set ncolors [llength $colors]
 683     if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 684         set child [lindex $children($id) 0]
 685         if {[info exists colormap($child)]
 686             && $nparents($child) == 1} {
 687             set colormap($id) $colormap($child)
 688             return
 689         }
 690     }
 691     set badcolors {}
 692     if {[info exists cornercrossings($id)]} {
 693         foreach x $cornercrossings($id) {
 694             if {[info exists colormap($x)]
 695                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
 696                 lappend badcolors $colormap($x)
 697             }
 698         }
 699         if {[llength $badcolors] >= $ncolors} {
 700             set badcolors {}
 701         }
 702     }
 703     set origbad $badcolors
 704     if {[llength $badcolors] < $ncolors - 1} {
 705         if {[info exists crossings($id)]} {
 706             foreach x $crossings($id) {
 707                 if {[info exists colormap($x)]
 708                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
 709                     lappend badcolors $colormap($x)
 710                 }
 711             }
 712             if {[llength $badcolors] >= $ncolors} {
 713                 set badcolors $origbad
 714             }
 715         }
 716         set origbad $badcolors
 717     }
 718     if {[llength $badcolors] < $ncolors - 1} {
 719         foreach child $children($id) {
 720             if {[info exists colormap($child)]
 721                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
 722                 lappend badcolors $colormap($child)
 723             }
 724             if {[info exists parents($child)]} {
 725                 foreach p $parents($child) {
 726                     if {[info exists colormap($p)]
 727                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
 728                         lappend badcolors $colormap($p)
 729                     }
 730                 }
 731             }
 732         }
 733         if {[llength $badcolors] >= $ncolors} {
 734             set badcolors $origbad
 735         }
 736     }
 737     for {set i 0} {$i <= $ncolors} {incr i} {
 738         set c [lindex $colors $nextcolor]
 739         if {[incr nextcolor] >= $ncolors} {
 740             set nextcolor 0
 741         }
 742         if {[lsearch -exact $badcolors $c]} break
 743     }
 744     set colormap($id) $c
 745 }
 746
 747 proc initgraph {} {
 748     global canvy canvy0 lineno numcommits nextcolor linespc
 749     global mainline mainlinearrow sidelines
 750     global nchildren ncleft
 751     global displist nhyperspace
 752
 753     allcanvs delete all
 754     set nextcolor 0
 755     set canvy $canvy0
 756     set lineno -1
 757     set numcommits 0
 758     catch {unset mainline}
 759     catch {unset mainlinearrow}
 760     catch {unset sidelines}
 761     foreach id [array names nchildren] {
 762         set ncleft($id) $nchildren($id)
 763     }
 764     set displist {}
 765     set nhyperspace 0
 766 }
 767
 768 proc bindline {t id} {
 769     global canv
 770
 771     $canv bind $t <Enter> "lineenter %x %y $id"
 772     $canv bind $t <Motion> "linemotion %x %y $id"
 773     $canv bind $t <Leave> "lineleave $id"
 774     $canv bind $t <Button-1> "lineclick %x %y $id 1"
 775 }
 776
 777 proc drawlines {id xtra delold} {
 778     global mainline mainlinearrow sidelines lthickness colormap canv
 779
 780     if {$delold} {
 781         $canv delete lines.$id
 782     }
 783     if {[info exists mainline($id)]} {
 784         set t [$canv create line $mainline($id) \
 785                    -width [expr {($xtra + 1) * $lthickness}] \
 786                    -fill $colormap($id) -tags lines.$id \
 787                    -arrow $mainlinearrow($id)]
 788         $canv lower $t
 789         bindline $t $id
 790     }
 791     if {[info exists sidelines($id)]} {
 792         foreach ls $sidelines($id) {
 793             set coords [lindex $ls 0]
 794             set thick [lindex $ls 1]
 795             set arrow [lindex $ls 2]
 796             set t [$canv create line $coords -fill $colormap($id) \
 797                        -width [expr {($thick + $xtra) * $lthickness}] \
 798                        -arrow $arrow -tags lines.$id]
 799             $canv lower $t
 800             bindline $t $id
 801         }
 802     }
 803 }
 804
 805 # level here is an index in displist
 806 proc drawcommitline {level} {
 807     global parents children nparents displist
 808     global canv canv2 canv3 mainfont namefont canvy linespc
 809     global lineid linehtag linentag linedtag commitinfo
 810     global colormap numcommits currentparents dupparents
 811     global idtags idline idheads idotherrefs
 812     global lineno lthickness mainline mainlinearrow sidelines
 813     global commitlisted rowtextx idpos lastuse displist
 814     global oldnlines olddlevel olddisplist
 815
 816     incr numcommits
 817     incr lineno
 818     set id [lindex $displist $level]
 819     set lastuse($id) $lineno
 820     set lineid($lineno) $id
 821     set idline($id) $lineno
 822     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 823     if {![info exists commitinfo($id)]} {
 824         readcommit $id
 825         if {![info exists commitinfo($id)]} {
 826             set commitinfo($id) {"No commit information available"}
 827             set nparents($id) 0
 828         }
 829     }
 830     assigncolor $id
 831     set currentparents {}
 832     set dupparents {}
 833     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 834         foreach p $parents($id) {
 835             if {[lsearch -exact $currentparents $p] < 0} {
 836                 lappend currentparents $p
 837             } else {
 838                 # remember that this parent was listed twice
 839                 lappend dupparents $p
 840             }
 841         }
 842     }
 843     set x [xcoord $level $level $lineno]
 844     set y1 $canvy
 845     set canvy [expr {$canvy + $linespc}]
 846     allcanvs conf -scrollregion \
 847         [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]]
 848     if {[info exists mainline($id)]} {
 849         lappend mainline($id) $x $y1
 850         if {$mainlinearrow($id) ne "none"} {
 851             set mainline($id) [trimdiagstart $mainline($id)]
 852         }
 853     }
 854     drawlines $id 0 0
 855     set orad [expr {$linespc / 3}]
 856     set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \
 857                [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \
 858                -fill $ofill -outline black -width 1]
 859     $canv raise $t
 860     $canv bind $t <1> {selcanvline {} %x %y}
 861     set xt [xcoord [llength $displist] $level $lineno]
 862     if {[llength $currentparents] > 2} {
 863         set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 864     }
 865     set rowtextx($lineno) $xt
 866     set idpos($id) [list $x $xt $y1]
 867     if {[info exists idtags($id)] || [info exists idheads($id)]
 868         || [info exists idotherrefs($id)]} {
 869         set xt [drawtags $id $x $xt $y1]
 870     }
 871     set headline [lindex $commitinfo($id) 0]
 872     set name [lindex $commitinfo($id) 1]
 873     set date [lindex $commitinfo($id) 2]
 874     set date [formatdate $date]
 875     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 876                                -text $headline -font $mainfont ]
 877     $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
 878     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 879                                -text $name -font $namefont]
 880     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 881                                -text $date -font $mainfont]
 882
 883     set olddlevel $level
 884     set olddisplist $displist
 885     set oldnlines [llength $displist]
 886 }
 887
 888 proc drawtags {id x xt y1} {
 889     global idtags idheads idotherrefs
 890     global linespc lthickness
 891     global canv mainfont idline rowtextx
 892
 893     set marks {}
 894     set ntags 0
 895     set nheads 0
 896     if {[info exists idtags($id)]} {
 897         set marks $idtags($id)
 898         set ntags [llength $marks]
 899     }
 900     if {[info exists idheads($id)]} {
 901         set marks [concat $marks $idheads($id)]
 902         set nheads [llength $idheads($id)]
 903     }
 904     if {[info exists idotherrefs($id)]} {
 905         set marks [concat $marks $idotherrefs($id)]
 906     }
 907     if {$marks eq {}} {
 908         return $xt
 909     }
 910
 911     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 912     set yt [expr {$y1 - 0.5 * $linespc}]
 913     set yb [expr {$yt + $linespc - 1}]
 914     set xvals {}
 915     set wvals {}
 916     foreach tag $marks {
 917         set wid [font measure $mainfont $tag]
 918         lappend xvals $xt
 919         lappend wvals $wid
 920         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 921     }
 922     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 923                -width $lthickness -fill black -tags tag.$id]
 924     $canv lower $t
 925     foreach tag $marks x $xvals wid $wvals {
 926         set xl [expr {$x + $delta}]
 927         set xr [expr {$x + $delta + $wid + $lthickness}]
 928         if {[incr ntags -1] >= 0} {
 929             # draw a tag
 930             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
 931                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
 932                        -width 1 -outline black -fill yellow -tags tag.$id]
 933             $canv bind $t <1> [list showtag $tag 1]
 934             set rowtextx($idline($id)) [expr {$xr + $linespc}]
 935         } else {
 936             # draw a head or other ref
 937             if {[incr nheads -1] >= 0} {
 938                 set col green
 939             } else {
 940                 set col "#ddddff"
 941             }
 942             set xl [expr {$xl - $delta/2}]
 943             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 944                 -width 1 -outline black -fill $col -tags tag.$id
 945         }
 946         set t [$canv create text $xl $y1 -anchor w -text $tag \
 947                    -font $mainfont -tags tag.$id]
 948         if {$ntags >= 0} {
 949             $canv bind $t <1> [list showtag $tag 1]
 950         }
 951     }
 952     return $xt
 953 }
 954
 955 proc notecrossings {id lo hi corner} {
 956     global olddisplist crossings cornercrossings
 957
 958     for {set i $lo} {[incr i] < $hi} {} {
 959         set p [lindex $olddisplist $i]
 960         if {$p == {}} continue
 961         if {$i == $corner} {
 962             if {![info exists cornercrossings($id)]
 963                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
 964                 lappend cornercrossings($id) $p
 965             }
 966             if {![info exists cornercrossings($p)]
 967                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
 968                 lappend cornercrossings($p) $id
 969             }
 970         } else {
 971             if {![info exists crossings($id)]
 972                 || [lsearch -exact $crossings($id) $p] < 0} {
 973                 lappend crossings($id) $p
 974             }
 975             if {![info exists crossings($p)]
 976                 || [lsearch -exact $crossings($p) $id] < 0} {
 977                 lappend crossings($p) $id
 978             }
 979         }
 980     }
 981 }
 982
 983 proc xcoord {i level ln} {
 984     global canvx0 xspc1 xspc2
 985
 986     set x [expr {$canvx0 + $i * $xspc1($ln)}]
 987     if {$i > 0 && $i == $level} {
 988         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
 989     } elseif {$i > $level} {
 990         set x [expr {$x + $xspc2 - $xspc1($ln)}]
 991     }
 992     return $x
 993 }
 994
 995 # it seems Tk can't draw arrows on the end of diagonal line segments...
 996 proc trimdiagend {line} {
 997     while {[llength $line] > 4} {
 998         set x1 [lindex $line end-3]
 999         set y1 [lindex $line end-2]
1000         set x2 [lindex $line end-1]
1001         set y2 [lindex $line end]
1002         if {($x1 == $x2) != ($y1 == $y2)} break
1003         set line [lreplace $line end-1 end]
1004     }
1005     return $line
1006 }
1007
1008 proc trimdiagstart {line} {
1009     while {[llength $line] > 4} {
1010         set x1 [lindex $line 0]
1011         set y1 [lindex $line 1]
1012         set x2 [lindex $line 2]
1013         set y2 [lindex $line 3]
1014         if {($x1 == $x2) != ($y1 == $y2)} break
1015         set line [lreplace $line 0 1]
1016     }
1017     return $line
1018 }
1019
1020 proc drawslants {id needonscreen nohs} {
1021     global canv mainline mainlinearrow sidelines
1022     global canvx0 canvy xspc1 xspc2 lthickness
1023     global currentparents dupparents
1024     global lthickness linespc canvy colormap lineno geometry
1025     global maxgraphpct maxwidth
1026     global displist onscreen lastuse
1027     global parents commitlisted
1028     global oldnlines olddlevel olddisplist
1029     global nhyperspace numcommits nnewparents
1030
1031     if {$lineno < 0} {
1032         lappend displist $id
1033         set onscreen($id) 1
1034         return 0
1035     }
1036
1037     set y1 [expr {$canvy - $linespc}]
1038     set y2 $canvy
1039
1040     # work out what we need to get back on screen
1041     set reins {}
1042     if {$onscreen($id) < 0} {
1043         # next to do isn't displayed, better get it on screen...
1044         lappend reins [list $id 0]
1045     }
1046     # make sure all the previous commits's parents are on the screen
1047     foreach p $currentparents {
1048         if {$onscreen($p) < 0} {
1049             lappend reins [list $p 0]
1050         }
1051     }
1052     # bring back anything requested by caller
1053     if {$needonscreen ne {}} {
1054         lappend reins $needonscreen
1055     }
1056
1057     # try the shortcut
1058     if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1059         set dlevel $olddlevel
1060         set x [xcoord $dlevel $dlevel $lineno]
1061         set mainline($id) [list $x $y1]
1062         set mainlinearrow($id) none
1063         set lastuse($id) $lineno
1064         set displist [lreplace $displist $dlevel $dlevel $id]
1065         set onscreen($id) 1
1066         set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1067         return $dlevel
1068     }
1069
1070     # update displist
1071     set displist [lreplace $displist $olddlevel $olddlevel]
1072     set j $olddlevel
1073     foreach p $currentparents {
1074         set lastuse($p) $lineno
1075         if {$onscreen($p) == 0} {
1076             set displist [linsert $displist $j $p]
1077             set onscreen($p) 1
1078             incr j
1079         }
1080     }
1081     if {$onscreen($id) == 0} {
1082         lappend displist $id
1083         set onscreen($id) 1
1084     }
1085
1086     # remove the null entry if present
1087     set nullentry [lsearch -exact $displist {}]
1088     if {$nullentry >= 0} {
1089         set displist [lreplace $displist $nullentry $nullentry]
1090     }
1091
1092     # bring back the ones we need now (if we did it earlier
1093     # it would change displist and invalidate olddlevel)
1094     foreach pi $reins {
1095         # test again in case of duplicates in reins
1096         set p [lindex $pi 0]
1097         if {$onscreen($p) < 0} {
1098             set onscreen($p) 1
1099             set lastuse($p) $lineno
1100             set displist [linsert $displist [lindex $pi 1] $p]
1101             incr nhyperspace -1
1102         }
1103     }
1104
1105     set lastuse($id) $lineno
1106
1107     # see if we need to make any lines jump off into hyperspace
1108     set displ [llength $displist]
1109     if {$displ > $maxwidth} {
1110         set ages {}
1111         foreach x $displist {
1112             lappend ages [list $lastuse($x) $x]
1113         }
1114         set ages [lsort -integer -index 0 $ages]
1115         set k 0
1116         while {$displ > $maxwidth} {
1117             set use [lindex $ages $k 0]
1118             set victim [lindex $ages $k 1]
1119             if {$use >= $lineno - 5} break
1120             incr k
1121             if {[lsearch -exact $nohs $victim] >= 0} continue
1122             set i [lsearch -exact $displist $victim]
1123             set displist [lreplace $displist $i $i]
1124             set onscreen($victim) -1
1125             incr nhyperspace
1126             incr displ -1
1127             if {$i < $nullentry} {
1128                 incr nullentry -1
1129             }
1130             set x [lindex $mainline($victim) end-1]
1131             lappend mainline($victim) $x $y1
1132             set line [trimdiagend $mainline($victim)]
1133             set arrow "last"
1134             if {$mainlinearrow($victim) ne "none"} {
1135                 set line [trimdiagstart $line]
1136                 set arrow "both"
1137             }
1138             lappend sidelines($victim) [list $line 1 $arrow]
1139             unset mainline($victim)
1140         }
1141     }
1142
1143     set dlevel [lsearch -exact $displist $id]
1144
1145     # If we are reducing, put in a null entry
1146     if {$displ < $oldnlines} {
1147         # does the next line look like a merge?
1148         # i.e. does it have > 1 new parent?
1149         if {$nnewparents($id) > 1} {
1150             set i [expr {$dlevel + 1}]
1151         } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1152             set i $olddlevel
1153             if {$nullentry >= 0 && $nullentry < $i} {
1154                 incr i -1
1155             }
1156         } elseif {$nullentry >= 0} {
1157             set i $nullentry
1158             while {$i < $displ
1159                    && [lindex $olddisplist $i] == [lindex $displist $i]} {
1160                 incr i
1161             }
1162         } else {
1163             set i $olddlevel
1164             if {$dlevel >= $i} {
1165                 incr i
1166             }
1167         }
1168         if {$i < $displ} {
1169             set displist [linsert $displist $i {}]
1170             incr displ
1171             if {$dlevel >= $i} {
1172                 incr dlevel
1173             }
1174         }
1175     }
1176
1177     # decide on the line spacing for the next line
1178     set lj [expr {$lineno + 1}]
1179     set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1180     if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1181         set xspc1($lj) $xspc2
1182     } else {
1183         set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1184         if {$xspc1($lj) < $lthickness} {
1185             set xspc1($lj) $lthickness
1186         }
1187     }
1188
1189     foreach idi $reins {
1190         set id [lindex $idi 0]
1191         set j [lsearch -exact $displist $id]
1192         set xj [xcoord $j $dlevel $lj]
1193         set mainline($id) [list $xj $y2]
1194         set mainlinearrow($id) first
1195     }
1196
1197     set i -1
1198     foreach id $olddisplist {
1199         incr i
1200         if {$id == {}} continue
1201         if {$onscreen($id) <= 0} continue
1202         set xi [xcoord $i $olddlevel $lineno]
1203         if {$i == $olddlevel} {
1204             foreach p $currentparents {
1205                 set j [lsearch -exact $displist $p]
1206                 set coords [list $xi $y1]
1207                 set xj [xcoord $j $dlevel $lj]
1208                 if {$xj < $xi - $linespc} {
1209                     lappend coords [expr {$xj + $linespc}] $y1
1210                     notecrossings $p $j $i [expr {$j + 1}]
1211                 } elseif {$xj > $xi + $linespc} {
1212                     lappend coords [expr {$xj - $linespc}] $y1
1213                     notecrossings $p $i $j [expr {$j - 1}]
1214                 }
1215                 if {[lsearch -exact $dupparents $p] >= 0} {
1216                     # draw a double-width line to indicate the doubled parent
1217                     lappend coords $xj $y2
1218                     lappend sidelines($p) [list $coords 2 none]
1219                     if {![info exists mainline($p)]} {
1220                         set mainline($p) [list $xj $y2]
1221                         set mainlinearrow($p) none
1222                     }
1223                 } else {
1224                     # normal case, no parent duplicated
1225                     set yb $y2
1226                     set dx [expr {abs($xi - $xj)}]
1227                     if {0 && $dx < $linespc} {
1228                         set yb [expr {$y1 + $dx}]
1229                     }
1230                     if {![info exists mainline($p)]} {
1231                         if {$xi != $xj} {
1232                             lappend coords $xj $yb
1233                         }
1234                         set mainline($p) $coords
1235                         set mainlinearrow($p) none
1236                     } else {
1237                         lappend coords $xj $yb
1238                         if {$yb < $y2} {
1239                             lappend coords $xj $y2
1240                         }
1241                         lappend sidelines($p) [list $coords 1 none]
1242                     }
1243                 }
1244             }
1245         } else {
1246             set j $i
1247             if {[lindex $displist $i] != $id} {
1248                 set j [lsearch -exact $displist $id]
1249             }
1250             if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1251                 || ($olddlevel < $i && $i < $dlevel)
1252                 || ($dlevel < $i && $i < $olddlevel)} {
1253                 set xj [xcoord $j $dlevel $lj]
1254                 lappend mainline($id) $xi $y1 $xj $y2
1255             }
1256         }
1257     }
1258     return $dlevel
1259 }
1260
1261 # search for x in a list of lists
1262 proc llsearch {llist x} {
1263     set i 0
1264     foreach l $llist {
1265         if {$l == $x || [lsearch -exact $l $x] >= 0} {
1266             return $i
1267         }
1268         incr i
1269     }
1270     return -1
1271 }
1272
1273 proc drawmore {reading} {
1274     global displayorder numcommits ncmupdate nextupdate
1275     global stopped nhyperspace parents commitlisted
1276     global maxwidth onscreen displist currentparents olddlevel
1277
1278     set n [llength $displayorder]
1279     while {$numcommits < $n} {
1280         set id [lindex $displayorder $numcommits]
1281         set ctxend [expr {$numcommits + 10}]
1282         if {!$reading && $ctxend > $n} {
1283             set ctxend $n
1284         }
1285         set dlist {}
1286         if {$numcommits > 0} {
1287             set dlist [lreplace $displist $olddlevel $olddlevel]
1288             set i $olddlevel
1289             foreach p $currentparents {
1290                 if {$onscreen($p) == 0} {
1291                     set dlist [linsert $dlist $i $p]
1292                     incr i
1293                 }
1294             }
1295         }
1296         set nohs {}
1297         set reins {}
1298         set isfat [expr {[llength $dlist] > $maxwidth}]
1299         if {$nhyperspace > 0 || $isfat} {
1300             if {$ctxend > $n} break
1301             # work out what to bring back and
1302             # what we want to don't want to send into hyperspace
1303             set room 1
1304             for {set k $numcommits} {$k < $ctxend} {incr k} {
1305                 set x [lindex $displayorder $k]
1306                 set i [llsearch $dlist $x]
1307                 if {$i < 0} {
1308                     set i [llength $dlist]
1309                     lappend dlist $x
1310                 }
1311                 if {[lsearch -exact $nohs $x] < 0} {
1312                     lappend nohs $x
1313                 }
1314                 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1315                     set reins [list $x $i]
1316                 }
1317                 set newp {}
1318                 if {[info exists commitlisted($x)]} {
1319                     set right 0
1320                     foreach p $parents($x) {
1321                         if {[llsearch $dlist $p] < 0} {
1322                             lappend newp $p
1323                             if {[lsearch -exact $nohs $p] < 0} {
1324                                 lappend nohs $p
1325                             }
1326                             if {$reins eq {} && $onscreen($p) < 0 && $room} {
1327                                 set reins [list $p [expr {$i + $right}]]
1328                             }
1329                         }
1330                         set right 1
1331                     }
1332                 }
1333                 set l [lindex $dlist $i]
1334                 if {[llength $l] == 1} {
1335                     set l $newp
1336                 } else {
1337                     set j [lsearch -exact $l $x]
1338                     set l [concat [lreplace $l $j $j] $newp]
1339                 }
1340                 set dlist [lreplace $dlist $i $i $l]
1341                 if {$room && $isfat && [llength $newp] <= 1} {
1342                     set room 0
1343                 }
1344             }
1345         }
1346
1347         set dlevel [drawslants $id $reins $nohs]
1348         drawcommitline $dlevel
1349         if {[clock clicks -milliseconds] >= $nextupdate
1350             && $numcommits >= $ncmupdate} {
1351             doupdate $reading
1352             if {$stopped} break
1353         }
1354     }
1355 }
1356
1357 # level here is an index in todo
1358 proc updatetodo {level noshortcut} {
1359     global ncleft todo nnewparents
1360     global commitlisted parents onscreen
1361
1362     set id [lindex $todo $level]
1363     set olds {}
1364     if {[info exists commitlisted($id)]} {
1365         foreach p $parents($id) {
1366             if {[lsearch -exact $olds $p] < 0} {
1367                 lappend olds $p
1368             }
1369         }
1370     }
1371     if {!$noshortcut && [llength $olds] == 1} {
1372         set p [lindex $olds 0]
1373         if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1374             set ncleft($p) 0
1375             set todo [lreplace $todo $level $level $p]
1376             set onscreen($p) 0
1377             set nnewparents($id) 1
1378             return 0
1379         }
1380     }
1381
1382     set todo [lreplace $todo $level $level]
1383     set i $level
1384     set n 0
1385     foreach p $olds {
1386         incr ncleft($p) -1
1387         set k [lsearch -exact $todo $p]
1388         if {$k < 0} {
1389             set todo [linsert $todo $i $p]
1390             set onscreen($p) 0
1391             incr i
1392             incr n
1393         }
1394     }
1395     set nnewparents($id) $n
1396
1397     return 1
1398 }
1399
1400 proc decidenext {{noread 0}} {
1401     global ncleft todo
1402     global datemode cdate
1403     global commitinfo
1404
1405     # choose which one to do next time around
1406     set todol [llength $todo]
1407     set level -1
1408     set latest {}
1409     for {set k $todol} {[incr k -1] >= 0} {} {
1410         set p [lindex $todo $k]
1411         if {$ncleft($p) == 0} {
1412             if {$datemode} {
1413                 if {![info exists commitinfo($p)]} {
1414                     if {$noread} {
1415                         return {}
1416                     }
1417                     readcommit $p
1418                 }
1419                 if {$latest == {} || $cdate($p) > $latest} {
1420                     set level $k
1421                     set latest $cdate($p)
1422                 }
1423             } else {
1424                 set level $k
1425                 break
1426             }
1427         }
1428     }
1429     if {$level < 0} {
1430         if {$todo != {}} {
1431             puts "ERROR: none of the pending commits can be done yet:"
1432             foreach p $todo {
1433                 puts "  $p ($ncleft($p))"
1434             }
1435         }
1436         return -1
1437     }
1438
1439     return $level
1440 }
1441
1442 proc drawcommit {id reading} {
1443     global phase todo nchildren datemode nextupdate revlistorder
1444     global numcommits ncmupdate displayorder todo onscreen
1445     global numcommits ncmupdate displayorder todo onscreen parents
1446
1447     if {$phase != "incrdraw"} {
1448         set phase incrdraw
1449         set displayorder {}
1450         set todo {}
1451         initgraph
1452     }
1453     if {$nchildren($id) == 0} {
1454         lappend todo $id
1455         set onscreen($id) 0
1456     }
1457     if {$revlistorder} {
1458         set level [lsearch -exact $todo $id]
1459         if {$level < 0} {
1460             error_popup "oops, $id isn't in todo"
1461             return
1462         }
1463         lappend displayorder $id
1464         updatetodo $level 0
1465     } else {
1466         set level [decidenext 1]
1467         if {$level == {} || $id != [lindex $todo $level]} {
1468             return
1469         }
1470         while 1 {
1471             lappend displayorder [lindex $todo $level]
1472             if {[updatetodo $level $datemode]} {
1473                 set level [decidenext 1]
1474                 if {$level == {}} break
1475             }
1476             set id [lindex $todo $level]
1477             if {![info exists commitlisted($id)]} {
1478                 break
1479             }
1480         }
1481     }
1482     drawmore $reading
1483 }
1484
1485 proc finishcommits {} {
1486     global phase oldcommits commits
1487     global canv mainfont ctext maincursor textcursor
1488     global parents
1489
1490     if {$phase == "incrdraw" || $phase == "removecommits"} {
1491         foreach id $oldcommits {
1492             lappend commits $id
1493             updatechildren $id $parents($id)
1494             drawcommit $id 0
1495         }
1496         set oldcommits {}
1497         drawrest
1498     } elseif {$phase == "updatecommits"} {
1499         set phase {}
1500     } else {
1501         $canv delete all
1502         $canv create text 3 3 -anchor nw -text "No commits selected" \
1503             -font $mainfont -tags textitems
1504         set phase {}
1505     }
1506     . config -cursor $maincursor
1507     settextcursor $textcursor
1508 }
1509
1510 # Don't change the text pane cursor if it is currently the hand cursor,
1511 # showing that we are over a sha1 ID link.
1512 proc settextcursor {c} {
1513     global ctext curtextcursor
1514
1515     if {[$ctext cget -cursor] == $curtextcursor} {
1516         $ctext config -cursor $c
1517     }
1518     set curtextcursor $c
1519 }
1520
1521 proc drawgraph {} {
1522     global nextupdate startmsecs ncmupdate
1523     global displayorder onscreen
1524
1525     if {$displayorder == {}} return
1526     set startmsecs [clock clicks -milliseconds]
1527     set nextupdate [expr {$startmsecs + 100}]
1528     set ncmupdate 1
1529     initgraph
1530     foreach id $displayorder {
1531         set onscreen($id) 0
1532     }
1533     drawmore 0
1534 }
1535
1536 proc drawrest {} {
1537     global phase stopped redisplaying selectedline
1538     global datemode todo displayorder
1539     global numcommits ncmupdate
1540     global nextupdate startmsecs revlistorder
1541
1542     set level [decidenext]
1543     if {$level >= 0} {
1544         set phase drawgraph
1545         while 1 {
1546             lappend displayorder [lindex $todo $level]
1547             set hard [updatetodo $level $datemode]
1548             if {$hard} {
1549                 set level [decidenext]
1550                 if {$level < 0} break
1551             }
1552         }
1553     }
1554     drawmore 0
1555     set phase {}
1556     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1557     #puts "overall $drawmsecs ms for $numcommits commits"
1558     if {$redisplaying} {
1559         if {$stopped == 0 && [info exists selectedline]} {
1560             selectline $selectedline 0
1561         }
1562         if {$stopped == 1} {
1563             set stopped 0
1564             after idle drawgraph
1565         } else {
1566             set redisplaying 0
1567         }
1568     }
1569 }
1570
1571 proc findmatches {f} {
1572     global findtype foundstring foundstrlen
1573     if {$findtype == "Regexp"} {
1574         set matches [regexp -indices -all -inline $foundstring $f]
1575     } else {
1576         if {$findtype == "IgnCase"} {
1577             set str [string tolower $f]
1578         } else {
1579             set str $f
1580         }
1581         set matches {}
1582         set i 0
1583         while {[set j [string first $foundstring $str $i]] >= 0} {
1584             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1585             set i [expr {$j + $foundstrlen}]
1586         }
1587     }
1588     return $matches
1589 }
1590
1591 proc dofind {} {
1592     global findtype findloc findstring markedmatches commitinfo
1593     global numcommits lineid linehtag linentag linedtag
1594     global mainfont namefont canv canv2 canv3 selectedline
1595     global matchinglines foundstring foundstrlen
1596
1597     stopfindproc
1598     unmarkmatches
1599     focus .
1600     set matchinglines {}
1601     if {$findloc == "Pickaxe"} {
1602         findpatches
1603         return
1604     }
1605     if {$findtype == "IgnCase"} {
1606         set foundstring [string tolower $findstring]
1607     } else {
1608         set foundstring $findstring
1609     }
1610     set foundstrlen [string length $findstring]
1611     if {$foundstrlen == 0} return
1612     if {$findloc == "Files"} {
1613         findfiles
1614         return
1615     }
1616     if {![info exists selectedline]} {
1617         set oldsel -1
1618     } else {
1619         set oldsel $selectedline
1620     }
1621     set didsel 0
1622     set fldtypes {Headline Author Date Committer CDate Comment}
1623     for {set l 0} {$l < $numcommits} {incr l} {
1624         set id $lineid($l)
1625         set info $commitinfo($id)
1626         set doesmatch 0
1627         foreach f $info ty $fldtypes {
1628             if {$findloc != "All fields" && $findloc != $ty} {
1629                 continue
1630             }
1631             set matches [findmatches $f]
1632             if {$matches == {}} continue
1633             set doesmatch 1
1634             if {$ty == "Headline"} {
1635                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1636             } elseif {$ty == "Author"} {
1637                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1638             } elseif {$ty == "Date"} {
1639                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1640             }
1641         }
1642         if {$doesmatch} {
1643             lappend matchinglines $l
1644             if {!$didsel && $l > $oldsel} {
1645                 findselectline $l
1646                 set didsel 1
1647             }
1648         }
1649     }
1650     if {$matchinglines == {}} {
1651         bell
1652     } elseif {!$didsel} {
1653         findselectline [lindex $matchinglines 0]
1654     }
1655 }
1656
1657 proc findselectline {l} {
1658     global findloc commentend ctext
1659     selectline $l 1
1660     if {$findloc == "All fields" || $findloc == "Comments"} {
1661         # highlight the matches in the comments
1662         set f [$ctext get 1.0 $commentend]
1663         set matches [findmatches $f]
1664         foreach match $matches {
1665             set start [lindex $match 0]
1666             set end [expr {[lindex $match 1] + 1}]
1667             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1668         }
1669     }
1670 }
1671
1672 proc findnext {restart} {
1673     global matchinglines selectedline
1674     if {![info exists matchinglines]} {
1675         if {$restart} {
1676             dofind
1677         }
1678         return
1679     }
1680     if {![info exists selectedline]} return
1681     foreach l $matchinglines {
1682         if {$l > $selectedline} {
1683             findselectline $l
1684             return
1685         }
1686     }
1687     bell
1688 }
1689
1690 proc findprev {} {
1691     global matchinglines selectedline
1692     if {![info exists matchinglines]} {
1693         dofind
1694         return
1695     }
1696     if {![info exists selectedline]} return
1697     set prev {}
1698     foreach l $matchinglines {
1699         if {$l >= $selectedline} break
1700         set prev $l
1701     }
1702     if {$prev != {}} {
1703         findselectline $prev
1704     } else {
1705         bell
1706     }
1707 }
1708
1709 proc findlocchange {name ix op} {
1710     global findloc findtype findtypemenu
1711     if {$findloc == "Pickaxe"} {
1712         set findtype Exact
1713         set state disabled
1714     } else {
1715         set state normal
1716     }
1717     $findtypemenu entryconf 1 -state $state
1718     $findtypemenu entryconf 2 -state $state
1719 }
1720
1721 proc stopfindproc {{done 0}} {
1722     global findprocpid findprocfile findids
1723     global ctext findoldcursor phase maincursor textcursor
1724     global findinprogress
1725
1726     catch {unset findids}
1727     if {[info exists findprocpid]} {
1728         if {!$done} {
1729             catch {exec kill $findprocpid}
1730         }
1731         catch {close $findprocfile}
1732         unset findprocpid
1733     }
1734     if {[info exists findinprogress]} {
1735         unset findinprogress
1736         if {$phase != "incrdraw"} {
1737             . config -cursor $maincursor
1738             settextcursor $textcursor
1739         }
1740     }
1741 }
1742
1743 proc findpatches {} {
1744     global findstring selectedline numcommits
1745     global findprocpid findprocfile
1746     global finddidsel ctext lineid findinprogress
1747     global findinsertpos
1748
1749     if {$numcommits == 0} return
1750
1751     # make a list of all the ids to search, starting at the one
1752     # after the selected line (if any)
1753     if {[info exists selectedline]} {
1754         set l $selectedline
1755     } else {
1756         set l -1
1757     }
1758     set inputids {}
1759     for {set i 0} {$i < $numcommits} {incr i} {
1760         if {[incr l] >= $numcommits} {
1761             set l 0
1762         }
1763         append inputids $lineid($l) "\n"
1764     }
1765
1766     if {[catch {
1767         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1768                          << $inputids] r]
1769     } err]} {
1770         error_popup "Error starting search process: $err"
1771         return
1772     }
1773
1774     set findinsertpos end
1775     set findprocfile $f
1776     set findprocpid [pid $f]
1777     fconfigure $f -blocking 0
1778     fileevent $f readable readfindproc
1779     set finddidsel 0
1780     . config -cursor watch
1781     settextcursor watch
1782     set findinprogress 1
1783 }
1784
1785 proc readfindproc {} {
1786     global findprocfile finddidsel
1787     global idline matchinglines findinsertpos
1788
1789     set n [gets $findprocfile line]
1790     if {$n < 0} {
1791         if {[eof $findprocfile]} {
1792             stopfindproc 1
1793             if {!$finddidsel} {
1794                 bell
1795             }
1796         }
1797         return
1798     }
1799     if {![regexp {^[0-9a-f]{40}} $line id]} {
1800         error_popup "Can't parse git-diff-tree output: $line"
1801         stopfindproc
1802         return
1803     }
1804     if {![info exists idline($id)]} {
1805         puts stderr "spurious id: $id"
1806         return
1807     }
1808     set l $idline($id)
1809     insertmatch $l $id
1810 }
1811
1812 proc insertmatch {l id} {
1813     global matchinglines findinsertpos finddidsel
1814
1815     if {$findinsertpos == "end"} {
1816         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1817             set matchinglines [linsert $matchinglines 0 $l]
1818             set findinsertpos 1
1819         } else {
1820             lappend matchinglines $l
1821         }
1822     } else {
1823         set matchinglines [linsert $matchinglines $findinsertpos $l]
1824         incr findinsertpos
1825     }
1826     markheadline $l $id
1827     if {!$finddidsel} {
1828         findselectline $l
1829         set finddidsel 1
1830     }
1831 }
1832
1833 proc findfiles {} {
1834     global selectedline numcommits lineid ctext
1835     global ffileline finddidsel parents nparents
1836     global findinprogress findstartline findinsertpos
1837     global treediffs fdiffids fdiffsneeded fdiffpos
1838     global findmergefiles
1839
1840     if {$numcommits == 0} return
1841
1842     if {[info exists selectedline]} {
1843         set l [expr {$selectedline + 1}]
1844     } else {
1845         set l 0
1846     }
1847     set ffileline $l
1848     set findstartline $l
1849     set diffsneeded {}
1850     set fdiffsneeded {}
1851     while 1 {
1852         set id $lineid($l)
1853         if {$findmergefiles || $nparents($id) == 1} {
1854             foreach p $parents($id) {
1855                 if {![info exists treediffs([list $id $p])]} {
1856                     append diffsneeded "$id $p\n"
1857                     lappend fdiffsneeded [list $id $p]
1858                 }
1859             }
1860         }
1861         if {[incr l] >= $numcommits} {
1862             set l 0
1863         }
1864         if {$l == $findstartline} break
1865     }
1866
1867     # start off a git-diff-tree process if needed
1868     if {$diffsneeded ne {}} {
1869         if {[catch {
1870             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1871         } err ]} {
1872             error_popup "Error starting search process: $err"
1873             return
1874         }
1875         catch {unset fdiffids}
1876         set fdiffpos 0
1877         fconfigure $df -blocking 0
1878         fileevent $df readable [list readfilediffs $df]
1879     }
1880
1881     set finddidsel 0
1882     set findinsertpos end
1883     set id $lineid($l)
1884     set p [lindex $parents($id) 0]
1885     . config -cursor watch
1886     settextcursor watch
1887     set findinprogress 1
1888     findcont [list $id $p]
1889     update
1890 }
1891
1892 proc readfilediffs {df} {
1893     global findids fdiffids fdiffs
1894
1895     set n [gets $df line]
1896     if {$n < 0} {
1897         if {[eof $df]} {
1898             donefilediff
1899             if {[catch {close $df} err]} {
1900                 stopfindproc
1901                 bell
1902                 error_popup "Error in git-diff-tree: $err"
1903             } elseif {[info exists findids]} {
1904                 set ids $findids
1905                 stopfindproc
1906                 bell
1907                 error_popup "Couldn't find diffs for {$ids}"
1908             }
1909         }
1910         return
1911     }
1912     if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1913         # start of a new string of diffs
1914         donefilediff
1915         set fdiffids [list $id $p]
1916         set fdiffs {}
1917     } elseif {[string match ":*" $line]} {
1918         lappend fdiffs [lindex $line 5]
1919     }
1920 }
1921
1922 proc donefilediff {} {
1923     global fdiffids fdiffs treediffs findids
1924     global fdiffsneeded fdiffpos
1925
1926     if {[info exists fdiffids]} {
1927         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1928                && $fdiffpos < [llength $fdiffsneeded]} {
1929             # git-diff-tree doesn't output anything for a commit
1930             # which doesn't change anything
1931             set nullids [lindex $fdiffsneeded $fdiffpos]
1932             set treediffs($nullids) {}
1933             if {[info exists findids] && $nullids eq $findids} {
1934                 unset findids
1935                 findcont $nullids
1936             }
1937             incr fdiffpos
1938         }
1939         incr fdiffpos
1940
1941         if {![info exists treediffs($fdiffids)]} {
1942             set treediffs($fdiffids) $fdiffs
1943         }
1944         if {[info exists findids] && $fdiffids eq $findids} {
1945             unset findids
1946             findcont $fdiffids
1947         }
1948     }
1949 }
1950
1951 proc findcont {ids} {
1952     global findids treediffs parents nparents
1953     global ffileline findstartline finddidsel
1954     global lineid numcommits matchinglines findinprogress
1955     global findmergefiles
1956
1957     set id [lindex $ids 0]
1958     set p [lindex $ids 1]
1959     set pi [lsearch -exact $parents($id) $p]
1960     set l $ffileline
1961     while 1 {
1962         if {$findmergefiles || $nparents($id) == 1} {
1963             if {![info exists treediffs($ids)]} {
1964                 set findids $ids
1965                 set ffileline $l
1966                 return
1967             }
1968             set doesmatch 0
1969             foreach f $treediffs($ids) {
1970                 set x [findmatches $f]
1971                 if {$x != {}} {
1972                     set doesmatch 1
1973                     break
1974                 }
1975             }
1976             if {$doesmatch} {
1977                 insertmatch $l $id
1978                 set pi $nparents($id)
1979             }
1980         } else {
1981             set pi $nparents($id)
1982         }
1983         if {[incr pi] >= $nparents($id)} {
1984             set pi 0
1985             if {[incr l] >= $numcommits} {
1986                 set l 0
1987             }
1988             if {$l == $findstartline} break
1989             set id $lineid($l)
1990         }
1991         set p [lindex $parents($id) $pi]
1992         set ids [list $id $p]
1993     }
1994     stopfindproc
1995     if {!$finddidsel} {
1996         bell
1997     }
1998 }
1999
2000 # mark a commit as matching by putting a yellow background
2001 # behind the headline
2002 proc markheadline {l id} {
2003     global canv mainfont linehtag commitinfo
2004
2005     set bbox [$canv bbox $linehtag($l)]
2006     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2007     $canv lower $t
2008 }
2009
2010 # mark the bits of a headline, author or date that match a find string
2011 proc markmatches {canv l str tag matches font} {
2012     set bbox [$canv bbox $tag]
2013     set x0 [lindex $bbox 0]
2014     set y0 [lindex $bbox 1]
2015     set y1 [lindex $bbox 3]
2016     foreach match $matches {
2017         set start [lindex $match 0]
2018         set end [lindex $match 1]
2019         if {$start > $end} continue
2020         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2021         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2022         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2023                    [expr {$x0+$xlen+2}] $y1 \
2024                    -outline {} -tags matches -fill yellow]
2025         $canv lower $t
2026     }
2027 }
2028
2029 proc unmarkmatches {} {
2030     global matchinglines findids
2031     allcanvs delete matches
2032     catch {unset matchinglines}
2033     catch {unset findids}
2034 }
2035
2036 proc selcanvline {w x y} {
2037     global canv canvy0 ctext linespc
2038     global lineid linehtag linentag linedtag rowtextx
2039     set ymax [lindex [$canv cget -scrollregion] 3]
2040     if {$ymax == {}} return
2041     set yfrac [lindex [$canv yview] 0]
2042     set y [expr {$y + $yfrac * $ymax}]
2043     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2044     if {$l < 0} {
2045         set l 0
2046     }
2047     if {$w eq $canv} {
2048         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2049     }
2050     unmarkmatches
2051     selectline $l 1
2052 }
2053
2054 proc commit_descriptor {p} {
2055     global commitinfo
2056     set l "..."
2057     if {[info exists commitinfo($p)]} {
2058         set l [lindex $commitinfo($p) 0]
2059     }
2060     return "$p ($l)"
2061 }
2062
2063 # append some text to the ctext widget, and make any SHA1 ID
2064 # that we know about be a clickable link.
2065 proc appendwithlinks {text} {
2066     global ctext idline linknum
2067
2068     set start [$ctext index "end - 1c"]
2069     $ctext insert end $text
2070     $ctext insert end "\n"
2071     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2072     foreach l $links {
2073         set s [lindex $l 0]
2074         set e [lindex $l 1]
2075         set linkid [string range $text $s $e]
2076         if {![info exists idline($linkid)]} continue
2077         incr e
2078         $ctext tag add link "$start + $s c" "$start + $e c"
2079         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2080         $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2081         incr linknum
2082     }
2083     $ctext tag conf link -foreground blue -underline 1
2084     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2085     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2086 }
2087
2088 proc selectline {l isnew} {
2089     global canv canv2 canv3 ctext commitinfo selectedline
2090     global lineid linehtag linentag linedtag
2091     global canvy0 linespc parents nparents children
2092     global cflist currentid sha1entry
2093     global commentend idtags idline linknum
2094
2095     $canv delete hover
2096     normalline
2097     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2098     $canv delete secsel
2099     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2100                -tags secsel -fill [$canv cget -selectbackground]]
2101     $canv lower $t
2102     $canv2 delete secsel
2103     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2104                -tags secsel -fill [$canv2 cget -selectbackground]]
2105     $canv2 lower $t
2106     $canv3 delete secsel
2107     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2108                -tags secsel -fill [$canv3 cget -selectbackground]]
2109     $canv3 lower $t
2110     set y [expr {$canvy0 + $l * $linespc}]
2111     set ymax [lindex [$canv cget -scrollregion] 3]
2112     set ytop [expr {$y - $linespc - 1}]
2113     set ybot [expr {$y + $linespc + 1}]
2114     set wnow [$canv yview]
2115     set wtop [expr {[lindex $wnow 0] * $ymax}]
2116     set wbot [expr {[lindex $wnow 1] * $ymax}]
2117     set wh [expr {$wbot - $wtop}]
2118     set newtop $wtop
2119     if {$ytop < $wtop} {
2120         if {$ybot < $wtop} {
2121             set newtop [expr {$y - $wh / 2.0}]
2122         } else {
2123             set newtop $ytop
2124             if {$newtop > $wtop - $linespc} {
2125                 set newtop [expr {$wtop - $linespc}]
2126             }
2127         }
2128     } elseif {$ybot > $wbot} {
2129         if {$ytop > $wbot} {
2130             set newtop [expr {$y - $wh / 2.0}]
2131         } else {
2132             set newtop [expr {$ybot - $wh}]
2133             if {$newtop < $wtop + $linespc} {
2134                 set newtop [expr {$wtop + $linespc}]
2135             }
2136         }
2137     }
2138     if {$newtop != $wtop} {
2139         if {$newtop < 0} {
2140             set newtop 0
2141         }
2142         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2143     }
2144
2145     if {$isnew} {
2146         addtohistory [list selectline $l 0]
2147     }
2148
2149     set selectedline $l
2150
2151     set id $lineid($l)
2152     set currentid $id
2153     $sha1entry delete 0 end
2154     $sha1entry insert 0 $id
2155     $sha1entry selection from 0
2156     $sha1entry selection to end
2157
2158     $ctext conf -state normal
2159     $ctext delete 0.0 end
2160     set linknum 0
2161     $ctext mark set fmark.0 0.0
2162     $ctext mark gravity fmark.0 left
2163     set info $commitinfo($id)
2164     set date [formatdate [lindex $info 2]]
2165     $ctext insert end "Author: [lindex $info 1]  $date\n"
2166     set date [formatdate [lindex $info 4]]
2167     $ctext insert end "Committer: [lindex $info 3]  $date\n"
2168     if {[info exists idtags($id)]} {
2169         $ctext insert end "Tags:"
2170         foreach tag $idtags($id) {
2171             $ctext insert end " $tag"
2172         }
2173         $ctext insert end "\n"
2174     }
2175
2176     set comment {}
2177     if {[info exists parents($id)]} {
2178         foreach p $parents($id) {
2179             append comment "Parent: [commit_descriptor $p]\n"
2180         }
2181     }
2182     if {[info exists children($id)]} {
2183         foreach c $children($id) {
2184             append comment "Child:  [commit_descriptor $c]\n"
2185         }
2186     }
2187     append comment "\n"
2188     append comment [lindex $info 5]
2189
2190     # make anything that looks like a SHA1 ID be a clickable link
2191     appendwithlinks $comment
2192
2193     $ctext tag delete Comments
2194     $ctext tag remove found 1.0 end
2195     $ctext conf -state disabled
2196     set commentend [$ctext index "end - 1c"]
2197
2198     $cflist delete 0 end
2199     $cflist insert end "Comments"
2200     if {$nparents($id) == 1} {
2201         startdiff $id
2202     } elseif {$nparents($id) > 1} {
2203         mergediff $id
2204     }
2205 }
2206
2207 proc selnextline {dir} {
2208     global selectedline
2209     if {![info exists selectedline]} return
2210     set l [expr {$selectedline + $dir}]
2211     unmarkmatches
2212     selectline $l 1
2213 }
2214
2215 proc unselectline {} {
2216     global selectedline
2217
2218     catch {unset selectedline}
2219     allcanvs delete secsel
2220 }
2221
2222 proc addtohistory {cmd} {
2223     global history historyindex
2224
2225     if {$historyindex > 0
2226         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2227         return
2228     }
2229
2230     if {$historyindex < [llength $history]} {
2231         set history [lreplace $history $historyindex end $cmd]
2232     } else {
2233         lappend history $cmd
2234     }
2235     incr historyindex
2236     if {$historyindex > 1} {
2237         .ctop.top.bar.leftbut conf -state normal
2238     } else {
2239         .ctop.top.bar.leftbut conf -state disabled
2240     }
2241     .ctop.top.bar.rightbut conf -state disabled
2242 }
2243
2244 proc goback {} {
2245     global history historyindex
2246
2247     if {$historyindex > 1} {
2248         incr historyindex -1
2249         set cmd [lindex $history [expr {$historyindex - 1}]]
2250         eval $cmd
2251         .ctop.top.bar.rightbut conf -state normal
2252     }
2253     if {$historyindex <= 1} {
2254         .ctop.top.bar.leftbut conf -state disabled
2255     }
2256 }
2257
2258 proc goforw {} {
2259     global history historyindex
2260
2261     if {$historyindex < [llength $history]} {
2262         set cmd [lindex $history $historyindex]
2263         incr historyindex
2264         eval $cmd
2265         .ctop.top.bar.leftbut conf -state normal
2266     }
2267     if {$historyindex >= [llength $history]} {
2268         .ctop.top.bar.rightbut conf -state disabled
2269     }
2270 }
2271
2272 proc mergediff {id} {
2273     global parents diffmergeid diffmergegca mergefilelist diffpindex
2274
2275     set diffmergeid $id
2276     set diffpindex -1
2277     set diffmergegca [findgca $parents($id)]
2278     if {[info exists mergefilelist($id)]} {
2279         if {$mergefilelist($id) ne {}} {
2280             showmergediff
2281         }
2282     } else {
2283         contmergediff {}
2284     }
2285 }
2286
2287 proc findgca {ids} {
2288     set gca {}
2289     foreach id $ids {
2290         if {$gca eq {}} {
2291             set gca $id
2292         } else {
2293             if {[catch {
2294                 set gca [exec git-merge-base $gca $id]
2295             } err]} {
2296                 return {}
2297             }
2298         }
2299     }
2300     return $gca
2301 }
2302
2303 proc contmergediff {ids} {
2304     global diffmergeid diffpindex parents nparents diffmergegca
2305     global treediffs mergefilelist diffids treepending
2306
2307     # diff the child against each of the parents, and diff
2308     # each of the parents against the GCA.
2309     while 1 {
2310         if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} {
2311             set ids [list $diffmergegca [lindex $ids 0]]
2312         } else {
2313             if {[incr diffpindex] >= $nparents($diffmergeid)} break
2314             set p [lindex $parents($diffmergeid) $diffpindex]
2315             set ids [list $p $diffmergeid]
2316         }
2317         if {![info exists treediffs($ids)]} {
2318             set diffids $ids
2319             if {![info exists treepending]} {
2320                 gettreediffs $ids
2321             }
2322             return
2323         }
2324     }
2325
2326     # If a file in some parent is different from the child and also
2327     # different from the GCA, then it's interesting.
2328     # If we don't have a GCA, then a file is interesting if it is
2329     # different from the child in all the parents.
2330     if {$diffmergegca ne {}} {
2331         set files {}
2332         foreach p $parents($diffmergeid) {
2333             set gcadiffs $treediffs([list $diffmergegca $p])
2334             foreach f $treediffs([list $p $diffmergeid]) {
2335                 if {[lsearch -exact $files $f] < 0
2336                     && [lsearch -exact $gcadiffs $f] >= 0} {
2337                     lappend files $f
2338                 }
2339             }
2340         }
2341         set files [lsort $files]
2342     } else {
2343         set p [lindex $parents($diffmergeid) 0]
2344         set files $treediffs([list $diffmergeid $p])
2345         for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2346             set p [lindex $parents($diffmergeid) $i]
2347             set df $treediffs([list $p $diffmergeid])
2348             set nf {}
2349             foreach f $files {
2350                 if {[lsearch -exact $df $f] >= 0} {
2351                     lappend nf $f
2352                 }
2353             }
2354             set files $nf
2355         }
2356     }
2357
2358     set mergefilelist($diffmergeid) $files
2359     if {$files ne {}} {
2360         showmergediff
2361     }
2362 }
2363
2364 proc showmergediff {} {
2365     global cflist diffmergeid mergefilelist parents
2366     global diffopts diffinhunk currentfile currenthunk filelines
2367     global diffblocked groupfilelast mergefds groupfilenum grouphunks
2368
2369     set files $mergefilelist($diffmergeid)
2370     foreach f $files {
2371         $cflist insert end $f
2372     }
2373     set env(GIT_DIFF_OPTS) $diffopts
2374     set flist {}
2375     catch {unset currentfile}
2376     catch {unset currenthunk}
2377     catch {unset filelines}
2378     catch {unset groupfilenum}
2379     catch {unset grouphunks}
2380     set groupfilelast -1
2381     foreach p $parents($diffmergeid) {
2382         set cmd [list | git-diff-tree -p $p $diffmergeid]
2383         set cmd [concat $cmd $mergefilelist($diffmergeid)]
2384         if {[catch {set f [open $cmd r]} err]} {
2385             error_popup "Error getting diffs: $err"
2386             foreach f $flist {
2387                 catch {close $f}
2388             }
2389             return
2390         }
2391         lappend flist $f
2392         set ids [list $diffmergeid $p]
2393         set mergefds($ids) $f
2394         set diffinhunk($ids) 0
2395         set diffblocked($ids) 0
2396         fconfigure $f -blocking 0
2397         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2398     }
2399 }
2400
2401 proc getmergediffline {f ids id} {
2402     global diffmergeid diffinhunk diffoldlines diffnewlines
2403     global currentfile currenthunk
2404     global diffoldstart diffnewstart diffoldlno diffnewlno
2405     global diffblocked mergefilelist
2406     global noldlines nnewlines difflcounts filelines
2407
2408     set n [gets $f line]
2409     if {$n < 0} {
2410         if {![eof $f]} return
2411     }
2412
2413     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2414         if {$n < 0} {
2415             close $f
2416         }
2417         return
2418     }
2419
2420     if {$diffinhunk($ids) != 0} {
2421         set fi $currentfile($ids)
2422         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2423             # continuing an existing hunk
2424             set line [string range $line 1 end]
2425             set p [lindex $ids 1]
2426             if {$match eq "-" || $match eq " "} {
2427                 set filelines($p,$fi,$diffoldlno($ids)) $line
2428                 incr diffoldlno($ids)
2429             }
2430             if {$match eq "+" || $match eq " "} {
2431                 set filelines($id,$fi,$diffnewlno($ids)) $line
2432                 incr diffnewlno($ids)
2433             }
2434             if {$match eq " "} {
2435                 if {$diffinhunk($ids) == 2} {
2436                     lappend difflcounts($ids) \
2437                         [list $noldlines($ids) $nnewlines($ids)]
2438                     set noldlines($ids) 0
2439                     set diffinhunk($ids) 1
2440                 }
2441                 incr noldlines($ids)
2442             } elseif {$match eq "-" || $match eq "+"} {
2443                 if {$diffinhunk($ids) == 1} {
2444                     lappend difflcounts($ids) [list $noldlines($ids)]
2445                     set noldlines($ids) 0
2446                     set nnewlines($ids) 0
2447                     set diffinhunk($ids) 2
2448                 }
2449                 if {$match eq "-"} {
2450                     incr noldlines($ids)
2451                 } else {
2452                     incr nnewlines($ids)
2453                 }
2454             }
2455             # and if it's \ No newline at end of line, then what?
2456             return
2457         }
2458         # end of a hunk
2459         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2460             lappend difflcounts($ids) [list $noldlines($ids)]
2461         } elseif {$diffinhunk($ids) == 2
2462                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2463             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2464         }
2465         set currenthunk($ids) [list $currentfile($ids) \
2466                                    $diffoldstart($ids) $diffnewstart($ids) \
2467                                    $diffoldlno($ids) $diffnewlno($ids) \
2468                                    $difflcounts($ids)]
2469         set diffinhunk($ids) 0
2470         # -1 = need to block, 0 = unblocked, 1 = is blocked
2471         set diffblocked($ids) -1
2472         processhunks
2473         if {$diffblocked($ids) == -1} {
2474             fileevent $f readable {}
2475             set diffblocked($ids) 1
2476         }
2477     }
2478
2479     if {$n < 0} {
2480         # eof
2481         if {!$diffblocked($ids)} {
2482             close $f
2483             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2484             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2485             processhunks
2486         }
2487     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2488         # start of a new file
2489         set currentfile($ids) \
2490             [lsearch -exact $mergefilelist($diffmergeid) $fname]
2491     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2492                    $line match f1l f1c f2l f2c rest]} {
2493         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2494             # start of a new hunk
2495             if {$f1l == 0 && $f1c == 0} {
2496                 set f1l 1
2497             }
2498             if {$f2l == 0 && $f2c == 0} {
2499                 set f2l 1
2500             }
2501             set diffinhunk($ids) 1
2502             set diffoldstart($ids) $f1l
2503             set diffnewstart($ids) $f2l
2504             set diffoldlno($ids) $f1l
2505             set diffnewlno($ids) $f2l
2506             set difflcounts($ids) {}
2507             set noldlines($ids) 0
2508             set nnewlines($ids) 0
2509         }
2510     }
2511 }
2512
2513 proc processhunks {} {
2514     global diffmergeid parents nparents currenthunk
2515     global mergefilelist diffblocked mergefds
2516     global grouphunks grouplinestart grouplineend groupfilenum
2517
2518     set nfiles [llength $mergefilelist($diffmergeid)]
2519     while 1 {
2520         set fi $nfiles
2521         set lno 0
2522         # look for the earliest hunk
2523         foreach p $parents($diffmergeid) {
2524             set ids [list $diffmergeid $p]
2525             if {![info exists currenthunk($ids)]} return
2526             set i [lindex $currenthunk($ids) 0]
2527             set l [lindex $currenthunk($ids) 2]
2528             if {$i < $fi || ($i == $fi && $l < $lno)} {
2529                 set fi $i
2530                 set lno $l
2531                 set pi $p
2532             }
2533         }
2534
2535         if {$fi < $nfiles} {
2536             set ids [list $diffmergeid $pi]
2537             set hunk $currenthunk($ids)
2538             unset currenthunk($ids)
2539             if {$diffblocked($ids) > 0} {
2540                 fileevent $mergefds($ids) readable \
2541                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2542             }
2543             set diffblocked($ids) 0
2544
2545             if {[info exists groupfilenum] && $groupfilenum == $fi
2546                 && $lno <= $grouplineend} {
2547                 # add this hunk to the pending group
2548                 lappend grouphunks($pi) $hunk
2549                 set endln [lindex $hunk 4]
2550                 if {$endln > $grouplineend} {
2551                     set grouplineend $endln
2552                 }
2553                 continue
2554             }
2555         }
2556
2557         # succeeding stuff doesn't belong in this group, so
2558         # process the group now
2559         if {[info exists groupfilenum]} {
2560             processgroup
2561             unset groupfilenum
2562             unset grouphunks
2563         }
2564
2565         if {$fi >= $nfiles} break
2566
2567         # start a new group
2568         set groupfilenum $fi
2569         set grouphunks($pi) [list $hunk]
2570         set grouplinestart $lno
2571         set grouplineend [lindex $hunk 4]
2572     }
2573 }
2574
2575 proc processgroup {} {
2576     global groupfilelast groupfilenum difffilestart
2577     global mergefilelist diffmergeid ctext filelines
2578     global parents diffmergeid diffoffset
2579     global grouphunks grouplinestart grouplineend nparents
2580     global mergemax
2581
2582     $ctext conf -state normal
2583     set id $diffmergeid
2584     set f $groupfilenum
2585     if {$groupfilelast != $f} {
2586         $ctext insert end "\n"
2587         set here [$ctext index "end - 1c"]
2588         set difffilestart($f) $here
2589         set mark fmark.[expr {$f + 1}]
2590         $ctext mark set $mark $here
2591         $ctext mark gravity $mark left
2592         set header [lindex $mergefilelist($id) $f]
2593         set l [expr {(78 - [string length $header]) / 2}]
2594         set pad [string range "----------------------------------------" 1 $l]
2595         $ctext insert end "$pad $header $pad\n" filesep
2596         set groupfilelast $f
2597         foreach p $parents($id) {
2598             set diffoffset($p) 0
2599         }
2600     }
2601
2602     $ctext insert end "@@" msep
2603     set nlines [expr {$grouplineend - $grouplinestart}]
2604     set events {}
2605     set pnum 0
2606     foreach p $parents($id) {
2607         set startline [expr {$grouplinestart + $diffoffset($p)}]
2608         set ol $startline
2609         set nl $grouplinestart
2610         if {[info exists grouphunks($p)]} {
2611             foreach h $grouphunks($p) {
2612                 set l [lindex $h 2]
2613                 if {$nl < $l} {
2614                     for {} {$nl < $l} {incr nl} {
2615                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2616                         incr ol
2617                     }
2618                 }
2619                 foreach chunk [lindex $h 5] {
2620                     if {[llength $chunk] == 2} {
2621                         set olc [lindex $chunk 0]
2622                         set nlc [lindex $chunk 1]
2623                         set nnl [expr {$nl + $nlc}]
2624                         lappend events [list $nl $nnl $pnum $olc $nlc]
2625                         incr ol $olc
2626                         set nl $nnl
2627                     } else {
2628                         incr ol [lindex $chunk 0]
2629                         incr nl [lindex $chunk 0]
2630                     }
2631                 }
2632             }
2633         }
2634         if {$nl < $grouplineend} {
2635             for {} {$nl < $grouplineend} {incr nl} {
2636                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2637                 incr ol
2638             }
2639         }
2640         set nlines [expr {$ol - $startline}]
2641         $ctext insert end " -$startline,$nlines" msep
2642         incr pnum
2643     }
2644
2645     set nlines [expr {$grouplineend - $grouplinestart}]
2646     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2647
2648     set events [lsort -integer -index 0 $events]
2649     set nevents [llength $events]
2650     set nmerge $nparents($diffmergeid)
2651     set l $grouplinestart
2652     for {set i 0} {$i < $nevents} {set i $j} {
2653         set nl [lindex $events $i 0]
2654         while {$l < $nl} {
2655             $ctext insert end " $filelines($id,$f,$l)\n"
2656             incr l
2657         }
2658         set e [lindex $events $i]
2659         set enl [lindex $e 1]
2660         set j $i
2661         set active {}
2662         while 1 {
2663             set pnum [lindex $e 2]
2664             set olc [lindex $e 3]
2665             set nlc [lindex $e 4]
2666             if {![info exists delta($pnum)]} {
2667                 set delta($pnum) [expr {$olc - $nlc}]
2668                 lappend active $pnum
2669             } else {
2670                 incr delta($pnum) [expr {$olc - $nlc}]
2671             }
2672             if {[incr j] >= $nevents} break
2673             set e [lindex $events $j]
2674             if {[lindex $e 0] >= $enl} break
2675             if {[lindex $e 1] > $enl} {
2676                 set enl [lindex $e 1]
2677             }
2678         }
2679         set nlc [expr {$enl - $l}]
2680         set ncol mresult
2681         set bestpn -1
2682         if {[llength $active] == $nmerge - 1} {
2683             # no diff for one of the parents, i.e. it's identical
2684             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2685                 if {![info exists delta($pnum)]} {
2686                     if {$pnum < $mergemax} {
2687                         lappend ncol m$pnum
2688                     } else {
2689                         lappend ncol mmax
2690                     }
2691                     break
2692                 }
2693             }
2694         } elseif {[llength $active] == $nmerge} {
2695             # all parents are different, see if one is very similar
2696             set bestsim 30
2697             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2698                 set sim [similarity $pnum $l $nlc $f \
2699                              [lrange $events $i [expr {$j-1}]]]
2700                 if {$sim > $bestsim} {
2701                     set bestsim $sim
2702                     set bestpn $pnum
2703                 }
2704             }
2705             if {$bestpn >= 0} {
2706                 lappend ncol m$bestpn
2707             }
2708         }
2709         set pnum -1
2710         foreach p $parents($id) {
2711             incr pnum
2712             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2713             set olc [expr {$nlc + $delta($pnum)}]
2714             set ol [expr {$l + $diffoffset($p)}]
2715             incr diffoffset($p) $delta($pnum)
2716             unset delta($pnum)
2717             for {} {$olc > 0} {incr olc -1} {
2718                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2719                 incr ol
2720             }
2721         }
2722         set endl [expr {$l + $nlc}]
2723         if {$bestpn >= 0} {
2724             # show this pretty much as a normal diff
2725             set p [lindex $parents($id) $bestpn]
2726             set ol [expr {$l + $diffoffset($p)}]
2727             incr diffoffset($p) $delta($bestpn)
2728             unset delta($bestpn)
2729             for {set k $i} {$k < $j} {incr k} {
2730                 set e [lindex $events $k]
2731                 if {[lindex $e 2] != $bestpn} continue
2732                 set nl [lindex $e 0]
2733                 set ol [expr {$ol + $nl - $l}]
2734                 for {} {$l < $nl} {incr l} {
2735                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2736                 }
2737                 set c [lindex $e 3]
2738                 for {} {$c > 0} {incr c -1} {
2739                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2740                     incr ol
2741                 }
2742                 set nl [lindex $e 1]
2743                 for {} {$l < $nl} {incr l} {
2744                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2745                 }
2746             }
2747         }
2748         for {} {$l < $endl} {incr l} {
2749             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2750         }
2751     }
2752     while {$l < $grouplineend} {
2753         $ctext insert end " $filelines($id,$f,$l)\n"
2754         incr l
2755     }
2756     $ctext conf -state disabled
2757 }
2758
2759 proc similarity {pnum l nlc f events} {
2760     global diffmergeid parents diffoffset filelines
2761
2762     set id $diffmergeid
2763     set p [lindex $parents($id) $pnum]
2764     set ol [expr {$l + $diffoffset($p)}]
2765     set endl [expr {$l + $nlc}]
2766     set same 0
2767     set diff 0
2768     foreach e $events {
2769         if {[lindex $e 2] != $pnum} continue
2770         set nl [lindex $e 0]
2771         set ol [expr {$ol + $nl - $l}]
2772         for {} {$l < $nl} {incr l} {
2773             incr same [string length $filelines($id,$f,$l)]
2774             incr same
2775         }
2776         set oc [lindex $e 3]
2777         for {} {$oc > 0} {incr oc -1} {
2778             incr diff [string length $filelines($p,$f,$ol)]
2779             incr diff
2780             incr ol
2781         }
2782         set nl [lindex $e 1]
2783         for {} {$l < $nl} {incr l} {
2784             incr diff [string length $filelines($id,$f,$l)]
2785             incr diff
2786         }
2787     }
2788     for {} {$l < $endl} {incr l} {
2789         incr same [string length $filelines($id,$f,$l)]
2790         incr same
2791     }
2792     if {$same == 0} {
2793         return 0
2794     }
2795     return [expr {200 * $same / (2 * $same + $diff)}]
2796 }
2797
2798 proc startdiff {ids} {
2799     global treediffs diffids treepending diffmergeid
2800
2801     set diffids $ids
2802     catch {unset diffmergeid}
2803     if {![info exists treediffs($ids)]} {
2804         if {![info exists treepending]} {
2805             gettreediffs $ids
2806         }
2807     } else {
2808         addtocflist $ids
2809     }
2810 }
2811
2812 proc addtocflist {ids} {
2813     global treediffs cflist
2814     foreach f $treediffs($ids) {
2815         $cflist insert end $f
2816     }
2817     getblobdiffs $ids
2818 }
2819
2820 proc gettreediffs {ids} {
2821     global treediff parents treepending
2822     set treepending $ids
2823     set treediff {}
2824     if [catch {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return
2825     fconfigure $gdtf -blocking 0
2826     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2827 }
2828
2829 proc gettreediffline {gdtf ids} {
2830     global treediff treediffs treepending diffids diffmergeid
2831
2832     set n [gets $gdtf line]
2833     if {$n < 0} {
2834         if {![eof $gdtf]} return
2835         close $gdtf
2836         set treediffs($ids) $treediff
2837         unset treepending
2838         if {$ids != $diffids} {
2839             gettreediffs $diffids
2840         } else {
2841             if {[info exists diffmergeid]} {
2842                 contmergediff $ids
2843             } else {
2844                 addtocflist $ids
2845             }
2846         }
2847         return
2848     }
2849     set file [lindex $line 5]
2850     lappend treediff $file
2851 }
2852
2853 proc getblobdiffs {ids} {
2854     global diffopts blobdifffd diffids env curdifftag curtagstart
2855     global difffilestart nextupdate diffinhdr treediffs
2856
2857     set env(GIT_DIFF_OPTS) $diffopts
2858     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2859     if {[catch {set bdf [open $cmd r]} err]} {
2860         puts "error getting diffs: $err"
2861         return
2862     }
2863     set diffinhdr 0
2864     fconfigure $bdf -blocking 0
2865     set blobdifffd($ids) $bdf
2866     set curdifftag Comments
2867     set curtagstart 0.0
2868     catch {unset difffilestart}
2869     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2870     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2871 }
2872
2873 proc getblobdiffline {bdf ids} {
2874     global diffids blobdifffd ctext curdifftag curtagstart
2875     global diffnexthead diffnextnote difffilestart
2876     global nextupdate diffinhdr treediffs
2877
2878     set n [gets $bdf line]
2879     if {$n < 0} {
2880         if {[eof $bdf]} {
2881             close $bdf
2882             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2883                 $ctext tag add $curdifftag $curtagstart end
2884             }
2885         }
2886         return
2887     }
2888     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2889         return
2890     }
2891     $ctext conf -state normal
2892     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2893         # start of a new file
2894         $ctext insert end "\n"
2895         $ctext tag add $curdifftag $curtagstart end
2896         set curtagstart [$ctext index "end - 1c"]
2897         set header $newname
2898         set here [$ctext index "end - 1c"]
2899         set i [lsearch -exact $treediffs($diffids) $fname]
2900         if {$i >= 0} {
2901             set difffilestart($i) $here
2902             incr i
2903             $ctext mark set fmark.$i $here
2904             $ctext mark gravity fmark.$i left
2905         }
2906         if {$newname != $fname} {
2907             set i [lsearch -exact $treediffs($diffids) $newname]
2908             if {$i >= 0} {
2909                 set difffilestart($i) $here
2910                 incr i
2911                 $ctext mark set fmark.$i $here
2912                 $ctext mark gravity fmark.$i left
2913             }
2914         }
2915         set curdifftag "f:$fname"
2916         $ctext tag delete $curdifftag
2917         set l [expr {(78 - [string length $header]) / 2}]
2918         set pad [string range "----------------------------------------" 1 $l]
2919         $ctext insert end "$pad $header $pad\n" filesep
2920         set diffinhdr 1
2921     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2922         set diffinhdr 0
2923     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2924                    $line match f1l f1c f2l f2c rest]} {
2925         $ctext insert end "$line\n" hunksep
2926         set diffinhdr 0
2927     } else {
2928         set x [string range $line 0 0]
2929         if {$x == "-" || $x == "+"} {
2930             set tag [expr {$x == "+"}]
2931             $ctext insert end "$line\n" d$tag
2932         } elseif {$x == " "} {
2933             $ctext insert end "$line\n"
2934         } elseif {$diffinhdr || $x == "\\"} {
2935             # e.g. "\ No newline at end of file"
2936             $ctext insert end "$line\n" filesep
2937         } else {
2938             # Something else we don't recognize
2939             if {$curdifftag != "Comments"} {
2940                 $ctext insert end "\n"
2941                 $ctext tag add $curdifftag $curtagstart end
2942                 set curtagstart [$ctext index "end - 1c"]
2943                 set curdifftag Comments
2944             }
2945             $ctext insert end "$line\n" filesep
2946         }
2947     }
2948     $ctext conf -state disabled
2949     if {[clock clicks -milliseconds] >= $nextupdate} {
2950         incr nextupdate 100
2951         fileevent $bdf readable {}
2952         update
2953         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2954     }
2955 }
2956
2957 proc nextfile {} {
2958     global difffilestart ctext
2959     set here [$ctext index @0,0]
2960     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2961         if {[$ctext compare $difffilestart($i) > $here]} {
2962             if {![info exists pos]
2963                 || [$ctext compare $difffilestart($i) < $pos]} {
2964                 set pos $difffilestart($i)
2965             }
2966         }
2967     }
2968     if {[info exists pos]} {
2969         $ctext yview $pos
2970     }
2971 }
2972
2973 proc listboxsel {} {
2974     global ctext cflist currentid
2975     if {![info exists currentid]} return
2976     set sel [lsort [$cflist curselection]]
2977     if {$sel eq {}} return
2978     set first [lindex $sel 0]
2979     catch {$ctext yview fmark.$first}
2980 }
2981
2982 proc setcoords {} {
2983     global linespc charspc canvx0 canvy0 mainfont
2984     global xspc1 xspc2 lthickness
2985
2986     set linespc [font metrics $mainfont -linespace]
2987     set charspc [font measure $mainfont "m"]
2988     set canvy0 [expr {3 + 0.5 * $linespc}]
2989     set canvx0 [expr {3 + 0.5 * $linespc}]
2990     set lthickness [expr {int($linespc / 9) + 1}]
2991     set xspc1(0) $linespc
2992     set xspc2 $linespc
2993 }
2994
2995 proc redisplay {} {
2996     global stopped redisplaying phase
2997     if {$stopped > 1} return
2998     if {$phase == "getcommits"} return
2999     set redisplaying 1
3000     if {$phase == "drawgraph" || $phase == "incrdraw"} {
3001         set stopped 1
3002     } else {
3003         drawgraph
3004     }
3005 }
3006
3007 proc incrfont {inc} {
3008     global mainfont namefont textfont ctext canv phase
3009     global stopped entries
3010     unmarkmatches
3011     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3012     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3013     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3014     setcoords
3015     $ctext conf -font $textfont
3016     $ctext tag conf filesep -font [concat $textfont bold]
3017     foreach e $entries {
3018         $e conf -font $mainfont
3019     }
3020     if {$phase == "getcommits"} {
3021         $canv itemconf textitems -font $mainfont
3022     }
3023     redisplay
3024 }
3025
3026 proc clearsha1 {} {
3027     global sha1entry sha1string
3028     if {[string length $sha1string] == 40} {
3029         $sha1entry delete 0 end
3030     }
3031 }
3032
3033 proc sha1change {n1 n2 op} {
3034     global sha1string currentid sha1but
3035     if {$sha1string == {}
3036         || ([info exists currentid] && $sha1string == $currentid)} {
3037         set state disabled
3038     } else {
3039         set state normal
3040     }
3041     if {[$sha1but cget -state] == $state} return
3042     if {$state == "normal"} {
3043         $sha1but conf -state normal -relief raised -text "Goto: "
3044     } else {
3045         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3046     }
3047 }
3048
3049 proc gotocommit {} {
3050     global sha1string currentid idline tagids
3051     global lineid numcommits
3052
3053     if {$sha1string == {}
3054         || ([info exists currentid] && $sha1string == $currentid)} return
3055     if {[info exists tagids($sha1string)]} {
3056         set id $tagids($sha1string)
3057     } else {
3058         set id [string tolower $sha1string]
3059         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3060             set matches {}
3061             for {set l 0} {$l < $numcommits} {incr l} {
3062                 if {[string match $id* $lineid($l)]} {
3063                     lappend matches $lineid($l)
3064                 }
3065             }
3066             if {$matches ne {}} {
3067                 if {[llength $matches] > 1} {
3068                     error_popup "Short SHA1 id $id is ambiguous"
3069                     return
3070                 }
3071                 set id [lindex $matches 0]
3072             }
3073         }
3074     }
3075     if {[info exists idline($id)]} {
3076         selectline $idline($id) 1
3077         return
3078     }
3079     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3080         set type "SHA1 id"
3081     } else {
3082         set type "Tag"
3083     }
3084     error_popup "$type $sha1string is not known"
3085 }
3086
3087 proc lineenter {x y id} {
3088     global hoverx hovery hoverid hovertimer
3089     global commitinfo canv
3090
3091     if {![info exists commitinfo($id)]} return
3092     set hoverx $x
3093     set hovery $y
3094     set hoverid $id
3095     if {[info exists hovertimer]} {
3096         after cancel $hovertimer
3097     }
3098     set hovertimer [after 500 linehover]
3099     $canv delete hover
3100 }
3101
3102 proc linemotion {x y id} {
3103     global hoverx hovery hoverid hovertimer
3104
3105     if {[info exists hoverid] && $id == $hoverid} {
3106         set hoverx $x
3107         set hovery $y
3108         if {[info exists hovertimer]} {
3109             after cancel $hovertimer
3110         }
3111         set hovertimer [after 500 linehover]
3112     }
3113 }
3114
3115 proc lineleave {id} {
3116     global hoverid hovertimer canv
3117
3118     if {[info exists hoverid] && $id == $hoverid} {
3119         $canv delete hover
3120         if {[info exists hovertimer]} {
3121             after cancel $hovertimer
3122             unset hovertimer
3123         }
3124         unset hoverid
3125     }
3126 }
3127
3128 proc linehover {} {
3129     global hoverx hovery hoverid hovertimer
3130     global canv linespc lthickness
3131     global commitinfo mainfont
3132
3133     set text [lindex $commitinfo($hoverid) 0]
3134     set ymax [lindex [$canv cget -scrollregion] 3]
3135     if {$ymax == {}} return
3136     set yfrac [lindex [$canv yview] 0]
3137     set x [expr {$hoverx + 2 * $linespc}]
3138     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3139     set x0 [expr {$x - 2 * $lthickness}]
3140     set y0 [expr {$y - 2 * $lthickness}]
3141     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3142     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3143     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3144                -fill \#ffff80 -outline black -width 1 -tags hover]
3145     $canv raise $t
3146     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3147     $canv raise $t
3148 }
3149
3150 proc clickisonarrow {id y} {
3151     global mainline mainlinearrow sidelines lthickness
3152
3153     set thresh [expr {2 * $lthickness + 6}]
3154     if {[info exists mainline($id)]} {
3155         if {$mainlinearrow($id) ne "none"} {
3156             if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3157                 return "up"
3158             }
3159         }
3160     }
3161     if {[info exists sidelines($id)]} {
3162         foreach ls $sidelines($id) {
3163             set coords [lindex $ls 0]
3164             set arrow [lindex $ls 2]
3165             if {$arrow eq "first" || $arrow eq "both"} {
3166                 if {abs([lindex $coords 1] - $y) < $thresh} {
3167                     return "up"
3168                 }
3169             }
3170             if {$arrow eq "last" || $arrow eq "both"} {
3171                 if {abs([lindex $coords end] - $y) < $thresh} {
3172                     return "down"
3173                 }
3174             }
3175         }
3176     }
3177     return {}
3178 }
3179
3180 proc arrowjump {id dirn y} {
3181     global mainline sidelines canv canv2 canv3
3182
3183     set yt {}
3184     if {$dirn eq "down"} {
3185         if {[info exists mainline($id)]} {
3186             set y1 [lindex $mainline($id) 1]
3187             if {$y1 > $y} {
3188                 set yt $y1
3189             }
3190         }
3191         if {[info exists sidelines($id)]} {
3192             foreach ls $sidelines($id) {
3193                 set y1 [lindex $ls 0 1]
3194                 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3195                     set yt $y1
3196                 }
3197             }
3198         }
3199     } else {
3200         if {[info exists sidelines($id)]} {
3201             foreach ls $sidelines($id) {
3202                 set y1 [lindex $ls 0 end]
3203                 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3204                     set yt $y1
3205                 }
3206             }
3207         }
3208     }
3209     if {$yt eq {}} return
3210     set ymax [lindex [$canv cget -scrollregion] 3]
3211     if {$ymax eq {} || $ymax <= 0} return
3212     set view [$canv yview]
3213     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3214     set yfrac [expr {$yt / $ymax - $yspan / 2}]
3215     if {$yfrac < 0} {
3216         set yfrac 0
3217     }
3218     $canv yview moveto $yfrac
3219     $canv2 yview moveto $yfrac
3220     $canv3 yview moveto $yfrac
3221 }
3222
3223 proc lineclick {x y id isnew} {
3224     global ctext commitinfo children cflist canv thickerline
3225
3226     unmarkmatches
3227     unselectline
3228     normalline
3229     $canv delete hover
3230     # draw this line thicker than normal
3231     drawlines $id 1 1
3232     set thickerline $id
3233     if {$isnew} {
3234         set ymax [lindex [$canv cget -scrollregion] 3]
3235         if {$ymax eq {}} return
3236         set yfrac [lindex [$canv yview] 0]
3237         set y [expr {$y + $yfrac * $ymax}]
3238     }
3239     set dirn [clickisonarrow $id $y]
3240     if {$dirn ne {}} {
3241         arrowjump $id $dirn $y
3242         return
3243     }
3244
3245     if {$isnew} {
3246         addtohistory [list lineclick $x $y $id 0]
3247     }
3248     # fill the details pane with info about this line
3249     $ctext conf -state normal
3250     $ctext delete 0.0 end
3251     $ctext tag conf link -foreground blue -underline 1
3252     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3253     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3254     $ctext insert end "Parent:\t"
3255     $ctext insert end $id [list link link0]
3256     $ctext tag bind link0 <1> [list selbyid $id]
3257     set info $commitinfo($id)
3258     $ctext insert end "\n\t[lindex $info 0]\n"
3259     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3260     set date [formatdate [lindex $info 2]]
3261     $ctext insert end "\tDate:\t$date\n"
3262     if {[info exists children($id)]} {
3263         $ctext insert end "\nChildren:"
3264         set i 0
3265         foreach child $children($id) {
3266             incr i
3267             set info $commitinfo($child)
3268             $ctext insert end "\n\t"
3269             $ctext insert end $child [list link link$i]
3270             $ctext tag bind link$i <1> [list selbyid $child]
3271             $ctext insert end "\n\t[lindex $info 0]"
3272             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3273             set date [formatdate [lindex $info 2]]
3274             $ctext insert end "\n\tDate:\t$date\n"
3275         }
3276     }
3277     $ctext conf -state disabled
3278
3279     $cflist delete 0 end
3280 }
3281
3282 proc normalline {} {
3283     global thickerline
3284     if {[info exists thickerline]} {
3285         drawlines $thickerline 0 1
3286         unset thickerline
3287     }
3288 }
3289
3290 proc selbyid {id} {
3291     global idline
3292     if {[info exists idline($id)]} {
3293         selectline $idline($id) 1
3294     }
3295 }
3296
3297 proc mstime {} {
3298     global startmstime
3299     if {![info exists startmstime]} {
3300         set startmstime [clock clicks -milliseconds]
3301     }
3302     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3303 }
3304
3305 proc rowmenu {x y id} {
3306     global rowctxmenu idline selectedline rowmenuid
3307
3308     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3309         set state disabled
3310     } else {
3311         set state normal
3312     }
3313     $rowctxmenu entryconfigure 0 -state $state
3314     $rowctxmenu entryconfigure 1 -state $state
3315     $rowctxmenu entryconfigure 2 -state $state
3316     set rowmenuid $id
3317     tk_popup $rowctxmenu $x $y
3318 }
3319
3320 proc diffvssel {dirn} {
3321     global rowmenuid selectedline lineid
3322
3323     if {![info exists selectedline]} return
3324     if {$dirn} {
3325         set oldid $lineid($selectedline)
3326         set newid $rowmenuid
3327     } else {
3328         set oldid $rowmenuid
3329         set newid $lineid($selectedline)
3330     }
3331     addtohistory [list doseldiff $oldid $newid]
3332     doseldiff $oldid $newid
3333 }
3334
3335 proc doseldiff {oldid newid} {
3336     global ctext cflist
3337     global commitinfo
3338
3339     $ctext conf -state normal
3340     $ctext delete 0.0 end
3341     $ctext mark set fmark.0 0.0
3342     $ctext mark gravity fmark.0 left
3343     $cflist delete 0 end
3344     $cflist insert end "Top"
3345     $ctext insert end "From "
3346     $ctext tag conf link -foreground blue -underline 1
3347     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3348     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3349     $ctext tag bind link0 <1> [list selbyid $oldid]
3350     $ctext insert end $oldid [list link link0]
3351     $ctext insert end "\n     "
3352     $ctext insert end [lindex $commitinfo($oldid) 0]
3353     $ctext insert end "\n\nTo   "
3354     $ctext tag bind link1 <1> [list selbyid $newid]
3355     $ctext insert end $newid [list link link1]
3356     $ctext insert end "\n     "
3357     $ctext insert end [lindex $commitinfo($newid) 0]
3358     $ctext insert end "\n"
3359     $ctext conf -state disabled
3360     $ctext tag delete Comments
3361     $ctext tag remove found 1.0 end
3362     startdiff [list $oldid $newid]
3363 }
3364
3365 proc mkpatch {} {
3366     global rowmenuid currentid commitinfo patchtop patchnum
3367
3368     if {![info exists currentid]} return
3369     set oldid $currentid
3370     set oldhead [lindex $commitinfo($oldid) 0]
3371     set newid $rowmenuid
3372     set newhead [lindex $commitinfo($newid) 0]
3373     set top .patch
3374     set patchtop $top
3375     catch {destroy $top}
3376     toplevel $top
3377     label $top.title -text "Generate patch"
3378     grid $top.title - -pady 10
3379     label $top.from -text "From:"
3380     entry $top.fromsha1 -width 40 -relief flat
3381     $top.fromsha1 insert 0 $oldid
3382     $top.fromsha1 conf -state readonly
3383     grid $top.from $top.fromsha1 -sticky w
3384     entry $top.fromhead -width 60 -relief flat
3385     $top.fromhead insert 0 $oldhead
3386     $top.fromhead conf -state readonly
3387     grid x $top.fromhead -sticky w
3388     label $top.to -text "To:"
3389     entry $top.tosha1 -width 40 -relief flat
3390     $top.tosha1 insert 0 $newid
3391     $top.tosha1 conf -state readonly
3392     grid $top.to $top.tosha1 -sticky w
3393     entry $top.tohead -width 60 -relief flat
3394     $top.tohead insert 0 $newhead
3395     $top.tohead conf -state readonly
3396     grid x $top.tohead -sticky w
3397     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3398     grid $top.rev x -pady 10
3399     label $top.flab -text "Output file:"
3400     entry $top.fname -width 60
3401     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3402     incr patchnum
3403     grid $top.flab $top.fname -sticky w
3404     frame $top.buts
3405     button $top.buts.gen -text "Generate" -command mkpatchgo
3406     button $top.buts.can -text "Cancel" -command mkpatchcan
3407     grid $top.buts.gen $top.buts.can
3408     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3409     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3410     grid $top.buts - -pady 10 -sticky ew
3411     focus $top.fname
3412 }
3413
3414 proc mkpatchrev {} {
3415     global patchtop
3416
3417     set oldid [$patchtop.fromsha1 get]
3418     set oldhead [$patchtop.fromhead get]
3419     set newid [$patchtop.tosha1 get]
3420     set newhead [$patchtop.tohead get]
3421     foreach e [list fromsha1 fromhead tosha1 tohead] \
3422             v [list $newid $newhead $oldid $oldhead] {
3423         $patchtop.$e conf -state normal
3424         $patchtop.$e delete 0 end
3425         $patchtop.$e insert 0 $v
3426         $patchtop.$e conf -state readonly
3427     }
3428 }
3429
3430 proc mkpatchgo {} {
3431     global patchtop
3432
3433     set oldid [$patchtop.fromsha1 get]
3434     set newid [$patchtop.tosha1 get]
3435     set fname [$patchtop.fname get]
3436     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3437         error_popup "Error creating patch: $err"
3438     }
3439     catch {destroy $patchtop}
3440     unset patchtop
3441 }
3442
3443 proc mkpatchcan {} {
3444     global patchtop
3445
3446     catch {destroy $patchtop}
3447     unset patchtop
3448 }
3449
3450 proc mktag {} {
3451     global rowmenuid mktagtop commitinfo
3452
3453     set top .maketag
3454     set mktagtop $top
3455     catch {destroy $top}
3456     toplevel $top
3457     label $top.title -text "Create tag"
3458     grid $top.title - -pady 10
3459     label $top.id -text "ID:"
3460     entry $top.sha1 -width 40 -relief flat
3461     $top.sha1 insert 0 $rowmenuid
3462     $top.sha1 conf -state readonly
3463     grid $top.id $top.sha1 -sticky w
3464     entry $top.head -width 60 -relief flat
3465     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3466     $top.head conf -state readonly
3467     grid x $top.head -sticky w
3468     label $top.tlab -text "Tag name:"
3469     entry $top.tag -width 60
3470     grid $top.tlab $top.tag -sticky w
3471     frame $top.buts
3472     button $top.buts.gen -text "Create" -command mktaggo
3473     button $top.buts.can -text "Cancel" -command mktagcan
3474     grid $top.buts.gen $top.buts.can
3475     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3476     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3477     grid $top.buts - -pady 10 -sticky ew
3478     focus $top.tag
3479 }
3480
3481 proc domktag {} {
3482     global mktagtop env tagids idtags
3483
3484     set id [$mktagtop.sha1 get]
3485     set tag [$mktagtop.tag get]
3486     if {$tag == {}} {
3487         error_popup "No tag name specified"
3488         return
3489     }
3490     if {[info exists tagids($tag)]} {
3491         error_popup "Tag \"$tag\" already exists"
3492         return
3493     }
3494     if {[catch {
3495         set dir [gitdir]
3496         set fname [file join $dir "refs/tags" $tag]
3497         set f [open $fname w]
3498         puts $f $id
3499         close $f
3500     } err]} {
3501         error_popup "Error creating tag: $err"
3502         return
3503     }
3504
3505     set tagids($tag) $id
3506     lappend idtags($id) $tag
3507     redrawtags $id
3508 }
3509
3510 proc redrawtags {id} {
3511     global canv linehtag idline idpos selectedline
3512
3513     if {![info exists idline($id)]} return
3514     $canv delete tag.$id
3515     set xt [eval drawtags $id $idpos($id)]
3516     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3517     if {[info exists selectedline] && $selectedline == $idline($id)} {
3518         selectline $selectedline 0
3519     }
3520 }
3521
3522 proc mktagcan {} {
3523     global mktagtop
3524
3525     catch {destroy $mktagtop}
3526     unset mktagtop
3527 }
3528
3529 proc mktaggo {} {
3530     domktag
3531     mktagcan
3532 }
3533
3534 proc writecommit {} {
3535     global rowmenuid wrcomtop commitinfo wrcomcmd
3536
3537     set top .writecommit
3538     set wrcomtop $top
3539     catch {destroy $top}
3540     toplevel $top
3541     label $top.title -text "Write commit to file"
3542     grid $top.title - -pady 10
3543     label $top.id -text "ID:"
3544     entry $top.sha1 -width 40 -relief flat
3545     $top.sha1 insert 0 $rowmenuid
3546     $top.sha1 conf -state readonly
3547     grid $top.id $top.sha1 -sticky w
3548     entry $top.head -width 60 -relief flat
3549     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3550     $top.head conf -state readonly
3551     grid x $top.head -sticky w
3552     label $top.clab -text "Command:"
3553     entry $top.cmd -width 60 -textvariable wrcomcmd
3554     grid $top.clab $top.cmd -sticky w -pady 10
3555     label $top.flab -text "Output file:"
3556     entry $top.fname -width 60
3557     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3558     grid $top.flab $top.fname -sticky w
3559     frame $top.buts
3560     button $top.buts.gen -text "Write" -command wrcomgo
3561     button $top.buts.can -text "Cancel" -command wrcomcan
3562     grid $top.buts.gen $top.buts.can
3563     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3564     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3565     grid $top.buts - -pady 10 -sticky ew
3566     focus $top.fname
3567 }
3568
3569 proc wrcomgo {} {
3570     global wrcomtop
3571
3572     set id [$wrcomtop.sha1 get]
3573     set cmd "echo $id | [$wrcomtop.cmd get]"
3574     set fname [$wrcomtop.fname get]
3575     if {[catch {exec sh -c $cmd >$fname &} err]} {
3576         error_popup "Error writing commit: $err"
3577     }
3578     catch {destroy $wrcomtop}
3579     unset wrcomtop
3580 }
3581
3582 proc wrcomcan {} {
3583     global wrcomtop
3584
3585     catch {destroy $wrcomtop}
3586     unset wrcomtop
3587 }
3588
3589 proc listrefs {id} {
3590     global idtags idheads idotherrefs
3591
3592     set x {}
3593     if {[info exists idtags($id)]} {
3594         set x $idtags($id)
3595     }
3596     set y {}
3597     if {[info exists idheads($id)]} {
3598         set y $idheads($id)
3599     }
3600     set z {}
3601     if {[info exists idotherrefs($id)]} {
3602         set z $idotherrefs($id)
3603     }
3604     return [list $x $y $z]
3605 }
3606
3607 proc rereadrefs {} {
3608     global idtags idheads idotherrefs
3609     global tagids headids otherrefids
3610
3611     set refids [concat [array names idtags] \
3612                     [array names idheads] [array names idotherrefs]]
3613     foreach id $refids {
3614         if {![info exists ref($id)]} {
3615             set ref($id) [listrefs $id]
3616         }
3617     }
3618     readrefs
3619     set refids [lsort -unique [concat $refids [array names idtags] \
3620                         [array names idheads] [array names idotherrefs]]]
3621     foreach id $refids {
3622         set v [listrefs $id]
3623         if {![info exists ref($id)] || $ref($id) != $v} {
3624             redrawtags $id
3625         }
3626     }
3627 }
3628
3629 proc updatecommits {rargs} {
3630     global commitlisted commfd phase
3631     global startmsecs nextupdate ncmupdate
3632     global idtags idheads idotherrefs
3633     global leftover
3634     global parsed_args
3635     global canv
3636     global oldcommits commits
3637     global parents nchildren children ncleft
3638
3639     set old_args $parsed_args
3640     parse_args $rargs
3641
3642     foreach id $old_args {
3643         if {![regexp {^[0-9a-f]{40}$} $id]} continue
3644         if {[info exists oldref($id)]} continue
3645         set oldref($id) $id
3646         lappend ignoreold "^$id"
3647     }
3648     foreach id $parsed_args {
3649         if {![regexp {^[0-9a-f]{40}$} $id]} continue
3650         if {[info exists ref($id)]} continue
3651         set ref($id) $id
3652         lappend ignorenew "^$id"
3653     }
3654
3655     foreach a $old_args {
3656         if {![info exists ref($a)]} {
3657             lappend ignorenew $a
3658         }
3659     }
3660
3661     set phase updatecommits
3662     set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ]
3663     if {[llength $removed_commits] > 0} {
3664         $canv delete all
3665         set oldcommits {}
3666         foreach c $commits {
3667             if {[lsearch $c $removed_commits] < 0} {
3668                 lappend oldcommits $c
3669             } else {
3670                 unset commitlisted($c)
3671             }
3672         }
3673         set commits {}
3674         unset children
3675         unset nchildren
3676         set phase removecommits
3677     }
3678
3679     set args {}
3680     foreach a $parsed_args {
3681         if {![info exists oldref($a)]} {
3682             lappend args $a
3683         }
3684     }
3685
3686     readrefs
3687     if [catch {
3688         set commfd [open "|git-rev-list --header --topo-order --parents $ignoreold $args" r]
3689     } err] {
3690         puts stderr "Error executing git-rev-list: $err"
3691         exit 1
3692     }
3693     set startmsecs [clock clicks -milliseconds]
3694     set nextupdate [expr $startmsecs + 100]
3695     set ncmupdate 1
3696     set leftover {}
3697     fconfigure $commfd -blocking 0 -translation lf
3698     fileevent $commfd readable [list getcommitlines $commfd]
3699     . config -cursor watch
3700     settextcursor watch
3701 }
3702
3703 proc showtag {tag isnew} {
3704     global ctext cflist tagcontents tagids linknum
3705
3706     if {$isnew} {
3707         addtohistory [list showtag $tag 0]
3708     }
3709     $ctext conf -state normal
3710     $ctext delete 0.0 end
3711     set linknum 0
3712     if {[info exists tagcontents($tag)]} {
3713         set text $tagcontents($tag)
3714     } else {
3715         set text "Tag: $tag\nId:  $tagids($tag)"
3716     }
3717     appendwithlinks $text
3718     $ctext conf -state disabled
3719     $cflist delete 0 end
3720 }
3721
3722 proc doquit {} {
3723     global stopped
3724     set stopped 100
3725     destroy .
3726 }
3727
3728 proc doprefs {} {
3729     global maxwidth maxgraphpct diffopts findmergefiles
3730     global oldprefs prefstop
3731
3732     set top .gitkprefs
3733     set prefstop $top
3734     if {[winfo exists $top]} {
3735         raise $top
3736         return
3737     }
3738     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3739         set oldprefs($v) [set $v]
3740     }
3741     toplevel $top
3742     wm title $top "Gitk preferences"
3743     label $top.ldisp -text "Commit list display options"
3744     grid $top.ldisp - -sticky w -pady 10
3745     label $top.spacer -text " "
3746     label $top.maxwidthl -text "Maximum graph width (lines)" \
3747         -font optionfont
3748     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3749     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3750     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3751         -font optionfont
3752     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3753     grid x $top.maxpctl $top.maxpct -sticky w
3754     checkbutton $top.findm -variable findmergefiles
3755     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3756         -font optionfont
3757     grid $top.findm $top.findml - -sticky w
3758     label $top.ddisp -text "Diff display options"
3759     grid $top.ddisp - -sticky w -pady 10
3760     label $top.diffoptl -text "Options for diff program" \
3761         -font optionfont
3762     entry $top.diffopt -width 20 -textvariable diffopts
3763     grid x $top.diffoptl $top.diffopt -sticky w
3764     frame $top.buts
3765     button $top.buts.ok -text "OK" -command prefsok
3766     button $top.buts.can -text "Cancel" -command prefscan
3767     grid $top.buts.ok $top.buts.can
3768     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3769     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3770     grid $top.buts - - -pady 10 -sticky ew
3771 }
3772
3773 proc prefscan {} {
3774     global maxwidth maxgraphpct diffopts findmergefiles
3775     global oldprefs prefstop
3776
3777     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3778         set $v $oldprefs($v)
3779     }
3780     catch {destroy $prefstop}
3781     unset prefstop
3782 }
3783
3784 proc prefsok {} {
3785     global maxwidth maxgraphpct
3786     global oldprefs prefstop
3787
3788     catch {destroy $prefstop}
3789     unset prefstop
3790     if {$maxwidth != $oldprefs(maxwidth)
3791         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3792         redisplay
3793     }
3794 }
3795
3796 proc formatdate {d} {
3797     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3798 }
3799
3800 # defaults...
3801 set datemode 0
3802 set diffopts "-U 5 -p"
3803 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3804
3805 set gitencoding ""
3806 catch {
3807     set gitencoding [exec git-repo-config --get i18n.commitencoding]
3808 }
3809 if {$gitencoding == ""} {
3810         set gitencoding "utf-8"
3811 }
3812
3813 set mainfont {Helvetica 9}
3814 set textfont {Courier 9}
3815 set findmergefiles 0
3816 set maxgraphpct 50
3817 set maxwidth 16
3818 set revlistorder 0
3819 set fastdate 0
3820
3821 set colors {green red blue magenta darkgrey brown orange}
3822
3823 catch {source ~/.gitk}
3824
3825 set namefont $mainfont
3826
3827 font create optionfont -family sans-serif -size -12
3828
3829 set revtreeargs {}
3830 foreach arg $argv {
3831     switch -regexp -- $arg {
3832         "^$" { }
3833         "^-d" { set datemode 1 }
3834         "^-r" { set revlistorder 1 }
3835         default {
3836             lappend revtreeargs $arg
3837         }
3838     }
3839 }
3840
3841 set history {}
3842 set historyindex 0
3843
3844 set stopped 0
3845 set redisplaying 0
3846 set stuffsaved 0
3847 set patchnum 0
3848 setcoords
3849 makewindow $revtreeargs
3850 readrefs
3851 getcommits $revtreeargs