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