gitk

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