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