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