gitk

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