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