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