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