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