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