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 [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     }
3806     return [list $used $ret]
3807 }
3808
3809 proc shellsplit {str} {
3810     set l {}
3811     while {1} {
3812         set str [string trimleft $str]
3813         if {$str eq {}} break
3814         set dq [shelldequote $str]
3815         set n [lindex $dq 0]
3816         set word [lindex $dq 1]
3817         set str [string range $str $n end]
3818         lappend l $word
3819     }
3820     return $l
3821 }
3822
3823 # Code to implement multiple views
3824
3825 proc newview {ishighlight} {
3826     global nextviewnum newviewname newishighlight
3827     global revtreeargs viewargscmd newviewopts curview
3828
3829     set newishighlight $ishighlight
3830     set top .gitkview
3831     if {[winfo exists $top]} {
3832         raise $top
3833         return
3834     }
3835     decode_view_opts $nextviewnum $revtreeargs
3836     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3837     set newviewopts($nextviewnum,perm) 0
3838     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3839     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3840 }
3841
3842 set known_view_options {
3843     {perm      b    .  {}               {mc "Remember this view"}}
3844     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3845     {refs      t15  .. {}               {mc "Branches & tags:"}}
3846     {allrefs   b    *. "--all"          {mc "All refs"}}
3847     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3848     {tags      b    .  "--tags"         {mc "All tags"}}
3849     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3850     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3851     {author    t15  .. "--author=*"     {mc "Author:"}}
3852     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3853     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3854     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3855     {changes_l l    +  {}               {mc "Changes to Files:"}}
3856     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3857     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3858     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3859     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3860     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3861     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3862     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3863     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3864     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3865     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3866     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3867     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3868     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
3869     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
3870     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
3871     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
3872     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
3873     }
3874
3875 # Convert $newviewopts($n, ...) into args for git log.
3876 proc encode_view_opts {n} {
3877     global known_view_options newviewopts
3878
3879     set rargs [list]
3880     foreach opt $known_view_options {
3881         set patterns [lindex $opt 3]
3882         if {$patterns eq {}} continue
3883         set pattern [lindex $patterns 0]
3884
3885         if {[lindex $opt 1] eq "b"} {
3886             set val $newviewopts($n,[lindex $opt 0])
3887             if {$val} {
3888                 lappend rargs $pattern
3889             }
3890         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3891             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3892             set val $newviewopts($n,$button_id)
3893             if {$val eq $value} {
3894                 lappend rargs $pattern
3895             }
3896         } else {
3897             set val $newviewopts($n,[lindex $opt 0])
3898             set val [string trim $val]
3899             if {$val ne {}} {
3900                 set pfix [string range $pattern 0 end-1]
3901                 lappend rargs $pfix$val
3902             }
3903         }
3904     }
3905     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3906     return [concat $rargs [shellsplit $newviewopts($n,args)]]
3907 }
3908
3909 # Fill $newviewopts($n, ...) based on args for git log.
3910 proc decode_view_opts {n view_args} {
3911     global known_view_options newviewopts
3912
3913     foreach opt $known_view_options {
3914         set id [lindex $opt 0]
3915         if {[lindex $opt 1] eq "b"} {
3916             # Checkboxes
3917             set val 0
3918         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3919             # Radiobuttons
3920             regexp {^(.*_)} $id uselessvar id
3921             set val 0
3922         } else {
3923             # Text fields
3924             set val {}
3925         }
3926         set newviewopts($n,$id) $val
3927     }
3928     set oargs [list]
3929     set refargs [list]
3930     foreach arg $view_args {
3931         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3932             && ![info exists found(limit)]} {
3933             set newviewopts($n,limit) $cnt
3934             set found(limit) 1
3935             continue
3936         }
3937         catch { unset val }
3938         foreach opt $known_view_options {
3939             set id [lindex $opt 0]
3940             if {[info exists found($id)]} continue
3941             foreach pattern [lindex $opt 3] {
3942                 if {![string match $pattern $arg]} continue
3943                 if {[lindex $opt 1] eq "b"} {
3944                     # Check buttons
3945                     set val 1
3946                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3947                     # Radio buttons
3948                     regexp {^(.*_)} $id uselessvar id
3949                     set val $num
3950                 } else {
3951                     # Text input fields
3952                     set size [string length $pattern]
3953                     set val [string range $arg [expr {$size-1}] end]
3954                 }
3955                 set newviewopts($n,$id) $val
3956                 set found($id) 1
3957                 break
3958             }
3959             if {[info exists val]} break
3960         }
3961         if {[info exists val]} continue
3962         if {[regexp {^-} $arg]} {
3963             lappend oargs $arg
3964         } else {
3965             lappend refargs $arg
3966         }
3967     }
3968     set newviewopts($n,refs) [shellarglist $refargs]
3969     set newviewopts($n,args) [shellarglist $oargs]
3970 }
3971
3972 proc edit_or_newview {} {
3973     global curview
3974
3975     if {$curview > 0} {
3976         editview
3977     } else {
3978         newview 0
3979     }
3980 }
3981
3982 proc editview {} {
3983     global curview
3984     global viewname viewperm newviewname newviewopts
3985     global viewargs viewargscmd
3986
3987     set top .gitkvedit-$curview
3988     if {[winfo exists $top]} {
3989         raise $top
3990         return
3991     }
3992     decode_view_opts $curview $viewargs($curview)
3993     set newviewname($curview)      $viewname($curview)
3994     set newviewopts($curview,perm) $viewperm($curview)
3995     set newviewopts($curview,cmd)  $viewargscmd($curview)
3996     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3997 }
3998
3999 proc vieweditor {top n title} {
4000     global newviewname newviewopts viewfiles bgcolor
4001     global known_view_options NS
4002
4003     ttk_toplevel $top
4004     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4005     make_transient $top .
4006
4007     # View name
4008     ${NS}::frame $top.nfr
4009     ${NS}::label $top.nl -text [mc "View Name"]
4010     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4011     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4012     pack $top.nl -in $top.nfr -side left -padx {0 5}
4013     pack $top.name -in $top.nfr -side left -padx {0 25}
4014
4015     # View options
4016     set cframe $top.nfr
4017     set cexpand 0
4018     set cnt 0
4019     foreach opt $known_view_options {
4020         set id [lindex $opt 0]
4021         set type [lindex $opt 1]
4022         set flags [lindex $opt 2]
4023         set title [eval [lindex $opt 4]]
4024         set lxpad 0
4025
4026         if {$flags eq "+" || $flags eq "*"} {
4027             set cframe $top.fr$cnt
4028             incr cnt
4029             ${NS}::frame $cframe
4030             pack $cframe -in $top -fill x -pady 3 -padx 3
4031             set cexpand [expr {$flags eq "*"}]
4032         } elseif {$flags eq ".." || $flags eq "*."} {
4033             set cframe $top.fr$cnt
4034             incr cnt
4035             ${NS}::frame $cframe
4036             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4037             set cexpand [expr {$flags eq "*."}]
4038         } else {
4039             set lxpad 5
4040         }
4041
4042         if {$type eq "l"} {
4043             ${NS}::label $cframe.l_$id -text $title
4044             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4045         } elseif {$type eq "b"} {
4046             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4047             pack $cframe.c_$id -in $cframe -side left \
4048                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4049         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4050             regexp {^(.*_)} $id uselessvar button_id
4051             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4052             pack $cframe.c_$id -in $cframe -side left \
4053                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4054         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4055             ${NS}::label $cframe.l_$id -text $title
4056             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4057                 -textvariable newviewopts($n,$id)
4058             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4059             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4060         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4061             ${NS}::label $cframe.l_$id -text $title
4062             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4063                 -textvariable newviewopts($n,$id)
4064             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4065             pack $cframe.e_$id -in $cframe -side top -fill x
4066         } elseif {$type eq "path"} {
4067             ${NS}::label $top.l -text $title
4068             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4069             text $top.t -width 40 -height 5 -background $bgcolor
4070             if {[info exists viewfiles($n)]} {
4071                 foreach f $viewfiles($n) {
4072                     $top.t insert end $f
4073                     $top.t insert end "\n"
4074                 }
4075                 $top.t delete {end - 1c} end
4076                 $top.t mark set insert 0.0
4077             }
4078             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4079         }
4080     }
4081
4082     ${NS}::frame $top.buts
4083     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4084     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4085     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4086     bind $top <Control-Return> [list newviewok $top $n]
4087     bind $top <F5> [list newviewok $top $n 1]
4088     bind $top <Escape> [list destroy $top]
4089     grid $top.buts.ok $top.buts.apply $top.buts.can
4090     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4091     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4092     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4093     pack $top.buts -in $top -side top -fill x
4094     focus $top.t
4095 }
4096
4097 proc doviewmenu {m first cmd op argv} {
4098     set nmenu [$m index end]
4099     for {set i $first} {$i <= $nmenu} {incr i} {
4100         if {[$m entrycget $i -command] eq $cmd} {
4101             eval $m $op $i $argv
4102             break
4103         }
4104     }
4105 }
4106
4107 proc allviewmenus {n op args} {
4108     # global viewhlmenu
4109
4110     doviewmenu .bar.view 5 [list showview $n] $op $args
4111     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4112 }
4113
4114 proc newviewok {top n {apply 0}} {
4115     global nextviewnum newviewperm newviewname newishighlight
4116     global viewname viewfiles viewperm selectedview curview
4117     global viewargs viewargscmd newviewopts viewhlmenu
4118
4119     if {[catch {
4120         set newargs [encode_view_opts $n]
4121     } err]} {
4122         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4123         return
4124     }
4125     set files {}
4126     foreach f [split [$top.t get 0.0 end] "\n"] {
4127         set ft [string trim $f]
4128         if {$ft ne {}} {
4129             lappend files $ft
4130         }
4131     }
4132     if {![info exists viewfiles($n)]} {
4133         # creating a new view
4134         incr nextviewnum
4135         set viewname($n) $newviewname($n)
4136         set viewperm($n) $newviewopts($n,perm)
4137         set viewfiles($n) $files
4138         set viewargs($n) $newargs
4139         set viewargscmd($n) $newviewopts($n,cmd)
4140         addviewmenu $n
4141         if {!$newishighlight} {
4142             run showview $n
4143         } else {
4144             run addvhighlight $n
4145         }
4146     } else {
4147         # editing an existing view
4148         set viewperm($n) $newviewopts($n,perm)
4149         if {$newviewname($n) ne $viewname($n)} {
4150             set viewname($n) $newviewname($n)
4151             doviewmenu .bar.view 5 [list showview $n] \
4152                 entryconf [list -label $viewname($n)]
4153             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4154                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4155         }
4156         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4157                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4158             set viewfiles($n) $files
4159             set viewargs($n) $newargs
4160             set viewargscmd($n) $newviewopts($n,cmd)
4161             if {$curview == $n} {
4162                 run reloadcommits
4163             }
4164         }
4165     }
4166     if {$apply} return
4167     catch {destroy $top}
4168 }
4169
4170 proc delview {} {
4171     global curview viewperm hlview selectedhlview
4172
4173     if {$curview == 0} return
4174     if {[info exists hlview] && $hlview == $curview} {
4175         set selectedhlview [mc "None"]
4176         unset hlview
4177     }
4178     allviewmenus $curview delete
4179     set viewperm($curview) 0
4180     showview 0
4181 }
4182
4183 proc addviewmenu {n} {
4184     global viewname viewhlmenu
4185
4186     .bar.view add radiobutton -label $viewname($n) \
4187         -command [list showview $n] -variable selectedview -value $n
4188     #$viewhlmenu add radiobutton -label $viewname($n) \
4189     #   -command [list addvhighlight $n] -variable selectedhlview
4190 }
4191
4192 proc showview {n} {
4193     global curview cached_commitrow ordertok
4194     global displayorder parentlist rowidlist rowisopt rowfinal
4195     global colormap rowtextx nextcolor canvxmax
4196     global numcommits viewcomplete
4197     global selectedline currentid canv canvy0
4198     global treediffs
4199     global pending_select mainheadid
4200     global commitidx
4201     global selectedview
4202     global hlview selectedhlview commitinterest
4203
4204     if {$n == $curview} return
4205     set selid {}
4206     set ymax [lindex [$canv cget -scrollregion] 3]
4207     set span [$canv yview]
4208     set ytop [expr {[lindex $span 0] * $ymax}]
4209     set ybot [expr {[lindex $span 1] * $ymax}]
4210     set yscreen [expr {($ybot - $ytop) / 2}]
4211     if {$selectedline ne {}} {
4212         set selid $currentid
4213         set y [yc $selectedline]
4214         if {$ytop < $y && $y < $ybot} {
4215             set yscreen [expr {$y - $ytop}]
4216         }
4217     } elseif {[info exists pending_select]} {
4218         set selid $pending_select
4219         unset pending_select
4220     }
4221     unselectline
4222     normalline
4223     catch {unset treediffs}
4224     clear_display
4225     if {[info exists hlview] && $hlview == $n} {
4226         unset hlview
4227         set selectedhlview [mc "None"]
4228     }
4229     catch {unset commitinterest}
4230     catch {unset cached_commitrow}
4231     catch {unset ordertok}
4232
4233     set curview $n
4234     set selectedview $n
4235     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4236     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4237
4238     run refill_reflist
4239     if {![info exists viewcomplete($n)]} {
4240         getcommits $selid
4241         return
4242     }
4243
4244     set displayorder {}
4245     set parentlist {}
4246     set rowidlist {}
4247     set rowisopt {}
4248     set rowfinal {}
4249     set numcommits $commitidx($n)
4250
4251     catch {unset colormap}
4252     catch {unset rowtextx}
4253     set nextcolor 0
4254     set canvxmax [$canv cget -width]
4255     set curview $n
4256     set row 0
4257     setcanvscroll
4258     set yf 0
4259     set row {}
4260     if {$selid ne {} && [commitinview $selid $n]} {
4261         set row [rowofcommit $selid]
4262         # try to get the selected row in the same position on the screen
4263         set ymax [lindex [$canv cget -scrollregion] 3]
4264         set ytop [expr {[yc $row] - $yscreen}]
4265         if {$ytop < 0} {
4266             set ytop 0
4267         }
4268         set yf [expr {$ytop * 1.0 / $ymax}]
4269     }
4270     allcanvs yview moveto $yf
4271     drawvisible
4272     if {$row ne {}} {
4273         selectline $row 0
4274     } elseif {!$viewcomplete($n)} {
4275         reset_pending_select $selid
4276     } else {
4277         reset_pending_select {}
4278
4279         if {[commitinview $pending_select $curview]} {
4280             selectline [rowofcommit $pending_select] 1
4281         } else {
4282             set row [first_real_row]
4283             if {$row < $numcommits} {
4284                 selectline $row 0
4285             }
4286         }
4287     }
4288     if {!$viewcomplete($n)} {
4289         if {$numcommits == 0} {
4290             show_status [mc "Reading commits..."]
4291         }
4292     } elseif {$numcommits == 0} {
4293         show_status [mc "No commits selected"]
4294     }
4295 }
4296
4297 # Stuff relating to the highlighting facility
4298
4299 proc ishighlighted {id} {
4300     global vhighlights fhighlights nhighlights rhighlights
4301
4302     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4303         return $nhighlights($id)
4304     }
4305     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4306         return $vhighlights($id)
4307     }
4308     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4309         return $fhighlights($id)
4310     }
4311     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4312         return $rhighlights($id)
4313     }
4314     return 0
4315 }
4316
4317 proc bolden {id font} {
4318     global canv linehtag currentid boldids need_redisplay markedid
4319
4320     # need_redisplay = 1 means the display is stale and about to be redrawn
4321     if {$need_redisplay} return
4322     lappend boldids $id
4323     $canv itemconf $linehtag($id) -font $font
4324     if {[info exists currentid] && $id eq $currentid} {
4325         $canv delete secsel
4326         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4327                    -outline {{}} -tags secsel \
4328                    -fill [$canv cget -selectbackground]]
4329         $canv lower $t
4330     }
4331     if {[info exists markedid] && $id eq $markedid} {
4332         make_idmark $id
4333     }
4334 }
4335
4336 proc bolden_name {id font} {
4337     global canv2 linentag currentid boldnameids need_redisplay
4338
4339     if {$need_redisplay} return
4340     lappend boldnameids $id
4341     $canv2 itemconf $linentag($id) -font $font
4342     if {[info exists currentid] && $id eq $currentid} {
4343         $canv2 delete secsel
4344         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4345                    -outline {{}} -tags secsel \
4346                    -fill [$canv2 cget -selectbackground]]
4347         $canv2 lower $t
4348     }
4349 }
4350
4351 proc unbolden {} {
4352     global boldids
4353
4354     set stillbold {}
4355     foreach id $boldids {
4356         if {![ishighlighted $id]} {
4357             bolden $id mainfont
4358         } else {
4359             lappend stillbold $id
4360         }
4361     }
4362     set boldids $stillbold
4363 }
4364
4365 proc addvhighlight {n} {
4366     global hlview viewcomplete curview vhl_done commitidx
4367
4368     if {[info exists hlview]} {
4369         delvhighlight
4370     }
4371     set hlview $n
4372     if {$n != $curview && ![info exists viewcomplete($n)]} {
4373         start_rev_list $n
4374     }
4375     set vhl_done $commitidx($hlview)
4376     if {$vhl_done > 0} {
4377         drawvisible
4378     }
4379 }
4380
4381 proc delvhighlight {} {
4382     global hlview vhighlights
4383
4384     if {![info exists hlview]} return
4385     unset hlview
4386     catch {unset vhighlights}
4387     unbolden
4388 }
4389
4390 proc vhighlightmore {} {
4391     global hlview vhl_done commitidx vhighlights curview
4392
4393     set max $commitidx($hlview)
4394     set vr [visiblerows]
4395     set r0 [lindex $vr 0]
4396     set r1 [lindex $vr 1]
4397     for {set i $vhl_done} {$i < $max} {incr i} {
4398         set id [commitonrow $i $hlview]
4399         if {[commitinview $id $curview]} {
4400             set row [rowofcommit $id]
4401             if {$r0 <= $row && $row <= $r1} {
4402                 if {![highlighted $row]} {
4403                     bolden $id mainfontbold
4404                 }
4405                 set vhighlights($id) 1
4406             }
4407         }
4408     }
4409     set vhl_done $max
4410     return 0
4411 }
4412
4413 proc askvhighlight {row id} {
4414     global hlview vhighlights iddrawn
4415
4416     if {[commitinview $id $hlview]} {
4417         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4418             bolden $id mainfontbold
4419         }
4420         set vhighlights($id) 1
4421     } else {
4422         set vhighlights($id) 0
4423     }
4424 }
4425
4426 proc hfiles_change {} {
4427     global highlight_files filehighlight fhighlights fh_serial
4428     global highlight_paths
4429
4430     if {[info exists filehighlight]} {
4431         # delete previous highlights
4432         catch {close $filehighlight}
4433         unset filehighlight
4434         catch {unset fhighlights}
4435         unbolden
4436         unhighlight_filelist
4437     }
4438     set highlight_paths {}
4439     after cancel do_file_hl $fh_serial
4440     incr fh_serial
4441     if {$highlight_files ne {}} {
4442         after 300 do_file_hl $fh_serial
4443     }
4444 }
4445
4446 proc gdttype_change {name ix op} {
4447     global gdttype highlight_files findstring findpattern
4448
4449     stopfinding
4450     if {$findstring ne {}} {
4451         if {$gdttype eq [mc "containing:"]} {
4452             if {$highlight_files ne {}} {
4453                 set highlight_files {}
4454                 hfiles_change
4455             }
4456             findcom_change
4457         } else {
4458             if {$findpattern ne {}} {
4459                 set findpattern {}
4460                 findcom_change
4461             }
4462             set highlight_files $findstring
4463             hfiles_change
4464         }
4465         drawvisible
4466     }
4467     # enable/disable findtype/findloc menus too
4468 }
4469
4470 proc find_change {name ix op} {
4471     global gdttype findstring highlight_files
4472
4473     stopfinding
4474     if {$gdttype eq [mc "containing:"]} {
4475         findcom_change
4476     } else {
4477         if {$highlight_files ne $findstring} {
4478             set highlight_files $findstring
4479             hfiles_change
4480         }
4481     }
4482     drawvisible
4483 }
4484
4485 proc findcom_change args {
4486     global nhighlights boldnameids
4487     global findpattern findtype findstring gdttype
4488
4489     stopfinding
4490     # delete previous highlights, if any
4491     foreach id $boldnameids {
4492         bolden_name $id mainfont
4493     }
4494     set boldnameids {}
4495     catch {unset nhighlights}
4496     unbolden
4497     unmarkmatches
4498     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4499         set findpattern {}
4500     } elseif {$findtype eq [mc "Regexp"]} {
4501         set findpattern $findstring
4502     } else {
4503         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4504                    $findstring]
4505         set findpattern "*$e*"
4506     }
4507 }
4508
4509 proc makepatterns {l} {
4510     set ret {}
4511     foreach e $l {
4512         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4513         if {[string index $ee end] eq "/"} {
4514             lappend ret "$ee*"
4515         } else {
4516             lappend ret $ee
4517             lappend ret "$ee/*"
4518         }
4519     }
4520     return $ret
4521 }
4522
4523 proc do_file_hl {serial} {
4524     global highlight_files filehighlight highlight_paths gdttype fhl_list
4525     global cdup findtype
4526
4527     if {$gdttype eq [mc "touching paths:"]} {
4528         # If "exact" match then convert backslashes to forward slashes.
4529         # Most useful to support Windows-flavoured file paths.
4530         if {$findtype eq [mc "Exact"]} {
4531             set highlight_files [string map {"\\" "/"} $highlight_files]
4532         }
4533         if {[catch {set paths [shellsplit $highlight_files]}]} return
4534         set highlight_paths [makepatterns $paths]
4535         highlight_filelist
4536         set relative_paths {}
4537         foreach path $paths {
4538             lappend relative_paths [file join $cdup $path]
4539         }
4540         set gdtargs [concat -- $relative_paths]
4541     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4542         set gdtargs [list "-S$highlight_files"]
4543     } else {
4544         # must be "containing:", i.e. we're searching commit info
4545         return
4546     }
4547     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4548     set filehighlight [open $cmd r+]
4549     fconfigure $filehighlight -blocking 0
4550     filerun $filehighlight readfhighlight
4551     set fhl_list {}
4552     drawvisible
4553     flushhighlights
4554 }
4555
4556 proc flushhighlights {} {
4557     global filehighlight fhl_list
4558
4559     if {[info exists filehighlight]} {
4560         lappend fhl_list {}
4561         puts $filehighlight ""
4562         flush $filehighlight
4563     }
4564 }
4565
4566 proc askfilehighlight {row id} {
4567     global filehighlight fhighlights fhl_list
4568
4569     lappend fhl_list $id
4570     set fhighlights($id) -1
4571     puts $filehighlight $id
4572 }
4573
4574 proc readfhighlight {} {
4575     global filehighlight fhighlights curview iddrawn
4576     global fhl_list find_dirn
4577
4578     if {![info exists filehighlight]} {
4579         return 0
4580     }
4581     set nr 0
4582     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4583         set line [string trim $line]
4584         set i [lsearch -exact $fhl_list $line]
4585         if {$i < 0} continue
4586         for {set j 0} {$j < $i} {incr j} {
4587             set id [lindex $fhl_list $j]
4588             set fhighlights($id) 0
4589         }
4590         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4591         if {$line eq {}} continue
4592         if {![commitinview $line $curview]} continue
4593         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4594             bolden $line mainfontbold
4595         }
4596         set fhighlights($line) 1
4597     }
4598     if {[eof $filehighlight]} {
4599         # strange...
4600         puts "oops, git diff-tree died"
4601         catch {close $filehighlight}
4602         unset filehighlight
4603         return 0
4604     }
4605     if {[info exists find_dirn]} {
4606         run findmore
4607     }
4608     return 1
4609 }
4610
4611 proc doesmatch {f} {
4612     global findtype findpattern
4613
4614     if {$findtype eq [mc "Regexp"]} {
4615         return [regexp $findpattern $f]
4616     } elseif {$findtype eq [mc "IgnCase"]} {
4617         return [string match -nocase $findpattern $f]
4618     } else {
4619         return [string match $findpattern $f]
4620     }
4621 }
4622
4623 proc askfindhighlight {row id} {
4624     global nhighlights commitinfo iddrawn
4625     global findloc
4626     global markingmatches
4627
4628     if {![info exists commitinfo($id)]} {
4629         getcommit $id
4630     }
4631     set info $commitinfo($id)
4632     set isbold 0
4633     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4634     foreach f $info ty $fldtypes {
4635         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4636             [doesmatch $f]} {
4637             if {$ty eq [mc "Author"]} {
4638                 set isbold 2
4639                 break
4640             }
4641             set isbold 1
4642         }
4643     }
4644     if {$isbold && [info exists iddrawn($id)]} {
4645         if {![ishighlighted $id]} {
4646             bolden $id mainfontbold
4647             if {$isbold > 1} {
4648                 bolden_name $id mainfontbold
4649             }
4650         }
4651         if {$markingmatches} {
4652             markrowmatches $row $id
4653         }
4654     }
4655     set nhighlights($id) $isbold
4656 }
4657
4658 proc markrowmatches {row id} {
4659     global canv canv2 linehtag linentag commitinfo findloc
4660
4661     set headline [lindex $commitinfo($id) 0]
4662     set author [lindex $commitinfo($id) 1]
4663     $canv delete match$row
4664     $canv2 delete match$row
4665     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4666         set m [findmatches $headline]
4667         if {$m ne {}} {
4668             markmatches $canv $row $headline $linehtag($id) $m \
4669                 [$canv itemcget $linehtag($id) -font] $row
4670         }
4671     }
4672     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4673         set m [findmatches $author]
4674         if {$m ne {}} {
4675             markmatches $canv2 $row $author $linentag($id) $m \
4676                 [$canv2 itemcget $linentag($id) -font] $row
4677         }
4678     }
4679 }
4680
4681 proc vrel_change {name ix op} {
4682     global highlight_related
4683
4684     rhighlight_none
4685     if {$highlight_related ne [mc "None"]} {
4686         run drawvisible
4687     }
4688 }
4689
4690 # prepare for testing whether commits are descendents or ancestors of a
4691 proc rhighlight_sel {a} {
4692     global descendent desc_todo ancestor anc_todo
4693     global highlight_related
4694
4695     catch {unset descendent}
4696     set desc_todo [list $a]
4697     catch {unset ancestor}
4698     set anc_todo [list $a]
4699     if {$highlight_related ne [mc "None"]} {
4700         rhighlight_none
4701         run drawvisible
4702     }
4703 }
4704
4705 proc rhighlight_none {} {
4706     global rhighlights
4707
4708     catch {unset rhighlights}
4709     unbolden
4710 }
4711
4712 proc is_descendent {a} {
4713     global curview children descendent desc_todo
4714
4715     set v $curview
4716     set la [rowofcommit $a]
4717     set todo $desc_todo
4718     set leftover {}
4719     set done 0
4720     for {set i 0} {$i < [llength $todo]} {incr i} {
4721         set do [lindex $todo $i]
4722         if {[rowofcommit $do] < $la} {
4723             lappend leftover $do
4724             continue
4725         }
4726         foreach nk $children($v,$do) {
4727             if {![info exists descendent($nk)]} {
4728                 set descendent($nk) 1
4729                 lappend todo $nk
4730                 if {$nk eq $a} {
4731                     set done 1
4732                 }
4733             }
4734         }
4735         if {$done} {
4736             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4737             return
4738         }
4739     }
4740     set descendent($a) 0
4741     set desc_todo $leftover
4742 }
4743
4744 proc is_ancestor {a} {
4745     global curview parents ancestor anc_todo
4746
4747     set v $curview
4748     set la [rowofcommit $a]
4749     set todo $anc_todo
4750     set leftover {}
4751     set done 0
4752     for {set i 0} {$i < [llength $todo]} {incr i} {
4753         set do [lindex $todo $i]
4754         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4755             lappend leftover $do
4756             continue
4757         }
4758         foreach np $parents($v,$do) {
4759             if {![info exists ancestor($np)]} {
4760                 set ancestor($np) 1
4761                 lappend todo $np
4762                 if {$np eq $a} {
4763                     set done 1
4764                 }
4765             }
4766         }
4767         if {$done} {
4768             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4769             return
4770         }
4771     }
4772     set ancestor($a) 0
4773     set anc_todo $leftover
4774 }
4775
4776 proc askrelhighlight {row id} {
4777     global descendent highlight_related iddrawn rhighlights
4778     global selectedline ancestor
4779
4780     if {$selectedline eq {}} return
4781     set isbold 0
4782     if {$highlight_related eq [mc "Descendant"] ||
4783         $highlight_related eq [mc "Not descendant"]} {
4784         if {![info exists descendent($id)]} {
4785             is_descendent $id
4786         }
4787         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4788             set isbold 1
4789         }
4790     } elseif {$highlight_related eq [mc "Ancestor"] ||
4791               $highlight_related eq [mc "Not ancestor"]} {
4792         if {![info exists ancestor($id)]} {
4793             is_ancestor $id
4794         }
4795         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4796             set isbold 1
4797         }
4798     }
4799     if {[info exists iddrawn($id)]} {
4800         if {$isbold && ![ishighlighted $id]} {
4801             bolden $id mainfontbold
4802         }
4803     }
4804     set rhighlights($id) $isbold
4805 }
4806
4807 # Graph layout functions
4808
4809 proc shortids {ids} {
4810     set res {}
4811     foreach id $ids {
4812         if {[llength $id] > 1} {
4813             lappend res [shortids $id]
4814         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4815             lappend res [string range $id 0 7]
4816         } else {
4817             lappend res $id
4818         }
4819     }
4820     return $res
4821 }
4822
4823 proc ntimes {n o} {
4824     set ret {}
4825     set o [list $o]
4826     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4827         if {($n & $mask) != 0} {
4828             set ret [concat $ret $o]
4829         }
4830         set o [concat $o $o]
4831     }
4832     return $ret
4833 }
4834
4835 proc ordertoken {id} {
4836     global ordertok curview varcid varcstart varctok curview parents children
4837     global nullid nullid2
4838
4839     if {[info exists ordertok($id)]} {
4840         return $ordertok($id)
4841     }
4842     set origid $id
4843     set todo {}
4844     while {1} {
4845         if {[info exists varcid($curview,$id)]} {
4846             set a $varcid($curview,$id)
4847             set p [lindex $varcstart($curview) $a]
4848         } else {
4849             set p [lindex $children($curview,$id) 0]
4850         }
4851         if {[info exists ordertok($p)]} {
4852             set tok $ordertok($p)
4853             break
4854         }
4855         set id [first_real_child $curview,$p]
4856         if {$id eq {}} {
4857             # it's a root
4858             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4859             break
4860         }
4861         if {[llength $parents($curview,$id)] == 1} {
4862             lappend todo [list $p {}]
4863         } else {
4864             set j [lsearch -exact $parents($curview,$id) $p]
4865             if {$j < 0} {
4866                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4867             }
4868             lappend todo [list $p [strrep $j]]
4869         }
4870     }
4871     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4872         set p [lindex $todo $i 0]
4873         append tok [lindex $todo $i 1]
4874         set ordertok($p) $tok
4875     }
4876     set ordertok($origid) $tok
4877     return $tok
4878 }
4879
4880 # Work out where id should go in idlist so that order-token
4881 # values increase from left to right
4882 proc idcol {idlist id {i 0}} {
4883     set t [ordertoken $id]
4884     if {$i < 0} {
4885         set i 0
4886     }
4887     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4888         if {$i > [llength $idlist]} {
4889             set i [llength $idlist]
4890         }
4891         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4892         incr i
4893     } else {
4894         if {$t > [ordertoken [lindex $idlist $i]]} {
4895             while {[incr i] < [llength $idlist] &&
4896                    $t >= [ordertoken [lindex $idlist $i]]} {}
4897         }
4898     }
4899     return $i
4900 }
4901
4902 proc initlayout {} {
4903     global rowidlist rowisopt rowfinal displayorder parentlist
4904     global numcommits canvxmax canv
4905     global nextcolor
4906     global colormap rowtextx
4907
4908     set numcommits 0
4909     set displayorder {}
4910     set parentlist {}
4911     set nextcolor 0
4912     set rowidlist {}
4913     set rowisopt {}
4914     set rowfinal {}
4915     set canvxmax [$canv cget -width]
4916     catch {unset colormap}
4917     catch {unset rowtextx}
4918     setcanvscroll
4919 }
4920
4921 proc setcanvscroll {} {
4922     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4923     global lastscrollset lastscrollrows
4924
4925     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4926     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4927     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4928     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4929     set lastscrollset [clock clicks -milliseconds]
4930     set lastscrollrows $numcommits
4931 }
4932
4933 proc visiblerows {} {
4934     global canv numcommits linespc
4935
4936     set ymax [lindex [$canv cget -scrollregion] 3]
4937     if {$ymax eq {} || $ymax == 0} return
4938     set f [$canv yview]
4939     set y0 [expr {int([lindex $f 0] * $ymax)}]
4940     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4941     if {$r0 < 0} {
4942         set r0 0
4943     }
4944     set y1 [expr {int([lindex $f 1] * $ymax)}]
4945     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4946     if {$r1 >= $numcommits} {
4947         set r1 [expr {$numcommits - 1}]
4948     }
4949     return [list $r0 $r1]
4950 }
4951
4952 proc layoutmore {} {
4953     global commitidx viewcomplete curview
4954     global numcommits pending_select curview
4955     global lastscrollset lastscrollrows
4956
4957     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4958         [clock clicks -milliseconds] - $lastscrollset > 500} {
4959         setcanvscroll
4960     }
4961     if {[info exists pending_select] &&
4962         [commitinview $pending_select $curview]} {
4963         update
4964         selectline [rowofcommit $pending_select] 1
4965     }
4966     drawvisible
4967 }
4968
4969 # With path limiting, we mightn't get the actual HEAD commit,
4970 # so ask git rev-list what is the first ancestor of HEAD that
4971 # touches a file in the path limit.
4972 proc get_viewmainhead {view} {
4973     global viewmainheadid vfilelimit viewinstances mainheadid
4974
4975     catch {
4976         set rfd [open [concat | git rev-list -1 $mainheadid \
4977                            -- $vfilelimit($view)] r]
4978         set j [reg_instance $rfd]
4979         lappend viewinstances($view) $j
4980         fconfigure $rfd -blocking 0
4981         filerun $rfd [list getviewhead $rfd $j $view]
4982         set viewmainheadid($curview) {}
4983     }
4984 }
4985
4986 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4987 proc getviewhead {fd inst view} {
4988     global viewmainheadid commfd curview viewinstances showlocalchanges
4989
4990     set id {}
4991     if {[gets $fd line] < 0} {
4992         if {![eof $fd]} {
4993             return 1
4994         }
4995     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4996         set id $line
4997     }
4998     set viewmainheadid($view) $id
4999     close $fd
5000     unset commfd($inst)
5001     set i [lsearch -exact $viewinstances($view) $inst]
5002     if {$i >= 0} {
5003         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5004     }
5005     if {$showlocalchanges && $id ne {} && $view == $curview} {
5006         doshowlocalchanges
5007     }
5008     return 0
5009 }
5010
5011 proc doshowlocalchanges {} {
5012     global curview viewmainheadid
5013
5014     if {$viewmainheadid($curview) eq {}} return
5015     if {[commitinview $viewmainheadid($curview) $curview]} {
5016         dodiffindex
5017     } else {
5018         interestedin $viewmainheadid($curview) dodiffindex
5019     }
5020 }
5021
5022 proc dohidelocalchanges {} {
5023     global nullid nullid2 lserial curview
5024
5025     if {[commitinview $nullid $curview]} {
5026         removefakerow $nullid
5027     }
5028     if {[commitinview $nullid2 $curview]} {
5029         removefakerow $nullid2
5030     }
5031     incr lserial
5032 }
5033
5034 # spawn off a process to do git diff-index --cached HEAD
5035 proc dodiffindex {} {
5036     global lserial showlocalchanges vfilelimit curview
5037     global hasworktree
5038
5039     if {!$showlocalchanges || !$hasworktree} return
5040     incr lserial
5041     set cmd "|git diff-index --cached HEAD"
5042     if {$vfilelimit($curview) ne {}} {
5043         set cmd [concat $cmd -- $vfilelimit($curview)]
5044     }
5045     set fd [open $cmd r]
5046     fconfigure $fd -blocking 0
5047     set i [reg_instance $fd]
5048     filerun $fd [list readdiffindex $fd $lserial $i]
5049 }
5050
5051 proc readdiffindex {fd serial inst} {
5052     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5053     global vfilelimit
5054
5055     set isdiff 1
5056     if {[gets $fd line] < 0} {
5057         if {![eof $fd]} {
5058             return 1
5059         }
5060         set isdiff 0
5061     }
5062     # we only need to see one line and we don't really care what it says...
5063     stop_instance $inst
5064
5065     if {$serial != $lserial} {
5066         return 0
5067     }
5068
5069     # now see if there are any local changes not checked in to the index
5070     set cmd "|git diff-files"
5071     if {$vfilelimit($curview) ne {}} {
5072         set cmd [concat $cmd -- $vfilelimit($curview)]
5073     }
5074     set fd [open $cmd r]
5075     fconfigure $fd -blocking 0
5076     set i [reg_instance $fd]
5077     filerun $fd [list readdifffiles $fd $serial $i]
5078
5079     if {$isdiff && ![commitinview $nullid2 $curview]} {
5080         # add the line for the changes in the index to the graph
5081         set hl [mc "Local changes checked in to index but not committed"]
5082         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5083         set commitdata($nullid2) "\n    $hl\n"
5084         if {[commitinview $nullid $curview]} {
5085             removefakerow $nullid
5086         }
5087         insertfakerow $nullid2 $viewmainheadid($curview)
5088     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5089         if {[commitinview $nullid $curview]} {
5090             removefakerow $nullid
5091         }
5092         removefakerow $nullid2
5093     }
5094     return 0
5095 }
5096
5097 proc readdifffiles {fd serial inst} {
5098     global viewmainheadid nullid nullid2 curview
5099     global commitinfo commitdata lserial
5100
5101     set isdiff 1
5102     if {[gets $fd line] < 0} {
5103         if {![eof $fd]} {
5104             return 1
5105         }
5106         set isdiff 0
5107     }
5108     # we only need to see one line and we don't really care what it says...
5109     stop_instance $inst
5110
5111     if {$serial != $lserial} {
5112         return 0
5113     }
5114
5115     if {$isdiff && ![commitinview $nullid $curview]} {
5116         # add the line for the local diff to the graph
5117         set hl [mc "Local uncommitted changes, not checked in to index"]
5118         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5119         set commitdata($nullid) "\n    $hl\n"
5120         if {[commitinview $nullid2 $curview]} {
5121             set p $nullid2
5122         } else {
5123             set p $viewmainheadid($curview)
5124         }
5125         insertfakerow $nullid $p
5126     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5127         removefakerow $nullid
5128     }
5129     return 0
5130 }
5131
5132 proc nextuse {id row} {
5133     global curview children
5134
5135     if {[info exists children($curview,$id)]} {
5136         foreach kid $children($curview,$id) {
5137             if {![commitinview $kid $curview]} {
5138                 return -1
5139             }
5140             if {[rowofcommit $kid] > $row} {
5141                 return [rowofcommit $kid]
5142             }
5143         }
5144     }
5145     if {[commitinview $id $curview]} {
5146         return [rowofcommit $id]
5147     }
5148     return -1
5149 }
5150
5151 proc prevuse {id row} {
5152     global curview children
5153
5154     set ret -1
5155     if {[info exists children($curview,$id)]} {
5156         foreach kid $children($curview,$id) {
5157             if {![commitinview $kid $curview]} break
5158             if {[rowofcommit $kid] < $row} {
5159                 set ret [rowofcommit $kid]
5160             }
5161         }
5162     }
5163     return $ret
5164 }
5165
5166 proc make_idlist {row} {
5167     global displayorder parentlist uparrowlen downarrowlen mingaplen
5168     global commitidx curview children
5169
5170     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5171     if {$r < 0} {
5172         set r 0
5173     }
5174     set ra [expr {$row - $downarrowlen}]
5175     if {$ra < 0} {
5176         set ra 0
5177     }
5178     set rb [expr {$row + $uparrowlen}]
5179     if {$rb > $commitidx($curview)} {
5180         set rb $commitidx($curview)
5181     }
5182     make_disporder $r [expr {$rb + 1}]
5183     set ids {}
5184     for {} {$r < $ra} {incr r} {
5185         set nextid [lindex $displayorder [expr {$r + 1}]]
5186         foreach p [lindex $parentlist $r] {
5187             if {$p eq $nextid} continue
5188             set rn [nextuse $p $r]
5189             if {$rn >= $row &&
5190                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5191                 lappend ids [list [ordertoken $p] $p]
5192             }
5193         }
5194     }
5195     for {} {$r < $row} {incr r} {
5196         set nextid [lindex $displayorder [expr {$r + 1}]]
5197         foreach p [lindex $parentlist $r] {
5198             if {$p eq $nextid} continue
5199             set rn [nextuse $p $r]
5200             if {$rn < 0 || $rn >= $row} {
5201                 lappend ids [list [ordertoken $p] $p]
5202             }
5203         }
5204     }
5205     set id [lindex $displayorder $row]
5206     lappend ids [list [ordertoken $id] $id]
5207     while {$r < $rb} {
5208         foreach p [lindex $parentlist $r] {
5209             set firstkid [lindex $children($curview,$p) 0]
5210             if {[rowofcommit $firstkid] < $row} {
5211                 lappend ids [list [ordertoken $p] $p]
5212             }
5213         }
5214         incr r
5215         set id [lindex $displayorder $r]
5216         if {$id ne {}} {
5217             set firstkid [lindex $children($curview,$id) 0]
5218             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5219                 lappend ids [list [ordertoken $id] $id]
5220             }
5221         }
5222     }
5223     set idlist {}
5224     foreach idx [lsort -unique $ids] {
5225         lappend idlist [lindex $idx 1]
5226     }
5227     return $idlist
5228 }
5229
5230 proc rowsequal {a b} {
5231     while {[set i [lsearch -exact $a {}]] >= 0} {
5232         set a [lreplace $a $i $i]
5233     }
5234     while {[set i [lsearch -exact $b {}]] >= 0} {
5235         set b [lreplace $b $i $i]
5236     }
5237     return [expr {$a eq $b}]
5238 }
5239
5240 proc makeupline {id row rend col} {
5241     global rowidlist uparrowlen downarrowlen mingaplen
5242
5243     for {set r $rend} {1} {set r $rstart} {
5244         set rstart [prevuse $id $r]
5245         if {$rstart < 0} return
5246         if {$rstart < $row} break
5247     }
5248     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5249         set rstart [expr {$rend - $uparrowlen - 1}]
5250     }
5251     for {set r $rstart} {[incr r] <= $row} {} {
5252         set idlist [lindex $rowidlist $r]
5253         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5254             set col [idcol $idlist $id $col]
5255             lset rowidlist $r [linsert $idlist $col $id]
5256             changedrow $r
5257         }
5258     }
5259 }
5260
5261 proc layoutrows {row endrow} {
5262     global rowidlist rowisopt rowfinal displayorder
5263     global uparrowlen downarrowlen maxwidth mingaplen
5264     global children parentlist
5265     global commitidx viewcomplete curview
5266
5267     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5268     set idlist {}
5269     if {$row > 0} {
5270         set rm1 [expr {$row - 1}]
5271         foreach id [lindex $rowidlist $rm1] {
5272             if {$id ne {}} {
5273                 lappend idlist $id
5274             }
5275         }
5276         set final [lindex $rowfinal $rm1]
5277     }
5278     for {} {$row < $endrow} {incr row} {
5279         set rm1 [expr {$row - 1}]
5280         if {$rm1 < 0 || $idlist eq {}} {
5281             set idlist [make_idlist $row]
5282             set final 1
5283         } else {
5284             set id [lindex $displayorder $rm1]
5285             set col [lsearch -exact $idlist $id]
5286             set idlist [lreplace $idlist $col $col]
5287             foreach p [lindex $parentlist $rm1] {
5288                 if {[lsearch -exact $idlist $p] < 0} {
5289                     set col [idcol $idlist $p $col]
5290                     set idlist [linsert $idlist $col $p]
5291                     # if not the first child, we have to insert a line going up
5292                     if {$id ne [lindex $children($curview,$p) 0]} {
5293                         makeupline $p $rm1 $row $col
5294                     }
5295                 }
5296             }
5297             set id [lindex $displayorder $row]
5298             if {$row > $downarrowlen} {
5299                 set termrow [expr {$row - $downarrowlen - 1}]
5300                 foreach p [lindex $parentlist $termrow] {
5301                     set i [lsearch -exact $idlist $p]
5302                     if {$i < 0} continue
5303                     set nr [nextuse $p $termrow]
5304                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5305                         set idlist [lreplace $idlist $i $i]
5306                     }
5307                 }
5308             }
5309             set col [lsearch -exact $idlist $id]
5310             if {$col < 0} {
5311                 set col [idcol $idlist $id]
5312                 set idlist [linsert $idlist $col $id]
5313                 if {$children($curview,$id) ne {}} {
5314                     makeupline $id $rm1 $row $col
5315                 }
5316             }
5317             set r [expr {$row + $uparrowlen - 1}]
5318             if {$r < $commitidx($curview)} {
5319                 set x $col
5320                 foreach p [lindex $parentlist $r] {
5321                     if {[lsearch -exact $idlist $p] >= 0} continue
5322                     set fk [lindex $children($curview,$p) 0]
5323                     if {[rowofcommit $fk] < $row} {
5324                         set x [idcol $idlist $p $x]
5325                         set idlist [linsert $idlist $x $p]
5326                     }
5327                 }
5328                 if {[incr r] < $commitidx($curview)} {
5329                     set p [lindex $displayorder $r]
5330                     if {[lsearch -exact $idlist $p] < 0} {
5331                         set fk [lindex $children($curview,$p) 0]
5332                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5333                             set x [idcol $idlist $p $x]
5334                             set idlist [linsert $idlist $x $p]
5335                         }
5336                     }
5337                 }
5338             }
5339         }
5340         if {$final && !$viewcomplete($curview) &&
5341             $row + $uparrowlen + $mingaplen + $downarrowlen
5342                 >= $commitidx($curview)} {
5343             set final 0
5344         }
5345         set l [llength $rowidlist]
5346         if {$row == $l} {
5347             lappend rowidlist $idlist
5348             lappend rowisopt 0
5349             lappend rowfinal $final
5350         } elseif {$row < $l} {
5351             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5352                 lset rowidlist $row $idlist
5353                 changedrow $row
5354             }
5355             lset rowfinal $row $final
5356         } else {
5357             set pad [ntimes [expr {$row - $l}] {}]
5358             set rowidlist [concat $rowidlist $pad]
5359             lappend rowidlist $idlist
5360             set rowfinal [concat $rowfinal $pad]
5361             lappend rowfinal $final
5362             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5363         }
5364     }
5365     return $row
5366 }
5367
5368 proc changedrow {row} {
5369     global displayorder iddrawn rowisopt need_redisplay
5370
5371     set l [llength $rowisopt]
5372     if {$row < $l} {
5373         lset rowisopt $row 0
5374         if {$row + 1 < $l} {
5375             lset rowisopt [expr {$row + 1}] 0
5376             if {$row + 2 < $l} {
5377                 lset rowisopt [expr {$row + 2}] 0
5378             }
5379         }
5380     }
5381     set id [lindex $displayorder $row]
5382     if {[info exists iddrawn($id)]} {
5383         set need_redisplay 1
5384     }
5385 }
5386
5387 proc insert_pad {row col npad} {
5388     global rowidlist
5389
5390     set pad [ntimes $npad {}]
5391     set idlist [lindex $rowidlist $row]
5392     set bef [lrange $idlist 0 [expr {$col - 1}]]
5393     set aft [lrange $idlist $col end]
5394     set i [lsearch -exact $aft {}]
5395     if {$i > 0} {
5396         set aft [lreplace $aft $i $i]
5397     }
5398     lset rowidlist $row [concat $bef $pad $aft]
5399     changedrow $row
5400 }
5401
5402 proc optimize_rows {row col endrow} {
5403     global rowidlist rowisopt displayorder curview children
5404
5405     if {$row < 1} {
5406         set row 1
5407     }
5408     for {} {$row < $endrow} {incr row; set col 0} {
5409         if {[lindex $rowisopt $row]} continue
5410         set haspad 0
5411         set y0 [expr {$row - 1}]
5412         set ym [expr {$row - 2}]
5413         set idlist [lindex $rowidlist $row]
5414         set previdlist [lindex $rowidlist $y0]
5415         if {$idlist eq {} || $previdlist eq {}} continue
5416         if {$ym >= 0} {
5417             set pprevidlist [lindex $rowidlist $ym]
5418             if {$pprevidlist eq {}} continue
5419         } else {
5420             set pprevidlist {}
5421         }
5422         set x0 -1
5423         set xm -1
5424         for {} {$col < [llength $idlist]} {incr col} {
5425             set id [lindex $idlist $col]
5426             if {[lindex $previdlist $col] eq $id} continue
5427             if {$id eq {}} {
5428                 set haspad 1
5429                 continue
5430             }
5431             set x0 [lsearch -exact $previdlist $id]
5432             if {$x0 < 0} continue
5433             set z [expr {$x0 - $col}]
5434             set isarrow 0
5435             set z0 {}
5436             if {$ym >= 0} {
5437                 set xm [lsearch -exact $pprevidlist $id]
5438                 if {$xm >= 0} {
5439                     set z0 [expr {$xm - $x0}]
5440                 }
5441             }
5442             if {$z0 eq {}} {
5443                 # if row y0 is the first child of $id then it's not an arrow
5444                 if {[lindex $children($curview,$id) 0] ne
5445                     [lindex $displayorder $y0]} {
5446                     set isarrow 1
5447                 }
5448             }
5449             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5450                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5451                 set isarrow 1
5452             }
5453             # Looking at lines from this row to the previous row,
5454             # make them go straight up if they end in an arrow on
5455             # the previous row; otherwise make them go straight up
5456             # or at 45 degrees.
5457             if {$z < -1 || ($z < 0 && $isarrow)} {
5458                 # Line currently goes left too much;
5459                 # insert pads in the previous row, then optimize it
5460                 set npad [expr {-1 - $z + $isarrow}]
5461                 insert_pad $y0 $x0 $npad
5462                 if {$y0 > 0} {
5463                     optimize_rows $y0 $x0 $row
5464                 }
5465                 set previdlist [lindex $rowidlist $y0]
5466                 set x0 [lsearch -exact $previdlist $id]
5467                 set z [expr {$x0 - $col}]
5468                 if {$z0 ne {}} {
5469                     set pprevidlist [lindex $rowidlist $ym]
5470                     set xm [lsearch -exact $pprevidlist $id]
5471                     set z0 [expr {$xm - $x0}]
5472                 }
5473             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5474                 # Line currently goes right too much;
5475                 # insert pads in this line
5476                 set npad [expr {$z - 1 + $isarrow}]
5477                 insert_pad $row $col $npad
5478                 set idlist [lindex $rowidlist $row]
5479                 incr col $npad
5480                 set z [expr {$x0 - $col}]
5481                 set haspad 1
5482             }
5483             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5484                 # this line links to its first child on row $row-2
5485                 set id [lindex $displayorder $ym]
5486                 set xc [lsearch -exact $pprevidlist $id]
5487                 if {$xc >= 0} {
5488                     set z0 [expr {$xc - $x0}]
5489                 }
5490             }
5491             # avoid lines jigging left then immediately right
5492             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5493                 insert_pad $y0 $x0 1
5494                 incr x0
5495                 optimize_rows $y0 $x0 $row
5496                 set previdlist [lindex $rowidlist $y0]
5497             }
5498         }
5499         if {!$haspad} {
5500             # Find the first column that doesn't have a line going right
5501             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5502                 set id [lindex $idlist $col]
5503                 if {$id eq {}} break
5504                 set x0 [lsearch -exact $previdlist $id]
5505                 if {$x0 < 0} {
5506                     # check if this is the link to the first child
5507                     set kid [lindex $displayorder $y0]
5508                     if {[lindex $children($curview,$id) 0] eq $kid} {
5509                         # it is, work out offset to child
5510                         set x0 [lsearch -exact $previdlist $kid]
5511                     }
5512                 }
5513                 if {$x0 <= $col} break
5514             }
5515             # Insert a pad at that column as long as it has a line and
5516             # isn't the last column
5517             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5518                 set idlist [linsert $idlist $col {}]
5519                 lset rowidlist $row $idlist
5520                 changedrow $row
5521             }
5522         }
5523     }
5524 }
5525
5526 proc xc {row col} {
5527     global canvx0 linespc
5528     return [expr {$canvx0 + $col * $linespc}]
5529 }
5530
5531 proc yc {row} {
5532     global canvy0 linespc
5533     return [expr {$canvy0 + $row * $linespc}]
5534 }
5535
5536 proc linewidth {id} {
5537     global thickerline lthickness
5538
5539     set wid $lthickness
5540     if {[info exists thickerline] && $id eq $thickerline} {
5541         set wid [expr {2 * $lthickness}]
5542     }
5543     return $wid
5544 }
5545
5546 proc rowranges {id} {
5547     global curview children uparrowlen downarrowlen
5548     global rowidlist
5549
5550     set kids $children($curview,$id)
5551     if {$kids eq {}} {
5552         return {}
5553     }
5554     set ret {}
5555     lappend kids $id
5556     foreach child $kids {
5557         if {![commitinview $child $curview]} break
5558         set row [rowofcommit $child]
5559         if {![info exists prev]} {
5560             lappend ret [expr {$row + 1}]
5561         } else {
5562             if {$row <= $prevrow} {
5563                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5564             }
5565             # see if the line extends the whole way from prevrow to row
5566             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5567                 [lsearch -exact [lindex $rowidlist \
5568                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5569                 # it doesn't, see where it ends
5570                 set r [expr {$prevrow + $downarrowlen}]
5571                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5572                     while {[incr r -1] > $prevrow &&
5573                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5574                 } else {
5575                     while {[incr r] <= $row &&
5576                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5577                     incr r -1
5578                 }
5579                 lappend ret $r
5580                 # see where it starts up again
5581                 set r [expr {$row - $uparrowlen}]
5582                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5583                     while {[incr r] < $row &&
5584                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5585                 } else {
5586                     while {[incr r -1] >= $prevrow &&
5587                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5588                     incr r
5589                 }
5590                 lappend ret $r
5591             }
5592         }
5593         if {$child eq $id} {
5594             lappend ret $row
5595         }
5596         set prev $child
5597         set prevrow $row
5598     }
5599     return $ret
5600 }
5601
5602 proc drawlineseg {id row endrow arrowlow} {
5603     global rowidlist displayorder iddrawn linesegs
5604     global canv colormap linespc curview maxlinelen parentlist
5605
5606     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5607     set le [expr {$row + 1}]
5608     set arrowhigh 1
5609     while {1} {
5610         set c [lsearch -exact [lindex $rowidlist $le] $id]
5611         if {$c < 0} {
5612             incr le -1
5613             break
5614         }
5615         lappend cols $c
5616         set x [lindex $displayorder $le]
5617         if {$x eq $id} {
5618             set arrowhigh 0
5619             break
5620         }
5621         if {[info exists iddrawn($x)] || $le == $endrow} {
5622             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5623             if {$c >= 0} {
5624                 lappend cols $c
5625                 set arrowhigh 0
5626             }
5627             break
5628         }
5629         incr le
5630     }
5631     if {$le <= $row} {
5632         return $row
5633     }
5634
5635     set lines {}
5636     set i 0
5637     set joinhigh 0
5638     if {[info exists linesegs($id)]} {
5639         set lines $linesegs($id)
5640         foreach li $lines {
5641             set r0 [lindex $li 0]
5642             if {$r0 > $row} {
5643                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5644                     set joinhigh 1
5645                 }
5646                 break
5647             }
5648             incr i
5649         }
5650     }
5651     set joinlow 0
5652     if {$i > 0} {
5653         set li [lindex $lines [expr {$i-1}]]
5654         set r1 [lindex $li 1]
5655         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5656             set joinlow 1
5657         }
5658     }
5659
5660     set x [lindex $cols [expr {$le - $row}]]
5661     set xp [lindex $cols [expr {$le - 1 - $row}]]
5662     set dir [expr {$xp - $x}]
5663     if {$joinhigh} {
5664         set ith [lindex $lines $i 2]
5665         set coords [$canv coords $ith]
5666         set ah [$canv itemcget $ith -arrow]
5667         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5668         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5669         if {$x2 ne {} && $x - $x2 == $dir} {
5670             set coords [lrange $coords 0 end-2]
5671         }
5672     } else {
5673         set coords [list [xc $le $x] [yc $le]]
5674     }
5675     if {$joinlow} {
5676         set itl [lindex $lines [expr {$i-1}] 2]
5677         set al [$canv itemcget $itl -arrow]
5678         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5679     } elseif {$arrowlow} {
5680         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5681             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5682             set arrowlow 0
5683         }
5684     }
5685     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5686     for {set y $le} {[incr y -1] > $row} {} {
5687         set x $xp
5688         set xp [lindex $cols [expr {$y - 1 - $row}]]
5689         set ndir [expr {$xp - $x}]
5690         if {$dir != $ndir || $xp < 0} {
5691             lappend coords [xc $y $x] [yc $y]
5692         }
5693         set dir $ndir
5694     }
5695     if {!$joinlow} {
5696         if {$xp < 0} {
5697             # join parent line to first child
5698             set ch [lindex $displayorder $row]
5699             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5700             if {$xc < 0} {
5701                 puts "oops: drawlineseg: child $ch not on row $row"
5702             } elseif {$xc != $x} {
5703                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5704                     set d [expr {int(0.5 * $linespc)}]
5705                     set x1 [xc $row $x]
5706                     if {$xc < $x} {
5707                         set x2 [expr {$x1 - $d}]
5708                     } else {
5709                         set x2 [expr {$x1 + $d}]
5710                     }
5711                     set y2 [yc $row]
5712                     set y1 [expr {$y2 + $d}]
5713                     lappend coords $x1 $y1 $x2 $y2
5714                 } elseif {$xc < $x - 1} {
5715                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5716                 } elseif {$xc > $x + 1} {
5717                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5718                 }
5719                 set x $xc
5720             }
5721             lappend coords [xc $row $x] [yc $row]
5722         } else {
5723             set xn [xc $row $xp]
5724             set yn [yc $row]
5725             lappend coords $xn $yn
5726         }
5727         if {!$joinhigh} {
5728             assigncolor $id
5729             set t [$canv create line $coords -width [linewidth $id] \
5730                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5731             $canv lower $t
5732             bindline $t $id
5733             set lines [linsert $lines $i [list $row $le $t]]
5734         } else {
5735             $canv coords $ith $coords
5736             if {$arrow ne $ah} {
5737                 $canv itemconf $ith -arrow $arrow
5738             }
5739             lset lines $i 0 $row
5740         }
5741     } else {
5742         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5743         set ndir [expr {$xo - $xp}]
5744         set clow [$canv coords $itl]
5745         if {$dir == $ndir} {
5746             set clow [lrange $clow 2 end]
5747         }
5748         set coords [concat $coords $clow]
5749         if {!$joinhigh} {
5750             lset lines [expr {$i-1}] 1 $le
5751         } else {
5752             # coalesce two pieces
5753             $canv delete $ith
5754             set b [lindex $lines [expr {$i-1}] 0]
5755             set e [lindex $lines $i 1]
5756             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5757         }
5758         $canv coords $itl $coords
5759         if {$arrow ne $al} {
5760             $canv itemconf $itl -arrow $arrow
5761         }
5762     }
5763
5764     set linesegs($id) $lines
5765     return $le
5766 }
5767
5768 proc drawparentlinks {id row} {
5769     global rowidlist canv colormap curview parentlist
5770     global idpos linespc
5771
5772     set rowids [lindex $rowidlist $row]
5773     set col [lsearch -exact $rowids $id]
5774     if {$col < 0} return
5775     set olds [lindex $parentlist $row]
5776     set row2 [expr {$row + 1}]
5777     set x [xc $row $col]
5778     set y [yc $row]
5779     set y2 [yc $row2]
5780     set d [expr {int(0.5 * $linespc)}]
5781     set ymid [expr {$y + $d}]
5782     set ids [lindex $rowidlist $row2]
5783     # rmx = right-most X coord used
5784     set rmx 0
5785     foreach p $olds {
5786         set i [lsearch -exact $ids $p]
5787         if {$i < 0} {
5788             puts "oops, parent $p of $id not in list"
5789             continue
5790         }
5791         set x2 [xc $row2 $i]
5792         if {$x2 > $rmx} {
5793             set rmx $x2
5794         }
5795         set j [lsearch -exact $rowids $p]
5796         if {$j < 0} {
5797             # drawlineseg will do this one for us
5798             continue
5799         }
5800         assigncolor $p
5801         # should handle duplicated parents here...
5802         set coords [list $x $y]
5803         if {$i != $col} {
5804             # if attaching to a vertical segment, draw a smaller
5805             # slant for visual distinctness
5806             if {$i == $j} {
5807                 if {$i < $col} {
5808                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5809                 } else {
5810                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5811                 }
5812             } elseif {$i < $col && $i < $j} {
5813                 # segment slants towards us already
5814                 lappend coords [xc $row $j] $y
5815             } else {
5816                 if {$i < $col - 1} {
5817                     lappend coords [expr {$x2 + $linespc}] $y
5818                 } elseif {$i > $col + 1} {
5819                     lappend coords [expr {$x2 - $linespc}] $y
5820                 }
5821                 lappend coords $x2 $y2
5822             }
5823         } else {
5824             lappend coords $x2 $y2
5825         }
5826         set t [$canv create line $coords -width [linewidth $p] \
5827                    -fill $colormap($p) -tags lines.$p]
5828         $canv lower $t
5829         bindline $t $p
5830     }
5831     if {$rmx > [lindex $idpos($id) 1]} {
5832         lset idpos($id) 1 $rmx
5833         redrawtags $id
5834     }
5835 }
5836
5837 proc drawlines {id} {
5838     global canv
5839
5840     $canv itemconf lines.$id -width [linewidth $id]
5841 }
5842
5843 proc drawcmittext {id row col} {
5844     global linespc canv canv2 canv3 fgcolor curview
5845     global cmitlisted commitinfo rowidlist parentlist
5846     global rowtextx idpos idtags idheads idotherrefs
5847     global linehtag linentag linedtag selectedline
5848     global canvxmax boldids boldnameids fgcolor markedid
5849     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5850
5851     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5852     set listed $cmitlisted($curview,$id)
5853     if {$id eq $nullid} {
5854         set ofill red
5855     } elseif {$id eq $nullid2} {
5856         set ofill green
5857     } elseif {$id eq $mainheadid} {
5858         set ofill yellow
5859     } else {
5860         set ofill [lindex $circlecolors $listed]
5861     }
5862     set x [xc $row $col]
5863     set y [yc $row]
5864     set orad [expr {$linespc / 3}]
5865     if {$listed <= 2} {
5866         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5867                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5868                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5869     } elseif {$listed == 3} {
5870         # triangle pointing left for left-side commits
5871         set t [$canv create polygon \
5872                    [expr {$x - $orad}] $y \
5873                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5874                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5875                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5876     } else {
5877         # triangle pointing right for right-side commits
5878         set t [$canv create polygon \
5879                    [expr {$x + $orad - 1}] $y \
5880                    [expr {$x - $orad}] [expr {$y - $orad}] \
5881                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5882                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5883     }
5884     set circleitem($row) $t
5885     $canv raise $t
5886     $canv bind $t <1> {selcanvline {} %x %y}
5887     set rmx [llength [lindex $rowidlist $row]]
5888     set olds [lindex $parentlist $row]
5889     if {$olds ne {}} {
5890         set nextids [lindex $rowidlist [expr {$row + 1}]]
5891         foreach p $olds {
5892             set i [lsearch -exact $nextids $p]
5893             if {$i > $rmx} {
5894                 set rmx $i
5895             }
5896         }
5897     }
5898     set xt [xc $row $rmx]
5899     set rowtextx($row) $xt
5900     set idpos($id) [list $x $xt $y]
5901     if {[info exists idtags($id)] || [info exists idheads($id)]
5902         || [info exists idotherrefs($id)]} {
5903         set xt [drawtags $id $x $xt $y]
5904     }
5905     if {[lindex $commitinfo($id) 6] > 0} {
5906         set xt [drawnotesign $xt $y]
5907     }
5908     set headline [lindex $commitinfo($id) 0]
5909     set name [lindex $commitinfo($id) 1]
5910     set date [lindex $commitinfo($id) 2]
5911     set date [formatdate $date]
5912     set font mainfont
5913     set nfont mainfont
5914     set isbold [ishighlighted $id]
5915     if {$isbold > 0} {
5916         lappend boldids $id
5917         set font mainfontbold
5918         if {$isbold > 1} {
5919             lappend boldnameids $id
5920             set nfont mainfontbold
5921         }
5922     }
5923     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5924                            -text $headline -font $font -tags text]
5925     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5926     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5927                            -text $name -font $nfont -tags text]
5928     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5929                            -text $date -font mainfont -tags text]
5930     if {$selectedline == $row} {
5931         make_secsel $id
5932     }
5933     if {[info exists markedid] && $markedid eq $id} {
5934         make_idmark $id
5935     }
5936     set xr [expr {$xt + [font measure $font $headline]}]
5937     if {$xr > $canvxmax} {
5938         set canvxmax $xr
5939         setcanvscroll
5940     }
5941 }
5942
5943 proc drawcmitrow {row} {
5944     global displayorder rowidlist nrows_drawn
5945     global iddrawn markingmatches
5946     global commitinfo numcommits
5947     global filehighlight fhighlights findpattern nhighlights
5948     global hlview vhighlights
5949     global highlight_related rhighlights
5950
5951     if {$row >= $numcommits} return
5952
5953     set id [lindex $displayorder $row]
5954     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5955         askvhighlight $row $id
5956     }
5957     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5958         askfilehighlight $row $id
5959     }
5960     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5961         askfindhighlight $row $id
5962     }
5963     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5964         askrelhighlight $row $id
5965     }
5966     if {![info exists iddrawn($id)]} {
5967         set col [lsearch -exact [lindex $rowidlist $row] $id]
5968         if {$col < 0} {
5969             puts "oops, row $row id $id not in list"
5970             return
5971         }
5972         if {![info exists commitinfo($id)]} {
5973             getcommit $id
5974         }
5975         assigncolor $id
5976         drawcmittext $id $row $col
5977         set iddrawn($id) 1
5978         incr nrows_drawn
5979     }
5980     if {$markingmatches} {
5981         markrowmatches $row $id
5982     }
5983 }
5984
5985 proc drawcommits {row {endrow {}}} {
5986     global numcommits iddrawn displayorder curview need_redisplay
5987     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5988
5989     if {$row < 0} {
5990         set row 0
5991     }
5992     if {$endrow eq {}} {
5993         set endrow $row
5994     }
5995     if {$endrow >= $numcommits} {
5996         set endrow [expr {$numcommits - 1}]
5997     }
5998
5999     set rl1 [expr {$row - $downarrowlen - 3}]
6000     if {$rl1 < 0} {
6001         set rl1 0
6002     }
6003     set ro1 [expr {$row - 3}]
6004     if {$ro1 < 0} {
6005         set ro1 0
6006     }
6007     set r2 [expr {$endrow + $uparrowlen + 3}]
6008     if {$r2 > $numcommits} {
6009         set r2 $numcommits
6010     }
6011     for {set r $rl1} {$r < $r2} {incr r} {
6012         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6013             if {$rl1 < $r} {
6014                 layoutrows $rl1 $r
6015             }
6016             set rl1 [expr {$r + 1}]
6017         }
6018     }
6019     if {$rl1 < $r} {
6020         layoutrows $rl1 $r
6021     }
6022     optimize_rows $ro1 0 $r2
6023     if {$need_redisplay || $nrows_drawn > 2000} {
6024         clear_display
6025     }
6026
6027     # make the lines join to already-drawn rows either side
6028     set r [expr {$row - 1}]
6029     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6030         set r $row
6031     }
6032     set er [expr {$endrow + 1}]
6033     if {$er >= $numcommits ||
6034         ![info exists iddrawn([lindex $displayorder $er])]} {
6035         set er $endrow
6036     }
6037     for {} {$r <= $er} {incr r} {
6038         set id [lindex $displayorder $r]
6039         set wasdrawn [info exists iddrawn($id)]
6040         drawcmitrow $r
6041         if {$r == $er} break
6042         set nextid [lindex $displayorder [expr {$r + 1}]]
6043         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6044         drawparentlinks $id $r
6045
6046         set rowids [lindex $rowidlist $r]
6047         foreach lid $rowids {
6048             if {$lid eq {}} continue
6049             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6050             if {$lid eq $id} {
6051                 # see if this is the first child of any of its parents
6052                 foreach p [lindex $parentlist $r] {
6053                     if {[lsearch -exact $rowids $p] < 0} {
6054                         # make this line extend up to the child
6055                         set lineend($p) [drawlineseg $p $r $er 0]
6056                     }
6057                 }
6058             } else {
6059                 set lineend($lid) [drawlineseg $lid $r $er 1]
6060             }
6061         }
6062     }
6063 }
6064
6065 proc undolayout {row} {
6066     global uparrowlen mingaplen downarrowlen
6067     global rowidlist rowisopt rowfinal need_redisplay
6068
6069     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6070     if {$r < 0} {
6071         set r 0
6072     }
6073     if {[llength $rowidlist] > $r} {
6074         incr r -1
6075         set rowidlist [lrange $rowidlist 0 $r]
6076         set rowfinal [lrange $rowfinal 0 $r]
6077         set rowisopt [lrange $rowisopt 0 $r]
6078         set need_redisplay 1
6079         run drawvisible
6080     }
6081 }
6082
6083 proc drawvisible {} {
6084     global canv linespc curview vrowmod selectedline targetrow targetid
6085     global need_redisplay cscroll numcommits
6086
6087     set fs [$canv yview]
6088     set ymax [lindex [$canv cget -scrollregion] 3]
6089     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6090     set f0 [lindex $fs 0]
6091     set f1 [lindex $fs 1]
6092     set y0 [expr {int($f0 * $ymax)}]
6093     set y1 [expr {int($f1 * $ymax)}]
6094
6095     if {[info exists targetid]} {
6096         if {[commitinview $targetid $curview]} {
6097             set r [rowofcommit $targetid]
6098             if {$r != $targetrow} {
6099                 # Fix up the scrollregion and change the scrolling position
6100                 # now that our target row has moved.
6101                 set diff [expr {($r - $targetrow) * $linespc}]
6102                 set targetrow $r
6103                 setcanvscroll
6104                 set ymax [lindex [$canv cget -scrollregion] 3]
6105                 incr y0 $diff
6106                 incr y1 $diff
6107                 set f0 [expr {$y0 / $ymax}]
6108                 set f1 [expr {$y1 / $ymax}]
6109                 allcanvs yview moveto $f0
6110                 $cscroll set $f0 $f1
6111                 set need_redisplay 1
6112             }
6113         } else {
6114             unset targetid
6115         }
6116     }
6117
6118     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6119     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6120     if {$endrow >= $vrowmod($curview)} {
6121         update_arcrows $curview
6122     }
6123     if {$selectedline ne {} &&
6124         $row <= $selectedline && $selectedline <= $endrow} {
6125         set targetrow $selectedline
6126     } elseif {[info exists targetid]} {
6127         set targetrow [expr {int(($row + $endrow) / 2)}]
6128     }
6129     if {[info exists targetrow]} {
6130         if {$targetrow >= $numcommits} {
6131             set targetrow [expr {$numcommits - 1}]
6132         }
6133         set targetid [commitonrow $targetrow]
6134     }
6135     drawcommits $row $endrow
6136 }
6137
6138 proc clear_display {} {
6139     global iddrawn linesegs need_redisplay nrows_drawn
6140     global vhighlights fhighlights nhighlights rhighlights
6141     global linehtag linentag linedtag boldids boldnameids
6142
6143     allcanvs delete all
6144     catch {unset iddrawn}
6145     catch {unset linesegs}
6146     catch {unset linehtag}
6147     catch {unset linentag}
6148     catch {unset linedtag}
6149     set boldids {}
6150     set boldnameids {}
6151     catch {unset vhighlights}
6152     catch {unset fhighlights}
6153     catch {unset nhighlights}
6154     catch {unset rhighlights}
6155     set need_redisplay 0
6156     set nrows_drawn 0
6157 }
6158
6159 proc findcrossings {id} {
6160     global rowidlist parentlist numcommits displayorder
6161
6162     set cross {}
6163     set ccross {}
6164     foreach {s e} [rowranges $id] {
6165         if {$e >= $numcommits} {
6166             set e [expr {$numcommits - 1}]
6167         }
6168         if {$e <= $s} continue
6169         for {set row $e} {[incr row -1] >= $s} {} {
6170             set x [lsearch -exact [lindex $rowidlist $row] $id]
6171             if {$x < 0} break
6172             set olds [lindex $parentlist $row]
6173             set kid [lindex $displayorder $row]
6174             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6175             if {$kidx < 0} continue
6176             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6177             foreach p $olds {
6178                 set px [lsearch -exact $nextrow $p]
6179                 if {$px < 0} continue
6180                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6181                     if {[lsearch -exact $ccross $p] >= 0} continue
6182                     if {$x == $px + ($kidx < $px? -1: 1)} {
6183                         lappend ccross $p
6184                     } elseif {[lsearch -exact $cross $p] < 0} {
6185                         lappend cross $p
6186                     }
6187                 }
6188             }
6189         }
6190     }
6191     return [concat $ccross {{}} $cross]
6192 }
6193
6194 proc assigncolor {id} {
6195     global colormap colors nextcolor
6196     global parents children children curview
6197
6198     if {[info exists colormap($id)]} return
6199     set ncolors [llength $colors]
6200     if {[info exists children($curview,$id)]} {
6201         set kids $children($curview,$id)
6202     } else {
6203         set kids {}
6204     }
6205     if {[llength $kids] == 1} {
6206         set child [lindex $kids 0]
6207         if {[info exists colormap($child)]
6208             && [llength $parents($curview,$child)] == 1} {
6209             set colormap($id) $colormap($child)
6210             return
6211         }
6212     }
6213     set badcolors {}
6214     set origbad {}
6215     foreach x [findcrossings $id] {
6216         if {$x eq {}} {
6217             # delimiter between corner crossings and other crossings
6218             if {[llength $badcolors] >= $ncolors - 1} break
6219             set origbad $badcolors
6220         }
6221         if {[info exists colormap($x)]
6222             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6223             lappend badcolors $colormap($x)
6224         }
6225     }
6226     if {[llength $badcolors] >= $ncolors} {
6227         set badcolors $origbad
6228     }
6229     set origbad $badcolors
6230     if {[llength $badcolors] < $ncolors - 1} {
6231         foreach child $kids {
6232             if {[info exists colormap($child)]
6233                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6234                 lappend badcolors $colormap($child)
6235             }
6236             foreach p $parents($curview,$child) {
6237                 if {[info exists colormap($p)]
6238                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6239                     lappend badcolors $colormap($p)
6240                 }
6241             }
6242         }
6243         if {[llength $badcolors] >= $ncolors} {
6244             set badcolors $origbad
6245         }
6246     }
6247     for {set i 0} {$i <= $ncolors} {incr i} {
6248         set c [lindex $colors $nextcolor]
6249         if {[incr nextcolor] >= $ncolors} {
6250             set nextcolor 0
6251         }
6252         if {[lsearch -exact $badcolors $c]} break
6253     }
6254     set colormap($id) $c
6255 }
6256
6257 proc bindline {t id} {
6258     global canv
6259
6260     $canv bind $t <Enter> "lineenter %x %y $id"
6261     $canv bind $t <Motion> "linemotion %x %y $id"
6262     $canv bind $t <Leave> "lineleave $id"
6263     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6264 }
6265
6266 proc drawtags {id x xt y1} {
6267     global idtags idheads idotherrefs mainhead
6268     global linespc lthickness
6269     global canv rowtextx curview fgcolor bgcolor ctxbut
6270
6271     set marks {}
6272     set ntags 0
6273     set nheads 0
6274     if {[info exists idtags($id)]} {
6275         set marks $idtags($id)
6276         set ntags [llength $marks]
6277     }
6278     if {[info exists idheads($id)]} {
6279         set marks [concat $marks $idheads($id)]
6280         set nheads [llength $idheads($id)]
6281     }
6282     if {[info exists idotherrefs($id)]} {
6283         set marks [concat $marks $idotherrefs($id)]
6284     }
6285     if {$marks eq {}} {
6286         return $xt
6287     }
6288
6289     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6290     set yt [expr {$y1 - 0.5 * $linespc}]
6291     set yb [expr {$yt + $linespc - 1}]
6292     set xvals {}
6293     set wvals {}
6294     set i -1
6295     foreach tag $marks {
6296         incr i
6297         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6298             set wid [font measure mainfontbold $tag]
6299         } else {
6300             set wid [font measure mainfont $tag]
6301         }
6302         lappend xvals $xt
6303         lappend wvals $wid
6304         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6305     }
6306     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6307                -width $lthickness -fill black -tags tag.$id]
6308     $canv lower $t
6309     foreach tag $marks x $xvals wid $wvals {
6310         set tag_quoted [string map {% %%} $tag]
6311         set xl [expr {$x + $delta}]
6312         set xr [expr {$x + $delta + $wid + $lthickness}]
6313         set font mainfont
6314         if {[incr ntags -1] >= 0} {
6315             # draw a tag
6316             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6317                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6318                        -width 1 -outline black -fill yellow -tags tag.$id]
6319             $canv bind $t <1> [list showtag $tag_quoted 1]
6320             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6321         } else {
6322             # draw a head or other ref
6323             if {[incr nheads -1] >= 0} {
6324                 set col green
6325                 if {$tag eq $mainhead} {
6326                     set font mainfontbold
6327                 }
6328             } else {
6329                 set col "#ddddff"
6330             }
6331             set xl [expr {$xl - $delta/2}]
6332             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6333                 -width 1 -outline black -fill $col -tags tag.$id
6334             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6335                 set rwid [font measure mainfont $remoteprefix]
6336                 set xi [expr {$x + 1}]
6337                 set yti [expr {$yt + 1}]
6338                 set xri [expr {$x + $rwid}]
6339                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6340                         -width 0 -fill "#ffddaa" -tags tag.$id
6341             }
6342         }
6343         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6344                    -font $font -tags [list tag.$id text]]
6345         if {$ntags >= 0} {
6346             $canv bind $t <1> [list showtag $tag_quoted 1]
6347         } elseif {$nheads >= 0} {
6348             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6349         }
6350     }
6351     return $xt
6352 }
6353
6354 proc drawnotesign {xt y} {
6355     global linespc canv fgcolor
6356
6357     set orad [expr {$linespc / 3}]
6358     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6359                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6360                -fill yellow -outline $fgcolor -width 1 -tags circle]
6361     set xt [expr {$xt + $orad * 3}]
6362     return $xt
6363 }
6364
6365 proc xcoord {i level ln} {
6366     global canvx0 xspc1 xspc2
6367
6368     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6369     if {$i > 0 && $i == $level} {
6370         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6371     } elseif {$i > $level} {
6372         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6373     }
6374     return $x
6375 }
6376
6377 proc show_status {msg} {
6378     global canv fgcolor
6379
6380     clear_display
6381     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6382         -tags text -fill $fgcolor
6383 }
6384
6385 # Don't change the text pane cursor if it is currently the hand cursor,
6386 # showing that we are over a sha1 ID link.
6387 proc settextcursor {c} {
6388     global ctext curtextcursor
6389
6390     if {[$ctext cget -cursor] == $curtextcursor} {
6391         $ctext config -cursor $c
6392     }
6393     set curtextcursor $c
6394 }
6395
6396 proc nowbusy {what {name {}}} {
6397     global isbusy busyname statusw
6398
6399     if {[array names isbusy] eq {}} {
6400         . config -cursor watch
6401         settextcursor watch
6402     }
6403     set isbusy($what) 1
6404     set busyname($what) $name
6405     if {$name ne {}} {
6406         $statusw conf -text $name
6407     }
6408 }
6409
6410 proc notbusy {what} {
6411     global isbusy maincursor textcursor busyname statusw
6412
6413     catch {
6414         unset isbusy($what)
6415         if {$busyname($what) ne {} &&
6416             [$statusw cget -text] eq $busyname($what)} {
6417             $statusw conf -text {}
6418         }
6419     }
6420     if {[array names isbusy] eq {}} {
6421         . config -cursor $maincursor
6422         settextcursor $textcursor
6423     }
6424 }
6425
6426 proc findmatches {f} {
6427     global findtype findstring
6428     if {$findtype == [mc "Regexp"]} {
6429         set matches [regexp -indices -all -inline $findstring $f]
6430     } else {
6431         set fs $findstring
6432         if {$findtype == [mc "IgnCase"]} {
6433             set f [string tolower $f]
6434             set fs [string tolower $fs]
6435         }
6436         set matches {}
6437         set i 0
6438         set l [string length $fs]
6439         while {[set j [string first $fs $f $i]] >= 0} {
6440             lappend matches [list $j [expr {$j+$l-1}]]
6441             set i [expr {$j + $l}]
6442         }
6443     }
6444     return $matches
6445 }
6446
6447 proc dofind {{dirn 1} {wrap 1}} {
6448     global findstring findstartline findcurline selectedline numcommits
6449     global gdttype filehighlight fh_serial find_dirn findallowwrap
6450
6451     if {[info exists find_dirn]} {
6452         if {$find_dirn == $dirn} return
6453         stopfinding
6454     }
6455     focus .
6456     if {$findstring eq {} || $numcommits == 0} return
6457     if {$selectedline eq {}} {
6458         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6459     } else {
6460         set findstartline $selectedline
6461     }
6462     set findcurline $findstartline
6463     nowbusy finding [mc "Searching"]
6464     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6465         after cancel do_file_hl $fh_serial
6466         do_file_hl $fh_serial
6467     }
6468     set find_dirn $dirn
6469     set findallowwrap $wrap
6470     run findmore
6471 }
6472
6473 proc stopfinding {} {
6474     global find_dirn findcurline fprogcoord
6475
6476     if {[info exists find_dirn]} {
6477         unset find_dirn
6478         unset findcurline
6479         notbusy finding
6480         set fprogcoord 0
6481         adjustprogress
6482     }
6483     stopblaming
6484 }
6485
6486 proc findmore {} {
6487     global commitdata commitinfo numcommits findpattern findloc
6488     global findstartline findcurline findallowwrap
6489     global find_dirn gdttype fhighlights fprogcoord
6490     global curview varcorder vrownum varccommits vrowmod
6491
6492     if {![info exists find_dirn]} {
6493         return 0
6494     }
6495     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6496     set l $findcurline
6497     set moretodo 0
6498     if {$find_dirn > 0} {
6499         incr l
6500         if {$l >= $numcommits} {
6501             set l 0
6502         }
6503         if {$l <= $findstartline} {
6504             set lim [expr {$findstartline + 1}]
6505         } else {
6506             set lim $numcommits
6507             set moretodo $findallowwrap
6508         }
6509     } else {
6510         if {$l == 0} {
6511             set l $numcommits
6512         }
6513         incr l -1
6514         if {$l >= $findstartline} {
6515             set lim [expr {$findstartline - 1}]
6516         } else {
6517             set lim -1
6518             set moretodo $findallowwrap
6519         }
6520     }
6521     set n [expr {($lim - $l) * $find_dirn}]
6522     if {$n > 500} {
6523         set n 500
6524         set moretodo 1
6525     }
6526     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6527         update_arcrows $curview
6528     }
6529     set found 0
6530     set domore 1
6531     set ai [bsearch $vrownum($curview) $l]
6532     set a [lindex $varcorder($curview) $ai]
6533     set arow [lindex $vrownum($curview) $ai]
6534     set ids [lindex $varccommits($curview,$a)]
6535     set arowend [expr {$arow + [llength $ids]}]
6536     if {$gdttype eq [mc "containing:"]} {
6537         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6538             if {$l < $arow || $l >= $arowend} {
6539                 incr ai $find_dirn
6540                 set a [lindex $varcorder($curview) $ai]
6541                 set arow [lindex $vrownum($curview) $ai]
6542                 set ids [lindex $varccommits($curview,$a)]
6543                 set arowend [expr {$arow + [llength $ids]}]
6544             }
6545             set id [lindex $ids [expr {$l - $arow}]]
6546             # shouldn't happen unless git log doesn't give all the commits...
6547             if {![info exists commitdata($id)] ||
6548                 ![doesmatch $commitdata($id)]} {
6549                 continue
6550             }
6551             if {![info exists commitinfo($id)]} {
6552                 getcommit $id
6553             }
6554             set info $commitinfo($id)
6555             foreach f $info ty $fldtypes {
6556                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6557                     [doesmatch $f]} {
6558                     set found 1
6559                     break
6560                 }
6561             }
6562             if {$found} break
6563         }
6564     } else {
6565         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6566             if {$l < $arow || $l >= $arowend} {
6567                 incr ai $find_dirn
6568                 set a [lindex $varcorder($curview) $ai]
6569                 set arow [lindex $vrownum($curview) $ai]
6570                 set ids [lindex $varccommits($curview,$a)]
6571                 set arowend [expr {$arow + [llength $ids]}]
6572             }
6573             set id [lindex $ids [expr {$l - $arow}]]
6574             if {![info exists fhighlights($id)]} {
6575                 # this sets fhighlights($id) to -1
6576                 askfilehighlight $l $id
6577             }
6578             if {$fhighlights($id) > 0} {
6579                 set found $domore
6580                 break
6581             }
6582             if {$fhighlights($id) < 0} {
6583                 if {$domore} {
6584                     set domore 0
6585                     set findcurline [expr {$l - $find_dirn}]
6586                 }
6587             }
6588         }
6589     }
6590     if {$found || ($domore && !$moretodo)} {
6591         unset findcurline
6592         unset find_dirn
6593         notbusy finding
6594         set fprogcoord 0
6595         adjustprogress
6596         if {$found} {
6597             findselectline $l
6598         } else {
6599             bell
6600         }
6601         return 0
6602     }
6603     if {!$domore} {
6604         flushhighlights
6605     } else {
6606         set findcurline [expr {$l - $find_dirn}]
6607     }
6608     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6609     if {$n < 0} {
6610         incr n $numcommits
6611     }
6612     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6613     adjustprogress
6614     return $domore
6615 }
6616
6617 proc findselectline {l} {
6618     global findloc commentend ctext findcurline markingmatches gdttype
6619
6620     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6621     set findcurline $l
6622     selectline $l 1
6623     if {$markingmatches &&
6624         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6625         # highlight the matches in the comments
6626         set f [$ctext get 1.0 $commentend]
6627         set matches [findmatches $f]
6628         foreach match $matches {
6629             set start [lindex $match 0]
6630             set end [expr {[lindex $match 1] + 1}]
6631             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6632         }
6633     }
6634     drawvisible
6635 }
6636
6637 # mark the bits of a headline or author that match a find string
6638 proc markmatches {canv l str tag matches font row} {
6639     global selectedline
6640
6641     set bbox [$canv bbox $tag]
6642     set x0 [lindex $bbox 0]
6643     set y0 [lindex $bbox 1]
6644     set y1 [lindex $bbox 3]
6645     foreach match $matches {
6646         set start [lindex $match 0]
6647         set end [lindex $match 1]
6648         if {$start > $end} continue
6649         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6650         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6651         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6652                    [expr {$x0+$xlen+2}] $y1 \
6653                    -outline {} -tags [list match$l matches] -fill yellow]
6654         $canv lower $t
6655         if {$row == $selectedline} {
6656             $canv raise $t secsel
6657         }
6658     }
6659 }
6660
6661 proc unmarkmatches {} {
6662     global markingmatches
6663
6664     allcanvs delete matches
6665     set markingmatches 0
6666     stopfinding
6667 }
6668
6669 proc selcanvline {w x y} {
6670     global canv canvy0 ctext linespc
6671     global rowtextx
6672     set ymax [lindex [$canv cget -scrollregion] 3]
6673     if {$ymax == {}} return
6674     set yfrac [lindex [$canv yview] 0]
6675     set y [expr {$y + $yfrac * $ymax}]
6676     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6677     if {$l < 0} {
6678         set l 0
6679     }
6680     if {$w eq $canv} {
6681         set xmax [lindex [$canv cget -scrollregion] 2]
6682         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6683         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6684     }
6685     unmarkmatches
6686     selectline $l 1
6687 }
6688
6689 proc commit_descriptor {p} {
6690     global commitinfo
6691     if {![info exists commitinfo($p)]} {
6692         getcommit $p
6693     }
6694     set l "..."
6695     if {[llength $commitinfo($p)] > 1} {
6696         set l [lindex $commitinfo($p) 0]
6697     }
6698     return "$p ($l)\n"
6699 }
6700
6701 # append some text to the ctext widget, and make any SHA1 ID
6702 # that we know about be a clickable link.
6703 proc appendwithlinks {text tags} {
6704     global ctext linknum curview
6705
6706     set start [$ctext index "end - 1c"]
6707     $ctext insert end $text $tags
6708     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6709     foreach l $links {
6710         set s [lindex $l 0]
6711         set e [lindex $l 1]
6712         set linkid [string range $text $s $e]
6713         incr e
6714         $ctext tag delete link$linknum
6715         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6716         setlink $linkid link$linknum
6717         incr linknum
6718     }
6719 }
6720
6721 proc setlink {id lk} {
6722     global curview ctext pendinglinks
6723
6724     set known 0
6725     if {[string length $id] < 40} {
6726         set matches [longid $id]
6727         if {[llength $matches] > 0} {
6728             if {[llength $matches] > 1} return
6729             set known 1
6730             set id [lindex $matches 0]
6731         }
6732     } else {
6733         set known [commitinview $id $curview]
6734     }
6735     if {$known} {
6736         $ctext tag conf $lk -foreground blue -underline 1
6737         $ctext tag bind $lk <1> [list selbyid $id]
6738         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6739         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6740     } else {
6741         lappend pendinglinks($id) $lk
6742         interestedin $id {makelink %P}
6743     }
6744 }
6745
6746 proc appendshortlink {id {pre {}} {post {}}} {
6747     global ctext linknum
6748
6749     $ctext insert end $pre
6750     $ctext tag delete link$linknum
6751     $ctext insert end [string range $id 0 7] link$linknum
6752     $ctext insert end $post
6753     setlink $id link$linknum
6754     incr linknum
6755 }
6756
6757 proc makelink {id} {
6758     global pendinglinks
6759
6760     if {![info exists pendinglinks($id)]} return
6761     foreach lk $pendinglinks($id) {
6762         setlink $id $lk
6763     }
6764     unset pendinglinks($id)
6765 }
6766
6767 proc linkcursor {w inc} {
6768     global linkentercount curtextcursor
6769
6770     if {[incr linkentercount $inc] > 0} {
6771         $w configure -cursor hand2
6772     } else {
6773         $w configure -cursor $curtextcursor
6774         if {$linkentercount < 0} {
6775             set linkentercount 0
6776         }
6777     }
6778 }
6779
6780 proc viewnextline {dir} {
6781     global canv linespc
6782
6783     $canv delete hover
6784     set ymax [lindex [$canv cget -scrollregion] 3]
6785     set wnow [$canv yview]
6786     set wtop [expr {[lindex $wnow 0] * $ymax}]
6787     set newtop [expr {$wtop + $dir * $linespc}]
6788     if {$newtop < 0} {
6789         set newtop 0
6790     } elseif {$newtop > $ymax} {
6791         set newtop $ymax
6792     }
6793     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6794 }
6795
6796 # add a list of tag or branch names at position pos
6797 # returns the number of names inserted
6798 proc appendrefs {pos ids var} {
6799     global ctext linknum curview $var maxrefs
6800
6801     if {[catch {$ctext index $pos}]} {
6802         return 0
6803     }
6804     $ctext conf -state normal
6805     $ctext delete $pos "$pos lineend"
6806     set tags {}
6807     foreach id $ids {
6808         foreach tag [set $var\($id\)] {
6809             lappend tags [list $tag $id]
6810         }
6811     }
6812     if {[llength $tags] > $maxrefs} {
6813         $ctext insert $pos "[mc "many"] ([llength $tags])"
6814     } else {
6815         set tags [lsort -index 0 -decreasing $tags]
6816         set sep {}
6817         foreach ti $tags {
6818             set id [lindex $ti 1]
6819             set lk link$linknum
6820             incr linknum
6821             $ctext tag delete $lk
6822             $ctext insert $pos $sep
6823             $ctext insert $pos [lindex $ti 0] $lk
6824             setlink $id $lk
6825             set sep ", "
6826         }
6827     }
6828     $ctext conf -state disabled
6829     return [llength $tags]
6830 }
6831
6832 # called when we have finished computing the nearby tags
6833 proc dispneartags {delay} {
6834     global selectedline currentid showneartags tagphase
6835
6836     if {$selectedline eq {} || !$showneartags} return
6837     after cancel dispnexttag
6838     if {$delay} {
6839         after 200 dispnexttag
6840         set tagphase -1
6841     } else {
6842         after idle dispnexttag
6843         set tagphase 0
6844     }
6845 }
6846
6847 proc dispnexttag {} {
6848     global selectedline currentid showneartags tagphase ctext
6849
6850     if {$selectedline eq {} || !$showneartags} return
6851     switch -- $tagphase {
6852         0 {
6853             set dtags [desctags $currentid]
6854             if {$dtags ne {}} {
6855                 appendrefs precedes $dtags idtags
6856             }
6857         }
6858         1 {
6859             set atags [anctags $currentid]
6860             if {$atags ne {}} {
6861                 appendrefs follows $atags idtags
6862             }
6863         }
6864         2 {
6865             set dheads [descheads $currentid]
6866             if {$dheads ne {}} {
6867                 if {[appendrefs branch $dheads idheads] > 1
6868                     && [$ctext get "branch -3c"] eq "h"} {
6869                     # turn "Branch" into "Branches"
6870                     $ctext conf -state normal
6871                     $ctext insert "branch -2c" "es"
6872                     $ctext conf -state disabled
6873                 }
6874             }
6875         }
6876     }
6877     if {[incr tagphase] <= 2} {
6878         after idle dispnexttag
6879     }
6880 }
6881
6882 proc make_secsel {id} {
6883     global linehtag linentag linedtag canv canv2 canv3
6884
6885     if {![info exists linehtag($id)]} return
6886     $canv delete secsel
6887     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6888                -tags secsel -fill [$canv cget -selectbackground]]
6889     $canv lower $t
6890     $canv2 delete secsel
6891     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6892                -tags secsel -fill [$canv2 cget -selectbackground]]
6893     $canv2 lower $t
6894     $canv3 delete secsel
6895     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6896                -tags secsel -fill [$canv3 cget -selectbackground]]
6897     $canv3 lower $t
6898 }
6899
6900 proc make_idmark {id} {
6901     global linehtag canv fgcolor
6902
6903     if {![info exists linehtag($id)]} return
6904     $canv delete markid
6905     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6906                -tags markid -outline $fgcolor]
6907     $canv raise $t
6908 }
6909
6910 proc selectline {l isnew {desired_loc {}}} {
6911     global canv ctext commitinfo selectedline
6912     global canvy0 linespc parents children curview
6913     global currentid sha1entry
6914     global commentend idtags linknum
6915     global mergemax numcommits pending_select
6916     global cmitmode showneartags allcommits
6917     global targetrow targetid lastscrollrows
6918     global autoselect autosellen jump_to_here
6919
6920     catch {unset pending_select}
6921     $canv delete hover
6922     normalline
6923     unsel_reflist
6924     stopfinding
6925     if {$l < 0 || $l >= $numcommits} return
6926     set id [commitonrow $l]
6927     set targetid $id
6928     set targetrow $l
6929     set selectedline $l
6930     set currentid $id
6931     if {$lastscrollrows < $numcommits} {
6932         setcanvscroll
6933     }
6934
6935     set y [expr {$canvy0 + $l * $linespc}]
6936     set ymax [lindex [$canv cget -scrollregion] 3]
6937     set ytop [expr {$y - $linespc - 1}]
6938     set ybot [expr {$y + $linespc + 1}]
6939     set wnow [$canv yview]
6940     set wtop [expr {[lindex $wnow 0] * $ymax}]
6941     set wbot [expr {[lindex $wnow 1] * $ymax}]
6942     set wh [expr {$wbot - $wtop}]
6943     set newtop $wtop
6944     if {$ytop < $wtop} {
6945         if {$ybot < $wtop} {
6946             set newtop [expr {$y - $wh / 2.0}]
6947         } else {
6948             set newtop $ytop
6949             if {$newtop > $wtop - $linespc} {
6950                 set newtop [expr {$wtop - $linespc}]
6951             }
6952         }
6953     } elseif {$ybot > $wbot} {
6954         if {$ytop > $wbot} {
6955             set newtop [expr {$y - $wh / 2.0}]
6956         } else {
6957             set newtop [expr {$ybot - $wh}]
6958             if {$newtop < $wtop + $linespc} {
6959                 set newtop [expr {$wtop + $linespc}]
6960             }
6961         }
6962     }
6963     if {$newtop != $wtop} {
6964         if {$newtop < 0} {
6965             set newtop 0
6966         }
6967         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6968         drawvisible
6969     }
6970
6971     make_secsel $id
6972
6973     if {$isnew} {
6974         addtohistory [list selbyid $id 0] savecmitpos
6975     }
6976
6977     $sha1entry delete 0 end
6978     $sha1entry insert 0 $id
6979     if {$autoselect} {
6980         $sha1entry selection range 0 $autosellen
6981     }
6982     rhighlight_sel $id
6983
6984     $ctext conf -state normal
6985     clear_ctext
6986     set linknum 0
6987     if {![info exists commitinfo($id)]} {
6988         getcommit $id
6989     }
6990     set info $commitinfo($id)
6991     set date [formatdate [lindex $info 2]]
6992     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6993     set date [formatdate [lindex $info 4]]
6994     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6995     if {[info exists idtags($id)]} {
6996         $ctext insert end [mc "Tags:"]
6997         foreach tag $idtags($id) {
6998             $ctext insert end " $tag"
6999         }
7000         $ctext insert end "\n"
7001     }
7002
7003     set headers {}
7004     set olds $parents($curview,$id)
7005     if {[llength $olds] > 1} {
7006         set np 0
7007         foreach p $olds {
7008             if {$np >= $mergemax} {
7009                 set tag mmax
7010             } else {
7011                 set tag m$np
7012             }
7013             $ctext insert end "[mc "Parent"]: " $tag
7014             appendwithlinks [commit_descriptor $p] {}
7015             incr np
7016         }
7017     } else {
7018         foreach p $olds {
7019             append headers "[mc "Parent"]: [commit_descriptor $p]"
7020         }
7021     }
7022
7023     foreach c $children($curview,$id) {
7024         append headers "[mc "Child"]:  [commit_descriptor $c]"
7025     }
7026
7027     # make anything that looks like a SHA1 ID be a clickable link
7028     appendwithlinks $headers {}
7029     if {$showneartags} {
7030         if {![info exists allcommits]} {
7031             getallcommits
7032         }
7033         $ctext insert end "[mc "Branch"]: "
7034         $ctext mark set branch "end -1c"
7035         $ctext mark gravity branch left
7036         $ctext insert end "\n[mc "Follows"]: "
7037         $ctext mark set follows "end -1c"
7038         $ctext mark gravity follows left
7039         $ctext insert end "\n[mc "Precedes"]: "
7040         $ctext mark set precedes "end -1c"
7041         $ctext mark gravity precedes left
7042         $ctext insert end "\n"
7043         dispneartags 1
7044     }
7045     $ctext insert end "\n"
7046     set comment [lindex $info 5]
7047     if {[string first "\r" $comment] >= 0} {
7048         set comment [string map {"\r" "\n    "} $comment]
7049     }
7050     appendwithlinks $comment {comment}
7051
7052     $ctext tag remove found 1.0 end
7053     $ctext conf -state disabled
7054     set commentend [$ctext index "end - 1c"]
7055
7056     set jump_to_here $desired_loc
7057     init_flist [mc "Comments"]
7058     if {$cmitmode eq "tree"} {
7059         gettree $id
7060     } elseif {[llength $olds] <= 1} {
7061         startdiff $id
7062     } else {
7063         mergediff $id
7064     }
7065 }
7066
7067 proc selfirstline {} {
7068     unmarkmatches
7069     selectline 0 1
7070 }
7071
7072 proc sellastline {} {
7073     global numcommits
7074     unmarkmatches
7075     set l [expr {$numcommits - 1}]
7076     selectline $l 1
7077 }
7078
7079 proc selnextline {dir} {
7080     global selectedline
7081     focus .
7082     if {$selectedline eq {}} return
7083     set l [expr {$selectedline + $dir}]
7084     unmarkmatches
7085     selectline $l 1
7086 }
7087
7088 proc selnextpage {dir} {
7089     global canv linespc selectedline numcommits
7090
7091     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7092     if {$lpp < 1} {
7093         set lpp 1
7094     }
7095     allcanvs yview scroll [expr {$dir * $lpp}] units
7096     drawvisible
7097     if {$selectedline eq {}} return
7098     set l [expr {$selectedline + $dir * $lpp}]
7099     if {$l < 0} {
7100         set l 0
7101     } elseif {$l >= $numcommits} {
7102         set l [expr $numcommits - 1]
7103     }
7104     unmarkmatches
7105     selectline $l 1
7106 }
7107
7108 proc unselectline {} {
7109     global selectedline currentid
7110
7111     set selectedline {}
7112     catch {unset currentid}
7113     allcanvs delete secsel
7114     rhighlight_none
7115 }
7116
7117 proc reselectline {} {
7118     global selectedline
7119
7120     if {$selectedline ne {}} {
7121         selectline $selectedline 0
7122     }
7123 }
7124
7125 proc addtohistory {cmd {saveproc {}}} {
7126     global history historyindex curview
7127
7128     unset_posvars
7129     save_position
7130     set elt [list $curview $cmd $saveproc {}]
7131     if {$historyindex > 0
7132         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7133         return
7134     }
7135
7136     if {$historyindex < [llength $history]} {
7137         set history [lreplace $history $historyindex end $elt]
7138     } else {
7139         lappend history $elt
7140     }
7141     incr historyindex
7142     if {$historyindex > 1} {
7143         .tf.bar.leftbut conf -state normal
7144     } else {
7145         .tf.bar.leftbut conf -state disabled
7146     }
7147     .tf.bar.rightbut conf -state disabled
7148 }
7149
7150 # save the scrolling position of the diff display pane
7151 proc save_position {} {
7152     global historyindex history
7153
7154     if {$historyindex < 1} return
7155     set hi [expr {$historyindex - 1}]
7156     set fn [lindex $history $hi 2]
7157     if {$fn ne {}} {
7158         lset history $hi 3 [eval $fn]
7159     }
7160 }
7161
7162 proc unset_posvars {} {
7163     global last_posvars
7164
7165     if {[info exists last_posvars]} {
7166         foreach {var val} $last_posvars {
7167             global $var
7168             catch {unset $var}
7169         }
7170         unset last_posvars
7171     }
7172 }
7173
7174 proc godo {elt} {
7175     global curview last_posvars
7176
7177     set view [lindex $elt 0]
7178     set cmd [lindex $elt 1]
7179     set pv [lindex $elt 3]
7180     if {$curview != $view} {
7181         showview $view
7182     }
7183     unset_posvars
7184     foreach {var val} $pv {
7185         global $var
7186         set $var $val
7187     }
7188     set last_posvars $pv
7189     eval $cmd
7190 }
7191
7192 proc goback {} {
7193     global history historyindex
7194     focus .
7195
7196     if {$historyindex > 1} {
7197         save_position
7198         incr historyindex -1
7199         godo [lindex $history [expr {$historyindex - 1}]]
7200         .tf.bar.rightbut conf -state normal
7201     }
7202     if {$historyindex <= 1} {
7203         .tf.bar.leftbut conf -state disabled
7204     }
7205 }
7206
7207 proc goforw {} {
7208     global history historyindex
7209     focus .
7210
7211     if {$historyindex < [llength $history]} {
7212         save_position
7213         set cmd [lindex $history $historyindex]
7214         incr historyindex
7215         godo $cmd
7216         .tf.bar.leftbut conf -state normal
7217     }
7218     if {$historyindex >= [llength $history]} {
7219         .tf.bar.rightbut conf -state disabled
7220     }
7221 }
7222
7223 proc gettree {id} {
7224     global treefilelist treeidlist diffids diffmergeid treepending
7225     global nullid nullid2
7226
7227     set diffids $id
7228     catch {unset diffmergeid}
7229     if {![info exists treefilelist($id)]} {
7230         if {![info exists treepending]} {
7231             if {$id eq $nullid} {
7232                 set cmd [list | git ls-files]
7233             } elseif {$id eq $nullid2} {
7234                 set cmd [list | git ls-files --stage -t]
7235             } else {
7236                 set cmd [list | git ls-tree -r $id]
7237             }
7238             if {[catch {set gtf [open $cmd r]}]} {
7239                 return
7240             }
7241             set treepending $id
7242             set treefilelist($id) {}
7243             set treeidlist($id) {}
7244             fconfigure $gtf -blocking 0 -encoding binary
7245             filerun $gtf [list gettreeline $gtf $id]
7246         }
7247     } else {
7248         setfilelist $id
7249     }
7250 }
7251
7252 proc gettreeline {gtf id} {
7253     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7254
7255     set nl 0
7256     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7257         if {$diffids eq $nullid} {
7258             set fname $line
7259         } else {
7260             set i [string first "\t" $line]
7261             if {$i < 0} continue
7262             set fname [string range $line [expr {$i+1}] end]
7263             set line [string range $line 0 [expr {$i-1}]]
7264             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7265             set sha1 [lindex $line 2]
7266             lappend treeidlist($id) $sha1
7267         }
7268         if {[string index $fname 0] eq "\""} {
7269             set fname [lindex $fname 0]
7270         }
7271         set fname [encoding convertfrom $fname]
7272         lappend treefilelist($id) $fname
7273     }
7274     if {![eof $gtf]} {
7275         return [expr {$nl >= 1000? 2: 1}]
7276     }
7277     close $gtf
7278     unset treepending
7279     if {$cmitmode ne "tree"} {
7280         if {![info exists diffmergeid]} {
7281             gettreediffs $diffids
7282         }
7283     } elseif {$id ne $diffids} {
7284         gettree $diffids
7285     } else {
7286         setfilelist $id
7287     }
7288     return 0
7289 }
7290
7291 proc showfile {f} {
7292     global treefilelist treeidlist diffids nullid nullid2
7293     global ctext_file_names ctext_file_lines
7294     global ctext commentend
7295
7296     set i [lsearch -exact $treefilelist($diffids) $f]
7297     if {$i < 0} {
7298         puts "oops, $f not in list for id $diffids"
7299         return
7300     }
7301     if {$diffids eq $nullid} {
7302         if {[catch {set bf [open $f r]} err]} {
7303             puts "oops, can't read $f: $err"
7304             return
7305         }
7306     } else {
7307         set blob [lindex $treeidlist($diffids) $i]
7308         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7309             puts "oops, error reading blob $blob: $err"
7310             return
7311         }
7312     }
7313     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7314     filerun $bf [list getblobline $bf $diffids]
7315     $ctext config -state normal
7316     clear_ctext $commentend
7317     lappend ctext_file_names $f
7318     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7319     $ctext insert end "\n"
7320     $ctext insert end "$f\n" filesep
7321     $ctext config -state disabled
7322     $ctext yview $commentend
7323     settabs 0
7324 }
7325
7326 proc getblobline {bf id} {
7327     global diffids cmitmode ctext
7328
7329     if {$id ne $diffids || $cmitmode ne "tree"} {
7330         catch {close $bf}
7331         return 0
7332     }
7333     $ctext config -state normal
7334     set nl 0
7335     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7336         $ctext insert end "$line\n"
7337     }
7338     if {[eof $bf]} {
7339         global jump_to_here ctext_file_names commentend
7340
7341         # delete last newline
7342         $ctext delete "end - 2c" "end - 1c"
7343         close $bf
7344         if {$jump_to_here ne {} &&
7345             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7346             set lnum [expr {[lindex $jump_to_here 1] +
7347                             [lindex [split $commentend .] 0]}]
7348             mark_ctext_line $lnum
7349         }
7350         $ctext config -state disabled
7351         return 0
7352     }
7353     $ctext config -state disabled
7354     return [expr {$nl >= 1000? 2: 1}]
7355 }
7356
7357 proc mark_ctext_line {lnum} {
7358     global ctext markbgcolor
7359
7360     $ctext tag delete omark
7361     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7362     $ctext tag conf omark -background $markbgcolor
7363     $ctext see $lnum.0
7364 }
7365
7366 proc mergediff {id} {
7367     global diffmergeid
7368     global diffids treediffs
7369     global parents curview
7370
7371     set diffmergeid $id
7372     set diffids $id
7373     set treediffs($id) {}
7374     set np [llength $parents($curview,$id)]
7375     settabs $np
7376     getblobdiffs $id
7377 }
7378
7379 proc startdiff {ids} {
7380     global treediffs diffids treepending diffmergeid nullid nullid2
7381
7382     settabs 1
7383     set diffids $ids
7384     catch {unset diffmergeid}
7385     if {![info exists treediffs($ids)] ||
7386         [lsearch -exact $ids $nullid] >= 0 ||
7387         [lsearch -exact $ids $nullid2] >= 0} {
7388         if {![info exists treepending]} {
7389             gettreediffs $ids
7390         }
7391     } else {
7392         addtocflist $ids
7393     }
7394 }
7395
7396 proc path_filter {filter name} {
7397     foreach p $filter {
7398         set l [string length $p]
7399         if {[string index $p end] eq "/"} {
7400             if {[string compare -length $l $p $name] == 0} {
7401                 return 1
7402             }
7403         } else {
7404             if {[string compare -length $l $p $name] == 0 &&
7405                 ([string length $name] == $l ||
7406                  [string index $name $l] eq "/")} {
7407                 return 1
7408             }
7409         }
7410     }
7411     return 0
7412 }
7413
7414 proc addtocflist {ids} {
7415     global treediffs
7416
7417     add_flist $treediffs($ids)
7418     getblobdiffs $ids
7419 }
7420
7421 proc diffcmd {ids flags} {
7422     global nullid nullid2
7423
7424     set i [lsearch -exact $ids $nullid]
7425     set j [lsearch -exact $ids $nullid2]
7426     if {$i >= 0} {
7427         if {[llength $ids] > 1 && $j < 0} {
7428             # comparing working directory with some specific revision
7429             set cmd [concat | git diff-index $flags]
7430             if {$i == 0} {
7431                 lappend cmd -R [lindex $ids 1]
7432             } else {
7433                 lappend cmd [lindex $ids 0]
7434             }
7435         } else {
7436             # comparing working directory with index
7437             set cmd [concat | git diff-files $flags]
7438             if {$j == 1} {
7439                 lappend cmd -R
7440             }
7441         }
7442     } elseif {$j >= 0} {
7443         set cmd [concat | git diff-index --cached $flags]
7444         if {[llength $ids] > 1} {
7445             # comparing index with specific revision
7446             if {$j == 0} {
7447                 lappend cmd -R [lindex $ids 1]
7448             } else {
7449                 lappend cmd [lindex $ids 0]
7450             }
7451         } else {
7452             # comparing index with HEAD
7453             lappend cmd HEAD
7454         }
7455     } else {
7456         set cmd [concat | git diff-tree -r $flags $ids]
7457     }
7458     return $cmd
7459 }
7460
7461 proc gettreediffs {ids} {
7462     global treediff treepending
7463
7464     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7465
7466     set treepending $ids
7467     set treediff {}
7468     fconfigure $gdtf -blocking 0 -encoding binary
7469     filerun $gdtf [list gettreediffline $gdtf $ids]
7470 }
7471
7472 proc gettreediffline {gdtf ids} {
7473     global treediff treediffs treepending diffids diffmergeid
7474     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7475
7476     set nr 0
7477     set sublist {}
7478     set max 1000
7479     if {$perfile_attrs} {
7480         # cache_gitattr is slow, and even slower on win32 where we
7481         # have to invoke it for only about 30 paths at a time
7482         set max 500
7483         if {[tk windowingsystem] == "win32"} {
7484             set max 120
7485         }
7486     }
7487     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7488         set i [string first "\t" $line]
7489         if {$i >= 0} {
7490             set file [string range $line [expr {$i+1}] end]
7491             if {[string index $file 0] eq "\""} {
7492                 set file [lindex $file 0]
7493             }
7494             set file [encoding convertfrom $file]
7495             if {$file ne [lindex $treediff end]} {
7496                 lappend treediff $file
7497                 lappend sublist $file
7498             }
7499         }
7500     }
7501     if {$perfile_attrs} {
7502         cache_gitattr encoding $sublist
7503     }
7504     if {![eof $gdtf]} {
7505         return [expr {$nr >= $max? 2: 1}]
7506     }
7507     close $gdtf
7508     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7509         set flist {}
7510         foreach f $treediff {
7511             if {[path_filter $vfilelimit($curview) $f]} {
7512                 lappend flist $f
7513             }
7514         }
7515         set treediffs($ids) $flist
7516     } else {
7517         set treediffs($ids) $treediff
7518     }
7519     unset treepending
7520     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7521         gettree $diffids
7522     } elseif {$ids != $diffids} {
7523         if {![info exists diffmergeid]} {
7524             gettreediffs $diffids
7525         }
7526     } else {
7527         addtocflist $ids
7528     }
7529     return 0
7530 }
7531
7532 # empty string or positive integer
7533 proc diffcontextvalidate {v} {
7534     return [regexp {^(|[1-9][0-9]*)$} $v]
7535 }
7536
7537 proc diffcontextchange {n1 n2 op} {
7538     global diffcontextstring diffcontext
7539
7540     if {[string is integer -strict $diffcontextstring]} {
7541         if {$diffcontextstring >= 0} {
7542             set diffcontext $diffcontextstring
7543             reselectline
7544         }
7545     }
7546 }
7547
7548 proc changeignorespace {} {
7549     reselectline
7550 }
7551
7552 proc changeworddiff {name ix op} {
7553     reselectline
7554 }
7555
7556 proc getblobdiffs {ids} {
7557     global blobdifffd diffids env
7558     global diffinhdr treediffs
7559     global diffcontext
7560     global ignorespace
7561     global worddiff
7562     global limitdiffs vfilelimit curview
7563     global diffencoding targetline diffnparents
7564     global git_version currdiffsubmod
7565
7566     set textconv {}
7567     if {[package vcompare $git_version "1.6.1"] >= 0} {
7568         set textconv "--textconv"
7569     }
7570     set submodule {}
7571     if {[package vcompare $git_version "1.6.6"] >= 0} {
7572         set submodule "--submodule"
7573     }
7574     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7575     if {$ignorespace} {
7576         append cmd " -w"
7577     }
7578     if {$worddiff ne [mc "Line diff"]} {
7579         append cmd " --word-diff=porcelain"
7580     }
7581     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7582         set cmd [concat $cmd -- $vfilelimit($curview)]
7583     }
7584     if {[catch {set bdf [open $cmd r]} err]} {
7585         error_popup [mc "Error getting diffs: %s" $err]
7586         return
7587     }
7588     set targetline {}
7589     set diffnparents 0
7590     set diffinhdr 0
7591     set diffencoding [get_path_encoding {}]
7592     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7593     set blobdifffd($ids) $bdf
7594     set currdiffsubmod ""
7595     filerun $bdf [list getblobdiffline $bdf $diffids]
7596 }
7597
7598 proc savecmitpos {} {
7599     global ctext cmitmode
7600
7601     if {$cmitmode eq "tree"} {
7602         return {}
7603     }
7604     return [list target_scrollpos [$ctext index @0,0]]
7605 }
7606
7607 proc savectextpos {} {
7608     global ctext
7609
7610     return [list target_scrollpos [$ctext index @0,0]]
7611 }
7612
7613 proc maybe_scroll_ctext {ateof} {
7614     global ctext target_scrollpos
7615
7616     if {![info exists target_scrollpos]} return
7617     if {!$ateof} {
7618         set nlines [expr {[winfo height $ctext]
7619                           / [font metrics textfont -linespace]}]
7620         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7621     }
7622     $ctext yview $target_scrollpos
7623     unset target_scrollpos
7624 }
7625
7626 proc setinlist {var i val} {
7627     global $var
7628
7629     while {[llength [set $var]] < $i} {
7630         lappend $var {}
7631     }
7632     if {[llength [set $var]] == $i} {
7633         lappend $var $val
7634     } else {
7635         lset $var $i $val
7636     }
7637 }
7638
7639 proc makediffhdr {fname ids} {
7640     global ctext curdiffstart treediffs diffencoding
7641     global ctext_file_names jump_to_here targetline diffline
7642
7643     set fname [encoding convertfrom $fname]
7644     set diffencoding [get_path_encoding $fname]
7645     set i [lsearch -exact $treediffs($ids) $fname]
7646     if {$i >= 0} {
7647         setinlist difffilestart $i $curdiffstart
7648     }
7649     lset ctext_file_names end $fname
7650     set l [expr {(78 - [string length $fname]) / 2}]
7651     set pad [string range "----------------------------------------" 1 $l]
7652     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7653     set targetline {}
7654     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7655         set targetline [lindex $jump_to_here 1]
7656     }
7657     set diffline 0
7658 }
7659
7660 proc getblobdiffline {bdf ids} {
7661     global diffids blobdifffd ctext curdiffstart
7662     global diffnexthead diffnextnote difffilestart
7663     global ctext_file_names ctext_file_lines
7664     global diffinhdr treediffs mergemax diffnparents
7665     global diffencoding jump_to_here targetline diffline currdiffsubmod
7666     global worddiff
7667
7668     set nr 0
7669     $ctext conf -state normal
7670     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7671         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7672             catch {close $bdf}
7673             return 0
7674         }
7675         if {![string compare -length 5 "diff " $line]} {
7676             if {![regexp {^diff (--cc|--git) } $line m type]} {
7677                 set line [encoding convertfrom $line]
7678                 $ctext insert end "$line\n" hunksep
7679                 continue
7680             }
7681             # start of a new file
7682             set diffinhdr 1
7683             $ctext insert end "\n"
7684             set curdiffstart [$ctext index "end - 1c"]
7685             lappend ctext_file_names ""
7686             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7687             $ctext insert end "\n" filesep
7688
7689             if {$type eq "--cc"} {
7690                 # start of a new file in a merge diff
7691                 set fname [string range $line 10 end]
7692                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7693                     lappend treediffs($ids) $fname
7694                     add_flist [list $fname]
7695                 }
7696
7697             } else {
7698                 set line [string range $line 11 end]
7699                 # If the name hasn't changed the length will be odd,
7700                 # the middle char will be a space, and the two bits either
7701                 # side will be a/name and b/name, or "a/name" and "b/name".
7702                 # If the name has changed we'll get "rename from" and
7703                 # "rename to" or "copy from" and "copy to" lines following
7704                 # this, and we'll use them to get the filenames.
7705                 # This complexity is necessary because spaces in the
7706                 # filename(s) don't get escaped.
7707                 set l [string length $line]
7708                 set i [expr {$l / 2}]
7709                 if {!(($l & 1) && [string index $line $i] eq " " &&
7710                       [string range $line 2 [expr {$i - 1}]] eq \
7711                           [string range $line [expr {$i + 3}] end])} {
7712                     continue
7713                 }
7714                 # unescape if quoted and chop off the a/ from the front
7715                 if {[string index $line 0] eq "\""} {
7716                     set fname [string range [lindex $line 0] 2 end]
7717                 } else {
7718                     set fname [string range $line 2 [expr {$i - 1}]]
7719                 }
7720             }
7721             makediffhdr $fname $ids
7722
7723         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7724             set fname [encoding convertfrom [string range $line 16 end]]
7725             $ctext insert end "\n"
7726             set curdiffstart [$ctext index "end - 1c"]
7727             lappend ctext_file_names $fname
7728             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7729             $ctext insert end "$line\n" filesep
7730             set i [lsearch -exact $treediffs($ids) $fname]
7731             if {$i >= 0} {
7732                 setinlist difffilestart $i $curdiffstart
7733             }
7734
7735         } elseif {![string compare -length 2 "@@" $line]} {
7736             regexp {^@@+} $line ats
7737             set line [encoding convertfrom $diffencoding $line]
7738             $ctext insert end "$line\n" hunksep
7739             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7740                 set diffline $nl
7741             }
7742             set diffnparents [expr {[string length $ats] - 1}]
7743             set diffinhdr 0
7744
7745         } elseif {![string compare -length 10 "Submodule " $line]} {
7746             # start of a new submodule
7747             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7748                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7749             } else {
7750                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7751             }
7752             if {$currdiffsubmod != $fname} {
7753                 $ctext insert end "\n";     # Add newline after commit message
7754             }
7755             set curdiffstart [$ctext index "end - 1c"]
7756             lappend ctext_file_names ""
7757             if {$currdiffsubmod != $fname} {
7758                 lappend ctext_file_lines $fname
7759                 makediffhdr $fname $ids
7760                 set currdiffsubmod $fname
7761                 $ctext insert end "\n$line\n" filesep
7762             } else {
7763                 $ctext insert end "$line\n" filesep
7764             }
7765         } elseif {![string compare -length 3 "  >" $line]} {
7766             set $currdiffsubmod ""
7767             set line [encoding convertfrom $diffencoding $line]
7768             $ctext insert end "$line\n" dresult
7769         } elseif {![string compare -length 3 "  <" $line]} {
7770             set $currdiffsubmod ""
7771             set line [encoding convertfrom $diffencoding $line]
7772             $ctext insert end "$line\n" d0
7773         } elseif {$diffinhdr} {
7774             if {![string compare -length 12 "rename from " $line]} {
7775                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7776                 if {[string index $fname 0] eq "\""} {
7777                     set fname [lindex $fname 0]
7778                 }
7779                 set fname [encoding convertfrom $fname]
7780                 set i [lsearch -exact $treediffs($ids) $fname]
7781                 if {$i >= 0} {
7782                     setinlist difffilestart $i $curdiffstart
7783                 }
7784             } elseif {![string compare -length 10 $line "rename to "] ||
7785                       ![string compare -length 8 $line "copy to "]} {
7786                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7787                 if {[string index $fname 0] eq "\""} {
7788                     set fname [lindex $fname 0]
7789                 }
7790                 makediffhdr $fname $ids
7791             } elseif {[string compare -length 3 $line "---"] == 0} {
7792                 # do nothing
7793                 continue
7794             } elseif {[string compare -length 3 $line "+++"] == 0} {
7795                 set diffinhdr 0
7796                 continue
7797             }
7798             $ctext insert end "$line\n" filesep
7799
7800         } else {
7801             set line [string map {\x1A ^Z} \
7802                           [encoding convertfrom $diffencoding $line]]
7803             # parse the prefix - one ' ', '-' or '+' for each parent
7804             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7805             set tag [expr {$diffnparents > 1? "m": "d"}]
7806             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7807             set words_pre_markup ""
7808             set words_post_markup ""
7809             if {[string trim $prefix " -+"] eq {}} {
7810                 # prefix only has " ", "-" and "+" in it: normal diff line
7811                 set num [string first "-" $prefix]
7812                 if {$dowords} {
7813                     set line [string range $line 1 end]
7814                 }
7815                 if {$num >= 0} {
7816                     # removed line, first parent with line is $num
7817                     if {$num >= $mergemax} {
7818                         set num "max"
7819                     }
7820                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7821                         $ctext insert end "\[-$line-\]" $tag$num
7822                     } else {
7823                         $ctext insert end "$line" $tag$num
7824                     }
7825                     if {!$dowords} {
7826                         $ctext insert end "\n" $tag$num
7827                     }
7828                 } else {
7829                     set tags {}
7830                     if {[string first "+" $prefix] >= 0} {
7831                         # added line
7832                         lappend tags ${tag}result
7833                         if {$diffnparents > 1} {
7834                             set num [string first " " $prefix]
7835                             if {$num >= 0} {
7836                                 if {$num >= $mergemax} {
7837                                     set num "max"
7838                                 }
7839                                 lappend tags m$num
7840                             }
7841                         }
7842                         set words_pre_markup "{+"
7843                         set words_post_markup "+}"
7844                     }
7845                     if {$targetline ne {}} {
7846                         if {$diffline == $targetline} {
7847                             set seehere [$ctext index "end - 1 chars"]
7848                             set targetline {}
7849                         } else {
7850                             incr diffline
7851                         }
7852                     }
7853                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7854                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7855                     } else {
7856                         $ctext insert end "$line" $tags
7857                     }
7858                     if {!$dowords} {
7859                         $ctext insert end "\n" $tags
7860                     }
7861                 }
7862             } elseif {$dowords && $prefix eq "~"} {
7863                 $ctext insert end "\n" {}
7864             } else {
7865                 # "\ No newline at end of file",
7866                 # or something else we don't recognize
7867                 $ctext insert end "$line\n" hunksep
7868             }
7869         }
7870     }
7871     if {[info exists seehere]} {
7872         mark_ctext_line [lindex [split $seehere .] 0]
7873     }
7874     maybe_scroll_ctext [eof $bdf]
7875     $ctext conf -state disabled
7876     if {[eof $bdf]} {
7877         catch {close $bdf}
7878         return 0
7879     }
7880     return [expr {$nr >= 1000? 2: 1}]
7881 }
7882
7883 proc changediffdisp {} {
7884     global ctext diffelide
7885
7886     $ctext tag conf d0 -elide [lindex $diffelide 0]
7887     $ctext tag conf dresult -elide [lindex $diffelide 1]
7888 }
7889
7890 proc highlightfile {loc cline} {
7891     global ctext cflist cflist_top
7892
7893     $ctext yview $loc
7894     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7895     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7896     $cflist see $cline.0
7897     set cflist_top $cline
7898 }
7899
7900 proc prevfile {} {
7901     global difffilestart ctext cmitmode
7902
7903     if {$cmitmode eq "tree"} return
7904     set prev 0.0
7905     set prevline 1
7906     set here [$ctext index @0,0]
7907     foreach loc $difffilestart {
7908         if {[$ctext compare $loc >= $here]} {
7909             highlightfile $prev $prevline
7910             return
7911         }
7912         set prev $loc
7913         incr prevline
7914     }
7915     highlightfile $prev $prevline
7916 }
7917
7918 proc nextfile {} {
7919     global difffilestart ctext cmitmode
7920
7921     if {$cmitmode eq "tree"} return
7922     set here [$ctext index @0,0]
7923     set line 1
7924     foreach loc $difffilestart {
7925         incr line
7926         if {[$ctext compare $loc > $here]} {
7927             highlightfile $loc $line
7928             return
7929         }
7930     }
7931 }
7932
7933 proc clear_ctext {{first 1.0}} {
7934     global ctext smarktop smarkbot
7935     global ctext_file_names ctext_file_lines
7936     global pendinglinks
7937
7938     set l [lindex [split $first .] 0]
7939     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7940         set smarktop $l
7941     }
7942     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7943         set smarkbot $l
7944     }
7945     $ctext delete $first end
7946     if {$first eq "1.0"} {
7947         catch {unset pendinglinks}
7948     }
7949     set ctext_file_names {}
7950     set ctext_file_lines {}
7951 }
7952
7953 proc settabs {{firstab {}}} {
7954     global firsttabstop tabstop ctext have_tk85
7955
7956     if {$firstab ne {} && $have_tk85} {
7957         set firsttabstop $firstab
7958     }
7959     set w [font measure textfont "0"]
7960     if {$firsttabstop != 0} {
7961         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7962                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7963     } elseif {$have_tk85 || $tabstop != 8} {
7964         $ctext conf -tabs [expr {$tabstop * $w}]
7965     } else {
7966         $ctext conf -tabs {}
7967     }
7968 }
7969
7970 proc incrsearch {name ix op} {
7971     global ctext searchstring searchdirn
7972
7973     $ctext tag remove found 1.0 end
7974     if {[catch {$ctext index anchor}]} {
7975         # no anchor set, use start of selection, or of visible area
7976         set sel [$ctext tag ranges sel]
7977         if {$sel ne {}} {
7978             $ctext mark set anchor [lindex $sel 0]
7979         } elseif {$searchdirn eq "-forwards"} {
7980             $ctext mark set anchor @0,0
7981         } else {
7982             $ctext mark set anchor @0,[winfo height $ctext]
7983         }
7984     }
7985     if {$searchstring ne {}} {
7986         set here [$ctext search $searchdirn -- $searchstring anchor]
7987         if {$here ne {}} {
7988             $ctext see $here
7989         }
7990         searchmarkvisible 1
7991     }
7992 }
7993
7994 proc dosearch {} {
7995     global sstring ctext searchstring searchdirn
7996
7997     focus $sstring
7998     $sstring icursor end
7999     set searchdirn -forwards
8000     if {$searchstring ne {}} {
8001         set sel [$ctext tag ranges sel]
8002         if {$sel ne {}} {
8003             set start "[lindex $sel 0] + 1c"
8004         } elseif {[catch {set start [$ctext index anchor]}]} {
8005             set start "@0,0"
8006         }
8007         set match [$ctext search -count mlen -- $searchstring $start]
8008         $ctext tag remove sel 1.0 end
8009         if {$match eq {}} {
8010             bell
8011             return
8012         }
8013         $ctext see $match
8014         set mend "$match + $mlen c"
8015         $ctext tag add sel $match $mend
8016         $ctext mark unset anchor
8017     }
8018 }
8019
8020 proc dosearchback {} {
8021     global sstring ctext searchstring searchdirn
8022
8023     focus $sstring
8024     $sstring icursor end
8025     set searchdirn -backwards
8026     if {$searchstring ne {}} {
8027         set sel [$ctext tag ranges sel]
8028         if {$sel ne {}} {
8029             set start [lindex $sel 0]
8030         } elseif {[catch {set start [$ctext index anchor]}]} {
8031             set start @0,[winfo height $ctext]
8032         }
8033         set match [$ctext search -backwards -count ml -- $searchstring $start]
8034         $ctext tag remove sel 1.0 end
8035         if {$match eq {}} {
8036             bell
8037             return
8038         }
8039         $ctext see $match
8040         set mend "$match + $ml c"
8041         $ctext tag add sel $match $mend
8042         $ctext mark unset anchor
8043     }
8044 }
8045
8046 proc searchmark {first last} {
8047     global ctext searchstring
8048
8049     set mend $first.0
8050     while {1} {
8051         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8052         if {$match eq {}} break
8053         set mend "$match + $mlen c"
8054         $ctext tag add found $match $mend
8055     }
8056 }
8057
8058 proc searchmarkvisible {doall} {
8059     global ctext smarktop smarkbot
8060
8061     set topline [lindex [split [$ctext index @0,0] .] 0]
8062     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8063     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8064         # no overlap with previous
8065         searchmark $topline $botline
8066         set smarktop $topline
8067         set smarkbot $botline
8068     } else {
8069         if {$topline < $smarktop} {
8070             searchmark $topline [expr {$smarktop-1}]
8071             set smarktop $topline
8072         }
8073         if {$botline > $smarkbot} {
8074             searchmark [expr {$smarkbot+1}] $botline
8075             set smarkbot $botline
8076         }
8077     }
8078 }
8079
8080 proc scrolltext {f0 f1} {
8081     global searchstring
8082
8083     .bleft.bottom.sb set $f0 $f1
8084     if {$searchstring ne {}} {
8085         searchmarkvisible 0
8086     }
8087 }
8088
8089 proc setcoords {} {
8090     global linespc charspc canvx0 canvy0
8091     global xspc1 xspc2 lthickness
8092
8093     set linespc [font metrics mainfont -linespace]
8094     set charspc [font measure mainfont "m"]
8095     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8096     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8097     set lthickness [expr {int($linespc / 9) + 1}]
8098     set xspc1(0) $linespc
8099     set xspc2 $linespc
8100 }
8101
8102 proc redisplay {} {
8103     global canv
8104     global selectedline
8105
8106     set ymax [lindex [$canv cget -scrollregion] 3]
8107     if {$ymax eq {} || $ymax == 0} return
8108     set span [$canv yview]
8109     clear_display
8110     setcanvscroll
8111     allcanvs yview moveto [lindex $span 0]
8112     drawvisible
8113     if {$selectedline ne {}} {
8114         selectline $selectedline 0
8115         allcanvs yview moveto [lindex $span 0]
8116     }
8117 }
8118
8119 proc parsefont {f n} {
8120     global fontattr
8121
8122     set fontattr($f,family) [lindex $n 0]
8123     set s [lindex $n 1]
8124     if {$s eq {} || $s == 0} {
8125         set s 10
8126     } elseif {$s < 0} {
8127         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8128     }
8129     set fontattr($f,size) $s
8130     set fontattr($f,weight) normal
8131     set fontattr($f,slant) roman
8132     foreach style [lrange $n 2 end] {
8133         switch -- $style {
8134             "normal" -
8135             "bold"   {set fontattr($f,weight) $style}
8136             "roman" -
8137             "italic" {set fontattr($f,slant) $style}
8138         }
8139     }
8140 }
8141
8142 proc fontflags {f {isbold 0}} {
8143     global fontattr
8144
8145     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8146                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8147                 -slant $fontattr($f,slant)]
8148 }
8149
8150 proc fontname {f} {
8151     global fontattr
8152
8153     set n [list $fontattr($f,family) $fontattr($f,size)]
8154     if {$fontattr($f,weight) eq "bold"} {
8155         lappend n "bold"
8156     }
8157     if {$fontattr($f,slant) eq "italic"} {
8158         lappend n "italic"
8159     }
8160     return $n
8161 }
8162
8163 proc incrfont {inc} {
8164     global mainfont textfont ctext canv cflist showrefstop
8165     global stopped entries fontattr
8166
8167     unmarkmatches
8168     set s $fontattr(mainfont,size)
8169     incr s $inc
8170     if {$s < 1} {
8171         set s 1
8172     }
8173     set fontattr(mainfont,size) $s
8174     font config mainfont -size $s
8175     font config mainfontbold -size $s
8176     set mainfont [fontname mainfont]
8177     set s $fontattr(textfont,size)
8178     incr s $inc
8179     if {$s < 1} {
8180         set s 1
8181     }
8182     set fontattr(textfont,size) $s
8183     font config textfont -size $s
8184     font config textfontbold -size $s
8185     set textfont [fontname textfont]
8186     setcoords
8187     settabs
8188     redisplay
8189 }
8190
8191 proc clearsha1 {} {
8192     global sha1entry sha1string
8193     if {[string length $sha1string] == 40} {
8194         $sha1entry delete 0 end
8195     }
8196 }
8197
8198 proc sha1change {n1 n2 op} {
8199     global sha1string currentid sha1but
8200     if {$sha1string == {}
8201         || ([info exists currentid] && $sha1string == $currentid)} {
8202         set state disabled
8203     } else {
8204         set state normal
8205     }
8206     if {[$sha1but cget -state] == $state} return
8207     if {$state == "normal"} {
8208         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8209     } else {
8210         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8211     }
8212 }
8213
8214 proc gotocommit {} {
8215     global sha1string tagids headids curview varcid
8216
8217     if {$sha1string == {}
8218         || ([info exists currentid] && $sha1string == $currentid)} return
8219     if {[info exists tagids($sha1string)]} {
8220         set id $tagids($sha1string)
8221     } elseif {[info exists headids($sha1string)]} {
8222         set id $headids($sha1string)
8223     } else {
8224         set id [string tolower $sha1string]
8225         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8226             set matches [longid $id]
8227             if {$matches ne {}} {
8228                 if {[llength $matches] > 1} {
8229                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8230                     return
8231                 }
8232                 set id [lindex $matches 0]
8233             }
8234         } else {
8235             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8236                 error_popup [mc "Revision %s is not known" $sha1string]
8237                 return
8238             }
8239         }
8240     }
8241     if {[commitinview $id $curview]} {
8242         selectline [rowofcommit $id] 1
8243         return
8244     }
8245     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8246         set msg [mc "SHA1 id %s is not known" $sha1string]
8247     } else {
8248         set msg [mc "Revision %s is not in the current view" $sha1string]
8249     }
8250     error_popup $msg
8251 }
8252
8253 proc lineenter {x y id} {
8254     global hoverx hovery hoverid hovertimer
8255     global commitinfo canv
8256
8257     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8258     set hoverx $x
8259     set hovery $y
8260     set hoverid $id
8261     if {[info exists hovertimer]} {
8262         after cancel $hovertimer
8263     }
8264     set hovertimer [after 500 linehover]
8265     $canv delete hover
8266 }
8267
8268 proc linemotion {x y id} {
8269     global hoverx hovery hoverid hovertimer
8270
8271     if {[info exists hoverid] && $id == $hoverid} {
8272         set hoverx $x
8273         set hovery $y
8274         if {[info exists hovertimer]} {
8275             after cancel $hovertimer
8276         }
8277         set hovertimer [after 500 linehover]
8278     }
8279 }
8280
8281 proc lineleave {id} {
8282     global hoverid hovertimer canv
8283
8284     if {[info exists hoverid] && $id == $hoverid} {
8285         $canv delete hover
8286         if {[info exists hovertimer]} {
8287             after cancel $hovertimer
8288             unset hovertimer
8289         }
8290         unset hoverid
8291     }
8292 }
8293
8294 proc linehover {} {
8295     global hoverx hovery hoverid hovertimer
8296     global canv linespc lthickness
8297     global commitinfo
8298
8299     set text [lindex $commitinfo($hoverid) 0]
8300     set ymax [lindex [$canv cget -scrollregion] 3]
8301     if {$ymax == {}} return
8302     set yfrac [lindex [$canv yview] 0]
8303     set x [expr {$hoverx + 2 * $linespc}]
8304     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8305     set x0 [expr {$x - 2 * $lthickness}]
8306     set y0 [expr {$y - 2 * $lthickness}]
8307     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8308     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8309     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8310                -fill \#ffff80 -outline black -width 1 -tags hover]
8311     $canv raise $t
8312     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8313                -font mainfont]
8314     $canv raise $t
8315 }
8316
8317 proc clickisonarrow {id y} {
8318     global lthickness
8319
8320     set ranges [rowranges $id]
8321     set thresh [expr {2 * $lthickness + 6}]
8322     set n [expr {[llength $ranges] - 1}]
8323     for {set i 1} {$i < $n} {incr i} {
8324         set row [lindex $ranges $i]
8325         if {abs([yc $row] - $y) < $thresh} {
8326             return $i
8327         }
8328     }
8329     return {}
8330 }
8331
8332 proc arrowjump {id n y} {
8333     global canv
8334
8335     # 1 <-> 2, 3 <-> 4, etc...
8336     set n [expr {(($n - 1) ^ 1) + 1}]
8337     set row [lindex [rowranges $id] $n]
8338     set yt [yc $row]
8339     set ymax [lindex [$canv cget -scrollregion] 3]
8340     if {$ymax eq {} || $ymax <= 0} return
8341     set view [$canv yview]
8342     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8343     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8344     if {$yfrac < 0} {
8345         set yfrac 0
8346     }
8347     allcanvs yview moveto $yfrac
8348 }
8349
8350 proc lineclick {x y id isnew} {
8351     global ctext commitinfo children canv thickerline curview
8352
8353     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8354     unmarkmatches
8355     unselectline
8356     normalline
8357     $canv delete hover
8358     # draw this line thicker than normal
8359     set thickerline $id
8360     drawlines $id
8361     if {$isnew} {
8362         set ymax [lindex [$canv cget -scrollregion] 3]
8363         if {$ymax eq {}} return
8364         set yfrac [lindex [$canv yview] 0]
8365         set y [expr {$y + $yfrac * $ymax}]
8366     }
8367     set dirn [clickisonarrow $id $y]
8368     if {$dirn ne {}} {
8369         arrowjump $id $dirn $y
8370         return
8371     }
8372
8373     if {$isnew} {
8374         addtohistory [list lineclick $x $y $id 0] savectextpos
8375     }
8376     # fill the details pane with info about this line
8377     $ctext conf -state normal
8378     clear_ctext
8379     settabs 0
8380     $ctext insert end "[mc "Parent"]:\t"
8381     $ctext insert end $id link0
8382     setlink $id link0
8383     set info $commitinfo($id)
8384     $ctext insert end "\n\t[lindex $info 0]\n"
8385     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8386     set date [formatdate [lindex $info 2]]
8387     $ctext insert end "\t[mc "Date"]:\t$date\n"
8388     set kids $children($curview,$id)
8389     if {$kids ne {}} {
8390         $ctext insert end "\n[mc "Children"]:"
8391         set i 0
8392         foreach child $kids {
8393             incr i
8394             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8395             set info $commitinfo($child)
8396             $ctext insert end "\n\t"
8397             $ctext insert end $child link$i
8398             setlink $child link$i
8399             $ctext insert end "\n\t[lindex $info 0]"
8400             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8401             set date [formatdate [lindex $info 2]]
8402             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8403         }
8404     }
8405     maybe_scroll_ctext 1
8406     $ctext conf -state disabled
8407     init_flist {}
8408 }
8409
8410 proc normalline {} {
8411     global thickerline
8412     if {[info exists thickerline]} {
8413         set id $thickerline
8414         unset thickerline
8415         drawlines $id
8416     }
8417 }
8418
8419 proc selbyid {id {isnew 1}} {
8420     global curview
8421     if {[commitinview $id $curview]} {
8422         selectline [rowofcommit $id] $isnew
8423     }
8424 }
8425
8426 proc mstime {} {
8427     global startmstime
8428     if {![info exists startmstime]} {
8429         set startmstime [clock clicks -milliseconds]
8430     }
8431     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8432 }
8433
8434 proc rowmenu {x y id} {
8435     global rowctxmenu selectedline rowmenuid curview
8436     global nullid nullid2 fakerowmenu mainhead markedid
8437
8438     stopfinding
8439     set rowmenuid $id
8440     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8441         set state disabled
8442     } else {
8443         set state normal
8444     }
8445     if {$id ne $nullid && $id ne $nullid2} {
8446         set menu $rowctxmenu
8447         if {$mainhead ne {}} {
8448             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8449         } else {
8450             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8451         }
8452         if {[info exists markedid] && $markedid ne $id} {
8453             $menu entryconfigure 9 -state normal
8454             $menu entryconfigure 10 -state normal
8455             $menu entryconfigure 11 -state normal
8456         } else {
8457             $menu entryconfigure 9 -state disabled
8458             $menu entryconfigure 10 -state disabled
8459             $menu entryconfigure 11 -state disabled
8460         }
8461     } else {
8462         set menu $fakerowmenu
8463     }
8464     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8465     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8466     $menu entryconfigure [mca "Make patch"] -state $state
8467     tk_popup $menu $x $y
8468 }
8469
8470 proc markhere {} {
8471     global rowmenuid markedid canv
8472
8473     set markedid $rowmenuid
8474     make_idmark $markedid
8475 }
8476
8477 proc gotomark {} {
8478     global markedid
8479
8480     if {[info exists markedid]} {
8481         selbyid $markedid
8482     }
8483 }
8484
8485 proc replace_by_kids {l r} {
8486     global curview children
8487
8488     set id [commitonrow $r]
8489     set l [lreplace $l 0 0]
8490     foreach kid $children($curview,$id) {
8491         lappend l [rowofcommit $kid]
8492     }
8493     return [lsort -integer -decreasing -unique $l]
8494 }
8495
8496 proc find_common_desc {} {
8497     global markedid rowmenuid curview children
8498
8499     if {![info exists markedid]} return
8500     if {![commitinview $markedid $curview] ||
8501         ![commitinview $rowmenuid $curview]} return
8502     #set t1 [clock clicks -milliseconds]
8503     set l1 [list [rowofcommit $markedid]]
8504     set l2 [list [rowofcommit $rowmenuid]]
8505     while 1 {
8506         set r1 [lindex $l1 0]
8507         set r2 [lindex $l2 0]
8508         if {$r1 eq {} || $r2 eq {}} break
8509         if {$r1 == $r2} {
8510             selectline $r1 1
8511             break
8512         }
8513         if {$r1 > $r2} {
8514             set l1 [replace_by_kids $l1 $r1]
8515         } else {
8516             set l2 [replace_by_kids $l2 $r2]
8517         }
8518     }
8519     #set t2 [clock clicks -milliseconds]
8520     #puts "took [expr {$t2-$t1}]ms"
8521 }
8522
8523 proc compare_commits {} {
8524     global markedid rowmenuid curview children
8525
8526     if {![info exists markedid]} return
8527     if {![commitinview $markedid $curview]} return
8528     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8529     do_cmp_commits $markedid $rowmenuid
8530 }
8531
8532 proc getpatchid {id} {
8533     global patchids
8534
8535     if {![info exists patchids($id)]} {
8536         set cmd [diffcmd [list $id] {-p --root}]
8537         # trim off the initial "|"
8538         set cmd [lrange $cmd 1 end]
8539         if {[catch {
8540             set x [eval exec $cmd | git patch-id]
8541             set patchids($id) [lindex $x 0]
8542         }]} {
8543             set patchids($id) "error"
8544         }
8545     }
8546     return $patchids($id)
8547 }
8548
8549 proc do_cmp_commits {a b} {
8550     global ctext curview parents children patchids commitinfo
8551
8552     $ctext conf -state normal
8553     clear_ctext
8554     init_flist {}
8555     for {set i 0} {$i < 100} {incr i} {
8556         set skipa 0
8557         set skipb 0
8558         if {[llength $parents($curview,$a)] > 1} {
8559             appendshortlink $a [mc "Skipping merge commit "] "\n"
8560             set skipa 1
8561         } else {
8562             set patcha [getpatchid $a]
8563         }
8564         if {[llength $parents($curview,$b)] > 1} {
8565             appendshortlink $b [mc "Skipping merge commit "] "\n"
8566             set skipb 1
8567         } else {
8568             set patchb [getpatchid $b]
8569         }
8570         if {!$skipa && !$skipb} {
8571             set heada [lindex $commitinfo($a) 0]
8572             set headb [lindex $commitinfo($b) 0]
8573             if {$patcha eq "error"} {
8574                 appendshortlink $a [mc "Error getting patch ID for "] \
8575                     [mc " - stopping\n"]
8576                 break
8577             }
8578             if {$patchb eq "error"} {
8579                 appendshortlink $b [mc "Error getting patch ID for "] \
8580                     [mc " - stopping\n"]
8581                 break
8582             }
8583             if {$patcha eq $patchb} {
8584                 if {$heada eq $headb} {
8585                     appendshortlink $a [mc "Commit "]
8586                     appendshortlink $b " == " "  $heada\n"
8587                 } else {
8588                     appendshortlink $a [mc "Commit "] "  $heada\n"
8589                     appendshortlink $b [mc " is the same patch as\n       "] \
8590                         "  $headb\n"
8591                 }
8592                 set skipa 1
8593                 set skipb 1
8594             } else {
8595                 $ctext insert end "\n"
8596                 appendshortlink $a [mc "Commit "] "  $heada\n"
8597                 appendshortlink $b [mc " differs from\n       "] \
8598                     "  $headb\n"
8599                 $ctext insert end [mc "Diff of commits:\n\n"]
8600                 $ctext conf -state disabled
8601                 update
8602                 diffcommits $a $b
8603                 return
8604             }
8605         }
8606         if {$skipa} {
8607             set kids [real_children $curview,$a]
8608             if {[llength $kids] != 1} {
8609                 $ctext insert end "\n"
8610                 appendshortlink $a [mc "Commit "] \
8611                     [mc " has %s children - stopping\n" [llength $kids]]
8612                 break
8613             }
8614             set a [lindex $kids 0]
8615         }
8616         if {$skipb} {
8617             set kids [real_children $curview,$b]
8618             if {[llength $kids] != 1} {
8619                 appendshortlink $b [mc "Commit "] \
8620                     [mc " has %s children - stopping\n" [llength $kids]]
8621                 break
8622             }
8623             set b [lindex $kids 0]
8624         }
8625     }
8626     $ctext conf -state disabled
8627 }
8628
8629 proc diffcommits {a b} {
8630     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8631
8632     set tmpdir [gitknewtmpdir]
8633     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8634     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8635     if {[catch {
8636         exec git diff-tree -p --pretty $a >$fna
8637         exec git diff-tree -p --pretty $b >$fnb
8638     } err]} {
8639         error_popup [mc "Error writing commit to file: %s" $err]
8640         return
8641     }
8642     if {[catch {
8643         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8644     } err]} {
8645         error_popup [mc "Error diffing commits: %s" $err]
8646         return
8647     }
8648     set diffids [list commits $a $b]
8649     set blobdifffd($diffids) $fd
8650     set diffinhdr 0
8651     set currdiffsubmod ""
8652     filerun $fd [list getblobdiffline $fd $diffids]
8653 }
8654
8655 proc diffvssel {dirn} {
8656     global rowmenuid selectedline
8657
8658     if {$selectedline eq {}} return
8659     if {$dirn} {
8660         set oldid [commitonrow $selectedline]
8661         set newid $rowmenuid
8662     } else {
8663         set oldid $rowmenuid
8664         set newid [commitonrow $selectedline]
8665     }
8666     addtohistory [list doseldiff $oldid $newid] savectextpos
8667     doseldiff $oldid $newid
8668 }
8669
8670 proc doseldiff {oldid newid} {
8671     global ctext
8672     global commitinfo
8673
8674     $ctext conf -state normal
8675     clear_ctext
8676     init_flist [mc "Top"]
8677     $ctext insert end "[mc "From"] "
8678     $ctext insert end $oldid link0
8679     setlink $oldid link0
8680     $ctext insert end "\n     "
8681     $ctext insert end [lindex $commitinfo($oldid) 0]
8682     $ctext insert end "\n\n[mc "To"]   "
8683     $ctext insert end $newid link1
8684     setlink $newid link1
8685     $ctext insert end "\n     "
8686     $ctext insert end [lindex $commitinfo($newid) 0]
8687     $ctext insert end "\n"
8688     $ctext conf -state disabled
8689     $ctext tag remove found 1.0 end
8690     startdiff [list $oldid $newid]
8691 }
8692
8693 proc mkpatch {} {
8694     global rowmenuid currentid commitinfo patchtop patchnum NS
8695
8696     if {![info exists currentid]} return
8697     set oldid $currentid
8698     set oldhead [lindex $commitinfo($oldid) 0]
8699     set newid $rowmenuid
8700     set newhead [lindex $commitinfo($newid) 0]
8701     set top .patch
8702     set patchtop $top
8703     catch {destroy $top}
8704     ttk_toplevel $top
8705     make_transient $top .
8706     ${NS}::label $top.title -text [mc "Generate patch"]
8707     grid $top.title - -pady 10
8708     ${NS}::label $top.from -text [mc "From:"]
8709     ${NS}::entry $top.fromsha1 -width 40
8710     $top.fromsha1 insert 0 $oldid
8711     $top.fromsha1 conf -state readonly
8712     grid $top.from $top.fromsha1 -sticky w
8713     ${NS}::entry $top.fromhead -width 60
8714     $top.fromhead insert 0 $oldhead
8715     $top.fromhead conf -state readonly
8716     grid x $top.fromhead -sticky w
8717     ${NS}::label $top.to -text [mc "To:"]
8718     ${NS}::entry $top.tosha1 -width 40
8719     $top.tosha1 insert 0 $newid
8720     $top.tosha1 conf -state readonly
8721     grid $top.to $top.tosha1 -sticky w
8722     ${NS}::entry $top.tohead -width 60
8723     $top.tohead insert 0 $newhead
8724     $top.tohead conf -state readonly
8725     grid x $top.tohead -sticky w
8726     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8727     grid $top.rev x -pady 10 -padx 5
8728     ${NS}::label $top.flab -text [mc "Output file:"]
8729     ${NS}::entry $top.fname -width 60
8730     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8731     incr patchnum
8732     grid $top.flab $top.fname -sticky w
8733     ${NS}::frame $top.buts
8734     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8735     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8736     bind $top <Key-Return> mkpatchgo
8737     bind $top <Key-Escape> mkpatchcan
8738     grid $top.buts.gen $top.buts.can
8739     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8740     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8741     grid $top.buts - -pady 10 -sticky ew
8742     focus $top.fname
8743 }
8744
8745 proc mkpatchrev {} {
8746     global patchtop
8747
8748     set oldid [$patchtop.fromsha1 get]
8749     set oldhead [$patchtop.fromhead get]
8750     set newid [$patchtop.tosha1 get]
8751     set newhead [$patchtop.tohead get]
8752     foreach e [list fromsha1 fromhead tosha1 tohead] \
8753             v [list $newid $newhead $oldid $oldhead] {
8754         $patchtop.$e conf -state normal
8755         $patchtop.$e delete 0 end
8756         $patchtop.$e insert 0 $v
8757         $patchtop.$e conf -state readonly
8758     }
8759 }
8760
8761 proc mkpatchgo {} {
8762     global patchtop nullid nullid2
8763
8764     set oldid [$patchtop.fromsha1 get]
8765     set newid [$patchtop.tosha1 get]
8766     set fname [$patchtop.fname get]
8767     set cmd [diffcmd [list $oldid $newid] -p]
8768     # trim off the initial "|"
8769     set cmd [lrange $cmd 1 end]
8770     lappend cmd >$fname &
8771     if {[catch {eval exec $cmd} err]} {
8772         error_popup "[mc "Error creating patch:"] $err" $patchtop
8773     }
8774     catch {destroy $patchtop}
8775     unset patchtop
8776 }
8777
8778 proc mkpatchcan {} {
8779     global patchtop
8780
8781     catch {destroy $patchtop}
8782     unset patchtop
8783 }
8784
8785 proc mktag {} {
8786     global rowmenuid mktagtop commitinfo NS
8787
8788     set top .maketag
8789     set mktagtop $top
8790     catch {destroy $top}
8791     ttk_toplevel $top
8792     make_transient $top .
8793     ${NS}::label $top.title -text [mc "Create tag"]
8794     grid $top.title - -pady 10
8795     ${NS}::label $top.id -text [mc "ID:"]
8796     ${NS}::entry $top.sha1 -width 40
8797     $top.sha1 insert 0 $rowmenuid
8798     $top.sha1 conf -state readonly
8799     grid $top.id $top.sha1 -sticky w
8800     ${NS}::entry $top.head -width 60
8801     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8802     $top.head conf -state readonly
8803     grid x $top.head -sticky w
8804     ${NS}::label $top.tlab -text [mc "Tag name:"]
8805     ${NS}::entry $top.tag -width 60
8806     grid $top.tlab $top.tag -sticky w
8807     ${NS}::label $top.op -text [mc "Tag message is optional"]
8808     grid $top.op -columnspan 2 -sticky we
8809     ${NS}::label $top.mlab -text [mc "Tag message:"]
8810     ${NS}::entry $top.msg -width 60
8811     grid $top.mlab $top.msg -sticky w
8812     ${NS}::frame $top.buts
8813     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8814     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8815     bind $top <Key-Return> mktaggo
8816     bind $top <Key-Escape> mktagcan
8817     grid $top.buts.gen $top.buts.can
8818     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8819     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8820     grid $top.buts - -pady 10 -sticky ew
8821     focus $top.tag
8822 }
8823
8824 proc domktag {} {
8825     global mktagtop env tagids idtags
8826
8827     set id [$mktagtop.sha1 get]
8828     set tag [$mktagtop.tag get]
8829     set msg [$mktagtop.msg get]
8830     if {$tag == {}} {
8831         error_popup [mc "No tag name specified"] $mktagtop
8832         return 0
8833     }
8834     if {[info exists tagids($tag)]} {
8835         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8836         return 0
8837     }
8838     if {[catch {
8839         if {$msg != {}} {
8840             exec git tag -a -m $msg $tag $id
8841         } else {
8842             exec git tag $tag $id
8843         }
8844     } err]} {
8845         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8846         return 0
8847     }
8848
8849     set tagids($tag) $id
8850     lappend idtags($id) $tag
8851     redrawtags $id
8852     addedtag $id
8853     dispneartags 0
8854     run refill_reflist
8855     return 1
8856 }
8857
8858 proc redrawtags {id} {
8859     global canv linehtag idpos currentid curview cmitlisted markedid
8860     global canvxmax iddrawn circleitem mainheadid circlecolors
8861
8862     if {![commitinview $id $curview]} return
8863     if {![info exists iddrawn($id)]} return
8864     set row [rowofcommit $id]
8865     if {$id eq $mainheadid} {
8866         set ofill yellow
8867     } else {
8868         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8869     }
8870     $canv itemconf $circleitem($row) -fill $ofill
8871     $canv delete tag.$id
8872     set xt [eval drawtags $id $idpos($id)]
8873     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8874     set text [$canv itemcget $linehtag($id) -text]
8875     set font [$canv itemcget $linehtag($id) -font]
8876     set xr [expr {$xt + [font measure $font $text]}]
8877     if {$xr > $canvxmax} {
8878         set canvxmax $xr
8879         setcanvscroll
8880     }
8881     if {[info exists currentid] && $currentid == $id} {
8882         make_secsel $id
8883     }
8884     if {[info exists markedid] && $markedid eq $id} {
8885         make_idmark $id
8886     }
8887 }
8888
8889 proc mktagcan {} {
8890     global mktagtop
8891
8892     catch {destroy $mktagtop}
8893     unset mktagtop
8894 }
8895
8896 proc mktaggo {} {
8897     if {![domktag]} return
8898     mktagcan
8899 }
8900
8901 proc writecommit {} {
8902     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8903
8904     set top .writecommit
8905     set wrcomtop $top
8906     catch {destroy $top}
8907     ttk_toplevel $top
8908     make_transient $top .
8909     ${NS}::label $top.title -text [mc "Write commit to file"]
8910     grid $top.title - -pady 10
8911     ${NS}::label $top.id -text [mc "ID:"]
8912     ${NS}::entry $top.sha1 -width 40
8913     $top.sha1 insert 0 $rowmenuid
8914     $top.sha1 conf -state readonly
8915     grid $top.id $top.sha1 -sticky w
8916     ${NS}::entry $top.head -width 60
8917     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8918     $top.head conf -state readonly
8919     grid x $top.head -sticky w
8920     ${NS}::label $top.clab -text [mc "Command:"]
8921     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8922     grid $top.clab $top.cmd -sticky w -pady 10
8923     ${NS}::label $top.flab -text [mc "Output file:"]
8924     ${NS}::entry $top.fname -width 60
8925     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8926     grid $top.flab $top.fname -sticky w
8927     ${NS}::frame $top.buts
8928     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8929     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8930     bind $top <Key-Return> wrcomgo
8931     bind $top <Key-Escape> wrcomcan
8932     grid $top.buts.gen $top.buts.can
8933     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8934     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8935     grid $top.buts - -pady 10 -sticky ew
8936     focus $top.fname
8937 }
8938
8939 proc wrcomgo {} {
8940     global wrcomtop
8941
8942     set id [$wrcomtop.sha1 get]
8943     set cmd "echo $id | [$wrcomtop.cmd get]"
8944     set fname [$wrcomtop.fname get]
8945     if {[catch {exec sh -c $cmd >$fname &} err]} {
8946         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8947     }
8948     catch {destroy $wrcomtop}
8949     unset wrcomtop
8950 }
8951
8952 proc wrcomcan {} {
8953     global wrcomtop
8954
8955     catch {destroy $wrcomtop}
8956     unset wrcomtop
8957 }
8958
8959 proc mkbranch {} {
8960     global rowmenuid mkbrtop NS
8961
8962     set top .makebranch
8963     catch {destroy $top}
8964     ttk_toplevel $top
8965     make_transient $top .
8966     ${NS}::label $top.title -text [mc "Create new branch"]
8967     grid $top.title - -pady 10
8968     ${NS}::label $top.id -text [mc "ID:"]
8969     ${NS}::entry $top.sha1 -width 40
8970     $top.sha1 insert 0 $rowmenuid
8971     $top.sha1 conf -state readonly
8972     grid $top.id $top.sha1 -sticky w
8973     ${NS}::label $top.nlab -text [mc "Name:"]
8974     ${NS}::entry $top.name -width 40
8975     grid $top.nlab $top.name -sticky w
8976     ${NS}::frame $top.buts
8977     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8978     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8979     bind $top <Key-Return> [list mkbrgo $top]
8980     bind $top <Key-Escape> "catch {destroy $top}"
8981     grid $top.buts.go $top.buts.can
8982     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8983     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8984     grid $top.buts - -pady 10 -sticky ew
8985     focus $top.name
8986 }
8987
8988 proc mkbrgo {top} {
8989     global headids idheads
8990
8991     set name [$top.name get]
8992     set id [$top.sha1 get]
8993     set cmdargs {}
8994     set old_id {}
8995     if {$name eq {}} {
8996         error_popup [mc "Please specify a name for the new branch"] $top
8997         return
8998     }
8999     if {[info exists headids($name)]} {
9000         if {![confirm_popup [mc \
9001                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9002             return
9003         }
9004         set old_id $headids($name)
9005         lappend cmdargs -f
9006     }
9007     catch {destroy $top}
9008     lappend cmdargs $name $id
9009     nowbusy newbranch
9010     update
9011     if {[catch {
9012         eval exec git branch $cmdargs
9013     } err]} {
9014         notbusy newbranch
9015         error_popup $err
9016     } else {
9017         notbusy newbranch
9018         if {$old_id ne {}} {
9019             movehead $id $name
9020             movedhead $id $name
9021             redrawtags $old_id
9022             redrawtags $id
9023         } else {
9024             set headids($name) $id
9025             lappend idheads($id) $name
9026             addedhead $id $name
9027             redrawtags $id
9028         }
9029         dispneartags 0
9030         run refill_reflist
9031     }
9032 }
9033
9034 proc exec_citool {tool_args {baseid {}}} {
9035     global commitinfo env
9036
9037     set save_env [array get env GIT_AUTHOR_*]
9038
9039     if {$baseid ne {}} {
9040         if {![info exists commitinfo($baseid)]} {
9041             getcommit $baseid
9042         }
9043         set author [lindex $commitinfo($baseid) 1]
9044         set date [lindex $commitinfo($baseid) 2]
9045         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9046                     $author author name email]
9047             && $date ne {}} {
9048             set env(GIT_AUTHOR_NAME) $name
9049             set env(GIT_AUTHOR_EMAIL) $email
9050             set env(GIT_AUTHOR_DATE) $date
9051         }
9052     }
9053
9054     eval exec git citool $tool_args &
9055
9056     array unset env GIT_AUTHOR_*
9057     array set env $save_env
9058 }
9059
9060 proc cherrypick {} {
9061     global rowmenuid curview
9062     global mainhead mainheadid
9063     global gitdir
9064
9065     set oldhead [exec git rev-parse HEAD]
9066     set dheads [descheads $rowmenuid]
9067     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9068         set ok [confirm_popup [mc "Commit %s is already\
9069                 included in branch %s -- really re-apply it?" \
9070                                    [string range $rowmenuid 0 7] $mainhead]]
9071         if {!$ok} return
9072     }
9073     nowbusy cherrypick [mc "Cherry-picking"]
9074     update
9075     # Unfortunately git-cherry-pick writes stuff to stderr even when
9076     # no error occurs, and exec takes that as an indication of error...
9077     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9078         notbusy cherrypick
9079         if {[regexp -line \
9080                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9081                  $err msg fname]} {
9082             error_popup [mc "Cherry-pick failed because of local changes\
9083                         to file '%s'.\nPlease commit, reset or stash\
9084                         your changes and try again." $fname]
9085         } elseif {[regexp -line \
9086                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9087                        $err]} {
9088             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9089                         conflict.\nDo you wish to run git citool to\
9090                         resolve it?"]]} {
9091                 # Force citool to read MERGE_MSG
9092                 file delete [file join $gitdir "GITGUI_MSG"]
9093                 exec_citool {} $rowmenuid
9094             }
9095         } else {
9096             error_popup $err
9097         }
9098         run updatecommits
9099         return
9100     }
9101     set newhead [exec git rev-parse HEAD]
9102     if {$newhead eq $oldhead} {
9103         notbusy cherrypick
9104         error_popup [mc "No changes committed"]
9105         return
9106     }
9107     addnewchild $newhead $oldhead
9108     if {[commitinview $oldhead $curview]} {
9109         # XXX this isn't right if we have a path limit...
9110         insertrow $newhead $oldhead $curview
9111         if {$mainhead ne {}} {
9112             movehead $newhead $mainhead
9113             movedhead $newhead $mainhead
9114         }
9115         set mainheadid $newhead
9116         redrawtags $oldhead
9117         redrawtags $newhead
9118         selbyid $newhead
9119     }
9120     notbusy cherrypick
9121 }
9122
9123 proc resethead {} {
9124     global mainhead rowmenuid confirm_ok resettype NS
9125
9126     set confirm_ok 0
9127     set w ".confirmreset"
9128     ttk_toplevel $w
9129     make_transient $w .
9130     wm title $w [mc "Confirm reset"]
9131     ${NS}::label $w.m -text \
9132         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9133     pack $w.m -side top -fill x -padx 20 -pady 20
9134     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9135     set resettype mixed
9136     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9137         -text [mc "Soft: Leave working tree and index untouched"]
9138     grid $w.f.soft -sticky w
9139     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9140         -text [mc "Mixed: Leave working tree untouched, reset index"]
9141     grid $w.f.mixed -sticky w
9142     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9143         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9144     grid $w.f.hard -sticky w
9145     pack $w.f -side top -fill x -padx 4
9146     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9147     pack $w.ok -side left -fill x -padx 20 -pady 20
9148     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9149     bind $w <Key-Escape> [list destroy $w]
9150     pack $w.cancel -side right -fill x -padx 20 -pady 20
9151     bind $w <Visibility> "grab $w; focus $w"
9152     tkwait window $w
9153     if {!$confirm_ok} return
9154     if {[catch {set fd [open \
9155             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9156         error_popup $err
9157     } else {
9158         dohidelocalchanges
9159         filerun $fd [list readresetstat $fd]
9160         nowbusy reset [mc "Resetting"]
9161         selbyid $rowmenuid
9162     }
9163 }
9164
9165 proc readresetstat {fd} {
9166     global mainhead mainheadid showlocalchanges rprogcoord
9167
9168     if {[gets $fd line] >= 0} {
9169         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9170             set rprogcoord [expr {1.0 * $m / $n}]
9171             adjustprogress
9172         }
9173         return 1
9174     }
9175     set rprogcoord 0
9176     adjustprogress
9177     notbusy reset
9178     if {[catch {close $fd} err]} {
9179         error_popup $err
9180     }
9181     set oldhead $mainheadid
9182     set newhead [exec git rev-parse HEAD]
9183     if {$newhead ne $oldhead} {
9184         movehead $newhead $mainhead
9185         movedhead $newhead $mainhead
9186         set mainheadid $newhead
9187         redrawtags $oldhead
9188         redrawtags $newhead
9189     }
9190     if {$showlocalchanges} {
9191         doshowlocalchanges
9192     }
9193     return 0
9194 }
9195
9196 # context menu for a head
9197 proc headmenu {x y id head} {
9198     global headmenuid headmenuhead headctxmenu mainhead
9199
9200     stopfinding
9201     set headmenuid $id
9202     set headmenuhead $head
9203     set state normal
9204     if {[string match "remotes/*" $head]} {
9205         set state disabled
9206     }
9207     if {$head eq $mainhead} {
9208         set state disabled
9209     }
9210     $headctxmenu entryconfigure 0 -state $state
9211     $headctxmenu entryconfigure 1 -state $state
9212     tk_popup $headctxmenu $x $y
9213 }
9214
9215 proc cobranch {} {
9216     global headmenuid headmenuhead headids
9217     global showlocalchanges
9218
9219     # check the tree is clean first??
9220     nowbusy checkout [mc "Checking out"]
9221     update
9222     dohidelocalchanges
9223     if {[catch {
9224         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9225     } err]} {
9226         notbusy checkout
9227         error_popup $err
9228         if {$showlocalchanges} {
9229             dodiffindex
9230         }
9231     } else {
9232         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9233     }
9234 }
9235
9236 proc readcheckoutstat {fd newhead newheadid} {
9237     global mainhead mainheadid headids showlocalchanges progresscoords
9238     global viewmainheadid curview
9239
9240     if {[gets $fd line] >= 0} {
9241         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9242             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9243             adjustprogress
9244         }
9245         return 1
9246     }
9247     set progresscoords {0 0}
9248     adjustprogress
9249     notbusy checkout
9250     if {[catch {close $fd} err]} {
9251         error_popup $err
9252     }
9253     set oldmainid $mainheadid
9254     set mainhead $newhead
9255     set mainheadid $newheadid
9256     set viewmainheadid($curview) $newheadid
9257     redrawtags $oldmainid
9258     redrawtags $newheadid
9259     selbyid $newheadid
9260     if {$showlocalchanges} {
9261         dodiffindex
9262     }
9263 }
9264
9265 proc rmbranch {} {
9266     global headmenuid headmenuhead mainhead
9267     global idheads
9268
9269     set head $headmenuhead
9270     set id $headmenuid
9271     # this check shouldn't be needed any more...
9272     if {$head eq $mainhead} {
9273         error_popup [mc "Cannot delete the currently checked-out branch"]
9274         return
9275     }
9276     set dheads [descheads $id]
9277     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9278         # the stuff on this branch isn't on any other branch
9279         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9280                         branch.\nReally delete branch %s?" $head $head]]} return
9281     }
9282     nowbusy rmbranch
9283     update
9284     if {[catch {exec git branch -D $head} err]} {
9285         notbusy rmbranch
9286         error_popup $err
9287         return
9288     }
9289     removehead $id $head
9290     removedhead $id $head
9291     redrawtags $id
9292     notbusy rmbranch
9293     dispneartags 0
9294     run refill_reflist
9295 }
9296
9297 # Display a list of tags and heads
9298 proc showrefs {} {
9299     global showrefstop bgcolor fgcolor selectbgcolor NS
9300     global bglist fglist reflistfilter reflist maincursor
9301
9302     set top .showrefs
9303     set showrefstop $top
9304     if {[winfo exists $top]} {
9305         raise $top
9306         refill_reflist
9307         return
9308     }
9309     ttk_toplevel $top
9310     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9311     make_transient $top .
9312     text $top.list -background $bgcolor -foreground $fgcolor \
9313         -selectbackground $selectbgcolor -font mainfont \
9314         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9315         -width 30 -height 20 -cursor $maincursor \
9316         -spacing1 1 -spacing3 1 -state disabled
9317     $top.list tag configure highlight -background $selectbgcolor
9318     lappend bglist $top.list
9319     lappend fglist $top.list
9320     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9321     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9322     grid $top.list $top.ysb -sticky nsew
9323     grid $top.xsb x -sticky ew
9324     ${NS}::frame $top.f
9325     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9326     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9327     set reflistfilter "*"
9328     trace add variable reflistfilter write reflistfilter_change
9329     pack $top.f.e -side right -fill x -expand 1
9330     pack $top.f.l -side left
9331     grid $top.f - -sticky ew -pady 2
9332     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9333     bind $top <Key-Escape> [list destroy $top]
9334     grid $top.close -
9335     grid columnconfigure $top 0 -weight 1
9336     grid rowconfigure $top 0 -weight 1
9337     bind $top.list <1> {break}
9338     bind $top.list <B1-Motion> {break}
9339     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9340     set reflist {}
9341     refill_reflist
9342 }
9343
9344 proc sel_reflist {w x y} {
9345     global showrefstop reflist headids tagids otherrefids
9346
9347     if {![winfo exists $showrefstop]} return
9348     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9349     set ref [lindex $reflist [expr {$l-1}]]
9350     set n [lindex $ref 0]
9351     switch -- [lindex $ref 1] {
9352         "H" {selbyid $headids($n)}
9353         "T" {selbyid $tagids($n)}
9354         "o" {selbyid $otherrefids($n)}
9355     }
9356     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9357 }
9358
9359 proc unsel_reflist {} {
9360     global showrefstop
9361
9362     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9363     $showrefstop.list tag remove highlight 0.0 end
9364 }
9365
9366 proc reflistfilter_change {n1 n2 op} {
9367     global reflistfilter
9368
9369     after cancel refill_reflist
9370     after 200 refill_reflist
9371 }
9372
9373 proc refill_reflist {} {
9374     global reflist reflistfilter showrefstop headids tagids otherrefids
9375     global curview
9376
9377     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9378     set refs {}
9379     foreach n [array names headids] {
9380         if {[string match $reflistfilter $n]} {
9381             if {[commitinview $headids($n) $curview]} {
9382                 lappend refs [list $n H]
9383             } else {
9384                 interestedin $headids($n) {run refill_reflist}
9385             }
9386         }
9387     }
9388     foreach n [array names tagids] {
9389         if {[string match $reflistfilter $n]} {
9390             if {[commitinview $tagids($n) $curview]} {
9391                 lappend refs [list $n T]
9392             } else {
9393                 interestedin $tagids($n) {run refill_reflist}
9394             }
9395         }
9396     }
9397     foreach n [array names otherrefids] {
9398         if {[string match $reflistfilter $n]} {
9399             if {[commitinview $otherrefids($n) $curview]} {
9400                 lappend refs [list $n o]
9401             } else {
9402                 interestedin $otherrefids($n) {run refill_reflist}
9403             }
9404         }
9405     }
9406     set refs [lsort -index 0 $refs]
9407     if {$refs eq $reflist} return
9408
9409     # Update the contents of $showrefstop.list according to the
9410     # differences between $reflist (old) and $refs (new)
9411     $showrefstop.list conf -state normal
9412     $showrefstop.list insert end "\n"
9413     set i 0
9414     set j 0
9415     while {$i < [llength $reflist] || $j < [llength $refs]} {
9416         if {$i < [llength $reflist]} {
9417             if {$j < [llength $refs]} {
9418                 set cmp [string compare [lindex $reflist $i 0] \
9419                              [lindex $refs $j 0]]
9420                 if {$cmp == 0} {
9421                     set cmp [string compare [lindex $reflist $i 1] \
9422                                  [lindex $refs $j 1]]
9423                 }
9424             } else {
9425                 set cmp -1
9426             }
9427         } else {
9428             set cmp 1
9429         }
9430         switch -- $cmp {
9431             -1 {
9432                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9433                 incr i
9434             }
9435             0 {
9436                 incr i
9437                 incr j
9438             }
9439             1 {
9440                 set l [expr {$j + 1}]
9441                 $showrefstop.list image create $l.0 -align baseline \
9442                     -image reficon-[lindex $refs $j 1] -padx 2
9443                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9444                 incr j
9445             }
9446         }
9447     }
9448     set reflist $refs
9449     # delete last newline
9450     $showrefstop.list delete end-2c end-1c
9451     $showrefstop.list conf -state disabled
9452 }
9453
9454 # Stuff for finding nearby tags
9455 proc getallcommits {} {
9456     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9457     global idheads idtags idotherrefs allparents tagobjid
9458     global gitdir
9459
9460     if {![info exists allcommits]} {
9461         set nextarc 0
9462         set allcommits 0
9463         set seeds {}
9464         set allcwait 0
9465         set cachedarcs 0
9466         set allccache [file join $gitdir "gitk.cache"]
9467         if {![catch {
9468             set f [open $allccache r]
9469             set allcwait 1
9470             getcache $f
9471         }]} return
9472     }
9473
9474     if {$allcwait} {
9475         return
9476     }
9477     set cmd [list | git rev-list --parents]
9478     set allcupdate [expr {$seeds ne {}}]
9479     if {!$allcupdate} {
9480         set ids "--all"
9481     } else {
9482         set refs [concat [array names idheads] [array names idtags] \
9483                       [array names idotherrefs]]
9484         set ids {}
9485         set tagobjs {}
9486         foreach name [array names tagobjid] {
9487             lappend tagobjs $tagobjid($name)
9488         }
9489         foreach id [lsort -unique $refs] {
9490             if {![info exists allparents($id)] &&
9491                 [lsearch -exact $tagobjs $id] < 0} {
9492                 lappend ids $id
9493             }
9494         }
9495         if {$ids ne {}} {
9496             foreach id $seeds {
9497                 lappend ids "^$id"
9498             }
9499         }
9500     }
9501     if {$ids ne {}} {
9502         set fd [open [concat $cmd $ids] r]
9503         fconfigure $fd -blocking 0
9504         incr allcommits
9505         nowbusy allcommits
9506         filerun $fd [list getallclines $fd]
9507     } else {
9508         dispneartags 0
9509     }
9510 }
9511
9512 # Since most commits have 1 parent and 1 child, we group strings of
9513 # such commits into "arcs" joining branch/merge points (BMPs), which
9514 # are commits that either don't have 1 parent or don't have 1 child.
9515 #
9516 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9517 # arcout(id) - outgoing arcs for BMP
9518 # arcids(a) - list of IDs on arc including end but not start
9519 # arcstart(a) - BMP ID at start of arc
9520 # arcend(a) - BMP ID at end of arc
9521 # growing(a) - arc a is still growing
9522 # arctags(a) - IDs out of arcids (excluding end) that have tags
9523 # archeads(a) - IDs out of arcids (excluding end) that have heads
9524 # The start of an arc is at the descendent end, so "incoming" means
9525 # coming from descendents, and "outgoing" means going towards ancestors.
9526
9527 proc getallclines {fd} {
9528     global allparents allchildren idtags idheads nextarc
9529     global arcnos arcids arctags arcout arcend arcstart archeads growing
9530     global seeds allcommits cachedarcs allcupdate
9531
9532     set nid 0
9533     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9534         set id [lindex $line 0]
9535         if {[info exists allparents($id)]} {
9536             # seen it already
9537             continue
9538         }
9539         set cachedarcs 0
9540         set olds [lrange $line 1 end]
9541         set allparents($id) $olds
9542         if {![info exists allchildren($id)]} {
9543             set allchildren($id) {}
9544             set arcnos($id) {}
9545             lappend seeds $id
9546         } else {
9547             set a $arcnos($id)
9548             if {[llength $olds] == 1 && [llength $a] == 1} {
9549                 lappend arcids($a) $id
9550                 if {[info exists idtags($id)]} {
9551                     lappend arctags($a) $id
9552                 }
9553                 if {[info exists idheads($id)]} {
9554                     lappend archeads($a) $id
9555                 }
9556                 if {[info exists allparents($olds)]} {
9557                     # seen parent already
9558                     if {![info exists arcout($olds)]} {
9559                         splitarc $olds
9560                     }
9561                     lappend arcids($a) $olds
9562                     set arcend($a) $olds
9563                     unset growing($a)
9564                 }
9565                 lappend allchildren($olds) $id
9566                 lappend arcnos($olds) $a
9567                 continue
9568             }
9569         }
9570         foreach a $arcnos($id) {
9571             lappend arcids($a) $id
9572             set arcend($a) $id
9573             unset growing($a)
9574         }
9575
9576         set ao {}
9577         foreach p $olds {
9578             lappend allchildren($p) $id
9579             set a [incr nextarc]
9580             set arcstart($a) $id
9581             set archeads($a) {}
9582             set arctags($a) {}
9583             set archeads($a) {}
9584             set arcids($a) {}
9585             lappend ao $a
9586             set growing($a) 1
9587             if {[info exists allparents($p)]} {
9588                 # seen it already, may need to make a new branch
9589                 if {![info exists arcout($p)]} {
9590                     splitarc $p
9591                 }
9592                 lappend arcids($a) $p
9593                 set arcend($a) $p
9594                 unset growing($a)
9595             }
9596             lappend arcnos($p) $a
9597         }
9598         set arcout($id) $ao
9599     }
9600     if {$nid > 0} {
9601         global cached_dheads cached_dtags cached_atags
9602         catch {unset cached_dheads}
9603         catch {unset cached_dtags}
9604         catch {unset cached_atags}
9605     }
9606     if {![eof $fd]} {
9607         return [expr {$nid >= 1000? 2: 1}]
9608     }
9609     set cacheok 1
9610     if {[catch {
9611         fconfigure $fd -blocking 1
9612         close $fd
9613     } err]} {
9614         # got an error reading the list of commits
9615         # if we were updating, try rereading the whole thing again
9616         if {$allcupdate} {
9617             incr allcommits -1
9618             dropcache $err
9619             return
9620         }
9621         error_popup "[mc "Error reading commit topology information;\
9622                 branch and preceding/following tag information\
9623                 will be incomplete."]\n($err)"
9624         set cacheok 0
9625     }
9626     if {[incr allcommits -1] == 0} {
9627         notbusy allcommits
9628         if {$cacheok} {
9629             run savecache
9630         }
9631     }
9632     dispneartags 0
9633     return 0
9634 }
9635
9636 proc recalcarc {a} {
9637     global arctags archeads arcids idtags idheads
9638
9639     set at {}
9640     set ah {}
9641     foreach id [lrange $arcids($a) 0 end-1] {
9642         if {[info exists idtags($id)]} {
9643             lappend at $id
9644         }
9645         if {[info exists idheads($id)]} {
9646             lappend ah $id
9647         }
9648     }
9649     set arctags($a) $at
9650     set archeads($a) $ah
9651 }
9652
9653 proc splitarc {p} {
9654     global arcnos arcids nextarc arctags archeads idtags idheads
9655     global arcstart arcend arcout allparents growing
9656
9657     set a $arcnos($p)
9658     if {[llength $a] != 1} {
9659         puts "oops splitarc called but [llength $a] arcs already"
9660         return
9661     }
9662     set a [lindex $a 0]
9663     set i [lsearch -exact $arcids($a) $p]
9664     if {$i < 0} {
9665         puts "oops splitarc $p not in arc $a"
9666         return
9667     }
9668     set na [incr nextarc]
9669     if {[info exists arcend($a)]} {
9670         set arcend($na) $arcend($a)
9671     } else {
9672         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9673         set j [lsearch -exact $arcnos($l) $a]
9674         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9675     }
9676     set tail [lrange $arcids($a) [expr {$i+1}] end]
9677     set arcids($a) [lrange $arcids($a) 0 $i]
9678     set arcend($a) $p
9679     set arcstart($na) $p
9680     set arcout($p) $na
9681     set arcids($na) $tail
9682     if {[info exists growing($a)]} {
9683         set growing($na) 1
9684         unset growing($a)
9685     }
9686
9687     foreach id $tail {
9688         if {[llength $arcnos($id)] == 1} {
9689             set arcnos($id) $na
9690         } else {
9691             set j [lsearch -exact $arcnos($id) $a]
9692             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9693         }
9694     }
9695
9696     # reconstruct tags and heads lists
9697     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9698         recalcarc $a
9699         recalcarc $na
9700     } else {
9701         set arctags($na) {}
9702         set archeads($na) {}
9703     }
9704 }
9705
9706 # Update things for a new commit added that is a child of one
9707 # existing commit.  Used when cherry-picking.
9708 proc addnewchild {id p} {
9709     global allparents allchildren idtags nextarc
9710     global arcnos arcids arctags arcout arcend arcstart archeads growing
9711     global seeds allcommits
9712
9713     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9714     set allparents($id) [list $p]
9715     set allchildren($id) {}
9716     set arcnos($id) {}
9717     lappend seeds $id
9718     lappend allchildren($p) $id
9719     set a [incr nextarc]
9720     set arcstart($a) $id
9721     set archeads($a) {}
9722     set arctags($a) {}
9723     set arcids($a) [list $p]
9724     set arcend($a) $p
9725     if {![info exists arcout($p)]} {
9726         splitarc $p
9727     }
9728     lappend arcnos($p) $a
9729     set arcout($id) [list $a]
9730 }
9731
9732 # This implements a cache for the topology information.
9733 # The cache saves, for each arc, the start and end of the arc,
9734 # the ids on the arc, and the outgoing arcs from the end.
9735 proc readcache {f} {
9736     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9737     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9738     global allcwait
9739
9740     set a $nextarc
9741     set lim $cachedarcs
9742     if {$lim - $a > 500} {
9743         set lim [expr {$a + 500}]
9744     }
9745     if {[catch {
9746         if {$a == $lim} {
9747             # finish reading the cache and setting up arctags, etc.
9748             set line [gets $f]
9749             if {$line ne "1"} {error "bad final version"}
9750             close $f
9751             foreach id [array names idtags] {
9752                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9753                     [llength $allparents($id)] == 1} {
9754                     set a [lindex $arcnos($id) 0]
9755                     if {$arctags($a) eq {}} {
9756                         recalcarc $a
9757                     }
9758                 }
9759             }
9760             foreach id [array names idheads] {
9761                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9762                     [llength $allparents($id)] == 1} {
9763                     set a [lindex $arcnos($id) 0]
9764                     if {$archeads($a) eq {}} {
9765                         recalcarc $a
9766                     }
9767                 }
9768             }
9769             foreach id [lsort -unique $possible_seeds] {
9770                 if {$arcnos($id) eq {}} {
9771                     lappend seeds $id
9772                 }
9773             }
9774             set allcwait 0
9775         } else {
9776             while {[incr a] <= $lim} {
9777                 set line [gets $f]
9778                 if {[llength $line] != 3} {error "bad line"}
9779                 set s [lindex $line 0]
9780                 set arcstart($a) $s
9781                 lappend arcout($s) $a
9782                 if {![info exists arcnos($s)]} {
9783                     lappend possible_seeds $s
9784                     set arcnos($s) {}
9785                 }
9786                 set e [lindex $line 1]
9787                 if {$e eq {}} {
9788                     set growing($a) 1
9789                 } else {
9790                     set arcend($a) $e
9791                     if {![info exists arcout($e)]} {
9792                         set arcout($e) {}
9793                     }
9794                 }
9795                 set arcids($a) [lindex $line 2]
9796                 foreach id $arcids($a) {
9797                     lappend allparents($s) $id
9798                     set s $id
9799                     lappend arcnos($id) $a
9800                 }
9801                 if {![info exists allparents($s)]} {
9802                     set allparents($s) {}
9803                 }
9804                 set arctags($a) {}
9805                 set archeads($a) {}
9806             }
9807             set nextarc [expr {$a - 1}]
9808         }
9809     } err]} {
9810         dropcache $err
9811         return 0
9812     }
9813     if {!$allcwait} {
9814         getallcommits
9815     }
9816     return $allcwait
9817 }
9818
9819 proc getcache {f} {
9820     global nextarc cachedarcs possible_seeds
9821
9822     if {[catch {
9823         set line [gets $f]
9824         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9825         # make sure it's an integer
9826         set cachedarcs [expr {int([lindex $line 1])}]
9827         if {$cachedarcs < 0} {error "bad number of arcs"}
9828         set nextarc 0
9829         set possible_seeds {}
9830         run readcache $f
9831     } err]} {
9832         dropcache $err
9833     }
9834     return 0
9835 }
9836
9837 proc dropcache {err} {
9838     global allcwait nextarc cachedarcs seeds
9839
9840     #puts "dropping cache ($err)"
9841     foreach v {arcnos arcout arcids arcstart arcend growing \
9842                    arctags archeads allparents allchildren} {
9843         global $v
9844         catch {unset $v}
9845     }
9846     set allcwait 0
9847     set nextarc 0
9848     set cachedarcs 0
9849     set seeds {}
9850     getallcommits
9851 }
9852
9853 proc writecache {f} {
9854     global cachearc cachedarcs allccache
9855     global arcstart arcend arcnos arcids arcout
9856
9857     set a $cachearc
9858     set lim $cachedarcs
9859     if {$lim - $a > 1000} {
9860         set lim [expr {$a + 1000}]
9861     }
9862     if {[catch {
9863         while {[incr a] <= $lim} {
9864             if {[info exists arcend($a)]} {
9865                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9866             } else {
9867                 puts $f [list $arcstart($a) {} $arcids($a)]
9868             }
9869         }
9870     } err]} {
9871         catch {close $f}
9872         catch {file delete $allccache}
9873         #puts "writing cache failed ($err)"
9874         return 0
9875     }
9876     set cachearc [expr {$a - 1}]
9877     if {$a > $cachedarcs} {
9878         puts $f "1"
9879         close $f
9880         return 0
9881     }
9882     return 1
9883 }
9884
9885 proc savecache {} {
9886     global nextarc cachedarcs cachearc allccache
9887
9888     if {$nextarc == $cachedarcs} return
9889     set cachearc 0
9890     set cachedarcs $nextarc
9891     catch {
9892         set f [open $allccache w]
9893         puts $f [list 1 $cachedarcs]
9894         run writecache $f
9895     }
9896 }
9897
9898 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9899 # or 0 if neither is true.
9900 proc anc_or_desc {a b} {
9901     global arcout arcstart arcend arcnos cached_isanc
9902
9903     if {$arcnos($a) eq $arcnos($b)} {
9904         # Both are on the same arc(s); either both are the same BMP,
9905         # or if one is not a BMP, the other is also not a BMP or is
9906         # the BMP at end of the arc (and it only has 1 incoming arc).
9907         # Or both can be BMPs with no incoming arcs.
9908         if {$a eq $b || $arcnos($a) eq {}} {
9909             return 0
9910         }
9911         # assert {[llength $arcnos($a)] == 1}
9912         set arc [lindex $arcnos($a) 0]
9913         set i [lsearch -exact $arcids($arc) $a]
9914         set j [lsearch -exact $arcids($arc) $b]
9915         if {$i < 0 || $i > $j} {
9916             return 1
9917         } else {
9918             return -1
9919         }
9920     }
9921
9922     if {![info exists arcout($a)]} {
9923         set arc [lindex $arcnos($a) 0]
9924         if {[info exists arcend($arc)]} {
9925             set aend $arcend($arc)
9926         } else {
9927             set aend {}
9928         }
9929         set a $arcstart($arc)
9930     } else {
9931         set aend $a
9932     }
9933     if {![info exists arcout($b)]} {
9934         set arc [lindex $arcnos($b) 0]
9935         if {[info exists arcend($arc)]} {
9936             set bend $arcend($arc)
9937         } else {
9938             set bend {}
9939         }
9940         set b $arcstart($arc)
9941     } else {
9942         set bend $b
9943     }
9944     if {$a eq $bend} {
9945         return 1
9946     }
9947     if {$b eq $aend} {
9948         return -1
9949     }
9950     if {[info exists cached_isanc($a,$bend)]} {
9951         if {$cached_isanc($a,$bend)} {
9952             return 1
9953         }
9954     }
9955     if {[info exists cached_isanc($b,$aend)]} {
9956         if {$cached_isanc($b,$aend)} {
9957             return -1
9958         }
9959         if {[info exists cached_isanc($a,$bend)]} {
9960             return 0
9961         }
9962     }
9963
9964     set todo [list $a $b]
9965     set anc($a) a
9966     set anc($b) b
9967     for {set i 0} {$i < [llength $todo]} {incr i} {
9968         set x [lindex $todo $i]
9969         if {$anc($x) eq {}} {
9970             continue
9971         }
9972         foreach arc $arcnos($x) {
9973             set xd $arcstart($arc)
9974             if {$xd eq $bend} {
9975                 set cached_isanc($a,$bend) 1
9976                 set cached_isanc($b,$aend) 0
9977                 return 1
9978             } elseif {$xd eq $aend} {
9979                 set cached_isanc($b,$aend) 1
9980                 set cached_isanc($a,$bend) 0
9981                 return -1
9982             }
9983             if {![info exists anc($xd)]} {
9984                 set anc($xd) $anc($x)
9985                 lappend todo $xd
9986             } elseif {$anc($xd) ne $anc($x)} {
9987                 set anc($xd) {}
9988             }
9989         }
9990     }
9991     set cached_isanc($a,$bend) 0
9992     set cached_isanc($b,$aend) 0
9993     return 0
9994 }
9995
9996 # This identifies whether $desc has an ancestor that is
9997 # a growing tip of the graph and which is not an ancestor of $anc
9998 # and returns 0 if so and 1 if not.
9999 # If we subsequently discover a tag on such a growing tip, and that
10000 # turns out to be a descendent of $anc (which it could, since we
10001 # don't necessarily see children before parents), then $desc
10002 # isn't a good choice to display as a descendent tag of
10003 # $anc (since it is the descendent of another tag which is
10004 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10005 # display as a ancestor tag of $desc.
10006 #
10007 proc is_certain {desc anc} {
10008     global arcnos arcout arcstart arcend growing problems
10009
10010     set certain {}
10011     if {[llength $arcnos($anc)] == 1} {
10012         # tags on the same arc are certain
10013         if {$arcnos($desc) eq $arcnos($anc)} {
10014             return 1
10015         }
10016         if {![info exists arcout($anc)]} {
10017             # if $anc is partway along an arc, use the start of the arc instead
10018             set a [lindex $arcnos($anc) 0]
10019             set anc $arcstart($a)
10020         }
10021     }
10022     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10023         set x $desc
10024     } else {
10025         set a [lindex $arcnos($desc) 0]
10026         set x $arcend($a)
10027     }
10028     if {$x == $anc} {
10029         return 1
10030     }
10031     set anclist [list $x]
10032     set dl($x) 1
10033     set nnh 1
10034     set ngrowanc 0
10035     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10036         set x [lindex $anclist $i]
10037         if {$dl($x)} {
10038             incr nnh -1
10039         }
10040         set done($x) 1
10041         foreach a $arcout($x) {
10042             if {[info exists growing($a)]} {
10043                 if {![info exists growanc($x)] && $dl($x)} {
10044                     set growanc($x) 1
10045                     incr ngrowanc
10046                 }
10047             } else {
10048                 set y $arcend($a)
10049                 if {[info exists dl($y)]} {
10050                     if {$dl($y)} {
10051                         if {!$dl($x)} {
10052                             set dl($y) 0
10053                             if {![info exists done($y)]} {
10054                                 incr nnh -1
10055                             }
10056                             if {[info exists growanc($x)]} {
10057                                 incr ngrowanc -1
10058                             }
10059                             set xl [list $y]
10060                             for {set k 0} {$k < [llength $xl]} {incr k} {
10061                                 set z [lindex $xl $k]
10062                                 foreach c $arcout($z) {
10063                                     if {[info exists arcend($c)]} {
10064                                         set v $arcend($c)
10065                                         if {[info exists dl($v)] && $dl($v)} {
10066                                             set dl($v) 0
10067                                             if {![info exists done($v)]} {
10068                                                 incr nnh -1
10069                                             }
10070                                             if {[info exists growanc($v)]} {
10071                                                 incr ngrowanc -1
10072                                             }
10073                                             lappend xl $v
10074                                         }
10075                                     }
10076                                 }
10077                             }
10078                         }
10079                     }
10080                 } elseif {$y eq $anc || !$dl($x)} {
10081                     set dl($y) 0
10082                     lappend anclist $y
10083                 } else {
10084                     set dl($y) 1
10085                     lappend anclist $y
10086                     incr nnh
10087                 }
10088             }
10089         }
10090     }
10091     foreach x [array names growanc] {
10092         if {$dl($x)} {
10093             return 0
10094         }
10095         return 0
10096     }
10097     return 1
10098 }
10099
10100 proc validate_arctags {a} {
10101     global arctags idtags
10102
10103     set i -1
10104     set na $arctags($a)
10105     foreach id $arctags($a) {
10106         incr i
10107         if {![info exists idtags($id)]} {
10108             set na [lreplace $na $i $i]
10109             incr i -1
10110         }
10111     }
10112     set arctags($a) $na
10113 }
10114
10115 proc validate_archeads {a} {
10116     global archeads idheads
10117
10118     set i -1
10119     set na $archeads($a)
10120     foreach id $archeads($a) {
10121         incr i
10122         if {![info exists idheads($id)]} {
10123             set na [lreplace $na $i $i]
10124             incr i -1
10125         }
10126     }
10127     set archeads($a) $na
10128 }
10129
10130 # Return the list of IDs that have tags that are descendents of id,
10131 # ignoring IDs that are descendents of IDs already reported.
10132 proc desctags {id} {
10133     global arcnos arcstart arcids arctags idtags allparents
10134     global growing cached_dtags
10135
10136     if {![info exists allparents($id)]} {
10137         return {}
10138     }
10139     set t1 [clock clicks -milliseconds]
10140     set argid $id
10141     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10142         # part-way along an arc; check that arc first
10143         set a [lindex $arcnos($id) 0]
10144         if {$arctags($a) ne {}} {
10145             validate_arctags $a
10146             set i [lsearch -exact $arcids($a) $id]
10147             set tid {}
10148             foreach t $arctags($a) {
10149                 set j [lsearch -exact $arcids($a) $t]
10150                 if {$j >= $i} break
10151                 set tid $t
10152             }
10153             if {$tid ne {}} {
10154                 return $tid
10155             }
10156         }
10157         set id $arcstart($a)
10158         if {[info exists idtags($id)]} {
10159             return $id
10160         }
10161     }
10162     if {[info exists cached_dtags($id)]} {
10163         return $cached_dtags($id)
10164     }
10165
10166     set origid $id
10167     set todo [list $id]
10168     set queued($id) 1
10169     set nc 1
10170     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10171         set id [lindex $todo $i]
10172         set done($id) 1
10173         set ta [info exists hastaggedancestor($id)]
10174         if {!$ta} {
10175             incr nc -1
10176         }
10177         # ignore tags on starting node
10178         if {!$ta && $i > 0} {
10179             if {[info exists idtags($id)]} {
10180                 set tagloc($id) $id
10181                 set ta 1
10182             } elseif {[info exists cached_dtags($id)]} {
10183                 set tagloc($id) $cached_dtags($id)
10184                 set ta 1
10185             }
10186         }
10187         foreach a $arcnos($id) {
10188             set d $arcstart($a)
10189             if {!$ta && $arctags($a) ne {}} {
10190                 validate_arctags $a
10191                 if {$arctags($a) ne {}} {
10192                     lappend tagloc($id) [lindex $arctags($a) end]
10193                 }
10194             }
10195             if {$ta || $arctags($a) ne {}} {
10196                 set tomark [list $d]
10197                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10198                     set dd [lindex $tomark $j]
10199                     if {![info exists hastaggedancestor($dd)]} {
10200                         if {[info exists done($dd)]} {
10201                             foreach b $arcnos($dd) {
10202                                 lappend tomark $arcstart($b)
10203                             }
10204                             if {[info exists tagloc($dd)]} {
10205                                 unset tagloc($dd)
10206                             }
10207                         } elseif {[info exists queued($dd)]} {
10208                             incr nc -1
10209                         }
10210                         set hastaggedancestor($dd) 1
10211                     }
10212                 }
10213             }
10214             if {![info exists queued($d)]} {
10215                 lappend todo $d
10216                 set queued($d) 1
10217                 if {![info exists hastaggedancestor($d)]} {
10218                     incr nc
10219                 }
10220             }
10221         }
10222     }
10223     set tags {}
10224     foreach id [array names tagloc] {
10225         if {![info exists hastaggedancestor($id)]} {
10226             foreach t $tagloc($id) {
10227                 if {[lsearch -exact $tags $t] < 0} {
10228                     lappend tags $t
10229                 }
10230             }
10231         }
10232     }
10233     set t2 [clock clicks -milliseconds]
10234     set loopix $i
10235
10236     # remove tags that are descendents of other tags
10237     for {set i 0} {$i < [llength $tags]} {incr i} {
10238         set a [lindex $tags $i]
10239         for {set j 0} {$j < $i} {incr j} {
10240             set b [lindex $tags $j]
10241             set r [anc_or_desc $a $b]
10242             if {$r == 1} {
10243                 set tags [lreplace $tags $j $j]
10244                 incr j -1
10245                 incr i -1
10246             } elseif {$r == -1} {
10247                 set tags [lreplace $tags $i $i]
10248                 incr i -1
10249                 break
10250             }
10251         }
10252     }
10253
10254     if {[array names growing] ne {}} {
10255         # graph isn't finished, need to check if any tag could get
10256         # eclipsed by another tag coming later.  Simply ignore any
10257         # tags that could later get eclipsed.
10258         set ctags {}
10259         foreach t $tags {
10260             if {[is_certain $t $origid]} {
10261                 lappend ctags $t
10262             }
10263         }
10264         if {$tags eq $ctags} {
10265             set cached_dtags($origid) $tags
10266         } else {
10267             set tags $ctags
10268         }
10269     } else {
10270         set cached_dtags($origid) $tags
10271     }
10272     set t3 [clock clicks -milliseconds]
10273     if {0 && $t3 - $t1 >= 100} {
10274         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10275             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10276     }
10277     return $tags
10278 }
10279
10280 proc anctags {id} {
10281     global arcnos arcids arcout arcend arctags idtags allparents
10282     global growing cached_atags
10283
10284     if {![info exists allparents($id)]} {
10285         return {}
10286     }
10287     set t1 [clock clicks -milliseconds]
10288     set argid $id
10289     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10290         # part-way along an arc; check that arc first
10291         set a [lindex $arcnos($id) 0]
10292         if {$arctags($a) ne {}} {
10293             validate_arctags $a
10294             set i [lsearch -exact $arcids($a) $id]
10295             foreach t $arctags($a) {
10296                 set j [lsearch -exact $arcids($a) $t]
10297                 if {$j > $i} {
10298                     return $t
10299                 }
10300             }
10301         }
10302         if {![info exists arcend($a)]} {
10303             return {}
10304         }
10305         set id $arcend($a)
10306         if {[info exists idtags($id)]} {
10307             return $id
10308         }
10309     }
10310     if {[info exists cached_atags($id)]} {
10311         return $cached_atags($id)
10312     }
10313
10314     set origid $id
10315     set todo [list $id]
10316     set queued($id) 1
10317     set taglist {}
10318     set nc 1
10319     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10320         set id [lindex $todo $i]
10321         set done($id) 1
10322         set td [info exists hastaggeddescendent($id)]
10323         if {!$td} {
10324             incr nc -1
10325         }
10326         # ignore tags on starting node
10327         if {!$td && $i > 0} {
10328             if {[info exists idtags($id)]} {
10329                 set tagloc($id) $id
10330                 set td 1
10331             } elseif {[info exists cached_atags($id)]} {
10332                 set tagloc($id) $cached_atags($id)
10333                 set td 1
10334             }
10335         }
10336         foreach a $arcout($id) {
10337             if {!$td && $arctags($a) ne {}} {
10338                 validate_arctags $a
10339                 if {$arctags($a) ne {}} {
10340                     lappend tagloc($id) [lindex $arctags($a) 0]
10341                 }
10342             }
10343             if {![info exists arcend($a)]} continue
10344             set d $arcend($a)
10345             if {$td || $arctags($a) ne {}} {
10346                 set tomark [list $d]
10347                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10348                     set dd [lindex $tomark $j]
10349                     if {![info exists hastaggeddescendent($dd)]} {
10350                         if {[info exists done($dd)]} {
10351                             foreach b $arcout($dd) {
10352                                 if {[info exists arcend($b)]} {
10353                                     lappend tomark $arcend($b)
10354                                 }
10355                             }
10356                             if {[info exists tagloc($dd)]} {
10357                                 unset tagloc($dd)
10358                             }
10359                         } elseif {[info exists queued($dd)]} {
10360                             incr nc -1
10361                         }
10362                         set hastaggeddescendent($dd) 1
10363                     }
10364                 }
10365             }
10366             if {![info exists queued($d)]} {
10367                 lappend todo $d
10368                 set queued($d) 1
10369                 if {![info exists hastaggeddescendent($d)]} {
10370                     incr nc
10371                 }
10372             }
10373         }
10374     }
10375     set t2 [clock clicks -milliseconds]
10376     set loopix $i
10377     set tags {}
10378     foreach id [array names tagloc] {
10379         if {![info exists hastaggeddescendent($id)]} {
10380             foreach t $tagloc($id) {
10381                 if {[lsearch -exact $tags $t] < 0} {
10382                     lappend tags $t
10383                 }
10384             }
10385         }
10386     }
10387
10388     # remove tags that are ancestors of other tags
10389     for {set i 0} {$i < [llength $tags]} {incr i} {
10390         set a [lindex $tags $i]
10391         for {set j 0} {$j < $i} {incr j} {
10392             set b [lindex $tags $j]
10393             set r [anc_or_desc $a $b]
10394             if {$r == -1} {
10395                 set tags [lreplace $tags $j $j]
10396                 incr j -1
10397                 incr i -1
10398             } elseif {$r == 1} {
10399                 set tags [lreplace $tags $i $i]
10400                 incr i -1
10401                 break
10402             }
10403         }
10404     }
10405
10406     if {[array names growing] ne {}} {
10407         # graph isn't finished, need to check if any tag could get
10408         # eclipsed by another tag coming later.  Simply ignore any
10409         # tags that could later get eclipsed.
10410         set ctags {}
10411         foreach t $tags {
10412             if {[is_certain $origid $t]} {
10413                 lappend ctags $t
10414             }
10415         }
10416         if {$tags eq $ctags} {
10417             set cached_atags($origid) $tags
10418         } else {
10419             set tags $ctags
10420         }
10421     } else {
10422         set cached_atags($origid) $tags
10423     }
10424     set t3 [clock clicks -milliseconds]
10425     if {0 && $t3 - $t1 >= 100} {
10426         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10427             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10428     }
10429     return $tags
10430 }
10431
10432 # Return the list of IDs that have heads that are descendents of id,
10433 # including id itself if it has a head.
10434 proc descheads {id} {
10435     global arcnos arcstart arcids archeads idheads cached_dheads
10436     global allparents
10437
10438     if {![info exists allparents($id)]} {
10439         return {}
10440     }
10441     set aret {}
10442     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10443         # part-way along an arc; check it first
10444         set a [lindex $arcnos($id) 0]
10445         if {$archeads($a) ne {}} {
10446             validate_archeads $a
10447             set i [lsearch -exact $arcids($a) $id]
10448             foreach t $archeads($a) {
10449                 set j [lsearch -exact $arcids($a) $t]
10450                 if {$j > $i} break
10451                 lappend aret $t
10452             }
10453         }
10454         set id $arcstart($a)
10455     }
10456     set origid $id
10457     set todo [list $id]
10458     set seen($id) 1
10459     set ret {}
10460     for {set i 0} {$i < [llength $todo]} {incr i} {
10461         set id [lindex $todo $i]
10462         if {[info exists cached_dheads($id)]} {
10463             set ret [concat $ret $cached_dheads($id)]
10464         } else {
10465             if {[info exists idheads($id)]} {
10466                 lappend ret $id
10467             }
10468             foreach a $arcnos($id) {
10469                 if {$archeads($a) ne {}} {
10470                     validate_archeads $a
10471                     if {$archeads($a) ne {}} {
10472                         set ret [concat $ret $archeads($a)]
10473                     }
10474                 }
10475                 set d $arcstart($a)
10476                 if {![info exists seen($d)]} {
10477                     lappend todo $d
10478                     set seen($d) 1
10479                 }
10480             }
10481         }
10482     }
10483     set ret [lsort -unique $ret]
10484     set cached_dheads($origid) $ret
10485     return [concat $ret $aret]
10486 }
10487
10488 proc addedtag {id} {
10489     global arcnos arcout cached_dtags cached_atags
10490
10491     if {![info exists arcnos($id)]} return
10492     if {![info exists arcout($id)]} {
10493         recalcarc [lindex $arcnos($id) 0]
10494     }
10495     catch {unset cached_dtags}
10496     catch {unset cached_atags}
10497 }
10498
10499 proc addedhead {hid head} {
10500     global arcnos arcout cached_dheads
10501
10502     if {![info exists arcnos($hid)]} return
10503     if {![info exists arcout($hid)]} {
10504         recalcarc [lindex $arcnos($hid) 0]
10505     }
10506     catch {unset cached_dheads}
10507 }
10508
10509 proc removedhead {hid head} {
10510     global cached_dheads
10511
10512     catch {unset cached_dheads}
10513 }
10514
10515 proc movedhead {hid head} {
10516     global arcnos arcout cached_dheads
10517
10518     if {![info exists arcnos($hid)]} return
10519     if {![info exists arcout($hid)]} {
10520         recalcarc [lindex $arcnos($hid) 0]
10521     }
10522     catch {unset cached_dheads}
10523 }
10524
10525 proc changedrefs {} {
10526     global cached_dheads cached_dtags cached_atags
10527     global arctags archeads arcnos arcout idheads idtags
10528
10529     foreach id [concat [array names idheads] [array names idtags]] {
10530         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10531             set a [lindex $arcnos($id) 0]
10532             if {![info exists donearc($a)]} {
10533                 recalcarc $a
10534                 set donearc($a) 1
10535             }
10536         }
10537     }
10538     catch {unset cached_dtags}
10539     catch {unset cached_atags}
10540     catch {unset cached_dheads}
10541 }
10542
10543 proc rereadrefs {} {
10544     global idtags idheads idotherrefs mainheadid
10545
10546     set refids [concat [array names idtags] \
10547                     [array names idheads] [array names idotherrefs]]
10548     foreach id $refids {
10549         if {![info exists ref($id)]} {
10550             set ref($id) [listrefs $id]
10551         }
10552     }
10553     set oldmainhead $mainheadid
10554     readrefs
10555     changedrefs
10556     set refids [lsort -unique [concat $refids [array names idtags] \
10557                         [array names idheads] [array names idotherrefs]]]
10558     foreach id $refids {
10559         set v [listrefs $id]
10560         if {![info exists ref($id)] || $ref($id) != $v} {
10561             redrawtags $id
10562         }
10563     }
10564     if {$oldmainhead ne $mainheadid} {
10565         redrawtags $oldmainhead
10566         redrawtags $mainheadid
10567     }
10568     run refill_reflist
10569 }
10570
10571 proc listrefs {id} {
10572     global idtags idheads idotherrefs
10573
10574     set x {}
10575     if {[info exists idtags($id)]} {
10576         set x $idtags($id)
10577     }
10578     set y {}
10579     if {[info exists idheads($id)]} {
10580         set y $idheads($id)
10581     }
10582     set z {}
10583     if {[info exists idotherrefs($id)]} {
10584         set z $idotherrefs($id)
10585     }
10586     return [list $x $y $z]
10587 }
10588
10589 proc showtag {tag isnew} {
10590     global ctext tagcontents tagids linknum tagobjid
10591
10592     if {$isnew} {
10593         addtohistory [list showtag $tag 0] savectextpos
10594     }
10595     $ctext conf -state normal
10596     clear_ctext
10597     settabs 0
10598     set linknum 0
10599     if {![info exists tagcontents($tag)]} {
10600         catch {
10601            set tagcontents($tag) [exec git cat-file tag $tag]
10602         }
10603     }
10604     if {[info exists tagcontents($tag)]} {
10605         set text $tagcontents($tag)
10606     } else {
10607         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10608     }
10609     appendwithlinks $text {}
10610     maybe_scroll_ctext 1
10611     $ctext conf -state disabled
10612     init_flist {}
10613 }
10614
10615 proc doquit {} {
10616     global stopped
10617     global gitktmpdir
10618
10619     set stopped 100
10620     savestuff .
10621     destroy .
10622
10623     if {[info exists gitktmpdir]} {
10624         catch {file delete -force $gitktmpdir}
10625     }
10626 }
10627
10628 proc mkfontdisp {font top which} {
10629     global fontattr fontpref $font NS use_ttk
10630
10631     set fontpref($font) [set $font]
10632     ${NS}::button $top.${font}but -text $which \
10633         -command [list choosefont $font $which]
10634     ${NS}::label $top.$font -relief flat -font $font \
10635         -text $fontattr($font,family) -justify left
10636     grid x $top.${font}but $top.$font -sticky w
10637 }
10638
10639 proc choosefont {font which} {
10640     global fontparam fontlist fonttop fontattr
10641     global prefstop NS
10642
10643     set fontparam(which) $which
10644     set fontparam(font) $font
10645     set fontparam(family) [font actual $font -family]
10646     set fontparam(size) $fontattr($font,size)
10647     set fontparam(weight) $fontattr($font,weight)
10648     set fontparam(slant) $fontattr($font,slant)
10649     set top .gitkfont
10650     set fonttop $top
10651     if {![winfo exists $top]} {
10652         font create sample
10653         eval font config sample [font actual $font]
10654         ttk_toplevel $top
10655         make_transient $top $prefstop
10656         wm title $top [mc "Gitk font chooser"]
10657         ${NS}::label $top.l -textvariable fontparam(which)
10658         pack $top.l -side top
10659         set fontlist [lsort [font families]]
10660         ${NS}::frame $top.f
10661         listbox $top.f.fam -listvariable fontlist \
10662             -yscrollcommand [list $top.f.sb set]
10663         bind $top.f.fam <<ListboxSelect>> selfontfam
10664         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10665         pack $top.f.sb -side right -fill y
10666         pack $top.f.fam -side left -fill both -expand 1
10667         pack $top.f -side top -fill both -expand 1
10668         ${NS}::frame $top.g
10669         spinbox $top.g.size -from 4 -to 40 -width 4 \
10670             -textvariable fontparam(size) \
10671             -validatecommand {string is integer -strict %s}
10672         checkbutton $top.g.bold -padx 5 \
10673             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10674             -variable fontparam(weight) -onvalue bold -offvalue normal
10675         checkbutton $top.g.ital -padx 5 \
10676             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10677             -variable fontparam(slant) -onvalue italic -offvalue roman
10678         pack $top.g.size $top.g.bold $top.g.ital -side left
10679         pack $top.g -side top
10680         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10681             -background white
10682         $top.c create text 100 25 -anchor center -text $which -font sample \
10683             -fill black -tags text
10684         bind $top.c <Configure> [list centertext $top.c]
10685         pack $top.c -side top -fill x
10686         ${NS}::frame $top.buts
10687         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10688         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10689         bind $top <Key-Return> fontok
10690         bind $top <Key-Escape> fontcan
10691         grid $top.buts.ok $top.buts.can
10692         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10693         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10694         pack $top.buts -side bottom -fill x
10695         trace add variable fontparam write chg_fontparam
10696     } else {
10697         raise $top
10698         $top.c itemconf text -text $which
10699     }
10700     set i [lsearch -exact $fontlist $fontparam(family)]
10701     if {$i >= 0} {
10702         $top.f.fam selection set $i
10703         $top.f.fam see $i
10704     }
10705 }
10706
10707 proc centertext {w} {
10708     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10709 }
10710
10711 proc fontok {} {
10712     global fontparam fontpref prefstop
10713
10714     set f $fontparam(font)
10715     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10716     if {$fontparam(weight) eq "bold"} {
10717         lappend fontpref($f) "bold"
10718     }
10719     if {$fontparam(slant) eq "italic"} {
10720         lappend fontpref($f) "italic"
10721     }
10722     set w $prefstop.$f
10723     $w conf -text $fontparam(family) -font $fontpref($f)
10724
10725     fontcan
10726 }
10727
10728 proc fontcan {} {
10729     global fonttop fontparam
10730
10731     if {[info exists fonttop]} {
10732         catch {destroy $fonttop}
10733         catch {font delete sample}
10734         unset fonttop
10735         unset fontparam
10736     }
10737 }
10738
10739 if {[package vsatisfies [package provide Tk] 8.6]} {
10740     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10741     # function to make use of it.
10742     proc choosefont {font which} {
10743         tk fontchooser configure -title $which -font $font \
10744             -command [list on_choosefont $font $which]
10745         tk fontchooser show
10746     }
10747     proc on_choosefont {font which newfont} {
10748         global fontparam
10749         puts stderr "$font $newfont"
10750         array set f [font actual $newfont]
10751         set fontparam(which) $which
10752         set fontparam(font) $font
10753         set fontparam(family) $f(-family)
10754         set fontparam(size) $f(-size)
10755         set fontparam(weight) $f(-weight)
10756         set fontparam(slant) $f(-slant)
10757         fontok
10758     }
10759 }
10760
10761 proc selfontfam {} {
10762     global fonttop fontparam
10763
10764     set i [$fonttop.f.fam curselection]
10765     if {$i ne {}} {
10766         set fontparam(family) [$fonttop.f.fam get $i]
10767     }
10768 }
10769
10770 proc chg_fontparam {v sub op} {
10771     global fontparam
10772
10773     font config sample -$sub $fontparam($sub)
10774 }
10775
10776 proc doprefs {} {
10777     global maxwidth maxgraphpct use_ttk NS
10778     global oldprefs prefstop showneartags showlocalchanges
10779     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10780     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10781     global hideremotes want_ttk have_ttk
10782
10783     set top .gitkprefs
10784     set prefstop $top
10785     if {[winfo exists $top]} {
10786         raise $top
10787         return
10788     }
10789     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10790                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10791         set oldprefs($v) [set $v]
10792     }
10793     ttk_toplevel $top
10794     wm title $top [mc "Gitk preferences"]
10795     make_transient $top .
10796     ${NS}::label $top.ldisp -text [mc "Commit list display options"]
10797     grid $top.ldisp - -sticky w -pady 10
10798     ${NS}::label $top.spacer -text " "
10799     ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
10800     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10801     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10802     ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
10803     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10804     grid x $top.maxpctl $top.maxpct -sticky w
10805     ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10806         -variable showlocalchanges
10807     grid x $top.showlocal -sticky w
10808     ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1 (length)"] \
10809         -variable autoselect
10810     spinbox $top.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10811     grid x $top.autoselect $top.autosellen -sticky w
10812     ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10813         -variable hideremotes
10814     grid x $top.hideremotes -sticky w
10815
10816     ${NS}::label $top.ddisp -text [mc "Diff display options"]
10817     grid $top.ddisp - -sticky w -pady 10
10818     ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
10819     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10820     grid x $top.tabstopl $top.tabstop -sticky w
10821     ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10822         -variable showneartags
10823     grid x $top.ntag -sticky w
10824     ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10825         -variable limitdiffs
10826     grid x $top.ldiff -sticky w
10827     ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10828         -variable perfile_attrs
10829     grid x $top.lattr -sticky w
10830
10831     ${NS}::entry $top.extdifft -textvariable extdifftool
10832     ${NS}::frame $top.extdifff
10833     ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10834     ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10835     pack $top.extdifff.l $top.extdifff.b -side left
10836     pack configure $top.extdifff.l -padx 10
10837     grid x $top.extdifff $top.extdifft -sticky ew
10838
10839     ${NS}::label $top.lgen -text [mc "General options"]
10840     grid $top.lgen - -sticky w -pady 10
10841     ${NS}::checkbutton $top.want_ttk -variable want_ttk \
10842         -text [mc "Use themed widgets"]
10843     if {$have_ttk} {
10844         ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
10845     } else {
10846         ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
10847     }
10848     grid x $top.want_ttk $top.ttk_note -sticky w
10849
10850     ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
10851     grid $top.cdisp - -sticky w -pady 10
10852     label $top.ui -padx 40 -relief sunk -background $uicolor
10853     ${NS}::button $top.uibut -text [mc "Interface"] \
10854        -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
10855     grid x $top.uibut $top.ui -sticky w
10856     label $top.bg -padx 40 -relief sunk -background $bgcolor
10857     ${NS}::button $top.bgbut -text [mc "Background"] \
10858         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10859     grid x $top.bgbut $top.bg -sticky w
10860     label $top.fg -padx 40 -relief sunk -background $fgcolor
10861     ${NS}::button $top.fgbut -text [mc "Foreground"] \
10862         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10863     grid x $top.fgbut $top.fg -sticky w
10864     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10865     ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
10866         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10867                       [list $ctext tag conf d0 -foreground]]
10868     grid x $top.diffoldbut $top.diffold -sticky w
10869     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10870     ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
10871         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10872                       [list $ctext tag conf dresult -foreground]]
10873     grid x $top.diffnewbut $top.diffnew -sticky w
10874     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10875     ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
10876         -command [list choosecolor diffcolors 2 $top.hunksep \
10877                       [mc "diff hunk header"] \
10878                       [list $ctext tag conf hunksep -foreground]]
10879     grid x $top.hunksepbut $top.hunksep -sticky w
10880     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10881     ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
10882         -command [list choosecolor markbgcolor {} $top.markbgsep \
10883                       [mc "marked line background"] \
10884                       [list $ctext tag conf omark -background]]
10885     grid x $top.markbgbut $top.markbgsep -sticky w
10886     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10887     ${NS}::button $top.selbgbut -text [mc "Select bg"] \
10888         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10889     grid x $top.selbgbut $top.selbgsep -sticky w
10890
10891     ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
10892     grid $top.cfont - -sticky w -pady 10
10893     mkfontdisp mainfont $top [mc "Main font"]
10894     mkfontdisp textfont $top [mc "Diff display font"]
10895     mkfontdisp uifont $top [mc "User interface font"]
10896
10897     ${NS}::frame $top.buts
10898     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10899     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10900     bind $top <Key-Return> prefsok
10901     bind $top <Key-Escape> prefscan
10902     grid $top.buts.ok $top.buts.can
10903     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10904     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10905     grid $top.buts - - -pady 10 -sticky ew
10906     grid columnconfigure $top 2 -weight 1
10907     bind $top <Visibility> "focus $top.buts.ok"
10908 }
10909
10910 proc choose_extdiff {} {
10911     global extdifftool
10912
10913     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10914     if {$prog ne {}} {
10915         set extdifftool $prog
10916     }
10917 }
10918
10919 proc choosecolor {v vi w x cmd} {
10920     global $v
10921
10922     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10923                -title [mc "Gitk: choose color for %s" $x]]
10924     if {$c eq {}} return
10925     $w conf -background $c
10926     lset $v $vi $c
10927     eval $cmd $c
10928 }
10929
10930 proc setselbg {c} {
10931     global bglist cflist
10932     foreach w $bglist {
10933         $w configure -selectbackground $c
10934     }
10935     $cflist tag configure highlight \
10936         -background [$cflist cget -selectbackground]
10937     allcanvs itemconf secsel -fill $c
10938 }
10939
10940 # This sets the background color and the color scheme for the whole UI.
10941 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
10942 # if we don't specify one ourselves, which makes the checkbuttons and
10943 # radiobuttons look bad.  This chooses white for selectColor if the
10944 # background color is light, or black if it is dark.
10945 proc setui {c} {
10946     if {[tk windowingsystem] eq "win32"} { return }
10947     set bg [winfo rgb . $c]
10948     set selc black
10949     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
10950         set selc white
10951     }
10952     tk_setPalette background $c selectColor $selc
10953 }
10954
10955 proc setbg {c} {
10956     global bglist
10957
10958     foreach w $bglist {
10959         $w conf -background $c
10960     }
10961 }
10962
10963 proc setfg {c} {
10964     global fglist canv
10965
10966     foreach w $fglist {
10967         $w conf -foreground $c
10968     }
10969     allcanvs itemconf text -fill $c
10970     $canv itemconf circle -outline $c
10971     $canv itemconf markid -outline $c
10972 }
10973
10974 proc prefscan {} {
10975     global oldprefs prefstop
10976
10977     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10978                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10979         global $v
10980         set $v $oldprefs($v)
10981     }
10982     catch {destroy $prefstop}
10983     unset prefstop
10984     fontcan
10985 }
10986
10987 proc prefsok {} {
10988     global maxwidth maxgraphpct
10989     global oldprefs prefstop showneartags showlocalchanges
10990     global fontpref mainfont textfont uifont
10991     global limitdiffs treediffs perfile_attrs
10992     global hideremotes
10993
10994     catch {destroy $prefstop}
10995     unset prefstop
10996     fontcan
10997     set fontchanged 0
10998     if {$mainfont ne $fontpref(mainfont)} {
10999         set mainfont $fontpref(mainfont)
11000         parsefont mainfont $mainfont
11001         eval font configure mainfont [fontflags mainfont]
11002         eval font configure mainfontbold [fontflags mainfont 1]
11003         setcoords
11004         set fontchanged 1
11005     }
11006     if {$textfont ne $fontpref(textfont)} {
11007         set textfont $fontpref(textfont)
11008         parsefont textfont $textfont
11009         eval font configure textfont [fontflags textfont]
11010         eval font configure textfontbold [fontflags textfont 1]
11011     }
11012     if {$uifont ne $fontpref(uifont)} {
11013         set uifont $fontpref(uifont)
11014         parsefont uifont $uifont
11015         eval font configure uifont [fontflags uifont]
11016     }
11017     settabs
11018     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11019         if {$showlocalchanges} {
11020             doshowlocalchanges
11021         } else {
11022             dohidelocalchanges
11023         }
11024     }
11025     if {$limitdiffs != $oldprefs(limitdiffs) ||
11026         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11027         # treediffs elements are limited by path;
11028         # won't have encodings cached if perfile_attrs was just turned on
11029         catch {unset treediffs}
11030     }
11031     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11032         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11033         redisplay
11034     } elseif {$showneartags != $oldprefs(showneartags) ||
11035           $limitdiffs != $oldprefs(limitdiffs)} {
11036         reselectline
11037     }
11038     if {$hideremotes != $oldprefs(hideremotes)} {
11039         rereadrefs
11040     }
11041 }
11042
11043 proc formatdate {d} {
11044     global datetimeformat
11045     if {$d ne {}} {
11046         set d [clock format [lindex $d 0] -format $datetimeformat]
11047     }
11048     return $d
11049 }
11050
11051 # This list of encoding names and aliases is distilled from
11052 # http://www.iana.org/assignments/character-sets.
11053 # Not all of them are supported by Tcl.
11054 set encoding_aliases {
11055     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11056       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11057     { ISO-10646-UTF-1 csISO10646UTF1 }
11058     { ISO_646.basic:1983 ref csISO646basic1983 }
11059     { INVARIANT csINVARIANT }
11060     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11061     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11062     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11063     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11064     { NATS-DANO iso-ir-9-1 csNATSDANO }
11065     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11066     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11067     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11068     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11069     { ISO-2022-KR csISO2022KR }
11070     { EUC-KR csEUCKR }
11071     { ISO-2022-JP csISO2022JP }
11072     { ISO-2022-JP-2 csISO2022JP2 }
11073     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11074       csISO13JISC6220jp }
11075     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11076     { IT iso-ir-15 ISO646-IT csISO15Italian }
11077     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11078     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11079     { greek7-old iso-ir-18 csISO18Greek7Old }
11080     { latin-greek iso-ir-19 csISO19LatinGreek }
11081     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11082     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11083     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11084     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11085     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11086     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11087     { INIS iso-ir-49 csISO49INIS }
11088     { INIS-8 iso-ir-50 csISO50INIS8 }
11089     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11090     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11091     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11092     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11093     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11094     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11095       csISO60Norwegian1 }
11096     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11097     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11098     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11099     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11100     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11101     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11102     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11103     { greek7 iso-ir-88 csISO88Greek7 }
11104     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11105     { iso-ir-90 csISO90 }
11106     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11107     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11108       csISO92JISC62991984b }
11109     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11110     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11111     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11112       csISO95JIS62291984handadd }
11113     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11114     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11115     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11116     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11117       CP819 csISOLatin1 }
11118     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11119     { T.61-7bit iso-ir-102 csISO102T617bit }
11120     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11121     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11122     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11123     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11124     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11125     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11126     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11127     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11128       arabic csISOLatinArabic }
11129     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11130     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11131     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11132       greek greek8 csISOLatinGreek }
11133     { T.101-G2 iso-ir-128 csISO128T101G2 }
11134     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11135       csISOLatinHebrew }
11136     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11137     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11138     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11139     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11140     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11141     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11142     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11143       csISOLatinCyrillic }
11144     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11145     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11146     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11147     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11148     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11149     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11150     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11151     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11152     { ISO_10367-box iso-ir-155 csISO10367Box }
11153     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11154     { latin-lap lap iso-ir-158 csISO158Lap }
11155     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11156     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11157     { us-dk csUSDK }
11158     { dk-us csDKUS }
11159     { JIS_X0201 X0201 csHalfWidthKatakana }
11160     { KSC5636 ISO646-KR csKSC5636 }
11161     { ISO-10646-UCS-2 csUnicode }
11162     { ISO-10646-UCS-4 csUCS4 }
11163     { DEC-MCS dec csDECMCS }
11164     { hp-roman8 roman8 r8 csHPRoman8 }
11165     { macintosh mac csMacintosh }
11166     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11167       csIBM037 }
11168     { IBM038 EBCDIC-INT cp038 csIBM038 }
11169     { IBM273 CP273 csIBM273 }
11170     { IBM274 EBCDIC-BE CP274 csIBM274 }
11171     { IBM275 EBCDIC-BR cp275 csIBM275 }
11172     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11173     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11174     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11175     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11176     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11177     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11178     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11179     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11180     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11181     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11182     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11183     { IBM437 cp437 437 csPC8CodePage437 }
11184     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11185     { IBM775 cp775 csPC775Baltic }
11186     { IBM850 cp850 850 csPC850Multilingual }
11187     { IBM851 cp851 851 csIBM851 }
11188     { IBM852 cp852 852 csPCp852 }
11189     { IBM855 cp855 855 csIBM855 }
11190     { IBM857 cp857 857 csIBM857 }
11191     { IBM860 cp860 860 csIBM860 }
11192     { IBM861 cp861 861 cp-is csIBM861 }
11193     { IBM862 cp862 862 csPC862LatinHebrew }
11194     { IBM863 cp863 863 csIBM863 }
11195     { IBM864 cp864 csIBM864 }
11196     { IBM865 cp865 865 csIBM865 }
11197     { IBM866 cp866 866 csIBM866 }
11198     { IBM868 CP868 cp-ar csIBM868 }
11199     { IBM869 cp869 869 cp-gr csIBM869 }
11200     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11201     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11202     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11203     { IBM891 cp891 csIBM891 }
11204     { IBM903 cp903 csIBM903 }
11205     { IBM904 cp904 904 csIBBM904 }
11206     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11207     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11208     { IBM1026 CP1026 csIBM1026 }
11209     { EBCDIC-AT-DE csIBMEBCDICATDE }
11210     { EBCDIC-AT-DE-A csEBCDICATDEA }
11211     { EBCDIC-CA-FR csEBCDICCAFR }
11212     { EBCDIC-DK-NO csEBCDICDKNO }
11213     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11214     { EBCDIC-FI-SE csEBCDICFISE }
11215     { EBCDIC-FI-SE-A csEBCDICFISEA }
11216     { EBCDIC-FR csEBCDICFR }
11217     { EBCDIC-IT csEBCDICIT }
11218     { EBCDIC-PT csEBCDICPT }
11219     { EBCDIC-ES csEBCDICES }
11220     { EBCDIC-ES-A csEBCDICESA }
11221     { EBCDIC-ES-S csEBCDICESS }
11222     { EBCDIC-UK csEBCDICUK }
11223     { EBCDIC-US csEBCDICUS }
11224     { UNKNOWN-8BIT csUnknown8BiT }
11225     { MNEMONIC csMnemonic }
11226     { MNEM csMnem }
11227     { VISCII csVISCII }
11228     { VIQR csVIQR }
11229     { KOI8-R csKOI8R }
11230     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11231     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11232     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11233     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11234     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11235     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11236     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11237     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11238     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11239     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11240     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11241     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11242     { IBM1047 IBM-1047 }
11243     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11244     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11245     { UNICODE-1-1 csUnicode11 }
11246     { CESU-8 csCESU-8 }
11247     { BOCU-1 csBOCU-1 }
11248     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11249     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11250       l8 }
11251     { ISO-8859-15 ISO_8859-15 Latin-9 }
11252     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11253     { GBK CP936 MS936 windows-936 }
11254     { JIS_Encoding csJISEncoding }
11255     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11256     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11257       EUC-JP }
11258     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11259     { ISO-10646-UCS-Basic csUnicodeASCII }
11260     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11261     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11262     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11263     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11264     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11265     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11266     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11267     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11268     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11269     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11270     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11271     { Ventura-US csVenturaUS }
11272     { Ventura-International csVenturaInternational }
11273     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11274     { PC8-Turkish csPC8Turkish }
11275     { IBM-Symbols csIBMSymbols }
11276     { IBM-Thai csIBMThai }
11277     { HP-Legal csHPLegal }
11278     { HP-Pi-font csHPPiFont }
11279     { HP-Math8 csHPMath8 }
11280     { Adobe-Symbol-Encoding csHPPSMath }
11281     { HP-DeskTop csHPDesktop }
11282     { Ventura-Math csVenturaMath }
11283     { Microsoft-Publishing csMicrosoftPublishing }
11284     { Windows-31J csWindows31J }
11285     { GB2312 csGB2312 }
11286     { Big5 csBig5 }
11287 }
11288
11289 proc tcl_encoding {enc} {
11290     global encoding_aliases tcl_encoding_cache
11291     if {[info exists tcl_encoding_cache($enc)]} {
11292         return $tcl_encoding_cache($enc)
11293     }
11294     set names [encoding names]
11295     set lcnames [string tolower $names]
11296     set enc [string tolower $enc]
11297     set i [lsearch -exact $lcnames $enc]
11298     if {$i < 0} {
11299         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11300         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11301             set i [lsearch -exact $lcnames $encx]
11302         }
11303     }
11304     if {$i < 0} {
11305         foreach l $encoding_aliases {
11306             set ll [string tolower $l]
11307             if {[lsearch -exact $ll $enc] < 0} continue
11308             # look through the aliases for one that tcl knows about
11309             foreach e $ll {
11310                 set i [lsearch -exact $lcnames $e]
11311                 if {$i < 0} {
11312                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11313                         set i [lsearch -exact $lcnames $ex]
11314                     }
11315                 }
11316                 if {$i >= 0} break
11317             }
11318             break
11319         }
11320     }
11321     set tclenc {}
11322     if {$i >= 0} {
11323         set tclenc [lindex $names $i]
11324     }
11325     set tcl_encoding_cache($enc) $tclenc
11326     return $tclenc
11327 }
11328
11329 proc gitattr {path attr default} {
11330     global path_attr_cache
11331     if {[info exists path_attr_cache($attr,$path)]} {
11332         set r $path_attr_cache($attr,$path)
11333     } else {
11334         set r "unspecified"
11335         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11336             regexp "(.*): $attr: (.*)" $line m f r
11337         }
11338         set path_attr_cache($attr,$path) $r
11339     }
11340     if {$r eq "unspecified"} {
11341         return $default
11342     }
11343     return $r
11344 }
11345
11346 proc cache_gitattr {attr pathlist} {
11347     global path_attr_cache
11348     set newlist {}
11349     foreach path $pathlist {
11350         if {![info exists path_attr_cache($attr,$path)]} {
11351             lappend newlist $path
11352         }
11353     }
11354     set lim 1000
11355     if {[tk windowingsystem] == "win32"} {
11356         # windows has a 32k limit on the arguments to a command...
11357         set lim 30
11358     }
11359     while {$newlist ne {}} {
11360         set head [lrange $newlist 0 [expr {$lim - 1}]]
11361         set newlist [lrange $newlist $lim end]
11362         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11363             foreach row [split $rlist "\n"] {
11364                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11365                     if {[string index $path 0] eq "\""} {
11366                         set path [encoding convertfrom [lindex $path 0]]
11367                     }
11368                     set path_attr_cache($attr,$path) $value
11369                 }
11370             }
11371         }
11372     }
11373 }
11374
11375 proc get_path_encoding {path} {
11376     global gui_encoding perfile_attrs
11377     set tcl_enc $gui_encoding
11378     if {$path ne {} && $perfile_attrs} {
11379         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11380         if {$enc2 ne {}} {
11381             set tcl_enc $enc2
11382         }
11383     }
11384     return $tcl_enc
11385 }
11386
11387 # First check that Tcl/Tk is recent enough
11388 if {[catch {package require Tk 8.4} err]} {
11389     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11390                      Gitk requires at least Tcl/Tk 8.4." list
11391     exit 1
11392 }
11393
11394 # defaults...
11395 set wrcomcmd "git diff-tree --stdin -p --pretty"
11396
11397 set gitencoding {}
11398 catch {
11399     set gitencoding [exec git config --get i18n.commitencoding]
11400 }
11401 catch {
11402     set gitencoding [exec git config --get i18n.logoutputencoding]
11403 }
11404 if {$gitencoding == ""} {
11405     set gitencoding "utf-8"
11406 }
11407 set tclencoding [tcl_encoding $gitencoding]
11408 if {$tclencoding == {}} {
11409     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11410 }
11411
11412 set gui_encoding [encoding system]
11413 catch {
11414     set enc [exec git config --get gui.encoding]
11415     if {$enc ne {}} {
11416         set tclenc [tcl_encoding $enc]
11417         if {$tclenc ne {}} {
11418             set gui_encoding $tclenc
11419         } else {
11420             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11421         }
11422     }
11423 }
11424
11425 if {[tk windowingsystem] eq "aqua"} {
11426     set mainfont {{Lucida Grande} 9}
11427     set textfont {Monaco 9}
11428     set uifont {{Lucida Grande} 9 bold}
11429 } else {
11430     set mainfont {Helvetica 9}
11431     set textfont {Courier 9}
11432     set uifont {Helvetica 9 bold}
11433 }
11434 set tabstop 8
11435 set findmergefiles 0
11436 set maxgraphpct 50
11437 set maxwidth 16
11438 set revlistorder 0
11439 set fastdate 0
11440 set uparrowlen 5
11441 set downarrowlen 5
11442 set mingaplen 100
11443 set cmitmode "patch"
11444 set wrapcomment "none"
11445 set showneartags 1
11446 set hideremotes 0
11447 set maxrefs 20
11448 set maxlinelen 200
11449 set showlocalchanges 1
11450 set limitdiffs 1
11451 set datetimeformat "%Y-%m-%d %H:%M:%S"
11452 set autoselect 1
11453 set autosellen 40
11454 set perfile_attrs 0
11455 set want_ttk 1
11456
11457 if {[tk windowingsystem] eq "aqua"} {
11458     set extdifftool "opendiff"
11459 } else {
11460     set extdifftool "meld"
11461 }
11462
11463 set colors {green red blue magenta darkgrey brown orange}
11464 if {[tk windowingsystem] eq "win32"} {
11465     set uicolor SystemButtonFace
11466     set bgcolor SystemWindow
11467     set fgcolor SystemButtonText
11468     set selectbgcolor SystemHighlight
11469 } else {
11470     set uicolor grey85
11471     set bgcolor white
11472     set fgcolor black
11473     set selectbgcolor gray85
11474 }
11475 set diffcolors {red "#00a000" blue}
11476 set diffcontext 3
11477 set ignorespace 0
11478 set worddiff ""
11479 set markbgcolor "#e0e0ff"
11480
11481 set circlecolors {white blue gray blue blue}
11482
11483 # button for popping up context menus
11484 if {[tk windowingsystem] eq "aqua"} {
11485     set ctxbut <Button-2>
11486 } else {
11487     set ctxbut <Button-3>
11488 }
11489
11490 ## For msgcat loading, first locate the installation location.
11491 if { [info exists ::env(GITK_MSGSDIR)] } {
11492     ## Msgsdir was manually set in the environment.
11493     set gitk_msgsdir $::env(GITK_MSGSDIR)
11494 } else {
11495     ## Let's guess the prefix from argv0.
11496     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11497     set gitk_libdir [file join $gitk_prefix share gitk lib]
11498     set gitk_msgsdir [file join $gitk_libdir msgs]
11499     unset gitk_prefix
11500 }
11501
11502 ## Internationalization (i18n) through msgcat and gettext. See
11503 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11504 package require msgcat
11505 namespace import ::msgcat::mc
11506 ## And eventually load the actual message catalog
11507 ::msgcat::mcload $gitk_msgsdir
11508
11509 catch {source ~/.gitk}
11510
11511 parsefont mainfont $mainfont
11512 eval font create mainfont [fontflags mainfont]
11513 eval font create mainfontbold [fontflags mainfont 1]
11514
11515 parsefont textfont $textfont
11516 eval font create textfont [fontflags textfont]
11517 eval font create textfontbold [fontflags textfont 1]
11518
11519 parsefont uifont $uifont
11520 eval font create uifont [fontflags uifont]
11521
11522 setui $uicolor
11523
11524 setoptions
11525
11526 # check that we can find a .git directory somewhere...
11527 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11528     show_error {} . [mc "Cannot find a git repository here."]
11529     exit 1
11530 }
11531
11532 set selecthead {}
11533 set selectheadid {}
11534
11535 set revtreeargs {}
11536 set cmdline_files {}
11537 set i 0
11538 set revtreeargscmd {}
11539 foreach arg $argv {
11540     switch -glob -- $arg {
11541         "" { }
11542         "--" {
11543             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11544             break
11545         }
11546         "--select-commit=*" {
11547             set selecthead [string range $arg 16 end]
11548         }
11549         "--argscmd=*" {
11550             set revtreeargscmd [string range $arg 10 end]
11551         }
11552         default {
11553             lappend revtreeargs $arg
11554         }
11555     }
11556     incr i
11557 }
11558
11559 if {$selecthead eq "HEAD"} {
11560     set selecthead {}
11561 }
11562
11563 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11564     # no -- on command line, but some arguments (other than --argscmd)
11565     if {[catch {
11566         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11567         set cmdline_files [split $f "\n"]
11568         set n [llength $cmdline_files]
11569         set revtreeargs [lrange $revtreeargs 0 end-$n]
11570         # Unfortunately git rev-parse doesn't produce an error when
11571         # something is both a revision and a filename.  To be consistent
11572         # with git log and git rev-list, check revtreeargs for filenames.
11573         foreach arg $revtreeargs {
11574             if {[file exists $arg]} {
11575                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11576                                  and filename" $arg]
11577                 exit 1
11578             }
11579         }
11580     } err]} {
11581         # unfortunately we get both stdout and stderr in $err,
11582         # so look for "fatal:".
11583         set i [string first "fatal:" $err]
11584         if {$i > 0} {
11585             set err [string range $err [expr {$i + 6}] end]
11586         }
11587         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11588         exit 1
11589     }
11590 }
11591
11592 set nullid "0000000000000000000000000000000000000000"
11593 set nullid2 "0000000000000000000000000000000000000001"
11594 set nullfile "/dev/null"
11595
11596 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11597 if {![info exists have_ttk]} {
11598     set have_ttk [llength [info commands ::ttk::style]]
11599 }
11600 set use_ttk [expr {$have_ttk && $want_ttk}]
11601 set NS [expr {$use_ttk ? "ttk" : ""}]
11602
11603 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11604
11605 set show_notes {}
11606 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11607     set show_notes "--show-notes"
11608 }
11609
11610 set runq {}
11611 set history {}
11612 set historyindex 0
11613 set fh_serial 0
11614 set nhl_names {}
11615 set highlight_paths {}
11616 set findpattern {}
11617 set searchdirn -forwards
11618 set boldids {}
11619 set boldnameids {}
11620 set diffelide {0 0}
11621 set markingmatches 0
11622 set linkentercount 0
11623 set need_redisplay 0
11624 set nrows_drawn 0
11625 set firsttabstop 0
11626
11627 set nextviewnum 1
11628 set curview 0
11629 set selectedview 0
11630 set selectedhlview [mc "None"]
11631 set highlight_related [mc "None"]
11632 set highlight_files {}
11633 set viewfiles(0) {}
11634 set viewperm(0) 0
11635 set viewargs(0) {}
11636 set viewargscmd(0) {}
11637
11638 set selectedline {}
11639 set numcommits 0
11640 set loginstance 0
11641 set cmdlineok 0
11642 set stopped 0
11643 set stuffsaved 0
11644 set patchnum 0
11645 set lserial 0
11646 set hasworktree [hasworktree]
11647 set cdup {}
11648 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11649     set cdup [exec git rev-parse --show-cdup]
11650 }
11651 set worktree [exec git rev-parse --show-toplevel]
11652 setcoords
11653 makewindow
11654 catch {
11655     image create photo gitlogo      -width 16 -height 16
11656
11657     image create photo gitlogominus -width  4 -height  2
11658     gitlogominus put #C00000 -to 0 0 4 2
11659     gitlogo copy gitlogominus -to  1 5
11660     gitlogo copy gitlogominus -to  6 5
11661     gitlogo copy gitlogominus -to 11 5
11662     image delete gitlogominus
11663
11664     image create photo gitlogoplus  -width  4 -height  4
11665     gitlogoplus  put #008000 -to 1 0 3 4
11666     gitlogoplus  put #008000 -to 0 1 4 3
11667     gitlogo copy gitlogoplus  -to  1 9
11668     gitlogo copy gitlogoplus  -to  6 9
11669     gitlogo copy gitlogoplus  -to 11 9
11670     image delete gitlogoplus
11671
11672     image create photo gitlogo32    -width 32 -height 32
11673     gitlogo32 copy gitlogo -zoom 2 2
11674
11675     wm iconphoto . -default gitlogo gitlogo32
11676 }
11677 # wait for the window to become visible
11678 tkwait visibility .
11679 wm title . "[file tail $argv0]: [file tail [pwd]]"
11680 update
11681 readrefs
11682
11683 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11684     # create a view for the files/dirs specified on the command line
11685     set curview 1
11686     set selectedview 1
11687     set nextviewnum 2
11688     set viewname(1) [mc "Command line"]
11689     set viewfiles(1) $cmdline_files
11690     set viewargs(1) $revtreeargs
11691     set viewargscmd(1) $revtreeargscmd
11692     set viewperm(1) 0
11693     set vdatemode(1) 0
11694     addviewmenu 1
11695     .bar.view entryconf [mca "Edit view..."] -state normal
11696     .bar.view entryconf [mca "Delete view"] -state normal
11697 }
11698
11699 if {[info exists permviews]} {
11700     foreach v $permviews {
11701         set n $nextviewnum
11702         incr nextviewnum
11703         set viewname($n) [lindex $v 0]
11704         set viewfiles($n) [lindex $v 1]
11705         set viewargs($n) [lindex $v 2]
11706         set viewargscmd($n) [lindex $v 3]
11707         set viewperm($n) 1
11708         addviewmenu $n
11709     }
11710 }
11711
11712 if {[tk windowingsystem] eq "win32"} {
11713     focus -force .
11714 }
11715
11716 getcommits {}
11717
11718 # Local variables:
11719 # mode: tcl
11720 # indent-tabs-mode: t
11721 # tab-width: 8
11722 # End: