gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2011 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 package require Tk
  11
  12 proc hasworktree {} {
  13     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                   [exec git rev-parse --is-inside-git-dir] == "false"}]
  15 }
  16
  17 # A simple scheduler for compute-intensive stuff.
  18 # The aim is to make sure that event handlers for GUI actions can
  19 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  20 # run before X event handlers, so reading from a fast source can
  21 # make the GUI completely unresponsive.
  22 proc run args {
  23     global isonrunq runq currunq
  24
  25     set script $args
  26     if {[info exists isonrunq($script)]} return
  27     if {$runq eq {} && ![info exists currunq]} {
  28         after idle dorunq
  29     }
  30     lappend runq [list {} $script]
  31     set isonrunq($script) 1
  32 }
  33
  34 proc filerun {fd script} {
  35     fileevent $fd readable [list filereadable $fd $script]
  36 }
  37
  38 proc filereadable {fd script} {
  39     global runq currunq
  40
  41     fileevent $fd readable {}
  42     if {$runq eq {} && ![info exists currunq]} {
  43         after idle dorunq
  44     }
  45     lappend runq [list $fd $script]
  46 }
  47
  48 proc nukefile {fd} {
  49     global runq
  50
  51     for {set i 0} {$i < [llength $runq]} {} {
  52         if {[lindex $runq $i 0] eq $fd} {
  53             set runq [lreplace $runq $i $i]
  54         } else {
  55             incr i
  56         }
  57     }
  58 }
  59
  60 proc dorunq {} {
  61     global isonrunq runq currunq
  62
  63     set tstart [clock clicks -milliseconds]
  64     set t0 $tstart
  65     while {[llength $runq] > 0} {
  66         set fd [lindex $runq 0 0]
  67         set script [lindex $runq 0 1]
  68         set currunq [lindex $runq 0]
  69         set runq [lrange $runq 1 end]
  70         set repeat [eval $script]
  71         unset currunq
  72         set t1 [clock clicks -milliseconds]
  73         set t [expr {$t1 - $t0}]
  74         if {$repeat ne {} && $repeat} {
  75             if {$fd eq {} || $repeat == 2} {
  76                 # script returns 1 if it wants to be readded
  77                 # file readers return 2 if they could do more straight away
  78                 lappend runq [list $fd $script]
  79             } else {
  80                 fileevent $fd readable [list filereadable $fd $script]
  81             }
  82         } elseif {$fd eq {}} {
  83             unset isonrunq($script)
  84         }
  85         set t0 $t1
  86         if {$t1 - $tstart >= 80} break
  87     }
  88     if {$runq ne {}} {
  89         after idle dorunq
  90     }
  91 }
  92
  93 proc reg_instance {fd} {
  94     global commfd leftover loginstance
  95
  96     set i [incr loginstance]
  97     set commfd($i) $fd
  98     set leftover($i) {}
  99     return $i
 100 }
 101
 102 proc unmerged_files {files} {
 103     global nr_unmerged
 104
 105     # find the list of unmerged files
 106     set mlist {}
 107     set nr_unmerged 0
 108     if {[catch {
 109         set fd [open "| git ls-files -u" r]
 110     } err]} {
 111         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 112         exit 1
 113     }
 114     while {[gets $fd line] >= 0} {
 115         set i [string first "\t" $line]
 116         if {$i < 0} continue
 117         set fname [string range $line [expr {$i+1}] end]
 118         if {[lsearch -exact $mlist $fname] >= 0} continue
 119         incr nr_unmerged
 120         if {$files eq {} || [path_filter $files $fname]} {
 121             lappend mlist $fname
 122         }
 123     }
 124     catch {close $fd}
 125     return $mlist
 126 }
 127
 128 proc parseviewargs {n arglist} {
 129     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 130     global worddiff git_version
 131
 132     set vdatemode($n) 0
 133     set vmergeonly($n) 0
 134     set glflags {}
 135     set diffargs {}
 136     set nextisval 0
 137     set revargs {}
 138     set origargs $arglist
 139     set allknown 1
 140     set filtered 0
 141     set i -1
 142     foreach arg $arglist {
 143         incr i
 144         if {$nextisval} {
 145             lappend glflags $arg
 146             set nextisval 0
 147             continue
 148         }
 149         switch -glob -- $arg {
 150             "-d" -
 151             "--date-order" {
 152                 set vdatemode($n) 1
 153                 # remove from origargs in case we hit an unknown option
 154                 set origargs [lreplace $origargs $i $i]
 155                 incr i -1
 156             }
 157             "-[puabwcrRBMC]" -
 158             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 159             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 160             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 161             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 162             "--ignore-space-change" - "-U*" - "--unified=*" {
 163                 # These request or affect diff output, which we don't want.
 164                 # Some could be used to set our defaults for diff display.
 165                 lappend diffargs $arg
 166             }
 167             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 168             "--name-only" - "--name-status" - "--color" -
 169             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 170             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 171             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 172             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 173             "--objects" - "--objects-edge" - "--reverse" {
 174                 # These cause our parsing of git log's output to fail, or else
 175                 # they're options we want to set ourselves, so ignore them.
 176             }
 177             "--color-words*" - "--word-diff=color" {
 178                 # These trigger a word diff in the console interface,
 179                 # so help the user by enabling our own support
 180                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 181                     set worddiff [mc "Color words"]
 182                 }
 183             }
 184             "--word-diff*" {
 185                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 186                     set worddiff [mc "Markup words"]
 187                 }
 188             }
 189             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 190             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 191             "--full-history" - "--dense" - "--sparse" -
 192             "--follow" - "--left-right" - "--encoding=*" {
 193                 # These are harmless, and some are even useful
 194                 lappend glflags $arg
 195             }
 196             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 197             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 198             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 199             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 200             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 201             "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
 202             "--simplify-by-decoration" {
 203                 # These mean that we get a subset of the commits
 204                 set filtered 1
 205                 lappend glflags $arg
 206             }
 207             "-n" {
 208                 # This appears to be the only one that has a value as a
 209                 # separate word following it
 210                 set filtered 1
 211                 set nextisval 1
 212                 lappend glflags $arg
 213             }
 214             "--not" - "--all" {
 215                 lappend revargs $arg
 216             }
 217             "--merge" {
 218                 set vmergeonly($n) 1
 219                 # git rev-parse doesn't understand --merge
 220                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 221             }
 222             "--no-replace-objects" {
 223                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 224             }
 225             "-*" {
 226                 # Other flag arguments including -<n>
 227                 if {[string is digit -strict [string range $arg 1 end]]} {
 228                     set filtered 1
 229                 } else {
 230                     # a flag argument that we don't recognize;
 231                     # that means we can't optimize
 232                     set allknown 0
 233                 }
 234                 lappend glflags $arg
 235             }
 236             default {
 237                 # Non-flag arguments specify commits or ranges of commits
 238                 if {[string match "*...*" $arg]} {
 239                     lappend revargs --gitk-symmetric-diff-marker
 240                 }
 241                 lappend revargs $arg
 242             }
 243         }
 244     }
 245     set vdflags($n) $diffargs
 246     set vflags($n) $glflags
 247     set vrevs($n) $revargs
 248     set vfiltered($n) $filtered
 249     set vorigargs($n) $origargs
 250     return $allknown
 251 }
 252
 253 proc parseviewrevs {view revs} {
 254     global vposids vnegids
 255
 256     if {$revs eq {}} {
 257         set revs HEAD
 258     }
 259     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 260         # we get stdout followed by stderr in $err
 261         # for an unknown rev, git rev-parse echoes it and then errors out
 262         set errlines [split $err "\n"]
 263         set badrev {}
 264         for {set l 0} {$l < [llength $errlines]} {incr l} {
 265             set line [lindex $errlines $l]
 266             if {!([string length $line] == 40 && [string is xdigit $line])} {
 267                 if {[string match "fatal:*" $line]} {
 268                     if {[string match "fatal: ambiguous argument*" $line]
 269                         && $badrev ne {}} {
 270                         if {[llength $badrev] == 1} {
 271                             set err "unknown revision $badrev"
 272                         } else {
 273                             set err "unknown revisions: [join $badrev ", "]"
 274                         }
 275                     } else {
 276                         set err [join [lrange $errlines $l end] "\n"]
 277                     }
 278                     break
 279                 }
 280                 lappend badrev $line
 281             }
 282         }
 283         error_popup "[mc "Error parsing revisions:"] $err"
 284         return {}
 285     }
 286     set ret {}
 287     set pos {}
 288     set neg {}
 289     set sdm 0
 290     foreach id [split $ids "\n"] {
 291         if {$id eq "--gitk-symmetric-diff-marker"} {
 292             set sdm 4
 293         } elseif {[string match "^*" $id]} {
 294             if {$sdm != 1} {
 295                 lappend ret $id
 296                 if {$sdm == 3} {
 297                     set sdm 0
 298                 }
 299             }
 300             lappend neg [string range $id 1 end]
 301         } else {
 302             if {$sdm != 2} {
 303                 lappend ret $id
 304             } else {
 305                 lset ret end $id...[lindex $ret end]
 306             }
 307             lappend pos $id
 308         }
 309         incr sdm -1
 310     }
 311     set vposids($view) $pos
 312     set vnegids($view) $neg
 313     return $ret
 314 }
 315
 316 # Start off a git log process and arrange to read its output
 317 proc start_rev_list {view} {
 318     global startmsecs commitidx viewcomplete curview
 319     global tclencoding
 320     global viewargs viewargscmd viewfiles vfilelimit
 321     global showlocalchanges
 322     global viewactive viewinstances vmergeonly
 323     global mainheadid viewmainheadid viewmainheadid_orig
 324     global vcanopt vflags vrevs vorigargs
 325     global show_notes
 326
 327     set startmsecs [clock clicks -milliseconds]
 328     set commitidx($view) 0
 329     # these are set this way for the error exits
 330     set viewcomplete($view) 1
 331     set viewactive($view) 0
 332     varcinit $view
 333
 334     set args $viewargs($view)
 335     if {$viewargscmd($view) ne {}} {
 336         if {[catch {
 337             set str [exec sh -c $viewargscmd($view)]
 338         } err]} {
 339             error_popup "[mc "Error executing --argscmd command:"] $err"
 340             return 0
 341         }
 342         set args [concat $args [split $str "\n"]]
 343     }
 344     set vcanopt($view) [parseviewargs $view $args]
 345
 346     set files $viewfiles($view)
 347     if {$vmergeonly($view)} {
 348         set files [unmerged_files $files]
 349         if {$files eq {}} {
 350             global nr_unmerged
 351             if {$nr_unmerged == 0} {
 352                 error_popup [mc "No files selected: --merge specified but\
 353                              no files are unmerged."]
 354             } else {
 355                 error_popup [mc "No files selected: --merge specified but\
 356                              no unmerged files are within file limit."]
 357             }
 358             return 0
 359         }
 360     }
 361     set vfilelimit($view) $files
 362
 363     if {$vcanopt($view)} {
 364         set revs [parseviewrevs $view $vrevs($view)]
 365         if {$revs eq {}} {
 366             return 0
 367         }
 368         set args [limit_arg_length [concat $vflags($view) $revs]]
 369     } else {
 370         set args $vorigargs($view)
 371     }
 372
 373     if {[catch {
 374         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 375                         --parents --boundary $args "--" $files] r]
 376     } err]} {
 377         error_popup "[mc "Error executing git log:"] $err"
 378         return 0
 379     }
 380     set i [reg_instance $fd]
 381     set viewinstances($view) [list $i]
 382     set viewmainheadid($view) $mainheadid
 383     set viewmainheadid_orig($view) $mainheadid
 384     if {$files ne {} && $mainheadid ne {}} {
 385         get_viewmainhead $view
 386     }
 387     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 388         interestedin $viewmainheadid($view) dodiffindex
 389     }
 390     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 391     if {$tclencoding != {}} {
 392         fconfigure $fd -encoding $tclencoding
 393     }
 394     filerun $fd [list getcommitlines $fd $i $view 0]
 395     nowbusy $view [mc "Reading"]
 396     set viewcomplete($view) 0
 397     set viewactive($view) 1
 398     return 1
 399 }
 400
 401 proc stop_instance {inst} {
 402     global commfd leftover
 403
 404     set fd $commfd($inst)
 405     catch {
 406         set pid [pid $fd]
 407
 408         if {$::tcl_platform(platform) eq {windows}} {
 409             exec kill -f $pid
 410         } else {
 411             exec kill $pid
 412         }
 413     }
 414     catch {close $fd}
 415     nukefile $fd
 416     unset commfd($inst)
 417     unset leftover($inst)
 418 }
 419
 420 proc stop_backends {} {
 421     global commfd
 422
 423     foreach inst [array names commfd] {
 424         stop_instance $inst
 425     }
 426 }
 427
 428 proc stop_rev_list {view} {
 429     global viewinstances
 430
 431     foreach inst $viewinstances($view) {
 432         stop_instance $inst
 433     }
 434     set viewinstances($view) {}
 435 }
 436
 437 proc reset_pending_select {selid} {
 438     global pending_select mainheadid selectheadid
 439
 440     if {$selid ne {}} {
 441         set pending_select $selid
 442     } elseif {$selectheadid ne {}} {
 443         set pending_select $selectheadid
 444     } else {
 445         set pending_select $mainheadid
 446     }
 447 }
 448
 449 proc getcommits {selid} {
 450     global canv curview need_redisplay viewactive
 451
 452     initlayout
 453     if {[start_rev_list $curview]} {
 454         reset_pending_select $selid
 455         show_status [mc "Reading commits..."]
 456         set need_redisplay 1
 457     } else {
 458         show_status [mc "No commits selected"]
 459     }
 460 }
 461
 462 proc updatecommits {} {
 463     global curview vcanopt vorigargs vfilelimit viewinstances
 464     global viewactive viewcomplete tclencoding
 465     global startmsecs showneartags showlocalchanges
 466     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 467     global hasworktree
 468     global varcid vposids vnegids vflags vrevs
 469     global show_notes
 470
 471     set hasworktree [hasworktree]
 472     rereadrefs
 473     set view $curview
 474     if {$mainheadid ne $viewmainheadid_orig($view)} {
 475         if {$showlocalchanges} {
 476             dohidelocalchanges
 477         }
 478         set viewmainheadid($view) $mainheadid
 479         set viewmainheadid_orig($view) $mainheadid
 480         if {$vfilelimit($view) ne {}} {
 481             get_viewmainhead $view
 482         }
 483     }
 484     if {$showlocalchanges} {
 485         doshowlocalchanges
 486     }
 487     if {$vcanopt($view)} {
 488         set oldpos $vposids($view)
 489         set oldneg $vnegids($view)
 490         set revs [parseviewrevs $view $vrevs($view)]
 491         if {$revs eq {}} {
 492             return
 493         }
 494         # note: getting the delta when negative refs change is hard,
 495         # and could require multiple git log invocations, so in that
 496         # case we ask git log for all the commits (not just the delta)
 497         if {$oldneg eq $vnegids($view)} {
 498             set newrevs {}
 499             set npos 0
 500             # take out positive refs that we asked for before or
 501             # that we have already seen
 502             foreach rev $revs {
 503                 if {[string length $rev] == 40} {
 504                     if {[lsearch -exact $oldpos $rev] < 0
 505                         && ![info exists varcid($view,$rev)]} {
 506                         lappend newrevs $rev
 507                         incr npos
 508                     }
 509                 } else {
 510                     lappend $newrevs $rev
 511                 }
 512             }
 513             if {$npos == 0} return
 514             set revs $newrevs
 515             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 516         }
 517         set args [concat $vflags($view) $revs --not $oldpos]
 518     } else {
 519         set args $vorigargs($view)
 520     }
 521     if {[catch {
 522         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 523                         --parents --boundary $args "--" $vfilelimit($view)] r]
 524     } err]} {
 525         error_popup "[mc "Error executing git log:"] $err"
 526         return
 527     }
 528     if {$viewactive($view) == 0} {
 529         set startmsecs [clock clicks -milliseconds]
 530     }
 531     set i [reg_instance $fd]
 532     lappend viewinstances($view) $i
 533     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 534     if {$tclencoding != {}} {
 535         fconfigure $fd -encoding $tclencoding
 536     }
 537     filerun $fd [list getcommitlines $fd $i $view 1]
 538     incr viewactive($view)
 539     set viewcomplete($view) 0
 540     reset_pending_select {}
 541     nowbusy $view [mc "Reading"]
 542     if {$showneartags} {
 543         getallcommits
 544     }
 545 }
 546
 547 proc reloadcommits {} {
 548     global curview viewcomplete selectedline currentid thickerline
 549     global showneartags treediffs commitinterest cached_commitrow
 550     global targetid
 551
 552     set selid {}
 553     if {$selectedline ne {}} {
 554         set selid $currentid
 555     }
 556
 557     if {!$viewcomplete($curview)} {
 558         stop_rev_list $curview
 559     }
 560     resetvarcs $curview
 561     set selectedline {}
 562     catch {unset currentid}
 563     catch {unset thickerline}
 564     catch {unset treediffs}
 565     readrefs
 566     changedrefs
 567     if {$showneartags} {
 568         getallcommits
 569     }
 570     clear_display
 571     catch {unset commitinterest}
 572     catch {unset cached_commitrow}
 573     catch {unset targetid}
 574     setcanvscroll
 575     getcommits $selid
 576     return 0
 577 }
 578
 579 # This makes a string representation of a positive integer which
 580 # sorts as a string in numerical order
 581 proc strrep {n} {
 582     if {$n < 16} {
 583         return [format "%x" $n]
 584     } elseif {$n < 256} {
 585         return [format "x%.2x" $n]
 586     } elseif {$n < 65536} {
 587         return [format "y%.4x" $n]
 588     }
 589     return [format "z%.8x" $n]
 590 }
 591
 592 # Procedures used in reordering commits from git log (without
 593 # --topo-order) into the order for display.
 594
 595 proc varcinit {view} {
 596     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 597     global vtokmod varcmod vrowmod varcix vlastins
 598
 599     set varcstart($view) {{}}
 600     set vupptr($view) {0}
 601     set vdownptr($view) {0}
 602     set vleftptr($view) {0}
 603     set vbackptr($view) {0}
 604     set varctok($view) {{}}
 605     set varcrow($view) {{}}
 606     set vtokmod($view) {}
 607     set varcmod($view) 0
 608     set vrowmod($view) 0
 609     set varcix($view) {{}}
 610     set vlastins($view) {0}
 611 }
 612
 613 proc resetvarcs {view} {
 614     global varcid varccommits parents children vseedcount ordertok
 615
 616     foreach vid [array names varcid $view,*] {
 617         unset varcid($vid)
 618         unset children($vid)
 619         unset parents($vid)
 620     }
 621     # some commits might have children but haven't been seen yet
 622     foreach vid [array names children $view,*] {
 623         unset children($vid)
 624     }
 625     foreach va [array names varccommits $view,*] {
 626         unset varccommits($va)
 627     }
 628     foreach vd [array names vseedcount $view,*] {
 629         unset vseedcount($vd)
 630     }
 631     catch {unset ordertok}
 632 }
 633
 634 # returns a list of the commits with no children
 635 proc seeds {v} {
 636     global vdownptr vleftptr varcstart
 637
 638     set ret {}
 639     set a [lindex $vdownptr($v) 0]
 640     while {$a != 0} {
 641         lappend ret [lindex $varcstart($v) $a]
 642         set a [lindex $vleftptr($v) $a]
 643     }
 644     return $ret
 645 }
 646
 647 proc newvarc {view id} {
 648     global varcid varctok parents children vdatemode
 649     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 650     global commitdata commitinfo vseedcount varccommits vlastins
 651
 652     set a [llength $varctok($view)]
 653     set vid $view,$id
 654     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 655         if {![info exists commitinfo($id)]} {
 656             parsecommit $id $commitdata($id) 1
 657         }
 658         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 659         if {![string is integer -strict $cdate]} {
 660             set cdate 0
 661         }
 662         if {![info exists vseedcount($view,$cdate)]} {
 663             set vseedcount($view,$cdate) -1
 664         }
 665         set c [incr vseedcount($view,$cdate)]
 666         set cdate [expr {$cdate ^ 0xffffffff}]
 667         set tok "s[strrep $cdate][strrep $c]"
 668     } else {
 669         set tok {}
 670     }
 671     set ka 0
 672     if {[llength $children($vid)] > 0} {
 673         set kid [lindex $children($vid) end]
 674         set k $varcid($view,$kid)
 675         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 676             set ki $kid
 677             set ka $k
 678             set tok [lindex $varctok($view) $k]
 679         }
 680     }
 681     if {$ka != 0} {
 682         set i [lsearch -exact $parents($view,$ki) $id]
 683         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 684         append tok [strrep $j]
 685     }
 686     set c [lindex $vlastins($view) $ka]
 687     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 688         set c $ka
 689         set b [lindex $vdownptr($view) $ka]
 690     } else {
 691         set b [lindex $vleftptr($view) $c]
 692     }
 693     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 694         set c $b
 695         set b [lindex $vleftptr($view) $c]
 696     }
 697     if {$c == $ka} {
 698         lset vdownptr($view) $ka $a
 699         lappend vbackptr($view) 0
 700     } else {
 701         lset vleftptr($view) $c $a
 702         lappend vbackptr($view) $c
 703     }
 704     lset vlastins($view) $ka $a
 705     lappend vupptr($view) $ka
 706     lappend vleftptr($view) $b
 707     if {$b != 0} {
 708         lset vbackptr($view) $b $a
 709     }
 710     lappend varctok($view) $tok
 711     lappend varcstart($view) $id
 712     lappend vdownptr($view) 0
 713     lappend varcrow($view) {}
 714     lappend varcix($view) {}
 715     set varccommits($view,$a) {}
 716     lappend vlastins($view) 0
 717     return $a
 718 }
 719
 720 proc splitvarc {p v} {
 721     global varcid varcstart varccommits varctok vtokmod
 722     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 723
 724     set oa $varcid($v,$p)
 725     set otok [lindex $varctok($v) $oa]
 726     set ac $varccommits($v,$oa)
 727     set i [lsearch -exact $varccommits($v,$oa) $p]
 728     if {$i <= 0} return
 729     set na [llength $varctok($v)]
 730     # "%" sorts before "0"...
 731     set tok "$otok%[strrep $i]"
 732     lappend varctok($v) $tok
 733     lappend varcrow($v) {}
 734     lappend varcix($v) {}
 735     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 736     set varccommits($v,$na) [lrange $ac $i end]
 737     lappend varcstart($v) $p
 738     foreach id $varccommits($v,$na) {
 739         set varcid($v,$id) $na
 740     }
 741     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 742     lappend vlastins($v) [lindex $vlastins($v) $oa]
 743     lset vdownptr($v) $oa $na
 744     lset vlastins($v) $oa 0
 745     lappend vupptr($v) $oa
 746     lappend vleftptr($v) 0
 747     lappend vbackptr($v) 0
 748     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 749         lset vupptr($v) $b $na
 750     }
 751     if {[string compare $otok $vtokmod($v)] <= 0} {
 752         modify_arc $v $oa
 753     }
 754 }
 755
 756 proc renumbervarc {a v} {
 757     global parents children varctok varcstart varccommits
 758     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 759
 760     set t1 [clock clicks -milliseconds]
 761     set todo {}
 762     set isrelated($a) 1
 763     set kidchanged($a) 1
 764     set ntot 0
 765     while {$a != 0} {
 766         if {[info exists isrelated($a)]} {
 767             lappend todo $a
 768             set id [lindex $varccommits($v,$a) end]
 769             foreach p $parents($v,$id) {
 770                 if {[info exists varcid($v,$p)]} {
 771                     set isrelated($varcid($v,$p)) 1
 772                 }
 773             }
 774         }
 775         incr ntot
 776         set b [lindex $vdownptr($v) $a]
 777         if {$b == 0} {
 778             while {$a != 0} {
 779                 set b [lindex $vleftptr($v) $a]
 780                 if {$b != 0} break
 781                 set a [lindex $vupptr($v) $a]
 782             }
 783         }
 784         set a $b
 785     }
 786     foreach a $todo {
 787         if {![info exists kidchanged($a)]} continue
 788         set id [lindex $varcstart($v) $a]
 789         if {[llength $children($v,$id)] > 1} {
 790             set children($v,$id) [lsort -command [list vtokcmp $v] \
 791                                       $children($v,$id)]
 792         }
 793         set oldtok [lindex $varctok($v) $a]
 794         if {!$vdatemode($v)} {
 795             set tok {}
 796         } else {
 797             set tok $oldtok
 798         }
 799         set ka 0
 800         set kid [last_real_child $v,$id]
 801         if {$kid ne {}} {
 802             set k $varcid($v,$kid)
 803             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 804                 set ki $kid
 805                 set ka $k
 806                 set tok [lindex $varctok($v) $k]
 807             }
 808         }
 809         if {$ka != 0} {
 810             set i [lsearch -exact $parents($v,$ki) $id]
 811             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 812             append tok [strrep $j]
 813         }
 814         if {$tok eq $oldtok} {
 815             continue
 816         }
 817         set id [lindex $varccommits($v,$a) end]
 818         foreach p $parents($v,$id) {
 819             if {[info exists varcid($v,$p)]} {
 820                 set kidchanged($varcid($v,$p)) 1
 821             } else {
 822                 set sortkids($p) 1
 823             }
 824         }
 825         lset varctok($v) $a $tok
 826         set b [lindex $vupptr($v) $a]
 827         if {$b != $ka} {
 828             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 829                 modify_arc $v $ka
 830             }
 831             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 832                 modify_arc $v $b
 833             }
 834             set c [lindex $vbackptr($v) $a]
 835             set d [lindex $vleftptr($v) $a]
 836             if {$c == 0} {
 837                 lset vdownptr($v) $b $d
 838             } else {
 839                 lset vleftptr($v) $c $d
 840             }
 841             if {$d != 0} {
 842                 lset vbackptr($v) $d $c
 843             }
 844             if {[lindex $vlastins($v) $b] == $a} {
 845                 lset vlastins($v) $b $c
 846             }
 847             lset vupptr($v) $a $ka
 848             set c [lindex $vlastins($v) $ka]
 849             if {$c == 0 || \
 850                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 851                 set c $ka
 852                 set b [lindex $vdownptr($v) $ka]
 853             } else {
 854                 set b [lindex $vleftptr($v) $c]
 855             }
 856             while {$b != 0 && \
 857                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 858                 set c $b
 859                 set b [lindex $vleftptr($v) $c]
 860             }
 861             if {$c == $ka} {
 862                 lset vdownptr($v) $ka $a
 863                 lset vbackptr($v) $a 0
 864             } else {
 865                 lset vleftptr($v) $c $a
 866                 lset vbackptr($v) $a $c
 867             }
 868             lset vleftptr($v) $a $b
 869             if {$b != 0} {
 870                 lset vbackptr($v) $b $a
 871             }
 872             lset vlastins($v) $ka $a
 873         }
 874     }
 875     foreach id [array names sortkids] {
 876         if {[llength $children($v,$id)] > 1} {
 877             set children($v,$id) [lsort -command [list vtokcmp $v] \
 878                                       $children($v,$id)]
 879         }
 880     }
 881     set t2 [clock clicks -milliseconds]
 882     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 883 }
 884
 885 # Fix up the graph after we have found out that in view $v,
 886 # $p (a commit that we have already seen) is actually the parent
 887 # of the last commit in arc $a.
 888 proc fix_reversal {p a v} {
 889     global varcid varcstart varctok vupptr
 890
 891     set pa $varcid($v,$p)
 892     if {$p ne [lindex $varcstart($v) $pa]} {
 893         splitvarc $p $v
 894         set pa $varcid($v,$p)
 895     }
 896     # seeds always need to be renumbered
 897     if {[lindex $vupptr($v) $pa] == 0 ||
 898         [string compare [lindex $varctok($v) $a] \
 899              [lindex $varctok($v) $pa]] > 0} {
 900         renumbervarc $pa $v
 901     }
 902 }
 903
 904 proc insertrow {id p v} {
 905     global cmitlisted children parents varcid varctok vtokmod
 906     global varccommits ordertok commitidx numcommits curview
 907     global targetid targetrow
 908
 909     readcommit $id
 910     set vid $v,$id
 911     set cmitlisted($vid) 1
 912     set children($vid) {}
 913     set parents($vid) [list $p]
 914     set a [newvarc $v $id]
 915     set varcid($vid) $a
 916     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 917         modify_arc $v $a
 918     }
 919     lappend varccommits($v,$a) $id
 920     set vp $v,$p
 921     if {[llength [lappend children($vp) $id]] > 1} {
 922         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 923         catch {unset ordertok}
 924     }
 925     fix_reversal $p $a $v
 926     incr commitidx($v)
 927     if {$v == $curview} {
 928         set numcommits $commitidx($v)
 929         setcanvscroll
 930         if {[info exists targetid]} {
 931             if {![comes_before $targetid $p]} {
 932                 incr targetrow
 933             }
 934         }
 935     }
 936 }
 937
 938 proc insertfakerow {id p} {
 939     global varcid varccommits parents children cmitlisted
 940     global commitidx varctok vtokmod targetid targetrow curview numcommits
 941
 942     set v $curview
 943     set a $varcid($v,$p)
 944     set i [lsearch -exact $varccommits($v,$a) $p]
 945     if {$i < 0} {
 946         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 947         return
 948     }
 949     set children($v,$id) {}
 950     set parents($v,$id) [list $p]
 951     set varcid($v,$id) $a
 952     lappend children($v,$p) $id
 953     set cmitlisted($v,$id) 1
 954     set numcommits [incr commitidx($v)]
 955     # note we deliberately don't update varcstart($v) even if $i == 0
 956     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 957     modify_arc $v $a $i
 958     if {[info exists targetid]} {
 959         if {![comes_before $targetid $p]} {
 960             incr targetrow
 961         }
 962     }
 963     setcanvscroll
 964     drawvisible
 965 }
 966
 967 proc removefakerow {id} {
 968     global varcid varccommits parents children commitidx
 969     global varctok vtokmod cmitlisted currentid selectedline
 970     global targetid curview numcommits
 971
 972     set v $curview
 973     if {[llength $parents($v,$id)] != 1} {
 974         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
 975         return
 976     }
 977     set p [lindex $parents($v,$id) 0]
 978     set a $varcid($v,$id)
 979     set i [lsearch -exact $varccommits($v,$a) $id]
 980     if {$i < 0} {
 981         puts "oops: removefakerow can't find [shortids $id] on arc $a"
 982         return
 983     }
 984     unset varcid($v,$id)
 985     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
 986     unset parents($v,$id)
 987     unset children($v,$id)
 988     unset cmitlisted($v,$id)
 989     set numcommits [incr commitidx($v) -1]
 990     set j [lsearch -exact $children($v,$p) $id]
 991     if {$j >= 0} {
 992         set children($v,$p) [lreplace $children($v,$p) $j $j]
 993     }
 994     modify_arc $v $a $i
 995     if {[info exist currentid] && $id eq $currentid} {
 996         unset currentid
 997         set selectedline {}
 998     }
 999     if {[info exists targetid] && $targetid eq $id} {
1000         set targetid $p
1001     }
1002     setcanvscroll
1003     drawvisible
1004 }
1005
1006 proc real_children {vp} {
1007     global children nullid nullid2
1008
1009     set kids {}
1010     foreach id $children($vp) {
1011         if {$id ne $nullid && $id ne $nullid2} {
1012             lappend kids $id
1013         }
1014     }
1015     return $kids
1016 }
1017
1018 proc first_real_child {vp} {
1019     global children nullid nullid2
1020
1021     foreach id $children($vp) {
1022         if {$id ne $nullid && $id ne $nullid2} {
1023             return $id
1024         }
1025     }
1026     return {}
1027 }
1028
1029 proc last_real_child {vp} {
1030     global children nullid nullid2
1031
1032     set kids $children($vp)
1033     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1034         set id [lindex $kids $i]
1035         if {$id ne $nullid && $id ne $nullid2} {
1036             return $id
1037         }
1038     }
1039     return {}
1040 }
1041
1042 proc vtokcmp {v a b} {
1043     global varctok varcid
1044
1045     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1046                 [lindex $varctok($v) $varcid($v,$b)]]
1047 }
1048
1049 # This assumes that if lim is not given, the caller has checked that
1050 # arc a's token is less than $vtokmod($v)
1051 proc modify_arc {v a {lim {}}} {
1052     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1053
1054     if {$lim ne {}} {
1055         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1056         if {$c > 0} return
1057         if {$c == 0} {
1058             set r [lindex $varcrow($v) $a]
1059             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1060         }
1061     }
1062     set vtokmod($v) [lindex $varctok($v) $a]
1063     set varcmod($v) $a
1064     if {$v == $curview} {
1065         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1066             set a [lindex $vupptr($v) $a]
1067             set lim {}
1068         }
1069         set r 0
1070         if {$a != 0} {
1071             if {$lim eq {}} {
1072                 set lim [llength $varccommits($v,$a)]
1073             }
1074             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1075         }
1076         set vrowmod($v) $r
1077         undolayout $r
1078     }
1079 }
1080
1081 proc update_arcrows {v} {
1082     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1083     global varcid vrownum varcorder varcix varccommits
1084     global vupptr vdownptr vleftptr varctok
1085     global displayorder parentlist curview cached_commitrow
1086
1087     if {$vrowmod($v) == $commitidx($v)} return
1088     if {$v == $curview} {
1089         if {[llength $displayorder] > $vrowmod($v)} {
1090             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1091             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1092         }
1093         catch {unset cached_commitrow}
1094     }
1095     set narctot [expr {[llength $varctok($v)] - 1}]
1096     set a $varcmod($v)
1097     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1098         # go up the tree until we find something that has a row number,
1099         # or we get to a seed
1100         set a [lindex $vupptr($v) $a]
1101     }
1102     if {$a == 0} {
1103         set a [lindex $vdownptr($v) 0]
1104         if {$a == 0} return
1105         set vrownum($v) {0}
1106         set varcorder($v) [list $a]
1107         lset varcix($v) $a 0
1108         lset varcrow($v) $a 0
1109         set arcn 0
1110         set row 0
1111     } else {
1112         set arcn [lindex $varcix($v) $a]
1113         if {[llength $vrownum($v)] > $arcn + 1} {
1114             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1115             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1116         }
1117         set row [lindex $varcrow($v) $a]
1118     }
1119     while {1} {
1120         set p $a
1121         incr row [llength $varccommits($v,$a)]
1122         # go down if possible
1123         set b [lindex $vdownptr($v) $a]
1124         if {$b == 0} {
1125             # if not, go left, or go up until we can go left
1126             while {$a != 0} {
1127                 set b [lindex $vleftptr($v) $a]
1128                 if {$b != 0} break
1129                 set a [lindex $vupptr($v) $a]
1130             }
1131             if {$a == 0} break
1132         }
1133         set a $b
1134         incr arcn
1135         lappend vrownum($v) $row
1136         lappend varcorder($v) $a
1137         lset varcix($v) $a $arcn
1138         lset varcrow($v) $a $row
1139     }
1140     set vtokmod($v) [lindex $varctok($v) $p]
1141     set varcmod($v) $p
1142     set vrowmod($v) $row
1143     if {[info exists currentid]} {
1144         set selectedline [rowofcommit $currentid]
1145     }
1146 }
1147
1148 # Test whether view $v contains commit $id
1149 proc commitinview {id v} {
1150     global varcid
1151
1152     return [info exists varcid($v,$id)]
1153 }
1154
1155 # Return the row number for commit $id in the current view
1156 proc rowofcommit {id} {
1157     global varcid varccommits varcrow curview cached_commitrow
1158     global varctok vtokmod
1159
1160     set v $curview
1161     if {![info exists varcid($v,$id)]} {
1162         puts "oops rowofcommit no arc for [shortids $id]"
1163         return {}
1164     }
1165     set a $varcid($v,$id)
1166     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1167         update_arcrows $v
1168     }
1169     if {[info exists cached_commitrow($id)]} {
1170         return $cached_commitrow($id)
1171     }
1172     set i [lsearch -exact $varccommits($v,$a) $id]
1173     if {$i < 0} {
1174         puts "oops didn't find commit [shortids $id] in arc $a"
1175         return {}
1176     }
1177     incr i [lindex $varcrow($v) $a]
1178     set cached_commitrow($id) $i
1179     return $i
1180 }
1181
1182 # Returns 1 if a is on an earlier row than b, otherwise 0
1183 proc comes_before {a b} {
1184     global varcid varctok curview
1185
1186     set v $curview
1187     if {$a eq $b || ![info exists varcid($v,$a)] || \
1188             ![info exists varcid($v,$b)]} {
1189         return 0
1190     }
1191     if {$varcid($v,$a) != $varcid($v,$b)} {
1192         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1193                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1194     }
1195     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1196 }
1197
1198 proc bsearch {l elt} {
1199     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1200         return 0
1201     }
1202     set lo 0
1203     set hi [llength $l]
1204     while {$hi - $lo > 1} {
1205         set mid [expr {int(($lo + $hi) / 2)}]
1206         set t [lindex $l $mid]
1207         if {$elt < $t} {
1208             set hi $mid
1209         } elseif {$elt > $t} {
1210             set lo $mid
1211         } else {
1212             return $mid
1213         }
1214     }
1215     return $lo
1216 }
1217
1218 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1219 proc make_disporder {start end} {
1220     global vrownum curview commitidx displayorder parentlist
1221     global varccommits varcorder parents vrowmod varcrow
1222     global d_valid_start d_valid_end
1223
1224     if {$end > $vrowmod($curview)} {
1225         update_arcrows $curview
1226     }
1227     set ai [bsearch $vrownum($curview) $start]
1228     set start [lindex $vrownum($curview) $ai]
1229     set narc [llength $vrownum($curview)]
1230     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1231         set a [lindex $varcorder($curview) $ai]
1232         set l [llength $displayorder]
1233         set al [llength $varccommits($curview,$a)]
1234         if {$l < $r + $al} {
1235             if {$l < $r} {
1236                 set pad [ntimes [expr {$r - $l}] {}]
1237                 set displayorder [concat $displayorder $pad]
1238                 set parentlist [concat $parentlist $pad]
1239             } elseif {$l > $r} {
1240                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1241                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1242             }
1243             foreach id $varccommits($curview,$a) {
1244                 lappend displayorder $id
1245                 lappend parentlist $parents($curview,$id)
1246             }
1247         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1248             set i $r
1249             foreach id $varccommits($curview,$a) {
1250                 lset displayorder $i $id
1251                 lset parentlist $i $parents($curview,$id)
1252                 incr i
1253             }
1254         }
1255         incr r $al
1256     }
1257 }
1258
1259 proc commitonrow {row} {
1260     global displayorder
1261
1262     set id [lindex $displayorder $row]
1263     if {$id eq {}} {
1264         make_disporder $row [expr {$row + 1}]
1265         set id [lindex $displayorder $row]
1266     }
1267     return $id
1268 }
1269
1270 proc closevarcs {v} {
1271     global varctok varccommits varcid parents children
1272     global cmitlisted commitidx vtokmod
1273
1274     set missing_parents 0
1275     set scripts {}
1276     set narcs [llength $varctok($v)]
1277     for {set a 1} {$a < $narcs} {incr a} {
1278         set id [lindex $varccommits($v,$a) end]
1279         foreach p $parents($v,$id) {
1280             if {[info exists varcid($v,$p)]} continue
1281             # add p as a new commit
1282             incr missing_parents
1283             set cmitlisted($v,$p) 0
1284             set parents($v,$p) {}
1285             if {[llength $children($v,$p)] == 1 &&
1286                 [llength $parents($v,$id)] == 1} {
1287                 set b $a
1288             } else {
1289                 set b [newvarc $v $p]
1290             }
1291             set varcid($v,$p) $b
1292             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1293                 modify_arc $v $b
1294             }
1295             lappend varccommits($v,$b) $p
1296             incr commitidx($v)
1297             set scripts [check_interest $p $scripts]
1298         }
1299     }
1300     if {$missing_parents > 0} {
1301         foreach s $scripts {
1302             eval $s
1303         }
1304     }
1305 }
1306
1307 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1308 # Assumes we already have an arc for $rwid.
1309 proc rewrite_commit {v id rwid} {
1310     global children parents varcid varctok vtokmod varccommits
1311
1312     foreach ch $children($v,$id) {
1313         # make $rwid be $ch's parent in place of $id
1314         set i [lsearch -exact $parents($v,$ch) $id]
1315         if {$i < 0} {
1316             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1317         }
1318         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1319         # add $ch to $rwid's children and sort the list if necessary
1320         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1321             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1322                                         $children($v,$rwid)]
1323         }
1324         # fix the graph after joining $id to $rwid
1325         set a $varcid($v,$ch)
1326         fix_reversal $rwid $a $v
1327         # parentlist is wrong for the last element of arc $a
1328         # even if displayorder is right, hence the 3rd arg here
1329         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1330     }
1331 }
1332
1333 # Mechanism for registering a command to be executed when we come
1334 # across a particular commit.  To handle the case when only the
1335 # prefix of the commit is known, the commitinterest array is now
1336 # indexed by the first 4 characters of the ID.  Each element is a
1337 # list of id, cmd pairs.
1338 proc interestedin {id cmd} {
1339     global commitinterest
1340
1341     lappend commitinterest([string range $id 0 3]) $id $cmd
1342 }
1343
1344 proc check_interest {id scripts} {
1345     global commitinterest
1346
1347     set prefix [string range $id 0 3]
1348     if {[info exists commitinterest($prefix)]} {
1349         set newlist {}
1350         foreach {i script} $commitinterest($prefix) {
1351             if {[string match "$i*" $id]} {
1352                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1353             } else {
1354                 lappend newlist $i $script
1355             }
1356         }
1357         if {$newlist ne {}} {
1358             set commitinterest($prefix) $newlist
1359         } else {
1360             unset commitinterest($prefix)
1361         }
1362     }
1363     return $scripts
1364 }
1365
1366 proc getcommitlines {fd inst view updating}  {
1367     global cmitlisted leftover
1368     global commitidx commitdata vdatemode
1369     global parents children curview hlview
1370     global idpending ordertok
1371     global varccommits varcid varctok vtokmod vfilelimit
1372
1373     set stuff [read $fd 500000]
1374     # git log doesn't terminate the last commit with a null...
1375     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1376         set stuff "\0"
1377     }
1378     if {$stuff == {}} {
1379         if {![eof $fd]} {
1380             return 1
1381         }
1382         global commfd viewcomplete viewactive viewname
1383         global viewinstances
1384         unset commfd($inst)
1385         set i [lsearch -exact $viewinstances($view) $inst]
1386         if {$i >= 0} {
1387             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1388         }
1389         # set it blocking so we wait for the process to terminate
1390         fconfigure $fd -blocking 1
1391         if {[catch {close $fd} err]} {
1392             set fv {}
1393             if {$view != $curview} {
1394                 set fv " for the \"$viewname($view)\" view"
1395             }
1396             if {[string range $err 0 4] == "usage"} {
1397                 set err "Gitk: error reading commits$fv:\
1398                         bad arguments to git log."
1399                 if {$viewname($view) eq "Command line"} {
1400                     append err \
1401                         "  (Note: arguments to gitk are passed to git log\
1402                          to allow selection of commits to be displayed.)"
1403                 }
1404             } else {
1405                 set err "Error reading commits$fv: $err"
1406             }
1407             error_popup $err
1408         }
1409         if {[incr viewactive($view) -1] <= 0} {
1410             set viewcomplete($view) 1
1411             # Check if we have seen any ids listed as parents that haven't
1412             # appeared in the list
1413             closevarcs $view
1414             notbusy $view
1415         }
1416         if {$view == $curview} {
1417             run chewcommits
1418         }
1419         return 0
1420     }
1421     set start 0
1422     set gotsome 0
1423     set scripts {}
1424     while 1 {
1425         set i [string first "\0" $stuff $start]
1426         if {$i < 0} {
1427             append leftover($inst) [string range $stuff $start end]
1428             break
1429         }
1430         if {$start == 0} {
1431             set cmit $leftover($inst)
1432             append cmit [string range $stuff 0 [expr {$i - 1}]]
1433             set leftover($inst) {}
1434         } else {
1435             set cmit [string range $stuff $start [expr {$i - 1}]]
1436         }
1437         set start [expr {$i + 1}]
1438         set j [string first "\n" $cmit]
1439         set ok 0
1440         set listed 1
1441         if {$j >= 0 && [string match "commit *" $cmit]} {
1442             set ids [string range $cmit 7 [expr {$j - 1}]]
1443             if {[string match {[-^<>]*} $ids]} {
1444                 switch -- [string index $ids 0] {
1445                     "-" {set listed 0}
1446                     "^" {set listed 2}
1447                     "<" {set listed 3}
1448                     ">" {set listed 4}
1449                 }
1450                 set ids [string range $ids 1 end]
1451             }
1452             set ok 1
1453             foreach id $ids {
1454                 if {[string length $id] != 40} {
1455                     set ok 0
1456                     break
1457                 }
1458             }
1459         }
1460         if {!$ok} {
1461             set shortcmit $cmit
1462             if {[string length $shortcmit] > 80} {
1463                 set shortcmit "[string range $shortcmit 0 80]..."
1464             }
1465             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1466             exit 1
1467         }
1468         set id [lindex $ids 0]
1469         set vid $view,$id
1470
1471         if {!$listed && $updating && ![info exists varcid($vid)] &&
1472             $vfilelimit($view) ne {}} {
1473             # git log doesn't rewrite parents for unlisted commits
1474             # when doing path limiting, so work around that here
1475             # by working out the rewritten parent with git rev-list
1476             # and if we already know about it, using the rewritten
1477             # parent as a substitute parent for $id's children.
1478             if {![catch {
1479                 set rwid [exec git rev-list --first-parent --max-count=1 \
1480                               $id -- $vfilelimit($view)]
1481             }]} {
1482                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1483                     # use $rwid in place of $id
1484                     rewrite_commit $view $id $rwid
1485                     continue
1486                 }
1487             }
1488         }
1489
1490         set a 0
1491         if {[info exists varcid($vid)]} {
1492             if {$cmitlisted($vid) || !$listed} continue
1493             set a $varcid($vid)
1494         }
1495         if {$listed} {
1496             set olds [lrange $ids 1 end]
1497         } else {
1498             set olds {}
1499         }
1500         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1501         set cmitlisted($vid) $listed
1502         set parents($vid) $olds
1503         if {![info exists children($vid)]} {
1504             set children($vid) {}
1505         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1506             set k [lindex $children($vid) 0]
1507             if {[llength $parents($view,$k)] == 1 &&
1508                 (!$vdatemode($view) ||
1509                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1510                 set a $varcid($view,$k)
1511             }
1512         }
1513         if {$a == 0} {
1514             # new arc
1515             set a [newvarc $view $id]
1516         }
1517         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1518             modify_arc $view $a
1519         }
1520         if {![info exists varcid($vid)]} {
1521             set varcid($vid) $a
1522             lappend varccommits($view,$a) $id
1523             incr commitidx($view)
1524         }
1525
1526         set i 0
1527         foreach p $olds {
1528             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1529                 set vp $view,$p
1530                 if {[llength [lappend children($vp) $id]] > 1 &&
1531                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1532                     set children($vp) [lsort -command [list vtokcmp $view] \
1533                                            $children($vp)]
1534                     catch {unset ordertok}
1535                 }
1536                 if {[info exists varcid($view,$p)]} {
1537                     fix_reversal $p $a $view
1538                 }
1539             }
1540             incr i
1541         }
1542
1543         set scripts [check_interest $id $scripts]
1544         set gotsome 1
1545     }
1546     if {$gotsome} {
1547         global numcommits hlview
1548
1549         if {$view == $curview} {
1550             set numcommits $commitidx($view)
1551             run chewcommits
1552         }
1553         if {[info exists hlview] && $view == $hlview} {
1554             # we never actually get here...
1555             run vhighlightmore
1556         }
1557         foreach s $scripts {
1558             eval $s
1559         }
1560     }
1561     return 2
1562 }
1563
1564 proc chewcommits {} {
1565     global curview hlview viewcomplete
1566     global pending_select
1567
1568     layoutmore
1569     if {$viewcomplete($curview)} {
1570         global commitidx varctok
1571         global numcommits startmsecs
1572
1573         if {[info exists pending_select]} {
1574             update
1575             reset_pending_select {}
1576
1577             if {[commitinview $pending_select $curview]} {
1578                 selectline [rowofcommit $pending_select] 1
1579             } else {
1580                 set row [first_real_row]
1581                 selectline $row 1
1582             }
1583         }
1584         if {$commitidx($curview) > 0} {
1585             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1586             #puts "overall $ms ms for $numcommits commits"
1587             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1588         } else {
1589             show_status [mc "No commits selected"]
1590         }
1591         notbusy layout
1592     }
1593     return 0
1594 }
1595
1596 proc do_readcommit {id} {
1597     global tclencoding
1598
1599     # Invoke git-log to handle automatic encoding conversion
1600     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1601     # Read the results using i18n.logoutputencoding
1602     fconfigure $fd -translation lf -eofchar {}
1603     if {$tclencoding != {}} {
1604         fconfigure $fd -encoding $tclencoding
1605     }
1606     set contents [read $fd]
1607     close $fd
1608     # Remove the heading line
1609     regsub {^commit [0-9a-f]+\n} $contents {} contents
1610
1611     return $contents
1612 }
1613
1614 proc readcommit {id} {
1615     if {[catch {set contents [do_readcommit $id]}]} return
1616     parsecommit $id $contents 1
1617 }
1618
1619 proc parsecommit {id contents listed} {
1620     global commitinfo
1621
1622     set inhdr 1
1623     set comment {}
1624     set headline {}
1625     set auname {}
1626     set audate {}
1627     set comname {}
1628     set comdate {}
1629     set hdrend [string first "\n\n" $contents]
1630     if {$hdrend < 0} {
1631         # should never happen...
1632         set hdrend [string length $contents]
1633     }
1634     set header [string range $contents 0 [expr {$hdrend - 1}]]
1635     set comment [string range $contents [expr {$hdrend + 2}] end]
1636     foreach line [split $header "\n"] {
1637         set line [split $line " "]
1638         set tag [lindex $line 0]
1639         if {$tag == "author"} {
1640             set audate [lrange $line end-1 end]
1641             set auname [join [lrange $line 1 end-2] " "]
1642         } elseif {$tag == "committer"} {
1643             set comdate [lrange $line end-1 end]
1644             set comname [join [lrange $line 1 end-2] " "]
1645         }
1646     }
1647     set headline {}
1648     # take the first non-blank line of the comment as the headline
1649     set headline [string trimleft $comment]
1650     set i [string first "\n" $headline]
1651     if {$i >= 0} {
1652         set headline [string range $headline 0 $i]
1653     }
1654     set headline [string trimright $headline]
1655     set i [string first "\r" $headline]
1656     if {$i >= 0} {
1657         set headline [string trimright [string range $headline 0 $i]]
1658     }
1659     if {!$listed} {
1660         # git log indents the comment by 4 spaces;
1661         # if we got this via git cat-file, add the indentation
1662         set newcomment {}
1663         foreach line [split $comment "\n"] {
1664             append newcomment "    "
1665             append newcomment $line
1666             append newcomment "\n"
1667         }
1668         set comment $newcomment
1669     }
1670     set hasnote [string first "\nNotes:\n" $contents]
1671     set commitinfo($id) [list $headline $auname $audate \
1672                              $comname $comdate $comment $hasnote]
1673 }
1674
1675 proc getcommit {id} {
1676     global commitdata commitinfo
1677
1678     if {[info exists commitdata($id)]} {
1679         parsecommit $id $commitdata($id) 1
1680     } else {
1681         readcommit $id
1682         if {![info exists commitinfo($id)]} {
1683             set commitinfo($id) [list [mc "No commit information available"]]
1684         }
1685     }
1686     return 1
1687 }
1688
1689 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1690 # and are present in the current view.
1691 # This is fairly slow...
1692 proc longid {prefix} {
1693     global varcid curview
1694
1695     set ids {}
1696     foreach match [array names varcid "$curview,$prefix*"] {
1697         lappend ids [lindex [split $match ","] 1]
1698     }
1699     return $ids
1700 }
1701
1702 proc readrefs {} {
1703     global tagids idtags headids idheads tagobjid
1704     global otherrefids idotherrefs mainhead mainheadid
1705     global selecthead selectheadid
1706     global hideremotes
1707
1708     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1709         catch {unset $v}
1710     }
1711     set refd [open [list | git show-ref -d] r]
1712     while {[gets $refd line] >= 0} {
1713         if {[string index $line 40] ne " "} continue
1714         set id [string range $line 0 39]
1715         set ref [string range $line 41 end]
1716         if {![string match "refs/*" $ref]} continue
1717         set name [string range $ref 5 end]
1718         if {[string match "remotes/*" $name]} {
1719             if {![string match "*/HEAD" $name] && !$hideremotes} {
1720                 set headids($name) $id
1721                 lappend idheads($id) $name
1722             }
1723         } elseif {[string match "heads/*" $name]} {
1724             set name [string range $name 6 end]
1725             set headids($name) $id
1726             lappend idheads($id) $name
1727         } elseif {[string match "tags/*" $name]} {
1728             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1729             # which is what we want since the former is the commit ID
1730             set name [string range $name 5 end]
1731             if {[string match "*^{}" $name]} {
1732                 set name [string range $name 0 end-3]
1733             } else {
1734                 set tagobjid($name) $id
1735             }
1736             set tagids($name) $id
1737             lappend idtags($id) $name
1738         } else {
1739             set otherrefids($name) $id
1740             lappend idotherrefs($id) $name
1741         }
1742     }
1743     catch {close $refd}
1744     set mainhead {}
1745     set mainheadid {}
1746     catch {
1747         set mainheadid [exec git rev-parse HEAD]
1748         set thehead [exec git symbolic-ref HEAD]
1749         if {[string match "refs/heads/*" $thehead]} {
1750             set mainhead [string range $thehead 11 end]
1751         }
1752     }
1753     set selectheadid {}
1754     if {$selecthead ne {}} {
1755         catch {
1756             set selectheadid [exec git rev-parse --verify $selecthead]
1757         }
1758     }
1759 }
1760
1761 # skip over fake commits
1762 proc first_real_row {} {
1763     global nullid nullid2 numcommits
1764
1765     for {set row 0} {$row < $numcommits} {incr row} {
1766         set id [commitonrow $row]
1767         if {$id ne $nullid && $id ne $nullid2} {
1768             break
1769         }
1770     }
1771     return $row
1772 }
1773
1774 # update things for a head moved to a child of its previous location
1775 proc movehead {id name} {
1776     global headids idheads
1777
1778     removehead $headids($name) $name
1779     set headids($name) $id
1780     lappend idheads($id) $name
1781 }
1782
1783 # update things when a head has been removed
1784 proc removehead {id name} {
1785     global headids idheads
1786
1787     if {$idheads($id) eq $name} {
1788         unset idheads($id)
1789     } else {
1790         set i [lsearch -exact $idheads($id) $name]
1791         if {$i >= 0} {
1792             set idheads($id) [lreplace $idheads($id) $i $i]
1793         }
1794     }
1795     unset headids($name)
1796 }
1797
1798 proc ttk_toplevel {w args} {
1799     global use_ttk
1800     eval [linsert $args 0 ::toplevel $w]
1801     if {$use_ttk} {
1802         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1803     }
1804     return $w
1805 }
1806
1807 proc make_transient {window origin} {
1808     global have_tk85
1809
1810     # In MacOS Tk 8.4 transient appears to work by setting
1811     # overrideredirect, which is utterly useless, since the
1812     # windows get no border, and are not even kept above
1813     # the parent.
1814     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1815
1816     wm transient $window $origin
1817
1818     # Windows fails to place transient windows normally, so
1819     # schedule a callback to center them on the parent.
1820     if {[tk windowingsystem] eq {win32}} {
1821         after idle [list tk::PlaceWindow $window widget $origin]
1822     }
1823 }
1824
1825 proc show_error {w top msg {mc mc}} {
1826     global NS
1827     if {![info exists NS]} {set NS ""}
1828     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1829     message $w.m -text $msg -justify center -aspect 400
1830     pack $w.m -side top -fill x -padx 20 -pady 20
1831     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1832     pack $w.ok -side bottom -fill x
1833     bind $top <Visibility> "grab $top; focus $top"
1834     bind $top <Key-Return> "destroy $top"
1835     bind $top <Key-space>  "destroy $top"
1836     bind $top <Key-Escape> "destroy $top"
1837     tkwait window $top
1838 }
1839
1840 proc error_popup {msg {owner .}} {
1841     if {[tk windowingsystem] eq "win32"} {
1842         tk_messageBox -icon error -type ok -title [wm title .] \
1843             -parent $owner -message $msg
1844     } else {
1845         set w .error
1846         ttk_toplevel $w
1847         make_transient $w $owner
1848         show_error $w $w $msg
1849     }
1850 }
1851
1852 proc confirm_popup {msg {owner .}} {
1853     global confirm_ok NS
1854     set confirm_ok 0
1855     set w .confirm
1856     ttk_toplevel $w
1857     make_transient $w $owner
1858     message $w.m -text $msg -justify center -aspect 400
1859     pack $w.m -side top -fill x -padx 20 -pady 20
1860     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1861     pack $w.ok -side left -fill x
1862     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1863     pack $w.cancel -side right -fill x
1864     bind $w <Visibility> "grab $w; focus $w"
1865     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1866     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1867     bind $w <Key-Escape> "destroy $w"
1868     tk::PlaceWindow $w widget $owner
1869     tkwait window $w
1870     return $confirm_ok
1871 }
1872
1873 proc setoptions {} {
1874     if {[tk windowingsystem] ne "win32"} {
1875         option add *Panedwindow.showHandle 1 startupFile
1876         option add *Panedwindow.sashRelief raised startupFile
1877         if {[tk windowingsystem] ne "aqua"} {
1878             option add *Menu.font uifont startupFile
1879         }
1880     } else {
1881         option add *Menu.TearOff 0 startupFile
1882     }
1883     option add *Button.font uifont startupFile
1884     option add *Checkbutton.font uifont startupFile
1885     option add *Radiobutton.font uifont startupFile
1886     option add *Menubutton.font uifont startupFile
1887     option add *Label.font uifont startupFile
1888     option add *Message.font uifont startupFile
1889     option add *Entry.font textfont startupFile
1890     option add *Text.font textfont startupFile
1891     option add *Labelframe.font uifont startupFile
1892     option add *Spinbox.font textfont startupFile
1893     option add *Listbox.font mainfont startupFile
1894 }
1895
1896 # Make a menu and submenus.
1897 # m is the window name for the menu, items is the list of menu items to add.
1898 # Each item is a list {mc label type description options...}
1899 # mc is ignored; it's so we can put mc there to alert xgettext
1900 # label is the string that appears in the menu
1901 # type is cascade, command or radiobutton (should add checkbutton)
1902 # description depends on type; it's the sublist for cascade, the
1903 # command to invoke for command, or {variable value} for radiobutton
1904 proc makemenu {m items} {
1905     menu $m
1906     if {[tk windowingsystem] eq {aqua}} {
1907         set Meta1 Cmd
1908     } else {
1909         set Meta1 Ctrl
1910     }
1911     foreach i $items {
1912         set name [mc [lindex $i 1]]
1913         set type [lindex $i 2]
1914         set thing [lindex $i 3]
1915         set params [list $type]
1916         if {$name ne {}} {
1917             set u [string first "&" [string map {&& x} $name]]
1918             lappend params -label [string map {&& & & {}} $name]
1919             if {$u >= 0} {
1920                 lappend params -underline $u
1921             }
1922         }
1923         switch -- $type {
1924             "cascade" {
1925                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1926                 lappend params -menu $m.$submenu
1927             }
1928             "command" {
1929                 lappend params -command $thing
1930             }
1931             "radiobutton" {
1932                 lappend params -variable [lindex $thing 0] \
1933                     -value [lindex $thing 1]
1934             }
1935         }
1936         set tail [lrange $i 4 end]
1937         regsub -all {\yMeta1\y} $tail $Meta1 tail
1938         eval $m add $params $tail
1939         if {$type eq "cascade"} {
1940             makemenu $m.$submenu $thing
1941         }
1942     }
1943 }
1944
1945 # translate string and remove ampersands
1946 proc mca {str} {
1947     return [string map {&& & & {}} [mc $str]]
1948 }
1949
1950 proc makedroplist {w varname args} {
1951     global use_ttk
1952     if {$use_ttk} {
1953         set width 0
1954         foreach label $args {
1955             set cx [string length $label]
1956             if {$cx > $width} {set width $cx}
1957         }
1958         set gm [ttk::combobox $w -width $width -state readonly\
1959                     -textvariable $varname -values $args]
1960     } else {
1961         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
1962     }
1963     return $gm
1964 }
1965
1966 proc makewindow {} {
1967     global canv canv2 canv3 linespc charspc ctext cflist cscroll
1968     global tabstop
1969     global findtype findtypemenu findloc findstring fstring geometry
1970     global entries sha1entry sha1string sha1but
1971     global diffcontextstring diffcontext
1972     global ignorespace
1973     global maincursor textcursor curtextcursor
1974     global rowctxmenu fakerowmenu mergemax wrapcomment
1975     global highlight_files gdttype
1976     global searchstring sstring
1977     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1978     global headctxmenu progresscanv progressitem progresscoords statusw
1979     global fprogitem fprogcoord lastprogupdate progupdatepending
1980     global rprogitem rprogcoord rownumsel numcommits
1981     global have_tk85 use_ttk NS
1982     global git_version
1983     global worddiff
1984
1985     # The "mc" arguments here are purely so that xgettext
1986     # sees the following string as needing to be translated
1987     set file {
1988         mc "File" cascade {
1989             {mc "Update" command updatecommits -accelerator F5}
1990             {mc "Reload" command reloadcommits -accelerator Meta1-F5}
1991             {mc "Reread references" command rereadrefs}
1992             {mc "List references" command showrefs -accelerator F2}
1993             {xx "" separator}
1994             {mc "Start git gui" command {exec git gui &}}
1995             {xx "" separator}
1996             {mc "Quit" command doquit -accelerator Meta1-Q}
1997         }}
1998     set edit {
1999         mc "Edit" cascade {
2000             {mc "Preferences" command doprefs}
2001         }}
2002     set view {
2003         mc "View" cascade {
2004             {mc "New view..." command {newview 0} -accelerator Shift-F4}
2005             {mc "Edit view..." command editview -state disabled -accelerator F4}
2006             {mc "Delete view" command delview -state disabled}
2007             {xx "" separator}
2008             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2009         }}
2010     if {[tk windowingsystem] ne "aqua"} {
2011         set help {
2012         mc "Help" cascade {
2013             {mc "About gitk" command about}
2014             {mc "Key bindings" command keys}
2015         }}
2016         set bar [list $file $edit $view $help]
2017     } else {
2018         proc ::tk::mac::ShowPreferences {} {doprefs}
2019         proc ::tk::mac::Quit {} {doquit}
2020         lset file end [lreplace [lindex $file end] end-1 end]
2021         set apple {
2022         xx "Apple" cascade {
2023             {mc "About gitk" command about}
2024             {xx "" separator}
2025         }}
2026         set help {
2027         mc "Help" cascade {
2028             {mc "Key bindings" command keys}
2029         }}
2030         set bar [list $apple $file $view $help]
2031     }
2032     makemenu .bar $bar
2033     . configure -menu .bar
2034
2035     if {$use_ttk} {
2036         # cover the non-themed toplevel with a themed frame.
2037         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2038     }
2039
2040     # the gui has upper and lower half, parts of a paned window.
2041     ${NS}::panedwindow .ctop -orient vertical
2042
2043     # possibly use assumed geometry
2044     if {![info exists geometry(pwsash0)]} {
2045         set geometry(topheight) [expr {15 * $linespc}]
2046         set geometry(topwidth) [expr {80 * $charspc}]
2047         set geometry(botheight) [expr {15 * $linespc}]
2048         set geometry(botwidth) [expr {50 * $charspc}]
2049         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2050         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2051     }
2052
2053     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2054     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2055     ${NS}::frame .tf.histframe
2056     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2057     if {!$use_ttk} {
2058         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2059     }
2060
2061     # create three canvases
2062     set cscroll .tf.histframe.csb
2063     set canv .tf.histframe.pwclist.canv
2064     canvas $canv \
2065         -selectbackground $selectbgcolor \
2066         -background $bgcolor -bd 0 \
2067         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2068     .tf.histframe.pwclist add $canv
2069     set canv2 .tf.histframe.pwclist.canv2
2070     canvas $canv2 \
2071         -selectbackground $selectbgcolor \
2072         -background $bgcolor -bd 0 -yscrollincr $linespc
2073     .tf.histframe.pwclist add $canv2
2074     set canv3 .tf.histframe.pwclist.canv3
2075     canvas $canv3 \
2076         -selectbackground $selectbgcolor \
2077         -background $bgcolor -bd 0 -yscrollincr $linespc
2078     .tf.histframe.pwclist add $canv3
2079     if {$use_ttk} {
2080         bind .tf.histframe.pwclist <Map> {
2081             bind %W <Map> {}
2082             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2083             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2084         }
2085     } else {
2086         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2087         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2088     }
2089
2090     # a scroll bar to rule them
2091     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2092     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2093     pack $cscroll -side right -fill y
2094     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2095     lappend bglist $canv $canv2 $canv3
2096     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2097
2098     # we have two button bars at bottom of top frame. Bar 1
2099     ${NS}::frame .tf.bar
2100     ${NS}::frame .tf.lbar -height 15
2101
2102     set sha1entry .tf.bar.sha1
2103     set entries $sha1entry
2104     set sha1but .tf.bar.sha1label
2105     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2106         -command gotocommit -width 8
2107     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2108     pack .tf.bar.sha1label -side left
2109     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2110     trace add variable sha1string write sha1change
2111     pack $sha1entry -side left -pady 2
2112
2113     image create bitmap bm-left -data {
2114         #define left_width 16
2115         #define left_height 16
2116         static unsigned char left_bits[] = {
2117         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2118         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2119         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2120     }
2121     image create bitmap bm-right -data {
2122         #define right_width 16
2123         #define right_height 16
2124         static unsigned char right_bits[] = {
2125         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2126         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2127         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2128     }
2129     ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
2130         -state disabled -width 26
2131     pack .tf.bar.leftbut -side left -fill y
2132     ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
2133         -state disabled -width 26
2134     pack .tf.bar.rightbut -side left -fill y
2135
2136     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2137     set rownumsel {}
2138     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2139         -relief sunken -anchor e
2140     ${NS}::label .tf.bar.rowlabel2 -text "/"
2141     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2142         -relief sunken -anchor e
2143     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2144         -side left
2145     if {!$use_ttk} {
2146         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2147     }
2148     global selectedline
2149     trace add variable selectedline write selectedline_change
2150
2151     # Status label and progress bar
2152     set statusw .tf.bar.status
2153     ${NS}::label $statusw -width 15 -relief sunken
2154     pack $statusw -side left -padx 5
2155     if {$use_ttk} {
2156         set progresscanv [ttk::progressbar .tf.bar.progress]
2157     } else {
2158         set h [expr {[font metrics uifont -linespace] + 2}]
2159         set progresscanv .tf.bar.progress
2160         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2161         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2162         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2163         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2164     }
2165     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2166     set progresscoords {0 0}
2167     set fprogcoord 0
2168     set rprogcoord 0
2169     bind $progresscanv <Configure> adjustprogress
2170     set lastprogupdate [clock clicks -milliseconds]
2171     set progupdatepending 0
2172
2173     # build up the bottom bar of upper window
2174     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2175     ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2176     ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2177     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2178     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2179         -side left -fill y
2180     set gdttype [mc "containing:"]
2181     set gm [makedroplist .tf.lbar.gdttype gdttype \
2182                 [mc "containing:"] \
2183                 [mc "touching paths:"] \
2184                 [mc "adding/removing string:"]]
2185     trace add variable gdttype write gdttype_change
2186     pack .tf.lbar.gdttype -side left -fill y
2187
2188     set findstring {}
2189     set fstring .tf.lbar.findstring
2190     lappend entries $fstring
2191     ${NS}::entry $fstring -width 30 -textvariable findstring
2192     trace add variable findstring write find_change
2193     set findtype [mc "Exact"]
2194     set findtypemenu [makedroplist .tf.lbar.findtype \
2195                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2196     trace add variable findtype write findcom_change
2197     set findloc [mc "All fields"]
2198     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2199         [mc "Comments"] [mc "Author"] [mc "Committer"]
2200     trace add variable findloc write find_change
2201     pack .tf.lbar.findloc -side right
2202     pack .tf.lbar.findtype -side right
2203     pack $fstring -side left -expand 1 -fill x
2204
2205     # Finish putting the upper half of the viewer together
2206     pack .tf.lbar -in .tf -side bottom -fill x
2207     pack .tf.bar -in .tf -side bottom -fill x
2208     pack .tf.histframe -fill both -side top -expand 1
2209     .ctop add .tf
2210     if {!$use_ttk} {
2211         .ctop paneconfigure .tf -height $geometry(topheight)
2212         .ctop paneconfigure .tf -width $geometry(topwidth)
2213     }
2214
2215     # now build up the bottom
2216     ${NS}::panedwindow .pwbottom -orient horizontal
2217
2218     # lower left, a text box over search bar, scroll bar to the right
2219     # if we know window height, then that will set the lower text height, otherwise
2220     # we set lower text height which will drive window height
2221     if {[info exists geometry(main)]} {
2222         ${NS}::frame .bleft -width $geometry(botwidth)
2223     } else {
2224         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2225     }
2226     ${NS}::frame .bleft.top
2227     ${NS}::frame .bleft.mid
2228     ${NS}::frame .bleft.bottom
2229
2230     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2231     pack .bleft.top.search -side left -padx 5
2232     set sstring .bleft.top.sstring
2233     set searchstring ""
2234     ${NS}::entry $sstring -width 20 -textvariable searchstring
2235     lappend entries $sstring
2236     trace add variable searchstring write incrsearch
2237     pack $sstring -side left -expand 1 -fill x
2238     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2239         -command changediffdisp -variable diffelide -value {0 0}
2240     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2241         -command changediffdisp -variable diffelide -value {0 1}
2242     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2243         -command changediffdisp -variable diffelide -value {1 0}
2244     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2245     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2246     spinbox .bleft.mid.diffcontext -width 5 \
2247         -from 0 -increment 1 -to 10000000 \
2248         -validate all -validatecommand "diffcontextvalidate %P" \
2249         -textvariable diffcontextstring
2250     .bleft.mid.diffcontext set $diffcontext
2251     trace add variable diffcontextstring write diffcontextchange
2252     lappend entries .bleft.mid.diffcontext
2253     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2254     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2255         -command changeignorespace -variable ignorespace
2256     pack .bleft.mid.ignspace -side left -padx 5
2257
2258     set worddiff [mc "Line diff"]
2259     if {[package vcompare $git_version "1.7.2"] >= 0} {
2260         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2261             [mc "Markup words"] [mc "Color words"]
2262         trace add variable worddiff write changeworddiff
2263         pack .bleft.mid.worddiff -side left -padx 5
2264     }
2265
2266     set ctext .bleft.bottom.ctext
2267     text $ctext -background $bgcolor -foreground $fgcolor \
2268         -state disabled -font textfont \
2269         -yscrollcommand scrolltext -wrap none \
2270         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2271     if {$have_tk85} {
2272         $ctext conf -tabstyle wordprocessor
2273     }
2274     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2275     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2276     pack .bleft.top -side top -fill x
2277     pack .bleft.mid -side top -fill x
2278     grid $ctext .bleft.bottom.sb -sticky nsew
2279     grid .bleft.bottom.sbhorizontal -sticky ew
2280     grid columnconfigure .bleft.bottom 0 -weight 1
2281     grid rowconfigure .bleft.bottom 0 -weight 1
2282     grid rowconfigure .bleft.bottom 1 -weight 0
2283     pack .bleft.bottom -side top -fill both -expand 1
2284     lappend bglist $ctext
2285     lappend fglist $ctext
2286
2287     $ctext tag conf comment -wrap $wrapcomment
2288     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2289     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2290     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2291     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2292     $ctext tag conf m0 -fore red
2293     $ctext tag conf m1 -fore blue
2294     $ctext tag conf m2 -fore green
2295     $ctext tag conf m3 -fore purple
2296     $ctext tag conf m4 -fore brown
2297     $ctext tag conf m5 -fore "#009090"
2298     $ctext tag conf m6 -fore magenta
2299     $ctext tag conf m7 -fore "#808000"
2300     $ctext tag conf m8 -fore "#009000"
2301     $ctext tag conf m9 -fore "#ff0080"
2302     $ctext tag conf m10 -fore cyan
2303     $ctext tag conf m11 -fore "#b07070"
2304     $ctext tag conf m12 -fore "#70b0f0"
2305     $ctext tag conf m13 -fore "#70f0b0"
2306     $ctext tag conf m14 -fore "#f0b070"
2307     $ctext tag conf m15 -fore "#ff70b0"
2308     $ctext tag conf mmax -fore darkgrey
2309     set mergemax 16
2310     $ctext tag conf mresult -font textfontbold
2311     $ctext tag conf msep -font textfontbold
2312     $ctext tag conf found -back yellow
2313
2314     .pwbottom add .bleft
2315     if {!$use_ttk} {
2316         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2317     }
2318
2319     # lower right
2320     ${NS}::frame .bright
2321     ${NS}::frame .bright.mode
2322     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2323         -command reselectline -variable cmitmode -value "patch"
2324     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2325         -command reselectline -variable cmitmode -value "tree"
2326     grid .bright.mode.patch .bright.mode.tree -sticky ew
2327     pack .bright.mode -side top -fill x
2328     set cflist .bright.cfiles
2329     set indent [font measure mainfont "nn"]
2330     text $cflist \
2331         -selectbackground $selectbgcolor \
2332         -background $bgcolor -foreground $fgcolor \
2333         -font mainfont \
2334         -tabs [list $indent [expr {2 * $indent}]] \
2335         -yscrollcommand ".bright.sb set" \
2336         -cursor [. cget -cursor] \
2337         -spacing1 1 -spacing3 1
2338     lappend bglist $cflist
2339     lappend fglist $cflist
2340     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2341     pack .bright.sb -side right -fill y
2342     pack $cflist -side left -fill both -expand 1
2343     $cflist tag configure highlight \
2344         -background [$cflist cget -selectbackground]
2345     $cflist tag configure bold -font mainfontbold
2346
2347     .pwbottom add .bright
2348     .ctop add .pwbottom
2349
2350     # restore window width & height if known
2351     if {[info exists geometry(main)]} {
2352         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2353             if {$w > [winfo screenwidth .]} {
2354                 set w [winfo screenwidth .]
2355             }
2356             if {$h > [winfo screenheight .]} {
2357                 set h [winfo screenheight .]
2358             }
2359             wm geometry . "${w}x$h"
2360         }
2361     }
2362
2363     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2364         wm state . $geometry(state)
2365     }
2366
2367     if {[tk windowingsystem] eq {aqua}} {
2368         set M1B M1
2369         set ::BM "3"
2370     } else {
2371         set M1B Control
2372         set ::BM "2"
2373     }
2374
2375     if {$use_ttk} {
2376         bind .ctop <Map> {
2377             bind %W <Map> {}
2378             %W sashpos 0 $::geometry(topheight)
2379         }
2380         bind .pwbottom <Map> {
2381             bind %W <Map> {}
2382             %W sashpos 0 $::geometry(botwidth)
2383         }
2384     }
2385
2386     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2387     pack .ctop -fill both -expand 1
2388     bindall <1> {selcanvline %W %x %y}
2389     #bindall <B1-Motion> {selcanvline %W %x %y}
2390     if {[tk windowingsystem] == "win32"} {
2391         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2392         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2393     } else {
2394         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2395         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2396         if {[tk windowingsystem] eq "aqua"} {
2397             bindall <MouseWheel> {
2398                 set delta [expr {- (%D)}]
2399                 allcanvs yview scroll $delta units
2400             }
2401             bindall <Shift-MouseWheel> {
2402                 set delta [expr {- (%D)}]
2403                 $canv xview scroll $delta units
2404             }
2405         }
2406     }
2407     bindall <$::BM> "canvscan mark %W %x %y"
2408     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2409     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2410     bind . <$M1B-Key-w> doquit
2411     bindkey <Home> selfirstline
2412     bindkey <End> sellastline
2413     bind . <Key-Up> "selnextline -1"
2414     bind . <Key-Down> "selnextline 1"
2415     bind . <Shift-Key-Up> "dofind -1 0"
2416     bind . <Shift-Key-Down> "dofind 1 0"
2417     bindkey <Key-Right> "goforw"
2418     bindkey <Key-Left> "goback"
2419     bind . <Key-Prior> "selnextpage -1"
2420     bind . <Key-Next> "selnextpage 1"
2421     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2422     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2423     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2424     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2425     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2426     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2427     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2428     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2429     bindkey <Key-space> "$ctext yview scroll 1 pages"
2430     bindkey p "selnextline -1"
2431     bindkey n "selnextline 1"
2432     bindkey z "goback"
2433     bindkey x "goforw"
2434     bindkey k "selnextline -1"
2435     bindkey j "selnextline 1"
2436     bindkey h "goback"
2437     bindkey l "goforw"
2438     bindkey b prevfile
2439     bindkey d "$ctext yview scroll 18 units"
2440     bindkey u "$ctext yview scroll -18 units"
2441     bindkey / {focus $fstring}
2442     bindkey <Key-KP_Divide> {focus $fstring}
2443     bindkey <Key-Return> {dofind 1 1}
2444     bindkey ? {dofind -1 1}
2445     bindkey f nextfile
2446     bind . <F5> updatecommits
2447     bind . <$M1B-F5> reloadcommits
2448     bind . <F2> showrefs
2449     bind . <Shift-F4> {newview 0}
2450     catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2451     bind . <F4> edit_or_newview
2452     bind . <$M1B-q> doquit
2453     bind . <$M1B-f> {dofind 1 1}
2454     bind . <$M1B-g> {dofind 1 0}
2455     bind . <$M1B-r> dosearchback
2456     bind . <$M1B-s> dosearch
2457     bind . <$M1B-equal> {incrfont 1}
2458     bind . <$M1B-plus> {incrfont 1}
2459     bind . <$M1B-KP_Add> {incrfont 1}
2460     bind . <$M1B-minus> {incrfont -1}
2461     bind . <$M1B-KP_Subtract> {incrfont -1}
2462     wm protocol . WM_DELETE_WINDOW doquit
2463     bind . <Destroy> {stop_backends}
2464     bind . <Button-1> "click %W"
2465     bind $fstring <Key-Return> {dofind 1 1}
2466     bind $sha1entry <Key-Return> {gotocommit; break}
2467     bind $sha1entry <<PasteSelection>> clearsha1
2468     bind $cflist <1> {sel_flist %W %x %y; break}
2469     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2470     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2471     global ctxbut
2472     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2473     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2474     bind $ctext <Button-1> {focus %W}
2475
2476     set maincursor [. cget -cursor]
2477     set textcursor [$ctext cget -cursor]
2478     set curtextcursor $textcursor
2479
2480     set rowctxmenu .rowctxmenu
2481     makemenu $rowctxmenu {
2482         {mc "Diff this -> selected" command {diffvssel 0}}
2483         {mc "Diff selected -> this" command {diffvssel 1}}
2484         {mc "Make patch" command mkpatch}
2485         {mc "Create tag" command mktag}
2486         {mc "Write commit to file" command writecommit}
2487         {mc "Create new branch" command mkbranch}
2488         {mc "Cherry-pick this commit" command cherrypick}
2489         {mc "Reset HEAD branch to here" command resethead}
2490         {mc "Mark this commit" command markhere}
2491         {mc "Return to mark" command gotomark}
2492         {mc "Find descendant of this and mark" command find_common_desc}
2493         {mc "Compare with marked commit" command compare_commits}
2494     }
2495     $rowctxmenu configure -tearoff 0
2496
2497     set fakerowmenu .fakerowmenu
2498     makemenu $fakerowmenu {
2499         {mc "Diff this -> selected" command {diffvssel 0}}
2500         {mc "Diff selected -> this" command {diffvssel 1}}
2501         {mc "Make patch" command mkpatch}
2502     }
2503     $fakerowmenu configure -tearoff 0
2504
2505     set headctxmenu .headctxmenu
2506     makemenu $headctxmenu {
2507         {mc "Check out this branch" command cobranch}
2508         {mc "Remove this branch" command rmbranch}
2509     }
2510     $headctxmenu configure -tearoff 0
2511
2512     global flist_menu
2513     set flist_menu .flistctxmenu
2514     makemenu $flist_menu {
2515         {mc "Highlight this too" command {flist_hl 0}}
2516         {mc "Highlight this only" command {flist_hl 1}}
2517         {mc "External diff" command {external_diff}}
2518         {mc "Blame parent commit" command {external_blame 1}}
2519     }
2520     $flist_menu configure -tearoff 0
2521
2522     global diff_menu
2523     set diff_menu .diffctxmenu
2524     makemenu $diff_menu {
2525         {mc "Show origin of this line" command show_line_source}
2526         {mc "Run git gui blame on this line" command {external_blame_diff}}
2527     }
2528     $diff_menu configure -tearoff 0
2529 }
2530
2531 # Windows sends all mouse wheel events to the current focused window, not
2532 # the one where the mouse hovers, so bind those events here and redirect
2533 # to the correct window
2534 proc windows_mousewheel_redirector {W X Y D} {
2535     global canv canv2 canv3
2536     set w [winfo containing -displayof $W $X $Y]
2537     if {$w ne ""} {
2538         set u [expr {$D < 0 ? 5 : -5}]
2539         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2540             allcanvs yview scroll $u units
2541         } else {
2542             catch {
2543                 $w yview scroll $u units
2544             }
2545         }
2546     }
2547 }
2548
2549 # Update row number label when selectedline changes
2550 proc selectedline_change {n1 n2 op} {
2551     global selectedline rownumsel
2552
2553     if {$selectedline eq {}} {
2554         set rownumsel {}
2555     } else {
2556         set rownumsel [expr {$selectedline + 1}]
2557     }
2558 }
2559
2560 # mouse-2 makes all windows scan vertically, but only the one
2561 # the cursor is in scans horizontally
2562 proc canvscan {op w x y} {
2563     global canv canv2 canv3
2564     foreach c [list $canv $canv2 $canv3] {
2565         if {$c == $w} {
2566             $c scan $op $x $y
2567         } else {
2568             $c scan $op 0 $y
2569         }
2570     }
2571 }
2572
2573 proc scrollcanv {cscroll f0 f1} {
2574     $cscroll set $f0 $f1
2575     drawvisible
2576     flushhighlights
2577 }
2578
2579 # when we make a key binding for the toplevel, make sure
2580 # it doesn't get triggered when that key is pressed in the
2581 # find string entry widget.
2582 proc bindkey {ev script} {
2583     global entries
2584     bind . $ev $script
2585     set escript [bind Entry $ev]
2586     if {$escript == {}} {
2587         set escript [bind Entry <Key>]
2588     }
2589     foreach e $entries {
2590         bind $e $ev "$escript; break"
2591     }
2592 }
2593
2594 # set the focus back to the toplevel for any click outside
2595 # the entry widgets
2596 proc click {w} {
2597     global ctext entries
2598     foreach e [concat $entries $ctext] {
2599         if {$w == $e} return
2600     }
2601     focus .
2602 }
2603
2604 # Adjust the progress bar for a change in requested extent or canvas size
2605 proc adjustprogress {} {
2606     global progresscanv progressitem progresscoords
2607     global fprogitem fprogcoord lastprogupdate progupdatepending
2608     global rprogitem rprogcoord use_ttk
2609
2610     if {$use_ttk} {
2611         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2612         return
2613     }
2614
2615     set w [expr {[winfo width $progresscanv] - 4}]
2616     set x0 [expr {$w * [lindex $progresscoords 0]}]
2617     set x1 [expr {$w * [lindex $progresscoords 1]}]
2618     set h [winfo height $progresscanv]
2619     $progresscanv coords $progressitem $x0 0 $x1 $h
2620     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2621     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2622     set now [clock clicks -milliseconds]
2623     if {$now >= $lastprogupdate + 100} {
2624         set progupdatepending 0
2625         update
2626     } elseif {!$progupdatepending} {
2627         set progupdatepending 1
2628         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2629     }
2630 }
2631
2632 proc doprogupdate {} {
2633     global lastprogupdate progupdatepending
2634
2635     if {$progupdatepending} {
2636         set progupdatepending 0
2637         set lastprogupdate [clock clicks -milliseconds]
2638         update
2639     }
2640 }
2641
2642 proc savestuff {w} {
2643     global canv canv2 canv3 mainfont textfont uifont tabstop
2644     global stuffsaved findmergefiles maxgraphpct
2645     global maxwidth showneartags showlocalchanges
2646     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2647     global cmitmode wrapcomment datetimeformat limitdiffs
2648     global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2649     global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2650     global hideremotes want_ttk
2651
2652     if {$stuffsaved} return
2653     if {![winfo viewable .]} return
2654     catch {
2655         if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2656         set f [open "~/.gitk-new" w]
2657         if {$::tcl_platform(platform) eq {windows}} {
2658             file attributes "~/.gitk-new" -hidden true
2659         }
2660         puts $f [list set mainfont $mainfont]
2661         puts $f [list set textfont $textfont]
2662         puts $f [list set uifont $uifont]
2663         puts $f [list set tabstop $tabstop]
2664         puts $f [list set findmergefiles $findmergefiles]
2665         puts $f [list set maxgraphpct $maxgraphpct]
2666         puts $f [list set maxwidth $maxwidth]
2667         puts $f [list set cmitmode $cmitmode]
2668         puts $f [list set wrapcomment $wrapcomment]
2669         puts $f [list set autoselect $autoselect]
2670         puts $f [list set autosellen $autosellen]
2671         puts $f [list set showneartags $showneartags]
2672         puts $f [list set hideremotes $hideremotes]
2673         puts $f [list set showlocalchanges $showlocalchanges]
2674         puts $f [list set datetimeformat $datetimeformat]
2675         puts $f [list set limitdiffs $limitdiffs]
2676         puts $f [list set uicolor $uicolor]
2677         puts $f [list set want_ttk $want_ttk]
2678         puts $f [list set bgcolor $bgcolor]
2679         puts $f [list set fgcolor $fgcolor]
2680         puts $f [list set colors $colors]
2681         puts $f [list set diffcolors $diffcolors]
2682         puts $f [list set markbgcolor $markbgcolor]
2683         puts $f [list set diffcontext $diffcontext]
2684         puts $f [list set selectbgcolor $selectbgcolor]
2685         puts $f [list set extdifftool $extdifftool]
2686         puts $f [list set perfile_attrs $perfile_attrs]
2687
2688         puts $f "set geometry(main) [wm geometry .]"
2689         puts $f "set geometry(state) [wm state .]"
2690         puts $f "set geometry(topwidth) [winfo width .tf]"
2691         puts $f "set geometry(topheight) [winfo height .tf]"
2692         if {$use_ttk} {
2693             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2694             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2695         } else {
2696             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2697             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2698         }
2699         puts $f "set geometry(botwidth) [winfo width .bleft]"
2700         puts $f "set geometry(botheight) [winfo height .bleft]"
2701
2702         puts -nonewline $f "set permviews {"
2703         for {set v 0} {$v < $nextviewnum} {incr v} {
2704             if {$viewperm($v)} {
2705                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2706             }
2707         }
2708         puts $f "}"
2709         close $f
2710         file rename -force "~/.gitk-new" "~/.gitk"
2711     }
2712     set stuffsaved 1
2713 }
2714
2715 proc resizeclistpanes {win w} {
2716     global oldwidth use_ttk
2717     if {[info exists oldwidth($win)]} {
2718         if {$use_ttk} {
2719             set s0 [$win sashpos 0]
2720             set s1 [$win sashpos 1]
2721         } else {
2722             set s0 [$win sash coord 0]
2723             set s1 [$win sash coord 1]
2724         }
2725         if {$w < 60} {
2726             set sash0 [expr {int($w/2 - 2)}]
2727             set sash1 [expr {int($w*5/6 - 2)}]
2728         } else {
2729             set factor [expr {1.0 * $w / $oldwidth($win)}]
2730             set sash0 [expr {int($factor * [lindex $s0 0])}]
2731             set sash1 [expr {int($factor * [lindex $s1 0])}]
2732             if {$sash0 < 30} {
2733                 set sash0 30
2734             }
2735             if {$sash1 < $sash0 + 20} {
2736                 set sash1 [expr {$sash0 + 20}]
2737             }
2738             if {$sash1 > $w - 10} {
2739                 set sash1 [expr {$w - 10}]
2740                 if {$sash0 > $sash1 - 20} {
2741                     set sash0 [expr {$sash1 - 20}]
2742                 }
2743             }
2744         }
2745         if {$use_ttk} {
2746             $win sashpos 0 $sash0
2747             $win sashpos 1 $sash1
2748         } else {
2749             $win sash place 0 $sash0 [lindex $s0 1]
2750             $win sash place 1 $sash1 [lindex $s1 1]
2751         }
2752     }
2753     set oldwidth($win) $w
2754 }
2755
2756 proc resizecdetpanes {win w} {
2757     global oldwidth use_ttk
2758     if {[info exists oldwidth($win)]} {
2759         if {$use_ttk} {
2760             set s0 [$win sashpos 0]
2761         } else {
2762             set s0 [$win sash coord 0]
2763         }
2764         if {$w < 60} {
2765             set sash0 [expr {int($w*3/4 - 2)}]
2766         } else {
2767             set factor [expr {1.0 * $w / $oldwidth($win)}]
2768             set sash0 [expr {int($factor * [lindex $s0 0])}]
2769             if {$sash0 < 45} {
2770                 set sash0 45
2771             }
2772             if {$sash0 > $w - 15} {
2773                 set sash0 [expr {$w - 15}]
2774             }
2775         }
2776         if {$use_ttk} {
2777             $win sashpos 0 $sash0
2778         } else {
2779             $win sash place 0 $sash0 [lindex $s0 1]
2780         }
2781     }
2782     set oldwidth($win) $w
2783 }
2784
2785 proc allcanvs args {
2786     global canv canv2 canv3
2787     eval $canv $args
2788     eval $canv2 $args
2789     eval $canv3 $args
2790 }
2791
2792 proc bindall {event action} {
2793     global canv canv2 canv3
2794     bind $canv $event $action
2795     bind $canv2 $event $action
2796     bind $canv3 $event $action
2797 }
2798
2799 proc about {} {
2800     global uifont NS
2801     set w .about
2802     if {[winfo exists $w]} {
2803         raise $w
2804         return
2805     }
2806     ttk_toplevel $w
2807     wm title $w [mc "About gitk"]
2808     make_transient $w .
2809     message $w.m -text [mc "
2810 Gitk - a commit viewer for git
2811
2812 Copyright \u00a9 2005-2011 Paul Mackerras
2813
2814 Use and redistribute under the terms of the GNU General Public License"] \
2815             -justify center -aspect 400 -border 2 -bg white -relief groove
2816     pack $w.m -side top -fill x -padx 2 -pady 2
2817     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2818     pack $w.ok -side bottom
2819     bind $w <Visibility> "focus $w.ok"
2820     bind $w <Key-Escape> "destroy $w"
2821     bind $w <Key-Return> "destroy $w"
2822     tk::PlaceWindow $w widget .
2823 }
2824
2825 proc keys {} {
2826     global NS
2827     set w .keys
2828     if {[winfo exists $w]} {
2829         raise $w
2830         return
2831     }
2832     if {[tk windowingsystem] eq {aqua}} {
2833         set M1T Cmd
2834     } else {
2835         set M1T Ctrl
2836     }
2837     ttk_toplevel $w
2838     wm title $w [mc "Gitk key bindings"]
2839     make_transient $w .
2840     message $w.m -text "
2841 [mc "Gitk key bindings:"]
2842
2843 [mc "<%s-Q>             Quit" $M1T]
2844 [mc "<%s-W>             Close window" $M1T]
2845 [mc "<Home>             Move to first commit"]
2846 [mc "<End>              Move to last commit"]
2847 [mc "<Up>, p, k Move up one commit"]
2848 [mc "<Down>, n, j       Move down one commit"]
2849 [mc "<Left>, z, h       Go back in history list"]
2850 [mc "<Right>, x, l      Go forward in history list"]
2851 [mc "<PageUp>   Move up one page in commit list"]
2852 [mc "<PageDown> Move down one page in commit list"]
2853 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2854 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2855 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2856 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2857 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2858 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2859 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2860 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2861 [mc "<Delete>, b        Scroll diff view up one page"]
2862 [mc "<Backspace>        Scroll diff view up one page"]
2863 [mc "<Space>            Scroll diff view down one page"]
2864 [mc "u          Scroll diff view up 18 lines"]
2865 [mc "d          Scroll diff view down 18 lines"]
2866 [mc "<%s-F>             Find" $M1T]
2867 [mc "<%s-G>             Move to next find hit" $M1T]
2868 [mc "<Return>   Move to next find hit"]
2869 [mc "/          Focus the search box"]
2870 [mc "?          Move to previous find hit"]
2871 [mc "f          Scroll diff view to next file"]
2872 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2873 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2874 [mc "<%s-KP+>   Increase font size" $M1T]
2875 [mc "<%s-plus>  Increase font size" $M1T]
2876 [mc "<%s-KP->   Decrease font size" $M1T]
2877 [mc "<%s-minus> Decrease font size" $M1T]
2878 [mc "<F5>               Update"]
2879 " \
2880             -justify left -bg white -border 2 -relief groove
2881     pack $w.m -side top -fill both -padx 2 -pady 2
2882     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2883     bind $w <Key-Escape> [list destroy $w]
2884     pack $w.ok -side bottom
2885     bind $w <Visibility> "focus $w.ok"
2886     bind $w <Key-Escape> "destroy $w"
2887     bind $w <Key-Return> "destroy $w"
2888 }
2889
2890 # Procedures for manipulating the file list window at the
2891 # bottom right of the overall window.
2892
2893 proc treeview {w l openlevs} {
2894     global treecontents treediropen treeheight treeparent treeindex
2895
2896     set ix 0
2897     set treeindex() 0
2898     set lev 0
2899     set prefix {}
2900     set prefixend -1
2901     set prefendstack {}
2902     set htstack {}
2903     set ht 0
2904     set treecontents() {}
2905     $w conf -state normal
2906     foreach f $l {
2907         while {[string range $f 0 $prefixend] ne $prefix} {
2908             if {$lev <= $openlevs} {
2909                 $w mark set e:$treeindex($prefix) "end -1c"
2910                 $w mark gravity e:$treeindex($prefix) left
2911             }
2912             set treeheight($prefix) $ht
2913             incr ht [lindex $htstack end]
2914             set htstack [lreplace $htstack end end]
2915             set prefixend [lindex $prefendstack end]
2916             set prefendstack [lreplace $prefendstack end end]
2917             set prefix [string range $prefix 0 $prefixend]
2918             incr lev -1
2919         }
2920         set tail [string range $f [expr {$prefixend+1}] end]
2921         while {[set slash [string first "/" $tail]] >= 0} {
2922             lappend htstack $ht
2923             set ht 0
2924             lappend prefendstack $prefixend
2925             incr prefixend [expr {$slash + 1}]
2926             set d [string range $tail 0 $slash]
2927             lappend treecontents($prefix) $d
2928             set oldprefix $prefix
2929             append prefix $d
2930             set treecontents($prefix) {}
2931             set treeindex($prefix) [incr ix]
2932             set treeparent($prefix) $oldprefix
2933             set tail [string range $tail [expr {$slash+1}] end]
2934             if {$lev <= $openlevs} {
2935                 set ht 1
2936                 set treediropen($prefix) [expr {$lev < $openlevs}]
2937                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2938                 $w mark set d:$ix "end -1c"
2939                 $w mark gravity d:$ix left
2940                 set str "\n"
2941                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2942                 $w insert end $str
2943                 $w image create end -align center -image $bm -padx 1 \
2944                     -name a:$ix
2945                 $w insert end $d [highlight_tag $prefix]
2946                 $w mark set s:$ix "end -1c"
2947                 $w mark gravity s:$ix left
2948             }
2949             incr lev
2950         }
2951         if {$tail ne {}} {
2952             if {$lev <= $openlevs} {
2953                 incr ht
2954                 set str "\n"
2955                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2956                 $w insert end $str
2957                 $w insert end $tail [highlight_tag $f]
2958             }
2959             lappend treecontents($prefix) $tail
2960         }
2961     }
2962     while {$htstack ne {}} {
2963         set treeheight($prefix) $ht
2964         incr ht [lindex $htstack end]
2965         set htstack [lreplace $htstack end end]
2966         set prefixend [lindex $prefendstack end]
2967         set prefendstack [lreplace $prefendstack end end]
2968         set prefix [string range $prefix 0 $prefixend]
2969     }
2970     $w conf -state disabled
2971 }
2972
2973 proc linetoelt {l} {
2974     global treeheight treecontents
2975
2976     set y 2
2977     set prefix {}
2978     while {1} {
2979         foreach e $treecontents($prefix) {
2980             if {$y == $l} {
2981                 return "$prefix$e"
2982             }
2983             set n 1
2984             if {[string index $e end] eq "/"} {
2985                 set n $treeheight($prefix$e)
2986                 if {$y + $n > $l} {
2987                     append prefix $e
2988                     incr y
2989                     break
2990                 }
2991             }
2992             incr y $n
2993         }
2994     }
2995 }
2996
2997 proc highlight_tree {y prefix} {
2998     global treeheight treecontents cflist
2999
3000     foreach e $treecontents($prefix) {
3001         set path $prefix$e
3002         if {[highlight_tag $path] ne {}} {
3003             $cflist tag add bold $y.0 "$y.0 lineend"
3004         }
3005         incr y
3006         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3007             set y [highlight_tree $y $path]
3008         }
3009     }
3010     return $y
3011 }
3012
3013 proc treeclosedir {w dir} {
3014     global treediropen treeheight treeparent treeindex
3015
3016     set ix $treeindex($dir)
3017     $w conf -state normal
3018     $w delete s:$ix e:$ix
3019     set treediropen($dir) 0
3020     $w image configure a:$ix -image tri-rt
3021     $w conf -state disabled
3022     set n [expr {1 - $treeheight($dir)}]
3023     while {$dir ne {}} {
3024         incr treeheight($dir) $n
3025         set dir $treeparent($dir)
3026     }
3027 }
3028
3029 proc treeopendir {w dir} {
3030     global treediropen treeheight treeparent treecontents treeindex
3031
3032     set ix $treeindex($dir)
3033     $w conf -state normal
3034     $w image configure a:$ix -image tri-dn
3035     $w mark set e:$ix s:$ix
3036     $w mark gravity e:$ix right
3037     set lev 0
3038     set str "\n"
3039     set n [llength $treecontents($dir)]
3040     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3041         incr lev
3042         append str "\t"
3043         incr treeheight($x) $n
3044     }
3045     foreach e $treecontents($dir) {
3046         set de $dir$e
3047         if {[string index $e end] eq "/"} {
3048             set iy $treeindex($de)
3049             $w mark set d:$iy e:$ix
3050             $w mark gravity d:$iy left
3051             $w insert e:$ix $str
3052             set treediropen($de) 0
3053             $w image create e:$ix -align center -image tri-rt -padx 1 \
3054                 -name a:$iy
3055             $w insert e:$ix $e [highlight_tag $de]
3056             $w mark set s:$iy e:$ix
3057             $w mark gravity s:$iy left
3058             set treeheight($de) 1
3059         } else {
3060             $w insert e:$ix $str
3061             $w insert e:$ix $e [highlight_tag $de]
3062         }
3063     }
3064     $w mark gravity e:$ix right
3065     $w conf -state disabled
3066     set treediropen($dir) 1
3067     set top [lindex [split [$w index @0,0] .] 0]
3068     set ht [$w cget -height]
3069     set l [lindex [split [$w index s:$ix] .] 0]
3070     if {$l < $top} {
3071         $w yview $l.0
3072     } elseif {$l + $n + 1 > $top + $ht} {
3073         set top [expr {$l + $n + 2 - $ht}]
3074         if {$l < $top} {
3075             set top $l
3076         }
3077         $w yview $top.0
3078     }
3079 }
3080
3081 proc treeclick {w x y} {
3082     global treediropen cmitmode ctext cflist cflist_top
3083
3084     if {$cmitmode ne "tree"} return
3085     if {![info exists cflist_top]} return
3086     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3087     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3088     $cflist tag add highlight $l.0 "$l.0 lineend"
3089     set cflist_top $l
3090     if {$l == 1} {
3091         $ctext yview 1.0
3092         return
3093     }
3094     set e [linetoelt $l]
3095     if {[string index $e end] ne "/"} {
3096         showfile $e
3097     } elseif {$treediropen($e)} {
3098         treeclosedir $w $e
3099     } else {
3100         treeopendir $w $e
3101     }
3102 }
3103
3104 proc setfilelist {id} {
3105     global treefilelist cflist jump_to_here
3106
3107     treeview $cflist $treefilelist($id) 0
3108     if {$jump_to_here ne {}} {
3109         set f [lindex $jump_to_here 0]
3110         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3111             showfile $f
3112         }
3113     }
3114 }
3115
3116 image create bitmap tri-rt -background black -foreground blue -data {
3117     #define tri-rt_width 13
3118     #define tri-rt_height 13
3119     static unsigned char tri-rt_bits[] = {
3120        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3121        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3122        0x00, 0x00};
3123 } -maskdata {
3124     #define tri-rt-mask_width 13
3125     #define tri-rt-mask_height 13
3126     static unsigned char tri-rt-mask_bits[] = {
3127        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3128        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3129        0x08, 0x00};
3130 }
3131 image create bitmap tri-dn -background black -foreground blue -data {
3132     #define tri-dn_width 13
3133     #define tri-dn_height 13
3134     static unsigned char tri-dn_bits[] = {
3135        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3136        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3137        0x00, 0x00};
3138 } -maskdata {
3139     #define tri-dn-mask_width 13
3140     #define tri-dn-mask_height 13
3141     static unsigned char tri-dn-mask_bits[] = {
3142        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3143        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3144        0x00, 0x00};
3145 }
3146
3147 image create bitmap reficon-T -background black -foreground yellow -data {
3148     #define tagicon_width 13
3149     #define tagicon_height 9
3150     static unsigned char tagicon_bits[] = {
3151        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3152        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3153 } -maskdata {
3154     #define tagicon-mask_width 13
3155     #define tagicon-mask_height 9
3156     static unsigned char tagicon-mask_bits[] = {
3157        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3158        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3159 }
3160 set rectdata {
3161     #define headicon_width 13
3162     #define headicon_height 9
3163     static unsigned char headicon_bits[] = {
3164        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3165        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3166 }
3167 set rectmask {
3168     #define headicon-mask_width 13
3169     #define headicon-mask_height 9
3170     static unsigned char headicon-mask_bits[] = {
3171        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3172        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3173 }
3174 image create bitmap reficon-H -background black -foreground green \
3175     -data $rectdata -maskdata $rectmask
3176 image create bitmap reficon-o -background black -foreground "#ddddff" \
3177     -data $rectdata -maskdata $rectmask
3178
3179 proc init_flist {first} {
3180     global cflist cflist_top difffilestart
3181
3182     $cflist conf -state normal
3183     $cflist delete 0.0 end
3184     if {$first ne {}} {
3185         $cflist insert end $first
3186         set cflist_top 1
3187         $cflist tag add highlight 1.0 "1.0 lineend"
3188     } else {
3189         catch {unset cflist_top}
3190     }
3191     $cflist conf -state disabled
3192     set difffilestart {}
3193 }
3194
3195 proc highlight_tag {f} {
3196     global highlight_paths
3197
3198     foreach p $highlight_paths {
3199         if {[string match $p $f]} {
3200             return "bold"
3201         }
3202     }
3203     return {}
3204 }
3205
3206 proc highlight_filelist {} {
3207     global cmitmode cflist
3208
3209     $cflist conf -state normal
3210     if {$cmitmode ne "tree"} {
3211         set end [lindex [split [$cflist index end] .] 0]
3212         for {set l 2} {$l < $end} {incr l} {
3213             set line [$cflist get $l.0 "$l.0 lineend"]
3214             if {[highlight_tag $line] ne {}} {
3215                 $cflist tag add bold $l.0 "$l.0 lineend"
3216             }
3217         }
3218     } else {
3219         highlight_tree 2 {}
3220     }
3221     $cflist conf -state disabled
3222 }
3223
3224 proc unhighlight_filelist {} {
3225     global cflist
3226
3227     $cflist conf -state normal
3228     $cflist tag remove bold 1.0 end
3229     $cflist conf -state disabled
3230 }
3231
3232 proc add_flist {fl} {
3233     global cflist
3234
3235     $cflist conf -state normal
3236     foreach f $fl {
3237         $cflist insert end "\n"
3238         $cflist insert end $f [highlight_tag $f]
3239     }
3240     $cflist conf -state disabled
3241 }
3242
3243 proc sel_flist {w x y} {
3244     global ctext difffilestart cflist cflist_top cmitmode
3245
3246     if {$cmitmode eq "tree"} return
3247     if {![info exists cflist_top]} return
3248     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3249     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3250     $cflist tag add highlight $l.0 "$l.0 lineend"
3251     set cflist_top $l
3252     if {$l == 1} {
3253         $ctext yview 1.0
3254     } else {
3255         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3256     }
3257 }
3258
3259 proc pop_flist_menu {w X Y x y} {
3260     global ctext cflist cmitmode flist_menu flist_menu_file
3261     global treediffs diffids
3262
3263     stopfinding
3264     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3265     if {$l <= 1} return
3266     if {$cmitmode eq "tree"} {
3267         set e [linetoelt $l]
3268         if {[string index $e end] eq "/"} return
3269     } else {
3270         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3271     }
3272     set flist_menu_file $e
3273     set xdiffstate "normal"
3274     if {$cmitmode eq "tree"} {
3275         set xdiffstate "disabled"
3276     }
3277     # Disable "External diff" item in tree mode
3278     $flist_menu entryconf 2 -state $xdiffstate
3279     tk_popup $flist_menu $X $Y
3280 }
3281
3282 proc find_ctext_fileinfo {line} {
3283     global ctext_file_names ctext_file_lines
3284
3285     set ok [bsearch $ctext_file_lines $line]
3286     set tline [lindex $ctext_file_lines $ok]
3287
3288     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3289         return {}
3290     } else {
3291         return [list [lindex $ctext_file_names $ok] $tline]
3292     }
3293 }
3294
3295 proc pop_diff_menu {w X Y x y} {
3296     global ctext diff_menu flist_menu_file
3297     global diff_menu_txtpos diff_menu_line
3298     global diff_menu_filebase
3299
3300     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3301     set diff_menu_line [lindex $diff_menu_txtpos 0]
3302     # don't pop up the menu on hunk-separator or file-separator lines
3303     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3304         return
3305     }
3306     stopfinding
3307     set f [find_ctext_fileinfo $diff_menu_line]
3308     if {$f eq {}} return
3309     set flist_menu_file [lindex $f 0]
3310     set diff_menu_filebase [lindex $f 1]
3311     tk_popup $diff_menu $X $Y
3312 }
3313
3314 proc flist_hl {only} {
3315     global flist_menu_file findstring gdttype
3316
3317     set x [shellquote $flist_menu_file]
3318     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3319         set findstring $x
3320     } else {
3321         append findstring " " $x
3322     }
3323     set gdttype [mc "touching paths:"]
3324 }
3325
3326 proc gitknewtmpdir {} {
3327     global diffnum gitktmpdir gitdir
3328
3329     if {![info exists gitktmpdir]} {
3330         set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3331         if {[catch {file mkdir $gitktmpdir} err]} {
3332             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3333             unset gitktmpdir
3334             return {}
3335         }
3336         set diffnum 0
3337     }
3338     incr diffnum
3339     set diffdir [file join $gitktmpdir $diffnum]
3340     if {[catch {file mkdir $diffdir} err]} {
3341         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3342         return {}
3343     }
3344     return $diffdir
3345 }
3346
3347 proc save_file_from_commit {filename output what} {
3348     global nullfile
3349
3350     if {[catch {exec git show $filename -- > $output} err]} {
3351         if {[string match "fatal: bad revision *" $err]} {
3352             return $nullfile
3353         }
3354         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3355         return {}
3356     }
3357     return $output
3358 }
3359
3360 proc external_diff_get_one_file {diffid filename diffdir} {
3361     global nullid nullid2 nullfile
3362     global worktree
3363
3364     if {$diffid == $nullid} {
3365         set difffile [file join $worktree $filename]
3366         if {[file exists $difffile]} {
3367             return $difffile
3368         }
3369         return $nullfile
3370     }
3371     if {$diffid == $nullid2} {
3372         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3373         return [save_file_from_commit :$filename $difffile index]
3374     }
3375     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3376     return [save_file_from_commit $diffid:$filename $difffile \
3377                "revision $diffid"]
3378 }
3379
3380 proc external_diff {} {
3381     global nullid nullid2
3382     global flist_menu_file
3383     global diffids
3384     global extdifftool
3385
3386     if {[llength $diffids] == 1} {
3387         # no reference commit given
3388         set diffidto [lindex $diffids 0]
3389         if {$diffidto eq $nullid} {
3390             # diffing working copy with index
3391             set diffidfrom $nullid2
3392         } elseif {$diffidto eq $nullid2} {
3393             # diffing index with HEAD
3394             set diffidfrom "HEAD"
3395         } else {
3396             # use first parent commit
3397             global parentlist selectedline
3398             set diffidfrom [lindex $parentlist $selectedline 0]
3399         }
3400     } else {
3401         set diffidfrom [lindex $diffids 0]
3402         set diffidto [lindex $diffids 1]
3403     }
3404
3405     # make sure that several diffs wont collide
3406     set diffdir [gitknewtmpdir]
3407     if {$diffdir eq {}} return
3408
3409     # gather files to diff
3410     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3411     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3412
3413     if {$difffromfile ne {} && $difftofile ne {}} {
3414         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3415         if {[catch {set fl [open |$cmd r]} err]} {
3416             file delete -force $diffdir
3417             error_popup "$extdifftool: [mc "command failed:"] $err"
3418         } else {
3419             fconfigure $fl -blocking 0
3420             filerun $fl [list delete_at_eof $fl $diffdir]
3421         }
3422     }
3423 }
3424
3425 proc find_hunk_blamespec {base line} {
3426     global ctext
3427
3428     # Find and parse the hunk header
3429     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3430     if {$s_lix eq {}} return
3431
3432     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3433     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3434             s_line old_specs osz osz1 new_line nsz]} {
3435         return
3436     }
3437
3438     # base lines for the parents
3439     set base_lines [list $new_line]
3440     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3441         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3442                 old_spec old_line osz]} {
3443             return
3444         }
3445         lappend base_lines $old_line
3446     }
3447
3448     # Now scan the lines to determine offset within the hunk
3449     set max_parent [expr {[llength $base_lines]-2}]
3450     set dline 0
3451     set s_lno [lindex [split $s_lix "."] 0]
3452
3453     # Determine if the line is removed
3454     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3455     if {[string match {[-+ ]*} $chunk]} {
3456         set removed_idx [string first "-" $chunk]
3457         # Choose a parent index
3458         if {$removed_idx >= 0} {
3459             set parent $removed_idx
3460         } else {
3461             set unchanged_idx [string first " " $chunk]
3462             if {$unchanged_idx >= 0} {
3463                 set parent $unchanged_idx
3464             } else {
3465                 # blame the current commit
3466                 set parent -1
3467             }
3468         }
3469         # then count other lines that belong to it
3470         for {set i $line} {[incr i -1] > $s_lno} {} {
3471             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3472             # Determine if the line is removed
3473             set removed_idx [string first "-" $chunk]
3474             if {$parent >= 0} {
3475                 set code [string index $chunk $parent]
3476                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3477                     incr dline
3478                 }
3479             } else {
3480                 if {$removed_idx < 0} {
3481                     incr dline
3482                 }
3483             }
3484         }
3485         incr parent
3486     } else {
3487         set parent 0
3488     }
3489
3490     incr dline [lindex $base_lines $parent]
3491     return [list $parent $dline]
3492 }
3493
3494 proc external_blame_diff {} {
3495     global currentid cmitmode
3496     global diff_menu_txtpos diff_menu_line
3497     global diff_menu_filebase flist_menu_file
3498
3499     if {$cmitmode eq "tree"} {
3500         set parent_idx 0
3501         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3502     } else {
3503         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3504         if {$hinfo ne {}} {
3505             set parent_idx [lindex $hinfo 0]
3506             set line [lindex $hinfo 1]
3507         } else {
3508             set parent_idx 0
3509             set line 0
3510         }
3511     }
3512
3513     external_blame $parent_idx $line
3514 }
3515
3516 # Find the SHA1 ID of the blob for file $fname in the index
3517 # at stage 0 or 2
3518 proc index_sha1 {fname} {
3519     set f [open [list | git ls-files -s $fname] r]
3520     while {[gets $f line] >= 0} {
3521         set info [lindex [split $line "\t"] 0]
3522         set stage [lindex $info 2]
3523         if {$stage eq "0" || $stage eq "2"} {
3524             close $f
3525             return [lindex $info 1]
3526         }
3527     }
3528     close $f
3529     return {}
3530 }
3531
3532 # Turn an absolute path into one relative to the current directory
3533 proc make_relative {f} {
3534     if {[file pathtype $f] eq "relative"} {
3535         return $f
3536     }
3537     set elts [file split $f]
3538     set here [file split [pwd]]
3539     set ei 0
3540     set hi 0
3541     set res {}
3542     foreach d $here {
3543         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3544             lappend res ".."
3545         } else {
3546             incr ei
3547         }
3548         incr hi
3549     }
3550     set elts [concat $res [lrange $elts $ei end]]
3551     return [eval file join $elts]
3552 }
3553
3554 proc external_blame {parent_idx {line {}}} {
3555     global flist_menu_file cdup
3556     global nullid nullid2
3557     global parentlist selectedline currentid
3558
3559     if {$parent_idx > 0} {
3560         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3561     } else {
3562         set base_commit $currentid
3563     }
3564
3565     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3566         error_popup [mc "No such commit"]
3567         return
3568     }
3569
3570     set cmdline [list git gui blame]
3571     if {$line ne {} && $line > 1} {
3572         lappend cmdline "--line=$line"
3573     }
3574     set f [file join $cdup $flist_menu_file]
3575     # Unfortunately it seems git gui blame doesn't like
3576     # being given an absolute path...
3577     set f [make_relative $f]
3578     lappend cmdline $base_commit $f
3579     if {[catch {eval exec $cmdline &} err]} {
3580         error_popup "[mc "git gui blame: command failed:"] $err"
3581     }
3582 }
3583
3584 proc show_line_source {} {
3585     global cmitmode currentid parents curview blamestuff blameinst
3586     global diff_menu_line diff_menu_filebase flist_menu_file
3587     global nullid nullid2 gitdir cdup
3588
3589     set from_index {}
3590     if {$cmitmode eq "tree"} {
3591         set id $currentid
3592         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3593     } else {
3594         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3595         if {$h eq {}} return
3596         set pi [lindex $h 0]
3597         if {$pi == 0} {
3598             mark_ctext_line $diff_menu_line
3599             return
3600         }
3601         incr pi -1
3602         if {$currentid eq $nullid} {
3603             if {$pi > 0} {
3604                 # must be a merge in progress...
3605                 if {[catch {
3606                     # get the last line from .git/MERGE_HEAD
3607                     set f [open [file join $gitdir MERGE_HEAD] r]
3608                     set id [lindex [split [read $f] "\n"] end-1]
3609                     close $f
3610                 } err]} {
3611                     error_popup [mc "Couldn't read merge head: %s" $err]
3612                     return
3613                 }
3614             } elseif {$parents($curview,$currentid) eq $nullid2} {
3615                 # need to do the blame from the index
3616                 if {[catch {
3617                     set from_index [index_sha1 $flist_menu_file]
3618                 } err]} {
3619                     error_popup [mc "Error reading index: %s" $err]
3620                     return
3621                 }
3622             } else {
3623                 set id $parents($curview,$currentid)
3624             }
3625         } else {
3626             set id [lindex $parents($curview,$currentid) $pi]
3627         }
3628         set line [lindex $h 1]
3629     }
3630     set blameargs {}
3631     if {$from_index ne {}} {
3632         lappend blameargs | git cat-file blob $from_index
3633     }
3634     lappend blameargs | git blame -p -L$line,+1
3635     if {$from_index ne {}} {
3636         lappend blameargs --contents -
3637     } else {
3638         lappend blameargs $id
3639     }
3640     lappend blameargs -- [file join $cdup $flist_menu_file]
3641     if {[catch {
3642         set f [open $blameargs r]
3643     } err]} {
3644         error_popup [mc "Couldn't start git blame: %s" $err]
3645         return
3646     }
3647     nowbusy blaming [mc "Searching"]
3648     fconfigure $f -blocking 0
3649     set i [reg_instance $f]
3650     set blamestuff($i) {}
3651     set blameinst $i
3652     filerun $f [list read_line_source $f $i]
3653 }
3654
3655 proc stopblaming {} {
3656     global blameinst
3657
3658     if {[info exists blameinst]} {
3659         stop_instance $blameinst
3660         unset blameinst
3661         notbusy blaming
3662     }
3663 }
3664
3665 proc read_line_source {fd inst} {
3666     global blamestuff curview commfd blameinst nullid nullid2
3667
3668     while {[gets $fd line] >= 0} {
3669         lappend blamestuff($inst) $line
3670     }
3671     if {![eof $fd]} {
3672         return 1
3673     }
3674     unset commfd($inst)
3675     unset blameinst
3676     notbusy blaming
3677     fconfigure $fd -blocking 1
3678     if {[catch {close $fd} err]} {
3679         error_popup [mc "Error running git blame: %s" $err]
3680         return 0
3681     }
3682
3683     set fname {}
3684     set line [split [lindex $blamestuff($inst) 0] " "]
3685     set id [lindex $line 0]
3686     set lnum [lindex $line 1]
3687     if {[string length $id] == 40 && [string is xdigit $id] &&
3688         [string is digit -strict $lnum]} {
3689         # look for "filename" line
3690         foreach l $blamestuff($inst) {
3691             if {[string match "filename *" $l]} {
3692                 set fname [string range $l 9 end]
3693                 break
3694             }
3695         }
3696     }
3697     if {$fname ne {}} {
3698         # all looks good, select it
3699         if {$id eq $nullid} {
3700             # blame uses all-zeroes to mean not committed,
3701             # which would mean a change in the index
3702             set id $nullid2
3703         }
3704         if {[commitinview $id $curview]} {
3705             selectline [rowofcommit $id] 1 [list $fname $lnum]
3706         } else {
3707             error_popup [mc "That line comes from commit %s, \
3708                              which is not in this view" [shortids $id]]
3709         }
3710     } else {
3711         puts "oops couldn't parse git blame output"
3712     }
3713     return 0
3714 }
3715
3716 # delete $dir when we see eof on $f (presumably because the child has exited)
3717 proc delete_at_eof {f dir} {
3718     while {[gets $f line] >= 0} {}
3719     if {[eof $f]} {
3720         if {[catch {close $f} err]} {
3721             error_popup "[mc "External diff viewer failed:"] $err"
3722         }
3723         file delete -force $dir
3724         return 0
3725     }
3726     return 1
3727 }
3728
3729 # Functions for adding and removing shell-type quoting
3730
3731 proc shellquote {str} {
3732     if {![string match "*\['\"\\ \t]*" $str]} {
3733         return $str
3734     }
3735     if {![string match "*\['\"\\]*" $str]} {
3736         return "\"$str\""
3737     }
3738     if {![string match "*'*" $str]} {
3739         return "'$str'"
3740     }
3741     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3742 }
3743
3744 proc shellarglist {l} {
3745     set str {}
3746     foreach a $l {
3747         if {$str ne {}} {
3748             append str " "
3749         }
3750         append str [shellquote $a]
3751     }
3752     return $str
3753 }
3754
3755 proc shelldequote {str} {
3756     set ret {}
3757     set used -1
3758     while {1} {
3759         incr used
3760         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3761             append ret [string range $str $used end]
3762             set used [string length $str]
3763             break
3764         }
3765         set first [lindex $first 0]
3766         set ch [string index $str $first]
3767         if {$first > $used} {
3768             append ret [string range $str $used [expr {$first - 1}]]
3769             set used $first
3770         }
3771         if {$ch eq " " || $ch eq "\t"} break
3772         incr used
3773         if {$ch eq "'"} {
3774             set first [string first "'" $str $used]
3775             if {$first < 0} {
3776                 error "unmatched single-quote"
3777             }
3778             append ret [string range $str $used [expr {$first - 1}]]
3779             set used $first
3780             continue
3781         }
3782         if {$ch eq "\\"} {
3783             if {$used >= [string length $str]} {
3784                 error "trailing backslash"
3785             }
3786             append ret [string index $str $used]
3787             continue
3788         }
3789         # here ch == "\""
3790         while {1} {
3791             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3792                 error "unmatched double-quote"
3793             }
3794             set first [lindex $first 0]
3795             set ch [string index $str $first]
3796             if {$first > $used} {
3797                 append ret [string range $str $used [expr {$first - 1}]]
3798                 set used $first
3799             }
3800             if {$ch eq "\""} break
3801             incr used
3802             append ret [string index $str $used]
3803             incr used
3804         }
3805     }