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