gitk

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