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