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