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         for {} {$col < [llength $offs]} {incr col} {
1117             if {[lindex $idlist $col] eq {}} {
1118                 set haspad 1
1119                 continue
1120             }
1121             set z [lindex $offs $col]
1122             if {$z eq {}} continue
1123             set isarrow 0
1124             set x0 [expr {$col + $z}]
1125             set y0 [expr {$row - 1}]
1126             set z0 [lindex $rowoffsets $y0 $x0]
1127             if {$z0 eq {}} {
1128                 set id [lindex $idlist $col]
1129                 if {[info exists idrowranges($id)] &&
1130                     $y0 > [lindex $idrowranges($id) 0]} {
1131                     set isarrow 1
1132                 }
1133             }
1134             if {$z < -1 || ($z < 0 && $isarrow)} {
1135                 set npad [expr {-1 - $z + $isarrow}]
1136                 set offs [incrange $offs $col $npad]
1137                 insert_pad $y0 $x0 $npad
1138                 if {$y0 > 0} {
1139                     optimize_rows $y0 $x0 $row
1140                 }
1141                 set z [lindex $offs $col]
1142                 set x0 [expr {$col + $z}]
1143                 set z0 [lindex $rowoffsets $y0 $x0]
1144             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1145                 set npad [expr {$z - 1 + $isarrow}]
1146                 set y1 [expr {$row + 1}]
1147                 set offs2 [lindex $rowoffsets $y1]
1148                 set x1 -1
1149                 foreach z $offs2 {
1150                     incr x1
1151                     if {$z eq {} || $x1 + $z < $col} continue
1152                     if {$x1 + $z > $col} {
1153                         incr npad
1154                     }
1155                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1156                     break
1157                 }
1158                 set pad [ntimes $npad {}]
1159                 set idlist [eval linsert \$idlist $col $pad]
1160                 set tmp [eval linsert \$offs $col $pad]
1161                 incr col $npad
1162                 set offs [incrange $tmp $col [expr {-$npad}]]
1163                 set z [lindex $offs $col]
1164                 set haspad 1
1165             }
1166             if {$z0 eq {} && !$isarrow} {
1167                 # this line links to its first child on row $row-2
1168                 set rm2 [expr {$row - 2}]
1169                 set id [lindex $displayorder $rm2]
1170                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1171                 if {$xc >= 0} {
1172                     set z0 [expr {$xc - $x0}]
1173                 }
1174             }
1175             if {$z0 ne {} && $z < 0 && $z0 > 0} {
1176                 insert_pad $y0 $x0 1
1177                 set offs [incrange $offs $col 1]
1178                 optimize_rows $y0 [expr {$x0 + 1}] $row
1179             }
1180         }
1181         if {!$haspad} {
1182             set o {}
1183             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1184                 set o [lindex $offs $col]
1185                 if {$o eq {}} {
1186                     # check if this is the link to the first child
1187                     set id [lindex $idlist $col]
1188                     if {[info exists idrowranges($id)] &&
1189                         $row == [lindex $idrowranges($id) 0]} {
1190                         # it is, work out offset to child
1191                         set y0 [expr {$row - 1}]
1192                         set id [lindex $displayorder $y0]
1193                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1194                         if {$x0 >= 0} {
1195                             set o [expr {$x0 - $col}]
1196                         }
1197                     }
1198                 }
1199                 if {$o eq {} || $o <= 0} break
1200             }
1201             if {$o ne {} && [incr col] < [llength $idlist]} {
1202                 set y1 [expr {$row + 1}]
1203                 set offs2 [lindex $rowoffsets $y1]
1204                 set x1 -1
1205                 foreach z $offs2 {
1206                     incr x1
1207                     if {$z eq {} || $x1 + $z < $col} continue
1208                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
1209                     break
1210                 }
1211                 set idlist [linsert $idlist $col {}]
1212                 set tmp [linsert $offs $col {}]
1213                 incr col
1214                 set offs [incrange $tmp $col -1]
1215             }
1216         }
1217         lset rowidlist $row $idlist
1218         lset rowoffsets $row $offs
1219         set col 0
1220     }
1221 }
1222
1223 proc xc {row col} {
1224     global canvx0 linespc
1225     return [expr {$canvx0 + $col * $linespc}]
1226 }
1227
1228 proc yc {row} {
1229     global canvy0 linespc
1230     return [expr {$canvy0 + $row * $linespc}]
1231 }
1232
1233 proc linewidth {id} {
1234     global thickerline lthickness
1235
1236     set wid $lthickness
1237     if {[info exists thickerline] && $id eq $thickerline} {
1238         set wid [expr {2 * $lthickness}]
1239     }
1240     return $wid
1241 }
1242
1243 proc drawlineseg {id i} {
1244     global rowoffsets rowidlist idrowranges
1245     global displayorder
1246     global canv colormap linespc
1247
1248     set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1249     set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1250     if {$startrow == $row} return
1251     assigncolor $id
1252     set coords {}
1253     set col [lsearch -exact [lindex $rowidlist $row] $id]
1254     if {$col < 0} {
1255         puts "oops: drawline: id $id not on row $row"
1256         return
1257     }
1258     set lasto {}
1259     set ns 0
1260     while {1} {
1261         set o [lindex $rowoffsets $row $col]
1262         if {$o eq {}} break
1263         if {$o ne $lasto} {
1264             # changing direction
1265             set x [xc $row $col]
1266             set y [yc $row]
1267             lappend coords $x $y
1268             set lasto $o
1269         }
1270         incr col $o
1271         incr row -1
1272     }
1273     set x [xc $row $col]
1274     set y [yc $row]
1275     lappend coords $x $y
1276     if {$i == 0} {
1277         # draw the link to the first child as part of this line
1278         incr row -1
1279         set child [lindex $displayorder $row]
1280         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1281         if {$ccol >= 0} {
1282             set x [xc $row $ccol]
1283             set y [yc $row]
1284             if {$ccol < $col - 1} {
1285                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1286             } elseif {$ccol > $col + 1} {
1287                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1288             }
1289             lappend coords $x $y
1290         }
1291     }
1292     if {[llength $coords] < 4} return
1293     set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1294     if {$i < $last} {
1295         # This line has an arrow at the lower end: check if the arrow is
1296         # on a diagonal segment, and if so, work around the Tk 8.4
1297         # refusal to draw arrows on diagonal lines.
1298         set x0 [lindex $coords 0]
1299         set x1 [lindex $coords 2]
1300         if {$x0 != $x1} {
1301             set y0 [lindex $coords 1]
1302             set y1 [lindex $coords 3]
1303             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1304                 # we have a nearby vertical segment, just trim off the diag bit
1305                 set coords [lrange $coords 2 end]
1306             } else {
1307                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1308                 set xi [expr {$x0 - $slope * $linespc / 2}]
1309                 set yi [expr {$y0 - $linespc / 2}]
1310                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1311             }
1312         }
1313     }
1314     set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1315     set arrow [lindex {none first last both} $arrow]
1316     set t [$canv create line $coords -width [linewidth $id] \
1317                -fill $colormap($id) -tags lines.$id -arrow $arrow]
1318     $canv lower $t
1319     bindline $t $id
1320 }
1321
1322 proc drawparentlinks {id row col olds} {
1323     global rowidlist canv colormap idrowranges
1324
1325     set row2 [expr {$row + 1}]
1326     set x [xc $row $col]
1327     set y [yc $row]
1328     set y2 [yc $row2]
1329     set ids [lindex $rowidlist $row2]
1330     # rmx = right-most X coord used
1331     set rmx 0
1332     foreach p $olds {
1333         set i [lsearch -exact $ids $p]
1334         if {$i < 0} {
1335             puts "oops, parent $p of $id not in list"
1336             continue
1337         }
1338         set x2 [xc $row2 $i]
1339         if {$x2 > $rmx} {
1340             set rmx $x2
1341         }
1342         if {[info exists idrowranges($p)] &&
1343             $row2 == [lindex $idrowranges($p) 0] &&
1344             $row2 < [lindex $idrowranges($p) 1]} {
1345             # drawlineseg will do this one for us
1346             continue
1347         }
1348         assigncolor $p
1349         # should handle duplicated parents here...
1350         set coords [list $x $y]
1351         if {$i < $col - 1} {
1352             lappend coords [xc $row [expr {$i + 1}]] $y
1353         } elseif {$i > $col + 1} {
1354             lappend coords [xc $row [expr {$i - 1}]] $y
1355         }
1356         lappend coords $x2 $y2
1357         set t [$canv create line $coords -width [linewidth $p] \
1358                    -fill $colormap($p) -tags lines.$p]
1359         $canv lower $t
1360         bindline $t $p
1361     }
1362     return $rmx
1363 }
1364
1365 proc drawlines {id} {
1366     global colormap canv
1367     global idrowranges idrangedrawn
1368     global children iddrawn commitrow rowidlist
1369
1370     $canv delete lines.$id
1371     set nr [expr {[llength $idrowranges($id)] / 2}]
1372     for {set i 0} {$i < $nr} {incr i} {
1373         if {[info exists idrangedrawn($id,$i)]} {
1374             drawlineseg $id $i
1375         }
1376     }
1377     if {[info exists children($id)]} {
1378         foreach child $children($id) {
1379             if {[info exists iddrawn($child)]} {
1380                 set row $commitrow($child)
1381                 set col [lsearch -exact [lindex $rowidlist $row] $child]
1382                 if {$col >= 0} {
1383                     drawparentlinks $child $row $col [list $id]
1384                 }
1385             }
1386         }
1387     }
1388 }
1389
1390 proc drawcmittext {id row col rmx} {
1391     global linespc canv canv2 canv3 canvy0
1392     global commitlisted commitinfo rowidlist
1393     global rowtextx idpos idtags idheads idotherrefs
1394     global linehtag linentag linedtag
1395     global mainfont namefont canvxmax
1396
1397     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1398     set x [xc $row $col]
1399     set y [yc $row]
1400     set orad [expr {$linespc / 3}]
1401     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1402                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1403                -fill $ofill -outline black -width 1]
1404     $canv raise $t
1405     $canv bind $t <1> {selcanvline {} %x %y}
1406     set xt [xc $row [llength [lindex $rowidlist $row]]]
1407     if {$xt < $rmx} {
1408         set xt $rmx
1409     }
1410     set rowtextx($row) $xt
1411     set idpos($id) [list $x $xt $y]
1412     if {[info exists idtags($id)] || [info exists idheads($id)]
1413         || [info exists idotherrefs($id)]} {
1414         set xt [drawtags $id $x $xt $y]
1415     }
1416     set headline [lindex $commitinfo($id) 0]
1417     set name [lindex $commitinfo($id) 1]
1418     set date [lindex $commitinfo($id) 2]
1419     set date [formatdate $date]
1420     set linehtag($row) [$canv create text $xt $y -anchor w \
1421                             -text $headline -font $mainfont ]
1422     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1423     set linentag($row) [$canv2 create text 3 $y -anchor w \
1424                             -text $name -font $namefont]
1425     set linedtag($row) [$canv3 create text 3 $y -anchor w \
1426                             -text $date -font $mainfont]
1427     set xr [expr {$xt + [font measure $mainfont $headline]}]
1428     if {$xr > $canvxmax} {
1429         set canvxmax $xr
1430         setcanvscroll
1431     }
1432 }
1433
1434 proc drawcmitrow {row} {
1435     global displayorder rowidlist
1436     global idrowranges idrangedrawn iddrawn
1437     global commitinfo commitlisted parents numcommits
1438
1439     if {$row >= $numcommits} return
1440     foreach id [lindex $rowidlist $row] {
1441         if {![info exists idrowranges($id)]} continue
1442         set i -1
1443         foreach {s e} $idrowranges($id) {
1444             incr i
1445             if {$row < $s} continue
1446             if {$e eq {}} break
1447             if {$row <= $e} {
1448                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1449                     drawlineseg $id $i
1450                     set idrangedrawn($id,$i) 1
1451                 }
1452                 break
1453             }
1454         }
1455     }
1456
1457     set id [lindex $displayorder $row]
1458     if {[info exists iddrawn($id)]} return
1459     set col [lsearch -exact [lindex $rowidlist $row] $id]
1460     if {$col < 0} {
1461         puts "oops, row $row id $id not in list"
1462         return
1463     }
1464     if {![info exists commitinfo($id)]} {
1465         getcommit $id
1466     }
1467     assigncolor $id
1468     if {[info exists commitlisted($id)] && [info exists parents($id)]
1469         && $parents($id) ne {}} {
1470         set rmx [drawparentlinks $id $row $col $parents($id)]
1471     } else {
1472         set rmx 0
1473     }
1474     drawcmittext $id $row $col $rmx
1475     set iddrawn($id) 1
1476 }
1477
1478 proc drawfrac {f0 f1} {
1479     global numcommits canv
1480     global linespc
1481
1482     set ymax [lindex [$canv cget -scrollregion] 3]
1483     if {$ymax eq {} || $ymax == 0} return
1484     set y0 [expr {int($f0 * $ymax)}]
1485     set row [expr {int(($y0 - 3) / $linespc) - 1}]
1486     if {$row < 0} {
1487         set row 0
1488     }
1489     set y1 [expr {int($f1 * $ymax)}]
1490     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1491     if {$endrow >= $numcommits} {
1492         set endrow [expr {$numcommits - 1}]
1493     }
1494     for {} {$row <= $endrow} {incr row} {
1495         drawcmitrow $row
1496     }
1497 }
1498
1499 proc drawvisible {} {
1500     global canv
1501     eval drawfrac [$canv yview]
1502 }
1503
1504 proc clear_display {} {
1505     global iddrawn idrangedrawn
1506
1507     allcanvs delete all
1508     catch {unset iddrawn}
1509     catch {unset idrangedrawn}
1510 }
1511
1512 proc assigncolor {id} {
1513     global colormap colors nextcolor
1514     global parents nparents children nchildren
1515     global cornercrossings crossings
1516
1517     if {[info exists colormap($id)]} return
1518     set ncolors [llength $colors]
1519     if {$nchildren($id) == 1} {
1520         set child [lindex $children($id) 0]
1521         if {[info exists colormap($child)]
1522             && $nparents($child) == 1} {
1523             set colormap($id) $colormap($child)
1524             return
1525         }
1526     }
1527     set badcolors {}
1528     if {[info exists cornercrossings($id)]} {
1529         foreach x $cornercrossings($id) {
1530             if {[info exists colormap($x)]
1531                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1532                 lappend badcolors $colormap($x)
1533             }
1534         }
1535         if {[llength $badcolors] >= $ncolors} {
1536             set badcolors {}
1537         }
1538     }
1539     set origbad $badcolors
1540     if {[llength $badcolors] < $ncolors - 1} {
1541         if {[info exists crossings($id)]} {
1542             foreach x $crossings($id) {
1543                 if {[info exists colormap($x)]
1544                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
1545                     lappend badcolors $colormap($x)
1546                 }
1547             }
1548             if {[llength $badcolors] >= $ncolors} {
1549                 set badcolors $origbad
1550             }
1551         }
1552         set origbad $badcolors
1553     }
1554     if {[llength $badcolors] < $ncolors - 1} {
1555         foreach child $children($id) {
1556             if {[info exists colormap($child)]
1557                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1558                 lappend badcolors $colormap($child)
1559             }
1560             if {[info exists parents($child)]} {
1561                 foreach p $parents($child) {
1562                     if {[info exists colormap($p)]
1563                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
1564                         lappend badcolors $colormap($p)
1565                     }
1566                 }
1567             }
1568         }
1569         if {[llength $badcolors] >= $ncolors} {
1570             set badcolors $origbad
1571         }
1572     }
1573     for {set i 0} {$i <= $ncolors} {incr i} {
1574         set c [lindex $colors $nextcolor]
1575         if {[incr nextcolor] >= $ncolors} {
1576             set nextcolor 0
1577         }
1578         if {[lsearch -exact $badcolors $c]} break
1579     }
1580     set colormap($id) $c
1581 }
1582
1583 proc bindline {t id} {
1584     global canv
1585
1586     $canv bind $t <Enter> "lineenter %x %y $id"
1587     $canv bind $t <Motion> "linemotion %x %y $id"
1588     $canv bind $t <Leave> "lineleave $id"
1589     $canv bind $t <Button-1> "lineclick %x %y $id 1"
1590 }
1591
1592 proc drawtags {id x xt y1} {
1593     global idtags idheads idotherrefs
1594     global linespc lthickness
1595     global canv mainfont commitrow rowtextx
1596
1597     set marks {}
1598     set ntags 0
1599     set nheads 0
1600     if {[info exists idtags($id)]} {
1601         set marks $idtags($id)
1602         set ntags [llength $marks]
1603     }
1604     if {[info exists idheads($id)]} {
1605         set marks [concat $marks $idheads($id)]
1606         set nheads [llength $idheads($id)]
1607     }
1608     if {[info exists idotherrefs($id)]} {
1609         set marks [concat $marks $idotherrefs($id)]
1610     }
1611     if {$marks eq {}} {
1612         return $xt
1613     }
1614
1615     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1616     set yt [expr {$y1 - 0.5 * $linespc}]
1617     set yb [expr {$yt + $linespc - 1}]
1618     set xvals {}
1619     set wvals {}
1620     foreach tag $marks {
1621         set wid [font measure $mainfont $tag]
1622         lappend xvals $xt
1623         lappend wvals $wid
1624         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1625     }
1626     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1627                -width $lthickness -fill black -tags tag.$id]
1628     $canv lower $t
1629     foreach tag $marks x $xvals wid $wvals {
1630         set xl [expr {$x + $delta}]
1631         set xr [expr {$x + $delta + $wid + $lthickness}]
1632         if {[incr ntags -1] >= 0} {
1633             # draw a tag
1634             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1635                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1636                        -width 1 -outline black -fill yellow -tags tag.$id]
1637             $canv bind $t <1> [list showtag $tag 1]
1638             set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1639         } else {
1640             # draw a head or other ref
1641             if {[incr nheads -1] >= 0} {
1642                 set col green
1643             } else {
1644                 set col "#ddddff"
1645             }
1646             set xl [expr {$xl - $delta/2}]
1647             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1648                 -width 1 -outline black -fill $col -tags tag.$id
1649         }
1650         set t [$canv create text $xl $y1 -anchor w -text $tag \
1651                    -font $mainfont -tags tag.$id]
1652         if {$ntags >= 0} {
1653             $canv bind $t <1> [list showtag $tag 1]
1654         }
1655     }
1656     return $xt
1657 }
1658
1659 proc checkcrossings {row endrow} {
1660     global displayorder parents rowidlist
1661
1662     for {} {$row < $endrow} {incr row} {
1663         set id [lindex $displayorder $row]
1664         set i [lsearch -exact [lindex $rowidlist $row] $id]
1665         if {$i < 0} continue
1666         set idlist [lindex $rowidlist [expr {$row+1}]]
1667         foreach p $parents($id) {
1668             set j [lsearch -exact $idlist $p]
1669             if {$j > 0} {
1670                 if {$j < $i - 1} {
1671                     notecrossings $row $p $j $i [expr {$j+1}]
1672                 } elseif {$j > $i + 1} {
1673                     notecrossings $row $p $i $j [expr {$j-1}]
1674                 }
1675             }
1676         }
1677     }
1678 }
1679
1680 proc notecrossings {row id lo hi corner} {
1681     global rowidlist crossings cornercrossings
1682
1683     for {set i $lo} {[incr i] < $hi} {} {
1684         set p [lindex [lindex $rowidlist $row] $i]
1685         if {$p == {}} continue
1686         if {$i == $corner} {
1687             if {![info exists cornercrossings($id)]
1688                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1689                 lappend cornercrossings($id) $p
1690             }
1691             if {![info exists cornercrossings($p)]
1692                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1693                 lappend cornercrossings($p) $id
1694             }
1695         } else {
1696             if {![info exists crossings($id)]
1697                 || [lsearch -exact $crossings($id) $p] < 0} {
1698                 lappend crossings($id) $p
1699             }
1700             if {![info exists crossings($p)]
1701                 || [lsearch -exact $crossings($p) $id] < 0} {
1702                 lappend crossings($p) $id
1703             }
1704         }
1705     }
1706 }
1707
1708 proc xcoord {i level ln} {
1709     global canvx0 xspc1 xspc2
1710
1711     set x [expr {$canvx0 + $i * $xspc1($ln)}]
1712     if {$i > 0 && $i == $level} {
1713         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1714     } elseif {$i > $level} {
1715         set x [expr {$x + $xspc2 - $xspc1($ln)}]
1716     }
1717     return $x
1718 }
1719
1720 proc finishcommits {} {
1721     global commitidx phase
1722     global canv mainfont ctext maincursor textcursor
1723     global findinprogress
1724
1725     if {$commitidx > 0} {
1726         drawrest
1727     } else {
1728         $canv delete all
1729         $canv create text 3 3 -anchor nw -text "No commits selected" \
1730             -font $mainfont -tags textitems
1731     }
1732     if {![info exists findinprogress]} {
1733         . config -cursor $maincursor
1734         settextcursor $textcursor
1735     }
1736     set phase {}
1737 }
1738
1739 # Don't change the text pane cursor if it is currently the hand cursor,
1740 # showing that we are over a sha1 ID link.
1741 proc settextcursor {c} {
1742     global ctext curtextcursor
1743
1744     if {[$ctext cget -cursor] == $curtextcursor} {
1745         $ctext config -cursor $c
1746     }
1747     set curtextcursor $c
1748 }
1749
1750 proc drawrest {} {
1751     global numcommits
1752     global startmsecs
1753     global canvy0 numcommits linespc
1754     global rowlaidout commitidx
1755
1756     set row $rowlaidout
1757     layoutrows $rowlaidout $commitidx 1
1758     layouttail
1759     optimize_rows $row 0 $commitidx
1760     showstuff $commitidx
1761
1762     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1763     #puts "overall $drawmsecs ms for $numcommits commits"
1764 }
1765
1766 proc findmatches {f} {
1767     global findtype foundstring foundstrlen
1768     if {$findtype == "Regexp"} {
1769         set matches [regexp -indices -all -inline $foundstring $f]
1770     } else {
1771         if {$findtype == "IgnCase"} {
1772             set str [string tolower $f]
1773         } else {
1774             set str $f
1775         }
1776         set matches {}
1777         set i 0
1778         while {[set j [string first $foundstring $str $i]] >= 0} {
1779             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1780             set i [expr {$j + $foundstrlen}]
1781         }
1782     }
1783     return $matches
1784 }
1785
1786 proc dofind {} {
1787     global findtype findloc findstring markedmatches commitinfo
1788     global numcommits displayorder linehtag linentag linedtag
1789     global mainfont namefont canv canv2 canv3 selectedline
1790     global matchinglines foundstring foundstrlen matchstring
1791     global commitdata
1792
1793     stopfindproc
1794     unmarkmatches
1795     focus .
1796     set matchinglines {}
1797     if {$findloc == "Pickaxe"} {
1798         findpatches
1799         return
1800     }
1801     if {$findtype == "IgnCase"} {
1802         set foundstring [string tolower $findstring]
1803     } else {
1804         set foundstring $findstring
1805     }
1806     set foundstrlen [string length $findstring]
1807     if {$foundstrlen == 0} return
1808     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1809     set matchstring "*$matchstring*"
1810     if {$findloc == "Files"} {
1811         findfiles
1812         return
1813     }
1814     if {![info exists selectedline]} {
1815         set oldsel -1
1816     } else {
1817         set oldsel $selectedline
1818     }
1819     set didsel 0
1820     set fldtypes {Headline Author Date Committer CDate Comment}
1821     set l -1
1822     foreach id $displayorder {
1823         set d $commitdata($id)
1824         incr l
1825         if {$findtype == "Regexp"} {
1826             set doesmatch [regexp $foundstring $d]
1827         } elseif {$findtype == "IgnCase"} {
1828             set doesmatch [string match -nocase $matchstring $d]
1829         } else {
1830             set doesmatch [string match $matchstring $d]
1831         }
1832         if {!$doesmatch} continue
1833         if {![info exists commitinfo($id)]} {
1834             getcommit $id
1835         }
1836         set info $commitinfo($id)
1837         set doesmatch 0
1838         foreach f $info ty $fldtypes {
1839             if {$findloc != "All fields" && $findloc != $ty} {
1840                 continue
1841             }
1842             set matches [findmatches $f]
1843             if {$matches == {}} continue
1844             set doesmatch 1
1845             if {$ty == "Headline"} {
1846                 drawcmitrow $l
1847                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1848             } elseif {$ty == "Author"} {
1849                 drawcmitrow $l
1850                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1851             } elseif {$ty == "Date"} {
1852                 drawcmitrow $l
1853                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1854             }
1855         }
1856         if {$doesmatch} {
1857             lappend matchinglines $l
1858             if {!$didsel && $l > $oldsel} {
1859                 findselectline $l
1860                 set didsel 1
1861             }
1862         }
1863     }
1864     if {$matchinglines == {}} {
1865         bell
1866     } elseif {!$didsel} {
1867         findselectline [lindex $matchinglines 0]
1868     }
1869 }
1870
1871 proc findselectline {l} {
1872     global findloc commentend ctext
1873     selectline $l 1
1874     if {$findloc == "All fields" || $findloc == "Comments"} {
1875         # highlight the matches in the comments
1876         set f [$ctext get 1.0 $commentend]
1877         set matches [findmatches $f]
1878         foreach match $matches {
1879             set start [lindex $match 0]
1880             set end [expr {[lindex $match 1] + 1}]
1881             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1882         }
1883     }
1884 }
1885
1886 proc findnext {restart} {
1887     global matchinglines selectedline
1888     if {![info exists matchinglines]} {
1889         if {$restart} {
1890             dofind
1891         }
1892         return
1893     }
1894     if {![info exists selectedline]} return
1895     foreach l $matchinglines {
1896         if {$l > $selectedline} {
1897             findselectline $l
1898             return
1899         }
1900     }
1901     bell
1902 }
1903
1904 proc findprev {} {
1905     global matchinglines selectedline
1906     if {![info exists matchinglines]} {
1907         dofind
1908         return
1909     }
1910     if {![info exists selectedline]} return
1911     set prev {}
1912     foreach l $matchinglines {
1913         if {$l >= $selectedline} break
1914         set prev $l
1915     }
1916     if {$prev != {}} {
1917         findselectline $prev
1918     } else {
1919         bell
1920     }
1921 }
1922
1923 proc findlocchange {name ix op} {
1924     global findloc findtype findtypemenu
1925     if {$findloc == "Pickaxe"} {
1926         set findtype Exact
1927         set state disabled
1928     } else {
1929         set state normal
1930     }
1931     $findtypemenu entryconf 1 -state $state
1932     $findtypemenu entryconf 2 -state $state
1933 }
1934
1935 proc stopfindproc {{done 0}} {
1936     global findprocpid findprocfile findids
1937     global ctext findoldcursor phase maincursor textcursor
1938     global findinprogress
1939
1940     catch {unset findids}
1941     if {[info exists findprocpid]} {
1942         if {!$done} {
1943             catch {exec kill $findprocpid}
1944         }
1945         catch {close $findprocfile}
1946         unset findprocpid
1947     }
1948     if {[info exists findinprogress]} {
1949         unset findinprogress
1950         if {$phase != "incrdraw"} {
1951             . config -cursor $maincursor
1952             settextcursor $textcursor
1953         }
1954     }
1955 }
1956
1957 proc findpatches {} {
1958     global findstring selectedline numcommits
1959     global findprocpid findprocfile
1960     global finddidsel ctext displayorder findinprogress
1961     global findinsertpos
1962
1963     if {$numcommits == 0} return
1964
1965     # make a list of all the ids to search, starting at the one
1966     # after the selected line (if any)
1967     if {[info exists selectedline]} {
1968         set l $selectedline
1969     } else {
1970         set l -1
1971     }
1972     set inputids {}
1973     for {set i 0} {$i < $numcommits} {incr i} {
1974         if {[incr l] >= $numcommits} {
1975             set l 0
1976         }
1977         append inputids [lindex $displayorder $l] "\n"
1978     }
1979
1980     if {[catch {
1981         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1982                          << $inputids] r]
1983     } err]} {
1984         error_popup "Error starting search process: $err"
1985         return
1986     }
1987
1988     set findinsertpos end
1989     set findprocfile $f
1990     set findprocpid [pid $f]
1991     fconfigure $f -blocking 0
1992     fileevent $f readable readfindproc
1993     set finddidsel 0
1994     . config -cursor watch
1995     settextcursor watch
1996     set findinprogress 1
1997 }
1998
1999 proc readfindproc {} {
2000     global findprocfile finddidsel
2001     global commitrow matchinglines findinsertpos
2002
2003     set n [gets $findprocfile line]
2004     if {$n < 0} {
2005         if {[eof $findprocfile]} {
2006             stopfindproc 1
2007             if {!$finddidsel} {
2008                 bell
2009             }
2010         }
2011         return
2012     }
2013     if {![regexp {^[0-9a-f]{40}} $line id]} {
2014         error_popup "Can't parse git-diff-tree output: $line"
2015         stopfindproc
2016         return
2017     }
2018     if {![info exists commitrow($id)]} {
2019         puts stderr "spurious id: $id"
2020         return
2021     }
2022     set l $commitrow($id)
2023     insertmatch $l $id
2024 }
2025
2026 proc insertmatch {l id} {
2027     global matchinglines findinsertpos finddidsel
2028
2029     if {$findinsertpos == "end"} {
2030         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2031             set matchinglines [linsert $matchinglines 0 $l]
2032             set findinsertpos 1
2033         } else {
2034             lappend matchinglines $l
2035         }
2036     } else {
2037         set matchinglines [linsert $matchinglines $findinsertpos $l]
2038         incr findinsertpos
2039     }
2040     markheadline $l $id
2041     if {!$finddidsel} {
2042         findselectline $l
2043         set finddidsel 1
2044     }
2045 }
2046
2047 proc findfiles {} {
2048     global selectedline numcommits displayorder ctext
2049     global ffileline finddidsel parents nparents
2050     global findinprogress findstartline findinsertpos
2051     global treediffs fdiffid fdiffsneeded fdiffpos
2052     global findmergefiles
2053
2054     if {$numcommits == 0} return
2055
2056     if {[info exists selectedline]} {
2057         set l [expr {$selectedline + 1}]
2058     } else {
2059         set l 0
2060     }
2061     set ffileline $l
2062     set findstartline $l
2063     set diffsneeded {}
2064     set fdiffsneeded {}
2065     while 1 {
2066         set id [lindex $displayorder $l]
2067         if {$findmergefiles || $nparents($id) == 1} {
2068             if {![info exists treediffs($id)]} {
2069                 append diffsneeded "$id\n"
2070                 lappend fdiffsneeded $id
2071             }
2072         }
2073         if {[incr l] >= $numcommits} {
2074             set l 0
2075         }
2076         if {$l == $findstartline} break
2077     }
2078
2079     # start off a git-diff-tree process if needed
2080     if {$diffsneeded ne {}} {
2081         if {[catch {
2082             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2083         } err ]} {
2084             error_popup "Error starting search process: $err"
2085             return
2086         }
2087         catch {unset fdiffid}
2088         set fdiffpos 0
2089         fconfigure $df -blocking 0
2090         fileevent $df readable [list readfilediffs $df]
2091     }
2092
2093     set finddidsel 0
2094     set findinsertpos end
2095     set id [lindex $displayorder $l]
2096     . config -cursor watch
2097     settextcursor watch
2098     set findinprogress 1
2099     findcont $id
2100     update
2101 }
2102
2103 proc readfilediffs {df} {
2104     global findid fdiffid fdiffs
2105
2106     set n [gets $df line]
2107     if {$n < 0} {
2108         if {[eof $df]} {
2109             donefilediff
2110             if {[catch {close $df} err]} {
2111                 stopfindproc
2112                 bell
2113                 error_popup "Error in git-diff-tree: $err"
2114             } elseif {[info exists findid]} {
2115                 set id $findid
2116                 stopfindproc
2117                 bell
2118                 error_popup "Couldn't find diffs for $id"
2119             }
2120         }
2121         return
2122     }
2123     if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2124         # start of a new string of diffs
2125         donefilediff
2126         set fdiffid $id
2127         set fdiffs {}
2128     } elseif {[string match ":*" $line]} {
2129         lappend fdiffs [lindex $line 5]
2130     }
2131 }
2132
2133 proc donefilediff {} {
2134     global fdiffid fdiffs treediffs findid
2135     global fdiffsneeded fdiffpos
2136
2137     if {[info exists fdiffid]} {
2138         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2139                && $fdiffpos < [llength $fdiffsneeded]} {
2140             # git-diff-tree doesn't output anything for a commit
2141             # which doesn't change anything
2142             set nullid [lindex $fdiffsneeded $fdiffpos]
2143             set treediffs($nullid) {}
2144             if {[info exists findid] && $nullid eq $findid} {
2145                 unset findid
2146                 findcont $nullid
2147             }
2148             incr fdiffpos
2149         }
2150         incr fdiffpos
2151
2152         if {![info exists treediffs($fdiffid)]} {
2153             set treediffs($fdiffid) $fdiffs
2154         }
2155         if {[info exists findid] && $fdiffid eq $findid} {
2156             unset findid
2157             findcont $fdiffid
2158         }
2159     }
2160 }
2161
2162 proc findcont {id} {
2163     global findid treediffs parents nparents
2164     global ffileline findstartline finddidsel
2165     global displayorder numcommits matchinglines findinprogress
2166     global findmergefiles
2167
2168     set l $ffileline
2169     while 1 {
2170         if {$findmergefiles || $nparents($id) == 1} {
2171             if {![info exists treediffs($id)]} {
2172                 set findid $id
2173                 set ffileline $l
2174                 return
2175             }
2176             set doesmatch 0
2177             foreach f $treediffs($id) {
2178                 set x [findmatches $f]
2179                 if {$x != {}} {
2180                     set doesmatch 1
2181                     break
2182                 }
2183             }
2184             if {$doesmatch} {
2185                 insertmatch $l $id
2186             }
2187         }
2188         if {[incr l] >= $numcommits} {
2189             set l 0
2190         }
2191         if {$l == $findstartline} break
2192         set id [lindex $displayorder $l]
2193     }
2194     stopfindproc
2195     if {!$finddidsel} {
2196         bell
2197     }
2198 }
2199
2200 # mark a commit as matching by putting a yellow background
2201 # behind the headline
2202 proc markheadline {l id} {
2203     global canv mainfont linehtag
2204
2205     drawcmitrow $l
2206     set bbox [$canv bbox $linehtag($l)]
2207     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2208     $canv lower $t
2209 }
2210
2211 # mark the bits of a headline, author or date that match a find string
2212 proc markmatches {canv l str tag matches font} {
2213     set bbox [$canv bbox $tag]
2214     set x0 [lindex $bbox 0]
2215     set y0 [lindex $bbox 1]
2216     set y1 [lindex $bbox 3]
2217     foreach match $matches {
2218         set start [lindex $match 0]
2219         set end [lindex $match 1]
2220         if {$start > $end} continue
2221         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2222         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2223         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2224                    [expr {$x0+$xlen+2}] $y1 \
2225                    -outline {} -tags matches -fill yellow]
2226         $canv lower $t
2227     }
2228 }
2229
2230 proc unmarkmatches {} {
2231     global matchinglines findids
2232     allcanvs delete matches
2233     catch {unset matchinglines}
2234     catch {unset findids}
2235 }
2236
2237 proc selcanvline {w x y} {
2238     global canv canvy0 ctext linespc
2239     global rowtextx
2240     set ymax [lindex [$canv cget -scrollregion] 3]
2241     if {$ymax == {}} return
2242     set yfrac [lindex [$canv yview] 0]
2243     set y [expr {$y + $yfrac * $ymax}]
2244     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2245     if {$l < 0} {
2246         set l 0
2247     }
2248     if {$w eq $canv} {
2249         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2250     }
2251     unmarkmatches
2252     selectline $l 1
2253 }
2254
2255 proc commit_descriptor {p} {
2256     global commitinfo
2257     set l "..."
2258     if {[info exists commitinfo($p)]} {
2259         set l [lindex $commitinfo($p) 0]
2260     }
2261     return "$p ($l)"
2262 }
2263
2264 # append some text to the ctext widget, and make any SHA1 ID
2265 # that we know about be a clickable link.
2266 proc appendwithlinks {text} {
2267     global ctext commitrow linknum
2268
2269     set start [$ctext index "end - 1c"]
2270     $ctext insert end $text
2271     $ctext insert end "\n"
2272     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2273     foreach l $links {
2274         set s [lindex $l 0]
2275         set e [lindex $l 1]
2276         set linkid [string range $text $s $e]
2277         if {![info exists commitrow($linkid)]} continue
2278         incr e
2279         $ctext tag add link "$start + $s c" "$start + $e c"
2280         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2281         $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2282         incr linknum
2283     }
2284     $ctext tag conf link -foreground blue -underline 1
2285     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2286     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2287 }
2288
2289 proc selectline {l isnew} {
2290     global canv canv2 canv3 ctext commitinfo selectedline
2291     global displayorder linehtag linentag linedtag
2292     global canvy0 linespc parents nparents children
2293     global cflist currentid sha1entry
2294     global commentend idtags linknum
2295     global mergemax numcommits
2296
2297     $canv delete hover
2298     normalline
2299     if {$l < 0 || $l >= $numcommits} return
2300     set y [expr {$canvy0 + $l * $linespc}]
2301     set ymax [lindex [$canv cget -scrollregion] 3]
2302     set ytop [expr {$y - $linespc - 1}]
2303     set ybot [expr {$y + $linespc + 1}]
2304     set wnow [$canv yview]
2305     set wtop [expr {[lindex $wnow 0] * $ymax}]
2306     set wbot [expr {[lindex $wnow 1] * $ymax}]
2307     set wh [expr {$wbot - $wtop}]
2308     set newtop $wtop
2309     if {$ytop < $wtop} {
2310         if {$ybot < $wtop} {
2311             set newtop [expr {$y - $wh / 2.0}]
2312         } else {
2313             set newtop $ytop
2314             if {$newtop > $wtop - $linespc} {
2315                 set newtop [expr {$wtop - $linespc}]
2316             }
2317         }
2318     } elseif {$ybot > $wbot} {
2319         if {$ytop > $wbot} {
2320             set newtop [expr {$y - $wh / 2.0}]
2321         } else {
2322             set newtop [expr {$ybot - $wh}]
2323             if {$newtop < $wtop + $linespc} {
2324                 set newtop [expr {$wtop + $linespc}]
2325             }
2326         }
2327     }
2328     if {$newtop != $wtop} {
2329         if {$newtop < 0} {
2330             set newtop 0
2331         }
2332         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2333         drawvisible
2334     }
2335
2336     if {![info exists linehtag($l)]} return
2337     $canv delete secsel
2338     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2339                -tags secsel -fill [$canv cget -selectbackground]]
2340     $canv lower $t
2341     $canv2 delete secsel
2342     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2343                -tags secsel -fill [$canv2 cget -selectbackground]]
2344     $canv2 lower $t
2345     $canv3 delete secsel
2346     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2347                -tags secsel -fill [$canv3 cget -selectbackground]]
2348     $canv3 lower $t
2349
2350     if {$isnew} {
2351         addtohistory [list selectline $l 0]
2352     }
2353
2354     set selectedline $l
2355
2356     set id [lindex $displayorder $l]
2357     set currentid $id
2358     $sha1entry delete 0 end
2359     $sha1entry insert 0 $id
2360     $sha1entry selection from 0
2361     $sha1entry selection to end
2362
2363     $ctext conf -state normal
2364     $ctext delete 0.0 end
2365     set linknum 0
2366     $ctext mark set fmark.0 0.0
2367     $ctext mark gravity fmark.0 left
2368     set info $commitinfo($id)
2369     set date [formatdate [lindex $info 2]]
2370     $ctext insert end "Author: [lindex $info 1]  $date\n"
2371     set date [formatdate [lindex $info 4]]
2372     $ctext insert end "Committer: [lindex $info 3]  $date\n"
2373     if {[info exists idtags($id)]} {
2374         $ctext insert end "Tags:"
2375         foreach tag $idtags($id) {
2376             $ctext insert end " $tag"
2377         }
2378         $ctext insert end "\n"
2379     }
2380
2381     set comment {}
2382     if {$nparents($id) > 1} {
2383         set np 0
2384         foreach p $parents($id) {
2385             if {$np >= $mergemax} {
2386                 set tag mmax
2387             } else {
2388                 set tag m$np
2389             }
2390             $ctext insert end "Parent: " $tag
2391             appendwithlinks [commit_descriptor $p]
2392             incr np
2393         }
2394     } else {
2395         if {[info exists parents($id)]} {
2396             foreach p $parents($id) {
2397                 append comment "Parent: [commit_descriptor $p]\n"
2398             }
2399         }
2400     }
2401
2402     if {[info exists children($id)]} {
2403         foreach c $children($id) {
2404             append comment "Child:  [commit_descriptor $c]\n"
2405         }
2406     }
2407     append comment "\n"
2408     append comment [lindex $info 5]
2409
2410     # make anything that looks like a SHA1 ID be a clickable link
2411     appendwithlinks $comment
2412
2413     $ctext tag delete Comments
2414     $ctext tag remove found 1.0 end
2415     $ctext conf -state disabled
2416     set commentend [$ctext index "end - 1c"]
2417
2418     $cflist delete 0 end
2419     $cflist insert end "Comments"
2420     if {$nparents($id) <= 1} {
2421         startdiff $id
2422     } else {
2423         mergediff $id
2424     }
2425 }
2426
2427 proc selnextline {dir} {
2428     global selectedline
2429     if {![info exists selectedline]} return
2430     set l [expr {$selectedline + $dir}]
2431     unmarkmatches
2432     selectline $l 1
2433 }
2434
2435 proc unselectline {} {
2436     global selectedline
2437
2438     catch {unset selectedline}
2439     allcanvs delete secsel
2440 }
2441
2442 proc addtohistory {cmd} {
2443     global history historyindex
2444
2445     if {$historyindex > 0
2446         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2447         return
2448     }
2449
2450     if {$historyindex < [llength $history]} {
2451         set history [lreplace $history $historyindex end $cmd]
2452     } else {
2453         lappend history $cmd
2454     }
2455     incr historyindex
2456     if {$historyindex > 1} {
2457         .ctop.top.bar.leftbut conf -state normal
2458     } else {
2459         .ctop.top.bar.leftbut conf -state disabled
2460     }
2461     .ctop.top.bar.rightbut conf -state disabled
2462 }
2463
2464 proc goback {} {
2465     global history historyindex
2466
2467     if {$historyindex > 1} {
2468         incr historyindex -1
2469         set cmd [lindex $history [expr {$historyindex - 1}]]
2470         eval $cmd
2471         .ctop.top.bar.rightbut conf -state normal
2472     }
2473     if {$historyindex <= 1} {
2474         .ctop.top.bar.leftbut conf -state disabled
2475     }
2476 }
2477
2478 proc goforw {} {
2479     global history historyindex
2480
2481     if {$historyindex < [llength $history]} {
2482         set cmd [lindex $history $historyindex]
2483         incr historyindex
2484         eval $cmd
2485         .ctop.top.bar.leftbut conf -state normal
2486     }
2487     if {$historyindex >= [llength $history]} {
2488         .ctop.top.bar.rightbut conf -state disabled
2489     }
2490 }
2491
2492 proc mergediff {id} {
2493     global parents diffmergeid diffopts mdifffd
2494     global difffilestart diffids
2495
2496     set diffmergeid $id
2497     set diffids $id
2498     catch {unset difffilestart}
2499     # this doesn't seem to actually affect anything...
2500     set env(GIT_DIFF_OPTS) $diffopts
2501     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2502     if {[catch {set mdf [open $cmd r]} err]} {
2503         error_popup "Error getting merge diffs: $err"
2504         return
2505     }
2506     fconfigure $mdf -blocking 0
2507     set mdifffd($id) $mdf
2508     fileevent $mdf readable [list getmergediffline $mdf $id]
2509     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2510 }
2511
2512 proc getmergediffline {mdf id} {
2513     global diffmergeid ctext cflist nextupdate nparents mergemax
2514     global difffilestart mdifffd
2515
2516     set n [gets $mdf line]
2517     if {$n < 0} {
2518         if {[eof $mdf]} {
2519             close $mdf
2520         }
2521         return
2522     }
2523     if {![info exists diffmergeid] || $id != $diffmergeid
2524         || $mdf != $mdifffd($id)} {
2525         return
2526     }
2527     $ctext conf -state normal
2528     if {[regexp {^diff --cc (.*)} $line match fname]} {
2529         # start of a new file
2530         $ctext insert end "\n"
2531         set here [$ctext index "end - 1c"]
2532         set i [$cflist index end]
2533         $ctext mark set fmark.$i $here
2534         $ctext mark gravity fmark.$i left
2535         set difffilestart([expr {$i-1}]) $here
2536         $cflist insert end $fname
2537         set l [expr {(78 - [string length $fname]) / 2}]
2538         set pad [string range "----------------------------------------" 1 $l]
2539         $ctext insert end "$pad $fname $pad\n" filesep
2540     } elseif {[regexp {^@@} $line]} {
2541         $ctext insert end "$line\n" hunksep
2542     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2543         # do nothing
2544     } else {
2545         # parse the prefix - one ' ', '-' or '+' for each parent
2546         set np $nparents($id)
2547         set spaces {}
2548         set minuses {}
2549         set pluses {}
2550         set isbad 0
2551         for {set j 0} {$j < $np} {incr j} {
2552             set c [string range $line $j $j]
2553             if {$c == " "} {
2554                 lappend spaces $j
2555             } elseif {$c == "-"} {
2556                 lappend minuses $j
2557             } elseif {$c == "+"} {
2558                 lappend pluses $j
2559             } else {
2560                 set isbad 1
2561                 break
2562             }
2563         }
2564         set tags {}
2565         set num {}
2566         if {!$isbad && $minuses ne {} && $pluses eq {}} {
2567             # line doesn't appear in result, parents in $minuses have the line
2568             set num [lindex $minuses 0]
2569         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2570             # line appears in result, parents in $pluses don't have the line
2571             lappend tags mresult
2572             set num [lindex $spaces 0]
2573         }
2574         if {$num ne {}} {
2575             if {$num >= $mergemax} {
2576                 set num "max"
2577             }
2578             lappend tags m$num
2579         }
2580         $ctext insert end "$line\n" $tags
2581     }
2582     $ctext conf -state disabled
2583     if {[clock clicks -milliseconds] >= $nextupdate} {
2584         incr nextupdate 100
2585         fileevent $mdf readable {}
2586         update
2587         fileevent $mdf readable [list getmergediffline $mdf $id]
2588     }
2589 }
2590
2591 proc startdiff {ids} {
2592     global treediffs diffids treepending diffmergeid
2593
2594     set diffids $ids
2595     catch {unset diffmergeid}
2596     if {![info exists treediffs($ids)]} {
2597         if {![info exists treepending]} {
2598             gettreediffs $ids
2599         }
2600     } else {
2601         addtocflist $ids
2602     }
2603 }
2604
2605 proc addtocflist {ids} {
2606     global treediffs cflist
2607     foreach f $treediffs($ids) {
2608         $cflist insert end $f
2609     }
2610     getblobdiffs $ids
2611 }
2612
2613 proc gettreediffs {ids} {
2614     global treediff parents treepending
2615     set treepending $ids
2616     set treediff {}
2617     if {[catch \
2618          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2619         ]} return
2620     fconfigure $gdtf -blocking 0
2621     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2622 }
2623
2624 proc gettreediffline {gdtf ids} {
2625     global treediff treediffs treepending diffids diffmergeid
2626
2627     set n [gets $gdtf line]
2628     if {$n < 0} {
2629         if {![eof $gdtf]} return
2630         close $gdtf
2631         set treediffs($ids) $treediff
2632         unset treepending
2633         if {$ids != $diffids} {
2634             if {![info exists diffmergeid]} {
2635                 gettreediffs $diffids
2636             }
2637         } else {
2638             addtocflist $ids
2639         }
2640         return
2641     }
2642     set file [lindex $line 5]
2643     lappend treediff $file
2644 }
2645
2646 proc getblobdiffs {ids} {
2647     global diffopts blobdifffd diffids env curdifftag curtagstart
2648     global difffilestart nextupdate diffinhdr treediffs
2649
2650     set env(GIT_DIFF_OPTS) $diffopts
2651     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2652     if {[catch {set bdf [open $cmd r]} err]} {
2653         puts "error getting diffs: $err"
2654         return
2655     }
2656     set diffinhdr 0
2657     fconfigure $bdf -blocking 0
2658     set blobdifffd($ids) $bdf
2659     set curdifftag Comments
2660     set curtagstart 0.0
2661     catch {unset difffilestart}
2662     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2663     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2664 }
2665
2666 proc getblobdiffline {bdf ids} {
2667     global diffids blobdifffd ctext curdifftag curtagstart
2668     global diffnexthead diffnextnote difffilestart
2669     global nextupdate diffinhdr treediffs
2670
2671     set n [gets $bdf line]
2672     if {$n < 0} {
2673         if {[eof $bdf]} {
2674             close $bdf
2675             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2676                 $ctext tag add $curdifftag $curtagstart end
2677             }
2678         }
2679         return
2680     }
2681     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2682         return
2683     }
2684     $ctext conf -state normal
2685     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2686         # start of a new file
2687         $ctext insert end "\n"
2688         $ctext tag add $curdifftag $curtagstart end
2689         set curtagstart [$ctext index "end - 1c"]
2690         set header $newname
2691         set here [$ctext index "end - 1c"]
2692         set i [lsearch -exact $treediffs($diffids) $fname]
2693         if {$i >= 0} {
2694             set difffilestart($i) $here
2695             incr i
2696             $ctext mark set fmark.$i $here
2697             $ctext mark gravity fmark.$i left
2698         }
2699         if {$newname != $fname} {
2700             set i [lsearch -exact $treediffs($diffids) $newname]
2701             if {$i >= 0} {
2702                 set difffilestart($i) $here
2703                 incr i
2704                 $ctext mark set fmark.$i $here
2705                 $ctext mark gravity fmark.$i left
2706             }
2707         }
2708         set curdifftag "f:$fname"
2709         $ctext tag delete $curdifftag
2710         set l [expr {(78 - [string length $header]) / 2}]
2711         set pad [string range "----------------------------------------" 1 $l]
2712         $ctext insert end "$pad $header $pad\n" filesep
2713         set diffinhdr 1
2714     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2715         # do nothing
2716     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2717         set diffinhdr 0
2718     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2719                    $line match f1l f1c f2l f2c rest]} {
2720         $ctext insert end "$line\n" hunksep
2721         set diffinhdr 0
2722     } else {
2723         set x [string range $line 0 0]
2724         if {$x == "-" || $x == "+"} {
2725             set tag [expr {$x == "+"}]
2726             $ctext insert end "$line\n" d$tag
2727         } elseif {$x == " "} {
2728             $ctext insert end "$line\n"
2729         } elseif {$diffinhdr || $x == "\\"} {
2730             # e.g. "\ No newline at end of file"
2731             $ctext insert end "$line\n" filesep
2732         } else {
2733             # Something else we don't recognize
2734             if {$curdifftag != "Comments"} {
2735                 $ctext insert end "\n"
2736                 $ctext tag add $curdifftag $curtagstart end
2737                 set curtagstart [$ctext index "end - 1c"]
2738                 set curdifftag Comments
2739             }
2740             $ctext insert end "$line\n" filesep
2741         }
2742     }
2743     $ctext conf -state disabled
2744     if {[clock clicks -milliseconds] >= $nextupdate} {
2745         incr nextupdate 100
2746         fileevent $bdf readable {}
2747         update
2748         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2749     }
2750 }
2751
2752 proc nextfile {} {
2753     global difffilestart ctext
2754     set here [$ctext index @0,0]
2755     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2756         if {[$ctext compare $difffilestart($i) > $here]} {
2757             if {![info exists pos]
2758                 || [$ctext compare $difffilestart($i) < $pos]} {
2759                 set pos $difffilestart($i)
2760             }
2761         }
2762     }
2763     if {[info exists pos]} {
2764         $ctext yview $pos
2765     }
2766 }
2767
2768 proc listboxsel {} {
2769     global ctext cflist currentid
2770     if {![info exists currentid]} return
2771     set sel [lsort [$cflist curselection]]
2772     if {$sel eq {}} return
2773     set first [lindex $sel 0]
2774     catch {$ctext yview fmark.$first}
2775 }
2776
2777 proc setcoords {} {
2778     global linespc charspc canvx0 canvy0 mainfont
2779     global xspc1 xspc2 lthickness
2780
2781     set linespc [font metrics $mainfont -linespace]
2782     set charspc [font measure $mainfont "m"]
2783     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2784     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2785     set lthickness [expr {int($linespc / 9) + 1}]
2786     set xspc1(0) $linespc
2787     set xspc2 $linespc
2788 }
2789
2790 proc redisplay {} {
2791     global canv
2792     global selectedline
2793
2794     set ymax [lindex [$canv cget -scrollregion] 3]
2795     if {$ymax eq {} || $ymax == 0} return
2796     set span [$canv yview]
2797     clear_display
2798     setcanvscroll
2799     allcanvs yview moveto [lindex $span 0]
2800     drawvisible
2801     if {[info exists selectedline]} {
2802         selectline $selectedline 0
2803     }
2804 }
2805
2806 proc incrfont {inc} {
2807     global mainfont namefont textfont ctext canv phase
2808     global stopped entries
2809     unmarkmatches
2810     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2811     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2812     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2813     setcoords
2814     $ctext conf -font $textfont
2815     $ctext tag conf filesep -font [concat $textfont bold]
2816     foreach e $entries {
2817         $e conf -font $mainfont
2818     }
2819     if {$phase == "getcommits"} {
2820         $canv itemconf textitems -font $mainfont
2821     }
2822     redisplay
2823 }
2824
2825 proc clearsha1 {} {
2826     global sha1entry sha1string
2827     if {[string length $sha1string] == 40} {
2828         $sha1entry delete 0 end
2829     }
2830 }
2831
2832 proc sha1change {n1 n2 op} {
2833     global sha1string currentid sha1but
2834     if {$sha1string == {}
2835         || ([info exists currentid] && $sha1string == $currentid)} {
2836         set state disabled
2837     } else {
2838         set state normal
2839     }
2840     if {[$sha1but cget -state] == $state} return
2841     if {$state == "normal"} {
2842         $sha1but conf -state normal -relief raised -text "Goto: "
2843     } else {
2844         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2845     }
2846 }
2847
2848 proc gotocommit {} {
2849     global sha1string currentid commitrow tagids
2850     global displayorder numcommits
2851
2852     if {$sha1string == {}
2853         || ([info exists currentid] && $sha1string == $currentid)} return
2854     if {[info exists tagids($sha1string)]} {
2855         set id $tagids($sha1string)
2856     } else {
2857         set id [string tolower $sha1string]
2858         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2859             set matches {}
2860             foreach i $displayorder {
2861                 if {[string match $id* $i]} {
2862                     lappend matches $i
2863                 }
2864             }
2865             if {$matches ne {}} {
2866                 if {[llength $matches] > 1} {
2867                     error_popup "Short SHA1 id $id is ambiguous"
2868                     return
2869                 }
2870                 set id [lindex $matches 0]
2871             }
2872         }
2873     }
2874     if {[info exists commitrow($id)]} {
2875         selectline $commitrow($id) 1
2876         return
2877     }
2878     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2879         set type "SHA1 id"
2880     } else {
2881         set type "Tag"
2882     }
2883     error_popup "$type $sha1string is not known"
2884 }
2885
2886 proc lineenter {x y id} {
2887     global hoverx hovery hoverid hovertimer
2888     global commitinfo canv
2889
2890     if {![info exists commitinfo($id)] && ![getcommit $id]} return
2891     set hoverx $x
2892     set hovery $y
2893     set hoverid $id
2894     if {[info exists hovertimer]} {
2895         after cancel $hovertimer
2896     }
2897     set hovertimer [after 500 linehover]
2898     $canv delete hover
2899 }
2900
2901 proc linemotion {x y id} {
2902     global hoverx hovery hoverid hovertimer
2903
2904     if {[info exists hoverid] && $id == $hoverid} {
2905         set hoverx $x
2906         set hovery $y
2907         if {[info exists hovertimer]} {
2908             after cancel $hovertimer
2909         }
2910         set hovertimer [after 500 linehover]
2911     }
2912 }
2913
2914 proc lineleave {id} {
2915     global hoverid hovertimer canv
2916
2917     if {[info exists hoverid] && $id == $hoverid} {
2918         $canv delete hover
2919         if {[info exists hovertimer]} {
2920             after cancel $hovertimer
2921             unset hovertimer
2922         }
2923         unset hoverid
2924     }
2925 }
2926
2927 proc linehover {} {
2928     global hoverx hovery hoverid hovertimer
2929     global canv linespc lthickness
2930     global commitinfo mainfont
2931
2932     set text [lindex $commitinfo($hoverid) 0]
2933     set ymax [lindex [$canv cget -scrollregion] 3]
2934     if {$ymax == {}} return
2935     set yfrac [lindex [$canv yview] 0]
2936     set x [expr {$hoverx + 2 * $linespc}]
2937     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2938     set x0 [expr {$x - 2 * $lthickness}]
2939     set y0 [expr {$y - 2 * $lthickness}]
2940     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2941     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2942     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2943                -fill \#ffff80 -outline black -width 1 -tags hover]
2944     $canv raise $t
2945     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2946     $canv raise $t
2947 }
2948
2949 proc clickisonarrow {id y} {
2950     global lthickness idrowranges
2951
2952     set thresh [expr {2 * $lthickness + 6}]
2953     set n [expr {[llength $idrowranges($id)] - 1}]
2954     for {set i 1} {$i < $n} {incr i} {
2955         set row [lindex $idrowranges($id) $i]
2956         if {abs([yc $row] - $y) < $thresh} {
2957             return $i
2958         }
2959     }
2960     return {}
2961 }
2962
2963 proc arrowjump {id n y} {
2964     global idrowranges canv
2965
2966     # 1 <-> 2, 3 <-> 4, etc...
2967     set n [expr {(($n - 1) ^ 1) + 1}]
2968     set row [lindex $idrowranges($id) $n]
2969     set yt [yc $row]
2970     set ymax [lindex [$canv cget -scrollregion] 3]
2971     if {$ymax eq {} || $ymax <= 0} return
2972     set view [$canv yview]
2973     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2974     set yfrac [expr {$yt / $ymax - $yspan / 2}]
2975     if {$yfrac < 0} {
2976         set yfrac 0
2977     }
2978     allcanvs yview moveto $yfrac
2979 }
2980
2981 proc lineclick {x y id isnew} {
2982     global ctext commitinfo children cflist canv thickerline
2983
2984     if {![info exists commitinfo($id)] && ![getcommit $id]} return
2985     unmarkmatches
2986     unselectline
2987     normalline
2988     $canv delete hover
2989     # draw this line thicker than normal
2990     set thickerline $id
2991     drawlines $id
2992     if {$isnew} {
2993         set ymax [lindex [$canv cget -scrollregion] 3]
2994         if {$ymax eq {}} return
2995         set yfrac [lindex [$canv yview] 0]
2996         set y [expr {$y + $yfrac * $ymax}]
2997     }
2998     set dirn [clickisonarrow $id $y]
2999     if {$dirn ne {}} {
3000         arrowjump $id $dirn $y
3001         return
3002     }
3003
3004     if {$isnew} {
3005         addtohistory [list lineclick $x $y $id 0]
3006     }
3007     # fill the details pane with info about this line
3008     $ctext conf -state normal
3009     $ctext delete 0.0 end
3010     $ctext tag conf link -foreground blue -underline 1
3011     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3012     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3013     $ctext insert end "Parent:\t"
3014     $ctext insert end $id [list link link0]
3015     $ctext tag bind link0 <1> [list selbyid $id]
3016     set info $commitinfo($id)
3017     $ctext insert end "\n\t[lindex $info 0]\n"
3018     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3019     set date [formatdate [lindex $info 2]]
3020     $ctext insert end "\tDate:\t$date\n"
3021     if {[info exists children($id)]} {
3022         $ctext insert end "\nChildren:"
3023         set i 0
3024         foreach child $children($id) {
3025             incr i
3026             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3027             set info $commitinfo($child)
3028             $ctext insert end "\n\t"
3029             $ctext insert end $child [list link link$i]
3030             $ctext tag bind link$i <1> [list selbyid $child]
3031             $ctext insert end "\n\t[lindex $info 0]"
3032             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3033             set date [formatdate [lindex $info 2]]
3034             $ctext insert end "\n\tDate:\t$date\n"
3035         }
3036     }
3037     $ctext conf -state disabled
3038
3039     $cflist delete 0 end
3040 }
3041
3042 proc normalline {} {
3043     global thickerline
3044     if {[info exists thickerline]} {
3045         set id $thickerline
3046         unset thickerline
3047         drawlines $id
3048     }
3049 }
3050
3051 proc selbyid {id} {
3052     global commitrow
3053     if {[info exists commitrow($id)]} {
3054         selectline $commitrow($id) 1
3055     }
3056 }
3057
3058 proc mstime {} {
3059     global startmstime
3060     if {![info exists startmstime]} {
3061         set startmstime [clock clicks -milliseconds]
3062     }
3063     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3064 }
3065
3066 proc rowmenu {x y id} {
3067     global rowctxmenu commitrow selectedline rowmenuid
3068
3069     if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3070         set state disabled
3071     } else {
3072         set state normal
3073     }
3074     $rowctxmenu entryconfigure 0 -state $state
3075     $rowctxmenu entryconfigure 1 -state $state
3076     $rowctxmenu entryconfigure 2 -state $state
3077     set rowmenuid $id
3078     tk_popup $rowctxmenu $x $y
3079 }
3080
3081 proc diffvssel {dirn} {
3082     global rowmenuid selectedline displayorder
3083
3084     if {![info exists selectedline]} return
3085     if {$dirn} {
3086         set oldid [lindex $displayorder $selectedline]
3087         set newid $rowmenuid
3088     } else {
3089         set oldid $rowmenuid
3090         set newid [lindex $displayorder $selectedline]
3091     }
3092     addtohistory [list doseldiff $oldid $newid]
3093     doseldiff $oldid $newid
3094 }
3095
3096 proc doseldiff {oldid newid} {
3097     global ctext cflist
3098     global commitinfo
3099
3100     $ctext conf -state normal
3101     $ctext delete 0.0 end
3102     $ctext mark set fmark.0 0.0
3103     $ctext mark gravity fmark.0 left
3104     $cflist delete 0 end
3105     $cflist insert end "Top"
3106     $ctext insert end "From "
3107     $ctext tag conf link -foreground blue -underline 1
3108     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3109     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3110     $ctext tag bind link0 <1> [list selbyid $oldid]
3111     $ctext insert end $oldid [list link link0]
3112     $ctext insert end "\n     "
3113     $ctext insert end [lindex $commitinfo($oldid) 0]
3114     $ctext insert end "\n\nTo   "
3115     $ctext tag bind link1 <1> [list selbyid $newid]
3116     $ctext insert end $newid [list link link1]
3117     $ctext insert end "\n     "
3118     $ctext insert end [lindex $commitinfo($newid) 0]
3119     $ctext insert end "\n"
3120     $ctext conf -state disabled
3121     $ctext tag delete Comments
3122     $ctext tag remove found 1.0 end
3123     startdiff [list $oldid $newid]
3124 }
3125
3126 proc mkpatch {} {
3127     global rowmenuid currentid commitinfo patchtop patchnum
3128
3129     if {![info exists currentid]} return
3130     set oldid $currentid
3131     set oldhead [lindex $commitinfo($oldid) 0]
3132     set newid $rowmenuid
3133     set newhead [lindex $commitinfo($newid) 0]
3134     set top .patch
3135     set patchtop $top
3136     catch {destroy $top}
3137     toplevel $top
3138     label $top.title -text "Generate patch"
3139     grid $top.title - -pady 10
3140     label $top.from -text "From:"
3141     entry $top.fromsha1 -width 40 -relief flat
3142     $top.fromsha1 insert 0 $oldid
3143     $top.fromsha1 conf -state readonly
3144     grid $top.from $top.fromsha1 -sticky w
3145     entry $top.fromhead -width 60 -relief flat
3146     $top.fromhead insert 0 $oldhead
3147     $top.fromhead conf -state readonly
3148     grid x $top.fromhead -sticky w
3149     label $top.to -text "To:"
3150     entry $top.tosha1 -width 40 -relief flat
3151     $top.tosha1 insert 0 $newid
3152     $top.tosha1 conf -state readonly
3153     grid $top.to $top.tosha1 -sticky w
3154     entry $top.tohead -width 60 -relief flat
3155     $top.tohead insert 0 $newhead
3156     $top.tohead conf -state readonly
3157     grid x $top.tohead -sticky w
3158     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3159     grid $top.rev x -pady 10
3160     label $top.flab -text "Output file:"
3161     entry $top.fname -width 60
3162     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3163     incr patchnum
3164     grid $top.flab $top.fname -sticky w
3165     frame $top.buts
3166     button $top.buts.gen -text "Generate" -command mkpatchgo
3167     button $top.buts.can -text "Cancel" -command mkpatchcan
3168     grid $top.buts.gen $top.buts.can
3169     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3170     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3171     grid $top.buts - -pady 10 -sticky ew
3172     focus $top.fname
3173 }
3174
3175 proc mkpatchrev {} {
3176     global patchtop
3177
3178     set oldid [$patchtop.fromsha1 get]
3179     set oldhead [$patchtop.fromhead get]
3180     set newid [$patchtop.tosha1 get]
3181     set newhead [$patchtop.tohead get]
3182     foreach e [list fromsha1 fromhead tosha1 tohead] \
3183             v [list $newid $newhead $oldid $oldhead] {
3184         $patchtop.$e conf -state normal
3185         $patchtop.$e delete 0 end
3186         $patchtop.$e insert 0 $v
3187         $patchtop.$e conf -state readonly
3188     }
3189 }
3190
3191 proc mkpatchgo {} {
3192     global patchtop
3193
3194     set oldid [$patchtop.fromsha1 get]
3195     set newid [$patchtop.tosha1 get]
3196     set fname [$patchtop.fname get]
3197     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3198         error_popup "Error creating patch: $err"
3199     }
3200     catch {destroy $patchtop}
3201     unset patchtop
3202 }
3203
3204 proc mkpatchcan {} {
3205     global patchtop
3206
3207     catch {destroy $patchtop}
3208     unset patchtop
3209 }
3210
3211 proc mktag {} {
3212     global rowmenuid mktagtop commitinfo
3213
3214     set top .maketag
3215     set mktagtop $top
3216     catch {destroy $top}
3217     toplevel $top
3218     label $top.title -text "Create tag"
3219     grid $top.title - -pady 10
3220     label $top.id -text "ID:"
3221     entry $top.sha1 -width 40 -relief flat
3222     $top.sha1 insert 0 $rowmenuid
3223     $top.sha1 conf -state readonly
3224     grid $top.id $top.sha1 -sticky w
3225     entry $top.head -width 60 -relief flat
3226     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3227     $top.head conf -state readonly
3228     grid x $top.head -sticky w
3229     label $top.tlab -text "Tag name:"
3230     entry $top.tag -width 60
3231     grid $top.tlab $top.tag -sticky w
3232     frame $top.buts
3233     button $top.buts.gen -text "Create" -command mktaggo
3234     button $top.buts.can -text "Cancel" -command mktagcan
3235     grid $top.buts.gen $top.buts.can
3236     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3237     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3238     grid $top.buts - -pady 10 -sticky ew
3239     focus $top.tag
3240 }
3241
3242 proc domktag {} {
3243     global mktagtop env tagids idtags
3244
3245     set id [$mktagtop.sha1 get]
3246     set tag [$mktagtop.tag get]
3247     if {$tag == {}} {
3248         error_popup "No tag name specified"
3249         return
3250     }
3251     if {[info exists tagids($tag)]} {
3252         error_popup "Tag \"$tag\" already exists"
3253         return
3254     }
3255     if {[catch {
3256         set dir [gitdir]
3257         set fname [file join $dir "refs/tags" $tag]
3258         set f [open $fname w]
3259         puts $f $id
3260         close $f
3261     } err]} {
3262         error_popup "Error creating tag: $err"
3263         return
3264     }
3265
3266     set tagids($tag) $id
3267     lappend idtags($id) $tag
3268     redrawtags $id
3269 }
3270
3271 proc redrawtags {id} {
3272     global canv linehtag commitrow idpos selectedline
3273
3274     if {![info exists commitrow($id)]} return
3275     drawcmitrow $commitrow($id)
3276     $canv delete tag.$id
3277     set xt [eval drawtags $id $idpos($id)]
3278     $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3279     if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3280         selectline $selectedline 0
3281     }
3282 }
3283
3284 proc mktagcan {} {
3285     global mktagtop
3286
3287     catch {destroy $mktagtop}
3288     unset mktagtop
3289 }
3290
3291 proc mktaggo {} {
3292     domktag
3293     mktagcan
3294 }
3295
3296 proc writecommit {} {
3297     global rowmenuid wrcomtop commitinfo wrcomcmd
3298
3299     set top .writecommit
3300     set wrcomtop $top
3301     catch {destroy $top}
3302     toplevel $top
3303     label $top.title -text "Write commit to file"
3304     grid $top.title - -pady 10
3305     label $top.id -text "ID:"
3306     entry $top.sha1 -width 40 -relief flat
3307     $top.sha1 insert 0 $rowmenuid
3308     $top.sha1 conf -state readonly
3309     grid $top.id $top.sha1 -sticky w
3310     entry $top.head -width 60 -relief flat
3311     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3312     $top.head conf -state readonly
3313     grid x $top.head -sticky w
3314     label $top.clab -text "Command:"
3315     entry $top.cmd -width 60 -textvariable wrcomcmd
3316     grid $top.clab $top.cmd -sticky w -pady 10
3317     label $top.flab -text "Output file:"
3318     entry $top.fname -width 60
3319     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3320     grid $top.flab $top.fname -sticky w
3321     frame $top.buts
3322     button $top.buts.gen -text "Write" -command wrcomgo
3323     button $top.buts.can -text "Cancel" -command wrcomcan
3324     grid $top.buts.gen $top.buts.can
3325     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3326     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3327     grid $top.buts - -pady 10 -sticky ew
3328     focus $top.fname
3329 }
3330
3331 proc wrcomgo {} {
3332     global wrcomtop
3333
3334     set id [$wrcomtop.sha1 get]
3335     set cmd "echo $id | [$wrcomtop.cmd get]"
3336     set fname [$wrcomtop.fname get]
3337     if {[catch {exec sh -c $cmd >$fname &} err]} {
3338         error_popup "Error writing commit: $err"
3339     }
3340     catch {destroy $wrcomtop}
3341     unset wrcomtop
3342 }
3343
3344 proc wrcomcan {} {
3345     global wrcomtop
3346
3347     catch {destroy $wrcomtop}
3348     unset wrcomtop
3349 }
3350
3351 proc listrefs {id} {
3352     global idtags idheads idotherrefs
3353
3354     set x {}
3355     if {[info exists idtags($id)]} {
3356         set x $idtags($id)
3357     }
3358     set y {}
3359     if {[info exists idheads($id)]} {
3360         set y $idheads($id)
3361     }
3362     set z {}
3363     if {[info exists idotherrefs($id)]} {
3364         set z $idotherrefs($id)
3365     }
3366     return [list $x $y $z]
3367 }
3368
3369 proc rereadrefs {} {
3370     global idtags idheads idotherrefs
3371     global tagids headids otherrefids
3372
3373     set refids [concat [array names idtags] \
3374                     [array names idheads] [array names idotherrefs]]
3375     foreach id $refids {
3376         if {![info exists ref($id)]} {
3377             set ref($id) [listrefs $id]
3378         }
3379     }
3380     readrefs
3381     set refids [lsort -unique [concat $refids [array names idtags] \
3382                         [array names idheads] [array names idotherrefs]]]
3383     foreach id $refids {
3384         set v [listrefs $id]
3385         if {![info exists ref($id)] || $ref($id) != $v} {
3386             redrawtags $id
3387         }
3388     }
3389 }
3390
3391 proc showtag {tag isnew} {
3392     global ctext cflist tagcontents tagids linknum
3393
3394     if {$isnew} {
3395         addtohistory [list showtag $tag 0]
3396     }
3397     $ctext conf -state normal
3398     $ctext delete 0.0 end
3399     set linknum 0
3400     if {[info exists tagcontents($tag)]} {
3401         set text $tagcontents($tag)
3402     } else {
3403         set text "Tag: $tag\nId:  $tagids($tag)"
3404     }
3405     appendwithlinks $text
3406     $ctext conf -state disabled
3407     $cflist delete 0 end
3408 }
3409
3410 proc doquit {} {
3411     global stopped
3412     set stopped 100
3413     destroy .
3414 }
3415
3416 proc doprefs {} {
3417     global maxwidth maxgraphpct diffopts findmergefiles
3418     global oldprefs prefstop
3419
3420     set top .gitkprefs
3421     set prefstop $top
3422     if {[winfo exists $top]} {
3423         raise $top
3424         return
3425     }
3426     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3427         set oldprefs($v) [set $v]
3428     }
3429     toplevel $top
3430     wm title $top "Gitk preferences"
3431     label $top.ldisp -text "Commit list display options"
3432     grid $top.ldisp - -sticky w -pady 10
3433     label $top.spacer -text " "
3434     label $top.maxwidthl -text "Maximum graph width (lines)" \
3435         -font optionfont
3436     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3437     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3438     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3439         -font optionfont
3440     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3441     grid x $top.maxpctl $top.maxpct -sticky w
3442     checkbutton $top.findm -variable findmergefiles
3443     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3444         -font optionfont
3445     grid $top.findm $top.findml - -sticky w
3446     label $top.ddisp -text "Diff display options"
3447     grid $top.ddisp - -sticky w -pady 10
3448     label $top.diffoptl -text "Options for diff program" \
3449         -font optionfont
3450     entry $top.diffopt -width 20 -textvariable diffopts
3451     grid x $top.diffoptl $top.diffopt -sticky w
3452     frame $top.buts
3453     button $top.buts.ok -text "OK" -command prefsok
3454     button $top.buts.can -text "Cancel" -command prefscan
3455     grid $top.buts.ok $top.buts.can
3456     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3457     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3458     grid $top.buts - - -pady 10 -sticky ew
3459 }
3460
3461 proc prefscan {} {
3462     global maxwidth maxgraphpct diffopts findmergefiles
3463     global oldprefs prefstop
3464
3465     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3466         set $v $oldprefs($v)
3467     }
3468     catch {destroy $prefstop}
3469     unset prefstop
3470 }
3471
3472 proc prefsok {} {
3473     global maxwidth maxgraphpct
3474     global oldprefs prefstop
3475
3476     catch {destroy $prefstop}
3477     unset prefstop
3478     if {$maxwidth != $oldprefs(maxwidth)
3479         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3480         redisplay
3481     }
3482 }
3483
3484 proc formatdate {d} {
3485     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3486 }
3487
3488 # This list of encoding names and aliases is distilled from
3489 # http://www.iana.org/assignments/character-sets.
3490 # Not all of them are supported by Tcl.
3491 set encoding_aliases {
3492     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3493       ISO646-US US-ASCII us IBM367 cp367 csASCII }
3494     { ISO-10646-UTF-1 csISO10646UTF1 }
3495     { ISO_646.basic:1983 ref csISO646basic1983 }
3496     { INVARIANT csINVARIANT }
3497     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3498     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3499     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3500     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3501     { NATS-DANO iso-ir-9-1 csNATSDANO }
3502     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3503     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3504     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3505     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3506     { ISO-2022-KR csISO2022KR }
3507     { EUC-KR csEUCKR }
3508     { ISO-2022-JP csISO2022JP }
3509     { ISO-2022-JP-2 csISO2022JP2 }
3510     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3511       csISO13JISC6220jp }
3512     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3513     { IT iso-ir-15 ISO646-IT csISO15Italian }
3514     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3515     { ES iso-ir-17 ISO646-ES csISO17Spanish }
3516     { greek7-old iso-ir-18 csISO18Greek7Old }
3517     { latin-greek iso-ir-19 csISO19LatinGreek }
3518     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3519     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3520     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3521     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3522     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3523     { BS_viewdata iso-ir-47 csISO47BSViewdata }
3524     { INIS iso-ir-49 csISO49INIS }
3525     { INIS-8 iso-ir-50 csISO50INIS8 }
3526     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3527     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3528     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3529     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3530     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3531     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3532       csISO60Norwegian1 }
3533     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3534     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3535     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3536     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3537     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3538     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3539     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3540     { greek7 iso-ir-88 csISO88Greek7 }
3541     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3542     { iso-ir-90 csISO90 }
3543     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3544     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3545       csISO92JISC62991984b }
3546     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3547     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3548     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3549       csISO95JIS62291984handadd }
3550     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3551     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3552     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3553     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3554       CP819 csISOLatin1 }
3555     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3556     { T.61-7bit iso-ir-102 csISO102T617bit }
3557     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3558     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3559     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3560     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3561     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3562     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3563     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3564     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3565       arabic csISOLatinArabic }
3566     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3567     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3568     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3569       greek greek8 csISOLatinGreek }
3570     { T.101-G2 iso-ir-128 csISO128T101G2 }
3571     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3572       csISOLatinHebrew }
3573     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3574     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3575     { CSN_369103 iso-ir-139 csISO139CSN369103 }
3576     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3577     { ISO_6937-2-add iso-ir-142 csISOTextComm }
3578     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3579     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3580       csISOLatinCyrillic }
3581     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3582     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3583     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3584     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3585     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3586     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3587     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3588     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3589     { ISO_10367-box iso-ir-155 csISO10367Box }
3590     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3591     { latin-lap lap iso-ir-158 csISO158Lap }
3592     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3593     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3594     { us-dk csUSDK }
3595     { dk-us csDKUS }
3596     { JIS_X0201 X0201 csHalfWidthKatakana }
3597     { KSC5636 ISO646-KR csKSC5636 }
3598     { ISO-10646-UCS-2 csUnicode }
3599     { ISO-10646-UCS-4 csUCS4 }
3600     { DEC-MCS dec csDECMCS }
3601     { hp-roman8 roman8 r8 csHPRoman8 }
3602     { macintosh mac csMacintosh }
3603     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3604       csIBM037 }
3605     { IBM038 EBCDIC-INT cp038 csIBM038 }
3606     { IBM273 CP273 csIBM273 }
3607     { IBM274 EBCDIC-BE CP274 csIBM274 }
3608     { IBM275 EBCDIC-BR cp275 csIBM275 }
3609     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3610     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3611     { IBM280 CP280 ebcdic-cp-it csIBM280 }
3612     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3613     { IBM284 CP284 ebcdic-cp-es csIBM284 }
3614     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3615     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3616     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3617     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3618     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3619     { IBM424 cp424 ebcdic-cp-he csIBM424 }
3620     { IBM437 cp437 437 csPC8CodePage437 }
3621     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3622     { IBM775 cp775 csPC775Baltic }
3623     { IBM850 cp850 850 csPC850Multilingual }
3624     { IBM851 cp851 851 csIBM851 }
3625     { IBM852 cp852 852 csPCp852 }
3626     { IBM855 cp855 855 csIBM855 }
3627     { IBM857 cp857 857 csIBM857 }
3628     { IBM860 cp860 860 csIBM860 }
3629     { IBM861 cp861 861 cp-is csIBM861 }
3630     { IBM862 cp862 862 csPC862LatinHebrew }
3631     { IBM863 cp863 863 csIBM863 }
3632     { IBM864 cp864 csIBM864 }
3633     { IBM865 cp865 865 csIBM865 }
3634     { IBM866 cp866 866 csIBM866 }
3635     { IBM868 CP868 cp-ar csIBM868 }
3636     { IBM869 cp869 869 cp-gr csIBM869 }
3637     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3638     { IBM871 CP871 ebcdic-cp-is csIBM871 }
3639     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3640     { IBM891 cp891 csIBM891 }
3641     { IBM903 cp903 csIBM903 }
3642     { IBM904 cp904 904 csIBBM904 }
3643     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3644     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3645     { IBM1026 CP1026 csIBM1026 }
3646     { EBCDIC-AT-DE csIBMEBCDICATDE }
3647     { EBCDIC-AT-DE-A csEBCDICATDEA }
3648     { EBCDIC-CA-FR csEBCDICCAFR }
3649     { EBCDIC-DK-NO csEBCDICDKNO }
3650     { EBCDIC-DK-NO-A csEBCDICDKNOA }
3651     { EBCDIC-FI-SE csEBCDICFISE }
3652     { EBCDIC-FI-SE-A csEBCDICFISEA }
3653     { EBCDIC-FR csEBCDICFR }
3654     { EBCDIC-IT csEBCDICIT }
3655     { EBCDIC-PT csEBCDICPT }
3656     { EBCDIC-ES csEBCDICES }
3657     { EBCDIC-ES-A csEBCDICESA }
3658     { EBCDIC-ES-S csEBCDICESS }
3659     { EBCDIC-UK csEBCDICUK }
3660     { EBCDIC-US csEBCDICUS }
3661     { UNKNOWN-8BIT csUnknown8BiT }
3662     { MNEMONIC csMnemonic }
3663     { MNEM csMnem }
3664     { VISCII csVISCII }
3665     { VIQR csVIQR }
3666     { KOI8-R csKOI8R }
3667     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3668     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3669     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3670     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3671     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3672     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3673     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3674     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3675     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3676     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3677     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3678     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3679     { IBM1047 IBM-1047 }
3680     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3681     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3682     { UNICODE-1-1 csUnicode11 }
3683     { CESU-8 csCESU-8 }
3684     { BOCU-1 csBOCU-1 }
3685     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3686     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3687       l8 }
3688     { ISO-8859-15 ISO_8859-15 Latin-9 }
3689     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3690     { GBK CP936 MS936 windows-936 }
3691     { JIS_Encoding csJISEncoding }
3692     { Shift_JIS MS_Kanji csShiftJIS }
3693     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3694       EUC-JP }
3695     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3696     { ISO-10646-UCS-Basic csUnicodeASCII }
3697     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3698     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3699     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3700     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3701     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3702     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3703     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3704     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3705     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3706     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3707     { Adobe-Standard-Encoding csAdobeStandardEncoding }
3708     { Ventura-US csVenturaUS }
3709     { Ventura-International csVenturaInternational }
3710     { PC8-Danish-Norwegian csPC8DanishNorwegian }
3711     { PC8-Turkish csPC8Turkish }
3712     { IBM-Symbols csIBMSymbols }
3713     { IBM-Thai csIBMThai }
3714     { HP-Legal csHPLegal }
3715     { HP-Pi-font csHPPiFont }
3716     { HP-Math8 csHPMath8 }
3717     { Adobe-Symbol-Encoding csHPPSMath }
3718     { HP-DeskTop csHPDesktop }
3719     { Ventura-Math csVenturaMath }
3720     { Microsoft-Publishing csMicrosoftPublishing }
3721     { Windows-31J csWindows31J }
3722     { GB2312 csGB2312 }
3723     { Big5 csBig5 }
3724 }
3725
3726 proc tcl_encoding {enc} {
3727     global encoding_aliases
3728     set names [encoding names]
3729     set lcnames [string tolower $names]
3730     set enc [string tolower $enc]
3731     set i [lsearch -exact $lcnames $enc]
3732     if {$i < 0} {
3733         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3734         if {[regsub {^iso[-_]} $enc iso encx]} {
3735             set i [lsearch -exact $lcnames $encx]
3736         }
3737     }
3738     if {$i < 0} {
3739         foreach l $encoding_aliases {
3740             set ll [string tolower $l]
3741             if {[lsearch -exact $ll $enc] < 0} continue
3742             # look through the aliases for one that tcl knows about
3743             foreach e $ll {
3744                 set i [lsearch -exact $lcnames $e]
3745                 if {$i < 0} {
3746                     if {[regsub {^iso[-_]} $e iso ex]} {
3747                         set i [lsearch -exact $lcnames $ex]
3748                     }
3749                 }
3750                 if {$i >= 0} break
3751             }
3752             break
3753         }
3754     }
3755     if {$i >= 0} {
3756         return [lindex $names $i]
3757     }
3758     return {}
3759 }
3760
3761 # defaults...
3762 set datemode 0
3763 set diffopts "-U 5 -p"
3764 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3765
3766 set gitencoding {}
3767 catch {
3768     set gitencoding [exec git-repo-config --get i18n.commitencoding]
3769 }
3770 if {$gitencoding == ""} {
3771     set gitencoding "utf-8"
3772 }
3773 set tclencoding [tcl_encoding $gitencoding]
3774 if {$tclencoding == {}} {
3775     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3776 }
3777
3778 set mainfont {Helvetica 9}
3779 set textfont {Courier 9}
3780 set findmergefiles 0
3781 set maxgraphpct 50
3782 set maxwidth 16
3783 set revlistorder 0
3784 set fastdate 0
3785 set uparrowlen 7
3786 set downarrowlen 7
3787 set mingaplen 30
3788
3789 set colors {green red blue magenta darkgrey brown orange}
3790
3791 catch {source ~/.gitk}
3792
3793 set namefont $mainfont
3794
3795 font create optionfont -family sans-serif -size -12
3796
3797 set revtreeargs {}
3798 foreach arg $argv {
3799     switch -regexp -- $arg {
3800         "^$" { }
3801         "^-d" { set datemode 1 }
3802         default {
3803             lappend revtreeargs $arg
3804         }
3805     }
3806 }
3807
3808 # check that we can find a .git directory somewhere...
3809 set gitdir [gitdir]
3810 if {![file isdirectory $gitdir]} {
3811     error_popup "Cannot find the git directory \"$gitdir\"."
3812     exit 1
3813 }
3814
3815 set history {}
3816 set historyindex 0
3817
3818 set optim_delay 16
3819
3820 set stopped 0
3821 set stuffsaved 0
3822 set patchnum 0
3823 setcoords
3824 makewindow $revtreeargs
3825 readrefs
3826 getcommits $revtreeargs