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