gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
  16     }
  17 }
  18
  19 # A simple scheduler for compute-intensive stuff.
  20 # The aim is to make sure that event handlers for GUI actions can
  21 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22 # run before X event handlers, so reading from a fast source can
  23 # make the GUI completely unresponsive.
  24 proc run args {
  25     global isonrunq runq
  26
  27     set script $args
  28     if {[info exists isonrunq($script)]} return
  29     if {$runq eq {}} {
  30         after idle dorunq
  31     }
  32     lappend runq [list {} $script]
  33     set isonrunq($script) 1
  34 }
  35
  36 proc filerun {fd script} {
  37     fileevent $fd readable [list filereadable $fd $script]
  38 }
  39
  40 proc filereadable {fd script} {
  41     global runq
  42
  43     fileevent $fd readable {}
  44     if {$runq eq {}} {
  45         after idle dorunq
  46     }
  47     lappend runq [list $fd $script]
  48 }
  49
  50 proc dorunq {} {
  51     global isonrunq runq
  52
  53     set tstart [clock clicks -milliseconds]
  54     set t0 $tstart
  55     while {$runq ne {}} {
  56         set fd [lindex $runq 0 0]
  57         set script [lindex $runq 0 1]
  58         set repeat [eval $script]
  59         set t1 [clock clicks -milliseconds]
  60         set t [expr {$t1 - $t0}]
  61         set runq [lrange $runq 1 end]
  62         if {$repeat ne {} && $repeat} {
  63             if {$fd eq {} || $repeat == 2} {
  64                 # script returns 1 if it wants to be readded
  65                 # file readers return 2 if they could do more straight away
  66                 lappend runq [list $fd $script]
  67             } else {
  68                 fileevent $fd readable [list filereadable $fd $script]
  69             }
  70         } elseif {$fd eq {}} {
  71             unset isonrunq($script)
  72         }
  73         set t0 $t1
  74         if {$t1 - $tstart >= 80} break
  75     }
  76     if {$runq ne {}} {
  77         after idle dorunq
  78     }
  79 }
  80
  81 # Start off a git rev-list process and arrange to read its output
  82 proc start_rev_list {view} {
  83     global startmsecs
  84     global commfd leftover tclencoding datemode
  85     global viewargs viewfiles commitidx vnextroot
  86     global lookingforhead showlocalchanges
  87
  88     set startmsecs [clock clicks -milliseconds]
  89     set commitidx($view) 0
  90     set vnextroot($view) 0
  91     set order "--topo-order"
  92     if {$datemode} {
  93         set order "--date-order"
  94     }
  95     if {[catch {
  96         set fd [open [concat | git log -z --pretty=raw $order --parents \
  97                          --boundary $viewargs($view) "--" $viewfiles($view)] r]
  98     } err]} {
  99         error_popup "Error executing git rev-list: $err"
 100         exit 1
 101     }
 102     set commfd($view) $fd
 103     set leftover($view) {}
 104     set lookingforhead $showlocalchanges
 105     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 106     if {$tclencoding != {}} {
 107         fconfigure $fd -encoding $tclencoding
 108     }
 109     filerun $fd [list getcommitlines $fd $view]
 110     nowbusy $view
 111 }
 112
 113 proc stop_rev_list {} {
 114     global commfd curview
 115
 116     if {![info exists commfd($curview)]} return
 117     set fd $commfd($curview)
 118     catch {
 119         set pid [pid $fd]
 120         exec kill $pid
 121     }
 122     catch {close $fd}
 123     unset commfd($curview)
 124 }
 125
 126 proc getcommits {} {
 127     global phase canv mainfont curview
 128
 129     set phase getcommits
 130     initlayout
 131     start_rev_list $curview
 132     show_status "Reading commits..."
 133 }
 134
 135 # This makes a string representation of a positive integer which
 136 # sorts as a string in numerical order
 137 proc strrep {n} {
 138     if {$n < 16} {
 139         return [format "%x" $n]
 140     } elseif {$n < 256} {
 141         return [format "x%.2x" $n]
 142     } elseif {$n < 65536} {
 143         return [format "y%.4x" $n]
 144     }
 145     return [format "z%.8x" $n]
 146 }
 147
 148 proc getcommitlines {fd view}  {
 149     global commitlisted
 150     global leftover commfd
 151     global displayorder commitidx commitrow commitdata
 152     global parentlist children curview hlview
 153     global vparentlist vdisporder vcmitlisted
 154     global ordertok vnextroot
 155
 156     set stuff [read $fd 500000]
 157     # git log doesn't terminate the last commit with a null...
 158     if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
 159         set stuff "\0"
 160     }
 161     if {$stuff == {}} {
 162         if {![eof $fd]} {
 163             return 1
 164         }
 165         global viewname
 166         unset commfd($view)
 167         notbusy $view
 168         # set it blocking so we wait for the process to terminate
 169         fconfigure $fd -blocking 1
 170         if {[catch {close $fd} err]} {
 171             set fv {}
 172             if {$view != $curview} {
 173                 set fv " for the \"$viewname($view)\" view"
 174             }
 175             if {[string range $err 0 4] == "usage"} {
 176                 set err "Gitk: error reading commits$fv:\
 177                         bad arguments to git rev-list."
 178                 if {$viewname($view) eq "Command line"} {
 179                     append err \
 180                         "  (Note: arguments to gitk are passed to git rev-list\
 181                          to allow selection of commits to be displayed.)"
 182                 }
 183             } else {
 184                 set err "Error reading commits$fv: $err"
 185             }
 186             error_popup $err
 187         }
 188         if {$view == $curview} {
 189             run chewcommits $view
 190         }
 191         return 0
 192     }
 193     set start 0
 194     set gotsome 0
 195     while 1 {
 196         set i [string first "\0" $stuff $start]
 197         if {$i < 0} {
 198             append leftover($view) [string range $stuff $start end]
 199             break
 200         }
 201         if {$start == 0} {
 202             set cmit $leftover($view)
 203             append cmit [string range $stuff 0 [expr {$i - 1}]]
 204             set leftover($view) {}
 205         } else {
 206             set cmit [string range $stuff $start [expr {$i - 1}]]
 207         }
 208         set start [expr {$i + 1}]
 209         set j [string first "\n" $cmit]
 210         set ok 0
 211         set listed 1
 212         if {$j >= 0 && [string match "commit *" $cmit]} {
 213             set ids [string range $cmit 7 [expr {$j - 1}]]
 214             if {[string match {[-<>]*} $ids]} {
 215                 switch -- [string index $ids 0] {
 216                     "-" {set listed 0}
 217                     "<" {set listed 2}
 218                     ">" {set listed 3}
 219                 }
 220                 set ids [string range $ids 1 end]
 221             }
 222             set ok 1
 223             foreach id $ids {
 224                 if {[string length $id] != 40} {
 225                     set ok 0
 226                     break
 227                 }
 228             }
 229         }
 230         if {!$ok} {
 231             set shortcmit $cmit
 232             if {[string length $shortcmit] > 80} {
 233                 set shortcmit "[string range $shortcmit 0 80]..."
 234             }
 235             error_popup "Can't parse git log output: {$shortcmit}"
 236             exit 1
 237         }
 238         set id [lindex $ids 0]
 239         if {![info exists ordertok($view,$id)]} {
 240             set otok "o[strrep $vnextroot($view)]"
 241             incr vnextroot($view)
 242             set ordertok($view,$id) $otok
 243         } else {
 244             set otok $ordertok($view,$id)
 245         }
 246         if {$listed} {
 247             set olds [lrange $ids 1 end]
 248             if {[llength $olds] == 1} {
 249                 set p [lindex $olds 0]
 250                 lappend children($view,$p) $id
 251                 if {![info exists ordertok($view,$p)]} {
 252                     set ordertok($view,$p) $ordertok($view,$id)
 253                 }
 254             } else {
 255                 set i 0
 256                 foreach p $olds {
 257                     if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 258                         lappend children($view,$p) $id
 259                     }
 260                     if {![info exists ordertok($view,$p)]} {
 261                         set ordertok($view,$p) "$otok[strrep $i]]"
 262                     }
 263                     incr i
 264                 }
 265             }
 266         } else {
 267             set olds {}
 268         }
 269         if {![info exists children($view,$id)]} {
 270             set children($view,$id) {}
 271         }
 272         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 273         set commitrow($view,$id) $commitidx($view)
 274         incr commitidx($view)
 275         if {$view == $curview} {
 276             lappend parentlist $olds
 277             lappend displayorder $id
 278             lappend commitlisted $listed
 279         } else {
 280             lappend vparentlist($view) $olds
 281             lappend vdisporder($view) $id
 282             lappend vcmitlisted($view) $listed
 283         }
 284         set gotsome 1
 285     }
 286     if {$gotsome} {
 287         run chewcommits $view
 288     }
 289     return 2
 290 }
 291
 292 proc chewcommits {view} {
 293     global curview hlview commfd
 294     global selectedline pending_select
 295
 296     set more 0
 297     if {$view == $curview} {
 298         set allread [expr {![info exists commfd($view)]}]
 299         set tlimit [expr {[clock clicks -milliseconds] + 50}]
 300         set more [layoutmore $tlimit $allread]
 301         if {$allread && !$more} {
 302             global displayorder commitidx phase
 303             global numcommits startmsecs
 304
 305             if {[info exists pending_select]} {
 306                 set row [first_real_row]
 307                 selectline $row 1
 308             }
 309             if {$commitidx($curview) > 0} {
 310                 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 311                 #puts "overall $ms ms for $numcommits commits"
 312             } else {
 313                 show_status "No commits selected"
 314             }
 315             notbusy layout
 316             set phase {}
 317         }
 318     }
 319     if {[info exists hlview] && $view == $hlview} {
 320         vhighlightmore
 321     }
 322     return $more
 323 }
 324
 325 proc readcommit {id} {
 326     if {[catch {set contents [exec git cat-file commit $id]}]} return
 327     parsecommit $id $contents 0
 328 }
 329
 330 proc updatecommits {} {
 331     global viewdata curview phase displayorder
 332     global children commitrow selectedline thickerline
 333
 334     if {$phase ne {}} {
 335         stop_rev_list
 336         set phase {}
 337     }
 338     set n $curview
 339     foreach id $displayorder {
 340         catch {unset children($n,$id)}
 341         catch {unset commitrow($n,$id)}
 342     }
 343     set curview -1
 344     catch {unset selectedline}
 345     catch {unset thickerline}
 346     catch {unset viewdata($n)}
 347     readrefs
 348     changedrefs
 349     regetallcommits
 350     showview $n
 351 }
 352
 353 proc parsecommit {id contents listed} {
 354     global commitinfo cdate
 355
 356     set inhdr 1
 357     set comment {}
 358     set headline {}
 359     set auname {}
 360     set audate {}
 361     set comname {}
 362     set comdate {}
 363     set hdrend [string first "\n\n" $contents]
 364     if {$hdrend < 0} {
 365         # should never happen...
 366         set hdrend [string length $contents]
 367     }
 368     set header [string range $contents 0 [expr {$hdrend - 1}]]
 369     set comment [string range $contents [expr {$hdrend + 2}] end]
 370     foreach line [split $header "\n"] {
 371         set tag [lindex $line 0]
 372         if {$tag == "author"} {
 373             set audate [lindex $line end-1]
 374             set auname [lrange $line 1 end-2]
 375         } elseif {$tag == "committer"} {
 376             set comdate [lindex $line end-1]
 377             set comname [lrange $line 1 end-2]
 378         }
 379     }
 380     set headline {}
 381     # take the first non-blank line of the comment as the headline
 382     set headline [string trimleft $comment]
 383     set i [string first "\n" $headline]
 384     if {$i >= 0} {
 385         set headline [string range $headline 0 $i]
 386     }
 387     set headline [string trimright $headline]
 388     set i [string first "\r" $headline]
 389     if {$i >= 0} {
 390         set headline [string trimright [string range $headline 0 $i]]
 391     }
 392     if {!$listed} {
 393         # git rev-list indents the comment by 4 spaces;
 394         # if we got this via git cat-file, add the indentation
 395         set newcomment {}
 396         foreach line [split $comment "\n"] {
 397             append newcomment "    "
 398             append newcomment $line
 399             append newcomment "\n"
 400         }
 401         set comment $newcomment
 402     }
 403     if {$comdate != {}} {
 404         set cdate($id) $comdate
 405     }
 406     set commitinfo($id) [list $headline $auname $audate \
 407                              $comname $comdate $comment]
 408 }
 409
 410 proc getcommit {id} {
 411     global commitdata commitinfo
 412
 413     if {[info exists commitdata($id)]} {
 414         parsecommit $id $commitdata($id) 1
 415     } else {
 416         readcommit $id
 417         if {![info exists commitinfo($id)]} {
 418             set commitinfo($id) {"No commit information available"}
 419         }
 420     }
 421     return 1
 422 }
 423
 424 proc readrefs {} {
 425     global tagids idtags headids idheads tagobjid
 426     global otherrefids idotherrefs mainhead mainheadid
 427
 428     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 429         catch {unset $v}
 430     }
 431     set refd [open [list | git show-ref -d] r]
 432     while {[gets $refd line] >= 0} {
 433         if {[string index $line 40] ne " "} continue
 434         set id [string range $line 0 39]
 435         set ref [string range $line 41 end]
 436         if {![string match "refs/*" $ref]} continue
 437         set name [string range $ref 5 end]
 438         if {[string match "remotes/*" $name]} {
 439             if {![string match "*/HEAD" $name]} {
 440                 set headids($name) $id
 441                 lappend idheads($id) $name
 442             }
 443         } elseif {[string match "heads/*" $name]} {
 444             set name [string range $name 6 end]
 445             set headids($name) $id
 446             lappend idheads($id) $name
 447         } elseif {[string match "tags/*" $name]} {
 448             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 449             # which is what we want since the former is the commit ID
 450             set name [string range $name 5 end]
 451             if {[string match "*^{}" $name]} {
 452                 set name [string range $name 0 end-3]
 453             } else {
 454                 set tagobjid($name) $id
 455             }
 456             set tagids($name) $id
 457             lappend idtags($id) $name
 458         } else {
 459             set otherrefids($name) $id
 460             lappend idotherrefs($id) $name
 461         }
 462     }
 463     catch {close $refd}
 464     set mainhead {}
 465     set mainheadid {}
 466     catch {
 467         set thehead [exec git symbolic-ref HEAD]
 468         if {[string match "refs/heads/*" $thehead]} {
 469             set mainhead [string range $thehead 11 end]
 470             if {[info exists headids($mainhead)]} {
 471                 set mainheadid $headids($mainhead)
 472             }
 473         }
 474     }
 475 }
 476
 477 # skip over fake commits
 478 proc first_real_row {} {
 479     global nullid nullid2 displayorder numcommits
 480
 481     for {set row 0} {$row < $numcommits} {incr row} {
 482         set id [lindex $displayorder $row]
 483         if {$id ne $nullid && $id ne $nullid2} {
 484             break
 485         }
 486     }
 487     return $row
 488 }
 489
 490 # update things for a head moved to a child of its previous location
 491 proc movehead {id name} {
 492     global headids idheads
 493
 494     removehead $headids($name) $name
 495     set headids($name) $id
 496     lappend idheads($id) $name
 497 }
 498
 499 # update things when a head has been removed
 500 proc removehead {id name} {
 501     global headids idheads
 502
 503     if {$idheads($id) eq $name} {
 504         unset idheads($id)
 505     } else {
 506         set i [lsearch -exact $idheads($id) $name]
 507         if {$i >= 0} {
 508             set idheads($id) [lreplace $idheads($id) $i $i]
 509         }
 510     }
 511     unset headids($name)
 512 }
 513
 514 proc show_error {w top msg} {
 515     message $w.m -text $msg -justify center -aspect 400
 516     pack $w.m -side top -fill x -padx 20 -pady 20
 517     button $w.ok -text OK -command "destroy $top"
 518     pack $w.ok -side bottom -fill x
 519     bind $top <Visibility> "grab $top; focus $top"
 520     bind $top <Key-Return> "destroy $top"
 521     tkwait window $top
 522 }
 523
 524 proc error_popup msg {
 525     set w .error
 526     toplevel $w
 527     wm transient $w .
 528     show_error $w $w $msg
 529 }
 530
 531 proc confirm_popup msg {
 532     global confirm_ok
 533     set confirm_ok 0
 534     set w .confirm
 535     toplevel $w
 536     wm transient $w .
 537     message $w.m -text $msg -justify center -aspect 400
 538     pack $w.m -side top -fill x -padx 20 -pady 20
 539     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 540     pack $w.ok -side left -fill x
 541     button $w.cancel -text Cancel -command "destroy $w"
 542     pack $w.cancel -side right -fill x
 543     bind $w <Visibility> "grab $w; focus $w"
 544     tkwait window $w
 545     return $confirm_ok
 546 }
 547
 548 proc makewindow {} {
 549     global canv canv2 canv3 linespc charspc ctext cflist
 550     global textfont mainfont uifont tabstop
 551     global findtype findtypemenu findloc findstring fstring geometry
 552     global entries sha1entry sha1string sha1but
 553     global maincursor textcursor curtextcursor
 554     global rowctxmenu fakerowmenu mergemax wrapcomment
 555     global highlight_files gdttype
 556     global searchstring sstring
 557     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 558     global headctxmenu
 559
 560     menu .bar
 561     .bar add cascade -label "File" -menu .bar.file
 562     .bar configure -font $uifont
 563     menu .bar.file
 564     .bar.file add command -label "Update" -command updatecommits
 565     .bar.file add command -label "Reread references" -command rereadrefs
 566     .bar.file add command -label "Quit" -command doquit
 567     .bar.file configure -font $uifont
 568     menu .bar.edit
 569     .bar add cascade -label "Edit" -menu .bar.edit
 570     .bar.edit add command -label "Preferences" -command doprefs
 571     .bar.edit configure -font $uifont
 572
 573     menu .bar.view -font $uifont
 574     .bar add cascade -label "View" -menu .bar.view
 575     .bar.view add command -label "New view..." -command {newview 0}
 576     .bar.view add command -label "Edit view..." -command editview \
 577         -state disabled
 578     .bar.view add command -label "Delete view" -command delview -state disabled
 579     .bar.view add separator
 580     .bar.view add radiobutton -label "All files" -command {showview 0} \
 581         -variable selectedview -value 0
 582
 583     menu .bar.help
 584     .bar add cascade -label "Help" -menu .bar.help
 585     .bar.help add command -label "About gitk" -command about
 586     .bar.help add command -label "Key bindings" -command keys
 587     .bar.help configure -font $uifont
 588     . configure -menu .bar
 589
 590     # the gui has upper and lower half, parts of a paned window.
 591     panedwindow .ctop -orient vertical
 592
 593     # possibly use assumed geometry
 594     if {![info exists geometry(pwsash0)]} {
 595         set geometry(topheight) [expr {15 * $linespc}]
 596         set geometry(topwidth) [expr {80 * $charspc}]
 597         set geometry(botheight) [expr {15 * $linespc}]
 598         set geometry(botwidth) [expr {50 * $charspc}]
 599         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 600         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 601     }
 602
 603     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 604     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 605     frame .tf.histframe
 606     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 607
 608     # create three canvases
 609     set cscroll .tf.histframe.csb
 610     set canv .tf.histframe.pwclist.canv
 611     canvas $canv \
 612         -selectbackground $selectbgcolor \
 613         -background $bgcolor -bd 0 \
 614         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 615     .tf.histframe.pwclist add $canv
 616     set canv2 .tf.histframe.pwclist.canv2
 617     canvas $canv2 \
 618         -selectbackground $selectbgcolor \
 619         -background $bgcolor -bd 0 -yscrollincr $linespc
 620     .tf.histframe.pwclist add $canv2
 621     set canv3 .tf.histframe.pwclist.canv3
 622     canvas $canv3 \
 623         -selectbackground $selectbgcolor \
 624         -background $bgcolor -bd 0 -yscrollincr $linespc
 625     .tf.histframe.pwclist add $canv3
 626     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 627     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 628
 629     # a scroll bar to rule them
 630     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 631     pack $cscroll -side right -fill y
 632     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 633     lappend bglist $canv $canv2 $canv3
 634     pack .tf.histframe.pwclist -fill both -expand 1 -side left
 635
 636     # we have two button bars at bottom of top frame. Bar 1
 637     frame .tf.bar
 638     frame .tf.lbar -height 15
 639
 640     set sha1entry .tf.bar.sha1
 641     set entries $sha1entry
 642     set sha1but .tf.bar.sha1label
 643     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 644         -command gotocommit -width 8 -font $uifont
 645     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 646     pack .tf.bar.sha1label -side left
 647     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 648     trace add variable sha1string write sha1change
 649     pack $sha1entry -side left -pady 2
 650
 651     image create bitmap bm-left -data {
 652         #define left_width 16
 653         #define left_height 16
 654         static unsigned char left_bits[] = {
 655         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 656         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 657         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 658     }
 659     image create bitmap bm-right -data {
 660         #define right_width 16
 661         #define right_height 16
 662         static unsigned char right_bits[] = {
 663         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 664         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 665         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 666     }
 667     button .tf.bar.leftbut -image bm-left -command goback \
 668         -state disabled -width 26
 669     pack .tf.bar.leftbut -side left -fill y
 670     button .tf.bar.rightbut -image bm-right -command goforw \
 671         -state disabled -width 26
 672     pack .tf.bar.rightbut -side left -fill y
 673
 674     button .tf.bar.findbut -text "Find" -command dofind -font $uifont
 675     pack .tf.bar.findbut -side left
 676     set findstring {}
 677     set fstring .tf.bar.findstring
 678     lappend entries $fstring
 679     entry $fstring -width 30 -font $textfont -textvariable findstring
 680     trace add variable findstring write find_change
 681     pack $fstring -side left -expand 1 -fill x -in .tf.bar
 682     set findtype Exact
 683     set findtypemenu [tk_optionMenu .tf.bar.findtype \
 684                       findtype Exact IgnCase Regexp]
 685     trace add variable findtype write find_change
 686     .tf.bar.findtype configure -font $uifont
 687     .tf.bar.findtype.menu configure -font $uifont
 688     set findloc "All fields"
 689     tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
 690         Comments Author Committer
 691     trace add variable findloc write find_change
 692     .tf.bar.findloc configure -font $uifont
 693     .tf.bar.findloc.menu configure -font $uifont
 694     pack .tf.bar.findloc -side right
 695     pack .tf.bar.findtype -side right
 696
 697     # build up the bottom bar of upper window
 698     label .tf.lbar.flabel -text "Highlight:  Commits " \
 699     -font $uifont
 700     pack .tf.lbar.flabel -side left -fill y
 701     set gdttype "touching paths:"
 702     set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
 703         "adding/removing string:"]
 704     trace add variable gdttype write hfiles_change
 705     $gm conf -font $uifont
 706     .tf.lbar.gdttype conf -font $uifont
 707     pack .tf.lbar.gdttype -side left -fill y
 708     entry .tf.lbar.fent -width 25 -font $textfont \
 709         -textvariable highlight_files
 710     trace add variable highlight_files write hfiles_change
 711     lappend entries .tf.lbar.fent
 712     pack .tf.lbar.fent -side left -fill x -expand 1
 713     label .tf.lbar.vlabel -text " OR in view" -font $uifont
 714     pack .tf.lbar.vlabel -side left -fill y
 715     global viewhlmenu selectedhlview
 716     set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
 717     $viewhlmenu entryconf None -command delvhighlight
 718     $viewhlmenu conf -font $uifont
 719     .tf.lbar.vhl conf -font $uifont
 720     pack .tf.lbar.vhl -side left -fill y
 721     label .tf.lbar.rlabel -text " OR " -font $uifont
 722     pack .tf.lbar.rlabel -side left -fill y
 723     global highlight_related
 724     set m [tk_optionMenu .tf.lbar.relm highlight_related None \
 725         "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 726     $m conf -font $uifont
 727     .tf.lbar.relm conf -font $uifont
 728     trace add variable highlight_related write vrel_change
 729     pack .tf.lbar.relm -side left -fill y
 730
 731     # Finish putting the upper half of the viewer together
 732     pack .tf.lbar -in .tf -side bottom -fill x
 733     pack .tf.bar -in .tf -side bottom -fill x
 734     pack .tf.histframe -fill both -side top -expand 1
 735     .ctop add .tf
 736     .ctop paneconfigure .tf -height $geometry(topheight)
 737     .ctop paneconfigure .tf -width $geometry(topwidth)
 738
 739     # now build up the bottom
 740     panedwindow .pwbottom -orient horizontal
 741
 742     # lower left, a text box over search bar, scroll bar to the right
 743     # if we know window height, then that will set the lower text height, otherwise
 744     # we set lower text height which will drive window height
 745     if {[info exists geometry(main)]} {
 746         frame .bleft -width $geometry(botwidth)
 747     } else {
 748         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 749     }
 750     frame .bleft.top
 751     frame .bleft.mid
 752
 753     button .bleft.top.search -text "Search" -command dosearch \
 754         -font $uifont
 755     pack .bleft.top.search -side left -padx 5
 756     set sstring .bleft.top.sstring
 757     entry $sstring -width 20 -font $textfont -textvariable searchstring
 758     lappend entries $sstring
 759     trace add variable searchstring write incrsearch
 760     pack $sstring -side left -expand 1 -fill x
 761     radiobutton .bleft.mid.diff -text "Diff" \
 762         -command changediffdisp -variable diffelide -value {0 0}
 763     radiobutton .bleft.mid.old -text "Old version" \
 764         -command changediffdisp -variable diffelide -value {0 1}
 765     radiobutton .bleft.mid.new -text "New version" \
 766         -command changediffdisp -variable diffelide -value {1 0}
 767     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 768     set ctext .bleft.ctext
 769     text $ctext -background $bgcolor -foreground $fgcolor \
 770         -tabs "[expr {$tabstop * $charspc}]" \
 771         -state disabled -font $textfont \
 772         -yscrollcommand scrolltext -wrap none
 773     scrollbar .bleft.sb -command "$ctext yview"
 774     pack .bleft.top -side top -fill x
 775     pack .bleft.mid -side top -fill x
 776     pack .bleft.sb -side right -fill y
 777     pack $ctext -side left -fill both -expand 1
 778     lappend bglist $ctext
 779     lappend fglist $ctext
 780
 781     $ctext tag conf comment -wrap $wrapcomment
 782     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 783     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 784     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 785     $ctext tag conf d1 -fore [lindex $diffcolors 1]
 786     $ctext tag conf m0 -fore red
 787     $ctext tag conf m1 -fore blue
 788     $ctext tag conf m2 -fore green
 789     $ctext tag conf m3 -fore purple
 790     $ctext tag conf m4 -fore brown
 791     $ctext tag conf m5 -fore "#009090"
 792     $ctext tag conf m6 -fore magenta
 793     $ctext tag conf m7 -fore "#808000"
 794     $ctext tag conf m8 -fore "#009000"
 795     $ctext tag conf m9 -fore "#ff0080"
 796     $ctext tag conf m10 -fore cyan
 797     $ctext tag conf m11 -fore "#b07070"
 798     $ctext tag conf m12 -fore "#70b0f0"
 799     $ctext tag conf m13 -fore "#70f0b0"
 800     $ctext tag conf m14 -fore "#f0b070"
 801     $ctext tag conf m15 -fore "#ff70b0"
 802     $ctext tag conf mmax -fore darkgrey
 803     set mergemax 16
 804     $ctext tag conf mresult -font [concat $textfont bold]
 805     $ctext tag conf msep -font [concat $textfont bold]
 806     $ctext tag conf found -back yellow
 807
 808     .pwbottom add .bleft
 809     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 810
 811     # lower right
 812     frame .bright
 813     frame .bright.mode
 814     radiobutton .bright.mode.patch -text "Patch" \
 815         -command reselectline -variable cmitmode -value "patch"
 816     .bright.mode.patch configure -font $uifont
 817     radiobutton .bright.mode.tree -text "Tree" \
 818         -command reselectline -variable cmitmode -value "tree"
 819     .bright.mode.tree configure -font $uifont
 820     grid .bright.mode.patch .bright.mode.tree -sticky ew
 821     pack .bright.mode -side top -fill x
 822     set cflist .bright.cfiles
 823     set indent [font measure $mainfont "nn"]
 824     text $cflist \
 825         -selectbackground $selectbgcolor \
 826         -background $bgcolor -foreground $fgcolor \
 827         -font $mainfont \
 828         -tabs [list $indent [expr {2 * $indent}]] \
 829         -yscrollcommand ".bright.sb set" \
 830         -cursor [. cget -cursor] \
 831         -spacing1 1 -spacing3 1
 832     lappend bglist $cflist
 833     lappend fglist $cflist
 834     scrollbar .bright.sb -command "$cflist yview"
 835     pack .bright.sb -side right -fill y
 836     pack $cflist -side left -fill both -expand 1
 837     $cflist tag configure highlight \
 838         -background [$cflist cget -selectbackground]
 839     $cflist tag configure bold -font [concat $mainfont bold]
 840
 841     .pwbottom add .bright
 842     .ctop add .pwbottom
 843
 844     # restore window position if known
 845     if {[info exists geometry(main)]} {
 846         wm geometry . "$geometry(main)"
 847     }
 848
 849     if {[tk windowingsystem] eq {aqua}} {
 850         set M1B M1
 851     } else {
 852         set M1B Control
 853     }
 854
 855     bind .pwbottom <Configure> {resizecdetpanes %W %w}
 856     pack .ctop -fill both -expand 1
 857     bindall <1> {selcanvline %W %x %y}
 858     #bindall <B1-Motion> {selcanvline %W %x %y}
 859     if {[tk windowingsystem] == "win32"} {
 860         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
 861         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
 862     } else {
 863         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 864         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 865     }
 866     bindall <2> "canvscan mark %W %x %y"
 867     bindall <B2-Motion> "canvscan dragto %W %x %y"
 868     bindkey <Home> selfirstline
 869     bindkey <End> sellastline
 870     bind . <Key-Up> "selnextline -1"
 871     bind . <Key-Down> "selnextline 1"
 872     bind . <Shift-Key-Up> "next_highlight -1"
 873     bind . <Shift-Key-Down> "next_highlight 1"
 874     bindkey <Key-Right> "goforw"
 875     bindkey <Key-Left> "goback"
 876     bind . <Key-Prior> "selnextpage -1"
 877     bind . <Key-Next> "selnextpage 1"
 878     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
 879     bind . <$M1B-End> "allcanvs yview moveto 1.0"
 880     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
 881     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
 882     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
 883     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
 884     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 885     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 886     bindkey <Key-space> "$ctext yview scroll 1 pages"
 887     bindkey p "selnextline -1"
 888     bindkey n "selnextline 1"
 889     bindkey z "goback"
 890     bindkey x "goforw"
 891     bindkey i "selnextline -1"
 892     bindkey k "selnextline 1"
 893     bindkey j "goback"
 894     bindkey l "goforw"
 895     bindkey b "$ctext yview scroll -1 pages"
 896     bindkey d "$ctext yview scroll 18 units"
 897     bindkey u "$ctext yview scroll -18 units"
 898     bindkey / {findnext 1}
 899     bindkey <Key-Return> {findnext 0}
 900     bindkey ? findprev
 901     bindkey f nextfile
 902     bindkey <F5> updatecommits
 903     bind . <$M1B-q> doquit
 904     bind . <$M1B-f> dofind
 905     bind . <$M1B-g> {findnext 0}
 906     bind . <$M1B-r> dosearchback
 907     bind . <$M1B-s> dosearch
 908     bind . <$M1B-equal> {incrfont 1}
 909     bind . <$M1B-KP_Add> {incrfont 1}
 910     bind . <$M1B-minus> {incrfont -1}
 911     bind . <$M1B-KP_Subtract> {incrfont -1}
 912     wm protocol . WM_DELETE_WINDOW doquit
 913     bind . <Button-1> "click %W"
 914     bind $fstring <Key-Return> dofind
 915     bind $sha1entry <Key-Return> gotocommit
 916     bind $sha1entry <<PasteSelection>> clearsha1
 917     bind $cflist <1> {sel_flist %W %x %y; break}
 918     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 919     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 920     bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
 921
 922     set maincursor [. cget -cursor]
 923     set textcursor [$ctext cget -cursor]
 924     set curtextcursor $textcursor
 925
 926     set rowctxmenu .rowctxmenu
 927     menu $rowctxmenu -tearoff 0
 928     $rowctxmenu add command -label "Diff this -> selected" \
 929         -command {diffvssel 0}
 930     $rowctxmenu add command -label "Diff selected -> this" \
 931         -command {diffvssel 1}
 932     $rowctxmenu add command -label "Make patch" -command mkpatch
 933     $rowctxmenu add command -label "Create tag" -command mktag
 934     $rowctxmenu add command -label "Write commit to file" -command writecommit
 935     $rowctxmenu add command -label "Create new branch" -command mkbranch
 936     $rowctxmenu add command -label "Cherry-pick this commit" \
 937         -command cherrypick
 938     $rowctxmenu add command -label "Reset HEAD branch to here" \
 939         -command resethead
 940
 941     set fakerowmenu .fakerowmenu
 942     menu $fakerowmenu -tearoff 0
 943     $fakerowmenu add command -label "Diff this -> selected" \
 944         -command {diffvssel 0}
 945     $fakerowmenu add command -label "Diff selected -> this" \
 946         -command {diffvssel 1}
 947     $fakerowmenu add command -label "Make patch" -command mkpatch
 948 #    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
 949 #    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
 950 #    $fakerowmenu add command -label "Revert local changes" -command revertlocal
 951
 952     set headctxmenu .headctxmenu
 953     menu $headctxmenu -tearoff 0
 954     $headctxmenu add command -label "Check out this branch" \
 955         -command cobranch
 956     $headctxmenu add command -label "Remove this branch" \
 957         -command rmbranch
 958
 959     global flist_menu
 960     set flist_menu .flistctxmenu
 961     menu $flist_menu -tearoff 0
 962     $flist_menu add command -label "Highlight this too" \
 963         -command {flist_hl 0}
 964     $flist_menu add command -label "Highlight this only" \
 965         -command {flist_hl 1}
 966 }
 967
 968 # Windows sends all mouse wheel events to the current focused window, not
 969 # the one where the mouse hovers, so bind those events here and redirect
 970 # to the correct window
 971 proc windows_mousewheel_redirector {W X Y D} {
 972     global canv canv2 canv3
 973     set w [winfo containing -displayof $W $X $Y]
 974     if {$w ne ""} {
 975         set u [expr {$D < 0 ? 5 : -5}]
 976         if {$w == $canv || $w == $canv2 || $w == $canv3} {
 977             allcanvs yview scroll $u units
 978         } else {
 979             catch {
 980                 $w yview scroll $u units
 981             }
 982         }
 983     }
 984 }
 985
 986 # mouse-2 makes all windows scan vertically, but only the one
 987 # the cursor is in scans horizontally
 988 proc canvscan {op w x y} {
 989     global canv canv2 canv3
 990     foreach c [list $canv $canv2 $canv3] {
 991         if {$c == $w} {
 992             $c scan $op $x $y
 993         } else {
 994             $c scan $op 0 $y
 995         }
 996     }
 997 }
 998
 999 proc scrollcanv {cscroll f0 f1} {
1000     $cscroll set $f0 $f1
1001     drawfrac $f0 $f1
1002     flushhighlights
1003 }
1004
1005 # when we make a key binding for the toplevel, make sure
1006 # it doesn't get triggered when that key is pressed in the
1007 # find string entry widget.
1008 proc bindkey {ev script} {
1009     global entries
1010     bind . $ev $script
1011     set escript [bind Entry $ev]
1012     if {$escript == {}} {
1013         set escript [bind Entry <Key>]
1014     }
1015     foreach e $entries {
1016         bind $e $ev "$escript; break"
1017     }
1018 }
1019
1020 # set the focus back to the toplevel for any click outside
1021 # the entry widgets
1022 proc click {w} {
1023     global ctext entries
1024     foreach e [concat $entries $ctext] {
1025         if {$w == $e} return
1026     }
1027     focus .
1028 }
1029
1030 proc savestuff {w} {
1031     global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1032     global stuffsaved findmergefiles maxgraphpct
1033     global maxwidth showneartags showlocalchanges
1034     global viewname viewfiles viewargs viewperm nextviewnum
1035     global cmitmode wrapcomment
1036     global colors bgcolor fgcolor diffcolors selectbgcolor
1037
1038     if {$stuffsaved} return
1039     if {![winfo viewable .]} return
1040     catch {
1041         set f [open "~/.gitk-new" w]
1042         puts $f [list set mainfont $mainfont]
1043         puts $f [list set textfont $textfont]
1044         puts $f [list set uifont $uifont]
1045         puts $f [list set tabstop $tabstop]
1046         puts $f [list set findmergefiles $findmergefiles]
1047         puts $f [list set maxgraphpct $maxgraphpct]
1048         puts $f [list set maxwidth $maxwidth]
1049         puts $f [list set cmitmode $cmitmode]
1050         puts $f [list set wrapcomment $wrapcomment]
1051         puts $f [list set showneartags $showneartags]
1052         puts $f [list set showlocalchanges $showlocalchanges]
1053         puts $f [list set bgcolor $bgcolor]
1054         puts $f [list set fgcolor $fgcolor]
1055         puts $f [list set colors $colors]
1056         puts $f [list set diffcolors $diffcolors]
1057         puts $f [list set selectbgcolor $selectbgcolor]
1058
1059         puts $f "set geometry(main) [wm geometry .]"
1060         puts $f "set geometry(topwidth) [winfo width .tf]"
1061         puts $f "set geometry(topheight) [winfo height .tf]"
1062         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1063         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1064         puts $f "set geometry(botwidth) [winfo width .bleft]"
1065         puts $f "set geometry(botheight) [winfo height .bleft]"
1066
1067         puts -nonewline $f "set permviews {"
1068         for {set v 0} {$v < $nextviewnum} {incr v} {
1069             if {$viewperm($v)} {
1070                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1071             }
1072         }
1073         puts $f "}"
1074         close $f
1075         file rename -force "~/.gitk-new" "~/.gitk"
1076     }
1077     set stuffsaved 1
1078 }
1079
1080 proc resizeclistpanes {win w} {
1081     global oldwidth
1082     if {[info exists oldwidth($win)]} {
1083         set s0 [$win sash coord 0]
1084         set s1 [$win sash coord 1]
1085         if {$w < 60} {
1086             set sash0 [expr {int($w/2 - 2)}]
1087             set sash1 [expr {int($w*5/6 - 2)}]
1088         } else {
1089             set factor [expr {1.0 * $w / $oldwidth($win)}]
1090             set sash0 [expr {int($factor * [lindex $s0 0])}]
1091             set sash1 [expr {int($factor * [lindex $s1 0])}]
1092             if {$sash0 < 30} {
1093                 set sash0 30
1094             }
1095             if {$sash1 < $sash0 + 20} {
1096                 set sash1 [expr {$sash0 + 20}]
1097             }
1098             if {$sash1 > $w - 10} {
1099                 set sash1 [expr {$w - 10}]
1100                 if {$sash0 > $sash1 - 20} {
1101                     set sash0 [expr {$sash1 - 20}]
1102                 }
1103             }
1104         }
1105         $win sash place 0 $sash0 [lindex $s0 1]
1106         $win sash place 1 $sash1 [lindex $s1 1]
1107     }
1108     set oldwidth($win) $w
1109 }
1110
1111 proc resizecdetpanes {win w} {
1112     global oldwidth
1113     if {[info exists oldwidth($win)]} {
1114         set s0 [$win sash coord 0]
1115         if {$w < 60} {
1116             set sash0 [expr {int($w*3/4 - 2)}]
1117         } else {
1118             set factor [expr {1.0 * $w / $oldwidth($win)}]
1119             set sash0 [expr {int($factor * [lindex $s0 0])}]
1120             if {$sash0 < 45} {
1121                 set sash0 45
1122             }
1123             if {$sash0 > $w - 15} {
1124                 set sash0 [expr {$w - 15}]
1125             }
1126         }
1127         $win sash place 0 $sash0 [lindex $s0 1]
1128     }
1129     set oldwidth($win) $w
1130 }
1131
1132 proc allcanvs args {
1133     global canv canv2 canv3
1134     eval $canv $args
1135     eval $canv2 $args
1136     eval $canv3 $args
1137 }
1138
1139 proc bindall {event action} {
1140     global canv canv2 canv3
1141     bind $canv $event $action
1142     bind $canv2 $event $action
1143     bind $canv3 $event $action
1144 }
1145
1146 proc about {} {
1147     global uifont
1148     set w .about
1149     if {[winfo exists $w]} {
1150         raise $w
1151         return
1152     }
1153     toplevel $w
1154     wm title $w "About gitk"
1155     message $w.m -text {
1156 Gitk - a commit viewer for git
1157
1158 Copyright © 2005-2006 Paul Mackerras
1159
1160 Use and redistribute under the terms of the GNU General Public License} \
1161             -justify center -aspect 400 -border 2 -bg white -relief groove
1162     pack $w.m -side top -fill x -padx 2 -pady 2
1163     $w.m configure -font $uifont
1164     button $w.ok -text Close -command "destroy $w" -default active
1165     pack $w.ok -side bottom
1166     $w.ok configure -font $uifont
1167     bind $w <Visibility> "focus $w.ok"
1168     bind $w <Key-Escape> "destroy $w"
1169     bind $w <Key-Return> "destroy $w"
1170 }
1171
1172 proc keys {} {
1173     global uifont
1174     set w .keys
1175     if {[winfo exists $w]} {
1176         raise $w
1177         return
1178     }
1179     if {[tk windowingsystem] eq {aqua}} {
1180         set M1T Cmd
1181     } else {
1182         set M1T Ctrl
1183     }
1184     toplevel $w
1185     wm title $w "Gitk key bindings"
1186     message $w.m -text "
1187 Gitk key bindings:
1188
1189 <$M1T-Q>                Quit
1190 <Home>          Move to first commit
1191 <End>           Move to last commit
1192 <Up>, p, i      Move up one commit
1193 <Down>, n, k    Move down one commit
1194 <Left>, z, j    Go back in history list
1195 <Right>, x, l   Go forward in history list
1196 <PageUp>        Move up one page in commit list
1197 <PageDown>      Move down one page in commit list
1198 <$M1T-Home>     Scroll to top of commit list
1199 <$M1T-End>      Scroll to bottom of commit list
1200 <$M1T-Up>       Scroll commit list up one line
1201 <$M1T-Down>     Scroll commit list down one line
1202 <$M1T-PageUp>   Scroll commit list up one page
1203 <$M1T-PageDown> Scroll commit list down one page
1204 <Shift-Up>      Move to previous highlighted line
1205 <Shift-Down>    Move to next highlighted line
1206 <Delete>, b     Scroll diff view up one page
1207 <Backspace>     Scroll diff view up one page
1208 <Space>         Scroll diff view down one page
1209 u               Scroll diff view up 18 lines
1210 d               Scroll diff view down 18 lines
1211 <$M1T-F>                Find
1212 <$M1T-G>                Move to next find hit
1213 <Return>        Move to next find hit
1214 /               Move to next find hit, or redo find
1215 ?               Move to previous find hit
1216 f               Scroll diff view to next file
1217 <$M1T-S>                Search for next hit in diff view
1218 <$M1T-R>                Search for previous hit in diff view
1219 <$M1T-KP+>      Increase font size
1220 <$M1T-plus>     Increase font size
1221 <$M1T-KP->      Decrease font size
1222 <$M1T-minus>    Decrease font size
1223 <F5>            Update
1224 " \
1225             -justify left -bg white -border 2 -relief groove
1226     pack $w.m -side top -fill both -padx 2 -pady 2
1227     $w.m configure -font $uifont
1228     button $w.ok -text Close -command "destroy $w" -default active
1229     pack $w.ok -side bottom
1230     $w.ok configure -font $uifont
1231     bind $w <Visibility> "focus $w.ok"
1232     bind $w <Key-Escape> "destroy $w"
1233     bind $w <Key-Return> "destroy $w"
1234 }
1235
1236 # Procedures for manipulating the file list window at the
1237 # bottom right of the overall window.
1238
1239 proc treeview {w l openlevs} {
1240     global treecontents treediropen treeheight treeparent treeindex
1241
1242     set ix 0
1243     set treeindex() 0
1244     set lev 0
1245     set prefix {}
1246     set prefixend -1
1247     set prefendstack {}
1248     set htstack {}
1249     set ht 0
1250     set treecontents() {}
1251     $w conf -state normal
1252     foreach f $l {
1253         while {[string range $f 0 $prefixend] ne $prefix} {
1254             if {$lev <= $openlevs} {
1255                 $w mark set e:$treeindex($prefix) "end -1c"
1256                 $w mark gravity e:$treeindex($prefix) left
1257             }
1258             set treeheight($prefix) $ht
1259             incr ht [lindex $htstack end]
1260             set htstack [lreplace $htstack end end]
1261             set prefixend [lindex $prefendstack end]
1262             set prefendstack [lreplace $prefendstack end end]
1263             set prefix [string range $prefix 0 $prefixend]
1264             incr lev -1
1265         }
1266         set tail [string range $f [expr {$prefixend+1}] end]
1267         while {[set slash [string first "/" $tail]] >= 0} {
1268             lappend htstack $ht
1269             set ht 0
1270             lappend prefendstack $prefixend
1271             incr prefixend [expr {$slash + 1}]
1272             set d [string range $tail 0 $slash]
1273             lappend treecontents($prefix) $d
1274             set oldprefix $prefix
1275             append prefix $d
1276             set treecontents($prefix) {}
1277             set treeindex($prefix) [incr ix]
1278             set treeparent($prefix) $oldprefix
1279             set tail [string range $tail [expr {$slash+1}] end]
1280             if {$lev <= $openlevs} {
1281                 set ht 1
1282                 set treediropen($prefix) [expr {$lev < $openlevs}]
1283                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1284                 $w mark set d:$ix "end -1c"
1285                 $w mark gravity d:$ix left
1286                 set str "\n"
1287                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1288                 $w insert end $str
1289                 $w image create end -align center -image $bm -padx 1 \
1290                     -name a:$ix
1291                 $w insert end $d [highlight_tag $prefix]
1292                 $w mark set s:$ix "end -1c"
1293                 $w mark gravity s:$ix left
1294             }
1295             incr lev
1296         }
1297         if {$tail ne {}} {
1298             if {$lev <= $openlevs} {
1299                 incr ht
1300                 set str "\n"
1301                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1302                 $w insert end $str
1303                 $w insert end $tail [highlight_tag $f]
1304             }
1305             lappend treecontents($prefix) $tail
1306         }
1307     }
1308     while {$htstack ne {}} {
1309         set treeheight($prefix) $ht
1310         incr ht [lindex $htstack end]
1311         set htstack [lreplace $htstack end end]
1312         set prefixend [lindex $prefendstack end]
1313         set prefendstack [lreplace $prefendstack end end]
1314         set prefix [string range $prefix 0 $prefixend]
1315     }
1316     $w conf -state disabled
1317 }
1318
1319 proc linetoelt {l} {
1320     global treeheight treecontents
1321
1322     set y 2
1323     set prefix {}
1324     while {1} {
1325         foreach e $treecontents($prefix) {
1326             if {$y == $l} {
1327                 return "$prefix$e"
1328             }
1329             set n 1
1330             if {[string index $e end] eq "/"} {
1331                 set n $treeheight($prefix$e)
1332                 if {$y + $n > $l} {
1333                     append prefix $e
1334                     incr y
1335                     break
1336                 }
1337             }
1338             incr y $n
1339         }
1340     }
1341 }
1342
1343 proc highlight_tree {y prefix} {
1344     global treeheight treecontents cflist
1345
1346     foreach e $treecontents($prefix) {
1347         set path $prefix$e
1348         if {[highlight_tag $path] ne {}} {
1349             $cflist tag add bold $y.0 "$y.0 lineend"
1350         }
1351         incr y
1352         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1353             set y [highlight_tree $y $path]
1354         }
1355     }
1356     return $y
1357 }
1358
1359 proc treeclosedir {w dir} {
1360     global treediropen treeheight treeparent treeindex
1361
1362     set ix $treeindex($dir)
1363     $w conf -state normal
1364     $w delete s:$ix e:$ix
1365     set treediropen($dir) 0
1366     $w image configure a:$ix -image tri-rt
1367     $w conf -state disabled
1368     set n [expr {1 - $treeheight($dir)}]
1369     while {$dir ne {}} {
1370         incr treeheight($dir) $n
1371         set dir $treeparent($dir)
1372     }
1373 }
1374
1375 proc treeopendir {w dir} {
1376     global treediropen treeheight treeparent treecontents treeindex
1377
1378     set ix $treeindex($dir)
1379     $w conf -state normal
1380     $w image configure a:$ix -image tri-dn
1381     $w mark set e:$ix s:$ix
1382     $w mark gravity e:$ix right
1383     set lev 0
1384     set str "\n"
1385     set n [llength $treecontents($dir)]
1386     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1387         incr lev
1388         append str "\t"
1389         incr treeheight($x) $n
1390     }
1391     foreach e $treecontents($dir) {
1392         set de $dir$e
1393         if {[string index $e end] eq "/"} {
1394             set iy $treeindex($de)
1395             $w mark set d:$iy e:$ix
1396             $w mark gravity d:$iy left
1397             $w insert e:$ix $str
1398             set treediropen($de) 0
1399             $w image create e:$ix -align center -image tri-rt -padx 1 \
1400                 -name a:$iy
1401             $w insert e:$ix $e [highlight_tag $de]
1402             $w mark set s:$iy e:$ix
1403             $w mark gravity s:$iy left
1404             set treeheight($de) 1
1405         } else {
1406             $w insert e:$ix $str
1407             $w insert e:$ix $e [highlight_tag $de]
1408         }
1409     }
1410     $w mark gravity e:$ix left
1411     $w conf -state disabled
1412     set treediropen($dir) 1
1413     set top [lindex [split [$w index @0,0] .] 0]
1414     set ht [$w cget -height]
1415     set l [lindex [split [$w index s:$ix] .] 0]
1416     if {$l < $top} {
1417         $w yview $l.0
1418     } elseif {$l + $n + 1 > $top + $ht} {
1419         set top [expr {$l + $n + 2 - $ht}]
1420         if {$l < $top} {
1421             set top $l
1422         }
1423         $w yview $top.0
1424     }
1425 }
1426
1427 proc treeclick {w x y} {
1428     global treediropen cmitmode ctext cflist cflist_top
1429
1430     if {$cmitmode ne "tree"} return
1431     if {![info exists cflist_top]} return
1432     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1433     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1434     $cflist tag add highlight $l.0 "$l.0 lineend"
1435     set cflist_top $l
1436     if {$l == 1} {
1437         $ctext yview 1.0
1438         return
1439     }
1440     set e [linetoelt $l]
1441     if {[string index $e end] ne "/"} {
1442         showfile $e
1443     } elseif {$treediropen($e)} {
1444         treeclosedir $w $e
1445     } else {
1446         treeopendir $w $e
1447     }
1448 }
1449
1450 proc setfilelist {id} {
1451     global treefilelist cflist
1452
1453     treeview $cflist $treefilelist($id) 0
1454 }
1455
1456 image create bitmap tri-rt -background black -foreground blue -data {
1457     #define tri-rt_width 13
1458     #define tri-rt_height 13
1459     static unsigned char tri-rt_bits[] = {
1460        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1461        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1462        0x00, 0x00};
1463 } -maskdata {
1464     #define tri-rt-mask_width 13
1465     #define tri-rt-mask_height 13
1466     static unsigned char tri-rt-mask_bits[] = {
1467        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1468        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1469        0x08, 0x00};
1470 }
1471 image create bitmap tri-dn -background black -foreground blue -data {
1472     #define tri-dn_width 13
1473     #define tri-dn_height 13
1474     static unsigned char tri-dn_bits[] = {
1475        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1476        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1477        0x00, 0x00};
1478 } -maskdata {
1479     #define tri-dn-mask_width 13
1480     #define tri-dn-mask_height 13
1481     static unsigned char tri-dn-mask_bits[] = {
1482        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1483        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1484        0x00, 0x00};
1485 }
1486
1487 proc init_flist {first} {
1488     global cflist cflist_top selectedline difffilestart
1489
1490     $cflist conf -state normal
1491     $cflist delete 0.0 end
1492     if {$first ne {}} {
1493         $cflist insert end $first
1494         set cflist_top 1
1495         $cflist tag add highlight 1.0 "1.0 lineend"
1496     } else {
1497         catch {unset cflist_top}
1498     }
1499     $cflist conf -state disabled
1500     set difffilestart {}
1501 }
1502
1503 proc highlight_tag {f} {
1504     global highlight_paths
1505
1506     foreach p $highlight_paths {
1507         if {[string match $p $f]} {
1508             return "bold"
1509         }
1510     }
1511     return {}
1512 }
1513
1514 proc highlight_filelist {} {
1515     global cmitmode cflist
1516
1517     $cflist conf -state normal
1518     if {$cmitmode ne "tree"} {
1519         set end [lindex [split [$cflist index end] .] 0]
1520         for {set l 2} {$l < $end} {incr l} {
1521             set line [$cflist get $l.0 "$l.0 lineend"]
1522             if {[highlight_tag $line] ne {}} {
1523                 $cflist tag add bold $l.0 "$l.0 lineend"
1524             }
1525         }
1526     } else {
1527         highlight_tree 2 {}
1528     }
1529     $cflist conf -state disabled
1530 }
1531
1532 proc unhighlight_filelist {} {
1533     global cflist
1534
1535     $cflist conf -state normal
1536     $cflist tag remove bold 1.0 end
1537     $cflist conf -state disabled
1538 }
1539
1540 proc add_flist {fl} {
1541     global cflist
1542
1543     $cflist conf -state normal
1544     foreach f $fl {
1545         $cflist insert end "\n"
1546         $cflist insert end $f [highlight_tag $f]
1547     }
1548     $cflist conf -state disabled
1549 }
1550
1551 proc sel_flist {w x y} {
1552     global ctext difffilestart cflist cflist_top cmitmode
1553
1554     if {$cmitmode eq "tree"} return
1555     if {![info exists cflist_top]} return
1556     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1557     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1558     $cflist tag add highlight $l.0 "$l.0 lineend"
1559     set cflist_top $l
1560     if {$l == 1} {
1561         $ctext yview 1.0
1562     } else {
1563         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1564     }
1565 }
1566
1567 proc pop_flist_menu {w X Y x y} {
1568     global ctext cflist cmitmode flist_menu flist_menu_file
1569     global treediffs diffids
1570
1571     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1572     if {$l <= 1} return
1573     if {$cmitmode eq "tree"} {
1574         set e [linetoelt $l]
1575         if {[string index $e end] eq "/"} return
1576     } else {
1577         set e [lindex $treediffs($diffids) [expr {$l-2}]]
1578     }
1579     set flist_menu_file $e
1580     tk_popup $flist_menu $X $Y
1581 }
1582
1583 proc flist_hl {only} {
1584     global flist_menu_file highlight_files
1585
1586     set x [shellquote $flist_menu_file]
1587     if {$only || $highlight_files eq {}} {
1588         set highlight_files $x
1589     } else {
1590         append highlight_files " " $x
1591     }
1592 }
1593
1594 # Functions for adding and removing shell-type quoting
1595
1596 proc shellquote {str} {
1597     if {![string match "*\['\"\\ \t]*" $str]} {
1598         return $str
1599     }
1600     if {![string match "*\['\"\\]*" $str]} {
1601         return "\"$str\""
1602     }
1603     if {![string match "*'*" $str]} {
1604         return "'$str'"
1605     }
1606     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1607 }
1608
1609 proc shellarglist {l} {
1610     set str {}
1611     foreach a $l {
1612         if {$str ne {}} {
1613             append str " "
1614         }
1615         append str [shellquote $a]
1616     }
1617     return $str
1618 }
1619
1620 proc shelldequote {str} {
1621     set ret {}
1622     set used -1
1623     while {1} {
1624         incr used
1625         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1626             append ret [string range $str $used end]
1627             set used [string length $str]
1628             break
1629         }
1630         set first [lindex $first 0]
1631         set ch [string index $str $first]
1632         if {$first > $used} {
1633             append ret [string range $str $used [expr {$first - 1}]]
1634             set used $first
1635         }
1636         if {$ch eq " " || $ch eq "\t"} break
1637         incr used
1638         if {$ch eq "'"} {
1639             set first [string first "'" $str $used]
1640             if {$first < 0} {
1641                 error "unmatched single-quote"
1642             }
1643             append ret [string range $str $used [expr {$first - 1}]]
1644             set used $first
1645             continue
1646         }
1647         if {$ch eq "\\"} {
1648             if {$used >= [string length $str]} {
1649                 error "trailing backslash"
1650             }
1651             append ret [string index $str $used]
1652             continue
1653         }
1654         # here ch == "\""
1655         while {1} {
1656             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1657                 error "unmatched double-quote"
1658             }
1659             set first [lindex $first 0]
1660             set ch [string index $str $first]
1661             if {$first > $used} {
1662                 append ret [string range $str $used [expr {$first - 1}]]
1663                 set used $first
1664             }
1665             if {$ch eq "\""} break
1666             incr used
1667             append ret [string index $str $used]
1668             incr used
1669         }
1670     }
1671     return [list $used $ret]
1672 }
1673
1674 proc shellsplit {str} {
1675     set l {}
1676     while {1} {
1677         set str [string trimleft $str]
1678         if {$str eq {}} break
1679         set dq [shelldequote $str]
1680         set n [lindex $dq 0]
1681         set word [lindex $dq 1]
1682         set str [string range $str $n end]
1683         lappend l $word
1684     }
1685     return $l
1686 }
1687
1688 # Code to implement multiple views
1689
1690 proc newview {ishighlight} {
1691     global nextviewnum newviewname newviewperm uifont newishighlight
1692     global newviewargs revtreeargs
1693
1694     set newishighlight $ishighlight
1695     set top .gitkview
1696     if {[winfo exists $top]} {
1697         raise $top
1698         return
1699     }
1700     set newviewname($nextviewnum) "View $nextviewnum"
1701     set newviewperm($nextviewnum) 0
1702     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1703     vieweditor $top $nextviewnum "Gitk view definition"
1704 }
1705
1706 proc editview {} {
1707     global curview
1708     global viewname viewperm newviewname newviewperm
1709     global viewargs newviewargs
1710
1711     set top .gitkvedit-$curview
1712     if {[winfo exists $top]} {
1713         raise $top
1714         return
1715     }
1716     set newviewname($curview) $viewname($curview)
1717     set newviewperm($curview) $viewperm($curview)
1718     set newviewargs($curview) [shellarglist $viewargs($curview)]
1719     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1720 }
1721
1722 proc vieweditor {top n title} {
1723     global newviewname newviewperm viewfiles
1724     global uifont
1725
1726     toplevel $top
1727     wm title $top $title
1728     label $top.nl -text "Name" -font $uifont
1729     entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1730     grid $top.nl $top.name -sticky w -pady 5
1731     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1732         -font $uifont
1733     grid $top.perm - -pady 5 -sticky w
1734     message $top.al -aspect 1000 -font $uifont \
1735         -text "Commits to include (arguments to git rev-list):"
1736     grid $top.al - -sticky w -pady 5
1737     entry $top.args -width 50 -textvariable newviewargs($n) \
1738         -background white -font $uifont
1739     grid $top.args - -sticky ew -padx 5
1740     message $top.l -aspect 1000 -font $uifont \
1741         -text "Enter files and directories to include, one per line:"
1742     grid $top.l - -sticky w
1743     text $top.t -width 40 -height 10 -background white -font $uifont
1744     if {[info exists viewfiles($n)]} {
1745         foreach f $viewfiles($n) {
1746             $top.t insert end $f
1747             $top.t insert end "\n"
1748         }
1749         $top.t delete {end - 1c} end
1750         $top.t mark set insert 0.0
1751     }
1752     grid $top.t - -sticky ew -padx 5
1753     frame $top.buts
1754     button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1755         -font $uifont
1756     button $top.buts.can -text "Cancel" -command [list destroy $top] \
1757         -font $uifont
1758     grid $top.buts.ok $top.buts.can
1759     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1760     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1761     grid $top.buts - -pady 10 -sticky ew
1762     focus $top.t
1763 }
1764
1765 proc doviewmenu {m first cmd op argv} {
1766     set nmenu [$m index end]
1767     for {set i $first} {$i <= $nmenu} {incr i} {
1768         if {[$m entrycget $i -command] eq $cmd} {
1769             eval $m $op $i $argv
1770             break
1771         }
1772     }
1773 }
1774
1775 proc allviewmenus {n op args} {
1776     global viewhlmenu
1777
1778     doviewmenu .bar.view 5 [list showview $n] $op $args
1779     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1780 }
1781
1782 proc newviewok {top n} {
1783     global nextviewnum newviewperm newviewname newishighlight
1784     global viewname viewfiles viewperm selectedview curview
1785     global viewargs newviewargs viewhlmenu
1786
1787     if {[catch {
1788         set newargs [shellsplit $newviewargs($n)]
1789     } err]} {
1790         error_popup "Error in commit selection arguments: $err"
1791         wm raise $top
1792         focus $top
1793         return
1794     }
1795     set files {}
1796     foreach f [split [$top.t get 0.0 end] "\n"] {
1797         set ft [string trim $f]
1798         if {$ft ne {}} {
1799             lappend files $ft
1800         }
1801     }
1802     if {![info exists viewfiles($n)]} {
1803         # creating a new view
1804         incr nextviewnum
1805         set viewname($n) $newviewname($n)
1806         set viewperm($n) $newviewperm($n)
1807         set viewfiles($n) $files
1808         set viewargs($n) $newargs
1809         addviewmenu $n
1810         if {!$newishighlight} {
1811             run showview $n
1812         } else {
1813             run addvhighlight $n
1814         }
1815     } else {
1816         # editing an existing view
1817         set viewperm($n) $newviewperm($n)
1818         if {$newviewname($n) ne $viewname($n)} {
1819             set viewname($n) $newviewname($n)
1820             doviewmenu .bar.view 5 [list showview $n] \
1821                 entryconf [list -label $viewname($n)]
1822             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1823                 entryconf [list -label $viewname($n) -value $viewname($n)]
1824         }
1825         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1826             set viewfiles($n) $files
1827             set viewargs($n) $newargs
1828             if {$curview == $n} {
1829                 run updatecommits
1830             }
1831         }
1832     }
1833     catch {destroy $top}
1834 }
1835
1836 proc delview {} {
1837     global curview viewdata viewperm hlview selectedhlview
1838
1839     if {$curview == 0} return
1840     if {[info exists hlview] && $hlview == $curview} {
1841         set selectedhlview None
1842         unset hlview
1843     }
1844     allviewmenus $curview delete
1845     set viewdata($curview) {}
1846     set viewperm($curview) 0
1847     showview 0
1848 }
1849
1850 proc addviewmenu {n} {
1851     global viewname viewhlmenu
1852
1853     .bar.view add radiobutton -label $viewname($n) \
1854         -command [list showview $n] -variable selectedview -value $n
1855     $viewhlmenu add radiobutton -label $viewname($n) \
1856         -command [list addvhighlight $n] -variable selectedhlview
1857 }
1858
1859 proc flatten {var} {
1860     global $var
1861
1862     set ret {}
1863     foreach i [array names $var] {
1864         lappend ret $i [set $var\($i\)]
1865     }
1866     return $ret
1867 }
1868
1869 proc unflatten {var l} {
1870     global $var
1871
1872     catch {unset $var}
1873     foreach {i v} $l {
1874         set $var\($i\) $v
1875     }
1876 }
1877
1878 proc showview {n} {
1879     global curview viewdata viewfiles
1880     global displayorder parentlist rowidlist
1881     global colormap rowtextx commitrow nextcolor canvxmax
1882     global numcommits rowrangelist commitlisted idrowranges rowchk
1883     global selectedline currentid canv canvy0
1884     global treediffs
1885     global pending_select phase
1886     global commitidx rowlaidout rowoptim
1887     global commfd
1888     global selectedview selectfirst
1889     global vparentlist vdisporder vcmitlisted
1890     global hlview selectedhlview
1891
1892     if {$n == $curview} return
1893     set selid {}
1894     if {[info exists selectedline]} {
1895         set selid $currentid
1896         set y [yc $selectedline]
1897         set ymax [lindex [$canv cget -scrollregion] 3]
1898         set span [$canv yview]
1899         set ytop [expr {[lindex $span 0] * $ymax}]
1900         set ybot [expr {[lindex $span 1] * $ymax}]
1901         if {$ytop < $y && $y < $ybot} {
1902             set yscreen [expr {$y - $ytop}]
1903         } else {
1904             set yscreen [expr {($ybot - $ytop) / 2}]
1905         }
1906     } elseif {[info exists pending_select]} {
1907         set selid $pending_select
1908         unset pending_select
1909     }
1910     unselectline
1911     normalline
1912     if {$curview >= 0} {
1913         set vparentlist($curview) $parentlist
1914         set vdisporder($curview) $displayorder
1915         set vcmitlisted($curview) $commitlisted
1916         if {$phase ne {}} {
1917             set viewdata($curview) \
1918                 [list $phase $rowidlist {} $rowrangelist \
1919                      [flatten idrowranges] [flatten idinlist] \
1920                      $rowlaidout $rowoptim $numcommits]
1921         } elseif {![info exists viewdata($curview)]
1922                   || [lindex $viewdata($curview) 0] ne {}} {
1923             set viewdata($curview) \
1924                 [list {} $rowidlist {} $rowrangelist]
1925         }
1926     }
1927     catch {unset treediffs}
1928     clear_display
1929     if {[info exists hlview] && $hlview == $n} {
1930         unset hlview
1931         set selectedhlview None
1932     }
1933
1934     set curview $n
1935     set selectedview $n
1936     .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1937     .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1938
1939     if {![info exists viewdata($n)]} {
1940         if {$selid ne {}} {
1941             set pending_select $selid
1942         }
1943         getcommits
1944         return
1945     }
1946
1947     set v $viewdata($n)
1948     set phase [lindex $v 0]
1949     set displayorder $vdisporder($n)
1950     set parentlist $vparentlist($n)
1951     set commitlisted $vcmitlisted($n)
1952     set rowidlist [lindex $v 1]
1953     set rowrangelist [lindex $v 3]
1954     if {$phase eq {}} {
1955         set numcommits [llength $displayorder]
1956         catch {unset idrowranges}
1957     } else {
1958         unflatten idrowranges [lindex $v 4]
1959         unflatten idinlist [lindex $v 5]
1960         set rowlaidout [lindex $v 6]
1961         set rowoptim [lindex $v 7]
1962         set numcommits [lindex $v 8]
1963         catch {unset rowchk}
1964     }
1965
1966     catch {unset colormap}
1967     catch {unset rowtextx}
1968     set nextcolor 0
1969     set canvxmax [$canv cget -width]
1970     set curview $n
1971     set row 0
1972     setcanvscroll
1973     set yf 0
1974     set row {}
1975     set selectfirst 0
1976     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1977         set row $commitrow($n,$selid)
1978         # try to get the selected row in the same position on the screen
1979         set ymax [lindex [$canv cget -scrollregion] 3]
1980         set ytop [expr {[yc $row] - $yscreen}]
1981         if {$ytop < 0} {
1982             set ytop 0
1983         }
1984         set yf [expr {$ytop * 1.0 / $ymax}]
1985     }
1986     allcanvs yview moveto $yf
1987     drawvisible
1988     if {$row ne {}} {
1989         selectline $row 0
1990     } elseif {$selid ne {}} {
1991         set pending_select $selid
1992     } else {
1993         set row [first_real_row]
1994         if {$row < $numcommits} {
1995             selectline $row 0
1996         } else {
1997             set selectfirst 1
1998         }
1999     }
2000     if {$phase ne {}} {
2001         if {$phase eq "getcommits"} {
2002             show_status "Reading commits..."
2003         }
2004         run chewcommits $n
2005     } elseif {$numcommits == 0} {
2006         show_status "No commits selected"
2007     }
2008 }
2009
2010 # Stuff relating to the highlighting facility
2011
2012 proc ishighlighted {row} {
2013     global vhighlights fhighlights nhighlights rhighlights
2014
2015     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2016         return $nhighlights($row)
2017     }
2018     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2019         return $vhighlights($row)
2020     }
2021     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2022         return $fhighlights($row)
2023     }
2024     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2025         return $rhighlights($row)
2026     }
2027     return 0
2028 }
2029
2030 proc bolden {row font} {
2031     global canv linehtag selectedline boldrows
2032
2033     lappend boldrows $row
2034     $canv itemconf $linehtag($row) -font $font
2035     if {[info exists selectedline] && $row == $selectedline} {
2036         $canv delete secsel
2037         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2038                    -outline {{}} -tags secsel \
2039                    -fill [$canv cget -selectbackground]]
2040         $canv lower $t
2041     }
2042 }
2043
2044 proc bolden_name {row font} {
2045     global canv2 linentag selectedline boldnamerows
2046
2047     lappend boldnamerows $row
2048     $canv2 itemconf $linentag($row) -font $font
2049     if {[info exists selectedline] && $row == $selectedline} {
2050         $canv2 delete secsel
2051         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2052                    -outline {{}} -tags secsel \
2053                    -fill [$canv2 cget -selectbackground]]
2054         $canv2 lower $t
2055     }
2056 }
2057
2058 proc unbolden {} {
2059     global mainfont boldrows
2060
2061     set stillbold {}
2062     foreach row $boldrows {
2063         if {![ishighlighted $row]} {
2064             bolden $row $mainfont
2065         } else {
2066             lappend stillbold $row
2067         }
2068     }
2069     set boldrows $stillbold
2070 }
2071
2072 proc addvhighlight {n} {
2073     global hlview curview viewdata vhl_done vhighlights commitidx
2074
2075     if {[info exists hlview]} {
2076         delvhighlight
2077     }
2078     set hlview $n
2079     if {$n != $curview && ![info exists viewdata($n)]} {
2080         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2081         set vparentlist($n) {}
2082         set vdisporder($n) {}
2083         set vcmitlisted($n) {}
2084         start_rev_list $n
2085     }
2086     set vhl_done $commitidx($hlview)
2087     if {$vhl_done > 0} {
2088         drawvisible
2089     }
2090 }
2091
2092 proc delvhighlight {} {
2093     global hlview vhighlights
2094
2095     if {![info exists hlview]} return
2096     unset hlview
2097     catch {unset vhighlights}
2098     unbolden
2099 }
2100
2101 proc vhighlightmore {} {
2102     global hlview vhl_done commitidx vhighlights
2103     global displayorder vdisporder curview mainfont
2104
2105     set font [concat $mainfont bold]
2106     set max $commitidx($hlview)
2107     if {$hlview == $curview} {
2108         set disp $displayorder
2109     } else {
2110         set disp $vdisporder($hlview)
2111     }
2112     set vr [visiblerows]
2113     set r0 [lindex $vr 0]
2114     set r1 [lindex $vr 1]
2115     for {set i $vhl_done} {$i < $max} {incr i} {
2116         set id [lindex $disp $i]
2117         if {[info exists commitrow($curview,$id)]} {
2118             set row $commitrow($curview,$id)
2119             if {$r0 <= $row && $row <= $r1} {
2120                 if {![highlighted $row]} {
2121                     bolden $row $font
2122                 }
2123                 set vhighlights($row) 1
2124             }
2125         }
2126     }
2127     set vhl_done $max
2128 }
2129
2130 proc askvhighlight {row id} {
2131     global hlview vhighlights commitrow iddrawn mainfont
2132
2133     if {[info exists commitrow($hlview,$id)]} {
2134         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2135             bolden $row [concat $mainfont bold]
2136         }
2137         set vhighlights($row) 1
2138     } else {
2139         set vhighlights($row) 0
2140     }
2141 }
2142
2143 proc hfiles_change {name ix op} {
2144     global highlight_files filehighlight fhighlights fh_serial
2145     global mainfont highlight_paths
2146
2147     if {[info exists filehighlight]} {
2148         # delete previous highlights
2149         catch {close $filehighlight}
2150         unset filehighlight
2151         catch {unset fhighlights}
2152         unbolden
2153         unhighlight_filelist
2154     }
2155     set highlight_paths {}
2156     after cancel do_file_hl $fh_serial
2157     incr fh_serial
2158     if {$highlight_files ne {}} {
2159         after 300 do_file_hl $fh_serial
2160     }
2161 }
2162
2163 proc makepatterns {l} {
2164     set ret {}
2165     foreach e $l {
2166         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2167         if {[string index $ee end] eq "/"} {
2168             lappend ret "$ee*"
2169         } else {
2170             lappend ret $ee
2171             lappend ret "$ee/*"
2172         }
2173     }
2174     return $ret
2175 }
2176
2177 proc do_file_hl {serial} {
2178     global highlight_files filehighlight highlight_paths gdttype fhl_list
2179
2180     if {$gdttype eq "touching paths:"} {
2181         if {[catch {set paths [shellsplit $highlight_files]}]} return
2182         set highlight_paths [makepatterns $paths]
2183         highlight_filelist
2184         set gdtargs [concat -- $paths]
2185     } else {
2186         set gdtargs [list "-S$highlight_files"]
2187     }
2188     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2189     set filehighlight [open $cmd r+]
2190     fconfigure $filehighlight -blocking 0
2191     filerun $filehighlight readfhighlight
2192     set fhl_list {}
2193     drawvisible
2194     flushhighlights
2195 }
2196
2197 proc flushhighlights {} {
2198     global filehighlight fhl_list
2199
2200     if {[info exists filehighlight]} {
2201         lappend fhl_list {}
2202         puts $filehighlight ""
2203         flush $filehighlight
2204     }
2205 }
2206
2207 proc askfilehighlight {row id} {
2208     global filehighlight fhighlights fhl_list
2209
2210     lappend fhl_list $id
2211     set fhighlights($row) -1
2212     puts $filehighlight $id
2213 }
2214
2215 proc readfhighlight {} {
2216     global filehighlight fhighlights commitrow curview mainfont iddrawn
2217     global fhl_list
2218
2219     if {![info exists filehighlight]} {
2220         return 0
2221     }
2222     set nr 0
2223     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2224         set line [string trim $line]
2225         set i [lsearch -exact $fhl_list $line]
2226         if {$i < 0} continue
2227         for {set j 0} {$j < $i} {incr j} {
2228             set id [lindex $fhl_list $j]
2229             if {[info exists commitrow($curview,$id)]} {
2230                 set fhighlights($commitrow($curview,$id)) 0
2231             }
2232         }
2233         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2234         if {$line eq {}} continue
2235         if {![info exists commitrow($curview,$line)]} continue
2236         set row $commitrow($curview,$line)
2237         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2238             bolden $row [concat $mainfont bold]
2239         }
2240         set fhighlights($row) 1
2241     }
2242     if {[eof $filehighlight]} {
2243         # strange...
2244         puts "oops, git diff-tree died"
2245         catch {close $filehighlight}
2246         unset filehighlight
2247         return 0
2248     }
2249     next_hlcont
2250     return 1
2251 }
2252
2253 proc find_change {name ix op} {
2254     global nhighlights mainfont boldnamerows
2255     global findstring findpattern findtype
2256
2257     # delete previous highlights, if any
2258     foreach row $boldnamerows {
2259         bolden_name $row $mainfont
2260     }
2261     set boldnamerows {}
2262     catch {unset nhighlights}
2263     unbolden
2264     unmarkmatches
2265     if {$findtype ne "Regexp"} {
2266         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2267                    $findstring]
2268         set findpattern "*$e*"
2269     }
2270     drawvisible
2271 }
2272
2273 proc doesmatch {f} {
2274     global findtype findstring findpattern
2275
2276     if {$findtype eq "Regexp"} {
2277         return [regexp $findstring $f]
2278     } elseif {$findtype eq "IgnCase"} {
2279         return [string match -nocase $findpattern $f]
2280     } else {
2281         return [string match $findpattern $f]
2282     }
2283 }
2284
2285 proc askfindhighlight {row id} {
2286     global nhighlights commitinfo iddrawn mainfont
2287     global findloc
2288     global markingmatches
2289
2290     if {![info exists commitinfo($id)]} {
2291         getcommit $id
2292     }
2293     set info $commitinfo($id)
2294     set isbold 0
2295     set fldtypes {Headline Author Date Committer CDate Comments}
2296     foreach f $info ty $fldtypes {
2297         if {($findloc eq "All fields" || $findloc eq $ty) &&
2298             [doesmatch $f]} {
2299             if {$ty eq "Author"} {
2300                 set isbold 2
2301                 break
2302             }
2303             set isbold 1
2304         }
2305     }
2306     if {$isbold && [info exists iddrawn($id)]} {
2307         set f [concat $mainfont bold]
2308         if {![ishighlighted $row]} {
2309             bolden $row $f
2310             if {$isbold > 1} {
2311                 bolden_name $row $f
2312             }
2313         }
2314         if {$markingmatches} {
2315             markrowmatches $row $id
2316         }
2317     }
2318     set nhighlights($row) $isbold
2319 }
2320
2321 proc markrowmatches {row id} {
2322     global canv canv2 linehtag linentag commitinfo findloc
2323
2324     set headline [lindex $commitinfo($id) 0]
2325     set author [lindex $commitinfo($id) 1]
2326     $canv delete match$row
2327     $canv2 delete match$row
2328     if {$findloc eq "All fields" || $findloc eq "Headline"} {
2329         set m [findmatches $headline]
2330         if {$m ne {}} {
2331             markmatches $canv $row $headline $linehtag($row) $m \
2332                 [$canv itemcget $linehtag($row) -font] $row
2333         }
2334     }
2335     if {$findloc eq "All fields" || $findloc eq "Author"} {
2336         set m [findmatches $author]
2337         if {$m ne {}} {
2338             markmatches $canv2 $row $author $linentag($row) $m \
2339                 [$canv2 itemcget $linentag($row) -font] $row
2340         }
2341     }
2342 }
2343
2344 proc vrel_change {name ix op} {
2345     global highlight_related
2346
2347     rhighlight_none
2348     if {$highlight_related ne "None"} {
2349         run drawvisible
2350     }
2351 }
2352
2353 # prepare for testing whether commits are descendents or ancestors of a
2354 proc rhighlight_sel {a} {
2355     global descendent desc_todo ancestor anc_todo
2356     global highlight_related rhighlights
2357
2358     catch {unset descendent}
2359     set desc_todo [list $a]
2360     catch {unset ancestor}
2361     set anc_todo [list $a]
2362     if {$highlight_related ne "None"} {
2363         rhighlight_none
2364         run drawvisible
2365     }
2366 }
2367
2368 proc rhighlight_none {} {
2369     global rhighlights
2370
2371     catch {unset rhighlights}
2372     unbolden
2373 }
2374
2375 proc is_descendent {a} {
2376     global curview children commitrow descendent desc_todo
2377
2378     set v $curview
2379     set la $commitrow($v,$a)
2380     set todo $desc_todo
2381     set leftover {}
2382     set done 0
2383     for {set i 0} {$i < [llength $todo]} {incr i} {
2384         set do [lindex $todo $i]
2385         if {$commitrow($v,$do) < $la} {
2386             lappend leftover $do
2387             continue
2388         }
2389         foreach nk $children($v,$do) {
2390             if {![info exists descendent($nk)]} {
2391                 set descendent($nk) 1
2392                 lappend todo $nk
2393                 if {$nk eq $a} {
2394                     set done 1
2395                 }
2396             }
2397         }
2398         if {$done} {
2399             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2400             return
2401         }
2402     }
2403     set descendent($a) 0
2404     set desc_todo $leftover
2405 }
2406
2407 proc is_ancestor {a} {
2408     global curview parentlist commitrow ancestor anc_todo
2409
2410     set v $curview
2411     set la $commitrow($v,$a)
2412     set todo $anc_todo
2413     set leftover {}
2414     set done 0
2415     for {set i 0} {$i < [llength $todo]} {incr i} {
2416         set do [lindex $todo $i]
2417         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2418             lappend leftover $do
2419             continue
2420         }
2421         foreach np [lindex $parentlist $commitrow($v,$do)] {
2422             if {![info exists ancestor($np)]} {
2423                 set ancestor($np) 1
2424                 lappend todo $np
2425                 if {$np eq $a} {
2426                     set done 1
2427                 }
2428             }
2429         }
2430         if {$done} {
2431             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2432             return
2433         }
2434     }
2435     set ancestor($a) 0
2436     set anc_todo $leftover
2437 }
2438
2439 proc askrelhighlight {row id} {
2440     global descendent highlight_related iddrawn mainfont rhighlights
2441     global selectedline ancestor
2442
2443     if {![info exists selectedline]} return
2444     set isbold 0
2445     if {$highlight_related eq "Descendent" ||
2446         $highlight_related eq "Not descendent"} {
2447         if {![info exists descendent($id)]} {
2448             is_descendent $id
2449         }
2450         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2451             set isbold 1
2452         }
2453     } elseif {$highlight_related eq "Ancestor" ||
2454               $highlight_related eq "Not ancestor"} {
2455         if {![info exists ancestor($id)]} {
2456             is_ancestor $id
2457         }
2458         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2459             set isbold 1
2460         }
2461     }
2462     if {[info exists iddrawn($id)]} {
2463         if {$isbold && ![ishighlighted $row]} {
2464             bolden $row [concat $mainfont bold]
2465         }
2466     }
2467     set rhighlights($row) $isbold
2468 }
2469
2470 proc next_hlcont {} {
2471     global fhl_row fhl_dirn displayorder numcommits
2472     global vhighlights fhighlights nhighlights rhighlights
2473     global hlview filehighlight findstring highlight_related
2474
2475     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2476     set row $fhl_row
2477     while {1} {
2478         if {$row < 0 || $row >= $numcommits} {
2479             bell
2480             set fhl_dirn 0
2481             return
2482         }
2483         set id [lindex $displayorder $row]
2484         if {[info exists hlview]} {
2485             if {![info exists vhighlights($row)]} {
2486                 askvhighlight $row $id
2487             }
2488             if {$vhighlights($row) > 0} break
2489         }
2490         if {$findstring ne {}} {
2491             if {![info exists nhighlights($row)]} {
2492                 askfindhighlight $row $id
2493             }
2494             if {$nhighlights($row) > 0} break
2495         }
2496         if {$highlight_related ne "None"} {
2497             if {![info exists rhighlights($row)]} {
2498                 askrelhighlight $row $id
2499             }
2500             if {$rhighlights($row) > 0} break
2501         }
2502         if {[info exists filehighlight]} {
2503             if {![info exists fhighlights($row)]} {
2504                 # ask for a few more while we're at it...
2505                 set r $row
2506                 for {set n 0} {$n < 100} {incr n} {
2507                     if {![info exists fhighlights($r)]} {
2508                         askfilehighlight $r [lindex $displayorder $r]
2509                     }
2510                     incr r $fhl_dirn
2511                     if {$r < 0 || $r >= $numcommits} break
2512                 }
2513                 flushhighlights
2514             }
2515             if {$fhighlights($row) < 0} {
2516                 set fhl_row $row
2517                 return
2518             }
2519             if {$fhighlights($row) > 0} break
2520         }
2521         incr row $fhl_dirn
2522     }
2523     set fhl_dirn 0
2524     selectline $row 1
2525 }
2526
2527 proc next_highlight {dirn} {
2528     global selectedline fhl_row fhl_dirn
2529     global hlview filehighlight findstring highlight_related
2530
2531     if {![info exists selectedline]} return
2532     if {!([info exists hlview] || $findstring ne {} ||
2533           $highlight_related ne "None" || [info exists filehighlight])} return
2534     set fhl_row [expr {$selectedline + $dirn}]
2535     set fhl_dirn $dirn
2536     next_hlcont
2537 }
2538
2539 proc cancel_next_highlight {} {
2540     global fhl_dirn
2541
2542     set fhl_dirn 0
2543 }
2544
2545 # Graph layout functions
2546
2547 proc shortids {ids} {
2548     set res {}
2549     foreach id $ids {
2550         if {[llength $id] > 1} {
2551             lappend res [shortids $id]
2552         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2553             lappend res [string range $id 0 7]
2554         } else {
2555             lappend res $id
2556         }
2557     }
2558     return $res
2559 }
2560
2561 proc incrange {l x o} {
2562     set n [llength $l]
2563     while {$x < $n} {
2564         set e [lindex $l $x]
2565         if {$e ne {}} {
2566             lset l $x [expr {$e + $o}]
2567         }
2568         incr x
2569     }
2570     return $l
2571 }
2572
2573 proc ntimes {n o} {
2574     set ret {}
2575     for {} {$n > 0} {incr n -1} {
2576         lappend ret $o
2577     }
2578     return $ret
2579 }
2580
2581 proc usedinrange {id l1 l2} {
2582     global children commitrow curview
2583
2584     if {[info exists commitrow($curview,$id)]} {
2585         set r $commitrow($curview,$id)
2586         if {$l1 <= $r && $r <= $l2} {
2587             return [expr {$r - $l1 + 1}]
2588         }
2589     }
2590     set kids $children($curview,$id)
2591     foreach c $kids {
2592         set r $commitrow($curview,$c)
2593         if {$l1 <= $r && $r <= $l2} {
2594             return [expr {$r - $l1 + 1}]
2595         }
2596     }
2597     return 0
2598 }
2599
2600 # Work out where id should go in idlist so that order-token
2601 # values increase from left to right
2602 proc idcol {idlist id {i 0}} {
2603     global ordertok curview
2604
2605     set t $ordertok($curview,$id)
2606     if {$i >= [llength $idlist] ||
2607         $t < $ordertok($curview,[lindex $idlist $i])} {
2608         if {$i > [llength $idlist]} {
2609             set i [llength $idlist]
2610         }
2611         while {[incr i -1] >= 0 &&
2612                $t < $ordertok($curview,[lindex $idlist $i])} {}
2613         incr i
2614     } else {
2615         if {$t > $ordertok($curview,[lindex $idlist $i])} {
2616             while {[incr i] < [llength $idlist] &&
2617                    $t >= $ordertok($curview,[lindex $idlist $i])} {}
2618         }
2619     }
2620     return $i
2621 }
2622
2623 proc makeuparrow {oid y x} {
2624     global rowidlist uparrowlen idrowranges displayorder
2625
2626     for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
2627         incr y -1
2628         set idl [lindex $rowidlist $y]
2629         set x [idcol $idl $oid $x]
2630         lset rowidlist $y [linsert $idl $x $oid]
2631     }
2632     lappend idrowranges($oid) [lindex $displayorder $y]
2633 }
2634
2635 proc initlayout {} {
2636     global rowidlist displayorder commitlisted
2637     global rowlaidout rowoptim
2638     global idinlist rowchk rowrangelist idrowranges
2639     global numcommits canvxmax canv
2640     global nextcolor
2641     global parentlist
2642     global colormap rowtextx
2643     global selectfirst
2644
2645     set numcommits 0
2646     set displayorder {}
2647     set commitlisted {}
2648     set parentlist {}
2649     set rowrangelist {}
2650     set nextcolor 0
2651     set rowidlist {{}}
2652     catch {unset idinlist}
2653     catch {unset rowchk}
2654     set rowlaidout 0
2655     set rowoptim 0
2656     set canvxmax [$canv cget -width]
2657     catch {unset colormap}
2658     catch {unset rowtextx}
2659     catch {unset idrowranges}
2660     set selectfirst 1
2661 }
2662
2663 proc setcanvscroll {} {
2664     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2665
2666     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2667     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2668     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2669     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2670 }
2671
2672 proc visiblerows {} {
2673     global canv numcommits linespc
2674
2675     set ymax [lindex [$canv cget -scrollregion] 3]
2676     if {$ymax eq {} || $ymax == 0} return
2677     set f [$canv yview]
2678     set y0 [expr {int([lindex $f 0] * $ymax)}]
2679     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2680     if {$r0 < 0} {
2681         set r0 0
2682     }
2683     set y1 [expr {int([lindex $f 1] * $ymax)}]
2684     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2685     if {$r1 >= $numcommits} {
2686         set r1 [expr {$numcommits - 1}]
2687     }
2688     return [list $r0 $r1]
2689 }
2690
2691 proc layoutmore {tmax allread} {
2692     global rowlaidout rowoptim commitidx numcommits optim_delay
2693     global uparrowlen curview rowidlist idinlist
2694
2695     set showlast 0
2696     set showdelay $optim_delay
2697     set optdelay [expr {$uparrowlen + 1}]
2698     while {1} {
2699         if {$rowoptim - $showdelay > $numcommits} {
2700             showstuff [expr {$rowoptim - $showdelay}] $showlast
2701         } elseif {$rowlaidout - $optdelay > $rowoptim} {
2702             set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2703             if {$nr > 100} {
2704                 set nr 100
2705             }
2706             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2707             incr rowoptim $nr
2708         } elseif {$commitidx($curview) > $rowlaidout} {
2709             set nr [expr {$commitidx($curview) - $rowlaidout}]
2710             # may need to increase this threshold if uparrowlen or
2711             # mingaplen are increased...
2712             if {$nr > 200} {
2713                 set nr 200
2714             }
2715             set row $rowlaidout
2716             set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2717             if {$rowlaidout == $row} {
2718                 return 0
2719             }
2720         } elseif {$allread} {
2721             set optdelay 0
2722             set nrows $commitidx($curview)
2723             if {[lindex $rowidlist $nrows] ne {} ||
2724                 [array names idinlist] ne {}} {
2725                 layouttail
2726                 set rowlaidout $commitidx($curview)
2727             } elseif {$rowoptim == $nrows} {
2728                 set showdelay 0
2729                 set showlast 1
2730                 if {$numcommits == $nrows} {
2731                     return 0
2732                 }
2733             }
2734         } else {
2735             return 0
2736         }
2737         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2738             return 1
2739         }
2740     }
2741 }
2742
2743 proc showstuff {canshow last} {
2744     global numcommits commitrow pending_select selectedline curview
2745     global lookingforhead mainheadid displayorder selectfirst
2746     global lastscrollset
2747
2748     if {$numcommits == 0} {
2749         global phase
2750         set phase "incrdraw"
2751         allcanvs delete all
2752     }
2753     set r0 $numcommits
2754     set prev $numcommits
2755     set numcommits $canshow
2756     set t [clock clicks -milliseconds]
2757     if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2758         set lastscrollset $t
2759         setcanvscroll
2760     }
2761     set rows [visiblerows]
2762     set r1 [lindex $rows 1]
2763     if {$r1 >= $canshow} {
2764         set r1 [expr {$canshow - 1}]
2765     }
2766     if {$r0 <= $r1} {
2767         drawcommits $r0 $r1
2768     }
2769     if {[info exists pending_select] &&
2770         [info exists commitrow($curview,$pending_select)] &&
2771         $commitrow($curview,$pending_select) < $numcommits} {
2772         selectline $commitrow($curview,$pending_select) 1
2773     }
2774     if {$selectfirst} {
2775         if {[info exists selectedline] || [info exists pending_select]} {
2776             set selectfirst 0
2777         } else {
2778             set l [first_real_row]
2779             selectline $l 1
2780             set selectfirst 0
2781         }
2782     }
2783     if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2784         && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2785         set lookingforhead 0
2786         dodiffindex
2787     }
2788 }
2789
2790 proc doshowlocalchanges {} {
2791     global lookingforhead curview mainheadid phase commitrow
2792
2793     if {[info exists commitrow($curview,$mainheadid)] &&
2794         ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2795         dodiffindex
2796     } elseif {$phase ne {}} {
2797         set lookingforhead 1
2798     }
2799 }
2800
2801 proc dohidelocalchanges {} {
2802     global lookingforhead localfrow localirow lserial
2803
2804     set lookingforhead 0
2805     if {$localfrow >= 0} {
2806         removerow $localfrow
2807         set localfrow -1
2808         if {$localirow > 0} {
2809             incr localirow -1
2810         }
2811     }
2812     if {$localirow >= 0} {
2813         removerow $localirow
2814         set localirow -1
2815     }
2816     incr lserial
2817 }
2818
2819 # spawn off a process to do git diff-index --cached HEAD
2820 proc dodiffindex {} {
2821     global localirow localfrow lserial
2822
2823     incr lserial
2824     set localfrow -1
2825     set localirow -1
2826     set fd [open "|git diff-index --cached HEAD" r]
2827     fconfigure $fd -blocking 0
2828     filerun $fd [list readdiffindex $fd $lserial]
2829 }
2830
2831 proc readdiffindex {fd serial} {
2832     global localirow commitrow mainheadid nullid2 curview
2833     global commitinfo commitdata lserial
2834
2835     set isdiff 1
2836     if {[gets $fd line] < 0} {
2837         if {![eof $fd]} {
2838             return 1
2839         }
2840         set isdiff 0
2841     }
2842     # we only need to see one line and we don't really care what it says...
2843     close $fd
2844
2845     # now see if there are any local changes not checked in to the index
2846     if {$serial == $lserial} {
2847         set fd [open "|git diff-files" r]
2848         fconfigure $fd -blocking 0
2849         filerun $fd [list readdifffiles $fd $serial]
2850     }
2851
2852     if {$isdiff && $serial == $lserial && $localirow == -1} {
2853         # add the line for the changes in the index to the graph
2854         set localirow $commitrow($curview,$mainheadid)
2855         set hl "Local changes checked in to index but not committed"
2856         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2857         set commitdata($nullid2) "\n    $hl\n"
2858         insertrow $localirow $nullid2
2859     }
2860     return 0
2861 }
2862
2863 proc readdifffiles {fd serial} {
2864     global localirow localfrow commitrow mainheadid nullid curview
2865     global commitinfo commitdata lserial
2866
2867     set isdiff 1
2868     if {[gets $fd line] < 0} {
2869         if {![eof $fd]} {
2870             return 1
2871         }
2872         set isdiff 0
2873     }
2874     # we only need to see one line and we don't really care what it says...
2875     close $fd
2876
2877     if {$isdiff && $serial == $lserial && $localfrow == -1} {
2878         # add the line for the local diff to the graph
2879         if {$localirow >= 0} {
2880             set localfrow $localirow
2881             incr localirow
2882         } else {
2883             set localfrow $commitrow($curview,$mainheadid)
2884         }
2885         set hl "Local uncommitted changes, not checked in to index"
2886         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2887         set commitdata($nullid) "\n    $hl\n"
2888         insertrow $localfrow $nullid
2889     }
2890     return 0
2891 }
2892
2893 proc layoutrows {row endrow last} {
2894     global rowidlist displayorder
2895     global uparrowlen downarrowlen maxwidth mingaplen
2896     global children parentlist
2897     global idrowranges
2898     global commitidx curview
2899     global idinlist rowchk rowrangelist
2900
2901     set idlist [lindex $rowidlist $row]
2902     while {$row < $endrow} {
2903         set id [lindex $displayorder $row]
2904         set oldolds {}
2905         set newolds {}
2906         set olds [lindex $parentlist $row]
2907         foreach p $olds {
2908             if {![info exists idinlist($p)]} {
2909                 lappend newolds $p
2910             } elseif {!$idinlist($p)} {
2911                 lappend oldolds $p
2912             }
2913             set idinlist($p) 1
2914         }
2915         set nev [expr {[llength $idlist] + [llength $newolds]
2916                        + [llength $oldolds] - $maxwidth + 1}]
2917         if {1 || $nev > 0} {
2918             if {!$last &&
2919                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2920             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2921                 set i [lindex $idlist $x]
2922                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2923                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2924                                [expr {$row + $uparrowlen + $mingaplen}]]
2925                     if {$r == 0} {
2926                         set idlist [lreplace $idlist $x $x]
2927                         set idinlist($i) 0
2928                         set rm1 [expr {$row - 1}]
2929                         lappend idrowranges($i) [lindex $displayorder $rm1]
2930                         #if {[incr nev -1] <= 0} break
2931                         continue
2932                     }
2933                     set rowchk($id) [expr {$row + $r}]
2934                 }
2935             }
2936             lset rowidlist $row $idlist
2937         }
2938         set col [lsearch -exact $idlist $id]
2939         if {$col < 0} {
2940             set col [idcol $idlist $id]
2941             set idlist [linsert $idlist $col $id]
2942             lset rowidlist $row $idlist
2943             if {$children($curview,$id) ne {}} {
2944                 unset idinlist($id)
2945                 makeuparrow $id $row $col
2946             }
2947         } else {
2948             unset idinlist($id)
2949         }
2950         set ranges {}
2951         if {[info exists idrowranges($id)]} {
2952             set ranges $idrowranges($id)
2953             lappend ranges $id
2954             unset idrowranges($id)
2955         }
2956         lappend rowrangelist $ranges
2957         incr row
2958         set idlist [lreplace $idlist $col $col]
2959         set x $col
2960         foreach i $newolds {
2961             set x [idcol $idlist $i $x]
2962             set idlist [linsert $idlist $x $i]
2963             set idrowranges($i) $id
2964         }
2965         foreach oid $oldolds {
2966             set x [idcol $idlist $oid $x]
2967             set idlist [linsert $idlist $x $oid]
2968             makeuparrow $oid $row $x
2969         }
2970         lappend rowidlist $idlist
2971     }
2972     return $row
2973 }
2974
2975 proc addextraid {id row} {
2976     global displayorder commitrow commitinfo
2977     global commitidx commitlisted
2978     global parentlist children curview
2979
2980     incr commitidx($curview)
2981     lappend displayorder $id
2982     lappend commitlisted 0
2983     lappend parentlist {}
2984     set commitrow($curview,$id) $row
2985     readcommit $id
2986     if {![info exists commitinfo($id)]} {
2987         set commitinfo($id) {"No commit information available"}
2988     }
2989     if {![info exists children($curview,$id)]} {
2990         set children($curview,$id) {}
2991     }
2992 }
2993
2994 proc layouttail {} {
2995     global rowidlist idinlist commitidx curview
2996     global idrowranges rowrangelist
2997
2998     set row $commitidx($curview)
2999     set idlist [lindex $rowidlist $row]
3000     while {$idlist ne {}} {
3001         set col [expr {[llength $idlist] - 1}]
3002         set id [lindex $idlist $col]
3003         addextraid $id $row
3004         catch {unset idinlist($id)}
3005         lappend idrowranges($id) $id
3006         lappend rowrangelist $idrowranges($id)
3007         unset idrowranges($id)
3008         incr row
3009         set idlist [lreplace $idlist $col $col]
3010         lappend rowidlist $idlist
3011     }
3012
3013     foreach id [array names idinlist] {
3014         unset idinlist($id)
3015         addextraid $id $row
3016         lset rowidlist $row [list $id]
3017         makeuparrow $id $row 0
3018         lappend idrowranges($id) $id
3019         lappend rowrangelist $idrowranges($id)
3020         unset idrowranges($id)
3021         incr row
3022         lappend rowidlist {}
3023     }
3024 }
3025
3026 proc insert_pad {row col npad} {
3027     global rowidlist
3028
3029     set pad [ntimes $npad {}]
3030     set idlist [lindex $rowidlist $row]
3031     set bef [lrange $idlist 0 [expr {$col - 1}]]
3032     set aft [lrange $idlist $col end]
3033     set i [lsearch -exact $aft {}]
3034     if {$i > 0} {
3035         set aft [lreplace $aft $i $i]
3036     }
3037     lset rowidlist $row [concat $bef $pad $aft]
3038 }
3039
3040 proc optimize_rows {row col endrow} {
3041     global rowidlist displayorder
3042
3043     if {$row < 1} {
3044         set row 1
3045     }
3046     set idlist [lindex $rowidlist [expr {$row - 1}]]
3047     if {$row >= 2} {
3048         set previdlist [lindex $rowidlist [expr {$row - 2}]]
3049     } else {
3050         set previdlist {}
3051     }
3052     for {} {$row < $endrow} {incr row} {
3053         set pprevidlist $previdlist
3054         set previdlist $idlist
3055         set idlist [lindex $rowidlist $row]
3056         set haspad 0
3057         set y0 [expr {$row - 1}]
3058         set ym [expr {$row - 2}]
3059         set x0 -1
3060         set xm -1
3061         for {} {$col < [llength $idlist]} {incr col} {
3062             set id [lindex $idlist $col]
3063             if {[lindex $previdlist $col] eq $id} continue
3064             if {$id eq {}} {
3065                 set haspad 1
3066                 continue
3067             }
3068             set x0 [lsearch -exact $previdlist $id]
3069             if {$x0 < 0} continue
3070             set z [expr {$x0 - $col}]
3071             set isarrow 0
3072             set z0 {}
3073             if {$ym >= 0} {
3074                 set xm [lsearch -exact $pprevidlist $id]
3075                 if {$xm >= 0} {
3076                     set z0 [expr {$xm - $x0}]
3077                 }
3078             }
3079             if {$z0 eq {}} {
3080                 set ranges [rowranges $id]
3081                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3082                     set isarrow 1
3083                 }
3084             }
3085             if {!$isarrow && $id ne [lindex $displayorder $row] &&
3086                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3087                 set isarrow 1
3088             }
3089             # Looking at lines from this row to the previous row,
3090             # make them go straight up if they end in an arrow on
3091             # the previous row; otherwise make them go straight up
3092             # or at 45 degrees.
3093             if {$z < -1 || ($z < 0 && $isarrow)} {
3094                 # Line currently goes left too much;
3095                 # insert pads in the previous row, then optimize it
3096                 set npad [expr {-1 - $z + $isarrow}]
3097                 insert_pad $y0 $x0 $npad
3098                 if {$y0 > 0} {
3099                     optimize_rows $y0 $x0 $row
3100                 }
3101                 set previdlist [lindex $rowidlist $y0]
3102                 set x0 [lsearch -exact $previdlist $id]
3103                 set z [expr {$x0 - $col}]
3104                 if {$z0 ne {}} {
3105                     set pprevidlist [lindex $rowidlist $ym]
3106                     set xm [lsearch -exact $pprevidlist $id]
3107                     set z0 [expr {$xm - $x0}]
3108                 }
3109             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3110                 # Line currently goes right too much;
3111                 # insert pads in this line
3112                 set npad [expr {$z - 1 + $isarrow}]
3113                 insert_pad $row $col $npad
3114                 set idlist [lindex $rowidlist $row]
3115                 incr col $npad
3116                 set z [expr {$x0 - $col}]
3117                 set haspad 1
3118             }
3119             if {$z0 eq {} && !$isarrow && $ym >= 0} {
3120                 # this line links to its first child on row $row-2
3121                 set id [lindex $displayorder $ym]
3122                 set xc [lsearch -exact $pprevidlist $id]
3123                 if {$xc >= 0} {
3124                     set z0 [expr {$xc - $x0}]
3125                 }
3126             }
3127             # avoid lines jigging left then immediately right
3128             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3129                 insert_pad $y0 $x0 1
3130                 incr x0
3131                 optimize_rows $y0 $x0 $row
3132                 set previdlist [lindex $rowidlist $y0]
3133                 set pprevidlist [lindex $rowidlist $ym]
3134             }
3135         }
3136         if {!$haspad} {
3137             # Find the first column that doesn't have a line going right
3138             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3139                 set id [lindex $idlist $col]
3140                 if {$id eq {}} break
3141                 set x0 [lsearch -exact $previdlist $id]
3142                 if {$x0 < 0} {
3143                     # check if this is the link to the first child
3144                     set ranges [rowranges $id]
3145                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
3146                         # it is, work out offset to child
3147                         set id [lindex $displayorder $y0]
3148                         set x0 [lsearch -exact $previdlist $id]
3149                     }
3150                 }
3151                 if {$x0 <= $col} break
3152             }
3153             # Insert a pad at that column as long as it has a line and
3154             # isn't the last column
3155             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3156                 set idlist [linsert $idlist $col {}]
3157             }
3158         }
3159         lset rowidlist $row $idlist
3160         set col 0
3161     }
3162 }
3163
3164 proc xc {row col} {
3165     global canvx0 linespc
3166     return [expr {$canvx0 + $col * $linespc}]
3167 }
3168
3169 proc yc {row} {
3170     global canvy0 linespc
3171     return [expr {$canvy0 + $row * $linespc}]
3172 }
3173
3174 proc linewidth {id} {
3175     global thickerline lthickness
3176
3177     set wid $lthickness
3178     if {[info exists thickerline] && $id eq $thickerline} {
3179         set wid [expr {2 * $lthickness}]
3180     }
3181     return $wid
3182 }
3183
3184 proc rowranges {id} {
3185     global phase idrowranges commitrow rowlaidout rowrangelist curview
3186
3187     set ranges {}
3188     if {$phase eq {} ||
3189         ([info exists commitrow($curview,$id)]
3190          && $commitrow($curview,$id) < $rowlaidout)} {
3191         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3192     } elseif {[info exists idrowranges($id)]} {
3193         set ranges $idrowranges($id)
3194     }
3195     set linenos {}
3196     foreach rid $ranges {
3197         lappend linenos $commitrow($curview,$rid)
3198     }
3199     if {$linenos ne {}} {
3200         lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3201     }
3202     return $linenos
3203 }
3204
3205 proc drawlineseg {id row endrow arrowlow} {
3206     global rowidlist displayorder iddrawn linesegs
3207     global canv colormap linespc curview maxlinelen parentlist
3208
3209     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3210     set le [expr {$row + 1}]
3211     set arrowhigh 1
3212     while {1} {
3213         set c [lsearch -exact [lindex $rowidlist $le] $id]
3214         if {$c < 0} {
3215             incr le -1
3216             break
3217         }
3218         lappend cols $c
3219         set x [lindex $displayorder $le]
3220         if {$x eq $id} {
3221             set arrowhigh 0
3222             break
3223         }
3224         if {[info exists iddrawn($x)] || $le == $endrow} {
3225             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3226             if {$c >= 0} {
3227                 lappend cols $c
3228                 set arrowhigh 0
3229             }
3230             break
3231         }
3232         incr le
3233     }
3234     if {$le <= $row} {
3235         return $row
3236     }
3237
3238     set lines {}
3239     set i 0
3240     set joinhigh 0
3241     if {[info exists linesegs($id)]} {
3242         set lines $linesegs($id)
3243         foreach li $lines {
3244             set r0 [lindex $li 0]
3245             if {$r0 > $row} {
3246                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3247                     set joinhigh 1
3248                 }
3249                 break
3250             }
3251             incr i
3252         }
3253     }
3254     set joinlow 0
3255     if {$i > 0} {
3256         set li [lindex $lines [expr {$i-1}]]
3257         set r1 [lindex $li 1]
3258         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3259             set joinlow 1
3260         }
3261     }
3262
3263     set x [lindex $cols [expr {$le - $row}]]
3264     set xp [lindex $cols [expr {$le - 1 - $row}]]
3265     set dir [expr {$xp - $x}]
3266     if {$joinhigh} {
3267         set ith [lindex $lines $i 2]
3268         set coords [$canv coords $ith]
3269         set ah [$canv itemcget $ith -arrow]
3270         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3271         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3272         if {$x2 ne {} && $x - $x2 == $dir} {
3273             set coords [lrange $coords 0 end-2]
3274         }
3275     } else {
3276         set coords [list [xc $le $x] [yc $le]]
3277     }
3278     if {$joinlow} {
3279         set itl [lindex $lines [expr {$i-1}] 2]
3280         set al [$canv itemcget $itl -arrow]
3281         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3282     } elseif {$arrowlow} {
3283         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3284             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3285             set arrowlow 0
3286         }
3287     }
3288     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3289     for {set y $le} {[incr y -1] > $row} {} {
3290         set x $xp
3291         set xp [lindex $cols [expr {$y - 1 - $row}]]
3292         set ndir [expr {$xp - $x}]
3293         if {$dir != $ndir || $xp < 0} {
3294             lappend coords [xc $y $x] [yc $y]
3295         }
3296         set dir $ndir
3297     }
3298     if {!$joinlow} {
3299         if {$xp < 0} {
3300             # join parent line to first child
3301             set ch [lindex $displayorder $row]
3302             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3303             if {$xc < 0} {
3304                 puts "oops: drawlineseg: child $ch not on row $row"
3305             } elseif {$xc != $x} {
3306                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3307                     set d [expr {int(0.5 * $linespc)}]
3308                     set x1 [xc $row $x]
3309                     if {$xc < $x} {
3310                         set x2 [expr {$x1 - $d}]
3311                     } else {
3312                         set x2 [expr {$x1 + $d}]
3313                     }
3314                     set y2 [yc $row]
3315                     set y1 [expr {$y2 + $d}]
3316                     lappend coords $x1 $y1 $x2 $y2
3317                 } elseif {$xc < $x - 1} {
3318                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3319                 } elseif {$xc > $x + 1} {
3320                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3321                 }
3322                 set x $xc
3323             }
3324             lappend coords [xc $row $x] [yc $row]
3325         } else {
3326             set xn [xc $row $xp]
3327             set yn [yc $row]
3328             lappend coords $xn $yn
3329         }
3330         if {!$joinhigh} {
3331             assigncolor $id
3332             set t [$canv create line $coords -width [linewidth $id] \
3333                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3334             $canv lower $t
3335             bindline $t $id
3336             set lines [linsert $lines $i [list $row $le $t]]
3337         } else {
3338             $canv coords $ith $coords
3339             if {$arrow ne $ah} {
3340                 $canv itemconf $ith -arrow $arrow
3341             }
3342             lset lines $i 0 $row
3343         }
3344     } else {
3345         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3346         set ndir [expr {$xo - $xp}]
3347         set clow [$canv coords $itl]
3348         if {$dir == $ndir} {
3349             set clow [lrange $clow 2 end]
3350         }
3351         set coords [concat $coords $clow]
3352         if {!$joinhigh} {
3353             lset lines [expr {$i-1}] 1 $le
3354         } else {
3355             # coalesce two pieces
3356             $canv delete $ith
3357             set b [lindex $lines [expr {$i-1}] 0]
3358             set e [lindex $lines $i 1]
3359             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3360         }
3361         $canv coords $itl $coords
3362         if {$arrow ne $al} {
3363             $canv itemconf $itl -arrow $arrow
3364         }
3365     }
3366
3367     set linesegs($id) $lines
3368     return $le
3369 }
3370
3371 proc drawparentlinks {id row} {
3372     global rowidlist canv colormap curview parentlist
3373     global idpos linespc
3374
3375     set rowids [lindex $rowidlist $row]
3376     set col [lsearch -exact $rowids $id]
3377     if {$col < 0} return
3378     set olds [lindex $parentlist $row]
3379     set row2 [expr {$row + 1}]
3380     set x [xc $row $col]
3381     set y [yc $row]
3382     set y2 [yc $row2]
3383     set d [expr {int(0.5 * $linespc)}]
3384     set ymid [expr {$y + $d}]
3385     set ids [lindex $rowidlist $row2]
3386     # rmx = right-most X coord used
3387     set rmx 0
3388     foreach p $olds {
3389         set i [lsearch -exact $ids $p]
3390         if {$i < 0} {
3391             puts "oops, parent $p of $id not in list"
3392             continue
3393         }
3394         set x2 [xc $row2 $i]
3395         if {$x2 > $rmx} {
3396             set rmx $x2
3397         }
3398         set j [lsearch -exact $rowids $p]
3399         if {$j < 0} {
3400             # drawlineseg will do this one for us
3401             continue
3402         }
3403         assigncolor $p
3404         # should handle duplicated parents here...
3405         set coords [list $x $y]
3406         if {$i != $col} {
3407             # if attaching to a vertical segment, draw a smaller
3408             # slant for visual distinctness
3409             if {$i == $j} {
3410                 if {$i < $col} {
3411                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3412                 } else {
3413                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3414                 }
3415             } elseif {$i < $col && $i < $j} {
3416                 # segment slants towards us already
3417                 lappend coords [xc $row $j] $y
3418             } else {
3419                 if {$i < $col - 1} {
3420                     lappend coords [expr {$x2 + $linespc}] $y
3421                 } elseif {$i > $col + 1} {
3422                     lappend coords [expr {$x2 - $linespc}] $y
3423                 }
3424                 lappend coords $x2 $y2
3425             }
3426         } else {
3427             lappend coords $x2 $y2
3428         }
3429         set t [$canv create line $coords -width [linewidth $p] \
3430                    -fill $colormap($p) -tags lines.$p]
3431         $canv lower $t
3432         bindline $t $p
3433     }
3434     if {$rmx > [lindex $idpos($id) 1]} {
3435         lset idpos($id) 1 $rmx
3436         redrawtags $id
3437     }
3438 }
3439
3440 proc drawlines {id} {
3441     global canv
3442
3443     $canv itemconf lines.$id -width [linewidth $id]
3444 }
3445
3446 proc drawcmittext {id row col} {
3447     global linespc canv canv2 canv3 canvy0 fgcolor curview
3448     global commitlisted commitinfo rowidlist parentlist
3449     global rowtextx idpos idtags idheads idotherrefs
3450     global linehtag linentag linedtag
3451     global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3452
3453     # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3454     set listed [lindex $commitlisted $row]
3455     if {$id eq $nullid} {
3456         set ofill red
3457     } elseif {$id eq $nullid2} {
3458         set ofill green
3459     } else {
3460         set ofill [expr {$listed != 0? "blue": "white"}]
3461     }
3462     set x [xc $row $col]
3463     set y [yc $row]
3464     set orad [expr {$linespc / 3}]
3465     if {$listed <= 1} {
3466         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3467                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3468                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3469     } elseif {$listed == 2} {
3470         # triangle pointing left for left-side commits
3471         set t [$canv create polygon \
3472                    [expr {$x - $orad}] $y \
3473                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3474                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3475                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3476     } else {
3477         # triangle pointing right for right-side commits
3478         set t [$canv create polygon \
3479                    [expr {$x + $orad - 1}] $y \
3480                    [expr {$x - $orad}] [expr {$y - $orad}] \
3481                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3482                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3483     }
3484     $canv raise $t
3485     $canv bind $t <1> {selcanvline {} %x %y}
3486     set rmx [llength [lindex $rowidlist $row]]
3487     set olds [lindex $parentlist $row]
3488     if {$olds ne {}} {
3489         set nextids [lindex $rowidlist [expr {$row + 1}]]
3490         foreach p $olds {
3491             set i [lsearch -exact $nextids $p]
3492             if {$i > $rmx} {
3493                 set rmx $i
3494             }
3495         }
3496     }
3497     set xt [xc $row $rmx]
3498     set rowtextx($row) $xt
3499     set idpos($id) [list $x $xt $y]
3500     if {[info exists idtags($id)] || [info exists idheads($id)]
3501         || [info exists idotherrefs($id)]} {
3502         set xt [drawtags $id $x $xt $y]
3503     }
3504     set headline [lindex $commitinfo($id) 0]
3505     set name [lindex $commitinfo($id) 1]
3506     set date [lindex $commitinfo($id) 2]
3507     set date [formatdate $date]
3508     set font $mainfont
3509     set nfont $mainfont
3510     set isbold [ishighlighted $row]
3511     if {$isbold > 0} {
3512         lappend boldrows $row
3513         lappend font bold
3514         if {$isbold > 1} {
3515             lappend boldnamerows $row
3516             lappend nfont bold
3517         }
3518     }
3519     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3520                             -text $headline -font $font -tags text]
3521     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3522     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3523                             -text $name -font $nfont -tags text]
3524     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3525                             -text $date -font $mainfont -tags text]
3526     set xr [expr {$xt + [font measure $mainfont $headline]}]
3527     if {$xr > $canvxmax} {
3528         set canvxmax $xr
3529         setcanvscroll
3530     }
3531 }
3532
3533 proc drawcmitrow {row} {
3534     global displayorder rowidlist
3535     global iddrawn markingmatches
3536     global commitinfo parentlist numcommits
3537     global filehighlight fhighlights findstring nhighlights
3538     global hlview vhighlights
3539     global highlight_related rhighlights
3540
3541     if {$row >= $numcommits} return
3542
3543     set id [lindex $displayorder $row]
3544     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3545         askvhighlight $row $id
3546     }
3547     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3548         askfilehighlight $row $id
3549     }
3550     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3551         askfindhighlight $row $id
3552     }
3553     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3554         askrelhighlight $row $id
3555     }
3556     if {![info exists iddrawn($id)]} {
3557         set col [lsearch -exact [lindex $rowidlist $row] $id]
3558         if {$col < 0} {
3559             puts "oops, row $row id $id not in list"
3560             return
3561         }
3562         if {![info exists commitinfo($id)]} {
3563             getcommit $id
3564         }
3565         assigncolor $id
3566         drawcmittext $id $row $col
3567         set iddrawn($id) 1
3568     }
3569     if {$markingmatches} {
3570         markrowmatches $row $id
3571     }
3572 }
3573
3574 proc drawcommits {row {endrow {}}} {
3575     global numcommits iddrawn displayorder curview
3576     global parentlist rowidlist
3577
3578     if {$row < 0} {
3579         set row 0
3580     }
3581     if {$endrow eq {}} {
3582         set endrow $row
3583     }
3584     if {$endrow >= $numcommits} {
3585         set endrow [expr {$numcommits - 1}]
3586     }
3587
3588     # make the lines join to already-drawn rows either side
3589     set r [expr {$row - 1}]
3590     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3591         set r $row
3592     }
3593     set er [expr {$endrow + 1}]
3594     if {$er >= $numcommits ||
3595         ![info exists iddrawn([lindex $displayorder $er])]} {
3596         set er $endrow
3597     }
3598     for {} {$r <= $er} {incr r} {
3599         set id [lindex $displayorder $r]
3600         set wasdrawn [info exists iddrawn($id)]
3601         drawcmitrow $r
3602         if {$r == $er} break
3603         set nextid [lindex $displayorder [expr {$r + 1}]]
3604         if {$wasdrawn && [info exists iddrawn($nextid)]} {
3605             catch {unset prevlines}
3606             continue
3607         }
3608         drawparentlinks $id $r
3609
3610         if {[info exists lineends($r)]} {
3611             foreach lid $lineends($r) {
3612                 unset prevlines($lid)
3613             }
3614         }
3615         set rowids [lindex $rowidlist $r]
3616         foreach lid $rowids {
3617             if {$lid eq {}} continue
3618             if {$lid eq $id} {
3619                 # see if this is the first child of any of its parents
3620                 foreach p [lindex $parentlist $r] {
3621                     if {[lsearch -exact $rowids $p] < 0} {
3622                         # make this line extend up to the child
3623                         set le [drawlineseg $p $r $er 0]
3624                         lappend lineends($le) $p
3625                         set prevlines($p) 1
3626                     }
3627                 }
3628             } elseif {![info exists prevlines($lid)]} {
3629                 set le [drawlineseg $lid $r $er 1]
3630                 lappend lineends($le) $lid
3631                 set prevlines($lid) 1
3632             }
3633         }
3634     }
3635 }
3636
3637 proc drawfrac {f0 f1} {
3638     global canv linespc
3639
3640     set ymax [lindex [$canv cget -scrollregion] 3]
3641     if {$ymax eq {} || $ymax == 0} return
3642     set y0 [expr {int($f0 * $ymax)}]
3643     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3644     set y1 [expr {int($f1 * $ymax)}]
3645     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3646     drawcommits $row $endrow
3647 }
3648
3649 proc drawvisible {} {
3650     global canv
3651     eval drawfrac [$canv yview]
3652 }
3653
3654 proc clear_display {} {
3655     global iddrawn linesegs
3656     global vhighlights fhighlights nhighlights rhighlights
3657
3658     allcanvs delete all
3659     catch {unset iddrawn}
3660     catch {unset linesegs}
3661     catch {unset vhighlights}
3662     catch {unset fhighlights}
3663     catch {unset nhighlights}
3664     catch {unset rhighlights}
3665 }
3666
3667 proc findcrossings {id} {
3668     global rowidlist parentlist numcommits displayorder
3669
3670     set cross {}
3671     set ccross {}
3672     foreach {s e} [rowranges $id] {
3673         if {$e >= $numcommits} {
3674             set e [expr {$numcommits - 1}]
3675         }
3676         if {$e <= $s} continue
3677         for {set row $e} {[incr row -1] >= $s} {} {
3678             set x [lsearch -exact [lindex $rowidlist $row] $id]
3679             if {$x < 0} break
3680             set olds [lindex $parentlist $row]
3681             set kid [lindex $displayorder $row]
3682             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3683             if {$kidx < 0} continue
3684             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3685             foreach p $olds {
3686                 set px [lsearch -exact $nextrow $p]
3687                 if {$px < 0} continue
3688                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3689                     if {[lsearch -exact $ccross $p] >= 0} continue
3690                     if {$x == $px + ($kidx < $px? -1: 1)} {
3691                         lappend ccross $p
3692                     } elseif {[lsearch -exact $cross $p] < 0} {
3693                         lappend cross $p
3694                     }
3695                 }
3696             }
3697         }
3698     }
3699     return [concat $ccross {{}} $cross]
3700 }
3701
3702 proc assigncolor {id} {
3703     global colormap colors nextcolor
3704     global commitrow parentlist children children curview
3705
3706     if {[info exists colormap($id)]} return
3707     set ncolors [llength $colors]
3708     if {[info exists children($curview,$id)]} {
3709         set kids $children($curview,$id)
3710     } else {
3711         set kids {}
3712     }
3713     if {[llength $kids] == 1} {
3714         set child [lindex $kids 0]
3715         if {[info exists colormap($child)]
3716             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3717             set colormap($id) $colormap($child)
3718             return
3719         }
3720     }
3721     set badcolors {}
3722     set origbad {}
3723     foreach x [findcrossings $id] {
3724         if {$x eq {}} {
3725             # delimiter between corner crossings and other crossings
3726             if {[llength $badcolors] >= $ncolors - 1} break
3727             set origbad $badcolors
3728         }
3729         if {[info exists colormap($x)]
3730             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3731             lappend badcolors $colormap($x)
3732         }
3733     }
3734     if {[llength $badcolors] >= $ncolors} {
3735         set badcolors $origbad
3736     }
3737     set origbad $badcolors
3738     if {[llength $badcolors] < $ncolors - 1} {
3739         foreach child $kids {
3740             if {[info exists colormap($child)]
3741                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3742                 lappend badcolors $colormap($child)
3743             }
3744             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3745                 if {[info exists colormap($p)]
3746                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3747                     lappend badcolors $colormap($p)
3748                 }
3749             }
3750         }
3751         if {[llength $badcolors] >= $ncolors} {
3752             set badcolors $origbad
3753         }
3754     }
3755     for {set i 0} {$i <= $ncolors} {incr i} {
3756         set c [lindex $colors $nextcolor]
3757         if {[incr nextcolor] >= $ncolors} {
3758             set nextcolor 0
3759         }
3760         if {[lsearch -exact $badcolors $c]} break
3761     }
3762     set colormap($id) $c
3763 }
3764
3765 proc bindline {t id} {
3766     global canv
3767
3768     $canv bind $t <Enter> "lineenter %x %y $id"
3769     $canv bind $t <Motion> "linemotion %x %y $id"
3770     $canv bind $t <Leave> "lineleave $id"
3771     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3772 }
3773
3774 proc drawtags {id x xt y1} {
3775     global idtags idheads idotherrefs mainhead
3776     global linespc lthickness
3777     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3778
3779     set marks {}
3780     set ntags 0
3781     set nheads 0
3782     if {[info exists idtags($id)]} {
3783         set marks $idtags($id)
3784         set ntags [llength $marks]
3785     }
3786     if {[info exists idheads($id)]} {
3787         set marks [concat $marks $idheads($id)]
3788         set nheads [llength $idheads($id)]
3789     }
3790     if {[info exists idotherrefs($id)]} {
3791         set marks [concat $marks $idotherrefs($id)]
3792     }
3793     if {$marks eq {}} {
3794         return $xt
3795     }
3796
3797     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3798     set yt [expr {$y1 - 0.5 * $linespc}]
3799     set yb [expr {$yt + $linespc - 1}]
3800     set xvals {}
3801     set wvals {}
3802     set i -1
3803     foreach tag $marks {
3804         incr i
3805         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3806             set wid [font measure [concat $mainfont bold] $tag]
3807         } else {
3808             set wid [font measure $mainfont $tag]
3809         }
3810         lappend xvals $xt
3811         lappend wvals $wid
3812         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3813     }
3814     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3815                -width $lthickness -fill black -tags tag.$id]
3816     $canv lower $t
3817     foreach tag $marks x $xvals wid $wvals {
3818         set xl [expr {$x + $delta}]
3819         set xr [expr {$x + $delta + $wid + $lthickness}]
3820         set font $mainfont
3821         if {[incr ntags -1] >= 0} {
3822             # draw a tag
3823             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3824                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3825                        -width 1 -outline black -fill yellow -tags tag.$id]
3826             $canv bind $t <1> [list showtag $tag 1]
3827             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3828         } else {
3829             # draw a head or other ref
3830             if {[incr nheads -1] >= 0} {
3831                 set col green
3832                 if {$tag eq $mainhead} {
3833                     lappend font bold
3834                 }
3835             } else {
3836                 set col "#ddddff"
3837             }
3838             set xl [expr {$xl - $delta/2}]
3839             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3840                 -width 1 -outline black -fill $col -tags tag.$id
3841             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3842                 set rwid [font measure $mainfont $remoteprefix]
3843                 set xi [expr {$x + 1}]
3844                 set yti [expr {$yt + 1}]
3845                 set xri [expr {$x + $rwid}]
3846                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3847                         -width 0 -fill "#ffddaa" -tags tag.$id
3848             }
3849         }
3850         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3851                    -font $font -tags [list tag.$id text]]
3852         if {$ntags >= 0} {
3853             $canv bind $t <1> [list showtag $tag 1]
3854         } elseif {$nheads >= 0} {
3855             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3856         }
3857     }
3858     return $xt
3859 }
3860
3861 proc xcoord {i level ln} {
3862     global canvx0 xspc1 xspc2
3863
3864     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3865     if {$i > 0 && $i == $level} {
3866         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3867     } elseif {$i > $level} {
3868         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3869     }
3870     return $x
3871 }
3872
3873 proc show_status {msg} {
3874     global canv mainfont fgcolor
3875
3876     clear_display
3877     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3878         -tags text -fill $fgcolor
3879 }
3880
3881 # Insert a new commit as the child of the commit on row $row.
3882 # The new commit will be displayed on row $row and the commits
3883 # on that row and below will move down one row.
3884 proc insertrow {row newcmit} {
3885     global displayorder parentlist commitlisted children
3886     global commitrow curview rowidlist numcommits
3887     global rowrangelist rowlaidout rowoptim numcommits
3888     global selectedline rowchk commitidx
3889
3890     if {$row >= $numcommits} {
3891         puts "oops, inserting new row $row but only have $numcommits rows"
3892         return
3893     }
3894     set p [lindex $displayorder $row]
3895     set displayorder [linsert $displayorder $row $newcmit]
3896     set parentlist [linsert $parentlist $row $p]
3897     set kids $children($curview,$p)
3898     lappend kids $newcmit
3899     set children($curview,$p) $kids
3900     set children($curview,$newcmit) {}
3901     set commitlisted [linsert $commitlisted $row 1]
3902     set l [llength $displayorder]
3903     for {set r $row} {$r < $l} {incr r} {
3904         set id [lindex $displayorder $r]
3905         set commitrow($curview,$id) $r
3906     }
3907     incr commitidx($curview)
3908
3909     set idlist [lindex $rowidlist $row]
3910     if {[llength $kids] == 1} {
3911         set col [lsearch -exact $idlist $p]
3912         lset idlist $col $newcmit
3913     } else {
3914         set col [llength $idlist]
3915         lappend idlist $newcmit
3916     }
3917     set rowidlist [linsert $rowidlist $row $idlist]
3918
3919     set rowrangelist [linsert $rowrangelist $row {}]
3920     if {[llength $kids] > 1} {
3921         set rp1 [expr {$row + 1}]
3922         set ranges [lindex $rowrangelist $rp1]
3923         if {$ranges eq {}} {
3924             set ranges [list $newcmit $p]
3925         } elseif {[lindex $ranges end-1] eq $p} {
3926             lset ranges end-1 $newcmit
3927         }
3928         lset rowrangelist $rp1 $ranges
3929     }
3930
3931     catch {unset rowchk}
3932
3933     incr rowlaidout
3934     incr rowoptim
3935     incr numcommits
3936
3937     if {[info exists selectedline] && $selectedline >= $row} {
3938         incr selectedline
3939     }
3940     redisplay
3941 }
3942
3943 # Remove a commit that was inserted with insertrow on row $row.
3944 proc removerow {row} {
3945     global displayorder parentlist commitlisted children
3946     global commitrow curview rowidlist numcommits
3947     global rowrangelist idrowranges rowlaidout rowoptim numcommits
3948     global linesegends selectedline rowchk commitidx
3949
3950     if {$row >= $numcommits} {
3951         puts "oops, removing row $row but only have $numcommits rows"
3952         return
3953     }
3954     set rp1 [expr {$row + 1}]
3955     set id [lindex $displayorder $row]
3956     set p [lindex $parentlist $row]
3957     set displayorder [lreplace $displayorder $row $row]
3958     set parentlist [lreplace $parentlist $row $row]
3959     set commitlisted [lreplace $commitlisted $row $row]
3960     set kids $children($curview,$p)
3961     set i [lsearch -exact $kids $id]
3962     if {$i >= 0} {
3963         set kids [lreplace $kids $i $i]
3964         set children($curview,$p) $kids
3965     }
3966     set l [llength $displayorder]
3967     for {set r $row} {$r < $l} {incr r} {
3968         set id [lindex $displayorder $r]
3969         set commitrow($curview,$id) $r
3970     }
3971     incr commitidx($curview) -1
3972
3973     set rowidlist [lreplace $rowidlist $row $row]
3974
3975     set rowrangelist [lreplace $rowrangelist $row $row]
3976     if {[llength $kids] > 0} {
3977         set ranges [lindex $rowrangelist $row]
3978         if {[lindex $ranges end-1] eq $id} {
3979             set ranges [lreplace $ranges end-1 end]
3980             lset rowrangelist $row $ranges
3981         }
3982     }
3983
3984     catch {unset rowchk}
3985
3986     incr rowlaidout -1
3987     incr rowoptim -1
3988     incr numcommits -1
3989
3990     if {[info exists selectedline] && $selectedline > $row} {
3991         incr selectedline -1
3992     }
3993     redisplay
3994 }
3995
3996 # Don't change the text pane cursor if it is currently the hand cursor,
3997 # showing that we are over a sha1 ID link.
3998 proc settextcursor {c} {
3999     global ctext curtextcursor
4000
4001     if {[$ctext cget -cursor] == $curtextcursor} {
4002         $ctext config -cursor $c
4003     }
4004     set curtextcursor $c
4005 }
4006
4007 proc nowbusy {what} {
4008     global isbusy
4009
4010     if {[array names isbusy] eq {}} {
4011         . config -cursor watch
4012         settextcursor watch
4013     }
4014     set isbusy($what) 1
4015 }
4016
4017 proc notbusy {what} {
4018     global isbusy maincursor textcursor
4019
4020     catch {unset isbusy($what)}
4021     if {[array names isbusy] eq {}} {
4022         . config -cursor $maincursor
4023         settextcursor $textcursor
4024     }
4025 }
4026
4027 proc findmatches {f} {
4028     global findtype findstring
4029     if {$findtype == "Regexp"} {
4030         set matches [regexp -indices -all -inline $findstring $f]
4031     } else {
4032         set fs $findstring
4033         if {$findtype == "IgnCase"} {
4034             set f [string tolower $f]
4035             set fs [string tolower $fs]
4036         }
4037         set matches {}
4038         set i 0
4039         set l [string length $fs]
4040         while {[set j [string first $fs $f $i]] >= 0} {
4041             lappend matches [list $j [expr {$j+$l-1}]]
4042             set i [expr {$j + $l}]
4043         }
4044     }
4045     return $matches
4046 }
4047
4048 proc dofind {{rev 0}} {
4049     global findstring findstartline findcurline selectedline numcommits
4050
4051     unmarkmatches
4052     cancel_next_highlight
4053     focus .
4054     if {$findstring eq {} || $numcommits == 0} return
4055     if {![info exists selectedline]} {
4056         set findstartline [lindex [visiblerows] $rev]
4057     } else {
4058         set findstartline $selectedline
4059     }
4060     set findcurline $findstartline
4061     nowbusy finding
4062     if {!$rev} {
4063         run findmore
4064     } else {
4065         if {$findcurline == 0} {
4066             set findcurline $numcommits
4067         }
4068         incr findcurline -1
4069         run findmorerev
4070     }
4071 }
4072
4073 proc findnext {restart} {
4074     global findcurline
4075     if {![info exists findcurline]} {
4076         if {$restart} {
4077             dofind
4078         } else {
4079             bell
4080         }
4081     } else {
4082         run findmore
4083         nowbusy finding
4084     }
4085 }
4086
4087 proc findprev {} {
4088     global findcurline
4089     if {![info exists findcurline]} {
4090         dofind 1
4091     } else {
4092         run findmorerev
4093         nowbusy finding
4094     }
4095 }
4096
4097 proc findmore {} {
4098     global commitdata commitinfo numcommits findstring findpattern findloc
4099     global findstartline findcurline displayorder
4100
4101     set fldtypes {Headline Author Date Committer CDate Comments}
4102     set l [expr {$findcurline + 1}]
4103     if {$l >= $numcommits} {
4104         set l 0
4105     }
4106     if {$l <= $findstartline} {
4107         set lim [expr {$findstartline + 1}]
4108     } else {
4109         set lim $numcommits
4110     }
4111     if {$lim - $l > 500} {
4112         set lim [expr {$l + 500}]
4113     }
4114     set last 0
4115     for {} {$l < $lim} {incr l} {
4116         set id [lindex $displayorder $l]
4117         # shouldn't happen unless git log doesn't give all the commits...
4118         if {![info exists commitdata($id)]} continue
4119         if {![doesmatch $commitdata($id)]} continue
4120         if {![info exists commitinfo($id)]} {
4121             getcommit $id
4122         }
4123         set info $commitinfo($id)
4124         foreach f $info ty $fldtypes {
4125             if {($findloc eq "All fields" || $findloc eq $ty) &&
4126                 [doesmatch $f]} {
4127                 findselectline $l
4128                 notbusy finding
4129                 return 0
4130             }
4131         }
4132     }
4133     if {$l == $findstartline + 1} {
4134         bell
4135         unset findcurline
4136         notbusy finding
4137         return 0
4138     }
4139     set findcurline [expr {$l - 1}]
4140     return 1
4141 }
4142
4143 proc findmorerev {} {
4144     global commitdata commitinfo numcommits findstring findpattern findloc
4145     global findstartline findcurline displayorder
4146
4147     set fldtypes {Headline Author Date Committer CDate Comments}
4148     set l $findcurline
4149     if {$l == 0} {
4150         set l $numcommits
4151     }
4152     incr l -1
4153     if {$l >= $findstartline} {
4154         set lim [expr {$findstartline - 1}]
4155     } else {
4156         set lim -1
4157     }
4158     if {$l - $lim > 500} {
4159         set lim [expr {$l - 500}]
4160     }
4161     set last 0
4162     for {} {$l > $lim} {incr l -1} {
4163         set id [lindex $displayorder $l]
4164         if {![doesmatch $commitdata($id)]} continue
4165         if {![info exists commitinfo($id)]} {
4166             getcommit $id
4167         }
4168         set info $commitinfo($id)
4169         foreach f $info ty $fldtypes {
4170             if {($findloc eq "All fields" || $findloc eq $ty) &&
4171                 [doesmatch $f]} {
4172                 findselectline $l
4173                 notbusy finding
4174                 return 0
4175             }
4176         }
4177     }
4178     if {$l == -1} {
4179         bell
4180         unset findcurline
4181         notbusy finding
4182         return 0
4183     }
4184     set findcurline [expr {$l + 1}]
4185     return 1
4186 }
4187
4188 proc findselectline {l} {
4189     global findloc commentend ctext findcurline markingmatches
4190
4191     set markingmatches 1
4192     set findcurline $l
4193     selectline $l 1
4194     if {$findloc == "All fields" || $findloc == "Comments"} {
4195         # highlight the matches in the comments
4196         set f [$ctext get 1.0 $commentend]
4197         set matches [findmatches $f]
4198         foreach match $matches {
4199             set start [lindex $match 0]
4200             set end [expr {[lindex $match 1] + 1}]
4201             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4202         }
4203     }
4204     drawvisible
4205 }
4206
4207 # mark the bits of a headline or author that match a find string
4208 proc markmatches {canv l str tag matches font row} {
4209     global selectedline
4210
4211     set bbox [$canv bbox $tag]
4212     set x0 [lindex $bbox 0]
4213     set y0 [lindex $bbox 1]
4214     set y1 [lindex $bbox 3]
4215     foreach match $matches {
4216         set start [lindex $match 0]
4217         set end [lindex $match 1]
4218         if {$start > $end} continue
4219         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4220         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4221         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4222                    [expr {$x0+$xlen+2}] $y1 \
4223                    -outline {} -tags [list match$l matches] -fill yellow]
4224         $canv lower $t
4225         if {[info exists selectedline] && $row == $selectedline} {
4226             $canv raise $t secsel
4227         }
4228     }
4229 }
4230
4231 proc unmarkmatches {} {
4232     global findids markingmatches findcurline
4233
4234     allcanvs delete matches
4235     catch {unset findids}
4236     set markingmatches 0
4237     catch {unset findcurline}
4238 }
4239
4240 proc selcanvline {w x y} {
4241     global canv canvy0 ctext linespc
4242     global rowtextx
4243     set ymax [lindex [$canv cget -scrollregion] 3]
4244     if {$ymax == {}} return
4245     set yfrac [lindex [$canv yview] 0]
4246     set y [expr {$y + $yfrac * $ymax}]
4247     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4248     if {$l < 0} {
4249         set l 0
4250     }
4251     if {$w eq $canv} {
4252         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4253     }
4254     unmarkmatches
4255     selectline $l 1
4256 }
4257
4258 proc commit_descriptor {p} {
4259     global commitinfo
4260     if {![info exists commitinfo($p)]} {
4261         getcommit $p
4262     }
4263     set l "..."
4264     if {[llength $commitinfo($p)] > 1} {
4265         set l [lindex $commitinfo($p) 0]
4266     }
4267     return "$p ($l)\n"
4268 }
4269
4270 # append some text to the ctext widget, and make any SHA1 ID
4271 # that we know about be a clickable link.
4272 proc appendwithlinks {text tags} {
4273     global ctext commitrow linknum curview
4274
4275     set start [$ctext index "end - 1c"]
4276     $ctext insert end $text $tags
4277     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4278     foreach l $links {
4279         set s [lindex $l 0]
4280         set e [lindex $l 1]
4281         set linkid [string range $text $s $e]
4282         if {![info exists commitrow($curview,$linkid)]} continue
4283         incr e
4284         $ctext tag add link "$start + $s c" "$start + $e c"
4285         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4286         $ctext tag bind link$linknum <1> \
4287             [list selectline $commitrow($curview,$linkid) 1]
4288         incr linknum
4289     }
4290     $ctext tag conf link -foreground blue -underline 1
4291     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4292     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4293 }
4294
4295 proc viewnextline {dir} {
4296     global canv linespc
4297
4298     $canv delete hover
4299     set ymax [lindex [$canv cget -scrollregion] 3]
4300     set wnow [$canv yview]
4301     set wtop [expr {[lindex $wnow 0] * $ymax}]
4302     set newtop [expr {$wtop + $dir * $linespc}]
4303     if {$newtop < 0} {
4304         set newtop 0
4305     } elseif {$newtop > $ymax} {
4306         set newtop $ymax
4307     }
4308     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4309 }
4310
4311 # add a list of tag or branch names at position pos
4312 # returns the number of names inserted
4313 proc appendrefs {pos ids var} {
4314     global ctext commitrow linknum curview $var maxrefs
4315
4316     if {[catch {$ctext index $pos}]} {
4317         return 0
4318     }
4319     $ctext conf -state normal
4320     $ctext delete $pos "$pos lineend"
4321     set tags {}
4322     foreach id $ids {
4323         foreach tag [set $var\($id\)] {
4324             lappend tags [list $tag $id]
4325         }
4326     }
4327     if {[llength $tags] > $maxrefs} {
4328         $ctext insert $pos "many ([llength $tags])"
4329     } else {
4330         set tags [lsort -index 0 -decreasing $tags]
4331         set sep {}
4332         foreach ti $tags {
4333             set id [lindex $ti 1]
4334             set lk link$linknum
4335             incr linknum
4336             $ctext tag delete $lk
4337             $ctext insert $pos $sep
4338             $ctext insert $pos [lindex $ti 0] $lk
4339             if {[info exists commitrow($curview,$id)]} {
4340                 $ctext tag conf $lk -foreground blue
4341                 $ctext tag bind $lk <1> \
4342                     [list selectline $commitrow($curview,$id) 1]
4343                 $ctext tag conf $lk -underline 1
4344                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4345                 $ctext tag bind $lk <Leave> \
4346                     { %W configure -cursor $curtextcursor }
4347             }
4348             set sep ", "
4349         }
4350     }
4351     $ctext conf -state disabled
4352     return [llength $tags]
4353 }
4354
4355 # called when we have finished computing the nearby tags
4356 proc dispneartags {delay} {
4357     global selectedline currentid showneartags tagphase
4358
4359     if {![info exists selectedline] || !$showneartags} return
4360     after cancel dispnexttag
4361     if {$delay} {
4362         after 200 dispnexttag
4363         set tagphase -1
4364     } else {
4365         after idle dispnexttag
4366         set tagphase 0
4367     }
4368 }
4369
4370 proc dispnexttag {} {
4371     global selectedline currentid showneartags tagphase ctext
4372
4373     if {![info exists selectedline] || !$showneartags} return
4374     switch -- $tagphase {
4375         0 {
4376             set dtags [desctags $currentid]
4377             if {$dtags ne {}} {
4378                 appendrefs precedes $dtags idtags
4379             }
4380         }
4381         1 {
4382             set atags [anctags $currentid]
4383             if {$atags ne {}} {
4384                 appendrefs follows $atags idtags
4385             }
4386         }
4387         2 {
4388             set dheads [descheads $currentid]
4389             if {$dheads ne {}} {
4390                 if {[appendrefs branch $dheads idheads] > 1
4391                     && [$ctext get "branch -3c"] eq "h"} {
4392                     # turn "Branch" into "Branches"
4393                     $ctext conf -state normal
4394                     $ctext insert "branch -2c" "es"
4395                     $ctext conf -state disabled
4396                 }
4397             }
4398         }
4399     }
4400     if {[incr tagphase] <= 2} {
4401         after idle dispnexttag
4402     }
4403 }
4404
4405 proc selectline {l isnew} {
4406     global canv canv2 canv3 ctext commitinfo selectedline
4407     global displayorder linehtag linentag linedtag
4408     global canvy0 linespc parentlist children curview
4409     global currentid sha1entry
4410     global commentend idtags linknum
4411     global mergemax numcommits pending_select
4412     global cmitmode showneartags allcommits
4413
4414     catch {unset pending_select}
4415     $canv delete hover
4416     normalline
4417     cancel_next_highlight
4418     if {$l < 0 || $l >= $numcommits} return
4419     set y [expr {$canvy0 + $l * $linespc}]
4420     set ymax [lindex [$canv cget -scrollregion] 3]
4421     set ytop [expr {$y - $linespc - 1}]
4422     set ybot [expr {$y + $linespc + 1}]
4423     set wnow [$canv yview]
4424     set wtop [expr {[lindex $wnow 0] * $ymax}]
4425     set wbot [expr {[lindex $wnow 1] * $ymax}]
4426     set wh [expr {$wbot - $wtop}]
4427     set newtop $wtop
4428     if {$ytop < $wtop} {
4429         if {$ybot < $wtop} {
4430             set newtop [expr {$y - $wh / 2.0}]
4431         } else {
4432             set newtop $ytop
4433             if {$newtop > $wtop - $linespc} {
4434                 set newtop [expr {$wtop - $linespc}]
4435             }
4436         }
4437     } elseif {$ybot > $wbot} {
4438         if {$ytop > $wbot} {
4439             set newtop [expr {$y - $wh / 2.0}]
4440         } else {
4441             set newtop [expr {$ybot - $wh}]
4442             if {$newtop < $wtop + $linespc} {
4443                 set newtop [expr {$wtop + $linespc}]
4444             }
4445         }
4446     }
4447     if {$newtop != $wtop} {
4448         if {$newtop < 0} {
4449             set newtop 0
4450         }
4451         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4452         drawvisible
4453     }
4454
4455     if {![info exists linehtag($l)]} return
4456     $canv delete secsel
4457     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4458                -tags secsel -fill [$canv cget -selectbackground]]
4459     $canv lower $t
4460     $canv2 delete secsel
4461     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4462                -tags secsel -fill [$canv2 cget -selectbackground]]
4463     $canv2 lower $t
4464     $canv3 delete secsel
4465     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4466                -tags secsel -fill [$canv3 cget -selectbackground]]
4467     $canv3 lower $t
4468
4469     if {$isnew} {
4470         addtohistory [list selectline $l 0]
4471     }
4472
4473     set selectedline $l
4474
4475     set id [lindex $displayorder $l]
4476     set currentid $id
4477     $sha1entry delete 0 end
4478     $sha1entry insert 0 $id
4479     $sha1entry selection from 0
4480     $sha1entry selection to end
4481     rhighlight_sel $id
4482
4483     $ctext conf -state normal
4484     clear_ctext
4485     set linknum 0
4486     set info $commitinfo($id)
4487     set date [formatdate [lindex $info 2]]
4488     $ctext insert end "Author: [lindex $info 1]  $date\n"
4489     set date [formatdate [lindex $info 4]]
4490     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4491     if {[info exists idtags($id)]} {
4492         $ctext insert end "Tags:"
4493         foreach tag $idtags($id) {
4494             $ctext insert end " $tag"
4495         }
4496         $ctext insert end "\n"
4497     }
4498
4499     set headers {}
4500     set olds [lindex $parentlist $l]
4501     if {[llength $olds] > 1} {
4502         set np 0
4503         foreach p $olds {
4504             if {$np >= $mergemax} {
4505                 set tag mmax
4506             } else {
4507                 set tag m$np
4508             }
4509             $ctext insert end "Parent: " $tag
4510             appendwithlinks [commit_descriptor $p] {}
4511             incr np
4512         }
4513     } else {
4514         foreach p $olds {
4515             append headers "Parent: [commit_descriptor $p]"
4516         }
4517     }
4518
4519     foreach c $children($curview,$id) {
4520         append headers "Child:  [commit_descriptor $c]"
4521     }
4522
4523     # make anything that looks like a SHA1 ID be a clickable link
4524     appendwithlinks $headers {}
4525     if {$showneartags} {
4526         if {![info exists allcommits]} {
4527             getallcommits
4528         }
4529         $ctext insert end "Branch: "
4530         $ctext mark set branch "end -1c"
4531         $ctext mark gravity branch left
4532         $ctext insert end "\nFollows: "
4533         $ctext mark set follows "end -1c"
4534         $ctext mark gravity follows left
4535         $ctext insert end "\nPrecedes: "
4536         $ctext mark set precedes "end -1c"
4537         $ctext mark gravity precedes left
4538         $ctext insert end "\n"
4539         dispneartags 1
4540     }
4541     $ctext insert end "\n"
4542     set comment [lindex $info 5]
4543     if {[string first "\r" $comment] >= 0} {
4544         set comment [string map {"\r" "\n    "} $comment]
4545     }
4546     appendwithlinks $comment {comment}
4547
4548     $ctext tag remove found 1.0 end
4549     $ctext conf -state disabled
4550     set commentend [$ctext index "end - 1c"]
4551
4552     init_flist "Comments"
4553     if {$cmitmode eq "tree"} {
4554         gettree $id
4555     } elseif {[llength $olds] <= 1} {
4556         startdiff $id
4557     } else {
4558         mergediff $id $l
4559     }
4560 }
4561
4562 proc selfirstline {} {
4563     unmarkmatches
4564     selectline 0 1
4565 }
4566
4567 proc sellastline {} {
4568     global numcommits
4569     unmarkmatches
4570     set l [expr {$numcommits - 1}]
4571     selectline $l 1
4572 }
4573
4574 proc selnextline {dir} {
4575     global selectedline
4576     focus .
4577     if {![info exists selectedline]} return
4578     set l [expr {$selectedline + $dir}]
4579     unmarkmatches
4580     selectline $l 1
4581 }
4582
4583 proc selnextpage {dir} {
4584     global canv linespc selectedline numcommits
4585
4586     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4587     if {$lpp < 1} {
4588         set lpp 1
4589     }
4590     allcanvs yview scroll [expr {$dir * $lpp}] units
4591     drawvisible
4592     if {![info exists selectedline]} return
4593     set l [expr {$selectedline + $dir * $lpp}]
4594     if {$l < 0} {
4595         set l 0
4596     } elseif {$l >= $numcommits} {
4597         set l [expr $numcommits - 1]
4598     }
4599     unmarkmatches
4600     selectline $l 1
4601 }
4602
4603 proc unselectline {} {
4604     global selectedline currentid
4605
4606     catch {unset selectedline}
4607     catch {unset currentid}
4608     allcanvs delete secsel
4609     rhighlight_none
4610     cancel_next_highlight
4611 }
4612
4613 proc reselectline {} {
4614     global selectedline
4615
4616     if {[info exists selectedline]} {
4617         selectline $selectedline 0
4618     }
4619 }
4620
4621 proc addtohistory {cmd} {
4622     global history historyindex curview
4623
4624     set elt [list $curview $cmd]
4625     if {$historyindex > 0
4626         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4627         return
4628     }
4629
4630     if {$historyindex < [llength $history]} {
4631         set history [lreplace $history $historyindex end $elt]
4632     } else {
4633         lappend history $elt
4634     }
4635     incr historyindex
4636     if {$historyindex > 1} {
4637         .tf.bar.leftbut conf -state normal
4638     } else {
4639         .tf.bar.leftbut conf -state disabled
4640     }
4641     .tf.bar.rightbut conf -state disabled
4642 }
4643
4644 proc godo {elt} {
4645     global curview
4646
4647     set view [lindex $elt 0]
4648     set cmd [lindex $elt 1]
4649     if {$curview != $view} {
4650         showview $view
4651     }
4652     eval $cmd
4653 }
4654
4655 proc goback {} {
4656     global history historyindex
4657     focus .
4658
4659     if {$historyindex > 1} {
4660         incr historyindex -1
4661         godo [lindex $history [expr {$historyindex - 1}]]
4662         .tf.bar.rightbut conf -state normal
4663     }
4664     if {$historyindex <= 1} {
4665         .tf.bar.leftbut conf -state disabled
4666     }
4667 }
4668
4669 proc goforw {} {
4670     global history historyindex
4671     focus .
4672
4673     if {$historyindex < [llength $history]} {
4674         set cmd [lindex $history $historyindex]
4675         incr historyindex
4676         godo $cmd
4677         .tf.bar.leftbut conf -state normal
4678     }
4679     if {$historyindex >= [llength $history]} {
4680         .tf.bar.rightbut conf -state disabled
4681     }
4682 }
4683
4684 proc gettree {id} {
4685     global treefilelist treeidlist diffids diffmergeid treepending
4686     global nullid nullid2
4687
4688     set diffids $id
4689     catch {unset diffmergeid}
4690     if {![info exists treefilelist($id)]} {
4691         if {![info exists treepending]} {
4692             if {$id eq $nullid} {
4693                 set cmd [list | git ls-files]
4694             } elseif {$id eq $nullid2} {
4695                 set cmd [list | git ls-files --stage -t]
4696             } else {
4697                 set cmd [list | git ls-tree -r $id]
4698             }
4699             if {[catch {set gtf [open $cmd r]}]} {
4700                 return
4701             }
4702             set treepending $id
4703             set treefilelist($id) {}
4704             set treeidlist($id) {}
4705             fconfigure $gtf -blocking 0
4706             filerun $gtf [list gettreeline $gtf $id]
4707         }
4708     } else {
4709         setfilelist $id
4710     }
4711 }
4712
4713 proc gettreeline {gtf id} {
4714     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4715
4716     set nl 0
4717     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4718         if {$diffids eq $nullid} {
4719             set fname $line
4720         } else {
4721             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4722             set i [string first "\t" $line]
4723             if {$i < 0} continue
4724             set sha1 [lindex $line 2]
4725             set fname [string range $line [expr {$i+1}] end]
4726             if {[string index $fname 0] eq "\""} {
4727                 set fname [lindex $fname 0]
4728             }
4729             lappend treeidlist($id) $sha1
4730         }
4731         lappend treefilelist($id) $fname
4732     }
4733     if {![eof $gtf]} {
4734         return [expr {$nl >= 1000? 2: 1}]
4735     }
4736     close $gtf
4737     unset treepending
4738     if {$cmitmode ne "tree"} {
4739         if {![info exists diffmergeid]} {
4740             gettreediffs $diffids
4741         }
4742     } elseif {$id ne $diffids} {
4743         gettree $diffids
4744     } else {
4745         setfilelist $id
4746     }
4747     return 0
4748 }
4749
4750 proc showfile {f} {
4751     global treefilelist treeidlist diffids nullid nullid2
4752     global ctext commentend
4753
4754     set i [lsearch -exact $treefilelist($diffids) $f]
4755     if {$i < 0} {
4756         puts "oops, $f not in list for id $diffids"
4757         return
4758     }
4759     if {$diffids eq $nullid} {
4760         if {[catch {set bf [open $f r]} err]} {
4761             puts "oops, can't read $f: $err"
4762             return
4763         }
4764     } else {
4765         set blob [lindex $treeidlist($diffids) $i]
4766         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4767             puts "oops, error reading blob $blob: $err"
4768             return
4769         }
4770     }
4771     fconfigure $bf -blocking 0
4772     filerun $bf [list getblobline $bf $diffids]
4773     $ctext config -state normal
4774     clear_ctext $commentend
4775     $ctext insert end "\n"
4776     $ctext insert end "$f\n" filesep
4777     $ctext config -state disabled
4778     $ctext yview $commentend
4779 }
4780
4781 proc getblobline {bf id} {
4782     global diffids cmitmode ctext
4783
4784     if {$id ne $diffids || $cmitmode ne "tree"} {
4785         catch {close $bf}
4786         return 0
4787     }
4788     $ctext config -state normal
4789     set nl 0
4790     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4791         $ctext insert end "$line\n"
4792     }
4793     if {[eof $bf]} {
4794         # delete last newline
4795         $ctext delete "end - 2c" "end - 1c"
4796         close $bf
4797         return 0
4798     }
4799     $ctext config -state disabled
4800     return [expr {$nl >= 1000? 2: 1}]
4801 }
4802
4803 proc mergediff {id l} {
4804     global diffmergeid diffopts mdifffd
4805     global diffids
4806     global parentlist
4807
4808     set diffmergeid $id
4809     set diffids $id
4810     # this doesn't seem to actually affect anything...
4811     set env(GIT_DIFF_OPTS) $diffopts
4812     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4813     if {[catch {set mdf [open $cmd r]} err]} {
4814         error_popup "Error getting merge diffs: $err"
4815         return
4816     }
4817     fconfigure $mdf -blocking 0
4818     set mdifffd($id) $mdf
4819     set np [llength [lindex $parentlist $l]]
4820     filerun $mdf [list getmergediffline $mdf $id $np]
4821 }
4822
4823 proc getmergediffline {mdf id np} {
4824     global diffmergeid ctext cflist mergemax
4825     global difffilestart mdifffd
4826
4827     $ctext conf -state normal
4828     set nr 0
4829     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4830         if {![info exists diffmergeid] || $id != $diffmergeid
4831             || $mdf != $mdifffd($id)} {
4832             close $mdf
4833             return 0
4834         }
4835         if {[regexp {^diff --cc (.*)} $line match fname]} {
4836             # start of a new file
4837             $ctext insert end "\n"
4838             set here [$ctext index "end - 1c"]
4839             lappend difffilestart $here
4840             add_flist [list $fname]
4841             set l [expr {(78 - [string length $fname]) / 2}]
4842             set pad [string range "----------------------------------------" 1 $l]
4843             $ctext insert end "$pad $fname $pad\n" filesep
4844         } elseif {[regexp {^@@} $line]} {
4845             $ctext insert end "$line\n" hunksep
4846         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4847             # do nothing
4848         } else {
4849             # parse the prefix - one ' ', '-' or '+' for each parent
4850             set spaces {}
4851             set minuses {}
4852             set pluses {}
4853             set isbad 0
4854             for {set j 0} {$j < $np} {incr j} {
4855                 set c [string range $line $j $j]
4856                 if {$c == " "} {
4857                     lappend spaces $j
4858                 } elseif {$c == "-"} {
4859                     lappend minuses $j
4860                 } elseif {$c == "+"} {
4861                     lappend pluses $j
4862                 } else {
4863                     set isbad 1
4864                     break
4865                 }
4866             }
4867             set tags {}
4868             set num {}
4869             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4870                 # line doesn't appear in result, parents in $minuses have the line
4871                 set num [lindex $minuses 0]
4872             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4873                 # line appears in result, parents in $pluses don't have the line
4874                 lappend tags mresult
4875                 set num [lindex $spaces 0]
4876             }
4877             if {$num ne {}} {
4878                 if {$num >= $mergemax} {
4879                     set num "max"
4880                 }
4881                 lappend tags m$num
4882             }
4883             $ctext insert end "$line\n" $tags
4884         }
4885     }
4886     $ctext conf -state disabled
4887     if {[eof $mdf]} {
4888         close $mdf
4889         return 0
4890     }
4891     return [expr {$nr >= 1000? 2: 1}]
4892 }
4893
4894 proc startdiff {ids} {
4895     global treediffs diffids treepending diffmergeid nullid nullid2
4896
4897     set diffids $ids
4898     catch {unset diffmergeid}
4899     if {![info exists treediffs($ids)] ||
4900         [lsearch -exact $ids $nullid] >= 0 ||
4901         [lsearch -exact $ids $nullid2] >= 0} {
4902         if {![info exists treepending]} {
4903             gettreediffs $ids
4904         }
4905     } else {
4906         addtocflist $ids
4907     }
4908 }
4909
4910 proc addtocflist {ids} {
4911     global treediffs cflist
4912     add_flist $treediffs($ids)
4913     getblobdiffs $ids
4914 }
4915
4916 proc diffcmd {ids flags} {
4917     global nullid nullid2
4918
4919     set i [lsearch -exact $ids $nullid]
4920     set j [lsearch -exact $ids $nullid2]
4921     if {$i >= 0} {
4922         if {[llength $ids] > 1 && $j < 0} {
4923             # comparing working directory with some specific revision
4924             set cmd [concat | git diff-index $flags]
4925             if {$i == 0} {
4926                 lappend cmd -R [lindex $ids 1]
4927             } else {
4928                 lappend cmd [lindex $ids 0]
4929             }
4930         } else {
4931             # comparing working directory with index
4932             set cmd [concat | git diff-files $flags]
4933             if {$j == 1} {
4934                 lappend cmd -R
4935             }
4936         }
4937     } elseif {$j >= 0} {
4938         set cmd [concat | git diff-index --cached $flags]
4939         if {[llength $ids] > 1} {
4940             # comparing index with specific revision
4941             if {$i == 0} {
4942                 lappend cmd -R [lindex $ids 1]
4943             } else {
4944                 lappend cmd [lindex $ids 0]
4945             }
4946         } else {
4947             # comparing index with HEAD
4948             lappend cmd HEAD
4949         }
4950     } else {
4951         set cmd [concat | git diff-tree -r $flags $ids]
4952     }
4953     return $cmd
4954 }
4955
4956 proc gettreediffs {ids} {
4957     global treediff treepending
4958
4959     set treepending $ids
4960     set treediff {}
4961     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
4962     fconfigure $gdtf -blocking 0
4963     filerun $gdtf [list gettreediffline $gdtf $ids]
4964 }
4965
4966 proc gettreediffline {gdtf ids} {
4967     global treediff treediffs treepending diffids diffmergeid
4968     global cmitmode
4969
4970     set nr 0
4971     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4972         set i [string first "\t" $line]
4973         if {$i >= 0} {
4974             set file [string range $line [expr {$i+1}] end]
4975             if {[string index $file 0] eq "\""} {
4976                 set file [lindex $file 0]
4977             }
4978             lappend treediff $file
4979         }
4980     }
4981     if {![eof $gdtf]} {
4982         return [expr {$nr >= 1000? 2: 1}]
4983     }
4984     close $gdtf
4985     set treediffs($ids) $treediff
4986     unset treepending
4987     if {$cmitmode eq "tree"} {
4988         gettree $diffids
4989     } elseif {$ids != $diffids} {
4990         if {![info exists diffmergeid]} {
4991             gettreediffs $diffids
4992         }
4993     } else {
4994         addtocflist $ids
4995     }
4996     return 0
4997 }
4998
4999 proc getblobdiffs {ids} {
5000     global diffopts blobdifffd diffids env
5001     global diffinhdr treediffs
5002
5003     set env(GIT_DIFF_OPTS) $diffopts
5004     if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} {
5005         puts "error getting diffs: $err"
5006         return
5007     }
5008     set diffinhdr 0
5009     fconfigure $bdf -blocking 0
5010     set blobdifffd($ids) $bdf
5011     filerun $bdf [list getblobdiffline $bdf $diffids]
5012 }
5013
5014 proc setinlist {var i val} {
5015     global $var
5016
5017     while {[llength [set $var]] < $i} {
5018         lappend $var {}
5019     }
5020     if {[llength [set $var]] == $i} {
5021         lappend $var $val
5022     } else {
5023         lset $var $i $val
5024     }
5025 }
5026
5027 proc makediffhdr {fname ids} {
5028     global ctext curdiffstart treediffs
5029
5030     set i [lsearch -exact $treediffs($ids) $fname]
5031     if {$i >= 0} {
5032         setinlist difffilestart $i $curdiffstart
5033     }
5034     set l [expr {(78 - [string length $fname]) / 2}]
5035     set pad [string range "----------------------------------------" 1 $l]
5036     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5037 }
5038
5039 proc getblobdiffline {bdf ids} {
5040     global diffids blobdifffd ctext curdiffstart
5041     global diffnexthead diffnextnote difffilestart
5042     global diffinhdr treediffs
5043
5044     set nr 0
5045     $ctext conf -state normal
5046     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5047         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5048             close $bdf
5049             return 0
5050         }
5051         if {![string compare -length 11 "diff --git " $line]} {
5052             # trim off "diff --git "
5053             set line [string range $line 11 end]
5054             set diffinhdr 1
5055             # start of a new file
5056             $ctext insert end "\n"
5057             set curdiffstart [$ctext index "end - 1c"]
5058             $ctext insert end "\n" filesep
5059             # If the name hasn't changed the length will be odd,
5060             # the middle char will be a space, and the two bits either
5061             # side will be a/name and b/name, or "a/name" and "b/name".
5062             # If the name has changed we'll get "rename from" and
5063             # "rename to" lines following this, and we'll use them
5064             # to get the filenames.
5065             # This complexity is necessary because spaces in the filename(s)
5066             # don't get escaped.
5067             set l [string length $line]
5068             set i [expr {$l / 2}]
5069             if {!(($l & 1) && [string index $line $i] eq " " &&
5070                   [string range $line 2 [expr {$i - 1}]] eq \
5071                       [string range $line [expr {$i + 3}] end])} {
5072                 continue
5073             }
5074             # unescape if quoted and chop off the a/ from the front
5075             if {[string index $line 0] eq "\""} {
5076                 set fname [string range [lindex $line 0] 2 end]
5077             } else {
5078                 set fname [string range $line 2 [expr {$i - 1}]]
5079             }
5080             makediffhdr $fname $ids
5081
5082         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5083                        $line match f1l f1c f2l f2c rest]} {
5084             $ctext insert end "$line\n" hunksep
5085             set diffinhdr 0
5086
5087         } elseif {$diffinhdr} {
5088             if {![string compare -length 12 "rename from " $line]} {
5089                 set fname [string range $line 12 end]
5090                 if {[string index $fname 0] eq "\""} {
5091                     set fname [lindex $fname 0]
5092                 }
5093                 set i [lsearch -exact $treediffs($ids) $fname]
5094                 if {$i >= 0} {
5095                     setinlist difffilestart $i $curdiffstart
5096                 }
5097             } elseif {![string compare -length 10 $line "rename to "]} {
5098                 set fname [string range $line 10 end]
5099                 if {[string index $fname 0] eq "\""} {
5100                     set fname [lindex $fname 0]
5101                 }
5102                 makediffhdr $fname $ids
5103             } elseif {[string compare -length 3 $line "---"] == 0} {
5104                 # do nothing
5105                 continue
5106             } elseif {[string compare -length 3 $line "+++"] == 0} {
5107                 set diffinhdr 0
5108                 continue
5109             }
5110             $ctext insert end "$line\n" filesep
5111
5112         } else {
5113             set x [string range $line 0 0]
5114             if {$x == "-" || $x == "+"} {
5115                 set tag [expr {$x == "+"}]
5116                 $ctext insert end "$line\n" d$tag
5117             } elseif {$x == " "} {
5118                 $ctext insert end "$line\n"
5119             } else {
5120                 # "\ No newline at end of file",
5121                 # or something else we don't recognize
5122                 $ctext insert end "$line\n" hunksep
5123             }
5124         }
5125     }
5126     $ctext conf -state disabled
5127     if {[eof $bdf]} {
5128         close $bdf
5129         return 0
5130     }
5131     return [expr {$nr >= 1000? 2: 1}]
5132 }
5133
5134 proc changediffdisp {} {
5135     global ctext diffelide
5136
5137     $ctext tag conf d0 -elide [lindex $diffelide 0]
5138     $ctext tag conf d1 -elide [lindex $diffelide 1]
5139 }
5140
5141 proc prevfile {} {
5142     global difffilestart ctext
5143     set prev [lindex $difffilestart 0]
5144     set here [$ctext index @0,0]
5145     foreach loc $difffilestart {
5146         if {[$ctext compare $loc >= $here]} {
5147             $ctext yview $prev
5148             return
5149         }
5150         set prev $loc
5151     }
5152     $ctext yview $prev
5153 }
5154
5155 proc nextfile {} {
5156     global difffilestart ctext
5157     set here [$ctext index @0,0]
5158     foreach loc $difffilestart {
5159         if {[$ctext compare $loc > $here]} {
5160             $ctext yview $loc
5161             return
5162         }
5163     }
5164 }
5165
5166 proc clear_ctext {{first 1.0}} {
5167     global ctext smarktop smarkbot
5168
5169     set l [lindex [split $first .] 0]
5170     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5171         set smarktop $l
5172     }
5173     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5174         set smarkbot $l
5175     }
5176     $ctext delete $first end
5177 }
5178
5179 proc incrsearch {name ix op} {
5180     global ctext searchstring searchdirn
5181
5182     $ctext tag remove found 1.0 end
5183     if {[catch {$ctext index anchor}]} {
5184         # no anchor set, use start of selection, or of visible area
5185         set sel [$ctext tag ranges sel]
5186         if {$sel ne {}} {
5187             $ctext mark set anchor [lindex $sel 0]
5188         } elseif {$searchdirn eq "-forwards"} {
5189             $ctext mark set anchor @0,0
5190         } else {
5191             $ctext mark set anchor @0,[winfo height $ctext]
5192         }
5193     }
5194     if {$searchstring ne {}} {
5195         set here [$ctext search $searchdirn -- $searchstring anchor]
5196         if {$here ne {}} {
5197             $ctext see $here
5198         }
5199         searchmarkvisible 1
5200     }
5201 }
5202
5203 proc dosearch {} {
5204     global sstring ctext searchstring searchdirn
5205
5206     focus $sstring
5207     $sstring icursor end
5208     set searchdirn -forwards
5209     if {$searchstring ne {}} {
5210         set sel [$ctext tag ranges sel]
5211         if {$sel ne {}} {
5212             set start "[lindex $sel 0] + 1c"
5213         } elseif {[catch {set start [$ctext index anchor]}]} {
5214             set start "@0,0"
5215         }
5216         set match [$ctext search -count mlen -- $searchstring $start]
5217         $ctext tag remove sel 1.0 end
5218         if {$match eq {}} {
5219             bell
5220             return
5221         }
5222         $ctext see $match
5223         set mend "$match + $mlen c"
5224         $ctext tag add sel $match $mend
5225         $ctext mark unset anchor
5226     }
5227 }
5228
5229 proc dosearchback {} {
5230     global sstring ctext searchstring searchdirn
5231
5232     focus $sstring
5233     $sstring icursor end
5234     set searchdirn -backwards
5235     if {$searchstring ne {}} {
5236         set sel [$ctext tag ranges sel]
5237         if {$sel ne {}} {
5238             set start [lindex $sel 0]
5239         } elseif {[catch {set start [$ctext index anchor]}]} {
5240             set start @0,[winfo height $ctext]
5241         }
5242         set match [$ctext search -backwards -count ml -- $searchstring $start]
5243         $ctext tag remove sel 1.0 end
5244         if {$match eq {}} {
5245             bell
5246             return
5247         }
5248         $ctext see $match
5249         set mend "$match + $ml c"
5250         $ctext tag add sel $match $mend
5251         $ctext mark unset anchor
5252     }
5253 }
5254
5255 proc searchmark {first last} {
5256     global ctext searchstring
5257
5258     set mend $first.0
5259     while {1} {
5260         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5261         if {$match eq {}} break
5262         set mend "$match + $mlen c"
5263         $ctext tag add found $match $mend
5264     }
5265 }
5266
5267 proc searchmarkvisible {doall} {
5268     global ctext smarktop smarkbot
5269
5270     set topline [lindex [split [$ctext index @0,0] .] 0]
5271     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5272     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5273         # no overlap with previous
5274         searchmark $topline $botline
5275         set smarktop $topline
5276         set smarkbot $botline
5277     } else {
5278         if {$topline < $smarktop} {
5279             searchmark $topline [expr {$smarktop-1}]
5280             set smarktop $topline
5281         }
5282         if {$botline > $smarkbot} {
5283             searchmark [expr {$smarkbot+1}] $botline
5284             set smarkbot $botline
5285         }
5286     }
5287 }
5288
5289 proc scrolltext {f0 f1} {
5290     global searchstring
5291
5292     .bleft.sb set $f0 $f1
5293     if {$searchstring ne {}} {
5294         searchmarkvisible 0
5295     }
5296 }
5297
5298 proc setcoords {} {
5299     global linespc charspc canvx0 canvy0 mainfont
5300     global xspc1 xspc2 lthickness
5301
5302     set linespc [font metrics $mainfont -linespace]
5303     set charspc [font measure $mainfont "m"]
5304     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5305     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5306     set lthickness [expr {int($linespc / 9) + 1}]
5307     set xspc1(0) $linespc
5308     set xspc2 $linespc
5309 }
5310
5311 proc redisplay {} {
5312     global canv
5313     global selectedline
5314
5315     set ymax [lindex [$canv cget -scrollregion] 3]
5316     if {$ymax eq {} || $ymax == 0} return
5317     set span [$canv yview]
5318     clear_display
5319     setcanvscroll
5320     allcanvs yview moveto [lindex $span 0]
5321     drawvisible
5322     if {[info exists selectedline]} {
5323         selectline $selectedline 0
5324         allcanvs yview moveto [lindex $span 0]
5325     }
5326 }
5327
5328 proc incrfont {inc} {
5329     global mainfont textfont ctext canv phase cflist
5330     global charspc tabstop
5331     global stopped entries
5332     unmarkmatches
5333     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5334     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5335     setcoords
5336     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5337     $cflist conf -font $textfont
5338     $ctext tag conf filesep -font [concat $textfont bold]
5339     foreach e $entries {
5340         $e conf -font $mainfont
5341     }
5342     if {$phase eq "getcommits"} {
5343         $canv itemconf textitems -font $mainfont
5344     }
5345     redisplay
5346 }
5347
5348 proc clearsha1 {} {
5349     global sha1entry sha1string
5350     if {[string length $sha1string] == 40} {
5351         $sha1entry delete 0 end
5352     }
5353 }
5354
5355 proc sha1change {n1 n2 op} {
5356     global sha1string currentid sha1but
5357     if {$sha1string == {}
5358         || ([info exists currentid] && $sha1string == $currentid)} {
5359         set state disabled
5360     } else {
5361         set state normal
5362     }
5363     if {[$sha1but cget -state] == $state} return
5364     if {$state == "normal"} {
5365         $sha1but conf -state normal -relief raised -text "Goto: "
5366     } else {
5367         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5368     }
5369 }
5370
5371 proc gotocommit {} {
5372     global sha1string currentid commitrow tagids headids
5373     global displayorder numcommits curview
5374
5375     if {$sha1string == {}
5376         || ([info exists currentid] && $sha1string == $currentid)} return
5377     if {[info exists tagids($sha1string)]} {
5378         set id $tagids($sha1string)
5379     } elseif {[info exists headids($sha1string)]} {
5380         set id $headids($sha1string)
5381     } else {
5382         set id [string tolower $sha1string]
5383         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5384             set matches {}
5385             foreach i $displayorder {
5386                 if {[string match $id* $i]} {
5387                     lappend matches $i
5388                 }
5389             }
5390             if {$matches ne {}} {
5391                 if {[llength $matches] > 1} {
5392                     error_popup "Short SHA1 id $id is ambiguous"
5393                     return
5394                 }
5395                 set id [lindex $matches 0]
5396             }
5397         }
5398     }
5399     if {[info exists commitrow($curview,$id)]} {
5400         selectline $commitrow($curview,$id) 1
5401         return
5402     }
5403     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5404         set type "SHA1 id"
5405     } else {
5406         set type "Tag/Head"
5407     }
5408     error_popup "$type $sha1string is not known"
5409 }
5410
5411 proc lineenter {x y id} {
5412     global hoverx hovery hoverid hovertimer
5413     global commitinfo canv
5414
5415     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5416     set hoverx $x
5417     set hovery $y
5418     set hoverid $id
5419     if {[info exists hovertimer]} {
5420         after cancel $hovertimer
5421     }
5422     set hovertimer [after 500 linehover]
5423     $canv delete hover
5424 }
5425
5426 proc linemotion {x y id} {
5427     global hoverx hovery hoverid hovertimer
5428
5429     if {[info exists hoverid] && $id == $hoverid} {
5430         set hoverx $x
5431         set hovery $y
5432         if {[info exists hovertimer]} {
5433             after cancel $hovertimer
5434         }
5435         set hovertimer [after 500 linehover]
5436     }
5437 }
5438
5439 proc lineleave {id} {
5440     global hoverid hovertimer canv
5441
5442     if {[info exists hoverid] && $id == $hoverid} {
5443         $canv delete hover
5444         if {[info exists hovertimer]} {
5445             after cancel $hovertimer
5446             unset hovertimer
5447         }
5448         unset hoverid
5449     }
5450 }
5451
5452 proc linehover {} {
5453     global hoverx hovery hoverid hovertimer
5454     global canv linespc lthickness
5455     global commitinfo mainfont
5456
5457     set text [lindex $commitinfo($hoverid) 0]
5458     set ymax [lindex [$canv cget -scrollregion] 3]
5459     if {$ymax == {}} return
5460     set yfrac [lindex [$canv yview] 0]
5461     set x [expr {$hoverx + 2 * $linespc}]
5462     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5463     set x0 [expr {$x - 2 * $lthickness}]
5464     set y0 [expr {$y - 2 * $lthickness}]
5465     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5466     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5467     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5468                -fill \#ffff80 -outline black -width 1 -tags hover]
5469     $canv raise $t
5470     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5471                -font $mainfont]
5472     $canv raise $t
5473 }
5474
5475 proc clickisonarrow {id y} {
5476     global lthickness
5477
5478     set ranges [rowranges $id]
5479     set thresh [expr {2 * $lthickness + 6}]
5480     set n [expr {[llength $ranges] - 1}]
5481     for {set i 1} {$i < $n} {incr i} {
5482         set row [lindex $ranges $i]
5483         if {abs([yc $row] - $y) < $thresh} {
5484             return $i
5485         }
5486     }
5487     return {}
5488 }
5489
5490 proc arrowjump {id n y} {
5491     global canv
5492
5493     # 1 <-> 2, 3 <-> 4, etc...
5494     set n [expr {(($n - 1) ^ 1) + 1}]
5495     set row [lindex [rowranges $id] $n]
5496     set yt [yc $row]
5497     set ymax [lindex [$canv cget -scrollregion] 3]
5498     if {$ymax eq {} || $ymax <= 0} return
5499     set view [$canv yview]
5500     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5501     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5502     if {$yfrac < 0} {
5503         set yfrac 0
5504     }
5505     allcanvs yview moveto $yfrac
5506 }
5507
5508 proc lineclick {x y id isnew} {
5509     global ctext commitinfo children canv thickerline curview
5510
5511     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5512     unmarkmatches
5513     unselectline
5514     normalline
5515     $canv delete hover
5516     # draw this line thicker than normal
5517     set thickerline $id
5518     drawlines $id
5519     if {$isnew} {
5520         set ymax [lindex [$canv cget -scrollregion] 3]
5521         if {$ymax eq {}} return
5522         set yfrac [lindex [$canv yview] 0]
5523         set y [expr {$y + $yfrac * $ymax}]
5524     }
5525     set dirn [clickisonarrow $id $y]
5526     if {$dirn ne {}} {
5527         arrowjump $id $dirn $y
5528         return
5529     }
5530
5531     if {$isnew} {
5532         addtohistory [list lineclick $x $y $id 0]
5533     }
5534     # fill the details pane with info about this line
5535     $ctext conf -state normal
5536     clear_ctext
5537     $ctext tag conf link -foreground blue -underline 1
5538     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5539     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5540     $ctext insert end "Parent:\t"
5541     $ctext insert end $id [list link link0]
5542     $ctext tag bind link0 <1> [list selbyid $id]
5543     set info $commitinfo($id)
5544     $ctext insert end "\n\t[lindex $info 0]\n"
5545     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5546     set date [formatdate [lindex $info 2]]
5547     $ctext insert end "\tDate:\t$date\n"
5548     set kids $children($curview,$id)
5549     if {$kids ne {}} {
5550         $ctext insert end "\nChildren:"
5551         set i 0
5552         foreach child $kids {
5553             incr i
5554             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5555             set info $commitinfo($child)
5556             $ctext insert end "\n\t"
5557             $ctext insert end $child [list link link$i]
5558             $ctext tag bind link$i <1> [list selbyid $child]
5559             $ctext insert end "\n\t[lindex $info 0]"
5560             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5561             set date [formatdate [lindex $info 2]]
5562             $ctext insert end "\n\tDate:\t$date\n"
5563         }
5564     }
5565     $ctext conf -state disabled
5566     init_flist {}
5567 }
5568
5569 proc normalline {} {
5570     global thickerline
5571     if {[info exists thickerline]} {
5572         set id $thickerline
5573         unset thickerline
5574         drawlines $id
5575     }
5576 }
5577
5578 proc selbyid {id} {
5579     global commitrow curview
5580     if {[info exists commitrow($curview,$id)]} {
5581         selectline $commitrow($curview,$id) 1
5582     }
5583 }
5584
5585 proc mstime {} {
5586     global startmstime
5587     if {![info exists startmstime]} {
5588         set startmstime [clock clicks -milliseconds]
5589     }
5590     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5591 }
5592
5593 proc rowmenu {x y id} {
5594     global rowctxmenu commitrow selectedline rowmenuid curview
5595     global nullid nullid2 fakerowmenu mainhead
5596
5597     set rowmenuid $id
5598     if {![info exists selectedline]
5599         || $commitrow($curview,$id) eq $selectedline} {
5600         set state disabled
5601     } else {
5602         set state normal
5603     }
5604     if {$id ne $nullid && $id ne $nullid2} {
5605         set menu $rowctxmenu
5606         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5607     } else {
5608         set menu $fakerowmenu
5609     }
5610     $menu entryconfigure "Diff this*" -state $state
5611     $menu entryconfigure "Diff selected*" -state $state
5612     $menu entryconfigure "Make patch" -state $state
5613     tk_popup $menu $x $y
5614 }
5615
5616 proc diffvssel {dirn} {
5617     global rowmenuid selectedline displayorder
5618
5619     if {![info exists selectedline]} return
5620     if {$dirn} {
5621         set oldid [lindex $displayorder $selectedline]
5622         set newid $rowmenuid
5623     } else {
5624         set oldid $rowmenuid
5625         set newid [lindex $displayorder $selectedline]
5626     }
5627     addtohistory [list doseldiff $oldid $newid]
5628     doseldiff $oldid $newid
5629 }
5630
5631 proc doseldiff {oldid newid} {
5632     global ctext
5633     global commitinfo
5634
5635     $ctext conf -state normal
5636     clear_ctext
5637     init_flist "Top"
5638     $ctext insert end "From "
5639     $ctext tag conf link -foreground blue -underline 1
5640     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5641     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5642     $ctext tag bind link0 <1> [list selbyid $oldid]
5643     $ctext insert end $oldid [list link link0]
5644     $ctext insert end "\n     "
5645     $ctext insert end [lindex $commitinfo($oldid) 0]
5646     $ctext insert end "\n\nTo   "
5647     $ctext tag bind link1 <1> [list selbyid $newid]
5648     $ctext insert end $newid [list link link1]
5649     $ctext insert end "\n     "
5650     $ctext insert end [lindex $commitinfo($newid) 0]
5651     $ctext insert end "\n"
5652     $ctext conf -state disabled
5653     $ctext tag remove found 1.0 end
5654     startdiff [list $oldid $newid]
5655 }
5656
5657 proc mkpatch {} {
5658     global rowmenuid currentid commitinfo patchtop patchnum
5659
5660     if {![info exists currentid]} return
5661     set oldid $currentid
5662     set oldhead [lindex $commitinfo($oldid) 0]
5663     set newid $rowmenuid
5664     set newhead [lindex $commitinfo($newid) 0]
5665     set top .patch
5666     set patchtop $top
5667     catch {destroy $top}
5668     toplevel $top
5669     label $top.title -text "Generate patch"
5670     grid $top.title - -pady 10
5671     label $top.from -text "From:"
5672     entry $top.fromsha1 -width 40 -relief flat
5673     $top.fromsha1 insert 0 $oldid
5674     $top.fromsha1 conf -state readonly
5675     grid $top.from $top.fromsha1 -sticky w
5676     entry $top.fromhead -width 60 -relief flat
5677     $top.fromhead insert 0 $oldhead
5678     $top.fromhead conf -state readonly
5679     grid x $top.fromhead -sticky w
5680     label $top.to -text "To:"
5681     entry $top.tosha1 -width 40 -relief flat
5682     $top.tosha1 insert 0 $newid
5683     $top.tosha1 conf -state readonly
5684     grid $top.to $top.tosha1 -sticky w
5685     entry $top.tohead -width 60 -relief flat
5686     $top.tohead insert 0 $newhead
5687     $top.tohead conf -state readonly
5688     grid x $top.tohead -sticky w
5689     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5690     grid $top.rev x -pady 10
5691     label $top.flab -text "Output file:"
5692     entry $top.fname -width 60
5693     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5694     incr patchnum
5695     grid $top.flab $top.fname -sticky w
5696     frame $top.buts
5697     button $top.buts.gen -text "Generate" -command mkpatchgo
5698     button $top.buts.can -text "Cancel" -command mkpatchcan
5699     grid $top.buts.gen $top.buts.can
5700     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5701     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5702     grid $top.buts - -pady 10 -sticky ew
5703     focus $top.fname
5704 }
5705
5706 proc mkpatchrev {} {
5707     global patchtop
5708
5709     set oldid [$patchtop.fromsha1 get]
5710     set oldhead [$patchtop.fromhead get]
5711     set newid [$patchtop.tosha1 get]
5712     set newhead [$patchtop.tohead get]
5713     foreach e [list fromsha1 fromhead tosha1 tohead] \
5714             v [list $newid $newhead $oldid $oldhead] {
5715         $patchtop.$e conf -state normal
5716         $patchtop.$e delete 0 end
5717         $patchtop.$e insert 0 $v
5718         $patchtop.$e conf -state readonly
5719     }
5720 }
5721
5722 proc mkpatchgo {} {
5723     global patchtop nullid nullid2
5724
5725     set oldid [$patchtop.fromsha1 get]
5726     set newid [$patchtop.tosha1 get]
5727     set fname [$patchtop.fname get]
5728     set cmd [diffcmd [list $oldid $newid] -p]
5729     lappend cmd >$fname &
5730     if {[catch {eval exec $cmd} err]} {
5731         error_popup "Error creating patch: $err"
5732     }
5733     catch {destroy $patchtop}
5734     unset patchtop
5735 }
5736
5737 proc mkpatchcan {} {
5738     global patchtop
5739
5740     catch {destroy $patchtop}
5741     unset patchtop
5742 }
5743
5744 proc mktag {} {
5745     global rowmenuid mktagtop commitinfo
5746
5747     set top .maketag
5748     set mktagtop $top
5749     catch {destroy $top}
5750     toplevel $top
5751     label $top.title -text "Create tag"
5752     grid $top.title - -pady 10
5753     label $top.id -text "ID:"
5754     entry $top.sha1 -width 40 -relief flat
5755     $top.sha1 insert 0 $rowmenuid
5756     $top.sha1 conf -state readonly
5757     grid $top.id $top.sha1 -sticky w
5758     entry $top.head -width 60 -relief flat
5759     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5760     $top.head conf -state readonly
5761     grid x $top.head -sticky w
5762     label $top.tlab -text "Tag name:"
5763     entry $top.tag -width 60
5764     grid $top.tlab $top.tag -sticky w
5765     frame $top.buts
5766     button $top.buts.gen -text "Create" -command mktaggo
5767     button $top.buts.can -text "Cancel" -command mktagcan
5768     grid $top.buts.gen $top.buts.can
5769     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5770     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5771     grid $top.buts - -pady 10 -sticky ew
5772     focus $top.tag
5773 }
5774
5775 proc domktag {} {
5776     global mktagtop env tagids idtags
5777
5778     set id [$mktagtop.sha1 get]
5779     set tag [$mktagtop.tag get]
5780     if {$tag == {}} {
5781         error_popup "No tag name specified"
5782         return
5783     }
5784     if {[info exists tagids($tag)]} {
5785         error_popup "Tag \"$tag\" already exists"
5786         return
5787     }
5788     if {[catch {
5789         set dir [gitdir]
5790         set fname [file join $dir "refs/tags" $tag]
5791         set f [open $fname w]
5792         puts $f $id
5793         close $f
5794     } err]} {
5795         error_popup "Error creating tag: $err"
5796         return
5797     }
5798
5799     set tagids($tag) $id
5800     lappend idtags($id) $tag
5801     redrawtags $id
5802     addedtag $id
5803 }
5804
5805 proc redrawtags {id} {
5806     global canv linehtag commitrow idpos selectedline curview
5807     global mainfont canvxmax iddrawn
5808
5809     if {![info exists commitrow($curview,$id)]} return
5810     if {![info exists iddrawn($id)]} return
5811     drawcommits $commitrow($curview,$id)
5812     $canv delete tag.$id
5813     set xt [eval drawtags $id $idpos($id)]
5814     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5815     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5816     set xr [expr {$xt + [font measure $mainfont $text]}]
5817     if {$xr > $canvxmax} {
5818         set canvxmax $xr
5819         setcanvscroll
5820     }
5821     if {[info exists selectedline]
5822         && $selectedline == $commitrow($curview,$id)} {
5823         selectline $selectedline 0
5824     }
5825 }
5826
5827 proc mktagcan {} {
5828     global mktagtop
5829
5830     catch {destroy $mktagtop}
5831     unset mktagtop
5832 }
5833
5834 proc mktaggo {} {
5835     domktag
5836     mktagcan
5837 }
5838
5839 proc writecommit {} {
5840     global rowmenuid wrcomtop commitinfo wrcomcmd
5841
5842     set top .writecommit
5843     set wrcomtop $top
5844     catch {destroy $top}
5845     toplevel $top
5846     label $top.title -text "Write commit to file"
5847     grid $top.title - -pady 10
5848     label $top.id -text "ID:"
5849     entry $top.sha1 -width 40 -relief flat
5850     $top.sha1 insert 0 $rowmenuid
5851     $top.sha1 conf -state readonly
5852     grid $top.id $top.sha1 -sticky w
5853     entry $top.head -width 60 -relief flat
5854     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5855     $top.head conf -state readonly
5856     grid x $top.head -sticky w
5857     label $top.clab -text "Command:"
5858     entry $top.cmd -width 60 -textvariable wrcomcmd
5859     grid $top.clab $top.cmd -sticky w -pady 10
5860     label $top.flab -text "Output file:"
5861     entry $top.fname -width 60
5862     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5863     grid $top.flab $top.fname -sticky w
5864     frame $top.buts
5865     button $top.buts.gen -text "Write" -command wrcomgo
5866     button $top.buts.can -text "Cancel" -command wrcomcan
5867     grid $top.buts.gen $top.buts.can
5868     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5869     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5870     grid $top.buts - -pady 10 -sticky ew
5871     focus $top.fname
5872 }
5873
5874 proc wrcomgo {} {
5875     global wrcomtop
5876
5877     set id [$wrcomtop.sha1 get]
5878     set cmd "echo $id | [$wrcomtop.cmd get]"
5879     set fname [$wrcomtop.fname get]
5880     if {[catch {exec sh -c $cmd >$fname &} err]} {
5881         error_popup "Error writing commit: $err"
5882     }
5883     catch {destroy $wrcomtop}
5884     unset wrcomtop
5885 }
5886
5887 proc wrcomcan {} {
5888     global wrcomtop
5889
5890     catch {destroy $wrcomtop}
5891     unset wrcomtop
5892 }
5893
5894 proc mkbranch {} {
5895     global rowmenuid mkbrtop
5896
5897     set top .makebranch
5898     catch {destroy $top}
5899     toplevel $top
5900     label $top.title -text "Create new branch"
5901     grid $top.title - -pady 10
5902     label $top.id -text "ID:"
5903     entry $top.sha1 -width 40 -relief flat
5904     $top.sha1 insert 0 $rowmenuid
5905     $top.sha1 conf -state readonly
5906     grid $top.id $top.sha1 -sticky w
5907     label $top.nlab -text "Name:"
5908     entry $top.name -width 40
5909     grid $top.nlab $top.name -sticky w
5910     frame $top.buts
5911     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5912     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5913     grid $top.buts.go $top.buts.can
5914     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5915     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5916     grid $top.buts - -pady 10 -sticky ew
5917     focus $top.name
5918 }
5919
5920 proc mkbrgo {top} {
5921     global headids idheads
5922
5923     set name [$top.name get]
5924     set id [$top.sha1 get]
5925     if {$name eq {}} {
5926         error_popup "Please specify a name for the new branch"
5927         return
5928     }
5929     catch {destroy $top}
5930     nowbusy newbranch
5931     update
5932     if {[catch {
5933         exec git branch $name $id
5934     } err]} {
5935         notbusy newbranch
5936         error_popup $err
5937     } else {
5938         set headids($name) $id
5939         lappend idheads($id) $name
5940         addedhead $id $name
5941         notbusy newbranch
5942         redrawtags $id
5943         dispneartags 0
5944     }
5945 }
5946
5947 proc cherrypick {} {
5948     global rowmenuid curview commitrow
5949     global mainhead
5950
5951     set oldhead [exec git rev-parse HEAD]
5952     set dheads [descheads $rowmenuid]
5953     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5954         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5955                         included in branch $mainhead -- really re-apply it?"]
5956         if {!$ok} return
5957     }
5958     nowbusy cherrypick
5959     update
5960     # Unfortunately git-cherry-pick writes stuff to stderr even when
5961     # no error occurs, and exec takes that as an indication of error...
5962     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5963         notbusy cherrypick
5964         error_popup $err
5965         return
5966     }
5967     set newhead [exec git rev-parse HEAD]
5968     if {$newhead eq $oldhead} {
5969         notbusy cherrypick
5970         error_popup "No changes committed"
5971         return
5972     }
5973     addnewchild $newhead $oldhead
5974     if {[info exists commitrow($curview,$oldhead)]} {
5975         insertrow $commitrow($curview,$oldhead) $newhead
5976         if {$mainhead ne {}} {
5977             movehead $newhead $mainhead
5978             movedhead $newhead $mainhead
5979         }
5980         redrawtags $oldhead
5981         redrawtags $newhead
5982     }
5983     notbusy cherrypick
5984 }
5985
5986 proc resethead {} {
5987     global mainheadid mainhead rowmenuid confirm_ok resettype
5988     global showlocalchanges
5989
5990     set confirm_ok 0
5991     set w ".confirmreset"
5992     toplevel $w
5993     wm transient $w .
5994     wm title $w "Confirm reset"
5995     message $w.m -text \
5996         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5997         -justify center -aspect 1000
5998     pack $w.m -side top -fill x -padx 20 -pady 20
5999     frame $w.f -relief sunken -border 2
6000     message $w.f.rt -text "Reset type:" -aspect 1000
6001     grid $w.f.rt -sticky w
6002     set resettype mixed
6003     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6004         -text "Soft: Leave working tree and index untouched"
6005     grid $w.f.soft -sticky w
6006     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6007         -text "Mixed: Leave working tree untouched, reset index"
6008     grid $w.f.mixed -sticky w
6009     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6010         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6011     grid $w.f.hard -sticky w
6012     pack $w.f -side top -fill x
6013     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6014     pack $w.ok -side left -fill x -padx 20 -pady 20
6015     button $w.cancel -text Cancel -command "destroy $w"
6016     pack $w.cancel -side right -fill x -padx 20 -pady 20
6017     bind $w <Visibility> "grab $w; focus $w"
6018     tkwait window $w
6019     if {!$confirm_ok} return
6020     if {[catch {set fd [open \
6021             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6022         error_popup $err
6023     } else {
6024         dohidelocalchanges
6025         set w ".resetprogress"
6026         filerun $fd [list readresetstat $fd $w]
6027         toplevel $w
6028         wm transient $w
6029         wm title $w "Reset progress"
6030         message $w.m -text "Reset in progress, please wait..." \
6031             -justify center -aspect 1000
6032         pack $w.m -side top -fill x -padx 20 -pady 5
6033         canvas $w.c -width 150 -height 20 -bg white
6034         $w.c create rect 0 0 0 20 -fill green -tags rect
6035         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6036         nowbusy reset
6037     }
6038 }
6039
6040 proc readresetstat {fd w} {
6041     global mainhead mainheadid showlocalchanges
6042
6043     if {[gets $fd line] >= 0} {
6044         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6045             set x [expr {($m * 150) / $n}]
6046             $w.c coords rect 0 0 $x 20
6047         }
6048         return 1
6049     }
6050     destroy $w
6051     notbusy reset
6052     if {[catch {close $fd} err]} {
6053         error_popup $err
6054     }
6055     set oldhead $mainheadid
6056     set newhead [exec git rev-parse HEAD]
6057     if {$newhead ne $oldhead} {
6058         movehead $newhead $mainhead
6059         movedhead $newhead $mainhead
6060         set mainheadid $newhead
6061         redrawtags $oldhead
6062         redrawtags $newhead
6063     }
6064     if {$showlocalchanges} {
6065         doshowlocalchanges
6066     }
6067     return 0
6068 }
6069
6070 # context menu for a head
6071 proc headmenu {x y id head} {
6072     global headmenuid headmenuhead headctxmenu mainhead
6073
6074     set headmenuid $id
6075     set headmenuhead $head
6076     set state normal
6077     if {$head eq $mainhead} {
6078         set state disabled
6079     }
6080     $headctxmenu entryconfigure 0 -state $state
6081     $headctxmenu entryconfigure 1 -state $state
6082     tk_popup $headctxmenu $x $y
6083 }
6084
6085 proc cobranch {} {
6086     global headmenuid headmenuhead mainhead headids
6087     global showlocalchanges mainheadid
6088
6089     # check the tree is clean first??
6090     set oldmainhead $mainhead
6091     nowbusy checkout
6092     update
6093     dohidelocalchanges
6094     if {[catch {
6095         exec git checkout -q $headmenuhead
6096     } err]} {
6097         notbusy checkout
6098         error_popup $err
6099     } else {
6100         notbusy checkout
6101         set mainhead $headmenuhead
6102         set mainheadid $headmenuid
6103         if {[info exists headids($oldmainhead)]} {
6104             redrawtags $headids($oldmainhead)
6105         }
6106         redrawtags $headmenuid
6107     }
6108     if {$showlocalchanges} {
6109         dodiffindex
6110     }
6111 }
6112
6113 proc rmbranch {} {
6114     global headmenuid headmenuhead mainhead
6115     global headids idheads
6116
6117     set head $headmenuhead
6118     set id $headmenuid
6119     # this check shouldn't be needed any more...
6120     if {$head eq $mainhead} {
6121         error_popup "Cannot delete the currently checked-out branch"
6122         return
6123     }
6124     set dheads [descheads $id]
6125     if {$dheads eq $headids($head)} {
6126         # the stuff on this branch isn't on any other branch
6127         if {![confirm_popup "The commits on branch $head aren't on any other\
6128                         branch.\nReally delete branch $head?"]} return
6129     }
6130     nowbusy rmbranch
6131     update
6132     if {[catch {exec git branch -D $head} err]} {
6133         notbusy rmbranch
6134         error_popup $err
6135         return
6136     }
6137     removehead $id $head
6138     removedhead $id $head
6139     redrawtags $id
6140     notbusy rmbranch
6141     dispneartags 0
6142 }
6143
6144 # Stuff for finding nearby tags
6145 proc getallcommits {} {
6146     global allcommits allids nbmp nextarc seeds
6147
6148     set allids {}
6149     set nbmp 0
6150     set nextarc 0
6151     set allcommits 0
6152     set seeds {}
6153     regetallcommits
6154 }
6155
6156 # Called when the graph might have changed
6157 proc regetallcommits {} {
6158     global allcommits seeds
6159
6160     set cmd [concat | git rev-list --all --parents]
6161     foreach id $seeds {
6162         lappend cmd "^$id"
6163     }
6164     set fd [open $cmd r]
6165     fconfigure $fd -blocking 0
6166     incr allcommits
6167     nowbusy allcommits
6168     filerun $fd [list getallclines $fd]
6169 }
6170
6171 # Since most commits have 1 parent and 1 child, we group strings of
6172 # such commits into "arcs" joining branch/merge points (BMPs), which
6173 # are commits that either don't have 1 parent or don't have 1 child.
6174 #
6175 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6176 # arcout(id) - outgoing arcs for BMP
6177 # arcids(a) - list of IDs on arc including end but not start
6178 # arcstart(a) - BMP ID at start of arc
6179 # arcend(a) - BMP ID at end of arc
6180 # growing(a) - arc a is still growing
6181 # arctags(a) - IDs out of arcids (excluding end) that have tags
6182 # archeads(a) - IDs out of arcids (excluding end) that have heads
6183 # The start of an arc is at the descendent end, so "incoming" means
6184 # coming from descendents, and "outgoing" means going towards ancestors.
6185
6186 proc getallclines {fd} {
6187     global allids allparents allchildren idtags idheads nextarc nbmp
6188     global arcnos arcids arctags arcout arcend arcstart archeads growing
6189     global seeds allcommits
6190
6191     set nid 0
6192     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6193         set id [lindex $line 0]
6194         if {[info exists allparents($id)]} {
6195             # seen it already
6196             continue
6197         }
6198         lappend allids $id
6199         set olds [lrange $line 1 end]
6200         set allparents($id) $olds
6201         if {![info exists allchildren($id)]} {
6202             set allchildren($id) {}
6203             set arcnos($id) {}
6204             lappend seeds $id
6205         } else {
6206             set a $arcnos($id)
6207             if {[llength $olds] == 1 && [llength $a] == 1} {
6208                 lappend arcids($a) $id
6209                 if {[info exists idtags($id)]} {
6210                     lappend arctags($a) $id
6211                 }
6212                 if {[info exists idheads($id)]} {
6213                     lappend archeads($a) $id
6214                 }
6215                 if {[info exists allparents($olds)]} {
6216                     # seen parent already
6217                     if {![info exists arcout($olds)]} {
6218                         splitarc $olds
6219                     }
6220                     lappend arcids($a) $olds
6221                     set arcend($a) $olds
6222                     unset growing($a)
6223                 }
6224                 lappend allchildren($olds) $id
6225                 lappend arcnos($olds) $a
6226                 continue
6227             }
6228         }
6229         incr nbmp
6230         foreach a $arcnos($id) {
6231             lappend arcids($a) $id
6232             set arcend($a) $id
6233             unset growing($a)
6234         }
6235
6236         set ao {}
6237         foreach p $olds {
6238             lappend allchildren($p) $id
6239             set a [incr nextarc]
6240             set arcstart($a) $id
6241             set archeads($a) {}
6242             set arctags($a) {}
6243             set archeads($a) {}
6244             set arcids($a) {}
6245             lappend ao $a
6246             set growing($a) 1
6247             if {[info exists allparents($p)]} {
6248                 # seen it already, may need to make a new branch
6249                 if {![info exists arcout($p)]} {
6250                     splitarc $p
6251                 }
6252                 lappend arcids($a) $p
6253                 set arcend($a) $p
6254                 unset growing($a)
6255             }
6256             lappend arcnos($p) $a
6257         }
6258         set arcout($id) $ao
6259     }
6260     if {$nid > 0} {
6261         global cached_dheads cached_dtags cached_atags
6262         catch {unset cached_dheads}
6263         catch {unset cached_dtags}
6264         catch {unset cached_atags}
6265     }
6266     if {![eof $fd]} {
6267         return [expr {$nid >= 1000? 2: 1}]
6268     }
6269     close $fd
6270     if {[incr allcommits -1] == 0} {
6271         notbusy allcommits
6272     }
6273     dispneartags 0
6274     return 0
6275 }
6276
6277 proc recalcarc {a} {
6278     global arctags archeads arcids idtags idheads
6279
6280     set at {}
6281     set ah {}
6282     foreach id [lrange $arcids($a) 0 end-1] {
6283         if {[info exists idtags($id)]} {
6284             lappend at $id
6285         }
6286         if {[info exists idheads($id)]} {
6287             lappend ah $id
6288         }
6289     }
6290     set arctags($a) $at
6291     set archeads($a) $ah
6292 }
6293
6294 proc splitarc {p} {
6295     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6296     global arcstart arcend arcout allparents growing
6297
6298     set a $arcnos($p)
6299     if {[llength $a] != 1} {
6300         puts "oops splitarc called but [llength $a] arcs already"
6301         return
6302     }
6303     set a [lindex $a 0]
6304     set i [lsearch -exact $arcids($a) $p]
6305     if {$i < 0} {
6306         puts "oops splitarc $p not in arc $a"
6307         return
6308     }
6309     set na [incr nextarc]
6310     if {[info exists arcend($a)]} {
6311         set arcend($na) $arcend($a)
6312     } else {
6313         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6314         set j [lsearch -exact $arcnos($l) $a]
6315         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6316     }
6317     set tail [lrange $arcids($a) [expr {$i+1}] end]
6318     set arcids($a) [lrange $arcids($a) 0 $i]
6319     set arcend($a) $p
6320     set arcstart($na) $p
6321     set arcout($p) $na
6322     set arcids($na) $tail
6323     if {[info exists growing($a)]} {
6324         set growing($na) 1
6325         unset growing($a)
6326     }
6327     incr nbmp
6328
6329     foreach id $tail {
6330         if {[llength $arcnos($id)] == 1} {
6331             set arcnos($id) $na
6332         } else {
6333             set j [lsearch -exact $arcnos($id) $a]
6334             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6335         }
6336     }
6337
6338     # reconstruct tags and heads lists
6339     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6340         recalcarc $a
6341         recalcarc $na
6342     } else {
6343         set arctags($na) {}
6344         set archeads($na) {}
6345     }
6346 }
6347
6348 # Update things for a new commit added that is a child of one
6349 # existing commit.  Used when cherry-picking.
6350 proc addnewchild {id p} {
6351     global allids allparents allchildren idtags nextarc nbmp
6352     global arcnos arcids arctags arcout arcend arcstart archeads growing
6353     global seeds
6354
6355     lappend allids $id
6356     set allparents($id) [list $p]
6357     set allchildren($id) {}
6358     set arcnos($id) {}
6359     lappend seeds $id
6360     incr nbmp
6361     lappend allchildren($p) $id
6362     set a [incr nextarc]
6363     set arcstart($a) $id
6364     set archeads($a) {}
6365     set arctags($a) {}
6366     set arcids($a) [list $p]
6367     set arcend($a) $p
6368     if {![info exists arcout($p)]} {
6369         splitarc $p
6370     }
6371     lappend arcnos($p) $a
6372     set arcout($id) [list $a]
6373 }
6374
6375 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6376 # or 0 if neither is true.
6377 proc anc_or_desc {a b} {
6378     global arcout arcstart arcend arcnos cached_isanc
6379
6380     if {$arcnos($a) eq $arcnos($b)} {
6381         # Both are on the same arc(s); either both are the same BMP,
6382         # or if one is not a BMP, the other is also not a BMP or is
6383         # the BMP at end of the arc (and it only has 1 incoming arc).
6384         # Or both can be BMPs with no incoming arcs.
6385         if {$a eq $b || $arcnos($a) eq {}} {
6386             return 0
6387         }
6388         # assert {[llength $arcnos($a)] == 1}
6389         set arc [lindex $arcnos($a) 0]
6390         set i [lsearch -exact $arcids($arc) $a]
6391         set j [lsearch -exact $arcids($arc) $b]
6392         if {$i < 0 || $i > $j} {
6393             return 1
6394         } else {
6395             return -1
6396         }
6397     }
6398
6399     if {![info exists arcout($a)]} {
6400         set arc [lindex $arcnos($a) 0]
6401         if {[info exists arcend($arc)]} {
6402             set aend $arcend($arc)
6403         } else {
6404             set aend {}
6405         }
6406         set a $arcstart($arc)
6407     } else {
6408         set aend $a
6409     }
6410     if {![info exists arcout($b)]} {
6411         set arc [lindex $arcnos($b) 0]
6412         if {[info exists arcend($arc)]} {
6413             set bend $arcend($arc)
6414         } else {
6415             set bend {}
6416         }
6417         set b $arcstart($arc)
6418     } else {
6419         set bend $b
6420     }
6421     if {$a eq $bend} {
6422         return 1
6423     }
6424     if {$b eq $aend} {
6425         return -1
6426     }
6427     if {[info exists cached_isanc($a,$bend)]} {
6428         if {$cached_isanc($a,$bend)} {
6429             return 1
6430         }
6431     }
6432     if {[info exists cached_isanc($b,$aend)]} {
6433         if {$cached_isanc($b,$aend)} {
6434             return -1
6435         }
6436         if {[info exists cached_isanc($a,$bend)]} {
6437             return 0
6438         }
6439     }
6440
6441     set todo [list $a $b]
6442     set anc($a) a
6443     set anc($b) b
6444     for {set i 0} {$i < [llength $todo]} {incr i} {
6445         set x [lindex $todo $i]
6446         if {$anc($x) eq {}} {
6447             continue
6448         }
6449         foreach arc $arcnos($x) {
6450             set xd $arcstart($arc)
6451             if {$xd eq $bend} {
6452                 set cached_isanc($a,$bend) 1
6453                 set cached_isanc($b,$aend) 0
6454                 return 1
6455             } elseif {$xd eq $aend} {
6456                 set cached_isanc($b,$aend) 1
6457                 set cached_isanc($a,$bend) 0
6458                 return -1
6459             }
6460             if {![info exists anc($xd)]} {
6461                 set anc($xd) $anc($x)
6462                 lappend todo $xd
6463             } elseif {$anc($xd) ne $anc($x)} {
6464                 set anc($xd) {}
6465             }
6466         }
6467     }
6468     set cached_isanc($a,$bend) 0
6469     set cached_isanc($b,$aend) 0
6470     return 0
6471 }
6472
6473 # This identifies whether $desc has an ancestor that is
6474 # a growing tip of the graph and which is not an ancestor of $anc
6475 # and returns 0 if so and 1 if not.
6476 # If we subsequently discover a tag on such a growing tip, and that
6477 # turns out to be a descendent of $anc (which it could, since we
6478 # don't necessarily see children before parents), then $desc
6479 # isn't a good choice to display as a descendent tag of
6480 # $anc (since it is the descendent of another tag which is
6481 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6482 # display as a ancestor tag of $desc.
6483 #
6484 proc is_certain {desc anc} {
6485     global arcnos arcout arcstart arcend growing problems
6486
6487     set certain {}
6488     if {[llength $arcnos($anc)] == 1} {
6489         # tags on the same arc are certain
6490         if {$arcnos($desc) eq $arcnos($anc)} {
6491             return 1
6492         }
6493         if {![info exists arcout($anc)]} {
6494             # if $anc is partway along an arc, use the start of the arc instead
6495             set a [lindex $arcnos($anc) 0]
6496             set anc $arcstart($a)
6497         }
6498     }
6499     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6500         set x $desc
6501     } else {
6502         set a [lindex $arcnos($desc) 0]
6503         set x $arcend($a)
6504     }
6505     if {$x == $anc} {
6506         return 1
6507     }
6508     set anclist [list $x]
6509     set dl($x) 1
6510     set nnh 1
6511     set ngrowanc 0
6512     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6513         set x [lindex $anclist $i]
6514         if {$dl($x)} {
6515             incr nnh -1
6516         }
6517         set done($x) 1
6518         foreach a $arcout($x) {
6519             if {[info exists growing($a)]} {
6520                 if {![info exists growanc($x)] && $dl($x)} {
6521                     set growanc($x) 1
6522                     incr ngrowanc
6523                 }
6524             } else {
6525                 set y $arcend($a)
6526                 if {[info exists dl($y)]} {
6527                     if {$dl($y)} {
6528                         if {!$dl($x)} {
6529                             set dl($y) 0
6530                             if {![info exists done($y)]} {
6531                                 incr nnh -1
6532                             }
6533                             if {[info exists growanc($x)]} {
6534                                 incr ngrowanc -1
6535                             }
6536                             set xl [list $y]
6537                             for {set k 0} {$k < [llength $xl]} {incr k} {
6538                                 set z [lindex $xl $k]
6539                                 foreach c $arcout($z) {
6540                                     if {[info exists arcend($c)]} {
6541                                         set v $arcend($c)
6542                                         if {[info exists dl($v)] && $dl($v)} {
6543                                             set dl($v) 0
6544                                             if {![info exists done($v)]} {
6545                                                 incr nnh -1
6546                                             }
6547                                             if {[info exists growanc($v)]} {
6548                                                 incr ngrowanc -1
6549                                             }
6550                                             lappend xl $v
6551                                         }
6552                                     }
6553                                 }
6554                             }
6555                         }
6556                     }
6557                 } elseif {$y eq $anc || !$dl($x)} {
6558                     set dl($y) 0
6559                     lappend anclist $y
6560                 } else {
6561                     set dl($y) 1
6562                     lappend anclist $y
6563                     incr nnh
6564                 }
6565             }
6566         }
6567     }
6568     foreach x [array names growanc] {
6569         if {$dl($x)} {
6570             return 0
6571         }
6572         return 0
6573     }
6574     return 1
6575 }
6576
6577 proc validate_arctags {a} {
6578     global arctags idtags
6579
6580     set i -1
6581     set na $arctags($a)
6582     foreach id $arctags($a) {
6583         incr i
6584         if {![info exists idtags($id)]} {
6585             set na [lreplace $na $i $i]
6586             incr i -1
6587         }
6588     }
6589     set arctags($a) $na
6590 }
6591
6592 proc validate_archeads {a} {
6593     global archeads idheads
6594
6595     set i -1
6596     set na $archeads($a)
6597     foreach id $archeads($a) {
6598         incr i
6599         if {![info exists idheads($id)]} {
6600             set na [lreplace $na $i $i]
6601             incr i -1
6602         }
6603     }
6604     set archeads($a) $na
6605 }
6606
6607 # Return the list of IDs that have tags that are descendents of id,
6608 # ignoring IDs that are descendents of IDs already reported.
6609 proc desctags {id} {
6610     global arcnos arcstart arcids arctags idtags allparents
6611     global growing cached_dtags
6612
6613     if {![info exists allparents($id)]} {
6614         return {}
6615     }
6616     set t1 [clock clicks -milliseconds]
6617     set argid $id
6618     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6619         # part-way along an arc; check that arc first
6620         set a [lindex $arcnos($id) 0]
6621         if {$arctags($a) ne {}} {
6622             validate_arctags $a
6623             set i [lsearch -exact $arcids($a) $id]
6624             set tid {}
6625             foreach t $arctags($a) {
6626                 set j [lsearch -exact $arcids($a) $t]
6627                 if {$j >= $i} break
6628                 set tid $t
6629             }
6630             if {$tid ne {}} {
6631                 return $tid
6632             }
6633         }
6634         set id $arcstart($a)
6635         if {[info exists idtags($id)]} {
6636             return $id
6637         }
6638     }
6639     if {[info exists cached_dtags($id)]} {
6640         return $cached_dtags($id)
6641     }
6642
6643     set origid $id
6644     set todo [list $id]
6645     set queued($id) 1
6646     set nc 1
6647     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6648         set id [lindex $todo $i]
6649         set done($id) 1
6650         set ta [info exists hastaggedancestor($id)]
6651         if {!$ta} {
6652             incr nc -1
6653         }
6654         # ignore tags on starting node
6655         if {!$ta && $i > 0} {
6656             if {[info exists idtags($id)]} {
6657                 set tagloc($id) $id
6658                 set ta 1
6659             } elseif {[info exists cached_dtags($id)]} {
6660                 set tagloc($id) $cached_dtags($id)
6661                 set ta 1
6662             }
6663         }
6664         foreach a $arcnos($id) {
6665             set d $arcstart($a)
6666             if {!$ta && $arctags($a) ne {}} {
6667                 validate_arctags $a
6668                 if {$arctags($a) ne {}} {
6669                     lappend tagloc($id) [lindex $arctags($a) end]
6670                 }
6671             }
6672             if {$ta || $arctags($a) ne {}} {
6673                 set tomark [list $d]
6674                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6675                     set dd [lindex $tomark $j]
6676                     if {![info exists hastaggedancestor($dd)]} {
6677                         if {[info exists done($dd)]} {
6678                             foreach b $arcnos($dd) {
6679                                 lappend tomark $arcstart($b)
6680                             }
6681                             if {[info exists tagloc($dd)]} {
6682                                 unset tagloc($dd)
6683                             }
6684                         } elseif {[info exists queued($dd)]} {
6685                             incr nc -1
6686                         }
6687                         set hastaggedancestor($dd) 1
6688                     }
6689                 }
6690             }
6691             if {![info exists queued($d)]} {
6692                 lappend todo $d
6693                 set queued($d) 1
6694                 if {![info exists hastaggedancestor($d)]} {
6695                     incr nc
6696                 }
6697             }
6698         }
6699     }
6700     set tags {}
6701     foreach id [array names tagloc] {
6702         if {![info exists hastaggedancestor($id)]} {
6703             foreach t $tagloc($id) {
6704                 if {[lsearch -exact $tags $t] < 0} {
6705                     lappend tags $t
6706                 }
6707             }
6708         }
6709     }
6710     set t2 [clock clicks -milliseconds]
6711     set loopix $i
6712
6713     # remove tags that are descendents of other tags
6714     for {set i 0} {$i < [llength $tags]} {incr i} {
6715         set a [lindex $tags $i]
6716         for {set j 0} {$j < $i} {incr j} {
6717             set b [lindex $tags $j]
6718             set r [anc_or_desc $a $b]
6719             if {$r == 1} {
6720                 set tags [lreplace $tags $j $j]
6721                 incr j -1
6722                 incr i -1
6723             } elseif {$r == -1} {
6724                 set tags [lreplace $tags $i $i]
6725                 incr i -1
6726                 break
6727             }
6728         }
6729     }
6730
6731     if {[array names growing] ne {}} {
6732         # graph isn't finished, need to check if any tag could get
6733         # eclipsed by another tag coming later.  Simply ignore any
6734         # tags that could later get eclipsed.
6735         set ctags {}
6736         foreach t $tags {
6737             if {[is_certain $t $origid]} {
6738                 lappend ctags $t
6739             }
6740         }
6741         if {$tags eq $ctags} {
6742             set cached_dtags($origid) $tags
6743         } else {
6744             set tags $ctags
6745         }
6746     } else {
6747         set cached_dtags($origid) $tags
6748     }
6749     set t3 [clock clicks -milliseconds]
6750     if {0 && $t3 - $t1 >= 100} {
6751         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6752             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6753     }
6754     return $tags
6755 }
6756
6757 proc anctags {id} {
6758     global arcnos arcids arcout arcend arctags idtags allparents
6759     global growing cached_atags
6760
6761     if {![info exists allparents($id)]} {
6762         return {}
6763     }
6764     set t1 [clock clicks -milliseconds]
6765     set argid $id
6766     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6767         # part-way along an arc; check that arc first
6768         set a [lindex $arcnos($id) 0]
6769         if {$arctags($a) ne {}} {
6770             validate_arctags $a
6771             set i [lsearch -exact $arcids($a) $id]
6772             foreach t $arctags($a) {
6773                 set j [lsearch -exact $arcids($a) $t]
6774                 if {$j > $i} {
6775                     return $t
6776                 }
6777             }
6778         }
6779         if {![info exists arcend($a)]} {
6780             return {}
6781         }
6782         set id $arcend($a)
6783         if {[info exists idtags($id)]} {
6784             return $id
6785         }
6786     }
6787     if {[info exists cached_atags($id)]} {
6788         return $cached_atags($id)
6789     }
6790
6791     set origid $id
6792     set todo [list $id]
6793     set queued($id) 1
6794     set taglist {}
6795     set nc 1
6796     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6797         set id [lindex $todo $i]
6798         set done($id) 1
6799         set td [info exists hastaggeddescendent($id)]
6800         if {!$td} {
6801             incr nc -1
6802         }
6803         # ignore tags on starting node
6804         if {!$td && $i > 0} {
6805             if {[info exists idtags($id)]} {
6806                 set tagloc($id) $id
6807                 set td 1
6808             } elseif {[info exists cached_atags($id)]} {
6809                 set tagloc($id) $cached_atags($id)
6810                 set td 1
6811             }
6812         }
6813         foreach a $arcout($id) {
6814             if {!$td && $arctags($a) ne {}} {
6815                 validate_arctags $a
6816                 if {$arctags($a) ne {}} {
6817                     lappend tagloc($id) [lindex $arctags($a) 0]
6818                 }
6819             }
6820             if {![info exists arcend($a)]} continue
6821             set d $arcend($a)
6822             if {$td || $arctags($a) ne {}} {
6823                 set tomark [list $d]
6824                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6825                     set dd [lindex $tomark $j]
6826                     if {![info exists hastaggeddescendent($dd)]} {
6827                         if {[info exists done($dd)]} {
6828                             foreach b $arcout($dd) {
6829                                 if {[info exists arcend($b)]} {
6830                                     lappend tomark $arcend($b)
6831                                 }
6832                             }
6833                             if {[info exists tagloc($dd)]} {
6834                                 unset tagloc($dd)
6835                             }
6836                         } elseif {[info exists queued($dd)]} {
6837                             incr nc -1
6838                         }
6839                         set hastaggeddescendent($dd) 1
6840                     }
6841                 }
6842             }
6843             if {![info exists queued($d)]} {
6844                 lappend todo $d
6845                 set queued($d) 1
6846                 if {![info exists hastaggeddescendent($d)]} {
6847                     incr nc
6848                 }
6849             }
6850         }
6851     }
6852     set t2 [clock clicks -milliseconds]
6853     set loopix $i
6854     set tags {}
6855     foreach id [array names tagloc] {
6856         if {![info exists hastaggeddescendent($id)]} {
6857             foreach t $tagloc($id) {
6858                 if {[lsearch -exact $tags $t] < 0} {
6859                     lappend tags $t
6860                 }
6861             }
6862         }
6863     }
6864
6865     # remove tags that are ancestors of other tags
6866     for {set i 0} {$i < [llength $tags]} {incr i} {
6867         set a [lindex $tags $i]
6868         for {set j 0} {$j < $i} {incr j} {
6869             set b [lindex $tags $j]
6870             set r [anc_or_desc $a $b]
6871             if {$r == -1} {
6872                 set tags [lreplace $tags $j $j]
6873                 incr j -1
6874                 incr i -1
6875             } elseif {$r == 1} {
6876                 set tags [lreplace $tags $i $i]
6877                 incr i -1
6878                 break
6879             }
6880         }
6881     }
6882
6883     if {[array names growing] ne {}} {
6884         # graph isn't finished, need to check if any tag could get
6885         # eclipsed by another tag coming later.  Simply ignore any
6886         # tags that could later get eclipsed.
6887         set ctags {}
6888         foreach t $tags {
6889             if {[is_certain $origid $t]} {
6890                 lappend ctags $t
6891             }
6892         }
6893         if {$tags eq $ctags} {
6894             set cached_atags($origid) $tags
6895         } else {
6896             set tags $ctags
6897         }
6898     } else {
6899         set cached_atags($origid) $tags
6900     }
6901     set t3 [clock clicks -milliseconds]
6902     if {0 && $t3 - $t1 >= 100} {
6903         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6904             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6905     }
6906     return $tags
6907 }
6908
6909 # Return the list of IDs that have heads that are descendents of id,
6910 # including id itself if it has a head.
6911 proc descheads {id} {
6912     global arcnos arcstart arcids archeads idheads cached_dheads
6913     global allparents
6914
6915     if {![info exists allparents($id)]} {
6916         return {}
6917     }
6918     set aret {}
6919     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6920         # part-way along an arc; check it first
6921         set a [lindex $arcnos($id) 0]
6922         if {$archeads($a) ne {}} {
6923             validate_archeads $a
6924             set i [lsearch -exact $arcids($a) $id]
6925             foreach t $archeads($a) {
6926                 set j [lsearch -exact $arcids($a) $t]
6927                 if {$j > $i} break
6928                 lappend aret $t
6929             }
6930         }
6931         set id $arcstart($a)
6932     }
6933     set origid $id
6934     set todo [list $id]
6935     set seen($id) 1
6936     set ret {}
6937     for {set i 0} {$i < [llength $todo]} {incr i} {
6938         set id [lindex $todo $i]
6939         if {[info exists cached_dheads($id)]} {
6940             set ret [concat $ret $cached_dheads($id)]
6941         } else {
6942             if {[info exists idheads($id)]} {
6943                 lappend ret $id
6944             }
6945             foreach a $arcnos($id) {
6946                 if {$archeads($a) ne {}} {
6947                     validate_archeads $a
6948                     if {$archeads($a) ne {}} {
6949                         set ret [concat $ret $archeads($a)]
6950                     }
6951                 }
6952                 set d $arcstart($a)
6953                 if {![info exists seen($d)]} {
6954                     lappend todo $d
6955                     set seen($d) 1
6956                 }
6957             }
6958         }
6959     }
6960     set ret [lsort -unique $ret]
6961     set cached_dheads($origid) $ret
6962     return [concat $ret $aret]
6963 }
6964
6965 proc addedtag {id} {
6966     global arcnos arcout cached_dtags cached_atags
6967
6968     if {![info exists arcnos($id)]} return
6969     if {![info exists arcout($id)]} {
6970         recalcarc [lindex $arcnos($id) 0]
6971     }
6972     catch {unset cached_dtags}
6973     catch {unset cached_atags}
6974 }
6975
6976 proc addedhead {hid head} {
6977     global arcnos arcout cached_dheads
6978
6979     if {![info exists arcnos($hid)]} return
6980     if {![info exists arcout($hid)]} {
6981         recalcarc [lindex $arcnos($hid) 0]
6982     }
6983     catch {unset cached_dheads}
6984 }
6985
6986 proc removedhead {hid head} {
6987     global cached_dheads
6988
6989     catch {unset cached_dheads}
6990 }
6991
6992 proc movedhead {hid head} {
6993     global arcnos arcout cached_dheads
6994
6995     if {![info exists arcnos($hid)]} return
6996     if {![info exists arcout($hid)]} {
6997         recalcarc [lindex $arcnos($hid) 0]
6998     }
6999     catch {unset cached_dheads}
7000 }
7001
7002 proc changedrefs {} {
7003     global cached_dheads cached_dtags cached_atags
7004     global arctags archeads arcnos arcout idheads idtags
7005
7006     foreach id [concat [array names idheads] [array names idtags]] {
7007         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7008             set a [lindex $arcnos($id) 0]
7009             if {![info exists donearc($a)]} {
7010                 recalcarc $a
7011                 set donearc($a) 1
7012             }
7013         }
7014     }
7015     catch {unset cached_dtags}
7016     catch {unset cached_atags}
7017     catch {unset cached_dheads}
7018 }
7019
7020 proc rereadrefs {} {
7021     global idtags idheads idotherrefs mainhead
7022
7023     set refids [concat [array names idtags] \
7024                     [array names idheads] [array names idotherrefs]]
7025     foreach id $refids {
7026         if {![info exists ref($id)]} {
7027             set ref($id) [listrefs $id]
7028         }
7029     }
7030     set oldmainhead $mainhead
7031     readrefs
7032     changedrefs
7033     set refids [lsort -unique [concat $refids [array names idtags] \
7034                         [array names idheads] [array names idotherrefs]]]
7035     foreach id $refids {
7036         set v [listrefs $id]
7037         if {![info exists ref($id)] || $ref($id) != $v ||
7038             ($id eq $oldmainhead && $id ne $mainhead) ||
7039             ($id eq $mainhead && $id ne $oldmainhead)} {
7040             redrawtags $id
7041         }
7042     }
7043 }
7044
7045 proc listrefs {id} {
7046     global idtags idheads idotherrefs
7047
7048     set x {}
7049     if {[info exists idtags($id)]} {
7050         set x $idtags($id)
7051     }
7052     set y {}
7053     if {[info exists idheads($id)]} {
7054         set y $idheads($id)
7055     }
7056     set z {}
7057     if {[info exists idotherrefs($id)]} {
7058         set z $idotherrefs($id)
7059     }
7060     return [list $x $y $z]
7061 }
7062
7063 proc showtag {tag isnew} {
7064     global ctext tagcontents tagids linknum tagobjid
7065
7066     if {$isnew} {
7067         addtohistory [list showtag $tag 0]
7068     }
7069     $ctext conf -state normal
7070     clear_ctext
7071     set linknum 0
7072     if {![info exists tagcontents($tag)]} {
7073         catch {
7074             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7075         }
7076     }
7077     if {[info exists tagcontents($tag)]} {
7078         set text $tagcontents($tag)
7079     } else {
7080         set text "Tag: $tag\nId:  $tagids($tag)"
7081     }
7082     appendwithlinks $text {}
7083     $ctext conf -state disabled
7084     init_flist {}
7085 }
7086
7087 proc doquit {} {
7088     global stopped
7089     set stopped 100
7090     savestuff .
7091     destroy .
7092 }
7093
7094 proc doprefs {} {
7095     global maxwidth maxgraphpct diffopts
7096     global oldprefs prefstop showneartags showlocalchanges
7097     global bgcolor fgcolor ctext diffcolors selectbgcolor
7098     global uifont tabstop
7099
7100     set top .gitkprefs
7101     set prefstop $top
7102     if {[winfo exists $top]} {
7103         raise $top
7104         return
7105     }
7106     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7107         set oldprefs($v) [set $v]
7108     }
7109     toplevel $top
7110     wm title $top "Gitk preferences"
7111     label $top.ldisp -text "Commit list display options"
7112     $top.ldisp configure -font $uifont
7113     grid $top.ldisp - -sticky w -pady 10
7114     label $top.spacer -text " "
7115     label $top.maxwidthl -text "Maximum graph width (lines)" \
7116         -font optionfont
7117     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7118     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7119     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7120         -font optionfont
7121     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7122     grid x $top.maxpctl $top.maxpct -sticky w
7123     frame $top.showlocal
7124     label $top.showlocal.l -text "Show local changes" -font optionfont
7125     checkbutton $top.showlocal.b -variable showlocalchanges
7126     pack $top.showlocal.b $top.showlocal.l -side left
7127     grid x $top.showlocal -sticky w
7128
7129     label $top.ddisp -text "Diff display options"
7130     $top.ddisp configure -font $uifont
7131     grid $top.ddisp - -sticky w -pady 10
7132     label $top.diffoptl -text "Options for diff program" \
7133         -font optionfont
7134     entry $top.diffopt -width 20 -textvariable diffopts
7135     grid x $top.diffoptl $top.diffopt -sticky w
7136     frame $top.ntag
7137     label $top.ntag.l -text "Display nearby tags" -font optionfont
7138     checkbutton $top.ntag.b -variable showneartags
7139     pack $top.ntag.b $top.ntag.l -side left
7140     grid x $top.ntag -sticky w
7141     label $top.tabstopl -text "tabstop" -font optionfont
7142     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7143     grid x $top.tabstopl $top.tabstop -sticky w
7144
7145     label $top.cdisp -text "Colors: press to choose"
7146     $top.cdisp configure -font $uifont
7147     grid $top.cdisp - -sticky w -pady 10
7148     label $top.bg -padx 40 -relief sunk -background $bgcolor
7149     button $top.bgbut -text "Background" -font optionfont \
7150         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7151     grid x $top.bgbut $top.bg -sticky w
7152     label $top.fg -padx 40 -relief sunk -background $fgcolor
7153     button $top.fgbut -text "Foreground" -font optionfont \
7154         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7155     grid x $top.fgbut $top.fg -sticky w
7156     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7157     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7158         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7159                       [list $ctext tag conf d0 -foreground]]
7160     grid x $top.diffoldbut $top.diffold -sticky w
7161     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7162     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7163         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7164                       [list $ctext tag conf d1 -foreground]]
7165     grid x $top.diffnewbut $top.diffnew -sticky w
7166     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7167     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7168         -command [list choosecolor diffcolors 2 $top.hunksep \
7169                       "diff hunk header" \
7170                       [list $ctext tag conf hunksep -foreground]]
7171     grid x $top.hunksepbut $top.hunksep -sticky w
7172     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7173     button $top.selbgbut -text "Select bg" -font optionfont \
7174         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7175     grid x $top.selbgbut $top.selbgsep -sticky w
7176
7177     frame $top.buts
7178     button $top.buts.ok -text "OK" -command prefsok -default active
7179     $top.buts.ok configure -font $uifont
7180     button $top.buts.can -text "Cancel" -command prefscan -default normal
7181     $top.buts.can configure -font $uifont
7182     grid $top.buts.ok $top.buts.can
7183     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7184     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7185     grid $top.buts - - -pady 10 -sticky ew
7186     bind $top <Visibility> "focus $top.buts.ok"
7187 }
7188
7189 proc choosecolor {v vi w x cmd} {
7190     global $v
7191
7192     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7193                -title "Gitk: choose color for $x"]
7194     if {$c eq {}} return
7195     $w conf -background $c
7196     lset $v $vi $c
7197     eval $cmd $c
7198 }
7199
7200 proc setselbg {c} {
7201     global bglist cflist
7202     foreach w $bglist {
7203         $w configure -selectbackground $c
7204     }
7205     $cflist tag configure highlight \
7206         -background [$cflist cget -selectbackground]
7207     allcanvs itemconf secsel -fill $c
7208 }
7209
7210 proc setbg {c} {
7211     global bglist
7212
7213     foreach w $bglist {
7214         $w conf -background $c
7215     }
7216 }
7217
7218 proc setfg {c} {
7219     global fglist canv
7220
7221     foreach w $fglist {
7222         $w conf -foreground $c
7223     }
7224     allcanvs itemconf text -fill $c
7225     $canv itemconf circle -outline $c
7226 }
7227
7228 proc prefscan {} {
7229     global maxwidth maxgraphpct diffopts
7230     global oldprefs prefstop showneartags showlocalchanges
7231
7232     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7233         set $v $oldprefs($v)
7234     }
7235     catch {destroy $prefstop}
7236     unset prefstop
7237 }
7238
7239 proc prefsok {} {
7240     global maxwidth maxgraphpct
7241     global oldprefs prefstop showneartags showlocalchanges
7242     global charspc ctext tabstop
7243
7244     catch {destroy $prefstop}
7245     unset prefstop
7246     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7247     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7248         if {$showlocalchanges} {
7249             doshowlocalchanges
7250         } else {
7251             dohidelocalchanges
7252         }
7253     }
7254     if {$maxwidth != $oldprefs(maxwidth)
7255         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7256         redisplay
7257     } elseif {$showneartags != $oldprefs(showneartags)} {
7258         reselectline
7259     }
7260 }
7261
7262 proc formatdate {d} {
7263     if {$d ne {}} {
7264         set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7265     }
7266     return $d
7267 }
7268
7269 # This list of encoding names and aliases is distilled from
7270 # http://www.iana.org/assignments/character-sets.
7271 # Not all of them are supported by Tcl.
7272 set encoding_aliases {
7273     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7274       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7275     { ISO-10646-UTF-1 csISO10646UTF1 }
7276     { ISO_646.basic:1983 ref csISO646basic1983 }
7277     { INVARIANT csINVARIANT }
7278     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7279     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7280     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7281     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7282     { NATS-DANO iso-ir-9-1 csNATSDANO }
7283     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7284     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7285     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7286     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7287     { ISO-2022-KR csISO2022KR }
7288     { EUC-KR csEUCKR }
7289     { ISO-2022-JP csISO2022JP }
7290     { ISO-2022-JP-2 csISO2022JP2 }
7291     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7292       csISO13JISC6220jp }
7293     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7294     { IT iso-ir-15 ISO646-IT csISO15Italian }
7295     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7296     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7297     { greek7-old iso-ir-18 csISO18Greek7Old }
7298     { latin-greek iso-ir-19 csISO19LatinGreek }
7299     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7300     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7301     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7302     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7303     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7304     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7305     { INIS iso-ir-49 csISO49INIS }
7306     { INIS-8 iso-ir-50 csISO50INIS8 }
7307     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7308     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7309     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7310     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7311     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7312     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7313       csISO60Norwegian1 }
7314     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7315     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7316     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7317     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7318     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7319     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7320     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7321     { greek7 iso-ir-88 csISO88Greek7 }
7322     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7323     { iso-ir-90 csISO90 }
7324     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7325     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7326       csISO92JISC62991984b }
7327     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7328     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7329     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7330       csISO95JIS62291984handadd }
7331     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7332     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7333     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7334     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7335       CP819 csISOLatin1 }
7336     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7337     { T.61-7bit iso-ir-102 csISO102T617bit }
7338     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7339     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7340     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7341     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7342     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7343     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7344     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7345     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7346       arabic csISOLatinArabic }
7347     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7348     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7349     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7350       greek greek8 csISOLatinGreek }
7351     { T.101-G2 iso-ir-128 csISO128T101G2 }
7352     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7353       csISOLatinHebrew }
7354     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7355     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7356     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7357     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7358     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7359     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7360     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7361       csISOLatinCyrillic }
7362     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7363     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7364     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7365     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7366     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7367     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7368     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7369     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7370     { ISO_10367-box iso-ir-155 csISO10367Box }
7371     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7372     { latin-lap lap iso-ir-158 csISO158Lap }
7373     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7374     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7375     { us-dk csUSDK }
7376     { dk-us csDKUS }
7377     { JIS_X0201 X0201 csHalfWidthKatakana }
7378     { KSC5636 ISO646-KR csKSC5636 }
7379     { ISO-10646-UCS-2 csUnicode }
7380     { ISO-10646-UCS-4 csUCS4 }
7381     { DEC-MCS dec csDECMCS }
7382     { hp-roman8 roman8 r8 csHPRoman8 }
7383     { macintosh mac csMacintosh }
7384     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7385       csIBM037 }
7386     { IBM038 EBCDIC-INT cp038 csIBM038 }
7387     { IBM273 CP273 csIBM273 }
7388     { IBM274 EBCDIC-BE CP274 csIBM274 }
7389     { IBM275 EBCDIC-BR cp275 csIBM275 }
7390     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7391     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7392     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7393     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7394     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7395     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7396     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7397     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7398     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7399     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7400     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7401     { IBM437 cp437 437 csPC8CodePage437 }
7402     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7403     { IBM775 cp775 csPC775Baltic }
7404     { IBM850 cp850 850 csPC850Multilingual }
7405     { IBM851 cp851 851 csIBM851 }
7406     { IBM852 cp852 852 csPCp852 }
7407     { IBM855 cp855 855 csIBM855 }
7408     { IBM857 cp857 857 csIBM857 }
7409     { IBM860 cp860 860 csIBM860 }
7410     { IBM861 cp861 861 cp-is csIBM861 }
7411     { IBM862 cp862 862 csPC862LatinHebrew }
7412     { IBM863 cp863 863 csIBM863 }
7413     { IBM864 cp864 csIBM864 }
7414     { IBM865 cp865 865 csIBM865 }
7415     { IBM866 cp866 866 csIBM866 }
7416     { IBM868 CP868 cp-ar csIBM868 }
7417     { IBM869 cp869 869 cp-gr csIBM869 }
7418     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7419     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7420     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7421     { IBM891 cp891 csIBM891 }
7422     { IBM903 cp903 csIBM903 }
7423     { IBM904 cp904 904 csIBBM904 }
7424     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7425     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7426     { IBM1026 CP1026 csIBM1026 }
7427     { EBCDIC-AT-DE csIBMEBCDICATDE }
7428     { EBCDIC-AT-DE-A csEBCDICATDEA }
7429     { EBCDIC-CA-FR csEBCDICCAFR }
7430     { EBCDIC-DK-NO csEBCDICDKNO }
7431     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7432     { EBCDIC-FI-SE csEBCDICFISE }
7433     { EBCDIC-FI-SE-A csEBCDICFISEA }
7434     { EBCDIC-FR csEBCDICFR }
7435     { EBCDIC-IT csEBCDICIT }
7436     { EBCDIC-PT csEBCDICPT }
7437     { EBCDIC-ES csEBCDICES }
7438     { EBCDIC-ES-A csEBCDICESA }
7439     { EBCDIC-ES-S csEBCDICESS }
7440     { EBCDIC-UK csEBCDICUK }
7441     { EBCDIC-US csEBCDICUS }
7442     { UNKNOWN-8BIT csUnknown8BiT }
7443     { MNEMONIC csMnemonic }
7444     { MNEM csMnem }
7445     { VISCII csVISCII }
7446     { VIQR csVIQR }
7447     { KOI8-R csKOI8R }
7448     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7449     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7450     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7451     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7452     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7453     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7454     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7455     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7456     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7457     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7458     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7459     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7460     { IBM1047 IBM-1047 }
7461     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7462     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7463     { UNICODE-1-1 csUnicode11 }
7464     { CESU-8 csCESU-8 }
7465     { BOCU-1 csBOCU-1 }
7466     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7467     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7468       l8 }
7469     { ISO-8859-15 ISO_8859-15 Latin-9 }
7470     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7471     { GBK CP936 MS936 windows-936 }
7472     { JIS_Encoding csJISEncoding }
7473     { Shift_JIS MS_Kanji csShiftJIS }
7474     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7475       EUC-JP }
7476     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7477     { ISO-10646-UCS-Basic csUnicodeASCII }
7478     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7479     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7480     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7481     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7482     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7483     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7484     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7485     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7486     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7487     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7488     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7489     { Ventura-US csVenturaUS }
7490     { Ventura-International csVenturaInternational }
7491     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7492     { PC8-Turkish csPC8Turkish }
7493     { IBM-Symbols csIBMSymbols }
7494     { IBM-Thai csIBMThai }
7495     { HP-Legal csHPLegal }
7496     { HP-Pi-font csHPPiFont }
7497     { HP-Math8 csHPMath8 }
7498     { Adobe-Symbol-Encoding csHPPSMath }
7499     { HP-DeskTop csHPDesktop }
7500     { Ventura-Math csVenturaMath }
7501     { Microsoft-Publishing csMicrosoftPublishing }
7502     { Windows-31J csWindows31J }
7503     { GB2312 csGB2312 }
7504     { Big5 csBig5 }
7505 }
7506
7507 proc tcl_encoding {enc} {
7508     global encoding_aliases
7509     set names [encoding names]
7510     set lcnames [string tolower $names]
7511     set enc [string tolower $enc]
7512     set i [lsearch -exact $lcnames $enc]
7513     if {$i < 0} {
7514         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7515         if {[regsub {^iso[-_]} $enc iso encx]} {
7516             set i [lsearch -exact $lcnames $encx]
7517         }
7518     }
7519     if {$i < 0} {
7520         foreach l $encoding_aliases {
7521             set ll [string tolower $l]
7522             if {[lsearch -exact $ll $enc] < 0} continue
7523             # look through the aliases for one that tcl knows about
7524             foreach e $ll {
7525                 set i [lsearch -exact $lcnames $e]
7526                 if {$i < 0} {
7527                     if {[regsub {^iso[-_]} $e iso ex]} {
7528                         set i [lsearch -exact $lcnames $ex]
7529                     }
7530                 }
7531                 if {$i >= 0} break
7532             }
7533             break
7534         }
7535     }
7536     if {$i >= 0} {
7537         return [lindex $names $i]
7538     }
7539     return {}
7540 }
7541
7542 # defaults...
7543 set datemode 0
7544 set diffopts "-U 5 -p"
7545 set wrcomcmd "git diff-tree --stdin -p --pretty"
7546
7547 set gitencoding {}
7548 catch {
7549     set gitencoding [exec git config --get i18n.commitencoding]
7550 }
7551 if {$gitencoding == ""} {
7552     set gitencoding "utf-8"
7553 }
7554 set tclencoding [tcl_encoding $gitencoding]
7555 if {$tclencoding == {}} {
7556     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7557 }
7558
7559 set mainfont {Helvetica 9}
7560 set textfont {Courier 9}
7561 set uifont {Helvetica 9 bold}
7562 set tabstop 8
7563 set findmergefiles 0
7564 set maxgraphpct 50
7565 set maxwidth 16
7566 set revlistorder 0
7567 set fastdate 0
7568 set uparrowlen 5
7569 set downarrowlen 5
7570 set mingaplen 100
7571 set cmitmode "patch"
7572 set wrapcomment "none"
7573 set showneartags 1
7574 set maxrefs 20
7575 set maxlinelen 200
7576 set showlocalchanges 1
7577
7578 set colors {green red blue magenta darkgrey brown orange}
7579 set bgcolor white
7580 set fgcolor black
7581 set diffcolors {red "#00a000" blue}
7582 set selectbgcolor gray85
7583
7584 catch {source ~/.gitk}
7585
7586 font create optionfont -family sans-serif -size -12
7587
7588 # check that we can find a .git directory somewhere...
7589 if {[catch {set gitdir [gitdir]}]} {
7590     show_error {} . "Cannot find a git repository here."
7591     exit 1
7592 }
7593 if {![file isdirectory $gitdir]} {
7594     show_error {} . "Cannot find the git directory \"$gitdir\"."
7595     exit 1
7596 }
7597
7598 set revtreeargs {}
7599 set cmdline_files {}
7600 set i 0
7601 foreach arg $argv {
7602     switch -- $arg {
7603         "" { }
7604         "-d" { set datemode 1 }
7605         "--" {
7606             set cmdline_files [lrange $argv [expr {$i + 1}] end]
7607             break
7608         }
7609         default {
7610             lappend revtreeargs $arg
7611         }
7612     }
7613     incr i
7614 }
7615
7616 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7617     # no -- on command line, but some arguments (other than -d)
7618     if {[catch {
7619         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7620         set cmdline_files [split $f "\n"]
7621         set n [llength $cmdline_files]
7622         set revtreeargs [lrange $revtreeargs 0 end-$n]
7623         # Unfortunately git rev-parse doesn't produce an error when
7624         # something is both a revision and a filename.  To be consistent
7625         # with git log and git rev-list, check revtreeargs for filenames.
7626         foreach arg $revtreeargs {
7627             if {[file exists $arg]} {
7628                 show_error {} . "Ambiguous argument '$arg': both revision\
7629                                  and filename"
7630                 exit 1
7631             }
7632         }
7633     } err]} {
7634         # unfortunately we get both stdout and stderr in $err,
7635         # so look for "fatal:".
7636         set i [string first "fatal:" $err]
7637         if {$i > 0} {
7638             set err [string range $err [expr {$i + 6}] end]
7639         }
7640         show_error {} . "Bad arguments to gitk:\n$err"
7641         exit 1
7642     }
7643 }
7644
7645 set nullid "0000000000000000000000000000000000000000"
7646 set nullid2 "0000000000000000000000000000000000000001"
7647
7648
7649 set runq {}
7650 set history {}
7651 set historyindex 0
7652 set fh_serial 0
7653 set nhl_names {}
7654 set highlight_paths {}
7655 set searchdirn -forwards
7656 set boldrows {}
7657 set boldnamerows {}
7658 set diffelide {0 0}
7659 set markingmatches 0
7660
7661 set optim_delay 16
7662
7663 set nextviewnum 1
7664 set curview 0
7665 set selectedview 0
7666 set selectedhlview None
7667 set viewfiles(0) {}
7668 set viewperm(0) 0
7669 set viewargs(0) {}
7670
7671 set cmdlineok 0
7672 set stopped 0
7673 set stuffsaved 0
7674 set patchnum 0
7675 set lookingforhead 0
7676 set localirow -1
7677 set localfrow -1
7678 set lserial 0
7679 setcoords
7680 makewindow
7681 # wait for the window to become visible
7682 tkwait visibility .
7683 wm title . "[file tail $argv0]: [file tail [pwd]]"
7684 readrefs
7685
7686 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7687     # create a view for the files/dirs specified on the command line
7688     set curview 1
7689     set selectedview 1
7690     set nextviewnum 2
7691     set viewname(1) "Command line"
7692     set viewfiles(1) $cmdline_files
7693     set viewargs(1) $revtreeargs
7694     set viewperm(1) 0
7695     addviewmenu 1
7696     .bar.view entryconf Edit* -state normal
7697     .bar.view entryconf Delete* -state normal
7698 }
7699
7700 if {[info exists permviews]} {
7701     foreach v $permviews {
7702         set n $nextviewnum
7703         incr nextviewnum
7704         set viewname($n) [lindex $v 0]
7705         set viewfiles($n) [lindex $v 1]
7706         set viewargs($n) [lindex $v 2]
7707         set viewperm($n) 1
7708         addviewmenu $n
7709     }
7710 }
7711 getcommits