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