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 \
2916          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2917         ]} return
2918     fconfigure $gdtf -blocking 0
2919     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2920 }
2921
2922 proc gettreediffline {gdtf ids} {
2923     global treediff treediffs treepending diffids diffmergeid
2924
2925     set n [gets $gdtf line]
2926     if {$n < 0} {
2927         if {![eof $gdtf]} return
2928         close $gdtf
2929         set treediffs($ids) $treediff
2930         unset treepending
2931         if {$ids != $diffids} {
2932             gettreediffs $diffids
2933         } else {
2934             if {[info exists diffmergeid]} {
2935                 contmergediff $ids
2936             } else {
2937                 addtocflist $ids
2938             }
2939         }
2940         return
2941     }
2942     set file [lindex $line 5]
2943     lappend treediff $file
2944 }
2945
2946 proc getblobdiffs {ids} {
2947     global diffopts blobdifffd diffids env curdifftag curtagstart
2948     global difffilestart nextupdate diffinhdr treediffs
2949
2950     set env(GIT_DIFF_OPTS) $diffopts
2951     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2952     if {[catch {set bdf [open $cmd r]} err]} {
2953         puts "error getting diffs: $err"
2954         return
2955     }
2956     set diffinhdr 0
2957     fconfigure $bdf -blocking 0
2958     set blobdifffd($ids) $bdf
2959     set curdifftag Comments
2960     set curtagstart 0.0
2961     catch {unset difffilestart}
2962     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2963     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2964 }
2965
2966 proc getblobdiffline {bdf ids} {
2967     global diffids blobdifffd ctext curdifftag curtagstart
2968     global diffnexthead diffnextnote difffilestart
2969     global nextupdate diffinhdr treediffs
2970
2971     set n [gets $bdf line]
2972     if {$n < 0} {
2973         if {[eof $bdf]} {
2974             close $bdf
2975             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2976                 $ctext tag add $curdifftag $curtagstart end
2977             }
2978         }
2979         return
2980     }
2981     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2982         return
2983     }
2984     $ctext conf -state normal
2985     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2986         # start of a new file
2987         $ctext insert end "\n"
2988         $ctext tag add $curdifftag $curtagstart end
2989         set curtagstart [$ctext index "end - 1c"]
2990         set header $newname
2991         set here [$ctext index "end - 1c"]
2992         set i [lsearch -exact $treediffs($diffids) $fname]
2993         if {$i >= 0} {
2994             set difffilestart($i) $here
2995             incr i
2996             $ctext mark set fmark.$i $here
2997             $ctext mark gravity fmark.$i left
2998         }
2999         if {$newname != $fname} {
3000             set i [lsearch -exact $treediffs($diffids) $newname]
3001             if {$i >= 0} {
3002                 set difffilestart($i) $here
3003                 incr i
3004                 $ctext mark set fmark.$i $here
3005                 $ctext mark gravity fmark.$i left
3006             }
3007         }
3008         set curdifftag "f:$fname"
3009         $ctext tag delete $curdifftag
3010         set l [expr {(78 - [string length $header]) / 2}]
3011         set pad [string range "----------------------------------------" 1 $l]
3012         $ctext insert end "$pad $header $pad\n" filesep
3013         set diffinhdr 1
3014     } elseif {[regexp {^(---|\+\+\+)} $line]} {
3015         set diffinhdr 0
3016     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3017                    $line match f1l f1c f2l f2c rest]} {
3018         $ctext insert end "$line\n" hunksep
3019         set diffinhdr 0
3020     } else {
3021         set x [string range $line 0 0]
3022         if {$x == "-" || $x == "+"} {
3023             set tag [expr {$x == "+"}]
3024             $ctext insert end "$line\n" d$tag
3025         } elseif {$x == " "} {
3026             $ctext insert end "$line\n"
3027         } elseif {$diffinhdr || $x == "\\"} {
3028             # e.g. "\ No newline at end of file"
3029             $ctext insert end "$line\n" filesep
3030         } else {
3031             # Something else we don't recognize
3032             if {$curdifftag != "Comments"} {
3033                 $ctext insert end "\n"
3034                 $ctext tag add $curdifftag $curtagstart end
3035                 set curtagstart [$ctext index "end - 1c"]
3036                 set curdifftag Comments
3037             }
3038             $ctext insert end "$line\n" filesep
3039         }
3040     }
3041     $ctext conf -state disabled
3042     if {[clock clicks -milliseconds] >= $nextupdate} {
3043         incr nextupdate 100
3044         fileevent $bdf readable {}
3045         update
3046         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3047     }
3048 }
3049
3050 proc nextfile {} {
3051     global difffilestart ctext
3052     set here [$ctext index @0,0]
3053     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3054         if {[$ctext compare $difffilestart($i) > $here]} {
3055             if {![info exists pos]
3056                 || [$ctext compare $difffilestart($i) < $pos]} {
3057                 set pos $difffilestart($i)
3058             }
3059         }
3060     }
3061     if {[info exists pos]} {
3062         $ctext yview $pos
3063     }
3064 }
3065
3066 proc listboxsel {} {
3067     global ctext cflist currentid
3068     if {![info exists currentid]} return
3069     set sel [lsort [$cflist curselection]]
3070     if {$sel eq {}} return
3071     set first [lindex $sel 0]
3072     catch {$ctext yview fmark.$first}
3073 }
3074
3075 proc setcoords {} {
3076     global linespc charspc canvx0 canvy0 mainfont
3077     global xspc1 xspc2 lthickness
3078
3079     set linespc [font metrics $mainfont -linespace]
3080     set charspc [font measure $mainfont "m"]
3081     set canvy0 [expr {3 + 0.5 * $linespc}]
3082     set canvx0 [expr {3 + 0.5 * $linespc}]
3083     set lthickness [expr {int($linespc / 9) + 1}]
3084     set xspc1(0) $linespc
3085     set xspc2 $linespc
3086 }
3087
3088 proc redisplay {} {
3089     global stopped redisplaying phase
3090     if {$stopped > 1} return
3091     if {$phase == "getcommits"} return
3092     set redisplaying 1
3093     if {$phase == "drawgraph" || $phase == "incrdraw"} {
3094         set stopped 1
3095     } else {
3096         drawgraph
3097     }
3098 }
3099
3100 proc incrfont {inc} {
3101     global mainfont namefont textfont ctext canv phase
3102     global stopped entries
3103     unmarkmatches
3104     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3105     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3106     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3107     setcoords
3108     $ctext conf -font $textfont
3109     $ctext tag conf filesep -font [concat $textfont bold]
3110     foreach e $entries {
3111         $e conf -font $mainfont
3112     }
3113     if {$phase == "getcommits"} {
3114         $canv itemconf textitems -font $mainfont
3115     }
3116     redisplay
3117 }
3118
3119 proc clearsha1 {} {
3120     global sha1entry sha1string
3121     if {[string length $sha1string] == 40} {
3122         $sha1entry delete 0 end
3123     }
3124 }
3125
3126 proc sha1change {n1 n2 op} {
3127     global sha1string currentid sha1but
3128     if {$sha1string == {}
3129         || ([info exists currentid] && $sha1string == $currentid)} {
3130         set state disabled
3131     } else {
3132         set state normal
3133     }
3134     if {[$sha1but cget -state] == $state} return
3135     if {$state == "normal"} {
3136         $sha1but conf -state normal -relief raised -text "Goto: "
3137     } else {
3138         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3139     }
3140 }
3141
3142 proc gotocommit {} {
3143     global sha1string currentid idline tagids
3144     global lineid numcommits
3145
3146     if {$sha1string == {}
3147         || ([info exists currentid] && $sha1string == $currentid)} return
3148     if {[info exists tagids($sha1string)]} {
3149         set id $tagids($sha1string)
3150     } else {
3151         set id [string tolower $sha1string]
3152         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3153             set matches {}
3154             for {set l 0} {$l < $numcommits} {incr l} {
3155                 if {[string match $id* $lineid($l)]} {
3156                     lappend matches $lineid($l)
3157                 }
3158             }
3159             if {$matches ne {}} {
3160                 if {[llength $matches] > 1} {
3161                     error_popup "Short SHA1 id $id is ambiguous"
3162                     return
3163                 }
3164                 set id [lindex $matches 0]
3165             }
3166         }
3167     }
3168     if {[info exists idline($id)]} {
3169         selectline $idline($id) 1
3170         return
3171     }
3172     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3173         set type "SHA1 id"
3174     } else {
3175         set type "Tag"
3176     }
3177     error_popup "$type $sha1string is not known"
3178 }
3179
3180 proc lineenter {x y id} {
3181     global hoverx hovery hoverid hovertimer
3182     global commitinfo canv
3183
3184     if {![info exists commitinfo($id)]} return
3185     set hoverx $x
3186     set hovery $y
3187     set hoverid $id
3188     if {[info exists hovertimer]} {
3189         after cancel $hovertimer
3190     }
3191     set hovertimer [after 500 linehover]
3192     $canv delete hover
3193 }
3194
3195 proc linemotion {x y id} {
3196     global hoverx hovery hoverid hovertimer
3197
3198     if {[info exists hoverid] && $id == $hoverid} {
3199         set hoverx $x
3200         set hovery $y
3201         if {[info exists hovertimer]} {
3202             after cancel $hovertimer
3203         }
3204         set hovertimer [after 500 linehover]
3205     }
3206 }
3207
3208 proc lineleave {id} {
3209     global hoverid hovertimer canv
3210
3211     if {[info exists hoverid] && $id == $hoverid} {
3212         $canv delete hover
3213         if {[info exists hovertimer]} {
3214             after cancel $hovertimer
3215             unset hovertimer
3216         }
3217         unset hoverid
3218     }
3219 }
3220
3221 proc linehover {} {
3222     global hoverx hovery hoverid hovertimer
3223     global canv linespc lthickness
3224     global commitinfo mainfont
3225
3226     set text [lindex $commitinfo($hoverid) 0]
3227     set ymax [lindex [$canv cget -scrollregion] 3]
3228     if {$ymax == {}} return
3229     set yfrac [lindex [$canv yview] 0]
3230     set x [expr {$hoverx + 2 * $linespc}]
3231     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3232     set x0 [expr {$x - 2 * $lthickness}]
3233     set y0 [expr {$y - 2 * $lthickness}]
3234     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3235     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3236     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3237                -fill \#ffff80 -outline black -width 1 -tags hover]
3238     $canv raise $t
3239     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3240     $canv raise $t
3241 }
3242
3243 proc clickisonarrow {id y} {
3244     global mainline mainlinearrow sidelines lthickness
3245
3246     set thresh [expr {2 * $lthickness + 6}]
3247     if {[info exists mainline($id)]} {
3248         if {$mainlinearrow($id) ne "none"} {
3249             if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3250                 return "up"
3251             }
3252         }
3253     }
3254     if {[info exists sidelines($id)]} {
3255         foreach ls $sidelines($id) {
3256             set coords [lindex $ls 0]
3257             set arrow [lindex $ls 2]
3258             if {$arrow eq "first" || $arrow eq "both"} {
3259                 if {abs([lindex $coords 1] - $y) < $thresh} {
3260                     return "up"
3261                 }
3262             }
3263             if {$arrow eq "last" || $arrow eq "both"} {
3264                 if {abs([lindex $coords end] - $y) < $thresh} {
3265                     return "down"
3266                 }
3267             }
3268         }
3269     }
3270     return {}
3271 }
3272
3273 proc arrowjump {id dirn y} {
3274     global mainline sidelines canv canv2 canv3
3275
3276     set yt {}
3277     if {$dirn eq "down"} {
3278         if {[info exists mainline($id)]} {
3279             set y1 [lindex $mainline($id) 1]
3280             if {$y1 > $y} {
3281                 set yt $y1
3282             }
3283         }
3284         if {[info exists sidelines($id)]} {
3285             foreach ls $sidelines($id) {
3286                 set y1 [lindex $ls 0 1]
3287                 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3288                     set yt $y1
3289                 }
3290             }
3291         }
3292     } else {
3293         if {[info exists sidelines($id)]} {
3294             foreach ls $sidelines($id) {
3295                 set y1 [lindex $ls 0 end]
3296                 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3297                     set yt $y1
3298                 }
3299             }
3300         }
3301     }
3302     if {$yt eq {}} return
3303     set ymax [lindex [$canv cget -scrollregion] 3]
3304     if {$ymax eq {} || $ymax <= 0} return
3305     set view [$canv yview]
3306     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3307     set yfrac [expr {$yt / $ymax - $yspan / 2}]
3308     if {$yfrac < 0} {
3309         set yfrac 0
3310     }
3311     $canv yview moveto $yfrac
3312     $canv2 yview moveto $yfrac
3313     $canv3 yview moveto $yfrac
3314 }
3315
3316 proc lineclick {x y id isnew} {
3317     global ctext commitinfo children cflist canv thickerline
3318
3319     unmarkmatches
3320     unselectline
3321     normalline
3322     $canv delete hover
3323     # draw this line thicker than normal
3324     drawlines $id 1 1
3325     set thickerline $id
3326     if {$isnew} {
3327         set ymax [lindex [$canv cget -scrollregion] 3]
3328         if {$ymax eq {}} return
3329         set yfrac [lindex [$canv yview] 0]
3330         set y [expr {$y + $yfrac * $ymax}]
3331     }
3332     set dirn [clickisonarrow $id $y]
3333     if {$dirn ne {}} {
3334         arrowjump $id $dirn $y
3335         return
3336     }
3337
3338     if {$isnew} {
3339         addtohistory [list lineclick $x $y $id 0]
3340     }
3341     # fill the details pane with info about this line
3342     $ctext conf -state normal
3343     $ctext delete 0.0 end
3344     $ctext tag conf link -foreground blue -underline 1
3345     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3346     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3347     $ctext insert end "Parent:\t"
3348     $ctext insert end $id [list link link0]
3349     $ctext tag bind link0 <1> [list selbyid $id]
3350     set info $commitinfo($id)
3351     $ctext insert end "\n\t[lindex $info 0]\n"
3352     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3353     set date [formatdate [lindex $info 2]]
3354     $ctext insert end "\tDate:\t$date\n"
3355     if {[info exists children($id)]} {
3356         $ctext insert end "\nChildren:"
3357         set i 0
3358         foreach child $children($id) {
3359             incr i
3360             set info $commitinfo($child)
3361             $ctext insert end "\n\t"
3362             $ctext insert end $child [list link link$i]
3363             $ctext tag bind link$i <1> [list selbyid $child]
3364             $ctext insert end "\n\t[lindex $info 0]"
3365             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3366             set date [formatdate [lindex $info 2]]
3367             $ctext insert end "\n\tDate:\t$date\n"
3368         }
3369     }
3370     $ctext conf -state disabled
3371
3372     $cflist delete 0 end
3373 }
3374
3375 proc normalline {} {
3376     global thickerline
3377     if {[info exists thickerline]} {
3378         drawlines $thickerline 0 1
3379         unset thickerline
3380     }
3381 }
3382
3383 proc selbyid {id} {
3384     global idline
3385     if {[info exists idline($id)]} {
3386         selectline $idline($id) 1
3387     }
3388 }
3389
3390 proc mstime {} {
3391     global startmstime
3392     if {![info exists startmstime]} {
3393         set startmstime [clock clicks -milliseconds]
3394     }
3395     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3396 }
3397
3398 proc rowmenu {x y id} {
3399     global rowctxmenu idline selectedline rowmenuid
3400
3401     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3402         set state disabled
3403     } else {
3404         set state normal
3405     }
3406     $rowctxmenu entryconfigure 0 -state $state
3407     $rowctxmenu entryconfigure 1 -state $state
3408     $rowctxmenu entryconfigure 2 -state $state
3409     set rowmenuid $id
3410     tk_popup $rowctxmenu $x $y
3411 }
3412
3413 proc diffvssel {dirn} {
3414     global rowmenuid selectedline lineid
3415
3416     if {![info exists selectedline]} return
3417     if {$dirn} {
3418         set oldid $lineid($selectedline)
3419         set newid $rowmenuid
3420     } else {
3421         set oldid $rowmenuid
3422         set newid $lineid($selectedline)
3423     }
3424     addtohistory [list doseldiff $oldid $newid]
3425     doseldiff $oldid $newid
3426 }
3427
3428 proc doseldiff {oldid newid} {
3429     global ctext cflist
3430     global commitinfo
3431
3432     $ctext conf -state normal
3433     $ctext delete 0.0 end
3434     $ctext mark set fmark.0 0.0
3435     $ctext mark gravity fmark.0 left
3436     $cflist delete 0 end
3437     $cflist insert end "Top"
3438     $ctext insert end "From "
3439     $ctext tag conf link -foreground blue -underline 1
3440     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3441     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3442     $ctext tag bind link0 <1> [list selbyid $oldid]
3443     $ctext insert end $oldid [list link link0]
3444     $ctext insert end "\n     "
3445     $ctext insert end [lindex $commitinfo($oldid) 0]
3446     $ctext insert end "\n\nTo   "
3447     $ctext tag bind link1 <1> [list selbyid $newid]
3448     $ctext insert end $newid [list link link1]
3449     $ctext insert end "\n     "
3450     $ctext insert end [lindex $commitinfo($newid) 0]
3451     $ctext insert end "\n"
3452     $ctext conf -state disabled
3453     $ctext tag delete Comments
3454     $ctext tag remove found 1.0 end
3455     startdiff [list $oldid $newid]
3456 }
3457
3458 proc mkpatch {} {
3459     global rowmenuid currentid commitinfo patchtop patchnum
3460
3461     if {![info exists currentid]} return
3462     set oldid $currentid
3463     set oldhead [lindex $commitinfo($oldid) 0]
3464     set newid $rowmenuid
3465     set newhead [lindex $commitinfo($newid) 0]
3466     set top .patch
3467     set patchtop $top
3468     catch {destroy $top}
3469     toplevel $top
3470     label $top.title -text "Generate patch"
3471     grid $top.title - -pady 10
3472     label $top.from -text "From:"
3473     entry $top.fromsha1 -width 40 -relief flat
3474     $top.fromsha1 insert 0 $oldid
3475     $top.fromsha1 conf -state readonly
3476     grid $top.from $top.fromsha1 -sticky w
3477     entry $top.fromhead -width 60 -relief flat
3478     $top.fromhead insert 0 $oldhead
3479     $top.fromhead conf -state readonly
3480     grid x $top.fromhead -sticky w
3481     label $top.to -text "To:"
3482     entry $top.tosha1 -width 40 -relief flat
3483     $top.tosha1 insert 0 $newid
3484     $top.tosha1 conf -state readonly
3485     grid $top.to $top.tosha1 -sticky w
3486     entry $top.tohead -width 60 -relief flat
3487     $top.tohead insert 0 $newhead
3488     $top.tohead conf -state readonly
3489     grid x $top.tohead -sticky w
3490     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3491     grid $top.rev x -pady 10
3492     label $top.flab -text "Output file:"
3493     entry $top.fname -width 60
3494     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3495     incr patchnum
3496     grid $top.flab $top.fname -sticky w
3497     frame $top.buts
3498     button $top.buts.gen -text "Generate" -command mkpatchgo
3499     button $top.buts.can -text "Cancel" -command mkpatchcan
3500     grid $top.buts.gen $top.buts.can
3501     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3502     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3503     grid $top.buts - -pady 10 -sticky ew
3504     focus $top.fname
3505 }
3506
3507 proc mkpatchrev {} {
3508     global patchtop
3509
3510     set oldid [$patchtop.fromsha1 get]
3511     set oldhead [$patchtop.fromhead get]
3512     set newid [$patchtop.tosha1 get]
3513     set newhead [$patchtop.tohead get]
3514     foreach e [list fromsha1 fromhead tosha1 tohead] \
3515             v [list $newid $newhead $oldid $oldhead] {
3516         $patchtop.$e conf -state normal
3517         $patchtop.$e delete 0 end
3518         $patchtop.$e insert 0 $v
3519         $patchtop.$e conf -state readonly
3520     }
3521 }
3522
3523 proc mkpatchgo {} {
3524     global patchtop
3525
3526     set oldid [$patchtop.fromsha1 get]
3527     set newid [$patchtop.tosha1 get]
3528     set fname [$patchtop.fname get]
3529     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3530         error_popup "Error creating patch: $err"
3531     }
3532     catch {destroy $patchtop}
3533     unset patchtop
3534 }
3535
3536 proc mkpatchcan {} {
3537     global patchtop
3538
3539     catch {destroy $patchtop}
3540     unset patchtop
3541 }
3542
3543 proc mktag {} {
3544     global rowmenuid mktagtop commitinfo
3545
3546     set top .maketag
3547     set mktagtop $top
3548     catch {destroy $top}
3549     toplevel $top
3550     label $top.title -text "Create tag"
3551     grid $top.title - -pady 10
3552     label $top.id -text "ID:"
3553     entry $top.sha1 -width 40 -relief flat
3554     $top.sha1 insert 0 $rowmenuid
3555     $top.sha1 conf -state readonly
3556     grid $top.id $top.sha1 -sticky w
3557     entry $top.head -width 60 -relief flat
3558     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3559     $top.head conf -state readonly
3560     grid x $top.head -sticky w
3561     label $top.tlab -text "Tag name:"
3562     entry $top.tag -width 60
3563     grid $top.tlab $top.tag -sticky w
3564     frame $top.buts
3565     button $top.buts.gen -text "Create" -command mktaggo
3566     button $top.buts.can -text "Cancel" -command mktagcan
3567     grid $top.buts.gen $top.buts.can
3568     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3569     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3570     grid $top.buts - -pady 10 -sticky ew
3571     focus $top.tag
3572 }
3573
3574 proc domktag {} {
3575     global mktagtop env tagids idtags
3576
3577     set id [$mktagtop.sha1 get]
3578     set tag [$mktagtop.tag get]
3579     if {$tag == {}} {
3580         error_popup "No tag name specified"
3581         return
3582     }
3583     if {[info exists tagids($tag)]} {
3584         error_popup "Tag \"$tag\" already exists"
3585         return
3586     }
3587     if {[catch {
3588         set dir [gitdir]
3589         set fname [file join $dir "refs/tags" $tag]
3590         set f [open $fname w]
3591         puts $f $id
3592         close $f
3593     } err]} {
3594         error_popup "Error creating tag: $err"
3595         return
3596     }
3597
3598     set tagids($tag) $id
3599     lappend idtags($id) $tag
3600     redrawtags $id
3601 }
3602
3603 proc redrawtags {id} {
3604     global canv linehtag idline idpos selectedline
3605
3606     if {![info exists idline($id)]} return
3607     $canv delete tag.$id
3608     set xt [eval drawtags $id $idpos($id)]
3609     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3610     if {[info exists selectedline] && $selectedline == $idline($id)} {
3611         selectline $selectedline 0
3612     }
3613 }
3614
3615 proc mktagcan {} {
3616     global mktagtop
3617
3618     catch {destroy $mktagtop}
3619     unset mktagtop
3620 }
3621
3622 proc mktaggo {} {
3623     domktag
3624     mktagcan
3625 }
3626
3627 proc writecommit {} {
3628     global rowmenuid wrcomtop commitinfo wrcomcmd
3629
3630     set top .writecommit
3631     set wrcomtop $top
3632     catch {destroy $top}
3633     toplevel $top
3634     label $top.title -text "Write commit to file"
3635     grid $top.title - -pady 10
3636     label $top.id -text "ID:"
3637     entry $top.sha1 -width 40 -relief flat
3638     $top.sha1 insert 0 $rowmenuid
3639     $top.sha1 conf -state readonly
3640     grid $top.id $top.sha1 -sticky w
3641     entry $top.head -width 60 -relief flat
3642     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3643     $top.head conf -state readonly
3644     grid x $top.head -sticky w
3645     label $top.clab -text "Command:"
3646     entry $top.cmd -width 60 -textvariable wrcomcmd
3647     grid $top.clab $top.cmd -sticky w -pady 10
3648     label $top.flab -text "Output file:"
3649     entry $top.fname -width 60
3650     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3651     grid $top.flab $top.fname -sticky w
3652     frame $top.buts
3653     button $top.buts.gen -text "Write" -command wrcomgo
3654     button $top.buts.can -text "Cancel" -command wrcomcan
3655     grid $top.buts.gen $top.buts.can
3656     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3657     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3658     grid $top.buts - -pady 10 -sticky ew
3659     focus $top.fname
3660 }
3661
3662 proc wrcomgo {} {
3663     global wrcomtop
3664
3665     set id [$wrcomtop.sha1 get]
3666     set cmd "echo $id | [$wrcomtop.cmd get]"
3667     set fname [$wrcomtop.fname get]
3668     if {[catch {exec sh -c $cmd >$fname &} err]} {
3669         error_popup "Error writing commit: $err"
3670     }
3671     catch {destroy $wrcomtop}
3672     unset wrcomtop
3673 }
3674
3675 proc wrcomcan {} {
3676     global wrcomtop
3677
3678     catch {destroy $wrcomtop}
3679     unset wrcomtop
3680 }
3681
3682 proc listrefs {id} {
3683     global idtags idheads idotherrefs
3684
3685     set x {}
3686     if {[info exists idtags($id)]} {
3687         set x $idtags($id)
3688     }
3689     set y {}
3690     if {[info exists idheads($id)]} {
3691         set y $idheads($id)
3692     }
3693     set z {}
3694     if {[info exists idotherrefs($id)]} {
3695         set z $idotherrefs($id)
3696     }
3697     return [list $x $y $z]
3698 }
3699
3700 proc rereadrefs {} {
3701     global idtags idheads idotherrefs
3702     global tagids headids otherrefids
3703
3704     set refids [concat [array names idtags] \
3705                     [array names idheads] [array names idotherrefs]]
3706     foreach id $refids {
3707         if {![info exists ref($id)]} {
3708             set ref($id) [listrefs $id]
3709         }
3710     }
3711     readrefs
3712     set refids [lsort -unique [concat $refids [array names idtags] \
3713                         [array names idheads] [array names idotherrefs]]]
3714     foreach id $refids {
3715         set v [listrefs $id]
3716         if {![info exists ref($id)] || $ref($id) != $v} {
3717             redrawtags $id
3718         }
3719     }
3720 }
3721
3722 proc showtag {tag isnew} {
3723     global ctext cflist tagcontents tagids linknum
3724
3725     if {$isnew} {
3726         addtohistory [list showtag $tag 0]
3727     }
3728     $ctext conf -state normal
3729     $ctext delete 0.0 end
3730     set linknum 0
3731     if {[info exists tagcontents($tag)]} {
3732         set text $tagcontents($tag)
3733     } else {
3734         set text "Tag: $tag\nId:  $tagids($tag)"
3735     }
3736     appendwithlinks $text
3737     $ctext conf -state disabled
3738     $cflist delete 0 end
3739 }
3740
3741 proc doquit {} {
3742     global stopped
3743     set stopped 100
3744     destroy .
3745 }
3746
3747 proc doprefs {} {
3748     global maxwidth maxgraphpct diffopts findmergefiles
3749     global oldprefs prefstop
3750
3751     set top .gitkprefs
3752     set prefstop $top
3753     if {[winfo exists $top]} {
3754         raise $top
3755         return
3756     }
3757     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3758         set oldprefs($v) [set $v]
3759     }
3760     toplevel $top
3761     wm title $top "Gitk preferences"
3762     label $top.ldisp -text "Commit list display options"
3763     grid $top.ldisp - -sticky w -pady 10
3764     label $top.spacer -text " "
3765     label $top.maxwidthl -text "Maximum graph width (lines)" \
3766         -font optionfont
3767     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3768     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3769     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3770         -font optionfont
3771     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3772     grid x $top.maxpctl $top.maxpct -sticky w
3773     checkbutton $top.findm -variable findmergefiles
3774     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3775         -font optionfont
3776     grid $top.findm $top.findml - -sticky w
3777     label $top.ddisp -text "Diff display options"
3778     grid $top.ddisp - -sticky w -pady 10
3779     label $top.diffoptl -text "Options for diff program" \
3780         -font optionfont
3781     entry $top.diffopt -width 20 -textvariable diffopts
3782     grid x $top.diffoptl $top.diffopt -sticky w
3783     frame $top.buts
3784     button $top.buts.ok -text "OK" -command prefsok
3785     button $top.buts.can -text "Cancel" -command prefscan
3786     grid $top.buts.ok $top.buts.can
3787     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3788     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3789     grid $top.buts - - -pady 10 -sticky ew
3790 }
3791
3792 proc prefscan {} {
3793     global maxwidth maxgraphpct diffopts findmergefiles
3794     global oldprefs prefstop
3795
3796     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3797         set $v $oldprefs($v)
3798     }
3799     catch {destroy $prefstop}
3800     unset prefstop
3801 }
3802
3803 proc prefsok {} {
3804     global maxwidth maxgraphpct
3805     global oldprefs prefstop
3806
3807     catch {destroy $prefstop}
3808     unset prefstop
3809     if {$maxwidth != $oldprefs(maxwidth)
3810         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3811         redisplay
3812     }
3813 }
3814
3815 proc formatdate {d} {
3816     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3817 }
3818
3819 # This list of encoding names and aliases is distilled from
3820 # http://www.iana.org/assignments/character-sets.
3821 # Not all of them are supported by Tcl.
3822 set encoding_aliases {
3823     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3824       ISO646-US US-ASCII us IBM367 cp367 csASCII }
3825     { ISO-10646-UTF-1 csISO10646UTF1 }
3826     { ISO_646.basic:1983 ref csISO646basic1983 }
3827     { INVARIANT csINVARIANT }
3828     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3829     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3830     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3831     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3832     { NATS-DANO iso-ir-9-1 csNATSDANO }
3833     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3834     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3835     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3836     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3837     { ISO-2022-KR csISO2022KR }
3838     { EUC-KR csEUCKR }
3839     { ISO-2022-JP csISO2022JP }
3840     { ISO-2022-JP-2 csISO2022JP2 }
3841     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3842       csISO13JISC6220jp }
3843     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3844     { IT iso-ir-15 ISO646-IT csISO15Italian }
3845     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3846     { ES iso-ir-17 ISO646-ES csISO17Spanish }
3847     { greek7-old iso-ir-18 csISO18Greek7Old }
3848     { latin-greek iso-ir-19 csISO19LatinGreek }
3849     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3850     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3851     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3852     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3853     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3854     { BS_viewdata iso-ir-47 csISO47BSViewdata }
3855     { INIS iso-ir-49 csISO49INIS }
3856     { INIS-8 iso-ir-50 csISO50INIS8 }
3857     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3858     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3859     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3860     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3861     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3862     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3863       csISO60Norwegian1 }
3864     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3865     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3866     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3867     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3868     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3869     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3870     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3871     { greek7 iso-ir-88 csISO88Greek7 }
3872     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3873     { iso-ir-90 csISO90 }
3874     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3875     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3876       csISO92JISC62991984b }
3877     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3878     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3879     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3880       csISO95JIS62291984handadd }
3881     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3882     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3883     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3884     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3885       CP819 csISOLatin1 }
3886     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3887     { T.61-7bit iso-ir-102 csISO102T617bit }
3888     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3889     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3890     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3891     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3892     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3893     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3894     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3895     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3896       arabic csISOLatinArabic }
3897     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3898     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3899     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3900       greek greek8 csISOLatinGreek }
3901     { T.101-G2 iso-ir-128 csISO128T101G2 }
3902     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3903       csISOLatinHebrew }
3904     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3905     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3906     { CSN_369103 iso-ir-139 csISO139CSN369103 }
3907     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3908     { ISO_6937-2-add iso-ir-142 csISOTextComm }
3909     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3910     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3911       csISOLatinCyrillic }
3912     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3913     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3914     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3915     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3916     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3917     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3918     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3919     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3920     { ISO_10367-box iso-ir-155 csISO10367Box }
3921     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3922     { latin-lap lap iso-ir-158 csISO158Lap }
3923     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3924     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3925     { us-dk csUSDK }
3926     { dk-us csDKUS }
3927     { JIS_X0201 X0201 csHalfWidthKatakana }
3928     { KSC5636 ISO646-KR csKSC5636 }
3929     { ISO-10646-UCS-2 csUnicode }
3930     { ISO-10646-UCS-4 csUCS4 }
3931     { DEC-MCS dec csDECMCS }
3932     { hp-roman8 roman8 r8 csHPRoman8 }
3933     { macintosh mac csMacintosh }
3934     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3935       csIBM037 }
3936     { IBM038 EBCDIC-INT cp038 csIBM038 }
3937     { IBM273 CP273 csIBM273 }
3938     { IBM274 EBCDIC-BE CP274 csIBM274 }
3939     { IBM275 EBCDIC-BR cp275 csIBM275 }
3940     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3941     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3942     { IBM280 CP280 ebcdic-cp-it csIBM280 }
3943     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3944     { IBM284 CP284 ebcdic-cp-es csIBM284 }
3945     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3946     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3947     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3948     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3949     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3950     { IBM424 cp424 ebcdic-cp-he csIBM424 }
3951     { IBM437 cp437 437 csPC8CodePage437 }
3952     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3953     { IBM775 cp775 csPC775Baltic }
3954     { IBM850 cp850 850 csPC850Multilingual }
3955     { IBM851 cp851 851 csIBM851 }
3956     { IBM852 cp852 852 csPCp852 }
3957     { IBM855 cp855 855 csIBM855 }
3958     { IBM857 cp857 857 csIBM857 }
3959     { IBM860 cp860 860 csIBM860 }
3960     { IBM861 cp861 861 cp-is csIBM861 }
3961     { IBM862 cp862 862 csPC862LatinHebrew }
3962     { IBM863 cp863 863 csIBM863 }
3963     { IBM864 cp864 csIBM864 }
3964     { IBM865 cp865 865 csIBM865 }
3965     { IBM866 cp866 866 csIBM866 }
3966     { IBM868 CP868 cp-ar csIBM868 }
3967     { IBM869 cp869 869 cp-gr csIBM869 }
3968     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3969     { IBM871 CP871 ebcdic-cp-is csIBM871 }
3970     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3971     { IBM891 cp891 csIBM891 }
3972     { IBM903 cp903 csIBM903 }
3973     { IBM904 cp904 904 csIBBM904 }
3974     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3975     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3976     { IBM1026 CP1026 csIBM1026 }
3977     { EBCDIC-AT-DE csIBMEBCDICATDE }
3978     { EBCDIC-AT-DE-A csEBCDICATDEA }
3979     { EBCDIC-CA-FR csEBCDICCAFR }
3980     { EBCDIC-DK-NO csEBCDICDKNO }
3981     { EBCDIC-DK-NO-A csEBCDICDKNOA }
3982     { EBCDIC-FI-SE csEBCDICFISE }
3983     { EBCDIC-FI-SE-A csEBCDICFISEA }
3984     { EBCDIC-FR csEBCDICFR }
3985     { EBCDIC-IT csEBCDICIT }
3986     { EBCDIC-PT csEBCDICPT }
3987     { EBCDIC-ES csEBCDICES }
3988     { EBCDIC-ES-A csEBCDICESA }
3989     { EBCDIC-ES-S csEBCDICESS }
3990     { EBCDIC-UK csEBCDICUK }
3991     { EBCDIC-US csEBCDICUS }
3992     { UNKNOWN-8BIT csUnknown8BiT }
3993     { MNEMONIC csMnemonic }
3994     { MNEM csMnem }
3995     { VISCII csVISCII }
3996     { VIQR csVIQR }
3997     { KOI8-R csKOI8R }
3998     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3999     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4000     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4001     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4002     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4003     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4004     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4005     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4006     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4007     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4008     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4009     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4010     { IBM1047 IBM-1047 }
4011     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4012     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4013     { UNICODE-1-1 csUnicode11 }
4014     { CESU-8 csCESU-8 }
4015     { BOCU-1 csBOCU-1 }
4016     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4017     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4018       l8 }
4019     { ISO-8859-15 ISO_8859-15 Latin-9 }
4020     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4021     { GBK CP936 MS936 windows-936 }
4022     { JIS_Encoding csJISEncoding }
4023     { Shift_JIS MS_Kanji csShiftJIS }
4024     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4025       EUC-JP }
4026     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4027     { ISO-10646-UCS-Basic csUnicodeASCII }
4028     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4029     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4030     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4031     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4032     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4033     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4034     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4035     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4036     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4037     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4038     { Adobe-Standard-Encoding csAdobeStandardEncoding }
4039     { Ventura-US csVenturaUS }
4040     { Ventura-International csVenturaInternational }
4041     { PC8-Danish-Norwegian csPC8DanishNorwegian }
4042     { PC8-Turkish csPC8Turkish }
4043     { IBM-Symbols csIBMSymbols }
4044     { IBM-Thai csIBMThai }
4045     { HP-Legal csHPLegal }
4046     { HP-Pi-font csHPPiFont }
4047     { HP-Math8 csHPMath8 }
4048     { Adobe-Symbol-Encoding csHPPSMath }
4049     { HP-DeskTop csHPDesktop }
4050     { Ventura-Math csVenturaMath }
4051     { Microsoft-Publishing csMicrosoftPublishing }
4052     { Windows-31J csWindows31J }
4053     { GB2312 csGB2312 }
4054     { Big5 csBig5 }
4055 }
4056
4057 proc tcl_encoding {enc} {
4058     global encoding_aliases
4059     set names [encoding names]
4060     set lcnames [string tolower $names]
4061     set enc [string tolower $enc]
4062     set i [lsearch -exact $lcnames $enc]
4063     if {$i < 0} {
4064         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4065         if {[regsub {^iso[-_]} $enc iso encx]} {
4066             set i [lsearch -exact $lcnames $encx]
4067         }
4068     }
4069     if {$i < 0} {
4070         foreach l $encoding_aliases {
4071             set ll [string tolower $l]
4072             if {[lsearch -exact $ll $enc] < 0} continue
4073             # look through the aliases for one that tcl knows about
4074             foreach e $ll {
4075                 set i [lsearch -exact $lcnames $e]
4076                 if {$i < 0} {
4077                     if {[regsub {^iso[-_]} $e iso ex]} {
4078                         set i [lsearch -exact $lcnames $ex]
4079                     }
4080                 }
4081                 if {$i >= 0} break
4082             }
4083             break
4084         }
4085     }
4086     if {$i >= 0} {
4087         return [lindex $names $i]
4088     }
4089     return {}
4090 }
4091
4092 # defaults...
4093 set datemode 0
4094 set diffopts "-U 5 -p"
4095 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4096
4097 set gitencoding {}
4098 catch {
4099     set gitencoding [exec git-repo-config --get i18n.commitencoding]
4100 }
4101 if {$gitencoding == ""} {
4102     set gitencoding "utf-8"
4103 }
4104 set tclencoding [tcl_encoding $gitencoding]
4105 if {$tclencoding == {}} {
4106     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4107 }
4108
4109 set mainfont {Helvetica 9}
4110 set textfont {Courier 9}
4111 set findmergefiles 0
4112 set maxgraphpct 50
4113 set maxwidth 16
4114 set revlistorder 0
4115 set fastdate 0
4116
4117 set colors {green red blue magenta darkgrey brown orange}
4118
4119 catch {source ~/.gitk}
4120
4121 set namefont $mainfont
4122
4123 font create optionfont -family sans-serif -size -12
4124
4125 set revtreeargs {}
4126 foreach arg $argv {
4127     switch -regexp -- $arg {
4128         "^$" { }
4129         "^-d" { set datemode 1 }
4130         "^-r" { set revlistorder 1 }
4131         default {
4132             lappend revtreeargs $arg
4133         }
4134     }
4135 }
4136
4137 set history {}
4138 set historyindex 0
4139
4140 set stopped 0
4141 set redisplaying 0
4142 set stuffsaved 0
4143 set patchnum 0
4144 setcoords
4145 makewindow $revtreeargs
4146 readrefs
4147 getcommits $revtreeargs