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