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