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