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 fdiffid 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             if {![info exists treediffs($id)]} {
1957                 append diffsneeded "$id\n"
1958                 lappend fdiffsneeded $id
1959             }
1960         }
1961         if {[incr l] >= $numcommits} {
1962             set l 0
1963         }
1964         if {$l == $findstartline} break
1965     }
1966
1967     # start off a git-diff-tree process if needed
1968     if {$diffsneeded ne {}} {
1969         if {[catch {
1970             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1971         } err ]} {
1972             error_popup "Error starting search process: $err"
1973             return
1974         }
1975         catch {unset fdiffid}
1976         set fdiffpos 0
1977         fconfigure $df -blocking 0
1978         fileevent $df readable [list readfilediffs $df]
1979     }
1980
1981     set finddidsel 0
1982     set findinsertpos end
1983     set id $lineid($l)
1984     . config -cursor watch
1985     settextcursor watch
1986     set findinprogress 1
1987     findcont $id
1988     update
1989 }
1990
1991 proc readfilediffs {df} {
1992     global findid fdiffid fdiffs
1993
1994     set n [gets $df line]
1995     if {$n < 0} {
1996         if {[eof $df]} {
1997             donefilediff
1998             if {[catch {close $df} err]} {
1999                 stopfindproc
2000                 bell
2001                 error_popup "Error in git-diff-tree: $err"
2002             } elseif {[info exists findid]} {
2003                 set id $findid
2004                 stopfindproc
2005                 bell
2006                 error_popup "Couldn't find diffs for $id"
2007             }
2008         }
2009         return
2010     }
2011     if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2012         # start of a new string of diffs
2013         donefilediff
2014         set fdiffid $id
2015         set fdiffs {}
2016     } elseif {[string match ":*" $line]} {
2017         lappend fdiffs [lindex $line 5]
2018     }
2019 }
2020
2021 proc donefilediff {} {
2022     global fdiffid fdiffs treediffs findid
2023     global fdiffsneeded fdiffpos
2024
2025     if {[info exists fdiffid]} {
2026         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2027                && $fdiffpos < [llength $fdiffsneeded]} {
2028             # git-diff-tree doesn't output anything for a commit
2029             # which doesn't change anything
2030             set nullid [lindex $fdiffsneeded $fdiffpos]
2031             set treediffs($nullid) {}
2032             if {[info exists findid] && $nullid eq $findid} {
2033                 unset findid
2034                 findcont $nullid
2035             }
2036             incr fdiffpos
2037         }
2038         incr fdiffpos
2039
2040         if {![info exists treediffs($fdiffid)]} {
2041             set treediffs($fdiffid) $fdiffs
2042         }
2043         if {[info exists findid] && $fdiffid eq $findid} {
2044             unset findid
2045             findcont $fdiffid
2046         }
2047     }
2048 }
2049
2050 proc findcont {id} {
2051     global findid treediffs parents nparents
2052     global ffileline findstartline finddidsel
2053     global lineid numcommits matchinglines findinprogress
2054     global findmergefiles
2055
2056     set l $ffileline
2057     while 1 {
2058         if {$findmergefiles || $nparents($id) == 1} {
2059             if {![info exists treediffs($id)]} {
2060                 set findid $id
2061                 set ffileline $l
2062                 return
2063             }
2064             set doesmatch 0
2065             foreach f $treediffs($id) {
2066                 set x [findmatches $f]
2067                 if {$x != {}} {
2068                     set doesmatch 1
2069                     break
2070                 }
2071             }
2072             if {$doesmatch} {
2073                 insertmatch $l $id
2074             }
2075         }
2076         if {[incr l] >= $numcommits} {
2077             set l 0
2078         }
2079         if {$l == $findstartline} break
2080         set id $lineid($l)
2081     }
2082     stopfindproc
2083     if {!$finddidsel} {
2084         bell
2085     }
2086 }
2087
2088 # mark a commit as matching by putting a yellow background
2089 # behind the headline
2090 proc markheadline {l id} {
2091     global canv mainfont linehtag commitinfo
2092
2093     set bbox [$canv bbox $linehtag($l)]
2094     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2095     $canv lower $t
2096 }
2097
2098 # mark the bits of a headline, author or date that match a find string
2099 proc markmatches {canv l str tag matches font} {
2100     set bbox [$canv bbox $tag]
2101     set x0 [lindex $bbox 0]
2102     set y0 [lindex $bbox 1]
2103     set y1 [lindex $bbox 3]
2104     foreach match $matches {
2105         set start [lindex $match 0]
2106         set end [lindex $match 1]
2107         if {$start > $end} continue
2108         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2109         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2110         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2111                    [expr {$x0+$xlen+2}] $y1 \
2112                    -outline {} -tags matches -fill yellow]
2113         $canv lower $t
2114     }
2115 }
2116
2117 proc unmarkmatches {} {
2118     global matchinglines findids
2119     allcanvs delete matches
2120     catch {unset matchinglines}
2121     catch {unset findids}
2122 }
2123
2124 proc selcanvline {w x y} {
2125     global canv canvy0 ctext linespc
2126     global lineid linehtag linentag linedtag rowtextx
2127     set ymax [lindex [$canv cget -scrollregion] 3]
2128     if {$ymax == {}} return
2129     set yfrac [lindex [$canv yview] 0]
2130     set y [expr {$y + $yfrac * $ymax}]
2131     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2132     if {$l < 0} {
2133         set l 0
2134     }
2135     if {$w eq $canv} {
2136         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2137     }
2138     unmarkmatches
2139     selectline $l 1
2140 }
2141
2142 proc commit_descriptor {p} {
2143     global commitinfo
2144     set l "..."
2145     if {[info exists commitinfo($p)]} {
2146         set l [lindex $commitinfo($p) 0]
2147     }
2148     return "$p ($l)"
2149 }
2150
2151 # append some text to the ctext widget, and make any SHA1 ID
2152 # that we know about be a clickable link.
2153 proc appendwithlinks {text} {
2154     global ctext idline linknum
2155
2156     set start [$ctext index "end - 1c"]
2157     $ctext insert end $text
2158     $ctext insert end "\n"
2159     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2160     foreach l $links {
2161         set s [lindex $l 0]
2162         set e [lindex $l 1]
2163         set linkid [string range $text $s $e]
2164         if {![info exists idline($linkid)]} continue
2165         incr e
2166         $ctext tag add link "$start + $s c" "$start + $e c"
2167         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2168         $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2169         incr linknum
2170     }
2171     $ctext tag conf link -foreground blue -underline 1
2172     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2173     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2174 }
2175
2176 proc selectline {l isnew} {
2177     global canv canv2 canv3 ctext commitinfo selectedline
2178     global lineid linehtag linentag linedtag
2179     global canvy0 linespc parents nparents children
2180     global cflist currentid sha1entry
2181     global commentend idtags idline linknum
2182     global mergemax
2183
2184     $canv delete hover
2185     normalline
2186     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2187     $canv delete secsel
2188     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2189                -tags secsel -fill [$canv cget -selectbackground]]
2190     $canv lower $t
2191     $canv2 delete secsel
2192     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2193                -tags secsel -fill [$canv2 cget -selectbackground]]
2194     $canv2 lower $t
2195     $canv3 delete secsel
2196     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2197                -tags secsel -fill [$canv3 cget -selectbackground]]
2198     $canv3 lower $t
2199     set y [expr {$canvy0 + $l * $linespc}]
2200     set ymax [lindex [$canv cget -scrollregion] 3]
2201     set ytop [expr {$y - $linespc - 1}]
2202     set ybot [expr {$y + $linespc + 1}]
2203     set wnow [$canv yview]
2204     set wtop [expr {[lindex $wnow 0] * $ymax}]
2205     set wbot [expr {[lindex $wnow 1] * $ymax}]
2206     set wh [expr {$wbot - $wtop}]
2207     set newtop $wtop
2208     if {$ytop < $wtop} {
2209         if {$ybot < $wtop} {
2210             set newtop [expr {$y - $wh / 2.0}]
2211         } else {
2212             set newtop $ytop
2213             if {$newtop > $wtop - $linespc} {
2214                 set newtop [expr {$wtop - $linespc}]
2215             }
2216         }
2217     } elseif {$ybot > $wbot} {
2218         if {$ytop > $wbot} {
2219             set newtop [expr {$y - $wh / 2.0}]
2220         } else {
2221             set newtop [expr {$ybot - $wh}]
2222             if {$newtop < $wtop + $linespc} {
2223                 set newtop [expr {$wtop + $linespc}]
2224             }
2225         }
2226     }
2227     if {$newtop != $wtop} {
2228         if {$newtop < 0} {
2229             set newtop 0
2230         }
2231         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2232     }
2233
2234     if {$isnew} {
2235         addtohistory [list selectline $l 0]
2236     }
2237
2238     set selectedline $l
2239
2240     set id $lineid($l)
2241     set currentid $id
2242     $sha1entry delete 0 end
2243     $sha1entry insert 0 $id
2244     $sha1entry selection from 0
2245     $sha1entry selection to end
2246
2247     $ctext conf -state normal
2248     $ctext delete 0.0 end
2249     set linknum 0
2250     $ctext mark set fmark.0 0.0
2251     $ctext mark gravity fmark.0 left
2252     set info $commitinfo($id)
2253     set date [formatdate [lindex $info 2]]
2254     $ctext insert end "Author: [lindex $info 1]  $date\n"
2255     set date [formatdate [lindex $info 4]]
2256     $ctext insert end "Committer: [lindex $info 3]  $date\n"
2257     if {[info exists idtags($id)]} {
2258         $ctext insert end "Tags:"
2259         foreach tag $idtags($id) {
2260             $ctext insert end " $tag"
2261         }
2262         $ctext insert end "\n"
2263     }
2264
2265     set comment {}
2266     if {$nparents($id) > 1} {
2267         set np 0
2268         foreach p $parents($id) {
2269             if {$np >= $mergemax} {
2270                 set tag mmax
2271             } else {
2272                 set tag m$np
2273             }
2274             $ctext insert end "Parent: " $tag
2275             appendwithlinks [commit_descriptor $p]
2276             incr np
2277         }
2278     } else {
2279         if {[info exists parents($id)]} {
2280             foreach p $parents($id) {
2281                 append comment "Parent: [commit_descriptor $p]\n"
2282             }
2283         }
2284     }
2285
2286     if {[info exists children($id)]} {
2287         foreach c $children($id) {
2288             append comment "Child:  [commit_descriptor $c]\n"
2289         }
2290     }
2291     append comment "\n"
2292     append comment [lindex $info 5]
2293
2294     # make anything that looks like a SHA1 ID be a clickable link
2295     appendwithlinks $comment
2296
2297     $ctext tag delete Comments
2298     $ctext tag remove found 1.0 end
2299     $ctext conf -state disabled
2300     set commentend [$ctext index "end - 1c"]
2301
2302     $cflist delete 0 end
2303     $cflist insert end "Comments"
2304     if {$nparents($id) == 1} {
2305         startdiff $id
2306     } elseif {$nparents($id) > 1} {
2307         mergediff $id
2308     }
2309 }
2310
2311 proc selnextline {dir} {
2312     global selectedline
2313     if {![info exists selectedline]} return
2314     set l [expr {$selectedline + $dir}]
2315     unmarkmatches
2316     selectline $l 1
2317 }
2318
2319 proc unselectline {} {
2320     global selectedline
2321
2322     catch {unset selectedline}
2323     allcanvs delete secsel
2324 }
2325
2326 proc addtohistory {cmd} {
2327     global history historyindex
2328
2329     if {$historyindex > 0
2330         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2331         return
2332     }
2333
2334     if {$historyindex < [llength $history]} {
2335         set history [lreplace $history $historyindex end $cmd]
2336     } else {
2337         lappend history $cmd
2338     }
2339     incr historyindex
2340     if {$historyindex > 1} {
2341         .ctop.top.bar.leftbut conf -state normal
2342     } else {
2343         .ctop.top.bar.leftbut conf -state disabled
2344     }
2345     .ctop.top.bar.rightbut conf -state disabled
2346 }
2347
2348 proc goback {} {
2349     global history historyindex
2350
2351     if {$historyindex > 1} {
2352         incr historyindex -1
2353         set cmd [lindex $history [expr {$historyindex - 1}]]
2354         eval $cmd
2355         .ctop.top.bar.rightbut conf -state normal
2356     }
2357     if {$historyindex <= 1} {
2358         .ctop.top.bar.leftbut conf -state disabled
2359     }
2360 }
2361
2362 proc goforw {} {
2363     global history historyindex
2364
2365     if {$historyindex < [llength $history]} {
2366         set cmd [lindex $history $historyindex]
2367         incr historyindex
2368         eval $cmd
2369         .ctop.top.bar.leftbut conf -state normal
2370     }
2371     if {$historyindex >= [llength $history]} {
2372         .ctop.top.bar.rightbut conf -state disabled
2373     }
2374 }
2375
2376 proc mergediff {id} {
2377     global parents diffmergeid diffopts mdifffd
2378     global difffilestart
2379
2380     set diffmergeid $id
2381     catch {unset difffilestart}
2382     # this doesn't seem to actually affect anything...
2383     set env(GIT_DIFF_OPTS) $diffopts
2384     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2385     if {[catch {set mdf [open $cmd r]} err]} {
2386         error_popup "Error getting merge diffs: $err"
2387         return
2388     }
2389     fconfigure $mdf -blocking 0
2390     set mdifffd($id) $mdf
2391     fileevent $mdf readable [list getmergediffline $mdf $id]
2392     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2393 }
2394
2395 proc getmergediffline {mdf id} {
2396     global diffmergeid ctext cflist nextupdate nparents mergemax
2397     global difffilestart
2398
2399     set n [gets $mdf line]
2400     if {$n < 0} {
2401         if {[eof $mdf]} {
2402             close $mdf
2403         }
2404         return
2405     }
2406     if {![info exists diffmergeid] || $id != $diffmergeid} {
2407         return
2408     }
2409     $ctext conf -state normal
2410     if {[regexp {^diff --cc (.*)} $line match fname]} {
2411         # start of a new file
2412         $ctext insert end "\n"
2413         set here [$ctext index "end - 1c"]
2414         set i [$cflist index end]
2415         $ctext mark set fmark.$i $here
2416         $ctext mark gravity fmark.$i left
2417         set difffilestart([expr {$i-1}]) $here
2418         $cflist insert end $fname
2419         set l [expr {(78 - [string length $fname]) / 2}]
2420         set pad [string range "----------------------------------------" 1 $l]
2421         $ctext insert end "$pad $fname $pad\n" filesep
2422     } elseif {[regexp {^@@} $line]} {
2423         $ctext insert end "$line\n" hunksep
2424     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2425         # do nothing
2426     } else {
2427         # parse the prefix - one ' ', '-' or '+' for each parent
2428         set np $nparents($id)
2429         set spaces {}
2430         set minuses {}
2431         set pluses {}
2432         set isbad 0
2433         for {set j 0} {$j < $np} {incr j} {
2434             set c [string range $line $j $j]
2435             if {$c == " "} {
2436                 lappend spaces $j
2437             } elseif {$c == "-"} {
2438                 lappend minuses $j
2439             } elseif {$c == "+"} {
2440                 lappend pluses $j
2441             } else {
2442                 set isbad 1
2443                 break
2444             }
2445         }
2446         set tags {}
2447         set num {}
2448         if {!$isbad && $minuses ne {} && $pluses eq {}} {
2449             # line doesn't appear in result, parents in $minuses have the line
2450             set num [lindex $minuses 0]
2451         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2452             # line appears in result, parents in $pluses don't have the line
2453             lappend tags mresult
2454             set num [lindex $spaces 0]
2455         }
2456         if {$num ne {}} {
2457             if {$num >= $mergemax} {
2458                 set num "max"
2459             }
2460             lappend tags m$num
2461         }
2462         $ctext insert end "$line\n" $tags
2463     }
2464     $ctext conf -state disabled
2465     if {[clock clicks -milliseconds] >= $nextupdate} {
2466         incr nextupdate 100
2467         fileevent $mdf readable {}
2468         update
2469         fileevent $mdf readable [list getmergediffline $mdf $id]
2470     }
2471 }
2472
2473 proc startdiff {ids} {
2474     global treediffs diffids treepending diffmergeid
2475
2476     set diffids $ids
2477     catch {unset diffmergeid}
2478     if {![info exists treediffs($ids)]} {
2479         if {![info exists treepending]} {
2480             gettreediffs $ids
2481         }
2482     } else {
2483         addtocflist $ids
2484     }
2485 }
2486
2487 proc addtocflist {ids} {
2488     global treediffs cflist
2489     foreach f $treediffs($ids) {
2490         $cflist insert end $f
2491     }
2492     getblobdiffs $ids
2493 }
2494
2495 proc gettreediffs {ids} {
2496     global treediff parents treepending
2497     set treepending $ids
2498     set treediff {}
2499     if {[catch \
2500          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2501         ]} return
2502     fconfigure $gdtf -blocking 0
2503     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2504 }
2505
2506 proc gettreediffline {gdtf ids} {
2507     global treediff treediffs treepending diffids diffmergeid
2508
2509     set n [gets $gdtf line]
2510     if {$n < 0} {
2511         if {![eof $gdtf]} return
2512         close $gdtf
2513         set treediffs($ids) $treediff
2514         unset treepending
2515         if {$ids != $diffids} {
2516             gettreediffs $diffids
2517         } else {
2518             if {[info exists diffmergeid]} {
2519                 contmergediff $ids
2520             } else {
2521                 addtocflist $ids
2522             }
2523         }
2524         return
2525     }
2526     set file [lindex $line 5]
2527     lappend treediff $file
2528 }
2529
2530 proc getblobdiffs {ids} {
2531     global diffopts blobdifffd diffids env curdifftag curtagstart
2532     global difffilestart nextupdate diffinhdr treediffs
2533
2534     set env(GIT_DIFF_OPTS) $diffopts
2535     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2536     if {[catch {set bdf [open $cmd r]} err]} {
2537         puts "error getting diffs: $err"
2538         return
2539     }
2540     set diffinhdr 0
2541     fconfigure $bdf -blocking 0
2542     set blobdifffd($ids) $bdf
2543     set curdifftag Comments
2544     set curtagstart 0.0
2545     catch {unset difffilestart}
2546     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2547     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2548 }
2549
2550 proc getblobdiffline {bdf ids} {
2551     global diffids blobdifffd ctext curdifftag curtagstart
2552     global diffnexthead diffnextnote difffilestart
2553     global nextupdate diffinhdr treediffs
2554
2555     set n [gets $bdf line]
2556     if {$n < 0} {
2557         if {[eof $bdf]} {
2558             close $bdf
2559             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2560                 $ctext tag add $curdifftag $curtagstart end
2561             }
2562         }
2563         return
2564     }
2565     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2566         return
2567     }
2568     $ctext conf -state normal
2569     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2570         # start of a new file
2571         $ctext insert end "\n"
2572         $ctext tag add $curdifftag $curtagstart end
2573         set curtagstart [$ctext index "end - 1c"]
2574         set header $newname
2575         set here [$ctext index "end - 1c"]
2576         set i [lsearch -exact $treediffs($diffids) $fname]
2577         if {$i >= 0} {
2578             set difffilestart($i) $here
2579             incr i
2580             $ctext mark set fmark.$i $here
2581             $ctext mark gravity fmark.$i left
2582         }
2583         if {$newname != $fname} {
2584             set i [lsearch -exact $treediffs($diffids) $newname]
2585             if {$i >= 0} {
2586                 set difffilestart($i) $here
2587                 incr i
2588                 $ctext mark set fmark.$i $here
2589                 $ctext mark gravity fmark.$i left
2590             }
2591         }
2592         set curdifftag "f:$fname"
2593         $ctext tag delete $curdifftag
2594         set l [expr {(78 - [string length $header]) / 2}]
2595         set pad [string range "----------------------------------------" 1 $l]
2596         $ctext insert end "$pad $header $pad\n" filesep
2597         set diffinhdr 1
2598     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2599         set diffinhdr 0
2600     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2601                    $line match f1l f1c f2l f2c rest]} {
2602         $ctext insert end "$line\n" hunksep
2603         set diffinhdr 0
2604     } else {
2605         set x [string range $line 0 0]
2606         if {$x == "-" || $x == "+"} {
2607             set tag [expr {$x == "+"}]
2608             $ctext insert end "$line\n" d$tag
2609         } elseif {$x == " "} {
2610             $ctext insert end "$line\n"
2611         } elseif {$diffinhdr || $x == "\\"} {
2612             # e.g. "\ No newline at end of file"
2613             $ctext insert end "$line\n" filesep
2614         } else {
2615             # Something else we don't recognize
2616             if {$curdifftag != "Comments"} {
2617                 $ctext insert end "\n"
2618                 $ctext tag add $curdifftag $curtagstart end
2619                 set curtagstart [$ctext index "end - 1c"]
2620                 set curdifftag Comments
2621             }
2622             $ctext insert end "$line\n" filesep
2623         }
2624     }
2625     $ctext conf -state disabled
2626     if {[clock clicks -milliseconds] >= $nextupdate} {
2627         incr nextupdate 100
2628         fileevent $bdf readable {}
2629         update
2630         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2631     }
2632 }
2633
2634 proc nextfile {} {
2635     global difffilestart ctext
2636     set here [$ctext index @0,0]
2637     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2638         if {[$ctext compare $difffilestart($i) > $here]} {
2639             if {![info exists pos]
2640                 || [$ctext compare $difffilestart($i) < $pos]} {
2641                 set pos $difffilestart($i)
2642             }
2643         }
2644     }
2645     if {[info exists pos]} {
2646         $ctext yview $pos
2647     }
2648 }
2649
2650 proc listboxsel {} {
2651     global ctext cflist currentid
2652     if {![info exists currentid]} return
2653     set sel [lsort [$cflist curselection]]
2654     if {$sel eq {}} return
2655     set first [lindex $sel 0]
2656     catch {$ctext yview fmark.$first}
2657 }
2658
2659 proc setcoords {} {
2660     global linespc charspc canvx0 canvy0 mainfont
2661     global xspc1 xspc2 lthickness
2662
2663     set linespc [font metrics $mainfont -linespace]
2664     set charspc [font measure $mainfont "m"]
2665     set canvy0 [expr {3 + 0.5 * $linespc}]
2666     set canvx0 [expr {3 + 0.5 * $linespc}]
2667     set lthickness [expr {int($linespc / 9) + 1}]
2668     set xspc1(0) $linespc
2669     set xspc2 $linespc
2670 }
2671
2672 proc redisplay {} {
2673     global stopped redisplaying phase
2674     if {$stopped > 1} return
2675     if {$phase == "getcommits"} return
2676     set redisplaying 1
2677     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2678         set stopped 1
2679     } else {
2680         drawgraph
2681     }
2682 }
2683
2684 proc incrfont {inc} {
2685     global mainfont namefont textfont ctext canv phase
2686     global stopped entries
2687     unmarkmatches
2688     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2689     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2690     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2691     setcoords
2692     $ctext conf -font $textfont
2693     $ctext tag conf filesep -font [concat $textfont bold]
2694     foreach e $entries {
2695         $e conf -font $mainfont
2696     }
2697     if {$phase == "getcommits"} {
2698         $canv itemconf textitems -font $mainfont
2699     }
2700     redisplay
2701 }
2702
2703 proc clearsha1 {} {
2704     global sha1entry sha1string
2705     if {[string length $sha1string] == 40} {
2706         $sha1entry delete 0 end
2707     }
2708 }
2709
2710 proc sha1change {n1 n2 op} {
2711     global sha1string currentid sha1but
2712     if {$sha1string == {}
2713         || ([info exists currentid] && $sha1string == $currentid)} {
2714         set state disabled
2715     } else {
2716         set state normal
2717     }
2718     if {[$sha1but cget -state] == $state} return
2719     if {$state == "normal"} {
2720         $sha1but conf -state normal -relief raised -text "Goto: "
2721     } else {
2722         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2723     }
2724 }
2725
2726 proc gotocommit {} {
2727     global sha1string currentid idline tagids
2728     global lineid numcommits
2729
2730     if {$sha1string == {}
2731         || ([info exists currentid] && $sha1string == $currentid)} return
2732     if {[info exists tagids($sha1string)]} {
2733         set id $tagids($sha1string)
2734     } else {
2735         set id [string tolower $sha1string]
2736         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2737             set matches {}
2738             for {set l 0} {$l < $numcommits} {incr l} {
2739                 if {[string match $id* $lineid($l)]} {
2740                     lappend matches $lineid($l)
2741                 }
2742             }
2743             if {$matches ne {}} {
2744                 if {[llength $matches] > 1} {
2745                     error_popup "Short SHA1 id $id is ambiguous"
2746                     return
2747                 }
2748                 set id [lindex $matches 0]
2749             }
2750         }
2751     }
2752     if {[info exists idline($id)]} {
2753         selectline $idline($id) 1
2754         return
2755     }
2756     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2757         set type "SHA1 id"
2758     } else {
2759         set type "Tag"
2760     }
2761     error_popup "$type $sha1string is not known"
2762 }
2763
2764 proc lineenter {x y id} {
2765     global hoverx hovery hoverid hovertimer
2766     global commitinfo canv
2767
2768     if {![info exists commitinfo($id)]} return
2769     set hoverx $x
2770     set hovery $y
2771     set hoverid $id
2772     if {[info exists hovertimer]} {
2773         after cancel $hovertimer
2774     }
2775     set hovertimer [after 500 linehover]
2776     $canv delete hover
2777 }
2778
2779 proc linemotion {x y id} {
2780     global hoverx hovery hoverid hovertimer
2781
2782     if {[info exists hoverid] && $id == $hoverid} {
2783         set hoverx $x
2784         set hovery $y
2785         if {[info exists hovertimer]} {
2786             after cancel $hovertimer
2787         }
2788         set hovertimer [after 500 linehover]
2789     }
2790 }
2791
2792 proc lineleave {id} {
2793     global hoverid hovertimer canv
2794
2795     if {[info exists hoverid] && $id == $hoverid} {
2796         $canv delete hover
2797         if {[info exists hovertimer]} {
2798             after cancel $hovertimer
2799             unset hovertimer
2800         }
2801         unset hoverid
2802     }
2803 }
2804
2805 proc linehover {} {
2806     global hoverx hovery hoverid hovertimer
2807     global canv linespc lthickness
2808     global commitinfo mainfont
2809
2810     set text [lindex $commitinfo($hoverid) 0]
2811     set ymax [lindex [$canv cget -scrollregion] 3]
2812     if {$ymax == {}} return
2813     set yfrac [lindex [$canv yview] 0]
2814     set x [expr {$hoverx + 2 * $linespc}]
2815     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2816     set x0 [expr {$x - 2 * $lthickness}]
2817     set y0 [expr {$y - 2 * $lthickness}]
2818     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2819     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2820     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2821                -fill \#ffff80 -outline black -width 1 -tags hover]
2822     $canv raise $t
2823     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2824     $canv raise $t
2825 }
2826
2827 proc clickisonarrow {id y} {
2828     global mainline mainlinearrow sidelines lthickness
2829
2830     set thresh [expr {2 * $lthickness + 6}]
2831     if {[info exists mainline($id)]} {
2832         if {$mainlinearrow($id) ne "none"} {
2833             if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
2834                 return "up"
2835             }
2836         }
2837     }
2838     if {[info exists sidelines($id)]} {
2839         foreach ls $sidelines($id) {
2840             set coords [lindex $ls 0]
2841             set arrow [lindex $ls 2]
2842             if {$arrow eq "first" || $arrow eq "both"} {
2843                 if {abs([lindex $coords 1] - $y) < $thresh} {
2844                     return "up"
2845                 }
2846             }
2847             if {$arrow eq "last" || $arrow eq "both"} {
2848                 if {abs([lindex $coords end] - $y) < $thresh} {
2849                     return "down"
2850                 }
2851             }
2852         }
2853     }
2854     return {}
2855 }
2856
2857 proc arrowjump {id dirn y} {
2858     global mainline sidelines canv canv2 canv3
2859
2860     set yt {}
2861     if {$dirn eq "down"} {
2862         if {[info exists mainline($id)]} {
2863             set y1 [lindex $mainline($id) 1]
2864             if {$y1 > $y} {
2865                 set yt $y1
2866             }
2867         }
2868         if {[info exists sidelines($id)]} {
2869             foreach ls $sidelines($id) {
2870                 set y1 [lindex $ls 0 1]
2871                 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
2872                     set yt $y1
2873                 }
2874             }
2875         }
2876     } else {
2877         if {[info exists sidelines($id)]} {
2878             foreach ls $sidelines($id) {
2879                 set y1 [lindex $ls 0 end]
2880                 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
2881                     set yt $y1
2882                 }
2883             }
2884         }
2885     }
2886     if {$yt eq {}} return
2887     set ymax [lindex [$canv cget -scrollregion] 3]
2888     if {$ymax eq {} || $ymax <= 0} return
2889     set view [$canv yview]
2890     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2891     set yfrac [expr {$yt / $ymax - $yspan / 2}]
2892     if {$yfrac < 0} {
2893         set yfrac 0
2894     }
2895     $canv yview moveto $yfrac
2896     $canv2 yview moveto $yfrac
2897     $canv3 yview moveto $yfrac
2898 }
2899
2900 proc lineclick {x y id isnew} {
2901     global ctext commitinfo children cflist canv thickerline
2902
2903     unmarkmatches
2904     unselectline
2905     normalline
2906     $canv delete hover
2907     # draw this line thicker than normal
2908     drawlines $id 1 1
2909     set thickerline $id
2910     if {$isnew} {
2911         set ymax [lindex [$canv cget -scrollregion] 3]
2912         if {$ymax eq {}} return
2913         set yfrac [lindex [$canv yview] 0]
2914         set y [expr {$y + $yfrac * $ymax}]
2915     }
2916     set dirn [clickisonarrow $id $y]
2917     if {$dirn ne {}} {
2918         arrowjump $id $dirn $y
2919         return
2920     }
2921
2922     if {$isnew} {
2923         addtohistory [list lineclick $x $y $id 0]
2924     }
2925     # fill the details pane with info about this line
2926     $ctext conf -state normal
2927     $ctext delete 0.0 end
2928     $ctext tag conf link -foreground blue -underline 1
2929     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2930     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2931     $ctext insert end "Parent:\t"
2932     $ctext insert end $id [list link link0]
2933     $ctext tag bind link0 <1> [list selbyid $id]
2934     set info $commitinfo($id)
2935     $ctext insert end "\n\t[lindex $info 0]\n"
2936     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2937     set date [formatdate [lindex $info 2]]
2938     $ctext insert end "\tDate:\t$date\n"
2939     if {[info exists children($id)]} {
2940         $ctext insert end "\nChildren:"
2941         set i 0
2942         foreach child $children($id) {
2943             incr i
2944             set info $commitinfo($child)
2945             $ctext insert end "\n\t"
2946             $ctext insert end $child [list link link$i]
2947             $ctext tag bind link$i <1> [list selbyid $child]
2948             $ctext insert end "\n\t[lindex $info 0]"
2949             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2950             set date [formatdate [lindex $info 2]]
2951             $ctext insert end "\n\tDate:\t$date\n"
2952         }
2953     }
2954     $ctext conf -state disabled
2955
2956     $cflist delete 0 end
2957 }
2958
2959 proc normalline {} {
2960     global thickerline
2961     if {[info exists thickerline]} {
2962         drawlines $thickerline 0 1
2963         unset thickerline
2964     }
2965 }
2966
2967 proc selbyid {id} {
2968     global idline
2969     if {[info exists idline($id)]} {
2970         selectline $idline($id) 1
2971     }
2972 }
2973
2974 proc mstime {} {
2975     global startmstime
2976     if {![info exists startmstime]} {
2977         set startmstime [clock clicks -milliseconds]
2978     }
2979     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2980 }
2981
2982 proc rowmenu {x y id} {
2983     global rowctxmenu idline selectedline rowmenuid
2984
2985     if {![info exists selectedline] || $idline($id) eq $selectedline} {
2986         set state disabled
2987     } else {
2988         set state normal
2989     }
2990     $rowctxmenu entryconfigure 0 -state $state
2991     $rowctxmenu entryconfigure 1 -state $state
2992     $rowctxmenu entryconfigure 2 -state $state
2993     set rowmenuid $id
2994     tk_popup $rowctxmenu $x $y
2995 }
2996
2997 proc diffvssel {dirn} {
2998     global rowmenuid selectedline lineid
2999
3000     if {![info exists selectedline]} return
3001     if {$dirn} {
3002         set oldid $lineid($selectedline)
3003         set newid $rowmenuid
3004     } else {
3005         set oldid $rowmenuid
3006         set newid $lineid($selectedline)
3007     }
3008     addtohistory [list doseldiff $oldid $newid]
3009     doseldiff $oldid $newid
3010 }
3011
3012 proc doseldiff {oldid newid} {
3013     global ctext cflist
3014     global commitinfo
3015
3016     $ctext conf -state normal
3017     $ctext delete 0.0 end
3018     $ctext mark set fmark.0 0.0
3019     $ctext mark gravity fmark.0 left
3020     $cflist delete 0 end
3021     $cflist insert end "Top"
3022     $ctext insert end "From "
3023     $ctext tag conf link -foreground blue -underline 1
3024     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3025     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3026     $ctext tag bind link0 <1> [list selbyid $oldid]
3027     $ctext insert end $oldid [list link link0]
3028     $ctext insert end "\n     "
3029     $ctext insert end [lindex $commitinfo($oldid) 0]
3030     $ctext insert end "\n\nTo   "
3031     $ctext tag bind link1 <1> [list selbyid $newid]
3032     $ctext insert end $newid [list link link1]
3033     $ctext insert end "\n     "
3034     $ctext insert end [lindex $commitinfo($newid) 0]
3035     $ctext insert end "\n"
3036     $ctext conf -state disabled
3037     $ctext tag delete Comments
3038     $ctext tag remove found 1.0 end
3039     startdiff [list $oldid $newid]
3040 }
3041
3042 proc mkpatch {} {
3043     global rowmenuid currentid commitinfo patchtop patchnum
3044
3045     if {![info exists currentid]} return
3046     set oldid $currentid
3047     set oldhead [lindex $commitinfo($oldid) 0]
3048     set newid $rowmenuid
3049     set newhead [lindex $commitinfo($newid) 0]
3050     set top .patch
3051     set patchtop $top
3052     catch {destroy $top}
3053     toplevel $top
3054     label $top.title -text "Generate patch"
3055     grid $top.title - -pady 10
3056     label $top.from -text "From:"
3057     entry $top.fromsha1 -width 40 -relief flat
3058     $top.fromsha1 insert 0 $oldid
3059     $top.fromsha1 conf -state readonly
3060     grid $top.from $top.fromsha1 -sticky w
3061     entry $top.fromhead -width 60 -relief flat
3062     $top.fromhead insert 0 $oldhead
3063     $top.fromhead conf -state readonly
3064     grid x $top.fromhead -sticky w
3065     label $top.to -text "To:"
3066     entry $top.tosha1 -width 40 -relief flat
3067     $top.tosha1 insert 0 $newid
3068     $top.tosha1 conf -state readonly
3069     grid $top.to $top.tosha1 -sticky w
3070     entry $top.tohead -width 60 -relief flat
3071     $top.tohead insert 0 $newhead
3072     $top.tohead conf -state readonly
3073     grid x $top.tohead -sticky w
3074     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3075     grid $top.rev x -pady 10
3076     label $top.flab -text "Output file:"
3077     entry $top.fname -width 60
3078     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3079     incr patchnum
3080     grid $top.flab $top.fname -sticky w
3081     frame $top.buts
3082     button $top.buts.gen -text "Generate" -command mkpatchgo
3083     button $top.buts.can -text "Cancel" -command mkpatchcan
3084     grid $top.buts.gen $top.buts.can
3085     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3086     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3087     grid $top.buts - -pady 10 -sticky ew
3088     focus $top.fname
3089 }
3090
3091 proc mkpatchrev {} {
3092     global patchtop
3093
3094     set oldid [$patchtop.fromsha1 get]
3095     set oldhead [$patchtop.fromhead get]
3096     set newid [$patchtop.tosha1 get]
3097     set newhead [$patchtop.tohead get]
3098     foreach e [list fromsha1 fromhead tosha1 tohead] \
3099             v [list $newid $newhead $oldid $oldhead] {
3100         $patchtop.$e conf -state normal
3101         $patchtop.$e delete 0 end
3102         $patchtop.$e insert 0 $v
3103         $patchtop.$e conf -state readonly
3104     }
3105 }
3106
3107 proc mkpatchgo {} {
3108     global patchtop
3109
3110     set oldid [$patchtop.fromsha1 get]
3111     set newid [$patchtop.tosha1 get]
3112     set fname [$patchtop.fname get]
3113     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3114         error_popup "Error creating patch: $err"
3115     }
3116     catch {destroy $patchtop}
3117     unset patchtop
3118 }
3119
3120 proc mkpatchcan {} {
3121     global patchtop
3122
3123     catch {destroy $patchtop}
3124     unset patchtop
3125 }
3126
3127 proc mktag {} {
3128     global rowmenuid mktagtop commitinfo
3129
3130     set top .maketag
3131     set mktagtop $top
3132     catch {destroy $top}
3133     toplevel $top
3134     label $top.title -text "Create tag"
3135     grid $top.title - -pady 10
3136     label $top.id -text "ID:"
3137     entry $top.sha1 -width 40 -relief flat
3138     $top.sha1 insert 0 $rowmenuid
3139     $top.sha1 conf -state readonly
3140     grid $top.id $top.sha1 -sticky w
3141     entry $top.head -width 60 -relief flat
3142     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3143     $top.head conf -state readonly
3144     grid x $top.head -sticky w
3145     label $top.tlab -text "Tag name:"
3146     entry $top.tag -width 60
3147     grid $top.tlab $top.tag -sticky w
3148     frame $top.buts
3149     button $top.buts.gen -text "Create" -command mktaggo
3150     button $top.buts.can -text "Cancel" -command mktagcan
3151     grid $top.buts.gen $top.buts.can
3152     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3153     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3154     grid $top.buts - -pady 10 -sticky ew
3155     focus $top.tag
3156 }
3157
3158 proc domktag {} {
3159     global mktagtop env tagids idtags
3160
3161     set id [$mktagtop.sha1 get]
3162     set tag [$mktagtop.tag get]
3163     if {$tag == {}} {
3164         error_popup "No tag name specified"
3165         return
3166     }
3167     if {[info exists tagids($tag)]} {
3168         error_popup "Tag \"$tag\" already exists"
3169         return
3170     }
3171     if {[catch {
3172         set dir [gitdir]
3173         set fname [file join $dir "refs/tags" $tag]
3174         set f [open $fname w]
3175         puts $f $id
3176         close $f
3177     } err]} {
3178         error_popup "Error creating tag: $err"
3179         return
3180     }
3181
3182     set tagids($tag) $id
3183     lappend idtags($id) $tag
3184     redrawtags $id
3185 }
3186
3187 proc redrawtags {id} {
3188     global canv linehtag idline idpos selectedline
3189
3190     if {![info exists idline($id)]} return
3191     $canv delete tag.$id
3192     set xt [eval drawtags $id $idpos($id)]
3193     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3194     if {[info exists selectedline] && $selectedline == $idline($id)} {
3195         selectline $selectedline 0
3196     }
3197 }
3198
3199 proc mktagcan {} {
3200     global mktagtop
3201
3202     catch {destroy $mktagtop}
3203     unset mktagtop
3204 }
3205
3206 proc mktaggo {} {
3207     domktag
3208     mktagcan
3209 }
3210
3211 proc writecommit {} {
3212     global rowmenuid wrcomtop commitinfo wrcomcmd
3213
3214     set top .writecommit
3215     set wrcomtop $top
3216     catch {destroy $top}
3217     toplevel $top
3218     label $top.title -text "Write commit to file"
3219     grid $top.title - -pady 10
3220     label $top.id -text "ID:"
3221     entry $top.sha1 -width 40 -relief flat
3222     $top.sha1 insert 0 $rowmenuid
3223     $top.sha1 conf -state readonly
3224     grid $top.id $top.sha1 -sticky w
3225     entry $top.head -width 60 -relief flat
3226     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3227     $top.head conf -state readonly
3228     grid x $top.head -sticky w
3229     label $top.clab -text "Command:"
3230     entry $top.cmd -width 60 -textvariable wrcomcmd
3231     grid $top.clab $top.cmd -sticky w -pady 10
3232     label $top.flab -text "Output file:"
3233     entry $top.fname -width 60
3234     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3235     grid $top.flab $top.fname -sticky w
3236     frame $top.buts
3237     button $top.buts.gen -text "Write" -command wrcomgo
3238     button $top.buts.can -text "Cancel" -command wrcomcan
3239     grid $top.buts.gen $top.buts.can
3240     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3241     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3242     grid $top.buts - -pady 10 -sticky ew
3243     focus $top.fname
3244 }
3245
3246 proc wrcomgo {} {
3247     global wrcomtop
3248
3249     set id [$wrcomtop.sha1 get]
3250     set cmd "echo $id | [$wrcomtop.cmd get]"
3251     set fname [$wrcomtop.fname get]
3252     if {[catch {exec sh -c $cmd >$fname &} err]} {
3253         error_popup "Error writing commit: $err"
3254     }
3255     catch {destroy $wrcomtop}
3256     unset wrcomtop
3257 }
3258
3259 proc wrcomcan {} {
3260     global wrcomtop
3261
3262     catch {destroy $wrcomtop}
3263     unset wrcomtop
3264 }
3265
3266 proc listrefs {id} {
3267     global idtags idheads idotherrefs
3268
3269     set x {}
3270     if {[info exists idtags($id)]} {
3271         set x $idtags($id)
3272     }
3273     set y {}
3274     if {[info exists idheads($id)]} {
3275         set y $idheads($id)
3276     }
3277     set z {}
3278     if {[info exists idotherrefs($id)]} {
3279         set z $idotherrefs($id)
3280     }
3281     return [list $x $y $z]
3282 }
3283
3284 proc rereadrefs {} {
3285     global idtags idheads idotherrefs
3286     global tagids headids otherrefids
3287
3288     set refids [concat [array names idtags] \
3289                     [array names idheads] [array names idotherrefs]]
3290     foreach id $refids {
3291         if {![info exists ref($id)]} {
3292             set ref($id) [listrefs $id]
3293         }
3294     }
3295     readrefs
3296     set refids [lsort -unique [concat $refids [array names idtags] \
3297                         [array names idheads] [array names idotherrefs]]]
3298     foreach id $refids {
3299         set v [listrefs $id]
3300         if {![info exists ref($id)] || $ref($id) != $v} {
3301             redrawtags $id
3302         }
3303     }
3304 }
3305
3306 proc showtag {tag isnew} {
3307     global ctext cflist tagcontents tagids linknum
3308
3309     if {$isnew} {
3310         addtohistory [list showtag $tag 0]
3311     }
3312     $ctext conf -state normal
3313     $ctext delete 0.0 end
3314     set linknum 0
3315     if {[info exists tagcontents($tag)]} {
3316         set text $tagcontents($tag)
3317     } else {
3318         set text "Tag: $tag\nId:  $tagids($tag)"
3319     }
3320     appendwithlinks $text
3321     $ctext conf -state disabled
3322     $cflist delete 0 end
3323 }
3324
3325 proc doquit {} {
3326     global stopped
3327     set stopped 100
3328     destroy .
3329 }
3330
3331 proc doprefs {} {
3332     global maxwidth maxgraphpct diffopts findmergefiles
3333     global oldprefs prefstop
3334
3335     set top .gitkprefs
3336     set prefstop $top
3337     if {[winfo exists $top]} {
3338         raise $top
3339         return
3340     }
3341     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3342         set oldprefs($v) [set $v]
3343     }
3344     toplevel $top
3345     wm title $top "Gitk preferences"
3346     label $top.ldisp -text "Commit list display options"
3347     grid $top.ldisp - -sticky w -pady 10
3348     label $top.spacer -text " "
3349     label $top.maxwidthl -text "Maximum graph width (lines)" \
3350         -font optionfont
3351     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3352     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3353     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3354         -font optionfont
3355     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3356     grid x $top.maxpctl $top.maxpct -sticky w
3357     checkbutton $top.findm -variable findmergefiles
3358     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3359         -font optionfont
3360     grid $top.findm $top.findml - -sticky w
3361     label $top.ddisp -text "Diff display options"
3362     grid $top.ddisp - -sticky w -pady 10
3363     label $top.diffoptl -text "Options for diff program" \
3364         -font optionfont
3365     entry $top.diffopt -width 20 -textvariable diffopts
3366     grid x $top.diffoptl $top.diffopt -sticky w
3367     frame $top.buts
3368     button $top.buts.ok -text "OK" -command prefsok
3369     button $top.buts.can -text "Cancel" -command prefscan
3370     grid $top.buts.ok $top.buts.can
3371     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3372     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3373     grid $top.buts - - -pady 10 -sticky ew
3374 }
3375
3376 proc prefscan {} {
3377     global maxwidth maxgraphpct diffopts findmergefiles
3378     global oldprefs prefstop
3379
3380     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3381         set $v $oldprefs($v)
3382     }
3383     catch {destroy $prefstop}
3384     unset prefstop
3385 }
3386
3387 proc prefsok {} {
3388     global maxwidth maxgraphpct
3389     global oldprefs prefstop
3390
3391     catch {destroy $prefstop}
3392     unset prefstop
3393     if {$maxwidth != $oldprefs(maxwidth)
3394         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3395         redisplay
3396     }
3397 }
3398
3399 proc formatdate {d} {
3400     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3401 }
3402
3403 # This list of encoding names and aliases is distilled from
3404 # http://www.iana.org/assignments/character-sets.
3405 # Not all of them are supported by Tcl.
3406 set encoding_aliases {
3407     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3408       ISO646-US US-ASCII us IBM367 cp367 csASCII }
3409     { ISO-10646-UTF-1 csISO10646UTF1 }
3410     { ISO_646.basic:1983 ref csISO646basic1983 }
3411     { INVARIANT csINVARIANT }
3412     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3413     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3414     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3415     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3416     { NATS-DANO iso-ir-9-1 csNATSDANO }
3417     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3418     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3419     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3420     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3421     { ISO-2022-KR csISO2022KR }
3422     { EUC-KR csEUCKR }
3423     { ISO-2022-JP csISO2022JP }
3424     { ISO-2022-JP-2 csISO2022JP2 }
3425     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3426       csISO13JISC6220jp }
3427     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3428     { IT iso-ir-15 ISO646-IT csISO15Italian }
3429     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3430     { ES iso-ir-17 ISO646-ES csISO17Spanish }
3431     { greek7-old iso-ir-18 csISO18Greek7Old }
3432     { latin-greek iso-ir-19 csISO19LatinGreek }
3433     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3434     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3435     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3436     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3437     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3438     { BS_viewdata iso-ir-47 csISO47BSViewdata }
3439     { INIS iso-ir-49 csISO49INIS }
3440     { INIS-8 iso-ir-50 csISO50INIS8 }
3441     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3442     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3443     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3444     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3445     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3446     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3447       csISO60Norwegian1 }
3448     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3449     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3450     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3451     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3452     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3453     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3454     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3455     { greek7 iso-ir-88 csISO88Greek7 }
3456     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3457     { iso-ir-90 csISO90 }
3458     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3459     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3460       csISO92JISC62991984b }
3461     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3462     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3463     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3464       csISO95JIS62291984handadd }
3465     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3466     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3467     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3468     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3469       CP819 csISOLatin1 }
3470     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3471     { T.61-7bit iso-ir-102 csISO102T617bit }
3472     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3473     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3474     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3475     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3476     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3477     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3478     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3479     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3480       arabic csISOLatinArabic }
3481     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3482     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3483     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3484       greek greek8 csISOLatinGreek }
3485     { T.101-G2 iso-ir-128 csISO128T101G2 }
3486     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3487       csISOLatinHebrew }
3488     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3489     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3490     { CSN_369103 iso-ir-139 csISO139CSN369103 }
3491     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3492     { ISO_6937-2-add iso-ir-142 csISOTextComm }
3493     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3494     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3495       csISOLatinCyrillic }
3496     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3497     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3498     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3499     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3500     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3501     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3502     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3503     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3504     { ISO_10367-box iso-ir-155 csISO10367Box }
3505     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3506     { latin-lap lap iso-ir-158 csISO158Lap }
3507     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3508     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3509     { us-dk csUSDK }
3510     { dk-us csDKUS }
3511     { JIS_X0201 X0201 csHalfWidthKatakana }
3512     { KSC5636 ISO646-KR csKSC5636 }
3513     { ISO-10646-UCS-2 csUnicode }
3514     { ISO-10646-UCS-4 csUCS4 }
3515     { DEC-MCS dec csDECMCS }
3516     { hp-roman8 roman8 r8 csHPRoman8 }
3517     { macintosh mac csMacintosh }
3518     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3519       csIBM037 }
3520     { IBM038 EBCDIC-INT cp038 csIBM038 }
3521     { IBM273 CP273 csIBM273 }
3522     { IBM274 EBCDIC-BE CP274 csIBM274 }
3523     { IBM275 EBCDIC-BR cp275 csIBM275 }
3524     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3525     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3526     { IBM280 CP280 ebcdic-cp-it csIBM280 }
3527     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3528     { IBM284 CP284 ebcdic-cp-es csIBM284 }
3529     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3530     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3531     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3532     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3533     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3534     { IBM424 cp424 ebcdic-cp-he csIBM424 }
3535     { IBM437 cp437 437 csPC8CodePage437 }
3536     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3537     { IBM775 cp775 csPC775Baltic }
3538     { IBM850 cp850 850 csPC850Multilingual }
3539     { IBM851 cp851 851 csIBM851 }
3540     { IBM852 cp852 852 csPCp852 }
3541     { IBM855 cp855 855 csIBM855 }
3542     { IBM857 cp857 857 csIBM857 }
3543     { IBM860 cp860 860 csIBM860 }
3544     { IBM861 cp861 861 cp-is csIBM861 }
3545     { IBM862 cp862 862 csPC862LatinHebrew }
3546     { IBM863 cp863 863 csIBM863 }
3547     { IBM864 cp864 csIBM864 }
3548     { IBM865 cp865 865 csIBM865 }
3549     { IBM866 cp866 866 csIBM866 }
3550     { IBM868 CP868 cp-ar csIBM868 }
3551     { IBM869 cp869 869 cp-gr csIBM869 }
3552     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3553     { IBM871 CP871 ebcdic-cp-is csIBM871 }
3554     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3555     { IBM891 cp891 csIBM891 }
3556     { IBM903 cp903 csIBM903 }
3557     { IBM904 cp904 904 csIBBM904 }
3558     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3559     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3560     { IBM1026 CP1026 csIBM1026 }
3561     { EBCDIC-AT-DE csIBMEBCDICATDE }
3562     { EBCDIC-AT-DE-A csEBCDICATDEA }
3563     { EBCDIC-CA-FR csEBCDICCAFR }
3564     { EBCDIC-DK-NO csEBCDICDKNO }
3565     { EBCDIC-DK-NO-A csEBCDICDKNOA }
3566     { EBCDIC-FI-SE csEBCDICFISE }
3567     { EBCDIC-FI-SE-A csEBCDICFISEA }
3568     { EBCDIC-FR csEBCDICFR }
3569     { EBCDIC-IT csEBCDICIT }
3570     { EBCDIC-PT csEBCDICPT }
3571     { EBCDIC-ES csEBCDICES }
3572     { EBCDIC-ES-A csEBCDICESA }
3573     { EBCDIC-ES-S csEBCDICESS }
3574     { EBCDIC-UK csEBCDICUK }
3575     { EBCDIC-US csEBCDICUS }
3576     { UNKNOWN-8BIT csUnknown8BiT }
3577     { MNEMONIC csMnemonic }
3578     { MNEM csMnem }
3579     { VISCII csVISCII }
3580     { VIQR csVIQR }
3581     { KOI8-R csKOI8R }
3582     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3583     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3584     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3585     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3586     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3587     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3588     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3589     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3590     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3591     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3592     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3593     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3594     { IBM1047 IBM-1047 }
3595     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3596     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3597     { UNICODE-1-1 csUnicode11 }
3598     { CESU-8 csCESU-8 }
3599     { BOCU-1 csBOCU-1 }
3600     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3601     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3602       l8 }
3603     { ISO-8859-15 ISO_8859-15 Latin-9 }
3604     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3605     { GBK CP936 MS936 windows-936 }
3606     { JIS_Encoding csJISEncoding }
3607     { Shift_JIS MS_Kanji csShiftJIS }
3608     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3609       EUC-JP }
3610     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3611     { ISO-10646-UCS-Basic csUnicodeASCII }
3612     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3613     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3614     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3615     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3616     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3617     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3618     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3619     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3620     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3621     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3622     { Adobe-Standard-Encoding csAdobeStandardEncoding }
3623     { Ventura-US csVenturaUS }
3624     { Ventura-International csVenturaInternational }
3625     { PC8-Danish-Norwegian csPC8DanishNorwegian }
3626     { PC8-Turkish csPC8Turkish }
3627     { IBM-Symbols csIBMSymbols }
3628     { IBM-Thai csIBMThai }
3629     { HP-Legal csHPLegal }
3630     { HP-Pi-font csHPPiFont }
3631     { HP-Math8 csHPMath8 }
3632     { Adobe-Symbol-Encoding csHPPSMath }
3633     { HP-DeskTop csHPDesktop }
3634     { Ventura-Math csVenturaMath }
3635     { Microsoft-Publishing csMicrosoftPublishing }
3636     { Windows-31J csWindows31J }
3637     { GB2312 csGB2312 }
3638     { Big5 csBig5 }
3639 }
3640
3641 proc tcl_encoding {enc} {
3642     global encoding_aliases
3643     set names [encoding names]
3644     set lcnames [string tolower $names]
3645     set enc [string tolower $enc]
3646     set i [lsearch -exact $lcnames $enc]
3647     if {$i < 0} {
3648         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3649         if {[regsub {^iso[-_]} $enc iso encx]} {
3650             set i [lsearch -exact $lcnames $encx]
3651         }
3652     }
3653     if {$i < 0} {
3654         foreach l $encoding_aliases {
3655             set ll [string tolower $l]
3656             if {[lsearch -exact $ll $enc] < 0} continue
3657             # look through the aliases for one that tcl knows about
3658             foreach e $ll {
3659                 set i [lsearch -exact $lcnames $e]
3660                 if {$i < 0} {
3661                     if {[regsub {^iso[-_]} $e iso ex]} {
3662                         set i [lsearch -exact $lcnames $ex]
3663                     }
3664                 }
3665                 if {$i >= 0} break
3666             }
3667             break
3668         }
3669     }
3670     if {$i >= 0} {
3671         return [lindex $names $i]
3672     }
3673     return {}
3674 }
3675
3676 # defaults...
3677 set datemode 0
3678 set diffopts "-U 5 -p"
3679 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3680
3681 set gitencoding {}
3682 catch {
3683     set gitencoding [exec git-repo-config --get i18n.commitencoding]
3684 }
3685 if {$gitencoding == ""} {
3686     set gitencoding "utf-8"
3687 }
3688 set tclencoding [tcl_encoding $gitencoding]
3689 if {$tclencoding == {}} {
3690     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3691 }
3692
3693 set mainfont {Helvetica 9}
3694 set textfont {Courier 9}
3695 set findmergefiles 0
3696 set maxgraphpct 50
3697 set maxwidth 16
3698 set revlistorder 0
3699 set fastdate 0
3700
3701 set colors {green red blue magenta darkgrey brown orange}
3702
3703 catch {source ~/.gitk}
3704
3705 set namefont $mainfont
3706
3707 font create optionfont -family sans-serif -size -12
3708
3709 set revtreeargs {}
3710 foreach arg $argv {
3711     switch -regexp -- $arg {
3712         "^$" { }
3713         "^-d" { set datemode 1 }
3714         "^-r" { set revlistorder 1 }
3715         default {
3716             lappend revtreeargs $arg
3717         }
3718     }
3719 }
3720
3721 set history {}
3722 set historyindex 0
3723
3724 set stopped 0
3725 set redisplaying 0
3726 set stuffsaved 0
3727 set patchnum 0
3728 setcoords
3729 makewindow $revtreeargs
3730 readrefs
3731 getcommits $revtreeargs