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