gitk

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