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