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