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 gitdir {} {
  13     global env
  14     if {[info exists env(GIT_DIR)]} {
  15         return $env(GIT_DIR)
  16     } else {
  17         return [exec git rev-parse --git-dir]
  18     }
  19 }
  20
  21 # A simple scheduler for compute-intensive stuff.
  22 # The aim is to make sure that event handlers for GUI actions can
  23 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  24 # run before X event handlers, so reading from a fast source can
  25 # make the GUI completely unresponsive.
  26 proc run args {
  27     global isonrunq runq currunq
  28
  29     set script $args
  30     if {[info exists isonrunq($script)]} return
  31     if {$runq eq {} && ![info exists currunq]} {
  32         after idle dorunq
  33     }
  34     lappend runq [list {} $script]
  35     set isonrunq($script) 1
  36 }
  37
  38 proc filerun {fd script} {
  39     fileevent $fd readable [list filereadable $fd $script]
  40 }
  41
  42 proc filereadable {fd script} {
  43     global runq currunq
  44
  45     fileevent $fd readable {}
  46     if {$runq eq {} && ![info exists currunq]} {
  47         after idle dorunq
  48     }
  49     lappend runq [list $fd $script]
  50 }
  51
  52 proc nukefile {fd} {
  53     global runq
  54
  55     for {set i 0} {$i < [llength $runq]} {} {
  56         if {[lindex $runq $i 0] eq $fd} {
  57             set runq [lreplace $runq $i $i]
  58         } else {
  59             incr i
  60         }
  61     }
  62 }
  63
  64 proc dorunq {} {
  65     global isonrunq runq currunq
  66
  67     set tstart [clock clicks -milliseconds]
  68     set t0 $tstart
  69     while {[llength $runq] > 0} {
  70         set fd [lindex $runq 0 0]
  71         set script [lindex $runq 0 1]
  72         set currunq [lindex $runq 0]
  73         set runq [lrange $runq 1 end]
  74         set repeat [eval $script]
  75         unset currunq
  76         set t1 [clock clicks -milliseconds]
  77         set t [expr {$t1 - $t0}]
  78         if {$repeat ne {} && $repeat} {
  79             if {$fd eq {} || $repeat == 2} {
  80                 # script returns 1 if it wants to be readded
  81                 # file readers return 2 if they could do more straight away
  82                 lappend runq [list $fd $script]
  83             } else {
  84                 fileevent $fd readable [list filereadable $fd $script]
  85             }
  86         } elseif {$fd eq {}} {
  87             unset isonrunq($script)
  88         }
  89         set t0 $t1
  90         if {$t1 - $tstart >= 80} break
  91     }
  92     if {$runq ne {}} {
  93         after idle dorunq
  94     }
  95 }
  96
  97 proc reg_instance {fd} {
  98     global commfd leftover loginstance
  99
 100     set i [incr loginstance]
 101     set commfd($i) $fd
 102     set leftover($i) {}
 103     return $i
 104 }
 105
 106 proc unmerged_files {files} {
 107     global nr_unmerged
 108
 109     # find the list of unmerged files
 110     set mlist {}
 111     set nr_unmerged 0
 112     if {[catch {
 113         set fd [open "| git ls-files -u" r]
 114     } err]} {
 115         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 116         exit 1
 117     }
 118     while {[gets $fd line] >= 0} {
 119         set i [string first "\t" $line]
 120         if {$i < 0} continue
 121         set fname [string range $line [expr {$i+1}] end]
 122         if {[lsearch -exact $mlist $fname] >= 0} continue
 123         incr nr_unmerged
 124         if {$files eq {} || [path_filter $files $fname]} {
 125             lappend mlist $fname
 126         }
 127     }
 128     catch {close $fd}
 129     return $mlist
 130 }
 131
 132 proc parseviewargs {n arglist} {
 133     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 134     global worddiff git_version
 135
 136     set vdatemode($n) 0
 137     set vmergeonly($n) 0
 138     set glflags {}
 139     set diffargs {}
 140     set nextisval 0
 141     set revargs {}
 142     set origargs $arglist
 143     set allknown 1
 144     set filtered 0
 145     set i -1
 146     foreach arg $arglist {
 147         incr i
 148         if {$nextisval} {
 149             lappend glflags $arg
 150             set nextisval 0
 151             continue
 152         }
 153         switch -glob -- $arg {
 154             "-d" -
 155             "--date-order" {
 156                 set vdatemode($n) 1
 157                 # remove from origargs in case we hit an unknown option
 158                 set origargs [lreplace $origargs $i $i]
 159                 incr i -1
 160             }
 161             "-[puabwcrRBMC]" -
 162             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 163             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 164             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 165             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 166             "--ignore-space-change" - "-U*" - "--unified=*" {
 167                 # These request or affect diff output, which we don't want.
 168                 # Some could be used to set our defaults for diff display.
 169                 lappend diffargs $arg
 170             }
 171             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 172             "--name-only" - "--name-status" - "--color" -
 173             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 174             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 175             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 176             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 177             "--objects" - "--objects-edge" - "--reverse" {
 178                 # These cause our parsing of git log's output to fail, or else
 179                 # they're options we want to set ourselves, so ignore them.
 180             }
 181             "--color-words*" - "--word-diff=color" {
 182                 # These trigger a word diff in the console interface,
 183                 # so help the user by enabling our own support
 184                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 185                     set worddiff [mc "Color words"]
 186                 }
 187             }
 188             "--word-diff*" {
 189                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 190                     set worddiff [mc "Markup words"]
 191                 }
 192             }
 193             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 194             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 195             "--full-history" - "--dense" - "--sparse" -
 196             "--follow" - "--left-right" - "--encoding=*" {
 197                 # These are harmless, and some are even useful
 198                 lappend glflags $arg
 199             }
 200             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 201             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 202             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 203             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 204             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 205             "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
 206             "--simplify-by-decoration" {
 207                 # These mean that we get a subset of the commits
 208                 set filtered 1
 209                 lappend glflags $arg
 210             }
 211             "-n" {
 212                 # This appears to be the only one that has a value as a
 213                 # separate word following it
 214                 set filtered 1
 215                 set nextisval 1
 216                 lappend glflags $arg
 217             }
 218             "--not" - "--all" {
 219                 lappend revargs $arg
 220             }
 221             "--merge" {
 222                 set vmergeonly($n) 1
 223                 # git rev-parse doesn't understand --merge
 224                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 225             }
 226             "--no-replace-objects" {
 227                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 228             }
 229             "-*" {
 230                 # Other flag arguments including -<n>
 231                 if {[string is digit -strict [string range $arg 1 end]]} {
 232                     set filtered 1
 233                 } else {
 234                     # a flag argument that we don't recognize;
 235                     # that means we can't optimize
 236                     set allknown 0
 237                 }
 238                 lappend glflags $arg
 239             }
 240             default {
 241                 # Non-flag arguments specify commits or ranges of commits
 242                 if {[string match "*...*" $arg]} {
 243                     lappend revargs --gitk-symmetric-diff-marker
 244                 }
 245                 lappend revargs $arg
 246             }
 247         }
 248     }
 249     set vdflags($n) $diffargs
 250     set vflags($n) $glflags
 251     set vrevs($n) $revargs
 252     set vfiltered($n) $filtered
 253     set vorigargs($n) $origargs
 254     return $allknown
 255 }
 256
 257 proc parseviewrevs {view revs} {
 258     global vposids vnegids
 259
 260     if {$revs eq {}} {
 261         set revs HEAD
 262     }
 263     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 264         # we get stdout followed by stderr in $err
 265         # for an unknown rev, git rev-parse echoes it and then errors out
 266         set errlines [split $err "\n"]
 267         set badrev {}
 268         for {set l 0} {$l < [llength $errlines]} {incr l} {
 269             set line [lindex $errlines $l]
 270             if {!([string length $line] == 40 && [string is xdigit $line])} {
 271                 if {[string match "fatal:*" $line]} {
 272                     if {[string match "fatal: ambiguous argument*" $line]
 273                         && $badrev ne {}} {
 274                         if {[llength $badrev] == 1} {
 275                             set err "unknown revision $badrev"
 276                         } else {
 277                             set err "unknown revisions: [join $badrev ", "]"
 278                         }
 279                     } else {
 280                         set err [join [lrange $errlines $l end] "\n"]
 281                     }
 282                     break
 283                 }
 284                 lappend badrev $line
 285             }
 286         }
 287         error_popup "[mc "Error parsing revisions:"] $err"
 288         return {}
 289     }
 290     set ret {}
 291     set pos {}
 292     set neg {}
 293     set sdm 0
 294     foreach id [split $ids "\n"] {
 295         if {$id eq "--gitk-symmetric-diff-marker"} {
 296             set sdm 4
 297         } elseif {[string match "^*" $id]} {
 298             if {$sdm != 1} {
 299                 lappend ret $id
 300                 if {$sdm == 3} {
 301                     set sdm 0
 302                 }
 303             }
 304             lappend neg [string range $id 1 end]
 305         } else {
 306             if {$sdm != 2} {
 307                 lappend ret $id
 308             } else {
 309                 lset ret end $id...[lindex $ret end]
 310             }
 311             lappend pos $id
 312         }
 313         incr sdm -1
 314     }
 315     set vposids($view) $pos
 316     set vnegids($view) $neg
 317     return $ret
 318 }
 319
 320 # Start off a git log process and arrange to read its output
 321 proc start_rev_list {view} {
 322     global startmsecs commitidx viewcomplete curview
 323     global tclencoding
 324     global viewargs viewargscmd viewfiles vfilelimit
 325     global showlocalchanges
 326     global viewactive viewinstances vmergeonly
 327     global mainheadid viewmainheadid viewmainheadid_orig
 328     global vcanopt vflags vrevs vorigargs
 329     global show_notes
 330
 331     set startmsecs [clock clicks -milliseconds]
 332     set commitidx($view) 0
 333     # these are set this way for the error exits
 334     set viewcomplete($view) 1
 335     set viewactive($view) 0
 336     varcinit $view
 337
 338     set args $viewargs($view)
 339     if {$viewargscmd($view) ne {}} {
 340         if {[catch {
 341             set str [exec sh -c $viewargscmd($view)]
 342         } err]} {
 343             error_popup "[mc "Error executing --argscmd command:"] $err"
 344             return 0
 345         }
 346         set args [concat $args [split $str "\n"]]
 347     }
 348     set vcanopt($view) [parseviewargs $view $args]
 349
 350     set files $viewfiles($view)
 351     if {$vmergeonly($view)} {
 352         set files [unmerged_files $files]
 353         if {$files eq {}} {
 354             global nr_unmerged
 355             if {$nr_unmerged == 0} {
 356                 error_popup [mc "No files selected: --merge specified but\
 357                              no files are unmerged."]
 358             } else {
 359                 error_popup [mc "No files selected: --merge specified but\
 360                              no unmerged files are within file limit."]
 361             }
 362             return 0
 363         }
 364     }
 365     set vfilelimit($view) $files
 366
 367     if {$vcanopt($view)} {
 368         set revs [parseviewrevs $view $vrevs($view)]
 369         if {$revs eq {}} {
 370             return 0
 371         }
 372         set args [concat $vflags($view) $revs]
 373     } else {
 374         set args $vorigargs($view)
 375     }
 376
 377     if {[catch {
 378         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 379                         --parents --boundary $args "--" $files] r]
 380     } err]} {
 381         error_popup "[mc "Error executing git log:"] $err"
 382         return 0
 383     }
 384     set i [reg_instance $fd]
 385     set viewinstances($view) [list $i]
 386     set viewmainheadid($view) $mainheadid
 387     set viewmainheadid_orig($view) $mainheadid
 388     if {$files ne {} && $mainheadid ne {}} {
 389         get_viewmainhead $view
 390     }
 391     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 392         interestedin $viewmainheadid($view) dodiffindex
 393     }
 394     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 395     if {$tclencoding != {}} {
 396         fconfigure $fd -encoding $tclencoding
 397     }
 398     filerun $fd [list getcommitlines $fd $i $view 0]
 399     nowbusy $view [mc "Reading"]
 400     set viewcomplete($view) 0
 401     set viewactive($view) 1
 402     return 1
 403 }
 404
 405 proc stop_instance {inst} {
 406     global commfd leftover
 407
 408     set fd $commfd($inst)
 409     catch {
 410         set pid [pid $fd]
 411
 412         if {$::tcl_platform(platform) eq {windows}} {
 413             exec kill -f $pid
 414         } else {
 415             exec kill $pid
 416         }
 417     }
 418     catch {close $fd}
 419     nukefile $fd
 420     unset commfd($inst)
 421     unset leftover($inst)
 422 }
 423
 424 proc stop_backends {} {
 425     global commfd
 426
 427     foreach inst [array names commfd] {
 428         stop_instance $inst
 429     }
 430 }
 431
 432 proc stop_rev_list {view} {
 433     global viewinstances
 434
 435     foreach inst $viewinstances($view) {
 436         stop_instance $inst
 437     }
 438     set viewinstances($view) {}
 439 }
 440
 441 proc reset_pending_select {selid} {
 442     global pending_select mainheadid selectheadid
 443
 444     if {$selid ne {}} {
 445         set pending_select $selid
 446     } elseif {$selectheadid ne {}} {
 447         set pending_select $selectheadid
 448     } else {
 449         set pending_select $mainheadid
 450     }
 451 }
 452
 453 proc getcommits {selid} {
 454     global canv curview need_redisplay viewactive
 455
 456     initlayout
 457     if {[start_rev_list $curview]} {
 458         reset_pending_select $selid
 459         show_status [mc "Reading commits..."]
 460         set need_redisplay 1
 461     } else {
 462         show_status [mc "No commits selected"]
 463     }
 464 }
 465
 466 proc updatecommits {} {
 467     global curview vcanopt vorigargs vfilelimit viewinstances
 468     global viewactive viewcomplete tclencoding
 469     global startmsecs showneartags showlocalchanges
 470     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 471     global isworktree
 472     global varcid vposids vnegids vflags vrevs
 473     global show_notes
 474
 475     set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
 476     rereadrefs
 477     set view $curview
 478     if {$mainheadid ne $viewmainheadid_orig($view)} {
 479         if {$showlocalchanges} {
 480             dohidelocalchanges
 481         }
 482         set viewmainheadid($view) $mainheadid
 483         set viewmainheadid_orig($view) $mainheadid
 484         if {$vfilelimit($view) ne {}} {
 485             get_viewmainhead $view
 486         }
 487     }
 488     if {$showlocalchanges} {
 489         doshowlocalchanges
 490     }
 491     if {$vcanopt($view)} {
 492         set oldpos $vposids($view)
 493         set oldneg $vnegids($view)
 494         set revs [parseviewrevs $view $vrevs($view)]
 495         if {$revs eq {}} {
 496             return
 497         }
 498         # note: getting the delta when negative refs change is hard,
 499         # and could require multiple git log invocations, so in that
 500         # case we ask git log for all the commits (not just the delta)
 501         if {$oldneg eq $vnegids($view)} {
 502             set newrevs {}
 503             set npos 0
 504             # take out positive refs that we asked for before or
 505             # that we have already seen
 506             foreach rev $revs {
 507                 if {[string length $rev] == 40} {
 508                     if {[lsearch -exact $oldpos $rev] < 0
 509                         && ![info exists varcid($view,$rev)]} {
 510                         lappend newrevs $rev
 511                         incr npos
 512                     }
 513                 } else {
 514                     lappend $newrevs $rev
 515                 }
 516             }
 517             if {$npos == 0} return
 518             set revs $newrevs
 519             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 520         }
 521         set args [concat $vflags($view) $revs --not $oldpos]
 522     } else {
 523         set args $vorigargs($view)
 524     }
 525     if {[catch {
 526         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 527                         --parents --boundary $args "--" $vfilelimit($view)] r]
 528     } err]} {
 529         error_popup "[mc "Error executing git log:"] $err"
 530         return
 531     }
 532     if {$viewactive($view) == 0} {
 533         set startmsecs [clock clicks -milliseconds]
 534     }
 535     set i [reg_instance $fd]
 536     lappend viewinstances($view) $i
 537     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 538     if {$tclencoding != {}} {
 539         fconfigure $fd -encoding $tclencoding
 540     }
 541     filerun $fd [list getcommitlines $fd $i $view 1]
 542     incr viewactive($view)
 543     set viewcomplete($view) 0
 544     reset_pending_select {}
 545     nowbusy $view [mc "Reading"]
 546     if {$showneartags} {
 547         getallcommits
 548     }
 549 }
 550
 551 proc reloadcommits {} {
 552     global curview viewcomplete selectedline currentid thickerline
 553     global showneartags treediffs commitinterest cached_commitrow
 554     global targetid
 555
 556     set selid {}
 557     if {$selectedline ne {}} {
 558         set selid $currentid
 559     }
 560
 561     if {!$viewcomplete($curview)} {
 562         stop_rev_list $curview
 563     }
 564     resetvarcs $curview
 565     set selectedline {}
 566     catch {unset currentid}
 567     catch {unset thickerline}
 568     catch {unset treediffs}
 569     readrefs
 570     changedrefs
 571     if {$showneartags} {
 572         getallcommits
 573     }
 574     clear_display
 575     catch {unset commitinterest}
 576     catch {unset cached_commitrow}
 577     catch {unset targetid}
 578     setcanvscroll
 579     getcommits $selid
 580     return 0
 581 }
 582
 583 # This makes a string representation of a positive integer which
 584 # sorts as a string in numerical order
 585 proc strrep {n} {
 586     if {$n < 16} {
 587         return [format "%x" $n]
 588     } elseif {$n < 256} {
 589         return [format "x%.2x" $n]
 590     } elseif {$n < 65536} {
 591         return [format "y%.4x" $n]
 592     }
 593     return [format "z%.8x" $n]
 594 }
 595
 596 # Procedures used in reordering commits from git log (without
 597 # --topo-order) into the order for display.
 598
 599 proc varcinit {view} {
 600     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 601     global vtokmod varcmod vrowmod varcix vlastins
 602
 603     set varcstart($view) {{}}
 604     set vupptr($view) {0}
 605     set vdownptr($view) {0}
 606     set vleftptr($view) {0}
 607     set vbackptr($view) {0}
 608     set varctok($view) {{}}
 609     set varcrow($view) {{}}
 610     set vtokmod($view) {}
 611     set varcmod($view) 0
 612     set vrowmod($view) 0
 613     set varcix($view) {{}}
 614     set vlastins($view) {0}
 615 }
 616
 617 proc resetvarcs {view} {
 618     global varcid varccommits parents children vseedcount ordertok
 619
 620     foreach vid [array names varcid $view,*] {
 621         unset varcid($vid)
 622         unset children($vid)
 623         unset parents($vid)
 624     }
 625     # some commits might have children but haven't been seen yet
 626     foreach vid [array names children $view,*] {
 627         unset children($vid)
 628     }
 629     foreach va [array names varccommits $view,*] {
 630         unset varccommits($va)
 631     }
 632     foreach vd [array names vseedcount $view,*] {
 633         unset vseedcount($vd)
 634     }
 635     catch {unset ordertok}
 636 }
 637
 638 # returns a list of the commits with no children
 639 proc seeds {v} {
 640     global vdownptr vleftptr varcstart
 641
 642     set ret {}
 643     set a [lindex $vdownptr($v) 0]
 644     while {$a != 0} {
 645         lappend ret [lindex $varcstart($v) $a]
 646         set a [lindex $vleftptr($v) $a]
 647     }
 648     return $ret
 649 }
 650
 651 proc newvarc {view id} {
 652     global varcid varctok parents children vdatemode
 653     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 654     global commitdata commitinfo vseedcount varccommits vlastins
 655
 656     set a [llength $varctok($view)]
 657     set vid $view,$id
 658     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 659         if {![info exists commitinfo($id)]} {
 660             parsecommit $id $commitdata($id) 1
 661         }
 662         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 663         if {![string is integer -strict $cdate]} {
 664             set cdate 0
 665         }
 666         if {![info exists vseedcount($view,$cdate)]} {
 667             set vseedcount($view,$cdate) -1
 668         }
 669         set c [incr vseedcount($view,$cdate)]
 670         set cdate [expr {$cdate ^ 0xffffffff}]
 671         set tok "s[strrep $cdate][strrep $c]"
 672     } else {
 673         set tok {}
 674     }
 675     set ka 0
 676     if {[llength $children($vid)] > 0} {
 677         set kid [lindex $children($vid) end]
 678         set k $varcid($view,$kid)
 679         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 680             set ki $kid
 681             set ka $k
 682             set tok [lindex $varctok($view) $k]
 683         }
 684     }
 685     if {$ka != 0} {
 686         set i [lsearch -exact $parents($view,$ki) $id]
 687         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 688         append tok [strrep $j]
 689     }
 690     set c [lindex $vlastins($view) $ka]
 691     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 692         set c $ka
 693         set b [lindex $vdownptr($view) $ka]
 694     } else {
 695         set b [lindex $vleftptr($view) $c]
 696     }
 697     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 698         set c $b
 699         set b [lindex $vleftptr($view) $c]
 700     }
 701     if {$c == $ka} {
 702         lset vdownptr($view) $ka $a
 703         lappend vbackptr($view) 0
 704     } else {
 705         lset vleftptr($view) $c $a
 706         lappend vbackptr($view) $c
 707     }
 708     lset vlastins($view) $ka $a
 709     lappend vupptr($view) $ka
 710     lappend vleftptr($view) $b
 711     if {$b != 0} {
 712         lset vbackptr($view) $b $a
 713     }
 714     lappend varctok($view) $tok
 715     lappend varcstart($view) $id
 716     lappend vdownptr($view) 0
 717     lappend varcrow($view) {}
 718     lappend varcix($view) {}
 719     set varccommits($view,$a) {}
 720     lappend vlastins($view) 0
 721     return $a
 722 }
 723
 724 proc splitvarc {p v} {
 725     global varcid varcstart varccommits varctok vtokmod
 726     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 727
 728     set oa $varcid($v,$p)
 729     set otok [lindex $varctok($v) $oa]
 730     set ac $varccommits($v,$oa)
 731     set i [lsearch -exact $varccommits($v,$oa) $p]
 732     if {$i <= 0} return
 733     set na [llength $varctok($v)]
 734     # "%" sorts before "0"...
 735     set tok "$otok%[strrep $i]"
 736     lappend varctok($v) $tok
 737     lappend varcrow($v) {}
 738     lappend varcix($v) {}
 739     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 740     set varccommits($v,$na) [lrange $ac $i end]
 741     lappend varcstart($v) $p
 742     foreach id $varccommits($v,$na) {
 743         set varcid($v,$id) $na
 744     }
 745     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 746     lappend vlastins($v) [lindex $vlastins($v) $oa]
 747     lset vdownptr($v) $oa $na
 748     lset vlastins($v) $oa 0
 749     lappend vupptr($v) $oa
 750     lappend vleftptr($v) 0
 751     lappend vbackptr($v) 0
 752     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 753         lset vupptr($v) $b $na
 754     }
 755     if {[string compare $otok $vtokmod($v)] <= 0} {
 756         modify_arc $v $oa
 757     }
 758 }
 759
 760 proc renumbervarc {a v} {
 761     global parents children varctok varcstart varccommits
 762     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 763
 764     set t1 [clock clicks -milliseconds]
 765     set todo {}
 766     set isrelated($a) 1
 767     set kidchanged($a) 1
 768     set ntot 0
 769     while {$a != 0} {
 770         if {[info exists isrelated($a)]} {
 771             lappend todo $a
 772             set id [lindex $varccommits($v,$a) end]
 773             foreach p $parents($v,$id) {
 774                 if {[info exists varcid($v,$p)]} {
 775                     set isrelated($varcid($v,$p)) 1
 776                 }
 777             }
 778         }
 779         incr ntot
 780         set b [lindex $vdownptr($v) $a]
 781         if {$b == 0} {
 782             while {$a != 0} {
 783                 set b [lindex $vleftptr($v) $a]
 784                 if {$b != 0} break
 785                 set a [lindex $vupptr($v) $a]
 786             }
 787         }
 788         set a $b
 789     }
 790     foreach a $todo {
 791         if {![info exists kidchanged($a)]} continue
 792         set id [lindex $varcstart($v) $a]
 793         if {[llength $children($v,$id)] > 1} {
 794             set children($v,$id) [lsort -command [list vtokcmp $v] \
 795                                       $children($v,$id)]
 796         }
 797         set oldtok [lindex $varctok($v) $a]
 798         if {!$vdatemode($v)} {
 799             set tok {}
 800         } else {
 801             set tok $oldtok
 802         }
 803         set ka 0
 804         set kid [last_real_child $v,$id]
 805         if {$kid ne {}} {
 806             set k $varcid($v,$kid)
 807             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 808                 set ki $kid
 809                 set ka $k
 810                 set tok [lindex $varctok($v) $k]
 811             }
 812         }
 813         if {$ka != 0} {
 814             set i [lsearch -exact $parents($v,$ki) $id]
 815             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 816             append tok [strrep $j]
 817         }
 818         if {$tok eq $oldtok} {
 819             continue
 820         }
 821         set id [lindex $varccommits($v,$a) end]
 822         foreach p $parents($v,$id) {
 823             if {[info exists varcid($v,$p)]} {
 824                 set kidchanged($varcid($v,$p)) 1
 825             } else {
 826                 set sortkids($p) 1
 827             }
 828         }
 829         lset varctok($v) $a $tok
 830         set b [lindex $vupptr($v) $a]
 831         if {$b != $ka} {
 832             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 833                 modify_arc $v $ka
 834             }
 835             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 836                 modify_arc $v $b
 837             }
 838             set c [lindex $vbackptr($v) $a]
 839             set d [lindex $vleftptr($v) $a]
 840             if {$c == 0} {
 841                 lset vdownptr($v) $b $d
 842             } else {
 843                 lset vleftptr($v) $c $d
 844             }
 845             if {$d != 0} {
 846                 lset vbackptr($v) $d $c
 847             }
 848             if {[lindex $vlastins($v) $b] == $a} {
 849                 lset vlastins($v) $b $c
 850             }
 851             lset vupptr($v) $a $ka
 852             set c [lindex $vlastins($v) $ka]
 853             if {$c == 0 || \
 854                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 855                 set c $ka
 856                 set b [lindex $vdownptr($v) $ka]
 857             } else {
 858                 set b [lindex $vleftptr($v) $c]
 859             }
 860             while {$b != 0 && \
 861                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 862                 set c $b
 863                 set b [lindex $vleftptr($v) $c]
 864             }
 865             if {$c == $ka} {
 866                 lset vdownptr($v) $ka $a
 867                 lset vbackptr($v) $a 0
 868             } else {
 869                 lset vleftptr($v) $c $a
 870                 lset vbackptr($v) $a $c
 871             }
 872             lset vleftptr($v) $a $b
 873             if {$b != 0} {
 874                 lset vbackptr($v) $b $a
 875             }
 876             lset vlastins($v) $ka $a
 877         }
 878     }
 879     foreach id [array names sortkids] {
 880         if {[llength $children($v,$id)] > 1} {
 881             set children($v,$id) [lsort -command [list vtokcmp $v] \
 882                                       $children($v,$id)]
 883         }
 884     }
 885     set t2 [clock clicks -milliseconds]
 886     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 887 }
 888
 889 # Fix up the graph after we have found out that in view $v,
 890 # $p (a commit that we have already seen) is actually the parent
 891 # of the last commit in arc $a.
 892 proc fix_reversal {p a v} {
 893     global varcid varcstart varctok vupptr
 894
 895     set pa $varcid($v,$p)
 896     if {$p ne [lindex $varcstart($v) $pa]} {
 897         splitvarc $p $v
 898         set pa $varcid($v,$p)
 899     }
 900     # seeds always need to be renumbered
 901     if {[lindex $vupptr($v) $pa] == 0 ||
 902         [string compare [lindex $varctok($v) $a] \
 903              [lindex $varctok($v) $pa]] > 0} {
 904         renumbervarc $pa $v
 905     }
 906 }
 907
 908 proc insertrow {id p v} {
 909     global cmitlisted children parents varcid varctok vtokmod
 910     global varccommits ordertok commitidx numcommits curview
 911     global targetid targetrow
 912
 913     readcommit $id
 914     set vid $v,$id
 915     set cmitlisted($vid) 1
 916     set children($vid) {}
 917     set parents($vid) [list $p]
 918     set a [newvarc $v $id]
 919     set varcid($vid) $a
 920     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 921         modify_arc $v $a
 922     }
 923     lappend varccommits($v,$a) $id
 924     set vp $v,$p
 925     if {[llength [lappend children($vp) $id]] > 1} {
 926         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 927         catch {unset ordertok}
 928     }
 929     fix_reversal $p $a $v
 930     incr commitidx($v)
 931     if {$v == $curview} {
 932         set numcommits $commitidx($v)
 933         setcanvscroll
 934         if {[info exists targetid]} {
 935             if {![comes_before $targetid $p]} {
 936                 incr targetrow
 937             }
 938         }
 939     }
 940 }
 941
 942 proc insertfakerow {id p} {
 943     global varcid varccommits parents children cmitlisted
 944     global commitidx varctok vtokmod targetid targetrow curview numcommits
 945
 946     set v $curview
 947     set a $varcid($v,$p)
 948     set i [lsearch -exact $varccommits($v,$a) $p]
 949     if {$i < 0} {
 950         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 951         return
 952     }
 953     set children($v,$id) {}
 954     set parents($v,$id) [list $p]
 955     set varcid($v,$id) $a
 956     lappend children($v,$p) $id
 957     set cmitlisted($v,$id) 1
 958     set numcommits [incr commitidx($v)]
 959     # note we deliberately don't update varcstart($v) even if $i == 0
 960     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 961     modify_arc $v $a $i
 962     if {[info exists targetid]} {
 963         if {![comes_before $targetid $p]} {
 964             incr targetrow
 965         }
 966     }
 967     setcanvscroll
 968     drawvisible
 969 }
 970
 971 proc removefakerow {id} {
 972     global varcid varccommits parents children commitidx
 973     global varctok vtokmod cmitlisted currentid selectedline
 974     global targetid curview numcommits
 975
 976     set v $curview
 977     if {[llength $parents($v,$id)] != 1} {
 978         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
 979         return
 980     }
 981     set p [lindex $parents($v,$id) 0]
 982     set a $varcid($v,$id)
 983     set i [lsearch -exact $varccommits($v,$a) $id]
 984     if {$i < 0} {
 985         puts "oops: removefakerow can't find [shortids $id] on arc $a"
 986         return
 987     }
 988     unset varcid($v,$id)
 989     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
 990     unset parents($v,$id)
 991     unset children($v,$id)
 992     unset cmitlisted($v,$id)
 993     set numcommits [incr commitidx($v) -1]
 994     set j [lsearch -exact $children($v,$p) $id]
 995     if {$j >= 0} {
 996         set children($v,$p) [lreplace $children($v,$p) $j $j]
 997     }
 998     modify_arc $v $a $i
 999     if {[info exist currentid] && $id eq $currentid} {
1000         unset currentid
1001         set selectedline {}
1002     }
1003     if {[info exists targetid] && $targetid eq $id} {
1004         set targetid $p
1005     }
1006     setcanvscroll
1007     drawvisible
1008 }
1009
1010 proc real_children {vp} {
1011     global children nullid nullid2
1012
1013     set kids {}
1014     foreach id $children($vp) {
1015         if {$id ne $nullid && $id ne $nullid2} {
1016             lappend kids $id
1017         }
1018     }
1019     return $kids
1020 }
1021
1022 proc first_real_child {vp} {
1023     global children nullid nullid2
1024
1025     foreach id $children($vp) {
1026         if {$id ne $nullid && $id ne $nullid2} {
1027             return $id
1028         }
1029     }
1030     return {}
1031 }
1032
1033 proc last_real_child {vp} {
1034     global children nullid nullid2
1035
1036     set kids $children($vp)
1037     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1038         set id [lindex $kids $i]
1039         if {$id ne $nullid && $id ne $nullid2} {
1040             return $id
1041         }
1042     }
1043     return {}
1044 }
1045
1046 proc vtokcmp {v a b} {
1047     global varctok varcid
1048
1049     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1050                 [lindex $varctok($v) $varcid($v,$b)]]
1051 }
1052
1053 # This assumes that if lim is not given, the caller has checked that
1054 # arc a's token is less than $vtokmod($v)
1055 proc modify_arc {v a {lim {}}} {
1056     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1057
1058     if {$lim ne {}} {
1059         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1060         if {$c > 0} return
1061         if {$c == 0} {
1062             set r [lindex $varcrow($v) $a]
1063             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1064         }
1065     }
1066     set vtokmod($v) [lindex $varctok($v) $a]
1067     set varcmod($v) $a
1068     if {$v == $curview} {
1069         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1070             set a [lindex $vupptr($v) $a]
1071             set lim {}
1072         }
1073         set r 0
1074         if {$a != 0} {
1075             if {$lim eq {}} {
1076                 set lim [llength $varccommits($v,$a)]
1077             }
1078             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1079         }
1080         set vrowmod($v) $r
1081         undolayout $r
1082     }
1083 }
1084
1085 proc update_arcrows {v} {
1086     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1087     global varcid vrownum varcorder varcix varccommits
1088     global vupptr vdownptr vleftptr varctok
1089     global displayorder parentlist curview cached_commitrow
1090
1091     if {$vrowmod($v) == $commitidx($v)} return
1092     if {$v == $curview} {
1093         if {[llength $displayorder] > $vrowmod($v)} {
1094             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1095             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1096         }
1097         catch {unset cached_commitrow}
1098     }
1099     set narctot [expr {[llength $varctok($v)] - 1}]
1100     set a $varcmod($v)
1101     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1102         # go up the tree until we find something that has a row number,
1103         # or we get to a seed
1104         set a [lindex $vupptr($v) $a]
1105     }
1106     if {$a == 0} {
1107         set a [lindex $vdownptr($v) 0]
1108         if {$a == 0} return
1109         set vrownum($v) {0}
1110         set varcorder($v) [list $a]
1111         lset varcix($v) $a 0
1112         lset varcrow($v) $a 0
1113         set arcn 0
1114         set row 0
1115     } else {
1116         set arcn [lindex $varcix($v) $a]
1117         if {[llength $vrownum($v)] > $arcn + 1} {
1118             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1119             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1120         }
1121         set row [lindex $varcrow($v) $a]
1122     }
1123     while {1} {
1124         set p $a
1125         incr row [llength $varccommits($v,$a)]
1126         # go down if possible
1127         set b [lindex $vdownptr($v) $a]
1128         if {$b == 0} {
1129             # if not, go left, or go up until we can go left
1130             while {$a != 0} {
1131                 set b [lindex $vleftptr($v) $a]
1132                 if {$b != 0} break
1133                 set a [lindex $vupptr($v) $a]
1134             }
1135             if {$a == 0} break
1136         }
1137         set a $b
1138         incr arcn
1139         lappend vrownum($v) $row
1140         lappend varcorder($v) $a
1141         lset varcix($v) $a $arcn
1142         lset varcrow($v) $a $row
1143     }
1144     set vtokmod($v) [lindex $varctok($v) $p]
1145     set varcmod($v) $p
1146     set vrowmod($v) $row
1147     if {[info exists currentid]} {
1148         set selectedline [rowofcommit $currentid]
1149     }
1150 }
1151
1152 # Test whether view $v contains commit $id
1153 proc commitinview {id v} {
1154     global varcid
1155
1156     return [info exists varcid($v,$id)]
1157 }
1158
1159 # Return the row number for commit $id in the current view
1160 proc rowofcommit {id} {
1161     global varcid varccommits varcrow curview cached_commitrow
1162     global varctok vtokmod
1163
1164     set v $curview
1165     if {![info exists varcid($v,$id)]} {
1166         puts "oops rowofcommit no arc for [shortids $id]"
1167         return {}
1168     }
1169     set a $varcid($v,$id)
1170     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1171         update_arcrows $v
1172     }
1173     if {[info exists cached_commitrow($id)]} {
1174         return $cached_commitrow($id)
1175     }
1176     set i [lsearch -exact $varccommits($v,$a) $id]
1177     if {$i < 0} {
1178         puts "oops didn't find commit [shortids $id] in arc $a"
1179         return {}
1180     }
1181     incr i [lindex $varcrow($v) $a]
1182     set cached_commitrow($id) $i
1183     return $i
1184 }
1185
1186 # Returns 1 if a is on an earlier row than b, otherwise 0
1187 proc comes_before {a b} {
1188     global varcid varctok curview
1189
1190     set v $curview
1191     if {$a eq $b || ![info exists varcid($v,$a)] || \
1192             ![info exists varcid($v,$b)]} {
1193         return 0
1194     }
1195     if {$varcid($v,$a) != $varcid($v,$b)} {
1196         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1197                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1198     }
1199     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1200 }
1201
1202 proc bsearch {l elt} {
1203     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1204         return 0
1205     }
1206     set lo 0
1207     set hi [llength $l]
1208     while {$hi - $lo > 1} {
1209         set mid [expr {int(($lo + $hi) / 2)}]
1210         set t [lindex $l $mid]
1211         if {$elt < $t} {
1212             set hi $mid
1213         } elseif {$elt > $t} {
1214             set lo $mid
1215         } else {
1216             return $mid
1217         }
1218     }
1219     return $lo
1220 }
1221
1222 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1223 proc make_disporder {start end} {
1224     global vrownum curview commitidx displayorder parentlist
1225     global varccommits varcorder parents vrowmod varcrow
1226     global d_valid_start d_valid_end
1227
1228     if {$end > $vrowmod($curview)} {
1229         update_arcrows $curview
1230     }
1231     set ai [bsearch $vrownum($curview) $start]
1232     set start [lindex $vrownum($curview) $ai]
1233     set narc [llength $vrownum($curview)]
1234     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1235         set a [lindex $varcorder($curview) $ai]
1236         set l [llength $displayorder]
1237         set al [llength $varccommits($curview,$a)]
1238         if {$l < $r + $al} {
1239             if {$l < $r} {
1240                 set pad [ntimes [expr {$r - $l}] {}]
1241                 set displayorder [concat $displayorder $pad]
1242                 set parentlist [concat $parentlist $pad]
1243             } elseif {$l > $r} {
1244                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1245                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1246             }
1247             foreach id $varccommits($curview,$a) {
1248                 lappend displayorder $id
1249                 lappend parentlist $parents($curview,$id)
1250             }
1251         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1252             set i $r
1253             foreach id $varccommits($curview,$a) {
1254                 lset displayorder $i $id
1255                 lset parentlist $i $parents($curview,$id)
1256                 incr i
1257             }
1258         }
1259         incr r $al
1260     }
1261 }
1262
1263 proc commitonrow {row} {
1264     global displayorder
1265
1266     set id [lindex $displayorder $row]
1267     if {$id eq {}} {
1268         make_disporder $row [expr {$row + 1}]
1269         set id [lindex $displayorder $row]
1270     }
1271     return $id
1272 }
1273
1274 proc closevarcs {v} {
1275     global varctok varccommits varcid parents children
1276     global cmitlisted commitidx vtokmod
1277
1278     set missing_parents 0
1279     set scripts {}
1280     set narcs [llength $varctok($v)]
1281     for {set a 1} {$a < $narcs} {incr a} {
1282         set id [lindex $varccommits($v,$a) end]
1283         foreach p $parents($v,$id) {
1284             if {[info exists varcid($v,$p)]} continue
1285             # add p as a new commit
1286             incr missing_parents
1287             set cmitlisted($v,$p) 0
1288             set parents($v,$p) {}
1289             if {[llength $children($v,$p)] == 1 &&
1290                 [llength $parents($v,$id)] == 1} {
1291                 set b $a
1292             } else {
1293                 set b [newvarc $v $p]
1294             }
1295             set varcid($v,$p) $b
1296             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1297                 modify_arc $v $b
1298             }
1299             lappend varccommits($v,$b) $p
1300             incr commitidx($v)
1301             set scripts [check_interest $p $scripts]
1302         }
1303     }
1304     if {$missing_parents > 0} {
1305         foreach s $scripts {
1306             eval $s
1307         }
1308     }
1309 }
1310
1311 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1312 # Assumes we already have an arc for $rwid.
1313 proc rewrite_commit {v id rwid} {
1314     global children parents varcid varctok vtokmod varccommits
1315
1316     foreach ch $children($v,$id) {
1317         # make $rwid be $ch's parent in place of $id
1318         set i [lsearch -exact $parents($v,$ch) $id]
1319         if {$i < 0} {
1320             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1321         }
1322         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1323         # add $ch to $rwid's children and sort the list if necessary
1324         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1325             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1326                                         $children($v,$rwid)]
1327         }
1328         # fix the graph after joining $id to $rwid
1329         set a $varcid($v,$ch)
1330         fix_reversal $rwid $a $v
1331         # parentlist is wrong for the last element of arc $a
1332         # even if displayorder is right, hence the 3rd arg here
1333         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1334     }
1335 }
1336
1337 # Mechanism for registering a command to be executed when we come
1338 # across a particular commit.  To handle the case when only the
1339 # prefix of the commit is known, the commitinterest array is now
1340 # indexed by the first 4 characters of the ID.  Each element is a
1341 # list of id, cmd pairs.
1342 proc interestedin {id cmd} {
1343     global commitinterest
1344
1345     lappend commitinterest([string range $id 0 3]) $id $cmd
1346 }
1347
1348 proc check_interest {id scripts} {
1349     global commitinterest
1350
1351     set prefix [string range $id 0 3]
1352     if {[info exists commitinterest($prefix)]} {
1353         set newlist {}
1354         foreach {i script} $commitinterest($prefix) {
1355             if {[string match "$i*" $id]} {
1356                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1357             } else {
1358                 lappend newlist $i $script
1359             }
1360         }
1361         if {$newlist ne {}} {
1362             set commitinterest($prefix) $newlist
1363         } else {
1364             unset commitinterest($prefix)
1365         }
1366     }
1367     return $scripts
1368 }
1369
1370 proc getcommitlines {fd inst view updating}  {
1371     global cmitlisted leftover
1372     global commitidx commitdata vdatemode
1373     global parents children curview hlview
1374     global idpending ordertok
1375     global varccommits varcid varctok vtokmod vfilelimit
1376
1377     set stuff [read $fd 500000]
1378     # git log doesn't terminate the last commit with a null...
1379     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1380         set stuff "\0"
1381     }
1382     if {$stuff == {}} {
1383         if {![eof $fd]} {
1384             return 1
1385         }
1386         global commfd viewcomplete viewactive viewname
1387         global viewinstances
1388         unset commfd($inst)
1389         set i [lsearch -exact $viewinstances($view) $inst]
1390         if {$i >= 0} {
1391             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1392         }
1393         # set it blocking so we wait for the process to terminate
1394         fconfigure $fd -blocking 1
1395         if {[catch {close $fd} err]} {
1396             set fv {}
1397             if {$view != $curview} {
1398                 set fv " for the \"$viewname($view)\" view"
1399             }
1400             if {[string range $err 0 4] == "usage"} {
1401                 set err "Gitk: error reading commits$fv:\
1402                         bad arguments to git log."
1403                 if {$viewname($view) eq "Command line"} {
1404                     append err \
1405                         "  (Note: arguments to gitk are passed to git log\
1406                          to allow selection of commits to be displayed.)"
1407                 }
1408             } else {
1409                 set err "Error reading commits$fv: $err"
1410             }
1411             error_popup $err
1412         }
1413         if {[incr viewactive($view) -1] <= 0} {
1414             set viewcomplete($view) 1
1415             # Check if we have seen any ids listed as parents that haven't
1416             # appeared in the list
1417             closevarcs $view
1418             notbusy $view
1419         }
1420         if {$view == $curview} {
1421             run chewcommits
1422         }
1423         return 0
1424     }
1425     set start 0
1426     set gotsome 0
1427     set scripts {}
1428     while 1 {
1429         set i [string first "\0" $stuff $start]
1430         if {$i < 0} {
1431             append leftover($inst) [string range $stuff $start end]
1432             break
1433         }
1434         if {$start == 0} {
1435             set cmit $leftover($inst)
1436             append cmit [string range $stuff 0 [expr {$i - 1}]]
1437             set leftover($inst) {}
1438         } else {
1439             set cmit [string range $stuff $start [expr {$i - 1}]]
1440         }
1441         set start [expr {$i + 1}]
1442         set j [string first "\n" $cmit]
1443         set ok 0
1444         set listed 1
1445         if {$j >= 0 && [string match "commit *" $cmit]} {
1446             set ids [string range $cmit 7 [expr {$j - 1}]]
1447             if {[string match {[-^<>]*} $ids]} {
1448                 switch -- [string index $ids 0] {
1449                     "-" {set listed 0}
1450                     "^" {set listed 2}
1451                     "<" {set listed 3}
1452                     ">" {set listed 4}
1453                 }
1454                 set ids [string range $ids 1 end]
1455             }
1456             set ok 1
1457             foreach id $ids {
1458                 if {[string length $id] != 40} {
1459                     set ok 0
1460                     break
1461                 }
1462             }
1463         }
1464         if {!$ok} {
1465             set shortcmit $cmit
1466             if {[string length $shortcmit] > 80} {
1467                 set shortcmit "[string range $shortcmit 0 80]..."
1468             }
1469             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1470             exit 1
1471         }
1472         set id [lindex $ids 0]
1473         set vid $view,$id
1474
1475         if {!$listed && $updating && ![info exists varcid($vid)] &&
1476             $vfilelimit($view) ne {}} {
1477             # git log doesn't rewrite parents for unlisted commits
1478             # when doing path limiting, so work around that here
1479             # by working out the rewritten parent with git rev-list
1480             # and if we already know about it, using the rewritten
1481             # parent as a substitute parent for $id's children.
1482             if {![catch {
1483                 set rwid [exec git rev-list --first-parent --max-count=1 \
1484                               $id -- $vfilelimit($view)]
1485             }]} {
1486                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1487                     # use $rwid in place of $id
1488                     rewrite_commit $view $id $rwid
1489                     continue
1490                 }
1491             }
1492         }
1493
1494         set a 0
1495         if {[info exists varcid($vid)]} {
1496             if {$cmitlisted($vid) || !$listed} continue
1497             set a $varcid($vid)
1498         }
1499         if {$listed} {
1500             set olds [lrange $ids 1 end]
1501         } else {
1502             set olds {}
1503         }
1504         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1505         set cmitlisted($vid) $listed
1506         set parents($vid) $olds
1507         if {![info exists children($vid)]} {
1508             set children($vid) {}
1509         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1510             set k [lindex $children($vid) 0]
1511             if {[llength $parents($view,$k)] == 1 &&
1512                 (!$vdatemode($view) ||
1513                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1514                 set a $varcid($view,$k)
1515             }
1516         }
1517         if {$a == 0} {
1518             # new arc
1519             set a [newvarc $view $id]
1520         }
1521         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1522             modify_arc $view $a
1523         }
1524         if {![info exists varcid($vid)]} {
1525             set varcid($vid) $a
1526             lappend varccommits($view,$a) $id
1527             incr commitidx($view)
1528         }
1529
1530         set i 0
1531         foreach p $olds {
1532             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1533                 set vp $view,$p
1534                 if {[llength [lappend children($vp) $id]] > 1 &&
1535                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1536                     set children($vp) [lsort -command [list vtokcmp $view] \
1537                                            $children($vp)]
1538                     catch {unset ordertok}
1539                 }
1540                 if {[info exists varcid($view,$p)]} {
1541                     fix_reversal $p $a $view
1542                 }
1543             }
1544             incr i
1545         }
1546
1547         set scripts [check_interest $id $scripts]
1548         set gotsome 1
1549     }
1550     if {$gotsome} {
1551         global numcommits hlview
1552
1553         if {$view == $curview} {
1554             set numcommits $commitidx($view)
1555             run chewcommits
1556         }
1557         if {[info exists hlview] && $view == $hlview} {
1558             # we never actually get here...
1559             run vhighlightmore
1560         }
1561         foreach s $scripts {
1562             eval $s
1563         }
1564     }
1565     return 2
1566 }
1567
1568 proc chewcommits {} {
1569     global curview hlview viewcomplete
1570     global pending_select
1571
1572     layoutmore
1573     if {$viewcomplete($curview)} {
1574         global commitidx varctok
1575         global numcommits startmsecs
1576
1577         if {[info exists pending_select]} {
1578             update
1579             reset_pending_select {}
1580
1581             if {[commitinview $pending_select $curview]} {
1582                 selectline [rowofcommit $pending_select] 1
1583             } else {
1584                 set row [first_real_row]
1585                 selectline $row 1
1586             }
1587         }
1588         if {$commitidx($curview) > 0} {
1589             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1590             #puts "overall $ms ms for $numcommits commits"
1591             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1592         } else {
1593             show_status [mc "No commits selected"]
1594         }
1595         notbusy layout
1596     }
1597     return 0
1598 }
1599
1600 proc do_readcommit {id} {
1601     global tclencoding
1602
1603     # Invoke git-log to handle automatic encoding conversion
1604     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1605     # Read the results using i18n.logoutputencoding
1606     fconfigure $fd -translation lf -eofchar {}
1607     if {$tclencoding != {}} {
1608         fconfigure $fd -encoding $tclencoding
1609     }
1610     set contents [read $fd]
1611     close $fd
1612     # Remove the heading line
1613     regsub {^commit [0-9a-f]+\n} $contents {} contents
1614
1615     return $contents
1616 }
1617
1618 proc readcommit {id} {
1619     if {[catch {set contents [do_readcommit $id]}]} return
1620     parsecommit $id $contents 1
1621 }
1622
1623 proc parsecommit {id contents listed} {
1624     global commitinfo
1625
1626     set inhdr 1
1627     set comment {}
1628     set headline {}
1629     set auname {}
1630     set audate {}
1631     set comname {}
1632     set comdate {}
1633     set hdrend [string first "\n\n" $contents]
1634     if {$hdrend < 0} {
1635         # should never happen...
1636         set hdrend [string length $contents]
1637     }
1638     set header [string range $contents 0 [expr {$hdrend - 1}]]
1639     set comment [string range $contents [expr {$hdrend + 2}] end]
1640     foreach line [split $header "\n"] {
1641         set line [split $line " "]
1642         set tag [lindex $line 0]
1643         if {$tag == "author"} {
1644             set audate [lrange $line end-1 end]
1645             set auname [join [lrange $line 1 end-2] " "]
1646         } elseif {$tag == "committer"} {
1647             set comdate [lrange $line end-1 end]
1648             set comname [join [lrange $line 1 end-2] " "]
1649         }
1650     }
1651     set headline {}
1652     # take the first non-blank line of the comment as the headline
1653     set headline [string trimleft $comment]
1654     set i [string first "\n" $headline]
1655     if {$i >= 0} {
1656         set headline [string range $headline 0 $i]
1657     }
1658     set headline [string trimright $headline]
1659     set i [string first "\r" $headline]
1660     if {$i >= 0} {
1661         set headline [string trimright [string range $headline 0 $i]]
1662     }
1663     if {!$listed} {
1664         # git log indents the comment by 4 spaces;
1665         # if we got this via git cat-file, add the indentation
1666         set newcomment {}
1667         foreach line [split $comment "\n"] {
1668             append newcomment "    "
1669             append newcomment $line
1670             append newcomment "\n"
1671         }
1672         set comment $newcomment
1673     }
1674     set hasnote [string first "\nNotes:\n" $contents]
1675     set commitinfo($id) [list $headline $auname $audate \
1676                              $comname $comdate $comment $hasnote]
1677 }
1678
1679 proc getcommit {id} {
1680     global commitdata commitinfo
1681
1682     if {[info exists commitdata($id)]} {
1683         parsecommit $id $commitdata($id) 1
1684     } else {
1685         readcommit $id
1686         if {![info exists commitinfo($id)]} {
1687             set commitinfo($id) [list [mc "No commit information available"]]
1688         }
1689     }
1690     return 1
1691 }
1692
1693 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1694 # and are present in the current view.
1695 # This is fairly slow...
1696 proc longid {prefix} {
1697     global varcid curview
1698
1699     set ids {}
1700     foreach match [array names varcid "$curview,$prefix*"] {
1701         lappend ids [lindex [split $match ","] 1]
1702     }
1703     return $ids
1704 }
1705
1706 proc readrefs {} {
1707     global tagids idtags headids idheads tagobjid
1708     global otherrefids idotherrefs mainhead mainheadid
1709     global selecthead selectheadid
1710     global hideremotes
1711
1712     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1713         catch {unset $v}
1714     }
1715     set refd [open [list | git show-ref -d] r]
1716     while {[gets $refd line] >= 0} {
1717         if {[string index $line 40] ne " "} continue
1718         set id [string range $line 0 39]
1719         set ref [string range $line 41 end]
1720         if {![string match "refs/*" $ref]} continue
1721         set name [string range $ref 5 end]
1722         if {[string match "remotes/*" $name]} {
1723             if {![string match "*/HEAD" $name] && !$hideremotes} {
1724                 set headids($name) $id
1725                 lappend idheads($id) $name
1726             }
1727         } elseif {[string match "heads/*" $name]} {
1728             set name [string range $name 6 end]
1729             set headids($name) $id
1730             lappend idheads($id) $name
1731         } elseif {[string match "tags/*" $name]} {
1732             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1733             # which is what we want since the former is the commit ID
1734             set name [string range $name 5 end]
1735             if {[string match "*^{}" $name]} {
1736                 set name [string range $name 0 end-3]
1737             } else {
1738                 set tagobjid($name) $id
1739             }
1740             set tagids($name) $id
1741             lappend idtags($id) $name
1742         } else {
1743             set otherrefids($name) $id
1744             lappend idotherrefs($id) $name
1745         }
1746     }
1747     catch {close $refd}
1748     set mainhead {}
1749     set mainheadid {}
1750     catch {
1751         set mainheadid [exec git rev-parse HEAD]
1752         set thehead [exec git symbolic-ref HEAD]
1753         if {[string match "refs/heads/*" $thehead]} {
1754             set mainhead [string range $thehead 11 end]
1755         }
1756     }
1757     set selectheadid {}
1758     if {$selecthead ne {}} {
1759         catch {
1760             set selectheadid [exec git rev-parse --verify $selecthead]
1761         }
1762     }
1763 }
1764
1765 # skip over fake commits
1766 proc first_real_row {} {
1767     global nullid nullid2 numcommits
1768
1769     for {set row 0} {$row < $numcommits} {incr row} {
1770         set id [commitonrow $row]
1771         if {$id ne $nullid && $id ne $nullid2} {
1772             break
1773         }
1774     }
1775     return $row
1776 }
1777
1778 # update things for a head moved to a child of its previous location
1779 proc movehead {id name} {
1780     global headids idheads
1781
1782     removehead $headids($name) $name
1783     set headids($name) $id
1784     lappend idheads($id) $name
1785 }
1786
1787 # update things when a head has been removed
1788 proc removehead {id name} {
1789     global headids idheads
1790
1791     if {$idheads($id) eq $name} {
1792         unset idheads($id)
1793     } else {
1794         set i [lsearch -exact $idheads($id) $name]
1795         if {$i >= 0} {
1796             set idheads($id) [lreplace $idheads($id) $i $i]
1797         }
1798     }
1799     unset headids($name)
1800 }
1801
1802 proc ttk_toplevel {w args} {
1803     global use_ttk
1804     eval [linsert $args 0 ::toplevel $w]
1805     if {$use_ttk} {
1806         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1807     }
1808     return $w
1809 }
1810
1811 proc make_transient {window origin} {
1812     global have_tk85
1813
1814     # In MacOS Tk 8.4 transient appears to work by setting
1815     # overrideredirect, which is utterly useless, since the
1816     # windows get no border, and are not even kept above
1817     # the parent.
1818     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1819
1820     wm transient $window $origin
1821
1822     # Windows fails to place transient windows normally, so
1823     # schedule a callback to center them on the parent.
1824     if {[tk windowingsystem] eq {win32}} {
1825         after idle [list tk::PlaceWindow $window widget $origin]
1826     }
1827 }
1828
1829 proc show_error {w top msg {mc mc}} {
1830     global NS
1831     if {![info exists NS]} {set NS ""}
1832     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1833     message $w.m -text $msg -justify center -aspect 400
1834     pack $w.m -side top -fill x -padx 20 -pady 20
1835     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1836     pack $w.ok -side bottom -fill x
1837     bind $top <Visibility> "grab $top; focus $top"
1838     bind $top <Key-Return> "destroy $top"
1839     bind $top <Key-space>  "destroy $top"
1840     bind $top <Key-Escape> "destroy $top"
1841     tkwait window $top
1842 }
1843
1844 proc error_popup {msg {owner .}} {
1845     if {[tk windowingsystem] eq "win32"} {
1846         tk_messageBox -icon error -type ok -title [wm title .] \
1847             -parent $owner -message $msg
1848     } else {
1849         set w .error
1850         ttk_toplevel $w
1851         make_transient $w $owner
1852         show_error $w $w $msg
1853     }
1854 }
1855
1856 proc confirm_popup {msg {owner .}} {
1857     global confirm_ok NS
1858     set confirm_ok 0
1859     set w .confirm
1860     ttk_toplevel $w
1861     make_transient $w $owner
1862     message $w.m -text $msg -justify center -aspect 400
1863     pack $w.m -side top -fill x -padx 20 -pady 20
1864     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1865     pack $w.ok -side left -fill x
1866     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1867     pack $w.cancel -side right -fill x
1868     bind $w <Visibility> "grab $w; focus $w"
1869     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1870     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1871     bind $w <Key-Escape> "destroy $w"
1872     tk::PlaceWindow $w widget $owner
1873     tkwait window $w
1874     return $confirm_ok
1875 }
1876
1877 proc setoptions {} {
1878     if {[tk windowingsystem] ne "win32"} {
1879         option add *Panedwindow.showHandle 1 startupFile
1880         option add *Panedwindow.sashRelief raised startupFile
1881         if {[tk windowingsystem] ne "aqua"} {
1882             option add *Menu.font uifont startupFile
1883         }
1884     } else {
1885         option add *Menu.TearOff 0 startupFile
1886     }
1887     option add *Button.font uifont startupFile
1888     option add *Checkbutton.font uifont startupFile
1889     option add *Radiobutton.font uifont startupFile
1890     option add *Menubutton.font uifont startupFile
1891     option add *Label.font uifont startupFile
1892     option add *Message.font uifont startupFile
1893     option add *Entry.font textfont startupFile
1894     option add *Text.font textfont startupFile
1895     option add *Labelframe.font uifont startupFile
1896     option add *Spinbox.font textfont startupFile
1897     option add *Listbox.font mainfont startupFile
1898 }
1899
1900 # Make a menu and submenus.
1901 # m is the window name for the menu, items is the list of menu items to add.
1902 # Each item is a list {mc label type description options...}
1903 # mc is ignored; it's so we can put mc there to alert xgettext
1904 # label is the string that appears in the menu
1905 # type is cascade, command or radiobutton (should add checkbutton)
1906 # description depends on type; it's the sublist for cascade, the
1907 # command to invoke for command, or {variable value} for radiobutton
1908 proc makemenu {m items} {
1909     menu $m
1910     if {[tk windowingsystem] eq {aqua}} {
1911         set Meta1 Cmd
1912     } else {
1913         set Meta1 Ctrl
1914     }
1915     foreach i $items {
1916         set name [mc [lindex $i 1]]
1917         set type [lindex $i 2]
1918         set thing [lindex $i 3]
1919         set params [list $type]
1920         if {$name ne {}} {
1921             set u [string first "&" [string map {&& x} $name]]
1922             lappend params -label [string map {&& & & {}} $name]
1923             if {$u >= 0} {
1924                 lappend params -underline $u
1925             }
1926         }
1927         switch -- $type {
1928             "cascade" {
1929                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1930                 lappend params -menu $m.$submenu
1931             }
1932             "command" {
1933                 lappend params -command $thing
1934             }
1935             "radiobutton" {
1936                 lappend params -variable [lindex $thing 0] \
1937                     -value [lindex $thing 1]
1938             }
1939         }
1940         set tail [lrange $i 4 end]
1941         regsub -all {\yMeta1\y} $tail $Meta1 tail
1942         eval $m add $params $tail
1943         if {$type eq "cascade"} {
1944             makemenu $m.$submenu $thing
1945         }
1946     }
1947 }
1948
1949 # translate string and remove ampersands
1950 proc mca {str} {
1951     return [string map {&& & & {}} [mc $str]]
1952 }
1953
1954 proc makedroplist {w varname args} {
1955     global use_ttk
1956     if {$use_ttk} {
1957         set width 0
1958         foreach label $args {
1959             set cx [string length $label]
1960             if {$cx > $width} {set width $cx}
1961         }
1962         set gm [ttk::combobox $w -width $width -state readonly\
1963                     -textvariable $varname -values $args]
1964     } else {
1965         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
1966     }
1967     return $gm
1968 }
1969
1970 proc makewindow {} {
1971     global canv canv2 canv3 linespc charspc ctext cflist cscroll
1972     global tabstop
1973     global findtype findtypemenu findloc findstring fstring geometry
1974     global entries sha1entry sha1string sha1but
1975     global diffcontextstring diffcontext
1976     global ignorespace
1977     global maincursor textcursor curtextcursor
1978     global rowctxmenu fakerowmenu mergemax wrapcomment
1979     global highlight_files gdttype
1980     global searchstring sstring
1981     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1982     global headctxmenu progresscanv progressitem progresscoords statusw
1983     global fprogitem fprogcoord lastprogupdate progupdatepending
1984     global rprogitem rprogcoord rownumsel numcommits
1985     global have_tk85 use_ttk NS
1986     global git_version
1987     global worddiff
1988
1989     # The "mc" arguments here are purely so that xgettext
1990     # sees the following string as needing to be translated
1991     set file {
1992         mc "File" cascade {
1993             {mc "Update" command updatecommits -accelerator F5}
1994             {mc "Reload" command reloadcommits -accelerator Meta1-F5}
1995             {mc "Reread references" command rereadrefs}
1996             {mc "List references" command showrefs -accelerator F2}
1997             {xx "" separator}
1998             {mc "Start git gui" command {exec git gui &}}
1999             {xx "" separator}
2000             {mc "Quit" command doquit -accelerator Meta1-Q}
2001         }}
2002     set edit {
2003         mc "Edit" cascade {
2004             {mc "Preferences" command doprefs}
2005         }}
2006     set view {
2007         mc "View" cascade {
2008             {mc "New view..." command {newview 0} -accelerator Shift-F4}
2009             {mc "Edit view..." command editview -state disabled -accelerator F4}
2010             {mc "Delete view" command delview -state disabled}
2011             {xx "" separator}
2012             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2013         }}
2014     if {[tk windowingsystem] ne "aqua"} {
2015         set help {
2016         mc "Help" cascade {
2017             {mc "About gitk" command about}
2018             {mc "Key bindings" command keys}
2019         }}
2020         set bar [list $file $edit $view $help]
2021     } else {
2022         proc ::tk::mac::ShowPreferences {} {doprefs}
2023         proc ::tk::mac::Quit {} {doquit}
2024         lset file end [lreplace [lindex $file end] end-1 end]
2025         set apple {
2026         xx "Apple" cascade {
2027             {mc "About gitk" command about}
2028             {xx "" separator}
2029         }}
2030         set help {
2031         mc "Help" cascade {
2032             {mc "Key bindings" command keys}
2033         }}
2034         set bar [list $apple $file $view $help]
2035     }
2036     makemenu .bar $bar
2037     . configure -menu .bar
2038
2039     if {$use_ttk} {
2040         # cover the non-themed toplevel with a themed frame.
2041         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2042     }
2043
2044     # the gui has upper and lower half, parts of a paned window.
2045     ${NS}::panedwindow .ctop -orient vertical
2046
2047     # possibly use assumed geometry
2048     if {![info exists geometry(pwsash0)]} {
2049         set geometry(topheight) [expr {15 * $linespc}]
2050         set geometry(topwidth) [expr {80 * $charspc}]
2051         set geometry(botheight) [expr {15 * $linespc}]
2052         set geometry(botwidth) [expr {50 * $charspc}]
2053         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2054         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2055     }
2056
2057     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2058     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2059     ${NS}::frame .tf.histframe
2060     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2061     if {!$use_ttk} {
2062         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2063     }
2064
2065     # create three canvases
2066     set cscroll .tf.histframe.csb
2067     set canv .tf.histframe.pwclist.canv
2068     canvas $canv \
2069         -selectbackground $selectbgcolor \
2070         -background $bgcolor -bd 0 \
2071         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2072     .tf.histframe.pwclist add $canv
2073     set canv2 .tf.histframe.pwclist.canv2
2074     canvas $canv2 \
2075         -selectbackground $selectbgcolor \
2076         -background $bgcolor -bd 0 -yscrollincr $linespc
2077     .tf.histframe.pwclist add $canv2
2078     set canv3 .tf.histframe.pwclist.canv3
2079     canvas $canv3 \
2080         -selectbackground $selectbgcolor \
2081         -background $bgcolor -bd 0 -yscrollincr $linespc
2082     .tf.histframe.pwclist add $canv3
2083     if {$use_ttk} {
2084         bind .tf.histframe.pwclist <Map> {
2085             bind %W <Map> {}
2086             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2087             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2088         }
2089     } else {
2090         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2091         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2092     }
2093
2094     # a scroll bar to rule them
2095     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2096     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2097     pack $cscroll -side right -fill y
2098     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2099     lappend bglist $canv $canv2 $canv3
2100     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2101
2102     # we have two button bars at bottom of top frame. Bar 1
2103     ${NS}::frame .tf.bar
2104     ${NS}::frame .tf.lbar -height 15
2105
2106     set sha1entry .tf.bar.sha1
2107     set entries $sha1entry
2108     set sha1but .tf.bar.sha1label
2109     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2110         -command gotocommit -width 8
2111     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2112     pack .tf.bar.sha1label -side left
2113     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2114     trace add variable sha1string write sha1change
2115     pack $sha1entry -side left -pady 2
2116
2117     image create bitmap bm-left -data {
2118         #define left_width 16
2119         #define left_height 16
2120         static unsigned char left_bits[] = {
2121         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2122         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2123         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2124     }
2125     image create bitmap bm-right -data {
2126         #define right_width 16
2127         #define right_height 16
2128         static unsigned char right_bits[] = {
2129         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2130         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2131         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2132     }
2133     ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
2134         -state disabled -width 26
2135     pack .tf.bar.leftbut -side left -fill y
2136     ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
2137         -state disabled -width 26
2138     pack .tf.bar.rightbut -side left -fill y
2139
2140     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2141     set rownumsel {}
2142     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2143         -relief sunken -anchor e
2144     ${NS}::label .tf.bar.rowlabel2 -text "/"
2145     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2146         -relief sunken -anchor e
2147     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2148         -side left
2149     if {!$use_ttk} {
2150         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2151     }
2152     global selectedline
2153     trace add variable selectedline write selectedline_change
2154
2155     # Status label and progress bar
2156     set statusw .tf.bar.status
2157     ${NS}::label $statusw -width 15 -relief sunken
2158     pack $statusw -side left -padx 5
2159     if {$use_ttk} {
2160         set progresscanv [ttk::progressbar .tf.bar.progress]
2161     } else {
2162         set h [expr {[font metrics uifont -linespace] + 2}]
2163         set progresscanv .tf.bar.progress
2164         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2165         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2166         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2167         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2168     }
2169     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2170     set progresscoords {0 0}
2171     set fprogcoord 0
2172     set rprogcoord 0
2173     bind $progresscanv <Configure> adjustprogress
2174     set lastprogupdate [clock clicks -milliseconds]
2175     set progupdatepending 0
2176
2177     # build up the bottom bar of upper window
2178     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2179     ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2180     ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2181     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2182     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2183         -side left -fill y
2184     set gdttype [mc "containing:"]
2185     set gm [makedroplist .tf.lbar.gdttype gdttype \
2186                 [mc "containing:"] \
2187                 [mc "touching paths:"] \
2188                 [mc "adding/removing string:"]]
2189     trace add variable gdttype write gdttype_change
2190     pack .tf.lbar.gdttype -side left -fill y
2191
2192     set findstring {}
2193     set fstring .tf.lbar.findstring
2194     lappend entries $fstring
2195     ${NS}::entry $fstring -width 30 -textvariable findstring
2196     trace add variable findstring write find_change
2197     set findtype [mc "Exact"]
2198     set findtypemenu [makedroplist .tf.lbar.findtype \
2199                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2200     trace add variable findtype write findcom_change
2201     set findloc [mc "All fields"]
2202     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2203         [mc "Comments"] [mc "Author"] [mc "Committer"]
2204     trace add variable findloc write find_change
2205     pack .tf.lbar.findloc -side right
2206     pack .tf.lbar.findtype -side right
2207     pack $fstring -side left -expand 1 -fill x
2208
2209     # Finish putting the upper half of the viewer together
2210     pack .tf.lbar -in .tf -side bottom -fill x
2211     pack .tf.bar -in .tf -side bottom -fill x
2212     pack .tf.histframe -fill both -side top -expand 1
2213     .ctop add .tf
2214     if {!$use_ttk} {
2215         .ctop paneconfigure .tf -height $geometry(topheight)
2216         .ctop paneconfigure .tf -width $geometry(topwidth)
2217     }
2218
2219     # now build up the bottom
2220     ${NS}::panedwindow .pwbottom -orient horizontal
2221
2222     # lower left, a text box over search bar, scroll bar to the right
2223     # if we know window height, then that will set the lower text height, otherwise
2224     # we set lower text height which will drive window height
2225     if {[info exists geometry(main)]} {
2226         ${NS}::frame .bleft -width $geometry(botwidth)
2227     } else {
2228         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2229     }
2230     ${NS}::frame .bleft.top
2231     ${NS}::frame .bleft.mid
2232     ${NS}::frame .bleft.bottom
2233
2234     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2235     pack .bleft.top.search -side left -padx 5
2236     set sstring .bleft.top.sstring
2237     set searchstring ""
2238     ${NS}::entry $sstring -width 20 -textvariable searchstring
2239     lappend entries $sstring
2240     trace add variable searchstring write incrsearch
2241     pack $sstring -side left -expand 1 -fill x
2242     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2243         -command changediffdisp -variable diffelide -value {0 0}
2244     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2245         -command changediffdisp -variable diffelide -value {0 1}
2246     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2247         -command changediffdisp -variable diffelide -value {1 0}
2248     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2249     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2250     spinbox .bleft.mid.diffcontext -width 5 \
2251         -from 0 -increment 1 -to 10000000 \
2252         -validate all -validatecommand "diffcontextvalidate %P" \
2253         -textvariable diffcontextstring
2254     .bleft.mid.diffcontext set $diffcontext
2255     trace add variable diffcontextstring write diffcontextchange
2256     lappend entries .bleft.mid.diffcontext
2257     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2258     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2259         -command changeignorespace -variable ignorespace
2260     pack .bleft.mid.ignspace -side left -padx 5
2261
2262     set worddiff [mc "Line diff"]
2263     if {[package vcompare $git_version "1.7.2"] >= 0} {
2264         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2265             [mc "Markup words"] [mc "Color words"]
2266         trace add variable worddiff write changeworddiff
2267         pack .bleft.mid.worddiff -side left -padx 5
2268     }
2269
2270     set ctext .bleft.bottom.ctext
2271     text $ctext -background $bgcolor -foreground $fgcolor \
2272         -state disabled -font textfont \
2273         -yscrollcommand scrolltext -wrap none \
2274         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2275     if {$have_tk85} {
2276         $ctext conf -tabstyle wordprocessor
2277     }
2278     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2279     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2280     pack .bleft.top -side top -fill x
2281     pack .bleft.mid -side top -fill x
2282     grid $ctext .bleft.bottom.sb -sticky nsew
2283     grid .bleft.bottom.sbhorizontal -sticky ew
2284     grid columnconfigure .bleft.bottom 0 -weight 1
2285     grid rowconfigure .bleft.bottom 0 -weight 1
2286     grid rowconfigure .bleft.bottom 1 -weight 0
2287     pack .bleft.bottom -side top -fill both -expand 1
2288     lappend bglist $ctext
2289     lappend fglist $ctext
2290
2291     $ctext tag conf comment -wrap $wrapcomment
2292     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2293     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2294     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2295     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2296     $ctext tag conf m0 -fore red
2297     $ctext tag conf m1 -fore blue
2298     $ctext tag conf m2 -fore green
2299     $ctext tag conf m3 -fore purple
2300     $ctext tag conf m4 -fore brown
2301     $ctext tag conf m5 -fore "#009090"
2302     $ctext tag conf m6 -fore magenta
2303     $ctext tag conf m7 -fore "#808000"
2304     $ctext tag conf m8 -fore "#009000"
2305     $ctext tag conf m9 -fore "#ff0080"
2306     $ctext tag conf m10 -fore cyan
2307     $ctext tag conf m11 -fore "#b07070"
2308     $ctext tag conf m12 -fore "#70b0f0"
2309     $ctext tag conf m13 -fore "#70f0b0"
2310     $ctext tag conf m14 -fore "#f0b070"
2311     $ctext tag conf m15 -fore "#ff70b0"
2312     $ctext tag conf mmax -fore darkgrey
2313     set mergemax 16
2314     $ctext tag conf mresult -font textfontbold
2315     $ctext tag conf msep -font textfontbold
2316     $ctext tag conf found -back yellow
2317
2318     .pwbottom add .bleft
2319     if {!$use_ttk} {
2320         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2321     }
2322
2323     # lower right
2324     ${NS}::frame .bright
2325     ${NS}::frame .bright.mode
2326     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2327         -command reselectline -variable cmitmode -value "patch"
2328     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2329         -command reselectline -variable cmitmode -value "tree"
2330     grid .bright.mode.patch .bright.mode.tree -sticky ew
2331     pack .bright.mode -side top -fill x
2332     set cflist .bright.cfiles
2333     set indent [font measure mainfont "nn"]
2334     text $cflist \
2335         -selectbackground $selectbgcolor \
2336         -background $bgcolor -foreground $fgcolor \
2337         -font mainfont \
2338         -tabs [list $indent [expr {2 * $indent}]] \
2339         -yscrollcommand ".bright.sb set" \
2340         -cursor [. cget -cursor] \
2341         -spacing1 1 -spacing3 1
2342     lappend bglist $cflist
2343     lappend fglist $cflist
2344     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2345     pack .bright.sb -side right -fill y
2346     pack $cflist -side left -fill both -expand 1
2347     $cflist tag configure highlight \
2348         -background [$cflist cget -selectbackground]
2349     $cflist tag configure bold -font mainfontbold
2350
2351     .pwbottom add .bright
2352     .ctop add .pwbottom
2353
2354     # restore window width & height if known
2355     if {[info exists geometry(main)]} {
2356         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2357             if {$w > [winfo screenwidth .]} {
2358                 set w [winfo screenwidth .]
2359             }
2360             if {$h > [winfo screenheight .]} {
2361                 set h [winfo screenheight .]
2362             }
2363             wm geometry . "${w}x$h"
2364         }
2365     }
2366
2367     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2368         wm state . $geometry(state)
2369     }
2370
2371     if {[tk windowingsystem] eq {aqua}} {
2372         set M1B M1
2373         set ::BM "3"
2374     } else {
2375         set M1B Control
2376         set ::BM "2"
2377     }
2378
2379     if {$use_ttk} {
2380         bind .ctop <Map> {
2381             bind %W <Map> {}
2382             %W sashpos 0 $::geometry(topheight)
2383         }
2384         bind .pwbottom <Map> {
2385             bind %W <Map> {}
2386             %W sashpos 0 $::geometry(botwidth)
2387         }
2388     }
2389
2390     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2391     pack .ctop -fill both -expand 1
2392     bindall <1> {selcanvline %W %x %y}
2393     #bindall <B1-Motion> {selcanvline %W %x %y}
2394     if {[tk windowingsystem] == "win32"} {
2395         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2396         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2397     } else {
2398         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2399         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2400         if {[tk windowingsystem] eq "aqua"} {
2401             bindall <MouseWheel> {
2402                 set delta [expr {- (%D)}]
2403                 allcanvs yview scroll $delta units
2404             }
2405             bindall <Shift-MouseWheel> {
2406                 set delta [expr {- (%D)}]
2407                 $canv xview scroll $delta units
2408             }
2409         }
2410     }
2411     bindall <$::BM> "canvscan mark %W %x %y"
2412     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2413     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2414     bind . <$M1B-Key-w> doquit
2415     bindkey <Home> selfirstline
2416     bindkey <End> sellastline
2417     bind . <Key-Up> "selnextline -1"
2418     bind . <Key-Down> "selnextline 1"
2419     bind . <Shift-Key-Up> "dofind -1 0"
2420     bind . <Shift-Key-Down> "dofind 1 0"
2421     bindkey <Key-Right> "goforw"
2422     bindkey <Key-Left> "goback"
2423     bind . <Key-Prior> "selnextpage -1"
2424     bind . <Key-Next> "selnextpage 1"
2425     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2426     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2427     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2428     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2429     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2430     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2431     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2432     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2433     bindkey <Key-space> "$ctext yview scroll 1 pages"
2434     bindkey p "selnextline -1"
2435     bindkey n "selnextline 1"
2436     bindkey z "goback"
2437     bindkey x "goforw"
2438     bindkey i "selnextline -1"
2439     bindkey k "selnextline 1"
2440     bindkey j "goback"
2441     bindkey l "goforw"
2442     bindkey b prevfile
2443     bindkey d "$ctext yview scroll 18 units"
2444     bindkey u "$ctext yview scroll -18 units"
2445     bindkey / {focus $fstring}
2446     bindkey <Key-KP_Divide> {focus $fstring}
2447     bindkey <Key-Return> {dofind 1 1}
2448     bindkey ? {dofind -1 1}
2449     bindkey f nextfile
2450     bind . <F5> updatecommits
2451     bind . <$M1B-F5> reloadcommits
2452     bind . <F2> showrefs
2453     bind . <Shift-F4> {newview 0}
2454     catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2455     bind . <F4> edit_or_newview
2456     bind . <$M1B-q> doquit
2457     bind . <$M1B-f> {dofind 1 1}
2458     bind . <$M1B-g> {dofind 1 0}
2459     bind . <$M1B-r> dosearchback
2460     bind . <$M1B-s> dosearch
2461     bind . <$M1B-equal> {incrfont 1}
2462     bind . <$M1B-plus> {incrfont 1}
2463     bind . <$M1B-KP_Add> {incrfont 1}
2464     bind . <$M1B-minus> {incrfont -1}
2465     bind . <$M1B-KP_Subtract> {incrfont -1}
2466     wm protocol . WM_DELETE_WINDOW doquit
2467     bind . <Destroy> {stop_backends}
2468     bind . <Button-1> "click %W"
2469     bind $fstring <Key-Return> {dofind 1 1}
2470     bind $sha1entry <Key-Return> {gotocommit; break}
2471     bind $sha1entry <<PasteSelection>> clearsha1
2472     bind $cflist <1> {sel_flist %W %x %y; break}
2473     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2474     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2475     global ctxbut
2476     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2477     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2478     bind $ctext <Button-1> {focus %W}
2479
2480     set maincursor [. cget -cursor]
2481     set textcursor [$ctext cget -cursor]
2482     set curtextcursor $textcursor
2483
2484     set rowctxmenu .rowctxmenu
2485     makemenu $rowctxmenu {
2486         {mc "Diff this -> selected" command {diffvssel 0}}
2487         {mc "Diff selected -> this" command {diffvssel 1}}
2488         {mc "Make patch" command mkpatch}
2489         {mc "Create tag" command mktag}
2490         {mc "Write commit to file" command writecommit}
2491         {mc "Create new branch" command mkbranch}
2492         {mc "Cherry-pick this commit" command cherrypick}
2493         {mc "Reset HEAD branch to here" command resethead}
2494         {mc "Mark this commit" command markhere}
2495         {mc "Return to mark" command gotomark}
2496         {mc "Find descendant of this and mark" command find_common_desc}
2497         {mc "Compare with marked commit" command compare_commits}
2498     }
2499     $rowctxmenu configure -tearoff 0
2500
2501     set fakerowmenu .fakerowmenu
2502     makemenu $fakerowmenu {
2503         {mc "Diff this -> selected" command {diffvssel 0}}
2504         {mc "Diff selected -> this" command {diffvssel 1}}
2505         {mc "Make patch" command mkpatch}
2506     }
2507     $fakerowmenu configure -tearoff 0
2508
2509     set headctxmenu .headctxmenu
2510     makemenu $headctxmenu {
2511         {mc "Check out this branch" command cobranch}
2512         {mc "Remove this branch" command rmbranch}
2513     }
2514     $headctxmenu configure -tearoff 0
2515
2516     global flist_menu
2517     set flist_menu .flistctxmenu
2518     makemenu $flist_menu {
2519         {mc "Highlight this too" command {flist_hl 0}}
2520         {mc "Highlight this only" command {flist_hl 1}}
2521         {mc "External diff" command {external_diff}}
2522         {mc "Blame parent commit" command {external_blame 1}}
2523     }
2524     $flist_menu configure -tearoff 0
2525
2526     global diff_menu
2527     set diff_menu .diffctxmenu
2528     makemenu $diff_menu {
2529         {mc "Show origin of this line" command show_line_source}
2530         {mc "Run git gui blame on this line" command {external_blame_diff}}
2531     }
2532     $diff_menu configure -tearoff 0
2533 }
2534
2535 # Windows sends all mouse wheel events to the current focused window, not
2536 # the one where the mouse hovers, so bind those events here and redirect
2537 # to the correct window
2538 proc windows_mousewheel_redirector {W X Y D} {
2539     global canv canv2 canv3
2540     set w [winfo containing -displayof $W $X $Y]
2541     if {$w ne ""} {
2542         set u [expr {$D < 0 ? 5 : -5}]
2543         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2544             allcanvs yview scroll $u units
2545         } else {
2546             catch {
2547                 $w yview scroll $u units
2548             }
2549         }
2550     }
2551 }
2552
2553 # Update row number label when selectedline changes
2554 proc selectedline_change {n1 n2 op} {
2555     global selectedline rownumsel
2556
2557     if {$selectedline eq {}} {
2558         set rownumsel {}
2559     } else {
2560         set rownumsel [expr {$selectedline + 1}]
2561     }
2562 }
2563
2564 # mouse-2 makes all windows scan vertically, but only the one
2565 # the cursor is in scans horizontally
2566 proc canvscan {op w x y} {
2567     global canv canv2 canv3
2568     foreach c [list $canv $canv2 $canv3] {
2569         if {$c == $w} {
2570             $c scan $op $x $y
2571         } else {
2572             $c scan $op 0 $y
2573         }
2574     }
2575 }
2576
2577 proc scrollcanv {cscroll f0 f1} {
2578     $cscroll set $f0 $f1
2579     drawvisible
2580     flushhighlights
2581 }
2582
2583 # when we make a key binding for the toplevel, make sure
2584 # it doesn't get triggered when that key is pressed in the
2585 # find string entry widget.
2586 proc bindkey {ev script} {
2587     global entries
2588     bind . $ev $script
2589     set escript [bind Entry $ev]
2590     if {$escript == {}} {
2591         set escript [bind Entry <Key>]
2592     }
2593     foreach e $entries {
2594         bind $e $ev "$escript; break"
2595     }
2596 }
2597
2598 # set the focus back to the toplevel for any click outside
2599 # the entry widgets
2600 proc click {w} {
2601     global ctext entries
2602     foreach e [concat $entries $ctext] {
2603         if {$w == $e} return
2604     }
2605     focus .
2606 }
2607
2608 # Adjust the progress bar for a change in requested extent or canvas size
2609 proc adjustprogress {} {
2610     global progresscanv progressitem progresscoords
2611     global fprogitem fprogcoord lastprogupdate progupdatepending
2612     global rprogitem rprogcoord use_ttk
2613
2614     if {$use_ttk} {
2615         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2616         return
2617     }
2618
2619     set w [expr {[winfo width $progresscanv] - 4}]
2620     set x0 [expr {$w * [lindex $progresscoords 0]}]
2621     set x1 [expr {$w * [lindex $progresscoords 1]}]
2622     set h [winfo height $progresscanv]
2623     $progresscanv coords $progressitem $x0 0 $x1 $h
2624     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2625     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2626     set now [clock clicks -milliseconds]
2627     if {$now >= $lastprogupdate + 100} {
2628         set progupdatepending 0
2629         update
2630     } elseif {!$progupdatepending} {
2631         set progupdatepending 1
2632         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2633     }
2634 }
2635
2636 proc doprogupdate {} {
2637     global lastprogupdate progupdatepending
2638
2639     if {$progupdatepending} {
2640         set progupdatepending 0
2641         set lastprogupdate [clock clicks -milliseconds]
2642         update
2643     }
2644 }
2645
2646 proc savestuff {w} {
2647     global canv canv2 canv3 mainfont textfont uifont tabstop
2648     global stuffsaved findmergefiles maxgraphpct
2649     global maxwidth showneartags showlocalchanges
2650     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2651     global cmitmode wrapcomment datetimeformat limitdiffs
2652     global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2653     global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2654     global hideremotes want_ttk
2655
2656     if {$stuffsaved} return
2657     if {![winfo viewable .]} return
2658     catch {
2659         if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2660         set f [open "~/.gitk-new" w]
2661         if {$::tcl_platform(platform) eq {windows}} {
2662             file attributes "~/.gitk-new" -hidden true
2663         }
2664         puts $f [list set mainfont $mainfont]
2665         puts $f [list set textfont $textfont]
2666         puts $f [list set uifont $uifont]
2667         puts $f [list set tabstop $tabstop]
2668         puts $f [list set findmergefiles $findmergefiles]
2669         puts $f [list set maxgraphpct $maxgraphpct]
2670         puts $f [list set maxwidth $maxwidth]
2671         puts $f [list set cmitmode $cmitmode]
2672         puts $f [list set wrapcomment $wrapcomment]
2673         puts $f [list set autoselect $autoselect]
2674         puts $f [list set autosellen $autosellen]
2675         puts $f [list set showneartags $showneartags]
2676         puts $f [list set hideremotes $hideremotes]
2677         puts $f [list set showlocalchanges $showlocalchanges]
2678         puts $f [list set datetimeformat $datetimeformat]
2679         puts $f [list set limitdiffs $limitdiffs]
2680         puts $f [list set uicolor $uicolor]
2681         puts $f [list set want_ttk $want_ttk]
2682         puts $f [list set bgcolor $bgcolor]
2683         puts $f [list set fgcolor $fgcolor]
2684         puts $f [list set colors $colors]
2685         puts $f [list set diffcolors $diffcolors]
2686         puts $f [list set markbgcolor $markbgcolor]
2687         puts $f [list set diffcontext $diffcontext]
2688         puts $f [list set selectbgcolor $selectbgcolor]
2689         puts $f [list set extdifftool $extdifftool]
2690         puts $f [list set perfile_attrs $perfile_attrs]
2691
2692         puts $f "set geometry(main) [wm geometry .]"
2693         puts $f "set geometry(state) [wm state .]"
2694         puts $f "set geometry(topwidth) [winfo width .tf]"
2695         puts $f "set geometry(topheight) [winfo height .tf]"
2696         if {$use_ttk} {
2697             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2698             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2699         } else {
2700             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2701             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2702         }
2703         puts $f "set geometry(botwidth) [winfo width .bleft]"
2704         puts $f "set geometry(botheight) [winfo height .bleft]"
2705
2706         puts -nonewline $f "set permviews {"
2707         for {set v 0} {$v < $nextviewnum} {incr v} {
2708             if {$viewperm($v)} {
2709                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2710             }
2711         }
2712         puts $f "}"
2713         close $f
2714         file rename -force "~/.gitk-new" "~/.gitk"
2715     }
2716     set stuffsaved 1
2717 }
2718
2719 proc resizeclistpanes {win w} {
2720     global oldwidth use_ttk
2721     if {[info exists oldwidth($win)]} {
2722         if {$use_ttk} {
2723             set s0 [$win sashpos 0]
2724             set s1 [$win sashpos 1]
2725         } else {
2726             set s0 [$win sash coord 0]
2727             set s1 [$win sash coord 1]
2728         }
2729         if {$w < 60} {
2730             set sash0 [expr {int($w/2 - 2)}]
2731             set sash1 [expr {int($w*5/6 - 2)}]
2732         } else {
2733             set factor [expr {1.0 * $w / $oldwidth($win)}]
2734             set sash0 [expr {int($factor * [lindex $s0 0])}]
2735             set sash1 [expr {int($factor * [lindex $s1 0])}]
2736             if {$sash0 < 30} {
2737                 set sash0 30
2738             }
2739             if {$sash1 < $sash0 + 20} {
2740                 set sash1 [expr {$sash0 + 20}]
2741             }
2742             if {$sash1 > $w - 10} {
2743                 set sash1 [expr {$w - 10}]
2744                 if {$sash0 > $sash1 - 20} {
2745                     set sash0 [expr {$sash1 - 20}]
2746                 }
2747             }
2748         }
2749         if {$use_ttk} {
2750             $win sashpos 0 $sash0
2751             $win sashpos 1 $sash1
2752         } else {
2753             $win sash place 0 $sash0 [lindex $s0 1]
2754             $win sash place 1 $sash1 [lindex $s1 1]
2755         }
2756     }
2757     set oldwidth($win) $w
2758 }
2759
2760 proc resizecdetpanes {win w} {
2761     global oldwidth use_ttk
2762     if {[info exists oldwidth($win)]} {
2763         if {$use_ttk} {
2764             set s0 [$win sashpos 0]
2765         } else {
2766             set s0 [$win sash coord 0]
2767         }
2768         if {$w < 60} {
2769             set sash0 [expr {int($w*3/4 - 2)}]
2770         } else {
2771             set factor [expr {1.0 * $w / $oldwidth($win)}]
2772             set sash0 [expr {int($factor * [lindex $s0 0])}]
2773             if {$sash0 < 45} {
2774                 set sash0 45
2775             }
2776             if {$sash0 > $w - 15} {
2777                 set sash0 [expr {$w - 15}]
2778             }
2779         }
2780         if {$use_ttk} {
2781             $win sashpos 0 $sash0
2782         } else {
2783             $win sash place 0 $sash0 [lindex $s0 1]
2784         }
2785     }
2786     set oldwidth($win) $w
2787 }
2788
2789 proc allcanvs args {
2790     global canv canv2 canv3
2791     eval $canv $args
2792     eval $canv2 $args
2793     eval $canv3 $args
2794 }
2795
2796 proc bindall {event action} {
2797     global canv canv2 canv3
2798     bind $canv $event $action
2799     bind $canv2 $event $action
2800     bind $canv3 $event $action
2801 }
2802
2803 proc about {} {
2804     global uifont NS
2805     set w .about
2806     if {[winfo exists $w]} {
2807         raise $w
2808         return
2809     }
2810     ttk_toplevel $w
2811     wm title $w [mc "About gitk"]
2812     make_transient $w .
2813     message $w.m -text [mc "
2814 Gitk - a commit viewer for git
2815
2816 Copyright \u00a9 2005-2011 Paul Mackerras
2817
2818 Use and redistribute under the terms of the GNU General Public License"] \
2819             -justify center -aspect 400 -border 2 -bg white -relief groove
2820     pack $w.m -side top -fill x -padx 2 -pady 2
2821     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2822     pack $w.ok -side bottom
2823     bind $w <Visibility> "focus $w.ok"
2824     bind $w <Key-Escape> "destroy $w"
2825     bind $w <Key-Return> "destroy $w"
2826     tk::PlaceWindow $w widget .
2827 }
2828
2829 proc keys {} {
2830     global NS
2831     set w .keys
2832     if {[winfo exists $w]} {
2833         raise $w
2834         return
2835     }
2836     if {[tk windowingsystem] eq {aqua}} {
2837         set M1T Cmd
2838     } else {
2839         set M1T Ctrl
2840     }
2841     ttk_toplevel $w
2842     wm title $w [mc "Gitk key bindings"]
2843     make_transient $w .
2844     message $w.m -text "
2845 [mc "Gitk key bindings:"]
2846
2847 [mc "<%s-Q>             Quit" $M1T]
2848 [mc "<%s-W>             Close window" $M1T]
2849 [mc "<Home>             Move to first commit"]
2850 [mc "<End>              Move to last commit"]
2851 [mc "<Up>, p, i Move up one commit"]
2852 [mc "<Down>, n, k       Move down one commit"]
2853 [mc "<Left>, z, j       Go back in history list"]
2854 [mc "<Right>, x, l      Go forward in history list"]
2855 [mc "<PageUp>   Move up one page in commit list"]
2856 [mc "<PageDown> Move down one page in commit list"]
2857 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2858 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2859 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2860 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2861 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2862 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2863 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2864 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2865 [mc "<Delete>, b        Scroll diff view up one page"]
2866 [mc "<Backspace>        Scroll diff view up one page"]
2867 [mc "<Space>            Scroll diff view down one page"]
2868 [mc "u          Scroll diff view up 18 lines"]
2869 [mc "d          Scroll diff view down 18 lines"]
2870 [mc "<%s-F>             Find" $M1T]
2871 [mc "<%s-G>             Move to next find hit" $M1T]
2872 [mc "<Return>   Move to next find hit"]
2873 [mc "/          Focus the search box"]
2874 [mc "?          Move to previous find hit"]
2875 [mc "f          Scroll diff view to next file"]
2876 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2877 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2878 [mc "<%s-KP+>   Increase font size" $M1T]
2879 [mc "<%s-plus>  Increase font size" $M1T]
2880 [mc "<%s-KP->   Decrease font size" $M1T]
2881 [mc "<%s-minus> Decrease font size" $M1T]
2882 [mc "<F5>               Update"]
2883 " \
2884             -justify left -bg white -border 2 -relief groove
2885     pack $w.m -side top -fill both -padx 2 -pady 2
2886     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2887     bind $w <Key-Escape> [list destroy $w]
2888     pack $w.ok -side bottom
2889     bind $w <Visibility> "focus $w.ok"
2890     bind $w <Key-Escape> "destroy $w"
2891     bind $w <Key-Return> "destroy $w"
2892 }
2893
2894 # Procedures for manipulating the file list window at the
2895 # bottom right of the overall window.
2896
2897 proc treeview {w l openlevs} {
2898     global treecontents treediropen treeheight treeparent treeindex
2899
2900     set ix 0
2901     set treeindex() 0
2902     set lev 0
2903     set prefix {}
2904     set prefixend -1
2905     set prefendstack {}
2906     set htstack {}
2907     set ht 0
2908     set treecontents() {}
2909     $w conf -state normal
2910     foreach f $l {
2911         while {[string range $f 0 $prefixend] ne $prefix} {
2912             if {$lev <= $openlevs} {
2913                 $w mark set e:$treeindex($prefix) "end -1c"
2914                 $w mark gravity e:$treeindex($prefix) left
2915             }
2916             set treeheight($prefix) $ht
2917             incr ht [lindex $htstack end]
2918             set htstack [lreplace $htstack end end]
2919             set prefixend [lindex $prefendstack end]
2920             set prefendstack [lreplace $prefendstack end end]
2921             set prefix [string range $prefix 0 $prefixend]
2922             incr lev -1
2923         }
2924         set tail [string range $f [expr {$prefixend+1}] end]
2925         while {[set slash [string first "/" $tail]] >= 0} {
2926             lappend htstack $ht
2927             set ht 0
2928             lappend prefendstack $prefixend
2929             incr prefixend [expr {$slash + 1}]
2930             set d [string range $tail 0 $slash]
2931             lappend treecontents($prefix) $d
2932             set oldprefix $prefix
2933             append prefix $d
2934             set treecontents($prefix) {}
2935             set treeindex($prefix) [incr ix]
2936             set treeparent($prefix) $oldprefix
2937             set tail [string range $tail [expr {$slash+1}] end]
2938             if {$lev <= $openlevs} {
2939                 set ht 1
2940                 set treediropen($prefix) [expr {$lev < $openlevs}]
2941                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2942                 $w mark set d:$ix "end -1c"
2943                 $w mark gravity d:$ix left
2944                 set str "\n"
2945                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2946                 $w insert end $str
2947                 $w image create end -align center -image $bm -padx 1 \
2948                     -name a:$ix
2949                 $w insert end $d [highlight_tag $prefix]
2950                 $w mark set s:$ix "end -1c"
2951                 $w mark gravity s:$ix left
2952             }
2953             incr lev
2954         }
2955         if {$tail ne {}} {
2956             if {$lev <= $openlevs} {
2957                 incr ht
2958                 set str "\n"
2959                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2960                 $w insert end $str
2961                 $w insert end $tail [highlight_tag $f]
2962             }
2963             lappend treecontents($prefix) $tail
2964         }
2965     }
2966     while {$htstack ne {}} {
2967         set treeheight($prefix) $ht
2968         incr ht [lindex $htstack end]
2969         set htstack [lreplace $htstack end end]
2970         set prefixend [lindex $prefendstack end]
2971         set prefendstack [lreplace $prefendstack end end]
2972         set prefix [string range $prefix 0 $prefixend]
2973     }
2974     $w conf -state disabled
2975 }
2976
2977 proc linetoelt {l} {
2978     global treeheight treecontents
2979
2980     set y 2
2981     set prefix {}
2982     while {1} {
2983         foreach e $treecontents($prefix) {
2984             if {$y == $l} {
2985                 return "$prefix$e"
2986             }
2987             set n 1
2988             if {[string index $e end] eq "/"} {
2989                 set n $treeheight($prefix$e)
2990                 if {$y + $n > $l} {
2991                     append prefix $e
2992                     incr y
2993                     break
2994                 }
2995             }
2996             incr y $n
2997         }
2998     }
2999 }
3000
3001 proc highlight_tree {y prefix} {
3002     global treeheight treecontents cflist
3003
3004     foreach e $treecontents($prefix) {
3005         set path $prefix$e
3006         if {[highlight_tag $path] ne {}} {
3007             $cflist tag add bold $y.0 "$y.0 lineend"
3008         }
3009         incr y
3010         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3011             set y [highlight_tree $y $path]
3012         }
3013     }
3014     return $y
3015 }
3016
3017 proc treeclosedir {w dir} {
3018     global treediropen treeheight treeparent treeindex
3019
3020     set ix $treeindex($dir)
3021     $w conf -state normal
3022     $w delete s:$ix e:$ix
3023     set treediropen($dir) 0
3024     $w image configure a:$ix -image tri-rt
3025     $w conf -state disabled
3026     set n [expr {1 - $treeheight($dir)}]
3027     while {$dir ne {}} {
3028         incr treeheight($dir) $n
3029         set dir $treeparent($dir)
3030     }
3031 }
3032
3033 proc treeopendir {w dir} {
3034     global treediropen treeheight treeparent treecontents treeindex
3035
3036     set ix $treeindex($dir)
3037     $w conf -state normal
3038     $w image configure a:$ix -image tri-dn
3039     $w mark set e:$ix s:$ix
3040     $w mark gravity e:$ix right
3041     set lev 0
3042     set str "\n"
3043     set n [llength $treecontents($dir)]
3044     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3045         incr lev
3046         append str "\t"
3047         incr treeheight($x) $n
3048     }
3049     foreach e $treecontents($dir) {
3050         set de $dir$e
3051         if {[string index $e end] eq "/"} {
3052             set iy $treeindex($de)
3053             $w mark set d:$iy e:$ix
3054             $w mark gravity d:$iy left
3055             $w insert e:$ix $str
3056             set treediropen($de) 0
3057             $w image create e:$ix -align center -image tri-rt -padx 1 \
3058                 -name a:$iy
3059             $w insert e:$ix $e [highlight_tag $de]
3060             $w mark set s:$iy e:$ix
3061             $w mark gravity s:$iy left
3062             set treeheight($de) 1
3063         } else {
3064             $w insert e:$ix $str
3065             $w insert e:$ix $e [highlight_tag $de]
3066         }
3067     }
3068     $w mark gravity e:$ix right
3069     $w conf -state disabled
3070     set treediropen($dir) 1
3071     set top [lindex [split [$w index @0,0] .] 0]
3072     set ht [$w cget -height]
3073     set l [lindex [split [$w index s:$ix] .] 0]
3074     if {$l < $top} {
3075         $w yview $l.0
3076     } elseif {$l + $n + 1 > $top + $ht} {
3077         set top [expr {$l + $n + 2 - $ht}]
3078         if {$l < $top} {
3079             set top $l
3080         }
3081         $w yview $top.0
3082     }
3083 }
3084
3085 proc treeclick {w x y} {
3086     global treediropen cmitmode ctext cflist cflist_top
3087
3088     if {$cmitmode ne "tree"} return
3089     if {![info exists cflist_top]} return
3090     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3091     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3092     $cflist tag add highlight $l.0 "$l.0 lineend"
3093     set cflist_top $l
3094     if {$l == 1} {
3095         $ctext yview 1.0
3096         return
3097     }
3098     set e [linetoelt $l]
3099     if {[string index $e end] ne "/"} {
3100         showfile $e
3101     } elseif {$treediropen($e)} {
3102         treeclosedir $w $e
3103     } else {
3104         treeopendir $w $e
3105     }
3106 }
3107
3108 proc setfilelist {id} {
3109     global treefilelist cflist jump_to_here
3110
3111     treeview $cflist $treefilelist($id) 0
3112     if {$jump_to_here ne {}} {
3113         set f [lindex $jump_to_here 0]
3114         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3115             showfile $f
3116         }
3117     }
3118 }
3119
3120 image create bitmap tri-rt -background black -foreground blue -data {
3121     #define tri-rt_width 13
3122     #define tri-rt_height 13
3123     static unsigned char tri-rt_bits[] = {
3124        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3125        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3126        0x00, 0x00};
3127 } -maskdata {
3128     #define tri-rt-mask_width 13
3129     #define tri-rt-mask_height 13
3130     static unsigned char tri-rt-mask_bits[] = {
3131        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3132        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3133        0x08, 0x00};
3134 }
3135 image create bitmap tri-dn -background black -foreground blue -data {
3136     #define tri-dn_width 13
3137     #define tri-dn_height 13
3138     static unsigned char tri-dn_bits[] = {
3139        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3140        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3141        0x00, 0x00};
3142 } -maskdata {
3143     #define tri-dn-mask_width 13
3144     #define tri-dn-mask_height 13
3145     static unsigned char tri-dn-mask_bits[] = {
3146        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3147        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3148        0x00, 0x00};
3149 }
3150
3151 image create bitmap reficon-T -background black -foreground yellow -data {
3152     #define tagicon_width 13
3153     #define tagicon_height 9
3154     static unsigned char tagicon_bits[] = {
3155        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3156        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3157 } -maskdata {
3158     #define tagicon-mask_width 13
3159     #define tagicon-mask_height 9
3160     static unsigned char tagicon-mask_bits[] = {
3161        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3162        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3163 }
3164 set rectdata {
3165     #define headicon_width 13
3166     #define headicon_height 9
3167     static unsigned char headicon_bits[] = {
3168        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3169        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3170 }
3171 set rectmask {
3172     #define headicon-mask_width 13
3173     #define headicon-mask_height 9
3174     static unsigned char headicon-mask_bits[] = {
3175        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3176        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3177 }
3178 image create bitmap reficon-H -background black -foreground green \
3179     -data $rectdata -maskdata $rectmask
3180 image create bitmap reficon-o -background black -foreground "#ddddff" \
3181     -data $rectdata -maskdata $rectmask
3182
3183 proc init_flist {first} {
3184     global cflist cflist_top difffilestart
3185
3186     $cflist conf -state normal
3187     $cflist delete 0.0 end
3188     if {$first ne {}} {
3189         $cflist insert end $first
3190         set cflist_top 1
3191         $cflist tag add highlight 1.0 "1.0 lineend"
3192     } else {
3193         catch {unset cflist_top}
3194     }
3195     $cflist conf -state disabled
3196     set difffilestart {}
3197 }
3198
3199 proc highlight_tag {f} {
3200     global highlight_paths
3201
3202     foreach p $highlight_paths {
3203         if {[string match $p $f]} {
3204             return "bold"
3205         }
3206     }
3207     return {}
3208 }
3209
3210 proc highlight_filelist {} {
3211     global cmitmode cflist
3212
3213     $cflist conf -state normal
3214     if {$cmitmode ne "tree"} {
3215         set end [lindex [split [$cflist index end] .] 0]
3216         for {set l 2} {$l < $end} {incr l} {
3217             set line [$cflist get $l.0 "$l.0 lineend"]
3218             if {[highlight_tag $line] ne {}} {
3219                 $cflist tag add bold $l.0 "$l.0 lineend"
3220             }
3221         }
3222     } else {
3223         highlight_tree 2 {}
3224     }
3225     $cflist conf -state disabled
3226 }
3227
3228 proc unhighlight_filelist {} {
3229     global cflist
3230
3231     $cflist conf -state normal
3232     $cflist tag remove bold 1.0 end
3233     $cflist conf -state disabled
3234 }
3235
3236 proc add_flist {fl} {
3237     global cflist
3238
3239     $cflist conf -state normal
3240     foreach f $fl {
3241         $cflist insert end "\n"
3242         $cflist insert end $f [highlight_tag $f]
3243     }
3244     $cflist conf -state disabled
3245 }
3246
3247 proc sel_flist {w x y} {
3248     global ctext difffilestart cflist cflist_top cmitmode
3249
3250     if {$cmitmode eq "tree"} return
3251     if {![info exists cflist_top]} return
3252     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3253     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3254     $cflist tag add highlight $l.0 "$l.0 lineend"
3255     set cflist_top $l
3256     if {$l == 1} {
3257         $ctext yview 1.0
3258     } else {
3259         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3260     }
3261 }
3262
3263 proc pop_flist_menu {w X Y x y} {
3264     global ctext cflist cmitmode flist_menu flist_menu_file
3265     global treediffs diffids
3266
3267     stopfinding
3268     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3269     if {$l <= 1} return
3270     if {$cmitmode eq "tree"} {
3271         set e [linetoelt $l]
3272         if {[string index $e end] eq "/"} return
3273     } else {
3274         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3275     }
3276     set flist_menu_file $e
3277     set xdiffstate "normal"
3278     if {$cmitmode eq "tree"} {
3279         set xdiffstate "disabled"
3280     }
3281     # Disable "External diff" item in tree mode
3282     $flist_menu entryconf 2 -state $xdiffstate
3283     tk_popup $flist_menu $X $Y
3284 }
3285
3286 proc find_ctext_fileinfo {line} {
3287     global ctext_file_names ctext_file_lines
3288
3289     set ok [bsearch $ctext_file_lines $line]
3290     set tline [lindex $ctext_file_lines $ok]
3291
3292     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3293         return {}
3294     } else {
3295         return [list [lindex $ctext_file_names $ok] $tline]
3296     }
3297 }
3298
3299 proc pop_diff_menu {w X Y x y} {
3300     global ctext diff_menu flist_menu_file
3301     global diff_menu_txtpos diff_menu_line
3302     global diff_menu_filebase
3303
3304     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3305     set diff_menu_line [lindex $diff_menu_txtpos 0]
3306     # don't pop up the menu on hunk-separator or file-separator lines
3307     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3308         return
3309     }
3310     stopfinding
3311     set f [find_ctext_fileinfo $diff_menu_line]
3312     if {$f eq {}} return
3313     set flist_menu_file [lindex $f 0]
3314     set diff_menu_filebase [lindex $f 1]
3315     tk_popup $diff_menu $X $Y
3316 }
3317
3318 proc flist_hl {only} {
3319     global flist_menu_file findstring gdttype
3320
3321     set x [shellquote $flist_menu_file]
3322     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3323         set findstring $x
3324     } else {
3325         append findstring " " $x
3326     }
3327     set gdttype [mc "touching paths:"]
3328 }
3329
3330 proc gitknewtmpdir {} {
3331     global diffnum gitktmpdir gitdir
3332
3333     if {![info exists gitktmpdir]} {
3334         set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3335         if {[catch {file mkdir $gitktmpdir} err]} {
3336             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3337             unset gitktmpdir
3338             return {}
3339         }
3340         set diffnum 0
3341     }
3342     incr diffnum
3343     set diffdir [file join $gitktmpdir $diffnum]
3344     if {[catch {file mkdir $diffdir} err]} {
3345         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3346         return {}
3347     }
3348     return $diffdir
3349 }
3350
3351 proc save_file_from_commit {filename output what} {
3352     global nullfile
3353
3354     if {[catch {exec git show $filename -- > $output} err]} {
3355         if {[string match "fatal: bad revision *" $err]} {
3356             return $nullfile
3357         }
3358         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3359         return {}
3360     }
3361     return $output
3362 }
3363
3364 proc external_diff_get_one_file {diffid filename diffdir} {
3365     global nullid nullid2 nullfile
3366     global worktree
3367
3368     if {$diffid == $nullid} {
3369         set difffile [file join $worktree $filename]
3370         if {[file exists $difffile]} {
3371             return $difffile
3372         }
3373         return $nullfile
3374     }
3375     if {$diffid == $nullid2} {
3376         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3377         return [save_file_from_commit :$filename $difffile index]
3378     }
3379     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3380     return [save_file_from_commit $diffid:$filename $difffile \
3381                "revision $diffid"]
3382 }
3383
3384 proc external_diff {} {
3385     global nullid nullid2
3386     global flist_menu_file
3387     global diffids
3388     global extdifftool
3389
3390     if {[llength $diffids] == 1} {
3391         # no reference commit given
3392         set diffidto [lindex $diffids 0]
3393         if {$diffidto eq $nullid} {
3394             # diffing working copy with index
3395             set diffidfrom $nullid2
3396         } elseif {$diffidto eq $nullid2} {
3397             # diffing index with HEAD
3398             set diffidfrom "HEAD"
3399         } else {
3400             # use first parent commit
3401             global parentlist selectedline
3402             set diffidfrom [lindex $parentlist $selectedline 0]
3403         }
3404     } else {
3405         set diffidfrom [lindex $diffids 0]
3406         set diffidto [lindex $diffids 1]
3407     }
3408
3409     # make sure that several diffs wont collide
3410     set diffdir [gitknewtmpdir]
3411     if {$diffdir eq {}} return
3412
3413     # gather files to diff
3414     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3415     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3416
3417     if {$difffromfile ne {} && $difftofile ne {}} {
3418         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3419         if {[catch {set fl [open |$cmd r]} err]} {
3420             file delete -force $diffdir
3421             error_popup "$extdifftool: [mc "command failed:"] $err"
3422         } else {
3423             fconfigure $fl -blocking 0
3424             filerun $fl [list delete_at_eof $fl $diffdir]
3425         }
3426     }
3427 }
3428
3429 proc find_hunk_blamespec {base line} {
3430     global ctext
3431
3432     # Find and parse the hunk header
3433     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3434     if {$s_lix eq {}} return
3435
3436     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3437     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3438             s_line old_specs osz osz1 new_line nsz]} {
3439         return
3440     }
3441
3442     # base lines for the parents
3443     set base_lines [list $new_line]
3444     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3445         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3446                 old_spec old_line osz]} {
3447             return
3448         }
3449         lappend base_lines $old_line
3450     }
3451
3452     # Now scan the lines to determine offset within the hunk
3453     set max_parent [expr {[llength $base_lines]-2}]
3454     set dline 0
3455     set s_lno [lindex [split $s_lix "."] 0]
3456
3457     # Determine if the line is removed
3458     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3459     if {[string match {[-+ ]*} $chunk]} {
3460         set removed_idx [string first "-" $chunk]
3461         # Choose a parent index
3462         if {$removed_idx >= 0} {
3463             set parent $removed_idx
3464         } else {
3465             set unchanged_idx [string first " " $chunk]
3466             if {$unchanged_idx >= 0} {
3467                 set parent $unchanged_idx
3468             } else {
3469                 # blame the current commit
3470                 set parent -1
3471             }
3472         }
3473         # then count other lines that belong to it
3474         for {set i $line} {[incr i -1] > $s_lno} {} {
3475             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3476             # Determine if the line is removed
3477             set removed_idx [string first "-" $chunk]
3478             if {$parent >= 0} {
3479                 set code [string index $chunk $parent]
3480                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3481                     incr dline
3482                 }
3483             } else {
3484                 if {$removed_idx < 0} {
3485                     incr dline
3486                 }
3487             }
3488         }
3489         incr parent
3490     } else {
3491         set parent 0
3492     }
3493
3494     incr dline [lindex $base_lines $parent]
3495     return [list $parent $dline]
3496 }
3497
3498 proc external_blame_diff {} {
3499     global currentid cmitmode
3500     global diff_menu_txtpos diff_menu_line
3501     global diff_menu_filebase flist_menu_file
3502
3503     if {$cmitmode eq "tree"} {
3504         set parent_idx 0
3505         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3506     } else {
3507         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3508         if {$hinfo ne {}} {
3509             set parent_idx [lindex $hinfo 0]
3510             set line [lindex $hinfo 1]
3511         } else {
3512             set parent_idx 0
3513             set line 0
3514         }
3515     }
3516
3517     external_blame $parent_idx $line
3518 }
3519
3520 # Find the SHA1 ID of the blob for file $fname in the index
3521 # at stage 0 or 2
3522 proc index_sha1 {fname} {
3523     set f [open [list | git ls-files -s $fname] r]
3524     while {[gets $f line] >= 0} {
3525         set info [lindex [split $line "\t"] 0]
3526         set stage [lindex $info 2]
3527         if {$stage eq "0" || $stage eq "2"} {
3528             close $f
3529             return [lindex $info 1]
3530         }
3531     }
3532     close $f
3533     return {}
3534 }
3535
3536 # Turn an absolute path into one relative to the current directory
3537 proc make_relative {f} {
3538     if {[file pathtype $f] eq "relative"} {
3539         return $f
3540     }
3541     set elts [file split $f]
3542     set here [file split [pwd]]
3543     set ei 0
3544     set hi 0
3545     set res {}
3546     foreach d $here {
3547         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3548             lappend res ".."
3549         } else {
3550             incr ei
3551         }
3552         incr hi
3553     }
3554     set elts [concat $res [lrange $elts $ei end]]
3555     return [eval file join $elts]
3556 }
3557
3558 proc external_blame {parent_idx {line {}}} {
3559     global flist_menu_file cdup
3560     global nullid nullid2
3561     global parentlist selectedline currentid
3562
3563     if {$parent_idx > 0} {
3564         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3565     } else {
3566         set base_commit $currentid
3567     }
3568
3569     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3570         error_popup [mc "No such commit"]
3571         return
3572     }
3573
3574     set cmdline [list git gui blame]
3575     if {$line ne {} && $line > 1} {
3576         lappend cmdline "--line=$line"
3577     }
3578     set f [file join $cdup $flist_menu_file]
3579     # Unfortunately it seems git gui blame doesn't like
3580     # being given an absolute path...
3581     set f [make_relative $f]
3582     lappend cmdline $base_commit $f
3583     if {[catch {eval exec $cmdline &} err]} {
3584         error_popup "[mc "git gui blame: command failed:"] $err"
3585     }
3586 }
3587
3588 proc show_line_source {} {
3589     global cmitmode currentid parents curview blamestuff blameinst
3590     global diff_menu_line diff_menu_filebase flist_menu_file
3591     global nullid nullid2 gitdir cdup
3592
3593     set from_index {}
3594     if {$cmitmode eq "tree"} {
3595         set id $currentid
3596         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3597     } else {
3598         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3599         if {$h eq {}} return
3600         set pi [lindex $h 0]
3601         if {$pi == 0} {
3602             mark_ctext_line $diff_menu_line
3603             return
3604         }
3605         incr pi -1
3606         if {$currentid eq $nullid} {
3607             if {$pi > 0} {
3608                 # must be a merge in progress...
3609                 if {[catch {
3610                     # get the last line from .git/MERGE_HEAD
3611                     set f [open [file join $gitdir MERGE_HEAD] r]
3612                     set id [lindex [split [read $f] "\n"] end-1]
3613                     close $f
3614                 } err]} {
3615                     error_popup [mc "Couldn't read merge head: %s" $err]
3616                     return
3617                 }
3618             } elseif {$parents($curview,$currentid) eq $nullid2} {
3619                 # need to do the blame from the index
3620                 if {[catch {
3621                     set from_index [index_sha1 $flist_menu_file]
3622                 } err]} {
3623                     error_popup [mc "Error reading index: %s" $err]
3624                     return
3625                 }
3626             } else {
3627                 set id $parents($curview,$currentid)
3628             }
3629         } else {
3630             set id [lindex $parents($curview,$currentid) $pi]
3631         }
3632         set line [lindex $h 1]
3633     }
3634     set blameargs {}
3635     if {$from_index ne {}} {
3636         lappend blameargs | git cat-file blob $from_index
3637     }
3638     lappend blameargs | git blame -p -L$line,+1
3639     if {$from_index ne {}} {
3640         lappend blameargs --contents -
3641     } else {
3642         lappend blameargs $id
3643     }
3644     lappend blameargs -- [file join $cdup $flist_menu_file]
3645     if {[catch {
3646         set f [open $blameargs r]
3647     } err]} {
3648         error_popup [mc "Couldn't start git blame: %s" $err]
3649         return
3650     }
3651     nowbusy blaming [mc "Searching"]
3652     fconfigure $f -blocking 0
3653     set i [reg_instance $f]
3654     set blamestuff($i) {}
3655     set blameinst $i
3656     filerun $f [list read_line_source $f $i]
3657 }
3658
3659 proc stopblaming {} {
3660     global blameinst
3661
3662     if {[info exists blameinst]} {
3663         stop_instance $blameinst
3664         unset blameinst
3665         notbusy blaming
3666     }
3667 }
3668
3669 proc read_line_source {fd inst} {
3670     global blamestuff curview commfd blameinst nullid nullid2
3671
3672     while {[gets $fd line] >= 0} {
3673         lappend blamestuff($inst) $line
3674     }
3675     if {![eof $fd]} {
3676         return 1
3677     }
3678     unset commfd($inst)
3679     unset blameinst
3680     notbusy blaming
3681     fconfigure $fd -blocking 1
3682     if {[catch {close $fd} err]} {
3683         error_popup [mc "Error running git blame: %s" $err]
3684         return 0
3685     }
3686
3687     set fname {}
3688     set line [split [lindex $blamestuff($inst) 0] " "]
3689     set id [lindex $line 0]
3690     set lnum [lindex $line 1]
3691     if {[string length $id] == 40 && [string is xdigit $id] &&
3692         [string is digit -strict $lnum]} {
3693         # look for "filename" line
3694         foreach l $blamestuff($inst) {
3695             if {[string match "filename *" $l]} {
3696                 set fname [string range $l 9 end]
3697                 break
3698             }
3699         }
3700     }
3701     if {$fname ne {}} {
3702         # all looks good, select it
3703         if {$id eq $nullid} {
3704             # blame uses all-zeroes to mean not committed,
3705             # which would mean a change in the index
3706             set id $nullid2
3707         }
3708         if {[commitinview $id $curview]} {
3709             selectline [rowofcommit $id] 1 [list $fname $lnum]
3710         } else {
3711             error_popup [mc "That line comes from commit %s, \
3712                              which is not in this view" [shortids $id]]
3713         }
3714     } else {
3715         puts "oops couldn't parse git blame output"
3716     }
3717     return 0
3718 }
3719
3720 # delete $dir when we see eof on $f (presumably because the child has exited)
3721 proc delete_at_eof {f dir} {
3722     while {[gets $f line] >= 0} {}
3723     if {[eof $f]} {
3724         if {[catch {close $f} err]} {
3725             error_popup "[mc "External diff viewer failed:"] $err"
3726         }
3727         file delete -force $dir
3728         return 0
3729     }
3730     return 1
3731 }
3732
3733 # Functions for adding and removing shell-type quoting
3734
3735 proc shellquote {str} {
3736     if {![string match "*\['\"\\ \t]*" $str]} {
3737         return $str
3738     }
3739     if {![string match "*\['\"\\]*" $str]} {
3740         return "\"$str\""
3741     }
3742     if {![string match "*'*" $str]} {
3743         return "'$str'"
3744     }
3745     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3746 }
3747
3748 proc shellarglist {l} {
3749     set str {}
3750     foreach a $l {
3751         if {$str ne {}} {
3752             append str " "
3753         }
3754         append str [shellquote $a]
3755     }
3756     return $str
3757 }
3758
3759 proc shelldequote {str} {
3760     set ret {}
3761     set used -1
3762     while {1} {
3763         incr used
3764         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3765             append ret [string range $str $used end]
3766             set used [string length $str]
3767             break
3768         }
3769         set first [lindex $first 0]
3770         set ch [string index $str $first]
3771         if {$first > $used} {
3772             append ret [string range $str $used [expr {$first - 1}]]
3773             set used $first
3774         }
3775         if {$ch eq " " || $ch eq "\t"} break
3776         incr used
3777         if {$ch eq "'"} {
3778             set first [string first "'" $str $used]
3779             if {$first < 0} {
3780                 error "unmatched single-quote"
3781             }
3782             append ret [string range $str $used [expr {$first - 1}]]
3783             set used $first
3784             continue
3785         }
3786         if {$ch eq "\\"} {
3787             if {$used >= [string length $str]} {
3788                 error "trailing backslash"
3789             }
3790             append ret [string index $str $used]
3791             continue
3792         }
3793         # here ch == "\""
3794         while {1} {
3795             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3796                 error "unmatched double-quote"
3797             }
3798             set first [lindex $first 0]
3799             set ch [string index $str $first]
3800             if {$first > $used} {
3801                 append ret [string range $str $used [expr {$first - 1}]]
3802                 set used $first
3803             }
3804             if {$ch eq "\""} break
3805             incr used
3806             append ret [string index $str $used]
3807             incr used
3808         }
3809     }
3810     return [list $used $ret]
3811 }
3812
3813 proc shellsplit {str} {
3814     set l {}
3815     while {1} {
3816         set str [string trimleft $str]
3817         if {$str eq {}} break
3818         set dq [shelldequote $str]
3819         set n [lindex $dq 0]
3820         set word [lindex $dq 1]
3821         set str [string range $str $n end]
3822         lappend l $word
3823     }
3824     return $l
3825 }
3826
3827 # Code to implement multiple views
3828
3829 proc newview {ishighlight} {
3830     global nextviewnum newviewname newishighlight
3831     global revtreeargs viewargscmd newviewopts curview
3832
3833     set newishighlight $ishighlight
3834     set top .gitkview
3835     if {[winfo exists $top]} {
3836         raise $top
3837         return
3838     }
3839     decode_view_opts $nextviewnum $revtreeargs
3840     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3841     set newviewopts($nextviewnum,perm) 0
3842     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3843     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3844 }
3845
3846 set known_view_options {
3847     {perm      b    .  {}               {mc "Remember this view"}}
3848     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3849     {refs      t15  .. {}               {mc "Branches & tags:"}}
3850     {allrefs   b    *. "--all"          {mc "All refs"}}
3851     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3852     {tags      b    .  "--tags"         {mc "All tags"}}
3853     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3854     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3855     {author    t15  .. "--author=*"     {mc "Author:"}}
3856     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3857     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3858     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3859     {changes_l l    +  {}               {mc "Changes to Files:"}}
3860     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3861     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3862     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3863     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3864     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3865     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3866     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3867     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3868     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3869     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3870     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3871     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3872     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
3873     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
3874     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
3875     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
3876     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
3877     }
3878
3879 # Convert $newviewopts($n, ...) into args for git log.
3880 proc encode_view_opts {n} {
3881     global known_view_options newviewopts
3882
3883     set rargs [list]
3884     foreach opt $known_view_options {
3885         set patterns [lindex $opt 3]
3886         if {$patterns eq {}} continue
3887         set pattern [lindex $patterns 0]
3888
3889         if {[lindex $opt 1] eq "b"} {
3890             set val $newviewopts($n,[lindex $opt 0])
3891             if {$val} {
3892                 lappend rargs $pattern
3893             }
3894         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3895             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3896             set val $newviewopts($n,$button_id)
3897             if {$val eq $value} {
3898                 lappend rargs $pattern
3899             }
3900         } else {
3901             set val $newviewopts($n,[lindex $opt 0])
3902             set val [string trim $val]
3903             if {$val ne {}} {
3904                 set pfix [string range $pattern 0 end-1]
3905                 lappend rargs $pfix$val
3906             }
3907         }
3908     }
3909     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3910     return [concat $rargs [shellsplit $newviewopts($n,args)]]
3911 }
3912
3913 # Fill $newviewopts($n, ...) based on args for git log.
3914 proc decode_view_opts {n view_args} {
3915     global known_view_options newviewopts
3916
3917     foreach opt $known_view_options {
3918         set id [lindex $opt 0]
3919         if {[lindex $opt 1] eq "b"} {
3920             # Checkboxes
3921             set val 0
3922         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3923             # Radiobuttons
3924             regexp {^(.*_)} $id uselessvar id
3925             set val 0
3926         } else {
3927             # Text fields
3928             set val {}
3929         }
3930         set newviewopts($n,$id) $val
3931     }
3932     set oargs [list]
3933     set refargs [list]
3934     foreach arg $view_args {
3935         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3936             && ![info exists found(limit)]} {
3937             set newviewopts($n,limit) $cnt
3938             set found(limit) 1
3939             continue
3940         }
3941         catch { unset val }
3942         foreach opt $known_view_options {
3943             set id [lindex $opt 0]
3944             if {[info exists found($id)]} continue
3945             foreach pattern [lindex $opt 3] {
3946                 if {![string match $pattern $arg]} continue
3947                 if {[lindex $opt 1] eq "b"} {
3948                     # Check buttons
3949                     set val 1
3950                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3951                     # Radio buttons
3952                     regexp {^(.*_)} $id uselessvar id
3953                     set val $num
3954                 } else {
3955                     # Text input fields
3956                     set size [string length $pattern]
3957                     set val [string range $arg [expr {$size-1}] end]
3958                 }
3959                 set newviewopts($n,$id) $val
3960                 set found($id) 1
3961                 break
3962             }
3963             if {[info exists val]} break
3964         }
3965         if {[info exists val]} continue
3966         if {[regexp {^-} $arg]} {
3967             lappend oargs $arg
3968         } else {
3969             lappend refargs $arg
3970         }
3971     }
3972     set newviewopts($n,refs) [shellarglist $refargs]
3973     set newviewopts($n,args) [shellarglist $oargs]
3974 }
3975
3976 proc edit_or_newview {} {
3977     global curview
3978
3979     if {$curview > 0} {
3980         editview
3981     } else {
3982         newview 0
3983     }
3984 }
3985
3986 proc editview {} {
3987     global curview
3988     global viewname viewperm newviewname newviewopts
3989     global viewargs viewargscmd
3990
3991     set top .gitkvedit-$curview
3992     if {[winfo exists $top]} {
3993         raise $top
3994         return
3995     }
3996     decode_view_opts $curview $viewargs($curview)
3997     set newviewname($curview)      $viewname($curview)
3998     set newviewopts($curview,perm) $viewperm($curview)
3999     set newviewopts($curview,cmd)  $viewargscmd($curview)
4000     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4001 }
4002
4003 proc vieweditor {top n title} {
4004     global newviewname newviewopts viewfiles bgcolor
4005     global known_view_options NS
4006
4007     ttk_toplevel $top
4008     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4009     make_transient $top .
4010
4011     # View name
4012     ${NS}::frame $top.nfr
4013     ${NS}::label $top.nl -text [mc "View Name"]
4014     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4015     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4016     pack $top.nl -in $top.nfr -side left -padx {0 5}
4017     pack $top.name -in $top.nfr -side left -padx {0 25}
4018
4019     # View options
4020     set cframe $top.nfr
4021     set cexpand 0
4022     set cnt 0
4023     foreach opt $known_view_options {
4024         set id [lindex $opt 0]
4025         set type [lindex $opt 1]
4026         set flags [lindex $opt 2]
4027         set title [eval [lindex $opt 4]]
4028         set lxpad 0
4029
4030         if {$flags eq "+" || $flags eq "*"} {
4031             set cframe $top.fr$cnt
4032             incr cnt
4033             ${NS}::frame $cframe
4034             pack $cframe -in $top -fill x -pady 3 -padx 3
4035             set cexpand [expr {$flags eq "*"}]
4036         } elseif {$flags eq ".." || $flags eq "*."} {
4037             set cframe $top.fr$cnt
4038             incr cnt
4039             ${NS}::frame $cframe
4040             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4041             set cexpand [expr {$flags eq "*."}]
4042         } else {
4043             set lxpad 5
4044         }
4045
4046         if {$type eq "l"} {
4047             ${NS}::label $cframe.l_$id -text $title
4048             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4049         } elseif {$type eq "b"} {
4050             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4051             pack $cframe.c_$id -in $cframe -side left \
4052                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4053         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4054             regexp {^(.*_)} $id uselessvar button_id
4055             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4056             pack $cframe.c_$id -in $cframe -side left \
4057                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4058         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4059             ${NS}::label $cframe.l_$id -text $title
4060             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4061                 -textvariable newviewopts($n,$id)
4062             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4063             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4064         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4065             ${NS}::label $cframe.l_$id -text $title
4066             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4067                 -textvariable newviewopts($n,$id)
4068             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4069             pack $cframe.e_$id -in $cframe -side top -fill x
4070         } elseif {$type eq "path"} {
4071             ${NS}::label $top.l -text $title
4072             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4073             text $top.t -width 40 -height 5 -background $bgcolor
4074             if {[info exists viewfiles($n)]} {
4075                 foreach f $viewfiles($n) {
4076                     $top.t insert end $f
4077                     $top.t insert end "\n"
4078                 }
4079                 $top.t delete {end - 1c} end
4080                 $top.t mark set insert 0.0
4081             }
4082             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4083         }
4084     }
4085
4086     ${NS}::frame $top.buts
4087     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4088     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4089     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4090     bind $top <Control-Return> [list newviewok $top $n]
4091     bind $top <F5> [list newviewok $top $n 1]
4092     bind $top <Escape> [list destroy $top]
4093     grid $top.buts.ok $top.buts.apply $top.buts.can
4094     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4095     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4096     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4097     pack $top.buts -in $top -side top -fill x
4098     focus $top.t
4099 }
4100
4101 proc doviewmenu {m first cmd op argv} {
4102     set nmenu [$m index end]
4103     for {set i $first} {$i <= $nmenu} {incr i} {
4104         if {[$m entrycget $i -command] eq $cmd} {
4105             eval $m $op $i $argv
4106             break
4107         }
4108     }
4109 }
4110
4111 proc allviewmenus {n op args} {
4112     # global viewhlmenu
4113
4114     doviewmenu .bar.view 5 [list showview $n] $op $args
4115     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4116 }
4117
4118 proc newviewok {top n {apply 0}} {
4119     global nextviewnum newviewperm newviewname newishighlight
4120     global viewname viewfiles viewperm selectedview curview
4121     global viewargs viewargscmd newviewopts viewhlmenu
4122
4123     if {[catch {
4124         set newargs [encode_view_opts $n]
4125     } err]} {
4126         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4127         return
4128     }
4129     set files {}
4130     foreach f [split [$top.t get 0.0 end] "\n"] {
4131         set ft [string trim $f]
4132         if {$ft ne {}} {
4133             lappend files $ft
4134         }
4135     }
4136     if {![info exists viewfiles($n)]} {
4137         # creating a new view
4138         incr nextviewnum
4139         set viewname($n) $newviewname($n)
4140         set viewperm($n) $newviewopts($n,perm)
4141         set viewfiles($n) $files
4142         set viewargs($n) $newargs
4143         set viewargscmd($n) $newviewopts($n,cmd)
4144         addviewmenu $n
4145         if {!$newishighlight} {
4146             run showview $n
4147         } else {
4148             run addvhighlight $n
4149         }
4150     } else {
4151         # editing an existing view
4152         set viewperm($n) $newviewopts($n,perm)
4153         if {$newviewname($n) ne $viewname($n)} {
4154             set viewname($n) $newviewname($n)
4155             doviewmenu .bar.view 5 [list showview $n] \
4156                 entryconf [list -label $viewname($n)]
4157             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4158                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4159         }
4160         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4161                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4162             set viewfiles($n) $files
4163             set viewargs($n) $newargs
4164             set viewargscmd($n) $newviewopts($n,cmd)
4165             if {$curview == $n} {
4166                 run reloadcommits
4167             }
4168         }
4169     }
4170     if {$apply} return
4171     catch {destroy $top}
4172 }
4173
4174 proc delview {} {
4175     global curview viewperm hlview selectedhlview
4176
4177     if {$curview == 0} return
4178     if {[info exists hlview] && $hlview == $curview} {
4179         set selectedhlview [mc "None"]
4180         unset hlview
4181     }
4182     allviewmenus $curview delete
4183     set viewperm($curview) 0
4184     showview 0
4185 }
4186
4187 proc addviewmenu {n} {
4188     global viewname viewhlmenu
4189
4190     .bar.view add radiobutton -label $viewname($n) \
4191         -command [list showview $n] -variable selectedview -value $n
4192     #$viewhlmenu add radiobutton -label $viewname($n) \
4193     #   -command [list addvhighlight $n] -variable selectedhlview
4194 }
4195
4196 proc showview {n} {
4197     global curview cached_commitrow ordertok
4198     global displayorder parentlist rowidlist rowisopt rowfinal
4199     global colormap rowtextx nextcolor canvxmax
4200     global numcommits viewcomplete
4201     global selectedline currentid canv canvy0
4202     global treediffs
4203     global pending_select mainheadid
4204     global commitidx
4205     global selectedview
4206     global hlview selectedhlview commitinterest
4207
4208     if {$n == $curview} return
4209     set selid {}
4210     set ymax [lindex [$canv cget -scrollregion] 3]
4211     set span [$canv yview]
4212     set ytop [expr {[lindex $span 0] * $ymax}]
4213     set ybot [expr {[lindex $span 1] * $ymax}]
4214     set yscreen [expr {($ybot - $ytop) / 2}]
4215     if {$selectedline ne {}} {
4216         set selid $currentid
4217         set y [yc $selectedline]
4218         if {$ytop < $y && $y < $ybot} {
4219             set yscreen [expr {$y - $ytop}]
4220         }
4221     } elseif {[info exists pending_select]} {
4222         set selid $pending_select
4223         unset pending_select
4224     }
4225     unselectline
4226     normalline
4227     catch {unset treediffs}
4228     clear_display
4229     if {[info exists hlview] && $hlview == $n} {
4230         unset hlview
4231         set selectedhlview [mc "None"]
4232     }
4233     catch {unset commitinterest}
4234     catch {unset cached_commitrow}
4235     catch {unset ordertok}
4236
4237     set curview $n
4238     set selectedview $n
4239     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4240     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4241
4242     run refill_reflist
4243     if {![info exists viewcomplete($n)]} {
4244         getcommits $selid
4245         return
4246     }
4247
4248     set displayorder {}
4249     set parentlist {}
4250     set rowidlist {}
4251     set rowisopt {}
4252     set rowfinal {}
4253     set numcommits $commitidx($n)
4254
4255     catch {unset colormap}
4256     catch {unset rowtextx}
4257     set nextcolor 0
4258     set canvxmax [$canv cget -width]
4259     set curview $n
4260     set row 0
4261     setcanvscroll
4262     set yf 0
4263     set row {}
4264     if {$selid ne {} && [commitinview $selid $n]} {
4265         set row [rowofcommit $selid]
4266         # try to get the selected row in the same position on the screen
4267         set ymax [lindex [$canv cget -scrollregion] 3]
4268         set ytop [expr {[yc $row] - $yscreen}]
4269         if {$ytop < 0} {
4270             set ytop 0
4271         }
4272         set yf [expr {$ytop * 1.0 / $ymax}]
4273     }
4274     allcanvs yview moveto $yf
4275     drawvisible
4276     if {$row ne {}} {
4277         selectline $row 0
4278     } elseif {!$viewcomplete($n)} {
4279         reset_pending_select $selid
4280     } else {
4281         reset_pending_select {}
4282
4283         if {[commitinview $pending_select $curview]} {
4284             selectline [rowofcommit $pending_select] 1
4285         } else {
4286             set row [first_real_row]
4287             if {$row < $numcommits} {
4288                 selectline $row 0
4289             }
4290         }
4291     }
4292     if {!$viewcomplete($n)} {
4293         if {$numcommits == 0} {
4294             show_status [mc "Reading commits..."]
4295         }
4296     } elseif {$numcommits == 0} {
4297         show_status [mc "No commits selected"]
4298     }
4299 }
4300
4301 # Stuff relating to the highlighting facility
4302
4303 proc ishighlighted {id} {
4304     global vhighlights fhighlights nhighlights rhighlights
4305
4306     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4307         return $nhighlights($id)
4308     }
4309     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4310         return $vhighlights($id)
4311     }
4312     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4313         return $fhighlights($id)
4314     }
4315     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4316         return $rhighlights($id)
4317     }
4318     return 0
4319 }
4320
4321 proc bolden {id font} {
4322     global canv linehtag currentid boldids need_redisplay markedid
4323
4324     # need_redisplay = 1 means the display is stale and about to be redrawn
4325     if {$need_redisplay} return
4326     lappend boldids $id
4327     $canv itemconf $linehtag($id) -font $font
4328     if {[info exists currentid] && $id eq $currentid} {
4329         $canv delete secsel
4330         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4331                    -outline {{}} -tags secsel \
4332                    -fill [$canv cget -selectbackground]]
4333         $canv lower $t
4334     }
4335     if {[info exists markedid] && $id eq $markedid} {
4336         make_idmark $id
4337     }
4338 }
4339
4340 proc bolden_name {id font} {
4341     global canv2 linentag currentid boldnameids need_redisplay
4342
4343     if {$need_redisplay} return
4344     lappend boldnameids $id
4345     $canv2 itemconf $linentag($id) -font $font
4346     if {[info exists currentid] && $id eq $currentid} {
4347         $canv2 delete secsel
4348         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4349                    -outline {{}} -tags secsel \
4350                    -fill [$canv2 cget -selectbackground]]
4351         $canv2 lower $t
4352     }
4353 }
4354
4355 proc unbolden {} {
4356     global boldids
4357
4358     set stillbold {}
4359     foreach id $boldids {
4360         if {![ishighlighted $id]} {
4361             bolden $id mainfont
4362         } else {
4363             lappend stillbold $id
4364         }
4365     }
4366     set boldids $stillbold
4367 }
4368
4369 proc addvhighlight {n} {
4370     global hlview viewcomplete curview vhl_done commitidx
4371
4372     if {[info exists hlview]} {
4373         delvhighlight
4374     }
4375     set hlview $n
4376     if {$n != $curview && ![info exists viewcomplete($n)]} {
4377         start_rev_list $n
4378     }
4379     set vhl_done $commitidx($hlview)
4380     if {$vhl_done > 0} {
4381         drawvisible
4382     }
4383 }
4384
4385 proc delvhighlight {} {
4386     global hlview vhighlights
4387
4388     if {![info exists hlview]} return
4389     unset hlview
4390     catch {unset vhighlights}
4391     unbolden
4392 }
4393
4394 proc vhighlightmore {} {
4395     global hlview vhl_done commitidx vhighlights curview
4396
4397     set max $commitidx($hlview)
4398     set vr [visiblerows]
4399     set r0 [lindex $vr 0]
4400     set r1 [lindex $vr 1]
4401     for {set i $vhl_done} {$i < $max} {incr i} {
4402         set id [commitonrow $i $hlview]
4403         if {[commitinview $id $curview]} {
4404             set row [rowofcommit $id]
4405             if {$r0 <= $row && $row <= $r1} {
4406                 if {![highlighted $row]} {
4407                     bolden $id mainfontbold
4408                 }
4409                 set vhighlights($id) 1
4410             }
4411         }
4412     }
4413     set vhl_done $max
4414     return 0
4415 }
4416
4417 proc askvhighlight {row id} {
4418     global hlview vhighlights iddrawn
4419
4420     if {[commitinview $id $hlview]} {
4421         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4422             bolden $id mainfontbold
4423         }
4424         set vhighlights($id) 1
4425     } else {
4426         set vhighlights($id) 0
4427     }
4428 }
4429
4430 proc hfiles_change {} {
4431     global highlight_files filehighlight fhighlights fh_serial
4432     global highlight_paths
4433
4434     if {[info exists filehighlight]} {
4435         # delete previous highlights
4436         catch {close $filehighlight}
4437         unset filehighlight
4438         catch {unset fhighlights}
4439         unbolden
4440         unhighlight_filelist
4441     }
4442     set highlight_paths {}
4443     after cancel do_file_hl $fh_serial
4444     incr fh_serial
4445     if {$highlight_files ne {}} {
4446         after 300 do_file_hl $fh_serial
4447     }
4448 }
4449
4450 proc gdttype_change {name ix op} {
4451     global gdttype highlight_files findstring findpattern
4452
4453     stopfinding
4454     if {$findstring ne {}} {
4455         if {$gdttype eq [mc "containing:"]} {
4456             if {$highlight_files ne {}} {
4457                 set highlight_files {}
4458                 hfiles_change
4459             }
4460             findcom_change
4461         } else {
4462             if {$findpattern ne {}} {
4463                 set findpattern {}
4464                 findcom_change
4465             }
4466             set highlight_files $findstring
4467             hfiles_change
4468         }
4469         drawvisible
4470     }
4471     # enable/disable findtype/findloc menus too
4472 }
4473
4474 proc find_change {name ix op} {
4475     global gdttype findstring highlight_files
4476
4477     stopfinding
4478     if {$gdttype eq [mc "containing:"]} {
4479         findcom_change
4480     } else {
4481         if {$highlight_files ne $findstring} {
4482             set highlight_files $findstring
4483             hfiles_change
4484         }
4485     }
4486     drawvisible
4487 }
4488
4489 proc findcom_change args {
4490     global nhighlights boldnameids
4491     global findpattern findtype findstring gdttype
4492
4493     stopfinding
4494     # delete previous highlights, if any
4495     foreach id $boldnameids {
4496         bolden_name $id mainfont
4497     }
4498     set boldnameids {}
4499     catch {unset nhighlights}
4500     unbolden
4501     unmarkmatches
4502     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4503         set findpattern {}
4504     } elseif {$findtype eq [mc "Regexp"]} {
4505         set findpattern $findstring
4506     } else {
4507         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4508                    $findstring]
4509         set findpattern "*$e*"
4510     }
4511 }
4512
4513 proc makepatterns {l} {
4514     set ret {}
4515     foreach e $l {
4516         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4517         if {[string index $ee end] eq "/"} {
4518             lappend ret "$ee*"
4519         } else {
4520             lappend ret $ee
4521             lappend ret "$ee/*"
4522         }
4523     }
4524     return $ret
4525 }
4526
4527 proc do_file_hl {serial} {
4528     global highlight_files filehighlight highlight_paths gdttype fhl_list
4529     global cdup
4530
4531     if {$gdttype eq [mc "touching paths:"]} {
4532         if {[catch {set paths [shellsplit $highlight_files]}]} return
4533         set highlight_paths [makepatterns $paths]
4534         highlight_filelist
4535         set relative_paths {}
4536         foreach path $paths {
4537             lappend relative_paths [file join $cdup $path]
4538         }
4539         set gdtargs [concat -- $relative_paths]
4540     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4541         set gdtargs [list "-S$highlight_files"]
4542     } else {
4543         # must be "containing:", i.e. we're searching commit info
4544         return
4545     }
4546     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4547     set filehighlight [open $cmd r+]
4548     fconfigure $filehighlight -blocking 0
4549     filerun $filehighlight readfhighlight
4550     set fhl_list {}
4551     drawvisible
4552     flushhighlights
4553 }
4554
4555 proc flushhighlights {} {
4556     global filehighlight fhl_list
4557
4558     if {[info exists filehighlight]} {
4559         lappend fhl_list {}
4560         puts $filehighlight ""
4561         flush $filehighlight
4562     }
4563 }
4564
4565 proc askfilehighlight {row id} {
4566     global filehighlight fhighlights fhl_list
4567
4568     lappend fhl_list $id
4569     set fhighlights($id) -1
4570     puts $filehighlight $id
4571 }
4572
4573 proc readfhighlight {} {
4574     global filehighlight fhighlights curview iddrawn
4575     global fhl_list find_dirn
4576
4577     if {![info exists filehighlight]} {
4578         return 0
4579     }
4580     set nr 0
4581     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4582         set line [string trim $line]
4583         set i [lsearch -exact $fhl_list $line]
4584         if {$i < 0} continue
4585         for {set j 0} {$j < $i} {incr j} {
4586             set id [lindex $fhl_list $j]
4587             set fhighlights($id) 0
4588         }
4589         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4590         if {$line eq {}} continue
4591         if {![commitinview $line $curview]} continue
4592         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4593             bolden $line mainfontbold
4594         }
4595         set fhighlights($line) 1
4596     }
4597     if {[eof $filehighlight]} {
4598         # strange...
4599         puts "oops, git diff-tree died"
4600         catch {close $filehighlight}
4601         unset filehighlight
4602         return 0
4603     }
4604     if {[info exists find_dirn]} {
4605         run findmore
4606     }
4607     return 1
4608 }
4609
4610 proc doesmatch {f} {
4611     global findtype findpattern
4612
4613     if {$findtype eq [mc "Regexp"]} {
4614         return [regexp $findpattern $f]
4615     } elseif {$findtype eq [mc "IgnCase"]} {
4616         return [string match -nocase $findpattern $f]
4617     } else {
4618         return [string match $findpattern $f]
4619     }
4620 }
4621
4622 proc askfindhighlight {row id} {
4623     global nhighlights commitinfo iddrawn
4624     global findloc
4625     global markingmatches
4626
4627     if {![info exists commitinfo($id)]} {
4628         getcommit $id
4629     }
4630     set info $commitinfo($id)
4631     set isbold 0
4632     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4633     foreach f $info ty $fldtypes {
4634         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4635             [doesmatch $f]} {
4636             if {$ty eq [mc "Author"]} {
4637                 set isbold 2
4638                 break
4639             }
4640             set isbold 1
4641         }
4642     }
4643     if {$isbold && [info exists iddrawn($id)]} {
4644         if {![ishighlighted $id]} {
4645             bolden $id mainfontbold
4646             if {$isbold > 1} {
4647                 bolden_name $id mainfontbold
4648             }
4649         }
4650         if {$markingmatches} {
4651             markrowmatches $row $id
4652         }
4653     }
4654     set nhighlights($id) $isbold
4655 }
4656
4657 proc markrowmatches {row id} {
4658     global canv canv2 linehtag linentag commitinfo findloc
4659
4660     set headline [lindex $commitinfo($id) 0]
4661     set author [lindex $commitinfo($id) 1]
4662     $canv delete match$row
4663     $canv2 delete match$row
4664     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4665         set m [findmatches $headline]
4666         if {$m ne {}} {
4667             markmatches $canv $row $headline $linehtag($id) $m \
4668                 [$canv itemcget $linehtag($id) -font] $row
4669         }
4670     }
4671     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4672         set m [findmatches $author]
4673         if {$m ne {}} {
4674             markmatches $canv2 $row $author $linentag($id) $m \
4675                 [$canv2 itemcget $linentag($id) -font] $row
4676         }
4677     }
4678 }
4679
4680 proc vrel_change {name ix op} {
4681     global highlight_related
4682
4683     rhighlight_none
4684     if {$highlight_related ne [mc "None"]} {
4685         run drawvisible
4686     }
4687 }
4688
4689 # prepare for testing whether commits are descendents or ancestors of a
4690 proc rhighlight_sel {a} {
4691     global descendent desc_todo ancestor anc_todo
4692     global highlight_related
4693
4694     catch {unset descendent}
4695     set desc_todo [list $a]
4696     catch {unset ancestor}
4697     set anc_todo [list $a]
4698     if {$highlight_related ne [mc "None"]} {
4699         rhighlight_none
4700         run drawvisible
4701     }
4702 }
4703
4704 proc rhighlight_none {} {
4705     global rhighlights
4706
4707     catch {unset rhighlights}
4708     unbolden
4709 }
4710
4711 proc is_descendent {a} {
4712     global curview children descendent desc_todo
4713
4714     set v $curview
4715     set la [rowofcommit $a]
4716     set todo $desc_todo
4717     set leftover {}
4718     set done 0
4719     for {set i 0} {$i < [llength $todo]} {incr i} {
4720         set do [lindex $todo $i]
4721         if {[rowofcommit $do] < $la} {
4722             lappend leftover $do
4723             continue
4724         }
4725         foreach nk $children($v,$do) {
4726             if {![info exists descendent($nk)]} {
4727                 set descendent($nk) 1
4728                 lappend todo $nk
4729                 if {$nk eq $a} {
4730                     set done 1
4731                 }
4732             }
4733         }
4734         if {$done} {
4735             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4736             return
4737         }
4738     }
4739     set descendent($a) 0
4740     set desc_todo $leftover
4741 }
4742
4743 proc is_ancestor {a} {
4744     global curview parents ancestor anc_todo
4745
4746     set v $curview
4747     set la [rowofcommit $a]
4748     set todo $anc_todo
4749     set leftover {}
4750     set done 0
4751     for {set i 0} {$i < [llength $todo]} {incr i} {
4752         set do [lindex $todo $i]
4753         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4754             lappend leftover $do
4755             continue
4756         }
4757         foreach np $parents($v,$do) {
4758             if {![info exists ancestor($np)]} {
4759                 set ancestor($np) 1
4760                 lappend todo $np
4761                 if {$np eq $a} {
4762                     set done 1
4763                 }
4764             }
4765         }
4766         if {$done} {
4767             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4768             return
4769         }
4770     }
4771     set ancestor($a) 0
4772     set anc_todo $leftover
4773 }
4774
4775 proc askrelhighlight {row id} {
4776     global descendent highlight_related iddrawn rhighlights
4777     global selectedline ancestor
4778
4779     if {$selectedline eq {}} return
4780     set isbold 0
4781     if {$highlight_related eq [mc "Descendant"] ||
4782         $highlight_related eq [mc "Not descendant"]} {
4783         if {![info exists descendent($id)]} {
4784             is_descendent $id
4785         }
4786         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4787             set isbold 1
4788         }
4789     } elseif {$highlight_related eq [mc "Ancestor"] ||
4790               $highlight_related eq [mc "Not ancestor"]} {
4791         if {![info exists ancestor($id)]} {
4792             is_ancestor $id
4793         }
4794         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4795             set isbold 1
4796         }
4797     }
4798     if {[info exists iddrawn($id)]} {
4799         if {$isbold && ![ishighlighted $id]} {
4800             bolden $id mainfontbold
4801         }
4802     }
4803     set rhighlights($id) $isbold
4804 }
4805
4806 # Graph layout functions
4807
4808 proc shortids {ids} {
4809     set res {}
4810     foreach id $ids {
4811         if {[llength $id] > 1} {
4812             lappend res [shortids $id]
4813         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4814             lappend res [string range $id 0 7]
4815         } else {
4816             lappend res $id
4817         }
4818     }
4819     return $res
4820 }
4821
4822 proc ntimes {n o} {
4823     set ret {}
4824     set o [list $o]
4825     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4826         if {($n & $mask) != 0} {
4827             set ret [concat $ret $o]
4828         }
4829         set o [concat $o $o]
4830     }
4831     return $ret
4832 }
4833
4834 proc ordertoken {id} {
4835     global ordertok curview varcid varcstart varctok curview parents children
4836     global nullid nullid2
4837
4838     if {[info exists ordertok($id)]} {
4839         return $ordertok($id)
4840     }
4841     set origid $id
4842     set todo {}
4843     while {1} {
4844         if {[info exists varcid($curview,$id)]} {
4845             set a $varcid($curview,$id)
4846             set p [lindex $varcstart($curview) $a]
4847         } else {
4848             set p [lindex $children($curview,$id) 0]
4849         }
4850         if {[info exists ordertok($p)]} {
4851             set tok $ordertok($p)
4852             break
4853         }
4854         set id [first_real_child $curview,$p]
4855         if {$id eq {}} {
4856             # it's a root
4857             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4858             break
4859         }
4860         if {[llength $parents($curview,$id)] == 1} {
4861             lappend todo [list $p {}]
4862         } else {
4863             set j [lsearch -exact $parents($curview,$id) $p]
4864             if {$j < 0} {
4865                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4866             }
4867             lappend todo [list $p [strrep $j]]
4868         }
4869     }
4870     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4871         set p [lindex $todo $i 0]
4872         append tok [lindex $todo $i 1]
4873         set ordertok($p) $tok
4874     }
4875     set ordertok($origid) $tok
4876     return $tok
4877 }
4878
4879 # Work out where id should go in idlist so that order-token
4880 # values increase from left to right
4881 proc idcol {idlist id {i 0}} {
4882     set t [ordertoken $id]
4883     if {$i < 0} {
4884         set i 0
4885     }
4886     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4887         if {$i > [llength $idlist]} {
4888             set i [llength $idlist]
4889         }
4890         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4891         incr i
4892     } else {
4893         if {$t > [ordertoken [lindex $idlist $i]]} {
4894             while {[incr i] < [llength $idlist] &&
4895                    $t >= [ordertoken [lindex $idlist $i]]} {}
4896         }
4897     }
4898     return $i
4899 }
4900
4901 proc initlayout {} {
4902     global rowidlist rowisopt rowfinal displayorder parentlist
4903     global numcommits canvxmax canv
4904     global nextcolor
4905     global colormap rowtextx
4906
4907     set numcommits 0
4908     set displayorder {}
4909     set parentlist {}
4910     set nextcolor 0
4911     set rowidlist {}
4912     set rowisopt {}
4913     set rowfinal {}
4914     set canvxmax [$canv cget -width]
4915     catch {unset colormap}
4916     catch {unset rowtextx}
4917     setcanvscroll
4918 }
4919
4920 proc setcanvscroll {} {
4921     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4922     global lastscrollset lastscrollrows
4923
4924     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4925     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4926     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4927     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4928     set lastscrollset [clock clicks -milliseconds]
4929     set lastscrollrows $numcommits
4930 }
4931
4932 proc visiblerows {} {
4933     global canv numcommits linespc
4934
4935     set ymax [lindex [$canv cget -scrollregion] 3]
4936     if {$ymax eq {} || $ymax == 0} return
4937     set f [$canv yview]
4938     set y0 [expr {int([lindex $f 0] * $ymax)}]
4939     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4940     if {$r0 < 0} {
4941         set r0 0
4942     }
4943     set y1 [expr {int([lindex $f 1] * $ymax)}]
4944     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4945     if {$r1 >= $numcommits} {
4946         set r1 [expr {$numcommits - 1}]
4947     }
4948     return [list $r0 $r1]
4949 }
4950
4951 proc layoutmore {} {
4952     global commitidx viewcomplete curview
4953     global numcommits pending_select curview
4954     global lastscrollset lastscrollrows
4955
4956     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4957         [clock clicks -milliseconds] - $lastscrollset > 500} {
4958         setcanvscroll
4959     }
4960     if {[info exists pending_select] &&
4961         [commitinview $pending_select $curview]} {
4962         update
4963         selectline [rowofcommit $pending_select] 1
4964     }
4965     drawvisible
4966 }
4967
4968 # With path limiting, we mightn't get the actual HEAD commit,
4969 # so ask git rev-list what is the first ancestor of HEAD that
4970 # touches a file in the path limit.
4971 proc get_viewmainhead {view} {
4972     global viewmainheadid vfilelimit viewinstances mainheadid
4973
4974     catch {
4975         set rfd [open [concat | git rev-list -1 $mainheadid \
4976                            -- $vfilelimit($view)] r]
4977         set j [reg_instance $rfd]
4978         lappend viewinstances($view) $j
4979         fconfigure $rfd -blocking 0
4980         filerun $rfd [list getviewhead $rfd $j $view]
4981         set viewmainheadid($curview) {}
4982     }
4983 }
4984
4985 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4986 proc getviewhead {fd inst view} {
4987     global viewmainheadid commfd curview viewinstances showlocalchanges
4988
4989     set id {}
4990     if {[gets $fd line] < 0} {
4991         if {![eof $fd]} {
4992             return 1
4993         }
4994     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4995         set id $line
4996     }
4997     set viewmainheadid($view) $id
4998     close $fd
4999     unset commfd($inst)
5000     set i [lsearch -exact $viewinstances($view) $inst]
5001     if {$i >= 0} {
5002         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5003     }
5004     if {$showlocalchanges && $id ne {} && $view == $curview} {
5005         doshowlocalchanges
5006     }
5007     return 0
5008 }
5009
5010 proc doshowlocalchanges {} {
5011     global curview viewmainheadid
5012
5013     if {$viewmainheadid($curview) eq {}} return
5014     if {[commitinview $viewmainheadid($curview) $curview]} {
5015         dodiffindex
5016     } else {
5017         interestedin $viewmainheadid($curview) dodiffindex
5018     }
5019 }
5020
5021 proc dohidelocalchanges {} {
5022     global nullid nullid2 lserial curview
5023
5024     if {[commitinview $nullid $curview]} {
5025         removefakerow $nullid
5026     }
5027     if {[commitinview $nullid2 $curview]} {
5028         removefakerow $nullid2
5029     }
5030     incr lserial
5031 }
5032
5033 # spawn off a process to do git diff-index --cached HEAD
5034 proc dodiffindex {} {
5035     global lserial showlocalchanges vfilelimit curview
5036     global isworktree
5037
5038     if {!$showlocalchanges || !$isworktree} return
5039     incr lserial
5040     set cmd "|git diff-index --cached HEAD"
5041     if {$vfilelimit($curview) ne {}} {
5042         set cmd [concat $cmd -- $vfilelimit($curview)]
5043     }
5044     set fd [open $cmd r]
5045     fconfigure $fd -blocking 0
5046     set i [reg_instance $fd]
5047     filerun $fd [list readdiffindex $fd $lserial $i]
5048 }
5049
5050 proc readdiffindex {fd serial inst} {
5051     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5052     global vfilelimit
5053
5054     set isdiff 1
5055     if {[gets $fd line] < 0} {
5056         if {![eof $fd]} {
5057             return 1
5058         }
5059         set isdiff 0
5060     }
5061     # we only need to see one line and we don't really care what it says...
5062     stop_instance $inst
5063
5064     if {$serial != $lserial} {
5065         return 0
5066     }
5067
5068     # now see if there are any local changes not checked in to the index
5069     set cmd "|git diff-files"
5070     if {$vfilelimit($curview) ne {}} {
5071         set cmd [concat $cmd -- $vfilelimit($curview)]
5072     }
5073     set fd [open $cmd r]
5074     fconfigure $fd -blocking 0
5075     set i [reg_instance $fd]
5076     filerun $fd [list readdifffiles $fd $serial $i]
5077
5078     if {$isdiff && ![commitinview $nullid2 $curview]} {
5079         # add the line for the changes in the index to the graph
5080         set hl [mc "Local changes checked in to index but not committed"]
5081         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5082         set commitdata($nullid2) "\n    $hl\n"
5083         if {[commitinview $nullid $curview]} {
5084             removefakerow $nullid
5085         }
5086         insertfakerow $nullid2 $viewmainheadid($curview)
5087     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5088         if {[commitinview $nullid $curview]} {
5089             removefakerow $nullid
5090         }
5091         removefakerow $nullid2
5092     }
5093     return 0
5094 }
5095
5096 proc readdifffiles {fd serial inst} {
5097     global viewmainheadid nullid nullid2 curview
5098     global commitinfo commitdata lserial
5099
5100     set isdiff 1
5101     if {[gets $fd line] < 0} {
5102         if {![eof $fd]} {
5103             return 1
5104         }
5105         set isdiff 0
5106     }
5107     # we only need to see one line and we don't really care what it says...
5108     stop_instance $inst
5109
5110     if {$serial != $lserial} {
5111         return 0
5112     }
5113
5114     if {$isdiff && ![commitinview $nullid $curview]} {
5115         # add the line for the local diff to the graph
5116         set hl [mc "Local uncommitted changes, not checked in to index"]
5117         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5118         set commitdata($nullid) "\n    $hl\n"
5119         if {[commitinview $nullid2 $curview]} {
5120             set p $nullid2
5121         } else {
5122             set p $viewmainheadid($curview)
5123         }
5124         insertfakerow $nullid $p
5125     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5126         removefakerow $nullid
5127     }
5128     return 0
5129 }
5130
5131 proc nextuse {id row} {
5132     global curview children
5133
5134     if {[info exists children($curview,$id)]} {
5135         foreach kid $children($curview,$id) {
5136             if {![commitinview $kid $curview]} {
5137                 return -1
5138             }
5139             if {[rowofcommit $kid] > $row} {
5140                 return [rowofcommit $kid]
5141             }
5142         }
5143     }
5144     if {[commitinview $id $curview]} {
5145         return [rowofcommit $id]
5146     }
5147     return -1
5148 }
5149
5150 proc prevuse {id row} {
5151     global curview children
5152
5153     set ret -1
5154     if {[info exists children($curview,$id)]} {
5155         foreach kid $children($curview,$id) {
5156             if {![commitinview $kid $curview]} break
5157             if {[rowofcommit $kid] < $row} {
5158                 set ret [rowofcommit $kid]
5159             }
5160         }
5161     }
5162     return $ret
5163 }
5164
5165 proc make_idlist {row} {
5166     global displayorder parentlist uparrowlen downarrowlen mingaplen
5167     global commitidx curview children
5168
5169     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5170     if {$r < 0} {
5171         set r 0
5172     }
5173     set ra [expr {$row - $downarrowlen}]
5174     if {$ra < 0} {
5175         set ra 0
5176     }
5177     set rb [expr {$row + $uparrowlen}]
5178     if {$rb > $commitidx($curview)} {
5179         set rb $commitidx($curview)
5180     }
5181     make_disporder $r [expr {$rb + 1}]
5182     set ids {}
5183     for {} {$r < $ra} {incr r} {
5184         set nextid [lindex $displayorder [expr {$r + 1}]]
5185         foreach p [lindex $parentlist $r] {
5186             if {$p eq $nextid} continue
5187             set rn [nextuse $p $r]
5188             if {$rn >= $row &&
5189                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5190                 lappend ids [list [ordertoken $p] $p]
5191             }
5192         }
5193     }
5194     for {} {$r < $row} {incr r} {
5195         set nextid [lindex $displayorder [expr {$r + 1}]]
5196         foreach p [lindex $parentlist $r] {
5197             if {$p eq $nextid} continue
5198             set rn [nextuse $p $r]
5199             if {$rn < 0 || $rn >= $row} {
5200                 lappend ids [list [ordertoken $p] $p]
5201             }
5202         }
5203     }
5204     set id [lindex $displayorder $row]
5205     lappend ids [list [ordertoken $id] $id]
5206     while {$r < $rb} {
5207         foreach p [lindex $parentlist $r] {
5208             set firstkid [lindex $children($curview,$p) 0]
5209             if {[rowofcommit $firstkid] < $row} {
5210                 lappend ids [list [ordertoken $p] $p]
5211             }
5212         }
5213         incr r
5214         set id [lindex $displayorder $r]
5215         if {$id ne {}} {
5216             set firstkid [lindex $children($curview,$id) 0]
5217             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5218                 lappend ids [list [ordertoken $id] $id]
5219             }
5220         }
5221     }
5222     set idlist {}
5223     foreach idx [lsort -unique $ids] {
5224         lappend idlist [lindex $idx 1]
5225     }
5226     return $idlist
5227 }
5228
5229 proc rowsequal {a b} {
5230     while {[set i [lsearch -exact $a {}]] >= 0} {
5231         set a [lreplace $a $i $i]
5232     }
5233     while {[set i [lsearch -exact $b {}]] >= 0} {
5234         set b [lreplace $b $i $i]
5235     }
5236     return [expr {$a eq $b}]
5237 }
5238
5239 proc makeupline {id row rend col} {
5240     global rowidlist uparrowlen downarrowlen mingaplen
5241
5242     for {set r $rend} {1} {set r $rstart} {
5243         set rstart [prevuse $id $r]
5244         if {$rstart < 0} return
5245         if {$rstart < $row} break
5246     }
5247     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5248         set rstart [expr {$rend - $uparrowlen - 1}]
5249     }
5250     for {set r $rstart} {[incr r] <= $row} {} {
5251         set idlist [lindex $rowidlist $r]
5252         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5253             set col [idcol $idlist $id $col]
5254             lset rowidlist $r [linsert $idlist $col $id]
5255             changedrow $r
5256         }
5257     }
5258 }
5259
5260 proc layoutrows {row endrow} {
5261     global rowidlist rowisopt rowfinal displayorder
5262     global uparrowlen downarrowlen maxwidth mingaplen
5263     global children parentlist
5264     global commitidx viewcomplete curview
5265
5266     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5267     set idlist {}
5268     if {$row > 0} {
5269         set rm1 [expr {$row - 1}]
5270         foreach id [lindex $rowidlist $rm1] {
5271             if {$id ne {}} {
5272                 lappend idlist $id
5273             }
5274         }
5275         set final [lindex $rowfinal $rm1]
5276     }
5277     for {} {$row < $endrow} {incr row} {
5278         set rm1 [expr {$row - 1}]
5279         if {$rm1 < 0 || $idlist eq {}} {
5280             set idlist [make_idlist $row]
5281             set final 1
5282         } else {
5283             set id [lindex $displayorder $rm1]
5284             set col [lsearch -exact $idlist $id]
5285             set idlist [lreplace $idlist $col $col]
5286             foreach p [lindex $parentlist $rm1] {
5287                 if {[lsearch -exact $idlist $p] < 0} {
5288                     set col [idcol $idlist $p $col]
5289                     set idlist [linsert $idlist $col $p]
5290                     # if not the first child, we have to insert a line going up
5291                     if {$id ne [lindex $children($curview,$p) 0]} {
5292                         makeupline $p $rm1 $row $col
5293                     }
5294                 }
5295             }
5296             set id [lindex $displayorder $row]
5297             if {$row > $downarrowlen} {
5298                 set termrow [expr {$row - $downarrowlen - 1}]
5299                 foreach p [lindex $parentlist $termrow] {
5300                     set i [lsearch -exact $idlist $p]
5301                     if {$i < 0} continue
5302                     set nr [nextuse $p $termrow]
5303                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5304                         set idlist [lreplace $idlist $i $i]
5305                     }
5306                 }
5307             }
5308             set col [lsearch -exact $idlist $id]
5309             if {$col < 0} {
5310                 set col [idcol $idlist $id]
5311                 set idlist [linsert $idlist $col $id]
5312                 if {$children($curview,$id) ne {}} {
5313                     makeupline $id $rm1 $row $col
5314                 }
5315             }
5316             set r [expr {$row + $uparrowlen - 1}]
5317             if {$r < $commitidx($curview)} {
5318                 set x $col
5319                 foreach p [lindex $parentlist $r] {
5320                     if {[lsearch -exact $idlist $p] >= 0} continue
5321                     set fk [lindex $children($curview,$p) 0]
5322                     if {[rowofcommit $fk] < $row} {
5323                         set x [idcol $idlist $p $x]
5324                         set idlist [linsert $idlist $x $p]
5325                     }
5326                 }
5327                 if {[incr r] < $commitidx($curview)} {
5328                     set p [lindex $displayorder $r]
5329                     if {[lsearch -exact $idlist $p] < 0} {
5330                         set fk [lindex $children($curview,$p) 0]
5331                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5332                             set x [idcol $idlist $p $x]
5333                             set idlist [linsert $idlist $x $p]
5334                         }
5335                     }
5336                 }
5337             }
5338         }
5339         if {$final && !$viewcomplete($curview) &&
5340             $row + $uparrowlen + $mingaplen + $downarrowlen
5341                 >= $commitidx($curview)} {
5342             set final 0
5343         }
5344         set l [llength $rowidlist]
5345         if {$row == $l} {
5346             lappend rowidlist $idlist
5347             lappend rowisopt 0
5348             lappend rowfinal $final
5349         } elseif {$row < $l} {
5350             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5351                 lset rowidlist $row $idlist
5352                 changedrow $row
5353             }
5354             lset rowfinal $row $final
5355         } else {
5356             set pad [ntimes [expr {$row - $l}] {}]
5357             set rowidlist [concat $rowidlist $pad]
5358             lappend rowidlist $idlist
5359             set rowfinal [concat $rowfinal $pad]
5360             lappend rowfinal $final
5361             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5362         }
5363     }
5364     return $row
5365 }
5366
5367 proc changedrow {row} {
5368     global displayorder iddrawn rowisopt need_redisplay
5369
5370     set l [llength $rowisopt]
5371     if {$row < $l} {
5372         lset rowisopt $row 0
5373         if {$row + 1 < $l} {
5374             lset rowisopt [expr {$row + 1}] 0
5375             if {$row + 2 < $l} {
5376                 lset rowisopt [expr {$row + 2}] 0
5377             }
5378         }
5379     }
5380     set id [lindex $displayorder $row]
5381     if {[info exists iddrawn($id)]} {
5382         set need_redisplay 1
5383     }
5384 }
5385
5386 proc insert_pad {row col npad} {
5387     global rowidlist
5388
5389     set pad [ntimes $npad {}]
5390     set idlist [lindex $rowidlist $row]
5391     set bef [lrange $idlist 0 [expr {$col - 1}]]
5392     set aft [lrange $idlist $col end]
5393     set i [lsearch -exact $aft {}]
5394     if {$i > 0} {
5395         set aft [lreplace $aft $i $i]
5396     }
5397     lset rowidlist $row [concat $bef $pad $aft]
5398     changedrow $row
5399 }
5400
5401 proc optimize_rows {row col endrow} {
5402     global rowidlist rowisopt displayorder curview children
5403
5404     if {$row < 1} {
5405         set row 1
5406     }
5407     for {} {$row < $endrow} {incr row; set col 0} {
5408         if {[lindex $rowisopt $row]} continue
5409         set haspad 0
5410         set y0 [expr {$row - 1}]
5411         set ym [expr {$row - 2}]
5412         set idlist [lindex $rowidlist $row]
5413         set previdlist [lindex $rowidlist $y0]
5414         if {$idlist eq {} || $previdlist eq {}} continue
5415         if {$ym >= 0} {
5416             set pprevidlist [lindex $rowidlist $ym]
5417             if {$pprevidlist eq {}} continue
5418         } else {
5419             set pprevidlist {}
5420         }
5421         set x0 -1
5422         set xm -1
5423         for {} {$col < [llength $idlist]} {incr col} {
5424             set id [lindex $idlist $col]
5425             if {[lindex $previdlist $col] eq $id} continue
5426             if {$id eq {}} {
5427                 set haspad 1
5428                 continue
5429             }
5430             set x0 [lsearch -exact $previdlist $id]
5431             if {$x0 < 0} continue
5432             set z [expr {$x0 - $col}]
5433             set isarrow 0
5434             set z0 {}
5435             if {$ym >= 0} {
5436                 set xm [lsearch -exact $pprevidlist $id]
5437                 if {$xm >= 0} {
5438                     set z0 [expr {$xm - $x0}]
5439                 }
5440             }
5441             if {$z0 eq {}} {
5442                 # if row y0 is the first child of $id then it's not an arrow
5443                 if {[lindex $children($curview,$id) 0] ne
5444                     [lindex $displayorder $y0]} {
5445                     set isarrow 1
5446                 }
5447             }
5448             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5449                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5450                 set isarrow 1
5451             }
5452             # Looking at lines from this row to the previous row,
5453             # make them go straight up if they end in an arrow on
5454             # the previous row; otherwise make them go straight up
5455             # or at 45 degrees.
5456             if {$z < -1 || ($z < 0 && $isarrow)} {
5457                 # Line currently goes left too much;
5458                 # insert pads in the previous row, then optimize it
5459                 set npad [expr {-1 - $z + $isarrow}]
5460                 insert_pad $y0 $x0 $npad
5461                 if {$y0 > 0} {
5462                     optimize_rows $y0 $x0 $row
5463                 }
5464                 set previdlist [lindex $rowidlist $y0]
5465                 set x0 [lsearch -exact $previdlist $id]
5466                 set z [expr {$x0 - $col}]
5467                 if {$z0 ne {}} {
5468                     set pprevidlist [lindex $rowidlist $ym]
5469                     set xm [lsearch -exact $pprevidlist $id]
5470                     set z0 [expr {$xm - $x0}]
5471                 }
5472             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5473                 # Line currently goes right too much;
5474                 # insert pads in this line
5475                 set npad [expr {$z - 1 + $isarrow}]
5476                 insert_pad $row $col $npad
5477                 set idlist [lindex $rowidlist $row]
5478                 incr col $npad
5479                 set z [expr {$x0 - $col}]
5480                 set haspad 1
5481             }
5482             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5483                 # this line links to its first child on row $row-2
5484                 set id [lindex $displayorder $ym]
5485                 set xc [lsearch -exact $pprevidlist $id]
5486                 if {$xc >= 0} {
5487                     set z0 [expr {$xc - $x0}]
5488                 }
5489             }
5490             # avoid lines jigging left then immediately right
5491             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5492                 insert_pad $y0 $x0 1
5493                 incr x0
5494                 optimize_rows $y0 $x0 $row
5495                 set previdlist [lindex $rowidlist $y0]
5496             }
5497         }
5498         if {!$haspad} {
5499             # Find the first column that doesn't have a line going right
5500             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5501                 set id [lindex $idlist $col]
5502                 if {$id eq {}} break
5503                 set x0 [lsearch -exact $previdlist $id]
5504                 if {$x0 < 0} {
5505                     # check if this is the link to the first child
5506                     set kid [lindex $displayorder $y0]
5507                     if {[lindex $children($curview,$id) 0] eq $kid} {
5508                         # it is, work out offset to child
5509                         set x0 [lsearch -exact $previdlist $kid]
5510                     }
5511                 }
5512                 if {$x0 <= $col} break
5513             }
5514             # Insert a pad at that column as long as it has a line and
5515             # isn't the last column
5516             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5517                 set idlist [linsert $idlist $col {}]
5518                 lset rowidlist $row $idlist
5519                 changedrow $row
5520             }
5521         }
5522     }
5523 }
5524
5525 proc xc {row col} {
5526     global canvx0 linespc
5527     return [expr {$canvx0 + $col * $linespc}]
5528 }
5529
5530 proc yc {row} {
5531     global canvy0 linespc
5532     return [expr {$canvy0 + $row * $linespc}]
5533 }
5534
5535 proc linewidth {id} {
5536     global thickerline lthickness
5537
5538     set wid $lthickness
5539     if {[info exists thickerline] && $id eq $thickerline} {
5540         set wid [expr {2 * $lthickness}]
5541     }
5542     return $wid
5543 }
5544
5545 proc rowranges {id} {
5546     global curview children uparrowlen downarrowlen
5547     global rowidlist
5548
5549     set kids $children($curview,$id)
5550     if {$kids eq {}} {
5551         return {}
5552     }
5553     set ret {}
5554     lappend kids $id
5555     foreach child $kids {
5556         if {![commitinview $child $curview]} break
5557         set row [rowofcommit $child]
5558         if {![info exists prev]} {
5559             lappend ret [expr {$row + 1}]
5560         } else {
5561             if {$row <= $prevrow} {
5562                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5563             }
5564             # see if the line extends the whole way from prevrow to row
5565             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5566                 [lsearch -exact [lindex $rowidlist \
5567                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5568                 # it doesn't, see where it ends
5569                 set r [expr {$prevrow + $downarrowlen}]
5570                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5571                     while {[incr r -1] > $prevrow &&
5572                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5573                 } else {
5574                     while {[incr r] <= $row &&
5575                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5576                     incr r -1
5577                 }
5578                 lappend ret $r
5579                 # see where it starts up again
5580                 set r [expr {$row - $uparrowlen}]
5581                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5582                     while {[incr r] < $row &&
5583                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5584                 } else {
5585                     while {[incr r -1] >= $prevrow &&
5586                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5587                     incr r
5588                 }
5589                 lappend ret $r
5590             }
5591         }
5592         if {$child eq $id} {
5593             lappend ret $row
5594         }
5595         set prev $child
5596         set prevrow $row
5597     }
5598     return $ret
5599 }
5600
5601 proc drawlineseg {id row endrow arrowlow} {
5602     global rowidlist displayorder iddrawn linesegs
5603     global canv colormap linespc curview maxlinelen parentlist
5604
5605     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5606     set le [expr {$row + 1}]
5607     set arrowhigh 1
5608     while {1} {
5609         set c [lsearch -exact [lindex $rowidlist $le] $id]
5610         if {$c < 0} {
5611             incr le -1
5612             break
5613         }
5614         lappend cols $c
5615         set x [lindex $displayorder $le]
5616         if {$x eq $id} {
5617             set arrowhigh 0
5618             break
5619         }
5620         if {[info exists iddrawn($x)] || $le == $endrow} {
5621             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5622             if {$c >= 0} {
5623                 lappend cols $c
5624                 set arrowhigh 0
5625             }
5626             break
5627         }
5628         incr le
5629     }
5630     if {$le <= $row} {
5631         return $row
5632     }
5633
5634     set lines {}
5635     set i 0
5636     set joinhigh 0
5637     if {[info exists linesegs($id)]} {
5638         set lines $linesegs($id)
5639         foreach li $lines {
5640             set r0 [lindex $li 0]
5641             if {$r0 > $row} {
5642                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5643                     set joinhigh 1
5644                 }
5645                 break
5646             }
5647             incr i
5648         }
5649     }
5650     set joinlow 0
5651     if {$i > 0} {
5652         set li [lindex $lines [expr {$i-1}]]
5653         set r1 [lindex $li 1]
5654         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5655             set joinlow 1
5656         }
5657     }
5658
5659     set x [lindex $cols [expr {$le - $row}]]
5660     set xp [lindex $cols [expr {$le - 1 - $row}]]
5661     set dir [expr {$xp - $x}]
5662     if {$joinhigh} {
5663         set ith [lindex $lines $i 2]
5664         set coords [$canv coords $ith]
5665         set ah [$canv itemcget $ith -arrow]
5666         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5667         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5668         if {$x2 ne {} && $x - $x2 == $dir} {
5669             set coords [lrange $coords 0 end-2]
5670         }
5671     } else {
5672         set coords [list [xc $le $x] [yc $le]]
5673     }
5674     if {$joinlow} {
5675         set itl [lindex $lines [expr {$i-1}] 2]
5676         set al [$canv itemcget $itl -arrow]
5677         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5678     } elseif {$arrowlow} {
5679         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5680             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5681             set arrowlow 0
5682         }
5683     }
5684     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5685     for {set y $le} {[incr y -1] > $row} {} {
5686         set x $xp
5687         set xp [lindex $cols [expr {$y - 1 - $row}]]
5688         set ndir [expr {$xp - $x}]
5689         if {$dir != $ndir || $xp < 0} {
5690             lappend coords [xc $y $x] [yc $y]
5691         }
5692         set dir $ndir
5693     }
5694     if {!$joinlow} {
5695         if {$xp < 0} {
5696             # join parent line to first child
5697             set ch [lindex $displayorder $row]
5698             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5699             if {$xc < 0} {
5700                 puts "oops: drawlineseg: child $ch not on row $row"
5701             } elseif {$xc != $x} {
5702                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5703                     set d [expr {int(0.5 * $linespc)}]
5704                     set x1 [xc $row $x]
5705                     if {$xc < $x} {
5706                         set x2 [expr {$x1 - $d}]
5707                     } else {
5708                         set x2 [expr {$x1 + $d}]
5709                     }
5710                     set y2 [yc $row]
5711                     set y1 [expr {$y2 + $d}]
5712                     lappend coords $x1 $y1 $x2 $y2
5713                 } elseif {$xc < $x - 1} {
5714                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5715                 } elseif {$xc > $x + 1} {
5716                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5717                 }
5718                 set x $xc
5719             }
5720             lappend coords [xc $row $x] [yc $row]
5721         } else {
5722             set xn [xc $row $xp]
5723             set yn [yc $row]
5724             lappend coords $xn $yn
5725         }
5726         if {!$joinhigh} {
5727             assigncolor $id
5728             set t [$canv create line $coords -width [linewidth $id] \
5729                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5730             $canv lower $t
5731             bindline $t $id
5732             set lines [linsert $lines $i [list $row $le $t]]
5733         } else {
5734             $canv coords $ith $coords
5735             if {$arrow ne $ah} {
5736                 $canv itemconf $ith -arrow $arrow
5737             }
5738             lset lines $i 0 $row
5739         }
5740     } else {
5741         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5742         set ndir [expr {$xo - $xp}]
5743         set clow [$canv coords $itl]
5744         if {$dir == $ndir} {
5745             set clow [lrange $clow 2 end]
5746         }
5747         set coords [concat $coords $clow]
5748         if {!$joinhigh} {
5749             lset lines [expr {$i-1}] 1 $le
5750         } else {
5751             # coalesce two pieces
5752             $canv delete $ith
5753             set b [lindex $lines [expr {$i-1}] 0]
5754             set e [lindex $lines $i 1]
5755             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5756         }
5757         $canv coords $itl $coords
5758         if {$arrow ne $al} {
5759             $canv itemconf $itl -arrow $arrow
5760         }
5761     }
5762
5763     set linesegs($id) $lines
5764     return $le
5765 }
5766
5767 proc drawparentlinks {id row} {
5768     global rowidlist canv colormap curview parentlist
5769     global idpos linespc
5770
5771     set rowids [lindex $rowidlist $row]
5772     set col [lsearch -exact $rowids $id]
5773     if {$col < 0} return
5774     set olds [lindex $parentlist $row]
5775     set row2 [expr {$row + 1}]
5776     set x [xc $row $col]
5777     set y [yc $row]
5778     set y2 [yc $row2]
5779     set d [expr {int(0.5 * $linespc)}]
5780     set ymid [expr {$y + $d}]
5781     set ids [lindex $rowidlist $row2]
5782     # rmx = right-most X coord used
5783     set rmx 0
5784     foreach p $olds {
5785         set i [lsearch -exact $ids $p]
5786         if {$i < 0} {
5787             puts "oops, parent $p of $id not in list"
5788             continue
5789         }
5790         set x2 [xc $row2 $i]
5791         if {$x2 > $rmx} {
5792             set rmx $x2
5793         }
5794         set j [lsearch -exact $rowids $p]
5795         if {$j < 0} {
5796             # drawlineseg will do this one for us
5797             continue
5798         }
5799         assigncolor $p
5800         # should handle duplicated parents here...
5801         set coords [list $x $y]
5802         if {$i != $col} {
5803             # if attaching to a vertical segment, draw a smaller
5804             # slant for visual distinctness
5805             if {$i == $j} {
5806                 if {$i < $col} {
5807                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5808                 } else {
5809                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5810                 }
5811             } elseif {$i < $col && $i < $j} {
5812                 # segment slants towards us already
5813                 lappend coords [xc $row $j] $y
5814             } else {
5815                 if {$i < $col - 1} {
5816                     lappend coords [expr {$x2 + $linespc}] $y
5817                 } elseif {$i > $col + 1} {
5818                     lappend coords [expr {$x2 - $linespc}] $y
5819                 }
5820                 lappend coords $x2 $y2
5821             }
5822         } else {
5823             lappend coords $x2 $y2
5824         }
5825         set t [$canv create line $coords -width [linewidth $p] \
5826                    -fill $colormap($p) -tags lines.$p]
5827         $canv lower $t
5828         bindline $t $p
5829     }
5830     if {$rmx > [lindex $idpos($id) 1]} {
5831         lset idpos($id) 1 $rmx
5832         redrawtags $id
5833     }
5834 }
5835
5836 proc drawlines {id} {
5837     global canv
5838
5839     $canv itemconf lines.$id -width [linewidth $id]
5840 }
5841
5842 proc drawcmittext {id row col} {
5843     global linespc canv canv2 canv3 fgcolor curview
5844     global cmitlisted commitinfo rowidlist parentlist
5845     global rowtextx idpos idtags idheads idotherrefs
5846     global linehtag linentag linedtag selectedline
5847     global canvxmax boldids boldnameids fgcolor markedid
5848     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5849
5850     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5851     set listed $cmitlisted($curview,$id)
5852     if {$id eq $nullid} {
5853         set ofill red
5854     } elseif {$id eq $nullid2} {
5855         set ofill green
5856     } elseif {$id eq $mainheadid} {
5857         set ofill yellow
5858     } else {
5859         set ofill [lindex $circlecolors $listed]
5860     }
5861     set x [xc $row $col]
5862     set y [yc $row]
5863     set orad [expr {$linespc / 3}]
5864     if {$listed <= 2} {
5865         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5866                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5867                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5868     } elseif {$listed == 3} {
5869         # triangle pointing left for left-side commits
5870         set t [$canv create polygon \
5871                    [expr {$x - $orad}] $y \
5872                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5873                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5874                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5875     } else {
5876         # triangle pointing right for right-side commits
5877         set t [$canv create polygon \
5878                    [expr {$x + $orad - 1}] $y \
5879                    [expr {$x - $orad}] [expr {$y - $orad}] \
5880                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5881                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5882     }
5883     set circleitem($row) $t
5884     $canv raise $t
5885     $canv bind $t <1> {selcanvline {} %x %y}
5886     set rmx [llength [lindex $rowidlist $row]]
5887     set olds [lindex $parentlist $row]
5888     if {$olds ne {}} {
5889         set nextids [lindex $rowidlist [expr {$row + 1}]]
5890         foreach p $olds {
5891             set i [lsearch -exact $nextids $p]
5892             if {$i > $rmx} {
5893                 set rmx $i
5894             }
5895         }
5896     }
5897     set xt [xc $row $rmx]
5898     set rowtextx($row) $xt
5899     set idpos($id) [list $x $xt $y]
5900     if {[info exists idtags($id)] || [info exists idheads($id)]
5901         || [info exists idotherrefs($id)]} {
5902         set xt [drawtags $id $x $xt $y]
5903     }
5904     if {[lindex $commitinfo($id) 6] > 0} {
5905         set xt [drawnotesign $xt $y]
5906     }
5907     set headline [lindex $commitinfo($id) 0]
5908     set name [lindex $commitinfo($id) 1]
5909     set date [lindex $commitinfo($id) 2]
5910     set date [formatdate $date]
5911     set font mainfont
5912     set nfont mainfont
5913     set isbold [ishighlighted $id]
5914     if {$isbold > 0} {
5915         lappend boldids $id
5916         set font mainfontbold
5917         if {$isbold > 1} {
5918             lappend boldnameids $id
5919             set nfont mainfontbold
5920         }
5921     }
5922     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5923                            -text $headline -font $font -tags text]
5924     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5925     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5926                            -text $name -font $nfont -tags text]
5927     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5928                            -text $date -font mainfont -tags text]
5929     if {$selectedline == $row} {
5930         make_secsel $id
5931     }
5932     if {[info exists markedid] && $markedid eq $id} {
5933         make_idmark $id
5934     }
5935     set xr [expr {$xt + [font measure $font $headline]}]
5936     if {$xr > $canvxmax} {
5937         set canvxmax $xr
5938         setcanvscroll
5939     }
5940 }
5941
5942 proc drawcmitrow {row} {
5943     global displayorder rowidlist nrows_drawn
5944     global iddrawn markingmatches
5945     global commitinfo numcommits
5946     global filehighlight fhighlights findpattern nhighlights
5947     global hlview vhighlights
5948     global highlight_related rhighlights
5949
5950     if {$row >= $numcommits} return
5951
5952     set id [lindex $displayorder $row]
5953     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5954         askvhighlight $row $id
5955     }
5956     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5957         askfilehighlight $row $id
5958     }
5959     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5960         askfindhighlight $row $id
5961     }
5962     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5963         askrelhighlight $row $id
5964     }
5965     if {![info exists iddrawn($id)]} {
5966         set col [lsearch -exact [lindex $rowidlist $row] $id]
5967         if {$col < 0} {
5968             puts "oops, row $row id $id not in list"
5969             return
5970         }
5971         if {![info exists commitinfo($id)]} {
5972             getcommit $id
5973         }
5974         assigncolor $id
5975         drawcmittext $id $row $col
5976         set iddrawn($id) 1
5977         incr nrows_drawn
5978     }
5979     if {$markingmatches} {
5980         markrowmatches $row $id
5981     }
5982 }
5983
5984 proc drawcommits {row {endrow {}}} {
5985     global numcommits iddrawn displayorder curview need_redisplay
5986     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5987
5988     if {$row < 0} {
5989         set row 0
5990     }
5991     if {$endrow eq {}} {
5992         set endrow $row
5993     }
5994     if {$endrow >= $numcommits} {
5995         set endrow [expr {$numcommits - 1}]
5996     }
5997
5998     set rl1 [expr {$row - $downarrowlen - 3}]
5999     if {$rl1 < 0} {
6000         set rl1 0
6001     }
6002     set ro1 [expr {$row - 3}]
6003     if {$ro1 < 0} {
6004         set ro1 0
6005     }
6006     set r2 [expr {$endrow + $uparrowlen + 3}]
6007     if {$r2 > $numcommits} {
6008         set r2 $numcommits
6009     }
6010     for {set r $rl1} {$r < $r2} {incr r} {
6011         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6012             if {$rl1 < $r} {
6013                 layoutrows $rl1 $r
6014             }
6015             set rl1 [expr {$r + 1}]
6016         }
6017     }
6018     if {$rl1 < $r} {
6019         layoutrows $rl1 $r
6020     }
6021     optimize_rows $ro1 0 $r2
6022     if {$need_redisplay || $nrows_drawn > 2000} {
6023         clear_display
6024     }
6025
6026     # make the lines join to already-drawn rows either side
6027     set r [expr {$row - 1}]
6028     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6029         set r $row
6030     }
6031     set er [expr {$endrow + 1}]
6032     if {$er >= $numcommits ||
6033         ![info exists iddrawn([lindex $displayorder $er])]} {
6034         set er $endrow
6035     }
6036     for {} {$r <= $er} {incr r} {
6037         set id [lindex $displayorder $r]
6038         set wasdrawn [info exists iddrawn($id)]
6039         drawcmitrow $r
6040         if {$r == $er} break
6041         set nextid [lindex $displayorder [expr {$r + 1}]]
6042         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6043         drawparentlinks $id $r
6044
6045         set rowids [lindex $rowidlist $r]
6046         foreach lid $rowids {
6047             if {$lid eq {}} continue
6048             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6049             if {$lid eq $id} {
6050                 # see if this is the first child of any of its parents
6051                 foreach p [lindex $parentlist $r] {
6052                     if {[lsearch -exact $rowids $p] < 0} {
6053                         # make this line extend up to the child
6054                         set lineend($p) [drawlineseg $p $r $er 0]
6055                     }
6056                 }
6057             } else {
6058                 set lineend($lid) [drawlineseg $lid $r $er 1]
6059             }
6060         }
6061     }
6062 }
6063
6064 proc undolayout {row} {
6065     global uparrowlen mingaplen downarrowlen
6066     global rowidlist rowisopt rowfinal need_redisplay
6067
6068     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6069     if {$r < 0} {
6070         set r 0
6071     }
6072     if {[llength $rowidlist] > $r} {
6073         incr r -1
6074         set rowidlist [lrange $rowidlist 0 $r]
6075         set rowfinal [lrange $rowfinal 0 $r]
6076         set rowisopt [lrange $rowisopt 0 $r]
6077         set need_redisplay 1
6078         run drawvisible
6079     }
6080 }
6081
6082 proc drawvisible {} {
6083     global canv linespc curview vrowmod selectedline targetrow targetid
6084     global need_redisplay cscroll numcommits
6085
6086     set fs [$canv yview]
6087     set ymax [lindex [$canv cget -scrollregion] 3]
6088     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6089     set f0 [lindex $fs 0]
6090     set f1 [lindex $fs 1]
6091     set y0 [expr {int($f0 * $ymax)}]
6092     set y1 [expr {int($f1 * $ymax)}]
6093
6094     if {[info exists targetid]} {
6095         if {[commitinview $targetid $curview]} {
6096             set r [rowofcommit $targetid]
6097             if {$r != $targetrow} {
6098                 # Fix up the scrollregion and change the scrolling position
6099                 # now that our target row has moved.
6100                 set diff [expr {($r - $targetrow) * $linespc}]
6101                 set targetrow $r
6102                 setcanvscroll
6103                 set ymax [lindex [$canv cget -scrollregion] 3]
6104                 incr y0 $diff
6105                 incr y1 $diff
6106                 set f0 [expr {$y0 / $ymax}]
6107                 set f1 [expr {$y1 / $ymax}]
6108                 allcanvs yview moveto $f0
6109                 $cscroll set $f0 $f1
6110                 set need_redisplay 1
6111             }
6112         } else {
6113             unset targetid
6114         }
6115     }
6116
6117     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6118     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6119     if {$endrow >= $vrowmod($curview)} {
6120         update_arcrows $curview
6121     }
6122     if {$selectedline ne {} &&
6123         $row <= $selectedline && $selectedline <= $endrow} {
6124         set targetrow $selectedline
6125     } elseif {[info exists targetid]} {
6126         set targetrow [expr {int(($row + $endrow) / 2)}]
6127     }
6128     if {[info exists targetrow]} {
6129         if {$targetrow >= $numcommits} {
6130             set targetrow [expr {$numcommits - 1}]
6131         }
6132         set targetid [commitonrow $targetrow]
6133     }
6134     drawcommits $row $endrow
6135 }
6136
6137 proc clear_display {} {
6138     global iddrawn linesegs need_redisplay nrows_drawn
6139     global vhighlights fhighlights nhighlights rhighlights
6140     global linehtag linentag linedtag boldids boldnameids
6141
6142     allcanvs delete all
6143     catch {unset iddrawn}
6144     catch {unset linesegs}
6145     catch {unset linehtag}
6146     catch {unset linentag}
6147     catch {unset linedtag}
6148     set boldids {}
6149     set boldnameids {}
6150     catch {unset vhighlights}
6151     catch {unset fhighlights}
6152     catch {unset nhighlights}
6153     catch {unset rhighlights}
6154     set need_redisplay 0
6155     set nrows_drawn 0
6156 }
6157
6158 proc findcrossings {id} {
6159     global rowidlist parentlist numcommits displayorder
6160
6161     set cross {}
6162     set ccross {}
6163     foreach {s e} [rowranges $id] {
6164         if {$e >= $numcommits} {
6165             set e [expr {$numcommits - 1}]
6166         }
6167         if {$e <= $s} continue
6168         for {set row $e} {[incr row -1] >= $s} {} {
6169             set x [lsearch -exact [lindex $rowidlist $row] $id]
6170             if {$x < 0} break
6171             set olds [lindex $parentlist $row]
6172             set kid [lindex $displayorder $row]
6173             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6174             if {$kidx < 0} continue
6175             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6176             foreach p $olds {
6177                 set px [lsearch -exact $nextrow $p]
6178                 if {$px < 0} continue
6179                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6180                     if {[lsearch -exact $ccross $p] >= 0} continue
6181                     if {$x == $px + ($kidx < $px? -1: 1)} {
6182                         lappend ccross $p
6183                     } elseif {[lsearch -exact $cross $p] < 0} {
6184                         lappend cross $p
6185                     }
6186                 }
6187             }
6188         }
6189     }
6190     return [concat $ccross {{}} $cross]
6191 }
6192
6193 proc assigncolor {id} {
6194     global colormap colors nextcolor
6195     global parents children children curview
6196
6197     if {[info exists colormap($id)]} return
6198     set ncolors [llength $colors]
6199     if {[info exists children($curview,$id)]} {
6200         set kids $children($curview,$id)
6201     } else {
6202         set kids {}
6203     }
6204     if {[llength $kids] == 1} {
6205         set child [lindex $kids 0]
6206         if {[info exists colormap($child)]
6207             && [llength $parents($curview,$child)] == 1} {
6208             set colormap($id) $colormap($child)
6209             return
6210         }
6211     }
6212     set badcolors {}
6213     set origbad {}
6214     foreach x [findcrossings $id] {
6215         if {$x eq {}} {
6216             # delimiter between corner crossings and other crossings
6217             if {[llength $badcolors] >= $ncolors - 1} break
6218             set origbad $badcolors
6219         }
6220         if {[info exists colormap($x)]
6221             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6222             lappend badcolors $colormap($x)
6223         }
6224     }
6225     if {[llength $badcolors] >= $ncolors} {
6226         set badcolors $origbad
6227     }
6228     set origbad $badcolors
6229     if {[llength $badcolors] < $ncolors - 1} {
6230         foreach child $kids {
6231             if {[info exists colormap($child)]
6232                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6233                 lappend badcolors $colormap($child)
6234             }
6235             foreach p $parents($curview,$child) {
6236                 if {[info exists colormap($p)]
6237                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6238                     lappend badcolors $colormap($p)
6239                 }
6240             }
6241         }
6242         if {[llength $badcolors] >= $ncolors} {
6243             set badcolors $origbad
6244         }
6245     }
6246     for {set i 0} {$i <= $ncolors} {incr i} {
6247         set c [lindex $colors $nextcolor]
6248         if {[incr nextcolor] >= $ncolors} {
6249             set nextcolor 0
6250         }
6251         if {[lsearch -exact $badcolors $c]} break
6252     }
6253     set colormap($id) $c
6254 }
6255
6256 proc bindline {t id} {
6257     global canv
6258
6259     $canv bind $t <Enter> "lineenter %x %y $id"
6260     $canv bind $t <Motion> "linemotion %x %y $id"
6261     $canv bind $t <Leave> "lineleave $id"
6262     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6263 }
6264
6265 proc drawtags {id x xt y1} {
6266     global idtags idheads idotherrefs mainhead
6267     global linespc lthickness
6268     global canv rowtextx curview fgcolor bgcolor ctxbut
6269
6270     set marks {}
6271     set ntags 0
6272     set nheads 0
6273     if {[info exists idtags($id)]} {
6274         set marks $idtags($id)
6275         set ntags [llength $marks]
6276     }
6277     if {[info exists idheads($id)]} {
6278         set marks [concat $marks $idheads($id)]
6279         set nheads [llength $idheads($id)]
6280     }
6281     if {[info exists idotherrefs($id)]} {
6282         set marks [concat $marks $idotherrefs($id)]
6283     }
6284     if {$marks eq {}} {
6285         return $xt
6286     }
6287
6288     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6289     set yt [expr {$y1 - 0.5 * $linespc}]
6290     set yb [expr {$yt + $linespc - 1}]
6291     set xvals {}
6292     set wvals {}
6293     set i -1
6294     foreach tag $marks {
6295         incr i
6296         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6297             set wid [font measure mainfontbold $tag]
6298         } else {
6299             set wid [font measure mainfont $tag]
6300         }
6301         lappend xvals $xt
6302         lappend wvals $wid
6303         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6304     }
6305     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6306                -width $lthickness -fill black -tags tag.$id]
6307     $canv lower $t
6308     foreach tag $marks x $xvals wid $wvals {
6309         set tag_quoted [string map {% %%} $tag]
6310         set xl [expr {$x + $delta}]
6311         set xr [expr {$x + $delta + $wid + $lthickness}]
6312         set font mainfont
6313         if {[incr ntags -1] >= 0} {
6314             # draw a tag
6315             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6316                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6317                        -width 1 -outline black -fill yellow -tags tag.$id]
6318             $canv bind $t <1> [list showtag $tag_quoted 1]
6319             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6320         } else {
6321             # draw a head or other ref
6322             if {[incr nheads -1] >= 0} {
6323                 set col green
6324                 if {$tag eq $mainhead} {
6325                     set font mainfontbold
6326                 }
6327             } else {
6328                 set col "#ddddff"
6329             }
6330             set xl [expr {$xl - $delta/2}]
6331             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6332                 -width 1 -outline black -fill $col -tags tag.$id
6333             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6334                 set rwid [font measure mainfont $remoteprefix]
6335                 set xi [expr {$x + 1}]
6336                 set yti [expr {$yt + 1}]
6337                 set xri [expr {$x + $rwid}]
6338                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6339                         -width 0 -fill "#ffddaa" -tags tag.$id
6340             }
6341         }
6342         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6343                    -font $font -tags [list tag.$id text]]
6344         if {$ntags >= 0} {
6345             $canv bind $t <1> [list showtag $tag_quoted 1]
6346         } elseif {$nheads >= 0} {
6347             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6348         }
6349     }
6350     return $xt
6351 }
6352
6353 proc drawnotesign {xt y} {
6354     global linespc canv fgcolor
6355
6356     set orad [expr {$linespc / 3}]
6357     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6358                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6359                -fill yellow -outline $fgcolor -width 1 -tags circle]
6360     set xt [expr {$xt + $orad * 3}]
6361     return $xt
6362 }
6363
6364 proc xcoord {i level ln} {
6365     global canvx0 xspc1 xspc2
6366
6367     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6368     if {$i > 0 && $i == $level} {
6369         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6370     } elseif {$i > $level} {
6371         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6372     }
6373     return $x
6374 }
6375
6376 proc show_status {msg} {
6377     global canv fgcolor
6378
6379     clear_display
6380     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6381         -tags text -fill $fgcolor
6382 }
6383
6384 # Don't change the text pane cursor if it is currently the hand cursor,
6385 # showing that we are over a sha1 ID link.
6386 proc settextcursor {c} {
6387     global ctext curtextcursor
6388
6389     if {[$ctext cget -cursor] == $curtextcursor} {
6390         $ctext config -cursor $c
6391     }
6392     set curtextcursor $c
6393 }
6394
6395 proc nowbusy {what {name {}}} {
6396     global isbusy busyname statusw
6397
6398     if {[array names isbusy] eq {}} {
6399         . config -cursor watch
6400         settextcursor watch
6401     }
6402     set isbusy($what) 1
6403     set busyname($what) $name
6404     if {$name ne {}} {
6405         $statusw conf -text $name
6406     }
6407 }
6408
6409 proc notbusy {what} {
6410     global isbusy maincursor textcursor busyname statusw
6411
6412     catch {
6413         unset isbusy($what)
6414         if {$busyname($what) ne {} &&
6415             [$statusw cget -text] eq $busyname($what)} {
6416             $statusw conf -text {}
6417         }
6418     }
6419     if {[array names isbusy] eq {}} {
6420         . config -cursor $maincursor
6421         settextcursor $textcursor
6422     }
6423 }
6424
6425 proc findmatches {f} {
6426     global findtype findstring
6427     if {$findtype == [mc "Regexp"]} {
6428         set matches [regexp -indices -all -inline $findstring $f]
6429     } else {
6430         set fs $findstring
6431         if {$findtype == [mc "IgnCase"]} {
6432             set f [string tolower $f]
6433             set fs [string tolower $fs]
6434         }
6435         set matches {}
6436         set i 0
6437         set l [string length $fs]
6438         while {[set j [string first $fs $f $i]] >= 0} {
6439             lappend matches [list $j [expr {$j+$l-1}]]
6440             set i [expr {$j + $l}]
6441         }
6442     }
6443     return $matches
6444 }
6445
6446 proc dofind {{dirn 1} {wrap 1}} {
6447     global findstring findstartline findcurline selectedline numcommits
6448     global gdttype filehighlight fh_serial find_dirn findallowwrap
6449
6450     if {[info exists find_dirn]} {
6451         if {$find_dirn == $dirn} return
6452         stopfinding
6453     }
6454     focus .
6455     if {$findstring eq {} || $numcommits == 0} return
6456     if {$selectedline eq {}} {
6457         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6458     } else {
6459         set findstartline $selectedline
6460     }
6461     set findcurline $findstartline
6462     nowbusy finding [mc "Searching"]
6463     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6464         after cancel do_file_hl $fh_serial
6465         do_file_hl $fh_serial
6466     }
6467     set find_dirn $dirn
6468     set findallowwrap $wrap
6469     run findmore
6470 }
6471
6472 proc stopfinding {} {
6473     global find_dirn findcurline fprogcoord
6474
6475     if {[info exists find_dirn]} {
6476         unset find_dirn
6477         unset findcurline
6478         notbusy finding
6479         set fprogcoord 0
6480         adjustprogress
6481     }
6482     stopblaming
6483 }
6484
6485 proc findmore {} {
6486     global commitdata commitinfo numcommits findpattern findloc
6487     global findstartline findcurline findallowwrap
6488     global find_dirn gdttype fhighlights fprogcoord
6489     global curview varcorder vrownum varccommits vrowmod
6490
6491     if {![info exists find_dirn]} {
6492         return 0
6493     }
6494     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6495     set l $findcurline
6496     set moretodo 0
6497     if {$find_dirn > 0} {
6498         incr l
6499         if {$l >= $numcommits} {
6500             set l 0
6501         }
6502         if {$l <= $findstartline} {
6503             set lim [expr {$findstartline + 1}]
6504         } else {
6505             set lim $numcommits
6506             set moretodo $findallowwrap
6507         }
6508     } else {
6509         if {$l == 0} {
6510             set l $numcommits
6511         }
6512         incr l -1
6513         if {$l >= $findstartline} {
6514             set lim [expr {$findstartline - 1}]
6515         } else {
6516             set lim -1
6517             set moretodo $findallowwrap
6518         }
6519     }
6520     set n [expr {($lim - $l) * $find_dirn}]
6521     if {$n > 500} {
6522         set n 500
6523         set moretodo 1
6524     }
6525     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6526         update_arcrows $curview
6527     }
6528     set found 0
6529     set domore 1
6530     set ai [bsearch $vrownum($curview) $l]
6531     set a [lindex $varcorder($curview) $ai]
6532     set arow [lindex $vrownum($curview) $ai]
6533     set ids [lindex $varccommits($curview,$a)]
6534     set arowend [expr {$arow + [llength $ids]}]
6535     if {$gdttype eq [mc "containing:"]} {
6536         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6537             if {$l < $arow || $l >= $arowend} {
6538                 incr ai $find_dirn
6539                 set a [lindex $varcorder($curview) $ai]
6540                 set arow [lindex $vrownum($curview) $ai]
6541                 set ids [lindex $varccommits($curview,$a)]
6542                 set arowend [expr {$arow + [llength $ids]}]
6543             }
6544             set id [lindex $ids [expr {$l - $arow}]]
6545             # shouldn't happen unless git log doesn't give all the commits...
6546             if {![info exists commitdata($id)] ||
6547                 ![doesmatch $commitdata($id)]} {
6548                 continue
6549             }
6550             if {![info exists commitinfo($id)]} {
6551                 getcommit $id
6552             }
6553             set info $commitinfo($id)
6554             foreach f $info ty $fldtypes {
6555                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6556                     [doesmatch $f]} {
6557                     set found 1
6558                     break
6559                 }
6560             }
6561             if {$found} break
6562         }
6563     } else {
6564         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6565             if {$l < $arow || $l >= $arowend} {
6566                 incr ai $find_dirn
6567                 set a [lindex $varcorder($curview) $ai]
6568                 set arow [lindex $vrownum($curview) $ai]
6569                 set ids [lindex $varccommits($curview,$a)]
6570                 set arowend [expr {$arow + [llength $ids]}]
6571             }
6572             set id [lindex $ids [expr {$l - $arow}]]
6573             if {![info exists fhighlights($id)]} {
6574                 # this sets fhighlights($id) to -1
6575                 askfilehighlight $l $id
6576             }
6577             if {$fhighlights($id) > 0} {
6578                 set found $domore
6579                 break
6580             }
6581             if {$fhighlights($id) < 0} {
6582                 if {$domore} {
6583                     set domore 0
6584                     set findcurline [expr {$l - $find_dirn}]
6585                 }
6586             }
6587         }
6588     }
6589     if {$found || ($domore && !$moretodo)} {
6590         unset findcurline
6591         unset find_dirn
6592         notbusy finding
6593         set fprogcoord 0
6594         adjustprogress
6595         if {$found} {
6596             findselectline $l
6597         } else {
6598             bell
6599         }
6600         return 0
6601     }
6602     if {!$domore} {
6603         flushhighlights
6604     } else {
6605         set findcurline [expr {$l - $find_dirn}]
6606     }
6607     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6608     if {$n < 0} {
6609         incr n $numcommits
6610     }
6611     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6612     adjustprogress
6613     return $domore
6614 }
6615
6616 proc findselectline {l} {
6617     global findloc commentend ctext findcurline markingmatches gdttype
6618
6619     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6620     set findcurline $l
6621     selectline $l 1
6622     if {$markingmatches &&
6623         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6624         # highlight the matches in the comments
6625         set f [$ctext get 1.0 $commentend]
6626         set matches [findmatches $f]
6627         foreach match $matches {
6628             set start [lindex $match 0]
6629             set end [expr {[lindex $match 1] + 1}]
6630             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6631         }
6632     }
6633     drawvisible
6634 }
6635
6636 # mark the bits of a headline or author that match a find string
6637 proc markmatches {canv l str tag matches font row} {
6638     global selectedline
6639
6640     set bbox [$canv bbox $tag]
6641     set x0 [lindex $bbox 0]
6642     set y0 [lindex $bbox 1]
6643     set y1 [lindex $bbox 3]
6644     foreach match $matches {
6645         set start [lindex $match 0]
6646         set end [lindex $match 1]
6647         if {$start > $end} continue
6648         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6649         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6650         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6651                    [expr {$x0+$xlen+2}] $y1 \
6652                    -outline {} -tags [list match$l matches] -fill yellow]
6653         $canv lower $t
6654         if {$row == $selectedline} {
6655             $canv raise $t secsel
6656         }
6657     }
6658 }
6659
6660 proc unmarkmatches {} {
6661     global markingmatches
6662
6663     allcanvs delete matches
6664     set markingmatches 0
6665     stopfinding
6666 }
6667
6668 proc selcanvline {w x y} {
6669     global canv canvy0 ctext linespc
6670     global rowtextx
6671     set ymax [lindex [$canv cget -scrollregion] 3]
6672     if {$ymax == {}} return
6673     set yfrac [lindex [$canv yview] 0]
6674     set y [expr {$y + $yfrac * $ymax}]
6675     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6676     if {$l < 0} {
6677         set l 0
6678     }
6679     if {$w eq $canv} {
6680         set xmax [lindex [$canv cget -scrollregion] 2]
6681         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6682         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6683     }
6684     unmarkmatches
6685     selectline $l 1
6686 }
6687
6688 proc commit_descriptor {p} {
6689     global commitinfo
6690     if {![info exists commitinfo($p)]} {
6691         getcommit $p
6692     }
6693     set l "..."
6694     if {[llength $commitinfo($p)] > 1} {
6695         set l [lindex $commitinfo($p) 0]
6696     }
6697     return "$p ($l)\n"
6698 }
6699
6700 # append some text to the ctext widget, and make any SHA1 ID
6701 # that we know about be a clickable link.
6702 proc appendwithlinks {text tags} {
6703     global ctext linknum curview
6704
6705     set start [$ctext index "end - 1c"]
6706     $ctext insert end $text $tags
6707     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6708     foreach l $links {
6709         set s [lindex $l 0]
6710         set e [lindex $l 1]
6711         set linkid [string range $text $s $e]
6712         incr e
6713         $ctext tag delete link$linknum
6714         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6715         setlink $linkid link$linknum
6716         incr linknum
6717     }
6718 }
6719
6720 proc setlink {id lk} {
6721     global curview ctext pendinglinks
6722
6723     set known 0
6724     if {[string length $id] < 40} {
6725         set matches [longid $id]
6726         if {[llength $matches] > 0} {
6727             if {[llength $matches] > 1} return
6728             set known 1
6729             set id [lindex $matches 0]
6730         }
6731     } else {
6732         set known [commitinview $id $curview]
6733     }
6734     if {$known} {
6735         $ctext tag conf $lk -foreground blue -underline 1
6736         $ctext tag bind $lk <1> [list selbyid $id]
6737         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6738         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6739     } else {
6740         lappend pendinglinks($id) $lk
6741         interestedin $id {makelink %P}
6742     }
6743 }
6744
6745 proc appendshortlink {id {pre {}} {post {}}} {
6746     global ctext linknum
6747
6748     $ctext insert end $pre
6749     $ctext tag delete link$linknum
6750     $ctext insert end [string range $id 0 7] link$linknum
6751     $ctext insert end $post
6752     setlink $id link$linknum
6753     incr linknum
6754 }
6755
6756 proc makelink {id} {
6757     global pendinglinks
6758
6759     if {![info exists pendinglinks($id)]} return
6760     foreach lk $pendinglinks($id) {
6761         setlink $id $lk
6762     }
6763     unset pendinglinks($id)
6764 }
6765
6766 proc linkcursor {w inc} {
6767     global linkentercount curtextcursor
6768
6769     if {[incr linkentercount $inc] > 0} {
6770         $w configure -cursor hand2
6771     } else {
6772         $w configure -cursor $curtextcursor
6773         if {$linkentercount < 0} {
6774             set linkentercount 0
6775         }
6776     }
6777 }
6778
6779 proc viewnextline {dir} {
6780     global canv linespc
6781
6782     $canv delete hover
6783     set ymax [lindex [$canv cget -scrollregion] 3]
6784     set wnow [$canv yview]
6785     set wtop [expr {[lindex $wnow 0] * $ymax}]
6786     set newtop [expr {$wtop + $dir * $linespc}]
6787     if {$newtop < 0} {
6788         set newtop 0
6789     } elseif {$newtop > $ymax} {
6790         set newtop $ymax
6791     }
6792     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6793 }
6794
6795 # add a list of tag or branch names at position pos
6796 # returns the number of names inserted
6797 proc appendrefs {pos ids var} {
6798     global ctext linknum curview $var maxrefs
6799
6800     if {[catch {$ctext index $pos}]} {
6801         return 0
6802     }
6803     $ctext conf -state normal
6804     $ctext delete $pos "$pos lineend"
6805     set tags {}
6806     foreach id $ids {
6807         foreach tag [set $var\($id\)] {
6808             lappend tags [list $tag $id]
6809         }
6810     }
6811     if {[llength $tags] > $maxrefs} {
6812         $ctext insert $pos "[mc "many"] ([llength $tags])"
6813     } else {
6814         set tags [lsort -index 0 -decreasing $tags]
6815         set sep {}
6816         foreach ti $tags {
6817             set id [lindex $ti 1]
6818             set lk link$linknum
6819             incr linknum
6820             $ctext tag delete $lk
6821             $ctext insert $pos $sep
6822             $ctext insert $pos [lindex $ti 0] $lk
6823             setlink $id $lk
6824             set sep ", "
6825         }
6826     }
6827     $ctext conf -state disabled
6828     return [llength $tags]
6829 }
6830
6831 # called when we have finished computing the nearby tags
6832 proc dispneartags {delay} {
6833     global selectedline currentid showneartags tagphase
6834
6835     if {$selectedline eq {} || !$showneartags} return
6836     after cancel dispnexttag
6837     if {$delay} {
6838         after 200 dispnexttag
6839         set tagphase -1
6840     } else {
6841         after idle dispnexttag
6842         set tagphase 0
6843     }
6844 }
6845
6846 proc dispnexttag {} {
6847     global selectedline currentid showneartags tagphase ctext
6848
6849     if {$selectedline eq {} || !$showneartags} return
6850     switch -- $tagphase {
6851         0 {
6852             set dtags [desctags $currentid]
6853             if {$dtags ne {}} {
6854                 appendrefs precedes $dtags idtags
6855             }
6856         }
6857         1 {
6858             set atags [anctags $currentid]
6859             if {$atags ne {}} {
6860                 appendrefs follows $atags idtags
6861             }
6862         }
6863         2 {
6864             set dheads [descheads $currentid]
6865             if {$dheads ne {}} {
6866                 if {[appendrefs branch $dheads idheads] > 1
6867                     && [$ctext get "branch -3c"] eq "h"} {
6868                     # turn "Branch" into "Branches"
6869                     $ctext conf -state normal
6870                     $ctext insert "branch -2c" "es"
6871                     $ctext conf -state disabled
6872                 }
6873             }
6874         }
6875     }
6876     if {[incr tagphase] <= 2} {
6877         after idle dispnexttag
6878     }
6879 }
6880
6881 proc make_secsel {id} {
6882     global linehtag linentag linedtag canv canv2 canv3
6883
6884     if {![info exists linehtag($id)]} return
6885     $canv delete secsel
6886     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6887                -tags secsel -fill [$canv cget -selectbackground]]
6888     $canv lower $t
6889     $canv2 delete secsel
6890     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6891                -tags secsel -fill [$canv2 cget -selectbackground]]
6892     $canv2 lower $t
6893     $canv3 delete secsel
6894     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6895                -tags secsel -fill [$canv3 cget -selectbackground]]
6896     $canv3 lower $t
6897 }
6898
6899 proc make_idmark {id} {
6900     global linehtag canv fgcolor
6901
6902     if {![info exists linehtag($id)]} return
6903     $canv delete markid
6904     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6905                -tags markid -outline $fgcolor]
6906     $canv raise $t
6907 }
6908
6909 proc selectline {l isnew {desired_loc {}}} {
6910     global canv ctext commitinfo selectedline
6911     global canvy0 linespc parents children curview
6912     global currentid sha1entry
6913     global commentend idtags linknum
6914     global mergemax numcommits pending_select
6915     global cmitmode showneartags allcommits
6916     global targetrow targetid lastscrollrows
6917     global autoselect autosellen jump_to_here
6918
6919     catch {unset pending_select}
6920     $canv delete hover
6921     normalline
6922     unsel_reflist
6923     stopfinding
6924     if {$l < 0 || $l >= $numcommits} return
6925     set id [commitonrow $l]
6926     set targetid $id
6927     set targetrow $l
6928     set selectedline $l
6929     set currentid $id
6930     if {$lastscrollrows < $numcommits} {
6931         setcanvscroll
6932     }
6933
6934     set y [expr {$canvy0 + $l * $linespc}]
6935     set ymax [lindex [$canv cget -scrollregion] 3]
6936     set ytop [expr {$y - $linespc - 1}]
6937     set ybot [expr {$y + $linespc + 1}]
6938     set wnow [$canv yview]
6939     set wtop [expr {[lindex $wnow 0] * $ymax}]
6940     set wbot [expr {[lindex $wnow 1] * $ymax}]
6941     set wh [expr {$wbot - $wtop}]
6942     set newtop $wtop
6943     if {$ytop < $wtop} {
6944         if {$ybot < $wtop} {
6945             set newtop [expr {$y - $wh / 2.0}]
6946         } else {
6947             set newtop $ytop
6948             if {$newtop > $wtop - $linespc} {
6949                 set newtop [expr {$wtop - $linespc}]
6950             }
6951         }
6952     } elseif {$ybot > $wbot} {
6953         if {$ytop > $wbot} {
6954             set newtop [expr {$y - $wh / 2.0}]
6955         } else {
6956             set newtop [expr {$ybot - $wh}]
6957             if {$newtop < $wtop + $linespc} {
6958                 set newtop [expr {$wtop + $linespc}]
6959             }
6960         }
6961     }
6962     if {$newtop != $wtop} {
6963         if {$newtop < 0} {
6964             set newtop 0
6965         }
6966         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6967         drawvisible
6968     }
6969
6970     make_secsel $id
6971
6972     if {$isnew} {
6973         addtohistory [list selbyid $id 0] savecmitpos
6974     }
6975
6976     $sha1entry delete 0 end
6977     $sha1entry insert 0 $id
6978     if {$autoselect} {
6979         $sha1entry selection range 0 $autosellen
6980     }
6981     rhighlight_sel $id
6982
6983     $ctext conf -state normal
6984     clear_ctext
6985     set linknum 0
6986     if {![info exists commitinfo($id)]} {
6987         getcommit $id
6988     }
6989     set info $commitinfo($id)
6990     set date [formatdate [lindex $info 2]]
6991     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6992     set date [formatdate [lindex $info 4]]
6993     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6994     if {[info exists idtags($id)]} {
6995         $ctext insert end [mc "Tags:"]
6996         foreach tag $idtags($id) {
6997             $ctext insert end " $tag"
6998         }
6999         $ctext insert end "\n"
7000     }
7001
7002     set headers {}
7003     set olds $parents($curview,$id)
7004     if {[llength $olds] > 1} {
7005         set np 0
7006         foreach p $olds {
7007             if {$np >= $mergemax} {
7008                 set tag mmax
7009             } else {
7010                 set tag m$np
7011             }
7012             $ctext insert end "[mc "Parent"]: " $tag
7013             appendwithlinks [commit_descriptor $p] {}
7014             incr np
7015         }
7016     } else {
7017         foreach p $olds {
7018             append headers "[mc "Parent"]: [commit_descriptor $p]"
7019         }
7020     }
7021
7022     foreach c $children($curview,$id) {
7023         append headers "[mc "Child"]:  [commit_descriptor $c]"
7024     }
7025
7026     # make anything that looks like a SHA1 ID be a clickable link
7027     appendwithlinks $headers {}
7028     if {$showneartags} {
7029         if {![info exists allcommits]} {
7030             getallcommits
7031         }
7032         $ctext insert end "[mc "Branch"]: "
7033         $ctext mark set branch "end -1c"
7034         $ctext mark gravity branch left
7035         $ctext insert end "\n[mc "Follows"]: "
7036         $ctext mark set follows "end -1c"
7037         $ctext mark gravity follows left
7038         $ctext insert end "\n[mc "Precedes"]: "
7039         $ctext mark set precedes "end -1c"
7040         $ctext mark gravity precedes left
7041         $ctext insert end "\n"
7042         dispneartags 1
7043     }
7044     $ctext insert end "\n"
7045     set comment [lindex $info 5]
7046     if {[string first "\r" $comment] >= 0} {
7047         set comment [string map {"\r" "\n    "} $comment]
7048     }
7049     appendwithlinks $comment {comment}
7050
7051     $ctext tag remove found 1.0 end
7052     $ctext conf -state disabled
7053     set commentend [$ctext index "end - 1c"]
7054
7055     set jump_to_here $desired_loc
7056     init_flist [mc "Comments"]
7057     if {$cmitmode eq "tree"} {
7058         gettree $id
7059     } elseif {[llength $olds] <= 1} {
7060         startdiff $id
7061     } else {
7062         mergediff $id
7063     }
7064 }
7065
7066 proc selfirstline {} {
7067     unmarkmatches
7068     selectline 0 1
7069 }
7070
7071 proc sellastline {} {
7072     global numcommits
7073     unmarkmatches
7074     set l [expr {$numcommits - 1}]
7075     selectline $l 1
7076 }
7077
7078 proc selnextline {dir} {
7079     global selectedline
7080     focus .
7081     if {$selectedline eq {}} return
7082     set l [expr {$selectedline + $dir}]
7083     unmarkmatches
7084     selectline $l 1
7085 }
7086
7087 proc selnextpage {dir} {
7088     global canv linespc selectedline numcommits
7089
7090     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7091     if {$lpp < 1} {
7092         set lpp 1
7093     }
7094     allcanvs yview scroll [expr {$dir * $lpp}] units
7095     drawvisible
7096     if {$selectedline eq {}} return
7097     set l [expr {$selectedline + $dir * $lpp}]
7098     if {$l < 0} {
7099         set l 0
7100     } elseif {$l >= $numcommits} {
7101         set l [expr $numcommits - 1]
7102     }
7103     unmarkmatches
7104     selectline $l 1
7105 }
7106
7107 proc unselectline {} {
7108     global selectedline currentid
7109
7110     set selectedline {}
7111     catch {unset currentid}
7112     allcanvs delete secsel
7113     rhighlight_none
7114 }
7115
7116 proc reselectline {} {
7117     global selectedline
7118
7119     if {$selectedline ne {}} {
7120         selectline $selectedline 0
7121     }
7122 }
7123
7124 proc addtohistory {cmd {saveproc {}}} {
7125     global history historyindex curview
7126
7127     unset_posvars
7128     save_position
7129     set elt [list $curview $cmd $saveproc {}]
7130     if {$historyindex > 0
7131         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7132         return
7133     }
7134
7135     if {$historyindex < [llength $history]} {
7136         set history [lreplace $history $historyindex end $elt]
7137     } else {
7138         lappend history $elt
7139     }
7140     incr historyindex
7141     if {$historyindex > 1} {
7142         .tf.bar.leftbut conf -state normal
7143     } else {
7144         .tf.bar.leftbut conf -state disabled
7145     }
7146     .tf.bar.rightbut conf -state disabled
7147 }
7148
7149 # save the scrolling position of the diff display pane
7150 proc save_position {} {
7151     global historyindex history
7152
7153     if {$historyindex < 1} return
7154     set hi [expr {$historyindex - 1}]
7155     set fn [lindex $history $hi 2]
7156     if {$fn ne {}} {
7157         lset history $hi 3 [eval $fn]
7158     }
7159 }
7160
7161 proc unset_posvars {} {
7162     global last_posvars
7163
7164     if {[info exists last_posvars]} {
7165         foreach {var val} $last_posvars {
7166             global $var
7167             catch {unset $var}
7168         }
7169         unset last_posvars
7170     }
7171 }
7172
7173 proc godo {elt} {
7174     global curview last_posvars
7175
7176     set view [lindex $elt 0]
7177     set cmd [lindex $elt 1]
7178     set pv [lindex $elt 3]
7179     if {$curview != $view} {
7180         showview $view
7181     }
7182     unset_posvars
7183     foreach {var val} $pv {
7184         global $var
7185         set $var $val
7186     }
7187     set last_posvars $pv
7188     eval $cmd
7189 }
7190
7191 proc goback {} {
7192     global history historyindex
7193     focus .
7194
7195     if {$historyindex > 1} {
7196         save_position
7197         incr historyindex -1
7198         godo [lindex $history [expr {$historyindex - 1}]]
7199         .tf.bar.rightbut conf -state normal
7200     }
7201     if {$historyindex <= 1} {
7202         .tf.bar.leftbut conf -state disabled
7203     }
7204 }
7205
7206 proc goforw {} {
7207     global history historyindex
7208     focus .
7209
7210     if {$historyindex < [llength $history]} {
7211         save_position
7212         set cmd [lindex $history $historyindex]
7213         incr historyindex
7214         godo $cmd
7215         .tf.bar.leftbut conf -state normal
7216     }
7217     if {$historyindex >= [llength $history]} {
7218         .tf.bar.rightbut conf -state disabled
7219     }
7220 }
7221
7222 proc gettree {id} {
7223     global treefilelist treeidlist diffids diffmergeid treepending
7224     global nullid nullid2
7225
7226     set diffids $id
7227     catch {unset diffmergeid}
7228     if {![info exists treefilelist($id)]} {
7229         if {![info exists treepending]} {
7230             if {$id eq $nullid} {
7231                 set cmd [list | git ls-files]
7232             } elseif {$id eq $nullid2} {
7233                 set cmd [list | git ls-files --stage -t]
7234             } else {
7235                 set cmd [list | git ls-tree -r $id]
7236             }
7237             if {[catch {set gtf [open $cmd r]}]} {
7238                 return
7239             }
7240             set treepending $id
7241             set treefilelist($id) {}
7242             set treeidlist($id) {}
7243             fconfigure $gtf -blocking 0 -encoding binary
7244             filerun $gtf [list gettreeline $gtf $id]
7245         }
7246     } else {
7247         setfilelist $id
7248     }
7249 }
7250
7251 proc gettreeline {gtf id} {
7252     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7253
7254     set nl 0
7255     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7256         if {$diffids eq $nullid} {
7257             set fname $line
7258         } else {
7259             set i [string first "\t" $line]
7260             if {$i < 0} continue
7261             set fname [string range $line [expr {$i+1}] end]
7262             set line [string range $line 0 [expr {$i-1}]]
7263             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7264             set sha1 [lindex $line 2]
7265             lappend treeidlist($id) $sha1
7266         }
7267         if {[string index $fname 0] eq "\""} {
7268             set fname [lindex $fname 0]
7269         }
7270         set fname [encoding convertfrom $fname]
7271         lappend treefilelist($id) $fname
7272     }
7273     if {![eof $gtf]} {
7274         return [expr {$nl >= 1000? 2: 1}]
7275     }
7276     close $gtf
7277     unset treepending
7278     if {$cmitmode ne "tree"} {
7279         if {![info exists diffmergeid]} {
7280             gettreediffs $diffids
7281         }
7282     } elseif {$id ne $diffids} {
7283         gettree $diffids
7284     } else {
7285         setfilelist $id
7286     }
7287     return 0
7288 }
7289
7290 proc showfile {f} {
7291     global treefilelist treeidlist diffids nullid nullid2
7292     global ctext_file_names ctext_file_lines
7293     global ctext commentend
7294
7295     set i [lsearch -exact $treefilelist($diffids) $f]
7296     if {$i < 0} {
7297         puts "oops, $f not in list for id $diffids"
7298         return
7299     }
7300     if {$diffids eq $nullid} {
7301         if {[catch {set bf [open $f r]} err]} {
7302             puts "oops, can't read $f: $err"
7303             return
7304         }
7305     } else {
7306         set blob [lindex $treeidlist($diffids) $i]
7307         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7308             puts "oops, error reading blob $blob: $err"
7309             return
7310         }
7311     }
7312     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7313     filerun $bf [list getblobline $bf $diffids]
7314     $ctext config -state normal
7315     clear_ctext $commentend
7316     lappend ctext_file_names $f
7317     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7318     $ctext insert end "\n"
7319     $ctext insert end "$f\n" filesep
7320     $ctext config -state disabled
7321     $ctext yview $commentend
7322     settabs 0
7323 }
7324
7325 proc getblobline {bf id} {
7326     global diffids cmitmode ctext
7327
7328     if {$id ne $diffids || $cmitmode ne "tree"} {
7329         catch {close $bf}
7330         return 0
7331     }
7332     $ctext config -state normal
7333     set nl 0
7334     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7335         $ctext insert end "$line\n"
7336     }
7337     if {[eof $bf]} {
7338         global jump_to_here ctext_file_names commentend
7339
7340         # delete last newline
7341         $ctext delete "end - 2c" "end - 1c"
7342         close $bf
7343         if {$jump_to_here ne {} &&
7344             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7345             set lnum [expr {[lindex $jump_to_here 1] +
7346                             [lindex [split $commentend .] 0]}]
7347             mark_ctext_line $lnum
7348         }
7349         $ctext config -state disabled
7350         return 0
7351     }
7352     $ctext config -state disabled
7353     return [expr {$nl >= 1000? 2: 1}]
7354 }
7355
7356 proc mark_ctext_line {lnum} {
7357     global ctext markbgcolor
7358
7359     $ctext tag delete omark
7360     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7361     $ctext tag conf omark -background $markbgcolor
7362     $ctext see $lnum.0
7363 }
7364
7365 proc mergediff {id} {
7366     global diffmergeid
7367     global diffids treediffs
7368     global parents curview
7369
7370     set diffmergeid $id
7371     set diffids $id
7372     set treediffs($id) {}
7373     set np [llength $parents($curview,$id)]
7374     settabs $np
7375     getblobdiffs $id
7376 }
7377
7378 proc startdiff {ids} {
7379     global treediffs diffids treepending diffmergeid nullid nullid2
7380
7381     settabs 1
7382     set diffids $ids
7383     catch {unset diffmergeid}
7384     if {![info exists treediffs($ids)] ||
7385         [lsearch -exact $ids $nullid] >= 0 ||
7386         [lsearch -exact $ids $nullid2] >= 0} {
7387         if {![info exists treepending]} {
7388             gettreediffs $ids
7389         }
7390     } else {
7391         addtocflist $ids
7392     }
7393 }
7394
7395 proc path_filter {filter name} {
7396     foreach p $filter {
7397         set l [string length $p]
7398         if {[string index $p end] eq "/"} {
7399             if {[string compare -length $l $p $name] == 0} {
7400                 return 1
7401             }
7402         } else {
7403             if {[string compare -length $l $p $name] == 0 &&
7404                 ([string length $name] == $l ||
7405                  [string index $name $l] eq "/")} {
7406                 return 1
7407             }
7408         }
7409     }
7410     return 0
7411 }
7412
7413 proc addtocflist {ids} {
7414     global treediffs
7415
7416     add_flist $treediffs($ids)
7417     getblobdiffs $ids
7418 }
7419
7420 proc diffcmd {ids flags} {
7421     global nullid nullid2
7422
7423     set i [lsearch -exact $ids $nullid]
7424     set j [lsearch -exact $ids $nullid2]
7425     if {$i >= 0} {
7426         if {[llength $ids] > 1 && $j < 0} {
7427             # comparing working directory with some specific revision
7428             set cmd [concat | git diff-index $flags]
7429             if {$i == 0} {
7430                 lappend cmd -R [lindex $ids 1]
7431             } else {
7432                 lappend cmd [lindex $ids 0]
7433             }
7434         } else {
7435             # comparing working directory with index
7436             set cmd [concat | git diff-files $flags]
7437             if {$j == 1} {
7438                 lappend cmd -R
7439             }
7440         }
7441     } elseif {$j >= 0} {
7442         set cmd [concat | git diff-index --cached $flags]
7443         if {[llength $ids] > 1} {
7444             # comparing index with specific revision
7445             if {$j == 0} {
7446                 lappend cmd -R [lindex $ids 1]
7447             } else {
7448                 lappend cmd [lindex $ids 0]
7449             }
7450         } else {
7451             # comparing index with HEAD
7452             lappend cmd HEAD
7453         }
7454     } else {
7455         set cmd [concat | git diff-tree -r $flags $ids]
7456     }
7457     return $cmd
7458 }
7459
7460 proc gettreediffs {ids} {
7461     global treediff treepending
7462
7463     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7464
7465     set treepending $ids
7466     set treediff {}
7467     fconfigure $gdtf -blocking 0 -encoding binary
7468     filerun $gdtf [list gettreediffline $gdtf $ids]
7469 }
7470
7471 proc gettreediffline {gdtf ids} {
7472     global treediff treediffs treepending diffids diffmergeid
7473     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7474
7475     set nr 0
7476     set sublist {}
7477     set max 1000
7478     if {$perfile_attrs} {
7479         # cache_gitattr is slow, and even slower on win32 where we
7480         # have to invoke it for only about 30 paths at a time
7481         set max 500
7482         if {[tk windowingsystem] == "win32"} {
7483             set max 120
7484         }
7485     }
7486     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7487         set i [string first "\t" $line]
7488         if {$i >= 0} {
7489             set file [string range $line [expr {$i+1}] end]
7490             if {[string index $file 0] eq "\""} {
7491                 set file [lindex $file 0]
7492             }
7493             set file [encoding convertfrom $file]
7494             if {$file ne [lindex $treediff end]} {
7495                 lappend treediff $file
7496                 lappend sublist $file
7497             }
7498         }
7499     }
7500     if {$perfile_attrs} {
7501         cache_gitattr encoding $sublist
7502     }
7503     if {![eof $gdtf]} {
7504         return [expr {$nr >= $max? 2: 1}]
7505     }
7506     close $gdtf
7507     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7508         set flist {}
7509         foreach f $treediff {
7510             if {[path_filter $vfilelimit($curview) $f]} {
7511                 lappend flist $f
7512             }
7513         }
7514         set treediffs($ids) $flist
7515     } else {
7516         set treediffs($ids) $treediff
7517     }
7518     unset treepending
7519     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7520         gettree $diffids
7521     } elseif {$ids != $diffids} {
7522         if {![info exists diffmergeid]} {
7523             gettreediffs $diffids
7524         }
7525     } else {
7526         addtocflist $ids
7527     }
7528     return 0
7529 }
7530
7531 # empty string or positive integer
7532 proc diffcontextvalidate {v} {
7533     return [regexp {^(|[1-9][0-9]*)$} $v]
7534 }
7535
7536 proc diffcontextchange {n1 n2 op} {
7537     global diffcontextstring diffcontext
7538
7539     if {[string is integer -strict $diffcontextstring]} {
7540         if {$diffcontextstring >= 0} {
7541             set diffcontext $diffcontextstring
7542             reselectline
7543         }
7544     }
7545 }
7546
7547 proc changeignorespace {} {
7548     reselectline
7549 }
7550
7551 proc changeworddiff {name ix op} {
7552     reselectline
7553 }
7554
7555 proc getblobdiffs {ids} {
7556     global blobdifffd diffids env
7557     global diffinhdr treediffs
7558     global diffcontext
7559     global ignorespace
7560     global worddiff
7561     global limitdiffs vfilelimit curview
7562     global diffencoding targetline diffnparents
7563     global git_version currdiffsubmod
7564
7565     set textconv {}
7566     if {[package vcompare $git_version "1.6.1"] >= 0} {
7567         set textconv "--textconv"
7568     }
7569     set submodule {}
7570     if {[package vcompare $git_version "1.6.6"] >= 0} {
7571         set submodule "--submodule"
7572     }
7573     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7574     if {$ignorespace} {
7575         append cmd " -w"
7576     }
7577     if {$worddiff ne [mc "Line diff"]} {
7578         append cmd " --word-diff=porcelain"
7579     }
7580     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7581         set cmd [concat $cmd -- $vfilelimit($curview)]
7582     }
7583     if {[catch {set bdf [open $cmd r]} err]} {
7584         error_popup [mc "Error getting diffs: %s" $err]
7585         return
7586     }
7587     set targetline {}
7588     set diffnparents 0
7589     set diffinhdr 0
7590     set diffencoding [get_path_encoding {}]
7591     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7592     set blobdifffd($ids) $bdf
7593     set currdiffsubmod ""
7594     filerun $bdf [list getblobdiffline $bdf $diffids]
7595 }
7596
7597 proc savecmitpos {} {
7598     global ctext cmitmode
7599
7600     if {$cmitmode eq "tree"} {
7601         return {}
7602     }
7603     return [list target_scrollpos [$ctext index @0,0]]
7604 }
7605
7606 proc savectextpos {} {
7607     global ctext
7608
7609     return [list target_scrollpos [$ctext index @0,0]]
7610 }
7611
7612 proc maybe_scroll_ctext {ateof} {
7613     global ctext target_scrollpos
7614
7615     if {![info exists target_scrollpos]} return
7616     if {!$ateof} {
7617         set nlines [expr {[winfo height $ctext]
7618                           / [font metrics textfont -linespace]}]
7619         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7620     }
7621     $ctext yview $target_scrollpos
7622     unset target_scrollpos
7623 }
7624
7625 proc setinlist {var i val} {
7626     global $var
7627
7628     while {[llength [set $var]] < $i} {
7629         lappend $var {}
7630     }
7631     if {[llength [set $var]] == $i} {
7632         lappend $var $val
7633     } else {
7634         lset $var $i $val
7635     }
7636 }
7637
7638 proc makediffhdr {fname ids} {
7639     global ctext curdiffstart treediffs diffencoding
7640     global ctext_file_names jump_to_here targetline diffline
7641
7642     set fname [encoding convertfrom $fname]
7643     set diffencoding [get_path_encoding $fname]
7644     set i [lsearch -exact $treediffs($ids) $fname]
7645     if {$i >= 0} {
7646         setinlist difffilestart $i $curdiffstart
7647     }
7648     lset ctext_file_names end $fname
7649     set l [expr {(78 - [string length $fname]) / 2}]
7650     set pad [string range "----------------------------------------" 1 $l]
7651     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7652     set targetline {}
7653     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7654         set targetline [lindex $jump_to_here 1]
7655     }
7656     set diffline 0
7657 }
7658
7659 proc getblobdiffline {bdf ids} {
7660     global diffids blobdifffd ctext curdiffstart
7661     global diffnexthead diffnextnote difffilestart
7662     global ctext_file_names ctext_file_lines
7663     global diffinhdr treediffs mergemax diffnparents
7664     global diffencoding jump_to_here targetline diffline currdiffsubmod
7665     global worddiff
7666
7667     set nr 0
7668     $ctext conf -state normal
7669     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7670         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7671             catch {close $bdf}
7672             return 0
7673         }
7674         if {![string compare -length 5 "diff " $line]} {
7675             if {![regexp {^diff (--cc|--git) } $line m type]} {
7676                 set line [encoding convertfrom $line]
7677                 $ctext insert end "$line\n" hunksep
7678                 continue
7679             }
7680             # start of a new file
7681             set diffinhdr 1
7682             $ctext insert end "\n"
7683             set curdiffstart [$ctext index "end - 1c"]
7684             lappend ctext_file_names ""
7685             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7686             $ctext insert end "\n" filesep
7687
7688             if {$type eq "--cc"} {
7689                 # start of a new file in a merge diff
7690                 set fname [string range $line 10 end]
7691                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7692                     lappend treediffs($ids) $fname
7693                     add_flist [list $fname]
7694                 }
7695
7696             } else {
7697                 set line [string range $line 11 end]
7698                 # If the name hasn't changed the length will be odd,
7699                 # the middle char will be a space, and the two bits either
7700                 # side will be a/name and b/name, or "a/name" and "b/name".
7701                 # If the name has changed we'll get "rename from" and
7702                 # "rename to" or "copy from" and "copy to" lines following
7703                 # this, and we'll use them to get the filenames.
7704                 # This complexity is necessary because spaces in the
7705                 # filename(s) don't get escaped.
7706                 set l [string length $line]
7707                 set i [expr {$l / 2}]
7708                 if {!(($l & 1) && [string index $line $i] eq " " &&
7709                       [string range $line 2 [expr {$i - 1}]] eq \
7710                           [string range $line [expr {$i + 3}] end])} {
7711                     continue
7712                 }
7713                 # unescape if quoted and chop off the a/ from the front
7714                 if {[string index $line 0] eq "\""} {
7715                     set fname [string range [lindex $line 0] 2 end]
7716                 } else {
7717                     set fname [string range $line 2 [expr {$i - 1}]]
7718                 }
7719             }
7720             makediffhdr $fname $ids
7721
7722         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7723             set fname [encoding convertfrom [string range $line 16 end]]
7724             $ctext insert end "\n"
7725             set curdiffstart [$ctext index "end - 1c"]
7726             lappend ctext_file_names $fname
7727             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7728             $ctext insert end "$line\n" filesep
7729             set i [lsearch -exact $treediffs($ids) $fname]
7730             if {$i >= 0} {
7731                 setinlist difffilestart $i $curdiffstart
7732             }
7733
7734         } elseif {![string compare -length 2 "@@" $line]} {
7735             regexp {^@@+} $line ats
7736             set line [encoding convertfrom $diffencoding $line]
7737             $ctext insert end "$line\n" hunksep
7738             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7739                 set diffline $nl
7740             }
7741             set diffnparents [expr {[string length $ats] - 1}]
7742             set diffinhdr 0
7743
7744         } elseif {![string compare -length 10 "Submodule " $line]} {
7745             # start of a new submodule
7746             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7747                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7748             } else {
7749                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7750             }
7751             if {$currdiffsubmod != $fname} {
7752                 $ctext insert end "\n";     # Add newline after commit message
7753             }
7754             set curdiffstart [$ctext index "end - 1c"]
7755             lappend ctext_file_names ""
7756             if {$currdiffsubmod != $fname} {
7757                 lappend ctext_file_lines $fname
7758                 makediffhdr $fname $ids
7759                 set currdiffsubmod $fname
7760                 $ctext insert end "\n$line\n" filesep
7761             } else {
7762                 $ctext insert end "$line\n" filesep
7763             }
7764         } elseif {![string compare -length 3 "  >" $line]} {
7765             set $currdiffsubmod ""
7766             set line [encoding convertfrom $diffencoding $line]
7767             $ctext insert end "$line\n" dresult
7768         } elseif {![string compare -length 3 "  <" $line]} {
7769             set $currdiffsubmod ""
7770             set line [encoding convertfrom $diffencoding $line]
7771             $ctext insert end "$line\n" d0
7772         } elseif {$diffinhdr} {
7773             if {![string compare -length 12 "rename from " $line]} {
7774                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7775                 if {[string index $fname 0] eq "\""} {
7776                     set fname [lindex $fname 0]
7777                 }
7778                 set fname [encoding convertfrom $fname]
7779                 set i [lsearch -exact $treediffs($ids) $fname]
7780                 if {$i >= 0} {
7781                     setinlist difffilestart $i $curdiffstart
7782                 }
7783             } elseif {![string compare -length 10 $line "rename to "] ||
7784                       ![string compare -length 8 $line "copy to "]} {
7785                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7786                 if {[string index $fname 0] eq "\""} {
7787                     set fname [lindex $fname 0]
7788                 }
7789                 makediffhdr $fname $ids
7790             } elseif {[string compare -length 3 $line "---"] == 0} {
7791                 # do nothing
7792                 continue
7793             } elseif {[string compare -length 3 $line "+++"] == 0} {
7794                 set diffinhdr 0
7795                 continue
7796             }
7797             $ctext insert end "$line\n" filesep
7798
7799         } else {
7800             set line [string map {\x1A ^Z} \
7801                           [encoding convertfrom $diffencoding $line]]
7802             # parse the prefix - one ' ', '-' or '+' for each parent
7803             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7804             set tag [expr {$diffnparents > 1? "m": "d"}]
7805             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7806             set words_pre_markup ""
7807             set words_post_markup ""
7808             if {[string trim $prefix " -+"] eq {}} {
7809                 # prefix only has " ", "-" and "+" in it: normal diff line
7810                 set num [string first "-" $prefix]
7811                 if {$dowords} {
7812                     set line [string range $line 1 end]
7813                 }
7814                 if {$num >= 0} {
7815                     # removed line, first parent with line is $num
7816                     if {$num >= $mergemax} {
7817                         set num "max"
7818                     }
7819                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7820                         $ctext insert end "\[-$line-\]" $tag$num
7821                     } else {
7822                         $ctext insert end "$line" $tag$num
7823                     }
7824                     if {!$dowords} {
7825                         $ctext insert end "\n" $tag$num
7826                     }
7827                 } else {
7828                     set tags {}
7829                     if {[string first "+" $prefix] >= 0} {
7830                         # added line
7831                         lappend tags ${tag}result
7832                         if {$diffnparents > 1} {
7833                             set num [string first " " $prefix]
7834                             if {$num >= 0} {
7835                                 if {$num >= $mergemax} {
7836                                     set num "max"
7837                                 }
7838                                 lappend tags m$num
7839                             }
7840                         }
7841                         set words_pre_markup "{+"
7842                         set words_post_markup "+}"
7843                     }
7844                     if {$targetline ne {}} {
7845                         if {$diffline == $targetline} {
7846                             set seehere [$ctext index "end - 1 chars"]
7847                             set targetline {}
7848                         } else {
7849                             incr diffline
7850                         }
7851                     }
7852                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7853                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7854                     } else {
7855                         $ctext insert end "$line" $tags
7856                     }
7857                     if {!$dowords} {
7858                         $ctext insert end "\n" $tags
7859                     }
7860                 }
7861             } elseif {$dowords && $prefix eq "~"} {
7862                 $ctext insert end "\n" {}
7863             } else {
7864                 # "\ No newline at end of file",
7865                 # or something else we don't recognize
7866                 $ctext insert end "$line\n" hunksep
7867             }
7868         }
7869     }
7870     if {[info exists seehere]} {
7871         mark_ctext_line [lindex [split $seehere .] 0]
7872     }
7873     maybe_scroll_ctext [eof $bdf]
7874     $ctext conf -state disabled
7875     if {[eof $bdf]} {
7876         catch {close $bdf}
7877         return 0
7878     }
7879     return [expr {$nr >= 1000? 2: 1}]
7880 }
7881
7882 proc changediffdisp {} {
7883     global ctext diffelide
7884
7885     $ctext tag conf d0 -elide [lindex $diffelide 0]
7886     $ctext tag conf dresult -elide [lindex $diffelide 1]
7887 }
7888
7889 proc highlightfile {loc cline} {
7890     global ctext cflist cflist_top
7891
7892     $ctext yview $loc
7893     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7894     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7895     $cflist see $cline.0
7896     set cflist_top $cline
7897 }
7898
7899 proc prevfile {} {
7900     global difffilestart ctext cmitmode
7901
7902     if {$cmitmode eq "tree"} return
7903     set prev 0.0
7904     set prevline 1
7905     set here [$ctext index @0,0]
7906     foreach loc $difffilestart {
7907         if {[$ctext compare $loc >= $here]} {
7908             highlightfile $prev $prevline
7909             return
7910         }
7911         set prev $loc
7912         incr prevline
7913     }
7914     highlightfile $prev $prevline
7915 }
7916
7917 proc nextfile {} {
7918     global difffilestart ctext cmitmode
7919
7920     if {$cmitmode eq "tree"} return
7921     set here [$ctext index @0,0]
7922     set line 1
7923     foreach loc $difffilestart {
7924         incr line
7925         if {[$ctext compare $loc > $here]} {
7926             highlightfile $loc $line
7927             return
7928         }
7929     }
7930 }
7931
7932 proc clear_ctext {{first 1.0}} {
7933     global ctext smarktop smarkbot
7934     global ctext_file_names ctext_file_lines
7935     global pendinglinks
7936
7937     set l [lindex [split $first .] 0]
7938     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7939         set smarktop $l
7940     }
7941     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7942         set smarkbot $l
7943     }
7944     $ctext delete $first end
7945     if {$first eq "1.0"} {
7946         catch {unset pendinglinks}
7947     }
7948     set ctext_file_names {}
7949     set ctext_file_lines {}
7950 }
7951
7952 proc settabs {{firstab {}}} {
7953     global firsttabstop tabstop ctext have_tk85
7954
7955     if {$firstab ne {} && $have_tk85} {
7956         set firsttabstop $firstab
7957     }
7958     set w [font measure textfont "0"]
7959     if {$firsttabstop != 0} {
7960         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7961                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7962     } elseif {$have_tk85 || $tabstop != 8} {
7963         $ctext conf -tabs [expr {$tabstop * $w}]
7964     } else {
7965         $ctext conf -tabs {}
7966     }
7967 }
7968
7969 proc incrsearch {name ix op} {
7970     global ctext searchstring searchdirn
7971
7972     $ctext tag remove found 1.0 end
7973     if {[catch {$ctext index anchor}]} {
7974         # no anchor set, use start of selection, or of visible area
7975         set sel [$ctext tag ranges sel]
7976         if {$sel ne {}} {
7977             $ctext mark set anchor [lindex $sel 0]
7978         } elseif {$searchdirn eq "-forwards"} {
7979             $ctext mark set anchor @0,0
7980         } else {
7981             $ctext mark set anchor @0,[winfo height $ctext]
7982         }
7983     }
7984     if {$searchstring ne {}} {
7985         set here [$ctext search $searchdirn -- $searchstring anchor]
7986         if {$here ne {}} {
7987             $ctext see $here
7988         }
7989         searchmarkvisible 1
7990     }
7991 }
7992
7993 proc dosearch {} {
7994     global sstring ctext searchstring searchdirn
7995
7996     focus $sstring
7997     $sstring icursor end
7998     set searchdirn -forwards
7999     if {$searchstring ne {}} {
8000         set sel [$ctext tag ranges sel]
8001         if {$sel ne {}} {
8002             set start "[lindex $sel 0] + 1c"
8003         } elseif {[catch {set start [$ctext index anchor]}]} {
8004             set start "@0,0"
8005         }
8006         set match [$ctext search -count mlen -- $searchstring $start]
8007         $ctext tag remove sel 1.0 end
8008         if {$match eq {}} {
8009             bell
8010             return
8011         }
8012         $ctext see $match
8013         set mend "$match + $mlen c"
8014         $ctext tag add sel $match $mend
8015         $ctext mark unset anchor
8016     }
8017 }
8018
8019 proc dosearchback {} {
8020     global sstring ctext searchstring searchdirn
8021
8022     focus $sstring
8023     $sstring icursor end
8024     set searchdirn -backwards
8025     if {$searchstring ne {}} {
8026         set sel [$ctext tag ranges sel]
8027         if {$sel ne {}} {
8028             set start [lindex $sel 0]
8029         } elseif {[catch {set start [$ctext index anchor]}]} {
8030             set start @0,[winfo height $ctext]
8031         }
8032         set match [$ctext search -backwards -count ml -- $searchstring $start]
8033         $ctext tag remove sel 1.0 end
8034         if {$match eq {}} {
8035             bell
8036             return
8037         }
8038         $ctext see $match
8039         set mend "$match + $ml c"
8040         $ctext tag add sel $match $mend
8041         $ctext mark unset anchor
8042     }
8043 }
8044
8045 proc searchmark {first last} {
8046     global ctext searchstring
8047
8048     set mend $first.0
8049     while {1} {
8050         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8051         if {$match eq {}} break
8052         set mend "$match + $mlen c"
8053         $ctext tag add found $match $mend
8054     }
8055 }
8056
8057 proc searchmarkvisible {doall} {
8058     global ctext smarktop smarkbot
8059
8060     set topline [lindex [split [$ctext index @0,0] .] 0]
8061     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8062     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8063         # no overlap with previous
8064         searchmark $topline $botline
8065         set smarktop $topline
8066         set smarkbot $botline
8067     } else {
8068         if {$topline < $smarktop} {
8069             searchmark $topline [expr {$smarktop-1}]
8070             set smarktop $topline
8071         }
8072         if {$botline > $smarkbot} {
8073             searchmark [expr {$smarkbot+1}] $botline
8074             set smarkbot $botline
8075         }
8076     }
8077 }
8078
8079 proc scrolltext {f0 f1} {
8080     global searchstring
8081
8082     .bleft.bottom.sb set $f0 $f1
8083     if {$searchstring ne {}} {
8084         searchmarkvisible 0
8085     }
8086 }
8087
8088 proc setcoords {} {
8089     global linespc charspc canvx0 canvy0
8090     global xspc1 xspc2 lthickness
8091
8092     set linespc [font metrics mainfont -linespace]
8093     set charspc [font measure mainfont "m"]
8094     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8095     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8096     set lthickness [expr {int($linespc / 9) + 1}]
8097     set xspc1(0) $linespc
8098     set xspc2 $linespc
8099 }
8100
8101 proc redisplay {} {
8102     global canv
8103     global selectedline
8104
8105     set ymax [lindex [$canv cget -scrollregion] 3]
8106     if {$ymax eq {} || $ymax == 0} return
8107     set span [$canv yview]
8108     clear_display
8109     setcanvscroll
8110     allcanvs yview moveto [lindex $span 0]
8111     drawvisible
8112     if {$selectedline ne {}} {
8113         selectline $selectedline 0
8114         allcanvs yview moveto [lindex $span 0]
8115     }
8116 }
8117
8118 proc parsefont {f n} {
8119     global fontattr
8120
8121     set fontattr($f,family) [lindex $n 0]
8122     set s [lindex $n 1]
8123     if {$s eq {} || $s == 0} {
8124         set s 10
8125     } elseif {$s < 0} {
8126         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8127     }
8128     set fontattr($f,size) $s
8129     set fontattr($f,weight) normal
8130     set fontattr($f,slant) roman
8131     foreach style [lrange $n 2 end] {
8132         switch -- $style {
8133             "normal" -
8134             "bold"   {set fontattr($f,weight) $style}
8135             "roman" -
8136             "italic" {set fontattr($f,slant) $style}
8137         }
8138     }
8139 }
8140
8141 proc fontflags {f {isbold 0}} {
8142     global fontattr
8143
8144     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8145                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8146                 -slant $fontattr($f,slant)]
8147 }
8148
8149 proc fontname {f} {
8150     global fontattr
8151
8152     set n [list $fontattr($f,family) $fontattr($f,size)]
8153     if {$fontattr($f,weight) eq "bold"} {
8154         lappend n "bold"
8155     }
8156     if {$fontattr($f,slant) eq "italic"} {
8157         lappend n "italic"
8158     }
8159     return $n
8160 }
8161
8162 proc incrfont {inc} {
8163     global mainfont textfont ctext canv cflist showrefstop
8164     global stopped entries fontattr
8165
8166     unmarkmatches
8167     set s $fontattr(mainfont,size)
8168     incr s $inc
8169     if {$s < 1} {
8170         set s 1
8171     }
8172     set fontattr(mainfont,size) $s
8173     font config mainfont -size $s
8174     font config mainfontbold -size $s
8175     set mainfont [fontname mainfont]
8176     set s $fontattr(textfont,size)
8177     incr s $inc
8178     if {$s < 1} {
8179         set s 1
8180     }
8181     set fontattr(textfont,size) $s
8182     font config textfont -size $s
8183     font config textfontbold -size $s
8184     set textfont [fontname textfont]
8185     setcoords
8186     settabs
8187     redisplay
8188 }
8189
8190 proc clearsha1 {} {
8191     global sha1entry sha1string
8192     if {[string length $sha1string] == 40} {
8193         $sha1entry delete 0 end
8194     }
8195 }
8196
8197 proc sha1change {n1 n2 op} {
8198     global sha1string currentid sha1but
8199     if {$sha1string == {}
8200         || ([info exists currentid] && $sha1string == $currentid)} {
8201         set state disabled
8202     } else {
8203         set state normal
8204     }
8205     if {[$sha1but cget -state] == $state} return
8206     if {$state == "normal"} {
8207         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8208     } else {
8209         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8210     }
8211 }
8212
8213 proc gotocommit {} {
8214     global sha1string tagids headids curview varcid
8215
8216     if {$sha1string == {}
8217         || ([info exists currentid] && $sha1string == $currentid)} return
8218     if {[info exists tagids($sha1string)]} {
8219         set id $tagids($sha1string)
8220     } elseif {[info exists headids($sha1string)]} {
8221         set id $headids($sha1string)
8222     } else {
8223         set id [string tolower $sha1string]
8224         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8225             set matches [longid $id]
8226             if {$matches ne {}} {
8227                 if {[llength $matches] > 1} {
8228                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8229                     return
8230                 }
8231                 set id [lindex $matches 0]
8232             }
8233         } else {
8234             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8235                 error_popup [mc "Revision %s is not known" $sha1string]
8236                 return
8237             }
8238         }
8239     }
8240     if {[commitinview $id $curview]} {
8241         selectline [rowofcommit $id] 1
8242         return
8243     }
8244     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8245         set msg [mc "SHA1 id %s is not known" $sha1string]
8246     } else {
8247         set msg [mc "Revision %s is not in the current view" $sha1string]
8248     }
8249     error_popup $msg
8250 }
8251
8252 proc lineenter {x y id} {
8253     global hoverx hovery hoverid hovertimer
8254     global commitinfo canv
8255
8256     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8257     set hoverx $x
8258     set hovery $y
8259     set hoverid $id
8260     if {[info exists hovertimer]} {
8261         after cancel $hovertimer
8262     }
8263     set hovertimer [after 500 linehover]
8264     $canv delete hover
8265 }
8266
8267 proc linemotion {x y id} {
8268     global hoverx hovery hoverid hovertimer
8269
8270     if {[info exists hoverid] && $id == $hoverid} {
8271         set hoverx $x
8272         set hovery $y
8273         if {[info exists hovertimer]} {
8274             after cancel $hovertimer
8275         }
8276         set hovertimer [after 500 linehover]
8277     }
8278 }
8279
8280 proc lineleave {id} {
8281     global hoverid hovertimer canv
8282
8283     if {[info exists hoverid] && $id == $hoverid} {
8284         $canv delete hover
8285         if {[info exists hovertimer]} {
8286             after cancel $hovertimer
8287             unset hovertimer
8288         }
8289         unset hoverid
8290     }
8291 }
8292
8293 proc linehover {} {
8294     global hoverx hovery hoverid hovertimer
8295     global canv linespc lthickness
8296     global commitinfo
8297
8298     set text [lindex $commitinfo($hoverid) 0]
8299     set ymax [lindex [$canv cget -scrollregion] 3]
8300     if {$ymax == {}} return
8301     set yfrac [lindex [$canv yview] 0]
8302     set x [expr {$hoverx + 2 * $linespc}]
8303     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8304     set x0 [expr {$x - 2 * $lthickness}]
8305     set y0 [expr {$y - 2 * $lthickness}]
8306     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8307     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8308     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8309                -fill \#ffff80 -outline black -width 1 -tags hover]
8310     $canv raise $t
8311     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8312                -font mainfont]
8313     $canv raise $t
8314 }
8315
8316 proc clickisonarrow {id y} {
8317     global lthickness
8318
8319     set ranges [rowranges $id]
8320     set thresh [expr {2 * $lthickness + 6}]
8321     set n [expr {[llength $ranges] - 1}]
8322     for {set i 1} {$i < $n} {incr i} {
8323         set row [lindex $ranges $i]
8324         if {abs([yc $row] - $y) < $thresh} {
8325             return $i
8326         }
8327     }
8328     return {}
8329 }
8330
8331 proc arrowjump {id n y} {
8332     global canv
8333
8334     # 1 <-> 2, 3 <-> 4, etc...
8335     set n [expr {(($n - 1) ^ 1) + 1}]
8336     set row [lindex [rowranges $id] $n]
8337     set yt [yc $row]
8338     set ymax [lindex [$canv cget -scrollregion] 3]
8339     if {$ymax eq {} || $ymax <= 0} return
8340     set view [$canv yview]
8341     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8342     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8343     if {$yfrac < 0} {
8344         set yfrac 0
8345     }
8346     allcanvs yview moveto $yfrac
8347 }
8348
8349 proc lineclick {x y id isnew} {
8350     global ctext commitinfo children canv thickerline curview
8351
8352     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8353     unmarkmatches
8354     unselectline
8355     normalline
8356     $canv delete hover
8357     # draw this line thicker than normal
8358     set thickerline $id
8359     drawlines $id
8360     if {$isnew} {
8361         set ymax [lindex [$canv cget -scrollregion] 3]
8362         if {$ymax eq {}} return
8363         set yfrac [lindex [$canv yview] 0]
8364         set y [expr {$y + $yfrac * $ymax}]
8365     }
8366     set dirn [clickisonarrow $id $y]
8367     if {$dirn ne {}} {
8368         arrowjump $id $dirn $y
8369         return
8370     }
8371
8372     if {$isnew} {
8373         addtohistory [list lineclick $x $y $id 0] savectextpos
8374     }
8375     # fill the details pane with info about this line
8376     $ctext conf -state normal
8377     clear_ctext
8378     settabs 0
8379     $ctext insert end "[mc "Parent"]:\t"
8380     $ctext insert end $id link0
8381     setlink $id link0
8382     set info $commitinfo($id)
8383     $ctext insert end "\n\t[lindex $info 0]\n"
8384     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8385     set date [formatdate [lindex $info 2]]
8386     $ctext insert end "\t[mc "Date"]:\t$date\n"
8387     set kids $children($curview,$id)
8388     if {$kids ne {}} {
8389         $ctext insert end "\n[mc "Children"]:"
8390         set i 0
8391         foreach child $kids {
8392             incr i
8393             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8394             set info $commitinfo($child)
8395             $ctext insert end "\n\t"
8396             $ctext insert end $child link$i
8397             setlink $child link$i
8398             $ctext insert end "\n\t[lindex $info 0]"
8399             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8400             set date [formatdate [lindex $info 2]]
8401             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8402         }
8403     }
8404     maybe_scroll_ctext 1
8405     $ctext conf -state disabled
8406     init_flist {}
8407 }
8408
8409 proc normalline {} {
8410     global thickerline
8411     if {[info exists thickerline]} {
8412         set id $thickerline
8413         unset thickerline
8414         drawlines $id
8415     }
8416 }
8417
8418 proc selbyid {id {isnew 1}} {
8419     global curview
8420     if {[commitinview $id $curview]} {
8421         selectline [rowofcommit $id] $isnew
8422     }
8423 }
8424
8425 proc mstime {} {
8426     global startmstime
8427     if {![info exists startmstime]} {
8428         set startmstime [clock clicks -milliseconds]
8429     }
8430     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8431 }
8432
8433 proc rowmenu {x y id} {
8434     global rowctxmenu selectedline rowmenuid curview
8435     global nullid nullid2 fakerowmenu mainhead markedid
8436
8437     stopfinding
8438     set rowmenuid $id
8439     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8440         set state disabled
8441     } else {
8442         set state normal
8443     }
8444     if {$id ne $nullid && $id ne $nullid2} {
8445         set menu $rowctxmenu
8446         if {$mainhead ne {}} {
8447             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8448         } else {
8449             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8450         }
8451         if {[info exists markedid] && $markedid ne $id} {
8452             $menu entryconfigure 9 -state normal
8453             $menu entryconfigure 10 -state normal
8454             $menu entryconfigure 11 -state normal
8455         } else {
8456             $menu entryconfigure 9 -state disabled
8457             $menu entryconfigure 10 -state disabled
8458             $menu entryconfigure 11 -state disabled
8459         }
8460     } else {
8461         set menu $fakerowmenu
8462     }
8463     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8464     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8465     $menu entryconfigure [mca "Make patch"] -state $state
8466     tk_popup $menu $x $y
8467 }
8468
8469 proc markhere {} {
8470     global rowmenuid markedid canv
8471
8472     set markedid $rowmenuid
8473     make_idmark $markedid
8474 }
8475
8476 proc gotomark {} {
8477     global markedid
8478
8479     if {[info exists markedid]} {
8480         selbyid $markedid
8481     }
8482 }
8483
8484 proc replace_by_kids {l r} {
8485     global curview children
8486
8487     set id [commitonrow $r]
8488     set l [lreplace $l 0 0]
8489     foreach kid $children($curview,$id) {
8490         lappend l [rowofcommit $kid]
8491     }
8492     return [lsort -integer -decreasing -unique $l]
8493 }
8494
8495 proc find_common_desc {} {
8496     global markedid rowmenuid curview children
8497
8498     if {![info exists markedid]} return
8499     if {![commitinview $markedid $curview] ||
8500         ![commitinview $rowmenuid $curview]} return
8501     #set t1 [clock clicks -milliseconds]
8502     set l1 [list [rowofcommit $markedid]]
8503     set l2 [list [rowofcommit $rowmenuid]]
8504     while 1 {
8505         set r1 [lindex $l1 0]
8506         set r2 [lindex $l2 0]
8507         if {$r1 eq {} || $r2 eq {}} break
8508         if {$r1 == $r2} {
8509             selectline $r1 1
8510             break
8511         }
8512         if {$r1 > $r2} {
8513             set l1 [replace_by_kids $l1 $r1]
8514         } else {
8515             set l2 [replace_by_kids $l2 $r2]
8516         }
8517     }
8518     #set t2 [clock clicks -milliseconds]
8519     #puts "took [expr {$t2-$t1}]ms"
8520 }
8521
8522 proc compare_commits {} {
8523     global markedid rowmenuid curview children
8524
8525     if {![info exists markedid]} return
8526     if {![commitinview $markedid $curview]} return
8527     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8528     do_cmp_commits $markedid $rowmenuid
8529 }
8530
8531 proc getpatchid {id} {
8532     global patchids
8533
8534     if {![info exists patchids($id)]} {
8535         set cmd [diffcmd [list $id] {-p --root}]
8536         # trim off the initial "|"
8537         set cmd [lrange $cmd 1 end]
8538         if {[catch {
8539             set x [eval exec $cmd | git patch-id]
8540             set patchids($id) [lindex $x 0]
8541         }]} {
8542             set patchids($id) "error"
8543         }
8544     }
8545     return $patchids($id)
8546 }
8547
8548 proc do_cmp_commits {a b} {
8549     global ctext curview parents children patchids commitinfo
8550
8551     $ctext conf -state normal
8552     clear_ctext
8553     init_flist {}
8554     for {set i 0} {$i < 100} {incr i} {
8555         set skipa 0
8556         set skipb 0
8557         if {[llength $parents($curview,$a)] > 1} {
8558             appendshortlink $a [mc "Skipping merge commit "] "\n"
8559             set skipa 1
8560         } else {
8561             set patcha [getpatchid $a]
8562         }
8563         if {[llength $parents($curview,$b)] > 1} {
8564             appendshortlink $b [mc "Skipping merge commit "] "\n"
8565             set skipb 1
8566         } else {
8567             set patchb [getpatchid $b]
8568         }
8569         if {!$skipa && !$skipb} {
8570             set heada [lindex $commitinfo($a) 0]
8571             set headb [lindex $commitinfo($b) 0]
8572             if {$patcha eq "error"} {
8573                 appendshortlink $a [mc "Error getting patch ID for "] \
8574                     [mc " - stopping\n"]
8575                 break
8576             }
8577             if {$patchb eq "error"} {
8578                 appendshortlink $b [mc "Error getting patch ID for "] \
8579                     [mc " - stopping\n"]
8580                 break
8581             }
8582             if {$patcha eq $patchb} {
8583                 if {$heada eq $headb} {
8584                     appendshortlink $a [mc "Commit "]
8585                     appendshortlink $b " == " "  $heada\n"
8586                 } else {
8587                     appendshortlink $a [mc "Commit "] "  $heada\n"
8588                     appendshortlink $b [mc " is the same patch as\n       "] \
8589                         "  $headb\n"
8590                 }
8591                 set skipa 1
8592                 set skipb 1
8593             } else {
8594                 $ctext insert end "\n"
8595                 appendshortlink $a [mc "Commit "] "  $heada\n"
8596                 appendshortlink $b [mc " differs from\n       "] \
8597                     "  $headb\n"
8598                 $ctext insert end [mc "Diff of commits:\n\n"]
8599                 $ctext conf -state disabled
8600                 update
8601                 diffcommits $a $b
8602                 return
8603             }
8604         }
8605         if {$skipa} {
8606             set kids [real_children $curview,$a]
8607             if {[llength $kids] != 1} {
8608                 $ctext insert end "\n"
8609                 appendshortlink $a [mc "Commit "] \
8610                     [mc " has %s children - stopping\n" [llength $kids]]
8611                 break
8612             }
8613             set a [lindex $kids 0]
8614         }
8615         if {$skipb} {
8616             set kids [real_children $curview,$b]
8617             if {[llength $kids] != 1} {
8618                 appendshortlink $b [mc "Commit "] \
8619                     [mc " has %s children - stopping\n" [llength $kids]]
8620                 break
8621             }
8622             set b [lindex $kids 0]
8623         }
8624     }
8625     $ctext conf -state disabled
8626 }
8627
8628 proc diffcommits {a b} {
8629     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8630
8631     set tmpdir [gitknewtmpdir]
8632     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8633     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8634     if {[catch {
8635         exec git diff-tree -p --pretty $a >$fna
8636         exec git diff-tree -p --pretty $b >$fnb
8637     } err]} {
8638         error_popup [mc "Error writing commit to file: %s" $err]
8639         return
8640     }
8641     if {[catch {
8642         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8643     } err]} {
8644         error_popup [mc "Error diffing commits: %s" $err]
8645         return
8646     }
8647     set diffids [list commits $a $b]
8648     set blobdifffd($diffids) $fd
8649     set diffinhdr 0
8650     set currdiffsubmod ""
8651     filerun $fd [list getblobdiffline $fd $diffids]
8652 }
8653
8654 proc diffvssel {dirn} {
8655     global rowmenuid selectedline
8656
8657     if {$selectedline eq {}} return
8658     if {$dirn} {
8659         set oldid [commitonrow $selectedline]
8660         set newid $rowmenuid
8661     } else {
8662         set oldid $rowmenuid
8663         set newid [commitonrow $selectedline]
8664     }
8665     addtohistory [list doseldiff $oldid $newid] savectextpos
8666     doseldiff $oldid $newid
8667 }
8668
8669 proc doseldiff {oldid newid} {
8670     global ctext
8671     global commitinfo
8672
8673     $ctext conf -state normal
8674     clear_ctext
8675     init_flist [mc "Top"]
8676     $ctext insert end "[mc "From"] "
8677     $ctext insert end $oldid link0
8678     setlink $oldid link0
8679     $ctext insert end "\n     "
8680     $ctext insert end [lindex $commitinfo($oldid) 0]
8681     $ctext insert end "\n\n[mc "To"]   "
8682     $ctext insert end $newid link1
8683     setlink $newid link1
8684     $ctext insert end "\n     "
8685     $ctext insert end [lindex $commitinfo($newid) 0]
8686     $ctext insert end "\n"
8687     $ctext conf -state disabled
8688     $ctext tag remove found 1.0 end
8689     startdiff [list $oldid $newid]
8690 }
8691
8692 proc mkpatch {} {
8693     global rowmenuid currentid commitinfo patchtop patchnum NS
8694
8695     if {![info exists currentid]} return
8696     set oldid $currentid
8697     set oldhead [lindex $commitinfo($oldid) 0]
8698     set newid $rowmenuid
8699     set newhead [lindex $commitinfo($newid) 0]
8700     set top .patch
8701     set patchtop $top
8702     catch {destroy $top}
8703     ttk_toplevel $top
8704     make_transient $top .
8705     ${NS}::label $top.title -text [mc "Generate patch"]
8706     grid $top.title - -pady 10
8707     ${NS}::label $top.from -text [mc "From:"]
8708     ${NS}::entry $top.fromsha1 -width 40
8709     $top.fromsha1 insert 0 $oldid
8710     $top.fromsha1 conf -state readonly
8711     grid $top.from $top.fromsha1 -sticky w
8712     ${NS}::entry $top.fromhead -width 60
8713     $top.fromhead insert 0 $oldhead
8714     $top.fromhead conf -state readonly
8715     grid x $top.fromhead -sticky w
8716     ${NS}::label $top.to -text [mc "To:"]
8717     ${NS}::entry $top.tosha1 -width 40
8718     $top.tosha1 insert 0 $newid
8719     $top.tosha1 conf -state readonly
8720     grid $top.to $top.tosha1 -sticky w
8721     ${NS}::entry $top.tohead -width 60
8722     $top.tohead insert 0 $newhead
8723     $top.tohead conf -state readonly
8724     grid x $top.tohead -sticky w
8725     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8726     grid $top.rev x -pady 10 -padx 5
8727     ${NS}::label $top.flab -text [mc "Output file:"]
8728     ${NS}::entry $top.fname -width 60
8729     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8730     incr patchnum
8731     grid $top.flab $top.fname -sticky w
8732     ${NS}::frame $top.buts
8733     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8734     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8735     bind $top <Key-Return> mkpatchgo
8736     bind $top <Key-Escape> mkpatchcan
8737     grid $top.buts.gen $top.buts.can
8738     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8739     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8740     grid $top.buts - -pady 10 -sticky ew
8741     focus $top.fname
8742 }
8743
8744 proc mkpatchrev {} {
8745     global patchtop
8746
8747     set oldid [$patchtop.fromsha1 get]
8748     set oldhead [$patchtop.fromhead get]
8749     set newid [$patchtop.tosha1 get]
8750     set newhead [$patchtop.tohead get]
8751     foreach e [list fromsha1 fromhead tosha1 tohead] \
8752             v [list $newid $newhead $oldid $oldhead] {
8753         $patchtop.$e conf -state normal
8754         $patchtop.$e delete 0 end
8755         $patchtop.$e insert 0 $v
8756         $patchtop.$e conf -state readonly
8757     }
8758 }
8759
8760 proc mkpatchgo {} {
8761     global patchtop nullid nullid2
8762
8763     set oldid [$patchtop.fromsha1 get]
8764     set newid [$patchtop.tosha1 get]
8765     set fname [$patchtop.fname get]
8766     set cmd [diffcmd [list $oldid $newid] -p]
8767     # trim off the initial "|"
8768     set cmd [lrange $cmd 1 end]
8769     lappend cmd >$fname &
8770     if {[catch {eval exec $cmd} err]} {
8771         error_popup "[mc "Error creating patch:"] $err" $patchtop
8772     }
8773     catch {destroy $patchtop}
8774     unset patchtop
8775 }
8776
8777 proc mkpatchcan {} {
8778     global patchtop
8779
8780     catch {destroy $patchtop}
8781     unset patchtop
8782 }
8783
8784 proc mktag {} {
8785     global rowmenuid mktagtop commitinfo NS
8786
8787     set top .maketag
8788     set mktagtop $top
8789     catch {destroy $top}
8790     ttk_toplevel $top
8791     make_transient $top .
8792     ${NS}::label $top.title -text [mc "Create tag"]
8793     grid $top.title - -pady 10
8794     ${NS}::label $top.id -text [mc "ID:"]
8795     ${NS}::entry $top.sha1 -width 40
8796     $top.sha1 insert 0 $rowmenuid
8797     $top.sha1 conf -state readonly
8798     grid $top.id $top.sha1 -sticky w
8799     ${NS}::entry $top.head -width 60
8800     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8801     $top.head conf -state readonly
8802     grid x $top.head -sticky w
8803     ${NS}::label $top.tlab -text [mc "Tag name:"]
8804     ${NS}::entry $top.tag -width 60
8805     grid $top.tlab $top.tag -sticky w
8806     ${NS}::label $top.op -text [mc "Tag message is optional"]
8807     grid $top.op -columnspan 2 -sticky we
8808     ${NS}::label $top.mlab -text [mc "Tag message:"]
8809     ${NS}::entry $top.msg -width 60
8810     grid $top.mlab $top.msg -sticky w
8811     ${NS}::frame $top.buts
8812     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8813     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8814     bind $top <Key-Return> mktaggo
8815     bind $top <Key-Escape> mktagcan
8816     grid $top.buts.gen $top.buts.can
8817     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8818     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8819     grid $top.buts - -pady 10 -sticky ew
8820     focus $top.tag
8821 }
8822
8823 proc domktag {} {
8824     global mktagtop env tagids idtags
8825
8826     set id [$mktagtop.sha1 get]
8827     set tag [$mktagtop.tag get]
8828     set msg [$mktagtop.msg get]
8829     if {$tag == {}} {
8830         error_popup [mc "No tag name specified"] $mktagtop
8831         return 0
8832     }
8833     if {[info exists tagids($tag)]} {
8834         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8835         return 0
8836     }
8837     if {[catch {
8838         if {$msg != {}} {
8839             exec git tag -a -m $msg $tag $id
8840         } else {
8841             exec git tag $tag $id
8842         }
8843     } err]} {
8844         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8845         return 0
8846     }
8847
8848     set tagids($tag) $id
8849     lappend idtags($id) $tag
8850     redrawtags $id
8851     addedtag $id
8852     dispneartags 0
8853     run refill_reflist
8854     return 1
8855 }
8856
8857 proc redrawtags {id} {
8858     global canv linehtag idpos currentid curview cmitlisted markedid
8859     global canvxmax iddrawn circleitem mainheadid circlecolors
8860
8861     if {![commitinview $id $curview]} return
8862     if {![info exists iddrawn($id)]} return
8863     set row [rowofcommit $id]
8864     if {$id eq $mainheadid} {
8865         set ofill yellow
8866     } else {
8867         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8868     }
8869     $canv itemconf $circleitem($row) -fill $ofill
8870     $canv delete tag.$id
8871     set xt [eval drawtags $id $idpos($id)]
8872     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8873     set text [$canv itemcget $linehtag($id) -text]
8874     set font [$canv itemcget $linehtag($id) -font]
8875     set xr [expr {$xt + [font measure $font $text]}]
8876     if {$xr > $canvxmax} {
8877         set canvxmax $xr
8878         setcanvscroll
8879     }
8880     if {[info exists currentid] && $currentid == $id} {
8881         make_secsel $id
8882     }
8883     if {[info exists markedid] && $markedid eq $id} {
8884         make_idmark $id
8885     }
8886 }
8887
8888 proc mktagcan {} {
8889     global mktagtop
8890
8891     catch {destroy $mktagtop}
8892     unset mktagtop
8893 }
8894
8895 proc mktaggo {} {
8896     if {![domktag]} return
8897     mktagcan
8898 }
8899
8900 proc writecommit {} {
8901     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8902
8903     set top .writecommit
8904     set wrcomtop $top
8905     catch {destroy $top}
8906     ttk_toplevel $top
8907     make_transient $top .
8908     ${NS}::label $top.title -text [mc "Write commit to file"]
8909     grid $top.title - -pady 10
8910     ${NS}::label $top.id -text [mc "ID:"]
8911     ${NS}::entry $top.sha1 -width 40
8912     $top.sha1 insert 0 $rowmenuid
8913     $top.sha1 conf -state readonly
8914     grid $top.id $top.sha1 -sticky w
8915     ${NS}::entry $top.head -width 60
8916     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8917     $top.head conf -state readonly
8918     grid x $top.head -sticky w
8919     ${NS}::label $top.clab -text [mc "Command:"]
8920     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8921     grid $top.clab $top.cmd -sticky w -pady 10
8922     ${NS}::label $top.flab -text [mc "Output file:"]
8923     ${NS}::entry $top.fname -width 60
8924     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8925     grid $top.flab $top.fname -sticky w
8926     ${NS}::frame $top.buts
8927     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8928     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8929     bind $top <Key-Return> wrcomgo
8930     bind $top <Key-Escape> wrcomcan
8931     grid $top.buts.gen $top.buts.can
8932     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8933     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8934     grid $top.buts - -pady 10 -sticky ew
8935     focus $top.fname
8936 }
8937
8938 proc wrcomgo {} {
8939     global wrcomtop
8940
8941     set id [$wrcomtop.sha1 get]
8942     set cmd "echo $id | [$wrcomtop.cmd get]"
8943     set fname [$wrcomtop.fname get]
8944     if {[catch {exec sh -c $cmd >$fname &} err]} {
8945         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8946     }
8947     catch {destroy $wrcomtop}
8948     unset wrcomtop
8949 }
8950
8951 proc wrcomcan {} {
8952     global wrcomtop
8953
8954     catch {destroy $wrcomtop}
8955     unset wrcomtop
8956 }
8957
8958 proc mkbranch {} {
8959     global rowmenuid mkbrtop NS
8960
8961     set top .makebranch
8962     catch {destroy $top}
8963     ttk_toplevel $top
8964     make_transient $top .
8965     ${NS}::label $top.title -text [mc "Create new branch"]
8966     grid $top.title - -pady 10
8967     ${NS}::label $top.id -text [mc "ID:"]
8968     ${NS}::entry $top.sha1 -width 40
8969     $top.sha1 insert 0 $rowmenuid
8970     $top.sha1 conf -state readonly
8971     grid $top.id $top.sha1 -sticky w
8972     ${NS}::label $top.nlab -text [mc "Name:"]
8973     ${NS}::entry $top.name -width 40
8974     grid $top.nlab $top.name -sticky w
8975     ${NS}::frame $top.buts
8976     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8977     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8978     bind $top <Key-Return> [list mkbrgo $top]
8979     bind $top <Key-Escape> "catch {destroy $top}"
8980     grid $top.buts.go $top.buts.can
8981     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8982     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8983     grid $top.buts - -pady 10 -sticky ew
8984     focus $top.name
8985 }
8986
8987 proc mkbrgo {top} {
8988     global headids idheads
8989
8990     set name [$top.name get]
8991     set id [$top.sha1 get]
8992     set cmdargs {}
8993     set old_id {}
8994     if {$name eq {}} {
8995         error_popup [mc "Please specify a name for the new branch"] $top
8996         return
8997     }
8998     if {[info exists headids($name)]} {
8999         if {![confirm_popup [mc \
9000                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9001             return
9002         }
9003         set old_id $headids($name)
9004         lappend cmdargs -f
9005     }
9006     catch {destroy $top}
9007     lappend cmdargs $name $id
9008     nowbusy newbranch
9009     update
9010     if {[catch {
9011         eval exec git branch $cmdargs
9012     } err]} {
9013         notbusy newbranch
9014         error_popup $err
9015     } else {
9016         notbusy newbranch
9017         if {$old_id ne {}} {
9018             movehead $id $name
9019             movedhead $id $name
9020             redrawtags $old_id
9021             redrawtags $id
9022         } else {
9023             set headids($name) $id
9024             lappend idheads($id) $name
9025             addedhead $id $name
9026             redrawtags $id
9027         }
9028         dispneartags 0
9029         run refill_reflist
9030     }
9031 }
9032
9033 proc exec_citool {tool_args {baseid {}}} {
9034     global commitinfo env
9035
9036     set save_env [array get env GIT_AUTHOR_*]
9037
9038     if {$baseid ne {}} {
9039         if {![info exists commitinfo($baseid)]} {
9040             getcommit $baseid
9041         }
9042         set author [lindex $commitinfo($baseid) 1]
9043         set date [lindex $commitinfo($baseid) 2]
9044         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9045                     $author author name email]
9046             && $date ne {}} {
9047             set env(GIT_AUTHOR_NAME) $name
9048             set env(GIT_AUTHOR_EMAIL) $email
9049             set env(GIT_AUTHOR_DATE) $date
9050         }
9051     }
9052
9053     eval exec git citool $tool_args &
9054
9055     array unset env GIT_AUTHOR_*
9056     array set env $save_env
9057 }
9058
9059 proc cherrypick {} {
9060     global rowmenuid curview
9061     global mainhead mainheadid
9062     global gitdir
9063
9064     set oldhead [exec git rev-parse HEAD]
9065     set dheads [descheads $rowmenuid]
9066     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9067         set ok [confirm_popup [mc "Commit %s is already\
9068                 included in branch %s -- really re-apply it?" \
9069                                    [string range $rowmenuid 0 7] $mainhead]]
9070         if {!$ok} return
9071     }
9072     nowbusy cherrypick [mc "Cherry-picking"]
9073     update
9074     # Unfortunately git-cherry-pick writes stuff to stderr even when
9075     # no error occurs, and exec takes that as an indication of error...
9076     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9077         notbusy cherrypick
9078         if {[regexp -line \
9079                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9080                  $err msg fname]} {
9081             error_popup [mc "Cherry-pick failed because of local changes\
9082                         to file '%s'.\nPlease commit, reset or stash\
9083                         your changes and try again." $fname]
9084         } elseif {[regexp -line \
9085                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9086                        $err]} {
9087             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9088                         conflict.\nDo you wish to run git citool to\
9089                         resolve it?"]]} {
9090                 # Force citool to read MERGE_MSG
9091                 file delete [file join $gitdir "GITGUI_MSG"]
9092                 exec_citool {} $rowmenuid
9093             }
9094         } else {
9095             error_popup $err
9096         }
9097         run updatecommits
9098         return
9099     }
9100     set newhead [exec git rev-parse HEAD]
9101     if {$newhead eq $oldhead} {
9102         notbusy cherrypick
9103         error_popup [mc "No changes committed"]
9104         return
9105     }
9106     addnewchild $newhead $oldhead
9107     if {[commitinview $oldhead $curview]} {
9108         # XXX this isn't right if we have a path limit...
9109         insertrow $newhead $oldhead $curview
9110         if {$mainhead ne {}} {
9111             movehead $newhead $mainhead
9112             movedhead $newhead $mainhead
9113         }
9114         set mainheadid $newhead
9115         redrawtags $oldhead
9116         redrawtags $newhead
9117         selbyid $newhead
9118     }
9119     notbusy cherrypick
9120 }
9121
9122 proc resethead {} {
9123     global mainhead rowmenuid confirm_ok resettype NS
9124
9125     set confirm_ok 0
9126     set w ".confirmreset"
9127     ttk_toplevel $w
9128     make_transient $w .
9129     wm title $w [mc "Confirm reset"]
9130     ${NS}::label $w.m -text \
9131         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9132     pack $w.m -side top -fill x -padx 20 -pady 20
9133     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9134     set resettype mixed
9135     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9136         -text [mc "Soft: Leave working tree and index untouched"]
9137     grid $w.f.soft -sticky w
9138     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9139         -text [mc "Mixed: Leave working tree untouched, reset index"]
9140     grid $w.f.mixed -sticky w
9141     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9142         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9143     grid $w.f.hard -sticky w
9144     pack $w.f -side top -fill x -padx 4
9145     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9146     pack $w.ok -side left -fill x -padx 20 -pady 20
9147     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9148     bind $w <Key-Escape> [list destroy $w]
9149     pack $w.cancel -side right -fill x -padx 20 -pady 20
9150     bind $w <Visibility> "grab $w; focus $w"
9151     tkwait window $w
9152     if {!$confirm_ok} return
9153     if {[catch {set fd [open \
9154             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9155         error_popup $err
9156     } else {
9157         dohidelocalchanges
9158         filerun $fd [list readresetstat $fd]
9159         nowbusy reset [mc "Resetting"]
9160         selbyid $rowmenuid
9161     }
9162 }
9163
9164 proc readresetstat {fd} {
9165     global mainhead mainheadid showlocalchanges rprogcoord
9166
9167     if {[gets $fd line] >= 0} {
9168         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9169             set rprogcoord [expr {1.0 * $m / $n}]
9170             adjustprogress
9171         }
9172         return 1
9173     }
9174     set rprogcoord 0
9175     adjustprogress
9176     notbusy reset
9177     if {[catch {close $fd} err]} {
9178         error_popup $err
9179     }
9180     set oldhead $mainheadid
9181     set newhead [exec git rev-parse HEAD]
9182     if {$newhead ne $oldhead} {
9183         movehead $newhead $mainhead
9184         movedhead $newhead $mainhead
9185         set mainheadid $newhead
9186         redrawtags $oldhead
9187         redrawtags $newhead
9188     }
9189     if {$showlocalchanges} {
9190         doshowlocalchanges
9191     }
9192     return 0
9193 }
9194
9195 # context menu for a head
9196 proc headmenu {x y id head} {
9197     global headmenuid headmenuhead headctxmenu mainhead
9198
9199     stopfinding
9200     set headmenuid $id
9201     set headmenuhead $head
9202     set state normal
9203     if {[string match "remotes/*" $head]} {
9204         set state disabled
9205     }
9206     if {$head eq $mainhead} {
9207         set state disabled
9208     }
9209     $headctxmenu entryconfigure 0 -state $state
9210     $headctxmenu entryconfigure 1 -state $state
9211     tk_popup $headctxmenu $x $y
9212 }
9213
9214 proc cobranch {} {
9215     global headmenuid headmenuhead headids
9216     global showlocalchanges
9217
9218     # check the tree is clean first??
9219     nowbusy checkout [mc "Checking out"]
9220     update
9221     dohidelocalchanges
9222     if {[catch {
9223         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9224     } err]} {
9225         notbusy checkout
9226         error_popup $err
9227         if {$showlocalchanges} {
9228             dodiffindex
9229         }
9230     } else {
9231         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9232     }
9233 }
9234
9235 proc readcheckoutstat {fd newhead newheadid} {
9236     global mainhead mainheadid headids showlocalchanges progresscoords
9237     global viewmainheadid curview
9238
9239     if {[gets $fd line] >= 0} {
9240         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9241             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9242             adjustprogress
9243         }
9244         return 1
9245     }
9246     set progresscoords {0 0}
9247     adjustprogress
9248     notbusy checkout
9249     if {[catch {close $fd} err]} {
9250         error_popup $err
9251     }
9252     set oldmainid $mainheadid
9253     set mainhead $newhead
9254     set mainheadid $newheadid
9255     set viewmainheadid($curview) $newheadid
9256     redrawtags $oldmainid
9257     redrawtags $newheadid
9258     selbyid $newheadid
9259     if {$showlocalchanges} {
9260         dodiffindex
9261     }
9262 }
9263
9264 proc rmbranch {} {
9265     global headmenuid headmenuhead mainhead
9266     global idheads
9267
9268     set head $headmenuhead
9269     set id $headmenuid
9270     # this check shouldn't be needed any more...
9271     if {$head eq $mainhead} {
9272         error_popup [mc "Cannot delete the currently checked-out branch"]
9273         return
9274     }
9275     set dheads [descheads $id]
9276     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9277         # the stuff on this branch isn't on any other branch
9278         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9279                         branch.\nReally delete branch %s?" $head $head]]} return
9280     }
9281     nowbusy rmbranch
9282     update
9283     if {[catch {exec git branch -D $head} err]} {
9284         notbusy rmbranch
9285         error_popup $err
9286         return
9287     }
9288     removehead $id $head
9289     removedhead $id $head
9290     redrawtags $id
9291     notbusy rmbranch
9292     dispneartags 0
9293     run refill_reflist
9294 }
9295
9296 # Display a list of tags and heads
9297 proc showrefs {} {
9298     global showrefstop bgcolor fgcolor selectbgcolor NS
9299     global bglist fglist reflistfilter reflist maincursor
9300
9301     set top .showrefs
9302     set showrefstop $top
9303     if {[winfo exists $top]} {
9304         raise $top
9305         refill_reflist
9306         return
9307     }
9308     ttk_toplevel $top
9309     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9310     make_transient $top .
9311     text $top.list -background $bgcolor -foreground $fgcolor \
9312         -selectbackground $selectbgcolor -font mainfont \
9313         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9314         -width 30 -height 20 -cursor $maincursor \
9315         -spacing1 1 -spacing3 1 -state disabled
9316     $top.list tag configure highlight -background $selectbgcolor
9317     lappend bglist $top.list
9318     lappend fglist $top.list
9319     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9320     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9321     grid $top.list $top.ysb -sticky nsew
9322     grid $top.xsb x -sticky ew
9323     ${NS}::frame $top.f
9324     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9325     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9326     set reflistfilter "*"
9327     trace add variable reflistfilter write reflistfilter_change
9328     pack $top.f.e -side right -fill x -expand 1
9329     pack $top.f.l -side left
9330     grid $top.f - -sticky ew -pady 2
9331     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9332     bind $top <Key-Escape> [list destroy $top]
9333     grid $top.close -
9334     grid columnconfigure $top 0 -weight 1
9335     grid rowconfigure $top 0 -weight 1
9336     bind $top.list <1> {break}
9337     bind $top.list <B1-Motion> {break}
9338     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9339     set reflist {}
9340     refill_reflist
9341 }
9342
9343 proc sel_reflist {w x y} {
9344     global showrefstop reflist headids tagids otherrefids
9345
9346     if {![winfo exists $showrefstop]} return
9347     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9348     set ref [lindex $reflist [expr {$l-1}]]
9349     set n [lindex $ref 0]
9350     switch -- [lindex $ref 1] {
9351         "H" {selbyid $headids($n)}
9352         "T" {selbyid $tagids($n)}
9353         "o" {selbyid $otherrefids($n)}
9354     }
9355     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9356 }
9357
9358 proc unsel_reflist {} {
9359     global showrefstop
9360
9361     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9362     $showrefstop.list tag remove highlight 0.0 end
9363 }
9364
9365 proc reflistfilter_change {n1 n2 op} {
9366     global reflistfilter
9367
9368     after cancel refill_reflist
9369     after 200 refill_reflist
9370 }
9371
9372 proc refill_reflist {} {
9373     global reflist reflistfilter showrefstop headids tagids otherrefids
9374     global curview
9375
9376     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9377     set refs {}
9378     foreach n [array names headids] {
9379         if {[string match $reflistfilter $n]} {
9380             if {[commitinview $headids($n) $curview]} {
9381                 lappend refs [list $n H]
9382             } else {
9383                 interestedin $headids($n) {run refill_reflist}
9384             }
9385         }
9386     }
9387     foreach n [array names tagids] {
9388         if {[string match $reflistfilter $n]} {
9389             if {[commitinview $tagids($n) $curview]} {
9390                 lappend refs [list $n T]
9391             } else {
9392                 interestedin $tagids($n) {run refill_reflist}
9393             }
9394         }
9395     }
9396     foreach n [array names otherrefids] {
9397         if {[string match $reflistfilter $n]} {
9398             if {[commitinview $otherrefids($n) $curview]} {
9399                 lappend refs [list $n o]
9400             } else {
9401                 interestedin $otherrefids($n) {run refill_reflist}
9402             }
9403         }
9404     }
9405     set refs [lsort -index 0 $refs]
9406     if {$refs eq $reflist} return
9407
9408     # Update the contents of $showrefstop.list according to the
9409     # differences between $reflist (old) and $refs (new)
9410     $showrefstop.list conf -state normal
9411     $showrefstop.list insert end "\n"
9412     set i 0
9413     set j 0
9414     while {$i < [llength $reflist] || $j < [llength $refs]} {
9415         if {$i < [llength $reflist]} {
9416             if {$j < [llength $refs]} {
9417                 set cmp [string compare [lindex $reflist $i 0] \
9418                              [lindex $refs $j 0]]
9419                 if {$cmp == 0} {
9420                     set cmp [string compare [lindex $reflist $i 1] \
9421                                  [lindex $refs $j 1]]
9422                 }
9423             } else {
9424                 set cmp -1
9425             }
9426         } else {
9427             set cmp 1
9428         }
9429         switch -- $cmp {
9430             -1 {
9431                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9432                 incr i
9433             }
9434             0 {
9435                 incr i
9436                 incr j
9437             }
9438             1 {
9439                 set l [expr {$j + 1}]
9440                 $showrefstop.list image create $l.0 -align baseline \
9441                     -image reficon-[lindex $refs $j 1] -padx 2
9442                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9443                 incr j
9444             }
9445         }
9446     }
9447     set reflist $refs
9448     # delete last newline
9449     $showrefstop.list delete end-2c end-1c
9450     $showrefstop.list conf -state disabled
9451 }
9452
9453 # Stuff for finding nearby tags
9454 proc getallcommits {} {
9455     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9456     global idheads idtags idotherrefs allparents tagobjid
9457     global gitdir
9458
9459     if {![info exists allcommits]} {
9460         set nextarc 0
9461         set allcommits 0
9462         set seeds {}
9463         set allcwait 0
9464         set cachedarcs 0
9465         set allccache [file join $gitdir "gitk.cache"]
9466         if {![catch {
9467             set f [open $allccache r]
9468             set allcwait 1
9469             getcache $f
9470         }]} return
9471     }
9472
9473     if {$allcwait} {
9474         return
9475     }
9476     set cmd [list | git rev-list --parents]
9477     set allcupdate [expr {$seeds ne {}}]
9478     if {!$allcupdate} {
9479         set ids "--all"
9480     } else {
9481         set refs [concat [array names idheads] [array names idtags] \
9482                       [array names idotherrefs]]
9483         set ids {}
9484         set tagobjs {}
9485         foreach name [array names tagobjid] {
9486             lappend tagobjs $tagobjid($name)
9487         }
9488         foreach id [lsort -unique $refs] {
9489             if {![info exists allparents($id)] &&
9490                 [lsearch -exact $tagobjs $id] < 0} {
9491                 lappend ids $id
9492             }
9493         }
9494         if {$ids ne {}} {
9495             foreach id $seeds {
9496                 lappend ids "^$id"
9497             }
9498         }
9499     }
9500     if {$ids ne {}} {
9501         set fd [open [concat $cmd $ids] r]
9502         fconfigure $fd -blocking 0
9503         incr allcommits
9504         nowbusy allcommits
9505         filerun $fd [list getallclines $fd]
9506     } else {
9507         dispneartags 0
9508     }
9509 }
9510
9511 # Since most commits have 1 parent and 1 child, we group strings of
9512 # such commits into "arcs" joining branch/merge points (BMPs), which
9513 # are commits that either don't have 1 parent or don't have 1 child.
9514 #
9515 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9516 # arcout(id) - outgoing arcs for BMP
9517 # arcids(a) - list of IDs on arc including end but not start
9518 # arcstart(a) - BMP ID at start of arc
9519 # arcend(a) - BMP ID at end of arc
9520 # growing(a) - arc a is still growing
9521 # arctags(a) - IDs out of arcids (excluding end) that have tags
9522 # archeads(a) - IDs out of arcids (excluding end) that have heads
9523 # The start of an arc is at the descendent end, so "incoming" means
9524 # coming from descendents, and "outgoing" means going towards ancestors.
9525
9526 proc getallclines {fd} {
9527     global allparents allchildren idtags idheads nextarc
9528     global arcnos arcids arctags arcout arcend arcstart archeads growing
9529     global seeds allcommits cachedarcs allcupdate
9530
9531     set nid 0
9532     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9533         set id [lindex $line 0]
9534         if {[info exists allparents($id)]} {
9535             # seen it already
9536             continue
9537         }
9538         set cachedarcs 0
9539         set olds [lrange $line 1 end]
9540         set allparents($id) $olds
9541         if {![info exists allchildren($id)]} {
9542             set allchildren($id) {}
9543             set arcnos($id) {}
9544             lappend seeds $id
9545         } else {
9546             set a $arcnos($id)
9547             if {[llength $olds] == 1 && [llength $a] == 1} {
9548                 lappend arcids($a) $id
9549                 if {[info exists idtags($id)]} {
9550                     lappend arctags($a) $id
9551                 }
9552                 if {[info exists idheads($id)]} {
9553                     lappend archeads($a) $id
9554                 }
9555                 if {[info exists allparents($olds)]} {
9556                     # seen parent already
9557                     if {![info exists arcout($olds)]} {
9558                         splitarc $olds
9559                     }
9560                     lappend arcids($a) $olds
9561                     set arcend($a) $olds
9562                     unset growing($a)
9563                 }
9564                 lappend allchildren($olds) $id
9565                 lappend arcnos($olds) $a
9566                 continue
9567             }
9568         }
9569         foreach a $arcnos($id) {
9570             lappend arcids($a) $id
9571             set arcend($a) $id
9572             unset growing($a)
9573         }
9574
9575         set ao {}
9576         foreach p $olds {
9577             lappend allchildren($p) $id
9578             set a [incr nextarc]
9579             set arcstart($a) $id
9580             set archeads($a) {}
9581             set arctags($a) {}
9582             set archeads($a) {}
9583             set arcids($a) {}
9584             lappend ao $a
9585             set growing($a) 1
9586             if {[info exists allparents($p)]} {
9587                 # seen it already, may need to make a new branch
9588                 if {![info exists arcout($p)]} {
9589                     splitarc $p
9590                 }
9591                 lappend arcids($a) $p
9592                 set arcend($a) $p
9593                 unset growing($a)
9594             }
9595             lappend arcnos($p) $a
9596         }
9597         set arcout($id) $ao
9598     }
9599     if {$nid > 0} {
9600         global cached_dheads cached_dtags cached_atags
9601         catch {unset cached_dheads}
9602         catch {unset cached_dtags}
9603         catch {unset cached_atags}
9604     }
9605     if {![eof $fd]} {
9606         return [expr {$nid >= 1000? 2: 1}]
9607     }
9608     set cacheok 1
9609     if {[catch {
9610         fconfigure $fd -blocking 1
9611         close $fd
9612     } err]} {
9613         # got an error reading the list of commits
9614         # if we were updating, try rereading the whole thing again
9615         if {$allcupdate} {
9616             incr allcommits -1
9617             dropcache $err
9618             return
9619         }
9620         error_popup "[mc "Error reading commit topology information;\
9621                 branch and preceding/following tag information\
9622                 will be incomplete."]\n($err)"
9623         set cacheok 0
9624     }
9625     if {[incr allcommits -1] == 0} {
9626         notbusy allcommits
9627         if {$cacheok} {
9628             run savecache
9629         }
9630     }
9631     dispneartags 0
9632     return 0
9633 }
9634
9635 proc recalcarc {a} {
9636     global arctags archeads arcids idtags idheads
9637
9638     set at {}
9639     set ah {}
9640     foreach id [lrange $arcids($a) 0 end-1] {
9641         if {[info exists idtags($id)]} {
9642             lappend at $id
9643         }
9644         if {[info exists idheads($id)]} {
9645             lappend ah $id
9646         }
9647     }
9648     set arctags($a) $at
9649     set archeads($a) $ah
9650 }
9651
9652 proc splitarc {p} {
9653     global arcnos arcids nextarc arctags archeads idtags idheads
9654     global arcstart arcend arcout allparents growing
9655
9656     set a $arcnos($p)
9657     if {[llength $a] != 1} {
9658         puts "oops splitarc called but [llength $a] arcs already"
9659         return
9660     }
9661     set a [lindex $a 0]
9662     set i [lsearch -exact $arcids($a) $p]
9663     if {$i < 0} {
9664         puts "oops splitarc $p not in arc $a"
9665         return
9666     }
9667     set na [incr nextarc]
9668     if {[info exists arcend($a)]} {
9669         set arcend($na) $arcend($a)
9670     } else {
9671         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9672         set j [lsearch -exact $arcnos($l) $a]
9673         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9674     }
9675     set tail [lrange $arcids($a) [expr {$i+1}] end]
9676     set arcids($a) [lrange $arcids($a) 0 $i]
9677     set arcend($a) $p
9678     set arcstart($na) $p
9679     set arcout($p) $na
9680     set arcids($na) $tail
9681     if {[info exists growing($a)]} {
9682         set growing($na) 1
9683         unset growing($a)
9684     }
9685
9686     foreach id $tail {
9687         if {[llength $arcnos($id)] == 1} {
9688             set arcnos($id) $na
9689         } else {
9690             set j [lsearch -exact $arcnos($id) $a]
9691             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9692         }
9693     }
9694
9695     # reconstruct tags and heads lists
9696     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9697         recalcarc $a
9698         recalcarc $na
9699     } else {
9700         set arctags($na) {}
9701         set archeads($na) {}
9702     }
9703 }
9704
9705 # Update things for a new commit added that is a child of one
9706 # existing commit.  Used when cherry-picking.
9707 proc addnewchild {id p} {
9708     global allparents allchildren idtags nextarc
9709     global arcnos arcids arctags arcout arcend arcstart archeads growing
9710     global seeds allcommits
9711
9712     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9713     set allparents($id) [list $p]
9714     set allchildren($id) {}
9715     set arcnos($id) {}
9716     lappend seeds $id
9717     lappend allchildren($p) $id
9718     set a [incr nextarc]
9719     set arcstart($a) $id
9720     set archeads($a) {}
9721     set arctags($a) {}
9722     set arcids($a) [list $p]
9723     set arcend($a) $p
9724     if {![info exists arcout($p)]} {
9725         splitarc $p
9726     }
9727     lappend arcnos($p) $a
9728     set arcout($id) [list $a]
9729 }
9730
9731 # This implements a cache for the topology information.
9732 # The cache saves, for each arc, the start and end of the arc,
9733 # the ids on the arc, and the outgoing arcs from the end.
9734 proc readcache {f} {
9735     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9736     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9737     global allcwait
9738
9739     set a $nextarc
9740     set lim $cachedarcs
9741     if {$lim - $a > 500} {
9742         set lim [expr {$a + 500}]
9743     }
9744     if {[catch {
9745         if {$a == $lim} {
9746             # finish reading the cache and setting up arctags, etc.
9747             set line [gets $f]
9748             if {$line ne "1"} {error "bad final version"}
9749             close $f
9750             foreach id [array names idtags] {
9751                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9752                     [llength $allparents($id)] == 1} {
9753                     set a [lindex $arcnos($id) 0]
9754                     if {$arctags($a) eq {}} {
9755                         recalcarc $a
9756                     }
9757                 }
9758             }
9759             foreach id [array names idheads] {
9760                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9761                     [llength $allparents($id)] == 1} {
9762                     set a [lindex $arcnos($id) 0]
9763                     if {$archeads($a) eq {}} {
9764                         recalcarc $a
9765                     }
9766                 }
9767             }
9768             foreach id [lsort -unique $possible_seeds] {
9769                 if {$arcnos($id) eq {}} {
9770                     lappend seeds $id
9771                 }
9772             }
9773             set allcwait 0
9774         } else {
9775             while {[incr a] <= $lim} {
9776                 set line [gets $f]
9777                 if {[llength $line] != 3} {error "bad line"}
9778                 set s [lindex $line 0]
9779                 set arcstart($a) $s
9780                 lappend arcout($s) $a
9781                 if {![info exists arcnos($s)]} {
9782                     lappend possible_seeds $s
9783                     set arcnos($s) {}
9784                 }
9785                 set e [lindex $line 1]
9786                 if {$e eq {}} {
9787                     set growing($a) 1
9788                 } else {
9789                     set arcend($a) $e
9790                     if {![info exists arcout($e)]} {
9791                         set arcout($e) {}
9792                     }
9793                 }
9794                 set arcids($a) [lindex $line 2]
9795                 foreach id $arcids($a) {
9796                     lappend allparents($s) $id
9797                     set s $id
9798                     lappend arcnos($id) $a
9799                 }
9800                 if {![info exists allparents($s)]} {
9801                     set allparents($s) {}
9802                 }
9803                 set arctags($a) {}
9804                 set archeads($a) {}
9805             }
9806             set nextarc [expr {$a - 1}]
9807         }
9808     } err]} {
9809         dropcache $err
9810         return 0
9811     }
9812     if {!$allcwait} {
9813         getallcommits
9814     }
9815     return $allcwait
9816 }
9817
9818 proc getcache {f} {
9819     global nextarc cachedarcs possible_seeds
9820
9821     if {[catch {
9822         set line [gets $f]
9823         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9824         # make sure it's an integer
9825         set cachedarcs [expr {int([lindex $line 1])}]
9826         if {$cachedarcs < 0} {error "bad number of arcs"}
9827         set nextarc 0
9828         set possible_seeds {}
9829         run readcache $f
9830     } err]} {
9831         dropcache $err
9832     }
9833     return 0
9834 }
9835
9836 proc dropcache {err} {
9837     global allcwait nextarc cachedarcs seeds
9838
9839     #puts "dropping cache ($err)"
9840     foreach v {arcnos arcout arcids arcstart arcend growing \
9841                    arctags archeads allparents allchildren} {
9842         global $v
9843         catch {unset $v}
9844     }
9845     set allcwait 0
9846     set nextarc 0
9847     set cachedarcs 0
9848     set seeds {}
9849     getallcommits
9850 }
9851
9852 proc writecache {f} {
9853     global cachearc cachedarcs allccache
9854     global arcstart arcend arcnos arcids arcout
9855
9856     set a $cachearc
9857     set lim $cachedarcs
9858     if {$lim - $a > 1000} {
9859         set lim [expr {$a + 1000}]
9860     }
9861     if {[catch {
9862         while {[incr a] <= $lim} {
9863             if {[info exists arcend($a)]} {
9864                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9865             } else {
9866                 puts $f [list $arcstart($a) {} $arcids($a)]
9867             }
9868         }
9869     } err]} {
9870         catch {close $f}
9871         catch {file delete $allccache}
9872         #puts "writing cache failed ($err)"
9873         return 0
9874     }
9875     set cachearc [expr {$a - 1}]
9876     if {$a > $cachedarcs} {
9877         puts $f "1"
9878         close $f
9879         return 0
9880     }
9881     return 1
9882 }
9883
9884 proc savecache {} {
9885     global nextarc cachedarcs cachearc allccache
9886
9887     if {$nextarc == $cachedarcs} return
9888     set cachearc 0
9889     set cachedarcs $nextarc
9890     catch {
9891         set f [open $allccache w]
9892         puts $f [list 1 $cachedarcs]
9893         run writecache $f
9894     }
9895 }
9896
9897 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9898 # or 0 if neither is true.
9899 proc anc_or_desc {a b} {
9900     global arcout arcstart arcend arcnos cached_isanc
9901
9902     if {$arcnos($a) eq $arcnos($b)} {
9903         # Both are on the same arc(s); either both are the same BMP,
9904         # or if one is not a BMP, the other is also not a BMP or is
9905         # the BMP at end of the arc (and it only has 1 incoming arc).
9906         # Or both can be BMPs with no incoming arcs.
9907         if {$a eq $b || $arcnos($a) eq {}} {
9908             return 0
9909         }
9910         # assert {[llength $arcnos($a)] == 1}
9911         set arc [lindex $arcnos($a) 0]
9912         set i [lsearch -exact $arcids($arc) $a]
9913         set j [lsearch -exact $arcids($arc) $b]
9914         if {$i < 0 || $i > $j} {
9915             return 1
9916         } else {
9917             return -1
9918         }
9919     }
9920
9921     if {![info exists arcout($a)]} {
9922         set arc [lindex $arcnos($a) 0]
9923         if {[info exists arcend($arc)]} {
9924             set aend $arcend($arc)
9925         } else {
9926             set aend {}
9927         }
9928         set a $arcstart($arc)
9929     } else {
9930         set aend $a
9931     }
9932     if {![info exists arcout($b)]} {
9933         set arc [lindex $arcnos($b) 0]
9934         if {[info exists arcend($arc)]} {
9935             set bend $arcend($arc)
9936         } else {
9937             set bend {}
9938         }
9939         set b $arcstart($arc)
9940     } else {
9941         set bend $b
9942     }
9943     if {$a eq $bend} {
9944         return 1
9945     }
9946     if {$b eq $aend} {
9947         return -1
9948     }
9949     if {[info exists cached_isanc($a,$bend)]} {
9950         if {$cached_isanc($a,$bend)} {
9951             return 1
9952         }
9953     }
9954     if {[info exists cached_isanc($b,$aend)]} {
9955         if {$cached_isanc($b,$aend)} {
9956             return -1
9957         }
9958         if {[info exists cached_isanc($a,$bend)]} {
9959             return 0
9960         }
9961     }
9962
9963     set todo [list $a $b]
9964     set anc($a) a
9965     set anc($b) b
9966     for {set i 0} {$i < [llength $todo]} {incr i} {
9967         set x [lindex $todo $i]
9968         if {$anc($x) eq {}} {
9969             continue
9970         }
9971         foreach arc $arcnos($x) {
9972             set xd $arcstart($arc)
9973             if {$xd eq $bend} {
9974                 set cached_isanc($a,$bend) 1
9975                 set cached_isanc($b,$aend) 0
9976                 return 1
9977             } elseif {$xd eq $aend} {
9978                 set cached_isanc($b,$aend) 1
9979                 set cached_isanc($a,$bend) 0
9980                 return -1
9981             }
9982             if {![info exists anc($xd)]} {
9983                 set anc($xd) $anc($x)
9984                 lappend todo $xd
9985             } elseif {$anc($xd) ne $anc($x)} {
9986                 set anc($xd) {}
9987             }
9988         }
9989     }
9990     set cached_isanc($a,$bend) 0
9991     set cached_isanc($b,$aend) 0
9992     return 0
9993 }
9994
9995 # This identifies whether $desc has an ancestor that is
9996 # a growing tip of the graph and which is not an ancestor of $anc
9997 # and returns 0 if so and 1 if not.
9998 # If we subsequently discover a tag on such a growing tip, and that
9999 # turns out to be a descendent of $anc (which it could, since we
10000 # don't necessarily see children before parents), then $desc
10001 # isn't a good choice to display as a descendent tag of
10002 # $anc (since it is the descendent of another tag which is
10003 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10004 # display as a ancestor tag of $desc.
10005 #
10006 proc is_certain {desc anc} {
10007     global arcnos arcout arcstart arcend growing problems
10008
10009     set certain {}
10010     if {[llength $arcnos($anc)] == 1} {
10011         # tags on the same arc are certain
10012         if {$arcnos($desc) eq $arcnos($anc)} {
10013             return 1
10014         }
10015         if {![info exists arcout($anc)]} {
10016             # if $anc is partway along an arc, use the start of the arc instead
10017             set a [lindex $arcnos($anc) 0]
10018             set anc $arcstart($a)
10019         }
10020     }
10021     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10022         set x $desc
10023     } else {
10024         set a [lindex $arcnos($desc) 0]
10025         set x $arcend($a)
10026     }
10027     if {$x == $anc} {
10028         return 1
10029     }
10030     set anclist [list $x]
10031     set dl($x) 1
10032     set nnh 1
10033     set ngrowanc 0
10034     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10035         set x [lindex $anclist $i]
10036         if {$dl($x)} {
10037             incr nnh -1
10038         }
10039         set done($x) 1
10040         foreach a $arcout($x) {
10041             if {[info exists growing($a)]} {
10042                 if {![info exists growanc($x)] && $dl($x)} {
10043                     set growanc($x) 1
10044                     incr ngrowanc
10045                 }
10046             } else {
10047                 set y $arcend($a)
10048                 if {[info exists dl($y)]} {
10049                     if {$dl($y)} {
10050                         if {!$dl($x)} {
10051                             set dl($y) 0
10052                             if {![info exists done($y)]} {
10053                                 incr nnh -1
10054                             }
10055                             if {[info exists growanc($x)]} {
10056                                 incr ngrowanc -1
10057                             }
10058                             set xl [list $y]
10059                             for {set k 0} {$k < [llength $xl]} {incr k} {
10060                                 set z [lindex $xl $k]
10061                                 foreach c $arcout($z) {
10062                                     if {[info exists arcend($c)]} {
10063                                         set v $arcend($c)
10064                                         if {[info exists dl($v)] && $dl($v)} {
10065                                             set dl($v) 0
10066                                             if {![info exists done($v)]} {
10067                                                 incr nnh -1
10068                                             }
10069                                             if {[info exists growanc($v)]} {
10070                                                 incr ngrowanc -1
10071                                             }
10072                                             lappend xl $v
10073                                         }
10074                                     }
10075                                 }
10076                             }
10077                         }
10078                     }
10079                 } elseif {$y eq $anc || !$dl($x)} {
10080                     set dl($y) 0
10081                     lappend anclist $y
10082                 } else {
10083                     set dl($y) 1
10084                     lappend anclist $y
10085                     incr nnh
10086                 }
10087             }
10088         }
10089     }
10090     foreach x [array names growanc] {
10091         if {$dl($x)} {
10092             return 0
10093         }
10094         return 0
10095     }
10096     return 1
10097 }
10098
10099 proc validate_arctags {a} {
10100     global arctags idtags
10101
10102     set i -1
10103     set na $arctags($a)
10104     foreach id $arctags($a) {
10105         incr i
10106         if {![info exists idtags($id)]} {
10107             set na [lreplace $na $i $i]
10108             incr i -1
10109         }
10110     }
10111     set arctags($a) $na
10112 }
10113
10114 proc validate_archeads {a} {
10115     global archeads idheads
10116
10117     set i -1
10118     set na $archeads($a)
10119     foreach id $archeads($a) {
10120         incr i
10121         if {![info exists idheads($id)]} {
10122             set na [lreplace $na $i $i]
10123             incr i -1
10124         }
10125     }
10126     set archeads($a) $na
10127 }
10128
10129 # Return the list of IDs that have tags that are descendents of id,
10130 # ignoring IDs that are descendents of IDs already reported.
10131 proc desctags {id} {
10132     global arcnos arcstart arcids arctags idtags allparents
10133     global growing cached_dtags
10134
10135     if {![info exists allparents($id)]} {
10136         return {}
10137     }
10138     set t1 [clock clicks -milliseconds]
10139     set argid $id
10140     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10141         # part-way along an arc; check that arc first
10142         set a [lindex $arcnos($id) 0]
10143         if {$arctags($a) ne {}} {
10144             validate_arctags $a
10145             set i [lsearch -exact $arcids($a) $id]
10146             set tid {}
10147             foreach t $arctags($a) {
10148                 set j [lsearch -exact $arcids($a) $t]
10149                 if {$j >= $i} break
10150                 set tid $t
10151             }
10152             if {$tid ne {}} {
10153                 return $tid
10154             }
10155         }
10156         set id $arcstart($a)
10157         if {[info exists idtags($id)]} {
10158             return $id
10159         }
10160     }
10161     if {[info exists cached_dtags($id)]} {
10162         return $cached_dtags($id)
10163     }
10164
10165     set origid $id
10166     set todo [list $id]
10167     set queued($id) 1
10168     set nc 1
10169     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10170         set id [lindex $todo $i]
10171         set done($id) 1
10172         set ta [info exists hastaggedancestor($id)]
10173         if {!$ta} {
10174             incr nc -1
10175         }
10176         # ignore tags on starting node
10177         if {!$ta && $i > 0} {
10178             if {[info exists idtags($id)]} {
10179                 set tagloc($id) $id
10180                 set ta 1
10181             } elseif {[info exists cached_dtags($id)]} {
10182                 set tagloc($id) $cached_dtags($id)
10183                 set ta 1
10184             }
10185         }
10186         foreach a $arcnos($id) {
10187             set d $arcstart($a)
10188             if {!$ta && $arctags($a) ne {}} {
10189                 validate_arctags $a
10190                 if {$arctags($a) ne {}} {
10191                     lappend tagloc($id) [lindex $arctags($a) end]
10192                 }
10193             }
10194             if {$ta || $arctags($a) ne {}} {
10195                 set tomark [list $d]
10196                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10197                     set dd [lindex $tomark $j]
10198                     if {![info exists hastaggedancestor($dd)]} {
10199                         if {[info exists done($dd)]} {
10200                             foreach b $arcnos($dd) {
10201                                 lappend tomark $arcstart($b)
10202                             }
10203                             if {[info exists tagloc($dd)]} {
10204                                 unset tagloc($dd)
10205                             }
10206                         } elseif {[info exists queued($dd)]} {
10207                             incr nc -1
10208                         }
10209                         set hastaggedancestor($dd) 1
10210                     }
10211                 }
10212             }
10213             if {![info exists queued($d)]} {
10214                 lappend todo $d
10215                 set queued($d) 1
10216                 if {![info exists hastaggedancestor($d)]} {
10217                     incr nc
10218                 }
10219             }
10220         }
10221     }
10222     set tags {}
10223     foreach id [array names tagloc] {
10224         if {![info exists hastaggedancestor($id)]} {
10225             foreach t $tagloc($id) {
10226                 if {[lsearch -exact $tags $t] < 0} {
10227                     lappend tags $t
10228                 }
10229             }
10230         }
10231     }
10232     set t2 [clock clicks -milliseconds]
10233     set loopix $i
10234
10235     # remove tags that are descendents of other tags
10236     for {set i 0} {$i < [llength $tags]} {incr i} {
10237         set a [lindex $tags $i]
10238         for {set j 0} {$j < $i} {incr j} {
10239             set b [lindex $tags $j]
10240             set r [anc_or_desc $a $b]
10241             if {$r == 1} {
10242                 set tags [lreplace $tags $j $j]
10243                 incr j -1
10244                 incr i -1
10245             } elseif {$r == -1} {
10246                 set tags [lreplace $tags $i $i]
10247                 incr i -1
10248                 break
10249             }
10250         }
10251     }
10252
10253     if {[array names growing] ne {}} {
10254         # graph isn't finished, need to check if any tag could get
10255         # eclipsed by another tag coming later.  Simply ignore any
10256         # tags that could later get eclipsed.
10257         set ctags {}
10258         foreach t $tags {
10259             if {[is_certain $t $origid]} {
10260                 lappend ctags $t
10261             }
10262         }
10263         if {$tags eq $ctags} {
10264             set cached_dtags($origid) $tags
10265         } else {
10266             set tags $ctags
10267         }
10268     } else {
10269         set cached_dtags($origid) $tags
10270     }
10271     set t3 [clock clicks -milliseconds]
10272     if {0 && $t3 - $t1 >= 100} {
10273         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10274             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10275     }
10276     return $tags
10277 }
10278
10279 proc anctags {id} {
10280     global arcnos arcids arcout arcend arctags idtags allparents
10281     global growing cached_atags
10282
10283     if {![info exists allparents($id)]} {
10284         return {}
10285     }
10286     set t1 [clock clicks -milliseconds]
10287     set argid $id
10288     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10289         # part-way along an arc; check that arc first
10290         set a [lindex $arcnos($id) 0]
10291         if {$arctags($a) ne {}} {
10292             validate_arctags $a
10293             set i [lsearch -exact $arcids($a) $id]
10294             foreach t $arctags($a) {
10295                 set j [lsearch -exact $arcids($a) $t]
10296                 if {$j > $i} {
10297                     return $t
10298                 }
10299             }
10300         }
10301         if {![info exists arcend($a)]} {
10302             return {}
10303         }
10304         set id $arcend($a)
10305         if {[info exists idtags($id)]} {
10306             return $id
10307         }
10308     }
10309     if {[info exists cached_atags($id)]} {
10310         return $cached_atags($id)
10311     }
10312
10313     set origid $id
10314     set todo [list $id]
10315     set queued($id) 1
10316     set taglist {}
10317     set nc 1
10318     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10319         set id [lindex $todo $i]
10320         set done($id) 1
10321         set td [info exists hastaggeddescendent($id)]
10322         if {!$td} {
10323             incr nc -1
10324         }
10325         # ignore tags on starting node
10326         if {!$td && $i > 0} {
10327             if {[info exists idtags($id)]} {
10328                 set tagloc($id) $id
10329                 set td 1
10330             } elseif {[info exists cached_atags($id)]} {
10331                 set tagloc($id) $cached_atags($id)
10332                 set td 1
10333             }
10334         }
10335         foreach a $arcout($id) {
10336             if {!$td && $arctags($a) ne {}} {
10337                 validate_arctags $a
10338                 if {$arctags($a) ne {}} {
10339                     lappend tagloc($id) [lindex $arctags($a) 0]
10340                 }
10341             }
10342             if {![info exists arcend($a)]} continue
10343             set d $arcend($a)
10344             if {$td || $arctags($a) ne {}} {
10345                 set tomark [list $d]
10346                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10347                     set dd [lindex $tomark $j]
10348                     if {![info exists hastaggeddescendent($dd)]} {
10349                         if {[info exists done($dd)]} {
10350                             foreach b $arcout($dd) {
10351                                 if {[info exists arcend($b)]} {
10352                                     lappend tomark $arcend($b)
10353                                 }
10354                             }
10355                             if {[info exists tagloc($dd)]} {
10356                                 unset tagloc($dd)
10357                             }
10358                         } elseif {[info exists queued($dd)]} {
10359                             incr nc -1
10360                         }
10361                         set hastaggeddescendent($dd) 1
10362                     }
10363                 }
10364             }
10365             if {![info exists queued($d)]} {
10366                 lappend todo $d
10367                 set queued($d) 1
10368                 if {![info exists hastaggeddescendent($d)]} {
10369                     incr nc
10370                 }
10371             }
10372         }
10373     }
10374     set t2 [clock clicks -milliseconds]
10375     set loopix $i
10376     set tags {}
10377     foreach id [array names tagloc] {
10378         if {![info exists hastaggeddescendent($id)]} {
10379             foreach t $tagloc($id) {
10380                 if {[lsearch -exact $tags $t] < 0} {
10381                     lappend tags $t
10382                 }
10383             }
10384         }
10385     }
10386
10387     # remove tags that are ancestors of other tags
10388     for {set i 0} {$i < [llength $tags]} {incr i} {
10389         set a [lindex $tags $i]
10390         for {set j 0} {$j < $i} {incr j} {
10391             set b [lindex $tags $j]
10392             set r [anc_or_desc $a $b]
10393             if {$r == -1} {
10394                 set tags [lreplace $tags $j $j]
10395                 incr j -1
10396                 incr i -1
10397             } elseif {$r == 1} {
10398                 set tags [lreplace $tags $i $i]
10399                 incr i -1
10400                 break
10401             }
10402         }
10403     }
10404
10405     if {[array names growing] ne {}} {
10406         # graph isn't finished, need to check if any tag could get
10407         # eclipsed by another tag coming later.  Simply ignore any
10408         # tags that could later get eclipsed.
10409         set ctags {}
10410         foreach t $tags {
10411             if {[is_certain $origid $t]} {
10412                 lappend ctags $t
10413             }
10414         }
10415         if {$tags eq $ctags} {
10416             set cached_atags($origid) $tags
10417         } else {
10418             set tags $ctags
10419         }
10420     } else {
10421         set cached_atags($origid) $tags
10422     }
10423     set t3 [clock clicks -milliseconds]
10424     if {0 && $t3 - $t1 >= 100} {
10425         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10426             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10427     }
10428     return $tags
10429 }
10430
10431 # Return the list of IDs that have heads that are descendents of id,
10432 # including id itself if it has a head.
10433 proc descheads {id} {
10434     global arcnos arcstart arcids archeads idheads cached_dheads
10435     global allparents
10436
10437     if {![info exists allparents($id)]} {
10438         return {}
10439     }
10440     set aret {}
10441     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10442         # part-way along an arc; check it first
10443         set a [lindex $arcnos($id) 0]
10444         if {$archeads($a) ne {}} {
10445             validate_archeads $a
10446             set i [lsearch -exact $arcids($a) $id]
10447             foreach t $archeads($a) {
10448                 set j [lsearch -exact $arcids($a) $t]
10449                 if {$j > $i} break
10450                 lappend aret $t
10451             }
10452         }
10453         set id $arcstart($a)
10454     }
10455     set origid $id
10456     set todo [list $id]
10457     set seen($id) 1
10458     set ret {}
10459     for {set i 0} {$i < [llength $todo]} {incr i} {
10460         set id [lindex $todo $i]
10461         if {[info exists cached_dheads($id)]} {
10462             set ret [concat $ret $cached_dheads($id)]
10463         } else {
10464             if {[info exists idheads($id)]} {
10465                 lappend ret $id
10466             }
10467             foreach a $arcnos($id) {
10468                 if {$archeads($a) ne {}} {
10469                     validate_archeads $a
10470                     if {$archeads($a) ne {}} {
10471                         set ret [concat $ret $archeads($a)]
10472                     }
10473                 }
10474                 set d $arcstart($a)
10475                 if {![info exists seen($d)]} {
10476                     lappend todo $d
10477                     set seen($d) 1
10478                 }
10479             }
10480         }
10481     }
10482     set ret [lsort -unique $ret]
10483     set cached_dheads($origid) $ret
10484     return [concat $ret $aret]
10485 }
10486
10487 proc addedtag {id} {
10488     global arcnos arcout cached_dtags cached_atags
10489
10490     if {![info exists arcnos($id)]} return
10491     if {![info exists arcout($id)]} {
10492         recalcarc [lindex $arcnos($id) 0]
10493     }
10494     catch {unset cached_dtags}
10495     catch {unset cached_atags}
10496 }
10497
10498 proc addedhead {hid head} {
10499     global arcnos arcout cached_dheads
10500
10501     if {![info exists arcnos($hid)]} return
10502     if {![info exists arcout($hid)]} {
10503         recalcarc [lindex $arcnos($hid) 0]
10504     }
10505     catch {unset cached_dheads}
10506 }
10507
10508 proc removedhead {hid head} {
10509     global cached_dheads
10510
10511     catch {unset cached_dheads}
10512 }
10513
10514 proc movedhead {hid head} {
10515     global arcnos arcout cached_dheads
10516
10517     if {![info exists arcnos($hid)]} return
10518     if {![info exists arcout($hid)]} {
10519         recalcarc [lindex $arcnos($hid) 0]
10520     }
10521     catch {unset cached_dheads}
10522 }
10523
10524 proc changedrefs {} {
10525     global cached_dheads cached_dtags cached_atags
10526     global arctags archeads arcnos arcout idheads idtags
10527
10528     foreach id [concat [array names idheads] [array names idtags]] {
10529         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10530             set a [lindex $arcnos($id) 0]
10531             if {![info exists donearc($a)]} {
10532                 recalcarc $a
10533                 set donearc($a) 1
10534             }
10535         }
10536     }
10537     catch {unset cached_dtags}
10538     catch {unset cached_atags}
10539     catch {unset cached_dheads}
10540 }
10541
10542 proc rereadrefs {} {
10543     global idtags idheads idotherrefs mainheadid
10544
10545     set refids [concat [array names idtags] \
10546                     [array names idheads] [array names idotherrefs]]
10547     foreach id $refids {
10548         if {![info exists ref($id)]} {
10549             set ref($id) [listrefs $id]
10550         }
10551     }
10552     set oldmainhead $mainheadid
10553     readrefs
10554     changedrefs
10555     set refids [lsort -unique [concat $refids [array names idtags] \
10556                         [array names idheads] [array names idotherrefs]]]
10557     foreach id $refids {
10558         set v [listrefs $id]
10559         if {![info exists ref($id)] || $ref($id) != $v} {
10560             redrawtags $id
10561         }
10562     }
10563     if {$oldmainhead ne $mainheadid} {
10564         redrawtags $oldmainhead
10565         redrawtags $mainheadid
10566     }
10567     run refill_reflist
10568 }
10569
10570 proc listrefs {id} {
10571     global idtags idheads idotherrefs
10572
10573     set x {}
10574     if {[info exists idtags($id)]} {
10575         set x $idtags($id)
10576     }
10577     set y {}
10578     if {[info exists idheads($id)]} {
10579         set y $idheads($id)
10580     }
10581     set z {}
10582     if {[info exists idotherrefs($id)]} {
10583         set z $idotherrefs($id)
10584     }
10585     return [list $x $y $z]
10586 }
10587
10588 proc showtag {tag isnew} {
10589     global ctext tagcontents tagids linknum tagobjid
10590
10591     if {$isnew} {
10592         addtohistory [list showtag $tag 0] savectextpos
10593     }
10594     $ctext conf -state normal
10595     clear_ctext
10596     settabs 0
10597     set linknum 0
10598     if {![info exists tagcontents($tag)]} {
10599         catch {
10600            set tagcontents($tag) [exec git cat-file tag $tag]
10601         }
10602     }
10603     if {[info exists tagcontents($tag)]} {
10604         set text $tagcontents($tag)
10605     } else {
10606         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10607     }
10608     appendwithlinks $text {}
10609     maybe_scroll_ctext 1
10610     $ctext conf -state disabled
10611     init_flist {}
10612 }
10613
10614 proc doquit {} {
10615     global stopped
10616     global gitktmpdir
10617
10618     set stopped 100
10619     savestuff .
10620     destroy .
10621
10622     if {[info exists gitktmpdir]} {
10623         catch {file delete -force $gitktmpdir}
10624     }
10625 }
10626
10627 proc mkfontdisp {font top which} {
10628     global fontattr fontpref $font NS use_ttk
10629
10630     set fontpref($font) [set $font]
10631     ${NS}::button $top.${font}but -text $which \
10632         -command [list choosefont $font $which]
10633     ${NS}::label $top.$font -relief flat -font $font \
10634         -text $fontattr($font,family) -justify left
10635     grid x $top.${font}but $top.$font -sticky w
10636 }
10637
10638 proc choosefont {font which} {
10639     global fontparam fontlist fonttop fontattr
10640     global prefstop NS
10641
10642     set fontparam(which) $which
10643     set fontparam(font) $font
10644     set fontparam(family) [font actual $font -family]
10645     set fontparam(size) $fontattr($font,size)
10646     set fontparam(weight) $fontattr($font,weight)
10647     set fontparam(slant) $fontattr($font,slant)
10648     set top .gitkfont
10649     set fonttop $top
10650     if {![winfo exists $top]} {
10651         font create sample
10652         eval font config sample [font actual $font]
10653         ttk_toplevel $top
10654         make_transient $top $prefstop
10655         wm title $top [mc "Gitk font chooser"]
10656         ${NS}::label $top.l -textvariable fontparam(which)
10657         pack $top.l -side top
10658         set fontlist [lsort [font families]]
10659         ${NS}::frame $top.f
10660         listbox $top.f.fam -listvariable fontlist \
10661             -yscrollcommand [list $top.f.sb set]
10662         bind $top.f.fam <<ListboxSelect>> selfontfam
10663         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10664         pack $top.f.sb -side right -fill y
10665         pack $top.f.fam -side left -fill both -expand 1
10666         pack $top.f -side top -fill both -expand 1
10667         ${NS}::frame $top.g
10668         spinbox $top.g.size -from 4 -to 40 -width 4 \
10669             -textvariable fontparam(size) \
10670             -validatecommand {string is integer -strict %s}
10671         checkbutton $top.g.bold -padx 5 \
10672             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10673             -variable fontparam(weight) -onvalue bold -offvalue normal
10674         checkbutton $top.g.ital -padx 5 \
10675             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10676             -variable fontparam(slant) -onvalue italic -offvalue roman
10677         pack $top.g.size $top.g.bold $top.g.ital -side left
10678         pack $top.g -side top
10679         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10680             -background white
10681         $top.c create text 100 25 -anchor center -text $which -font sample \
10682             -fill black -tags text
10683         bind $top.c <Configure> [list centertext $top.c]
10684         pack $top.c -side top -fill x
10685         ${NS}::frame $top.buts
10686         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10687         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10688         bind $top <Key-Return> fontok
10689         bind $top <Key-Escape> fontcan
10690         grid $top.buts.ok $top.buts.can
10691         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10692         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10693         pack $top.buts -side bottom -fill x
10694         trace add variable fontparam write chg_fontparam
10695     } else {
10696         raise $top
10697         $top.c itemconf text -text $which
10698     }
10699     set i [lsearch -exact $fontlist $fontparam(family)]
10700     if {$i >= 0} {
10701         $top.f.fam selection set $i
10702         $top.f.fam see $i
10703     }
10704 }
10705
10706 proc centertext {w} {
10707     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10708 }
10709
10710 proc fontok {} {
10711     global fontparam fontpref prefstop
10712
10713     set f $fontparam(font)
10714     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10715     if {$fontparam(weight) eq "bold"} {
10716         lappend fontpref($f) "bold"
10717     }
10718     if {$fontparam(slant) eq "italic"} {
10719         lappend fontpref($f) "italic"
10720     }
10721     set w $prefstop.$f
10722     $w conf -text $fontparam(family) -font $fontpref($f)
10723
10724     fontcan
10725 }
10726
10727 proc fontcan {} {
10728     global fonttop fontparam
10729
10730     if {[info exists fonttop]} {
10731         catch {destroy $fonttop}
10732         catch {font delete sample}
10733         unset fonttop
10734         unset fontparam
10735     }
10736 }
10737
10738 if {[package vsatisfies [package provide Tk] 8.6]} {
10739     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10740     # function to make use of it.
10741     proc choosefont {font which} {
10742         tk fontchooser configure -title $which -font $font \
10743             -command [list on_choosefont $font $which]
10744         tk fontchooser show
10745     }
10746     proc on_choosefont {font which newfont} {
10747         global fontparam
10748         puts stderr "$font $newfont"
10749         array set f [font actual $newfont]
10750         set fontparam(which) $which
10751         set fontparam(font) $font
10752         set fontparam(family) $f(-family)
10753         set fontparam(size) $f(-size)
10754         set fontparam(weight) $f(-weight)
10755         set fontparam(slant) $f(-slant)
10756         fontok
10757     }
10758 }
10759
10760 proc selfontfam {} {
10761     global fonttop fontparam
10762
10763     set i [$fonttop.f.fam curselection]
10764     if {$i ne {}} {
10765         set fontparam(family) [$fonttop.f.fam get $i]
10766     }
10767 }
10768
10769 proc chg_fontparam {v sub op} {
10770     global fontparam
10771
10772     font config sample -$sub $fontparam($sub)
10773 }
10774
10775 proc doprefs {} {
10776     global maxwidth maxgraphpct use_ttk NS
10777     global oldprefs prefstop showneartags showlocalchanges
10778     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10779     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10780     global hideremotes want_ttk have_ttk
10781
10782     set top .gitkprefs
10783     set prefstop $top
10784     if {[winfo exists $top]} {
10785         raise $top
10786         return
10787     }
10788     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10789                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10790         set oldprefs($v) [set $v]
10791     }
10792     ttk_toplevel $top
10793     wm title $top [mc "Gitk preferences"]
10794     make_transient $top .
10795     ${NS}::label $top.ldisp -text [mc "Commit list display options"]
10796     grid $top.ldisp - -sticky w -pady 10
10797     ${NS}::label $top.spacer -text " "
10798     ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
10799     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10800     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10801     ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
10802     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10803     grid x $top.maxpctl $top.maxpct -sticky w
10804     ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10805         -variable showlocalchanges
10806     grid x $top.showlocal -sticky w
10807     ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1 (length)"] \
10808         -variable autoselect
10809     spinbox $top.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10810     grid x $top.autoselect $top.autosellen -sticky w
10811     ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10812         -variable hideremotes
10813     grid x $top.hideremotes -sticky w
10814
10815     ${NS}::label $top.ddisp -text [mc "Diff display options"]
10816     grid $top.ddisp - -sticky w -pady 10
10817     ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
10818     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10819     grid x $top.tabstopl $top.tabstop -sticky w
10820     ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10821         -variable showneartags
10822     grid x $top.ntag -sticky w
10823     ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10824         -variable limitdiffs
10825     grid x $top.ldiff -sticky w
10826     ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10827         -variable perfile_attrs
10828     grid x $top.lattr -sticky w
10829
10830     ${NS}::entry $top.extdifft -textvariable extdifftool
10831     ${NS}::frame $top.extdifff
10832     ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10833     ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10834     pack $top.extdifff.l $top.extdifff.b -side left
10835     pack configure $top.extdifff.l -padx 10
10836     grid x $top.extdifff $top.extdifft -sticky ew
10837
10838     ${NS}::label $top.lgen -text [mc "General options"]
10839     grid $top.lgen - -sticky w -pady 10
10840     ${NS}::checkbutton $top.want_ttk -variable want_ttk \
10841         -text [mc "Use themed widgets"]
10842     if {$have_ttk} {
10843         ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
10844     } else {
10845         ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
10846     }
10847     grid x $top.want_ttk $top.ttk_note -sticky w
10848
10849     ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
10850     grid $top.cdisp - -sticky w -pady 10
10851     label $top.ui -padx 40 -relief sunk -background $uicolor
10852     ${NS}::button $top.uibut -text [mc "Interface"] \
10853        -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
10854     grid x $top.uibut $top.ui -sticky w
10855     label $top.bg -padx 40 -relief sunk -background $bgcolor
10856     ${NS}::button $top.bgbut -text [mc "Background"] \
10857         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10858     grid x $top.bgbut $top.bg -sticky w
10859     label $top.fg -padx 40 -relief sunk -background $fgcolor
10860     ${NS}::button $top.fgbut -text [mc "Foreground"] \
10861         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10862     grid x $top.fgbut $top.fg -sticky w
10863     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10864     ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
10865         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10866                       [list $ctext tag conf d0 -foreground]]
10867     grid x $top.diffoldbut $top.diffold -sticky w
10868     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10869     ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
10870         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10871                       [list $ctext tag conf dresult -foreground]]
10872     grid x $top.diffnewbut $top.diffnew -sticky w
10873     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10874     ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
10875         -command [list choosecolor diffcolors 2 $top.hunksep \
10876                       [mc "diff hunk header"] \
10877                       [list $ctext tag conf hunksep -foreground]]
10878     grid x $top.hunksepbut $top.hunksep -sticky w
10879     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10880     ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
10881         -command [list choosecolor markbgcolor {} $top.markbgsep \
10882                       [mc "marked line background"] \
10883                       [list $ctext tag conf omark -background]]
10884     grid x $top.markbgbut $top.markbgsep -sticky w
10885     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10886     ${NS}::button $top.selbgbut -text [mc "Select bg"] \
10887         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10888     grid x $top.selbgbut $top.selbgsep -sticky w
10889
10890     ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
10891     grid $top.cfont - -sticky w -pady 10
10892     mkfontdisp mainfont $top [mc "Main font"]
10893     mkfontdisp textfont $top [mc "Diff display font"]
10894     mkfontdisp uifont $top [mc "User interface font"]
10895
10896     ${NS}::frame $top.buts
10897     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10898     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10899     bind $top <Key-Return> prefsok
10900     bind $top <Key-Escape> prefscan
10901     grid $top.buts.ok $top.buts.can
10902     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10903     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10904     grid $top.buts - - -pady 10 -sticky ew
10905     grid columnconfigure $top 2 -weight 1
10906     bind $top <Visibility> "focus $top.buts.ok"
10907 }
10908
10909 proc choose_extdiff {} {
10910     global extdifftool
10911
10912     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10913     if {$prog ne {}} {
10914         set extdifftool $prog
10915     }
10916 }
10917
10918 proc choosecolor {v vi w x cmd} {
10919     global $v
10920
10921     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10922                -title [mc "Gitk: choose color for %s" $x]]
10923     if {$c eq {}} return
10924     $w conf -background $c
10925     lset $v $vi $c
10926     eval $cmd $c
10927 }
10928
10929 proc setselbg {c} {
10930     global bglist cflist
10931     foreach w $bglist {
10932         $w configure -selectbackground $c
10933     }
10934     $cflist tag configure highlight \
10935         -background [$cflist cget -selectbackground]
10936     allcanvs itemconf secsel -fill $c
10937 }
10938
10939 # This sets the background color and the color scheme for the whole UI.
10940 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
10941 # if we don't specify one ourselves, which makes the checkbuttons and
10942 # radiobuttons look bad.  This chooses white for selectColor if the
10943 # background color is light, or black if it is dark.
10944 proc setui {c} {
10945     if {[tk windowingsystem] eq "win32"} { return }
10946     set bg [winfo rgb . $c]
10947     set selc black
10948     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
10949         set selc white
10950     }
10951     tk_setPalette background $c selectColor $selc
10952 }
10953
10954 proc setbg {c} {
10955     global bglist
10956
10957     foreach w $bglist {
10958         $w conf -background $c
10959     }
10960 }
10961
10962 proc setfg {c} {
10963     global fglist canv
10964
10965     foreach w $fglist {
10966         $w conf -foreground $c
10967     }
10968     allcanvs itemconf text -fill $c
10969     $canv itemconf circle -outline $c
10970     $canv itemconf markid -outline $c
10971 }
10972
10973 proc prefscan {} {
10974     global oldprefs prefstop
10975
10976     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10977                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10978         global $v
10979         set $v $oldprefs($v)
10980     }
10981     catch {destroy $prefstop}
10982     unset prefstop
10983     fontcan
10984 }
10985
10986 proc prefsok {} {
10987     global maxwidth maxgraphpct
10988     global oldprefs prefstop showneartags showlocalchanges
10989     global fontpref mainfont textfont uifont
10990     global limitdiffs treediffs perfile_attrs
10991     global hideremotes
10992
10993     catch {destroy $prefstop}
10994     unset prefstop
10995     fontcan
10996     set fontchanged 0
10997     if {$mainfont ne $fontpref(mainfont)} {
10998         set mainfont $fontpref(mainfont)
10999         parsefont mainfont $mainfont
11000         eval font configure mainfont [fontflags mainfont]
11001         eval font configure mainfontbold [fontflags mainfont 1]
11002         setcoords
11003         set fontchanged 1
11004     }
11005     if {$textfont ne $fontpref(textfont)} {
11006         set textfont $fontpref(textfont)
11007         parsefont textfont $textfont
11008         eval font configure textfont [fontflags textfont]
11009         eval font configure textfontbold [fontflags textfont 1]
11010     }
11011     if {$uifont ne $fontpref(uifont)} {
11012         set uifont $fontpref(uifont)
11013         parsefont uifont $uifont
11014         eval font configure uifont [fontflags uifont]
11015     }
11016     settabs
11017     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11018         if {$showlocalchanges} {
11019             doshowlocalchanges
11020         } else {
11021             dohidelocalchanges
11022         }
11023     }
11024     if {$limitdiffs != $oldprefs(limitdiffs) ||
11025         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11026         # treediffs elements are limited by path;
11027         # won't have encodings cached if perfile_attrs was just turned on
11028         catch {unset treediffs}
11029     }
11030     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11031         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11032         redisplay
11033     } elseif {$showneartags != $oldprefs(showneartags) ||
11034           $limitdiffs != $oldprefs(limitdiffs)} {
11035         reselectline
11036     }
11037     if {$hideremotes != $oldprefs(hideremotes)} {
11038         rereadrefs
11039     }
11040 }
11041
11042 proc formatdate {d} {
11043     global datetimeformat
11044     if {$d ne {}} {
11045         set d [clock format [lindex $d 0] -format $datetimeformat]
11046     }
11047     return $d
11048 }
11049
11050 # This list of encoding names and aliases is distilled from
11051 # http://www.iana.org/assignments/character-sets.
11052 # Not all of them are supported by Tcl.
11053 set encoding_aliases {
11054     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11055       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11056     { ISO-10646-UTF-1 csISO10646UTF1 }
11057     { ISO_646.basic:1983 ref csISO646basic1983 }
11058     { INVARIANT csINVARIANT }
11059     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11060     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11061     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11062     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11063     { NATS-DANO iso-ir-9-1 csNATSDANO }
11064     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11065     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11066     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11067     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11068     { ISO-2022-KR csISO2022KR }
11069     { EUC-KR csEUCKR }
11070     { ISO-2022-JP csISO2022JP }
11071     { ISO-2022-JP-2 csISO2022JP2 }
11072     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11073       csISO13JISC6220jp }
11074     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11075     { IT iso-ir-15 ISO646-IT csISO15Italian }
11076     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11077     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11078     { greek7-old iso-ir-18 csISO18Greek7Old }
11079     { latin-greek iso-ir-19 csISO19LatinGreek }
11080     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11081     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11082     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11083     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11084     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11085     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11086     { INIS iso-ir-49 csISO49INIS }
11087     { INIS-8 iso-ir-50 csISO50INIS8 }
11088     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11089     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11090     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11091     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11092     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11093     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11094       csISO60Norwegian1 }
11095     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11096     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11097     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11098     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11099     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11100     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11101     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11102     { greek7 iso-ir-88 csISO88Greek7 }
11103     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11104     { iso-ir-90 csISO90 }
11105     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11106     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11107       csISO92JISC62991984b }
11108     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11109     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11110     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11111       csISO95JIS62291984handadd }
11112     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11113     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11114     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11115     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11116       CP819 csISOLatin1 }
11117     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11118     { T.61-7bit iso-ir-102 csISO102T617bit }
11119     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11120     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11121     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11122     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11123     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11124     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11125     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11126     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11127       arabic csISOLatinArabic }
11128     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11129     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11130     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11131       greek greek8 csISOLatinGreek }
11132     { T.101-G2 iso-ir-128 csISO128T101G2 }
11133     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11134       csISOLatinHebrew }
11135     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11136     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11137     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11138     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11139     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11140     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11141     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11142       csISOLatinCyrillic }
11143     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11144     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11145     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11146     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11147     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11148     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11149     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11150     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11151     { ISO_10367-box iso-ir-155 csISO10367Box }
11152     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11153     { latin-lap lap iso-ir-158 csISO158Lap }
11154     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11155     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11156     { us-dk csUSDK }
11157     { dk-us csDKUS }
11158     { JIS_X0201 X0201 csHalfWidthKatakana }
11159     { KSC5636 ISO646-KR csKSC5636 }
11160     { ISO-10646-UCS-2 csUnicode }
11161     { ISO-10646-UCS-4 csUCS4 }
11162     { DEC-MCS dec csDECMCS }
11163     { hp-roman8 roman8 r8 csHPRoman8 }
11164     { macintosh mac csMacintosh }
11165     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11166       csIBM037 }
11167     { IBM038 EBCDIC-INT cp038 csIBM038 }
11168     { IBM273 CP273 csIBM273 }
11169     { IBM274 EBCDIC-BE CP274 csIBM274 }
11170     { IBM275 EBCDIC-BR cp275 csIBM275 }
11171     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11172     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11173     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11174     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11175     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11176     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11177     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11178     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11179     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11180     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11181     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11182     { IBM437 cp437 437 csPC8CodePage437 }
11183     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11184     { IBM775 cp775 csPC775Baltic }
11185     { IBM850 cp850 850 csPC850Multilingual }
11186     { IBM851 cp851 851 csIBM851 }
11187     { IBM852 cp852 852 csPCp852 }
11188     { IBM855 cp855 855 csIBM855 }
11189     { IBM857 cp857 857 csIBM857 }
11190     { IBM860 cp860 860 csIBM860 }
11191     { IBM861 cp861 861 cp-is csIBM861 }
11192     { IBM862 cp862 862 csPC862LatinHebrew }
11193     { IBM863 cp863 863 csIBM863 }
11194     { IBM864 cp864 csIBM864 }
11195     { IBM865 cp865 865 csIBM865 }
11196     { IBM866 cp866 866 csIBM866 }
11197     { IBM868 CP868 cp-ar csIBM868 }
11198     { IBM869 cp869 869 cp-gr csIBM869 }
11199     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11200     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11201     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11202     { IBM891 cp891 csIBM891 }
11203     { IBM903 cp903 csIBM903 }
11204     { IBM904 cp904 904 csIBBM904 }
11205     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11206     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11207     { IBM1026 CP1026 csIBM1026 }
11208     { EBCDIC-AT-DE csIBMEBCDICATDE }
11209     { EBCDIC-AT-DE-A csEBCDICATDEA }
11210     { EBCDIC-CA-FR csEBCDICCAFR }
11211     { EBCDIC-DK-NO csEBCDICDKNO }
11212     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11213     { EBCDIC-FI-SE csEBCDICFISE }
11214     { EBCDIC-FI-SE-A csEBCDICFISEA }
11215     { EBCDIC-FR csEBCDICFR }
11216     { EBCDIC-IT csEBCDICIT }
11217     { EBCDIC-PT csEBCDICPT }
11218     { EBCDIC-ES csEBCDICES }
11219     { EBCDIC-ES-A csEBCDICESA }
11220     { EBCDIC-ES-S csEBCDICESS }
11221     { EBCDIC-UK csEBCDICUK }
11222     { EBCDIC-US csEBCDICUS }
11223     { UNKNOWN-8BIT csUnknown8BiT }
11224     { MNEMONIC csMnemonic }
11225     { MNEM csMnem }
11226     { VISCII csVISCII }
11227     { VIQR csVIQR }
11228     { KOI8-R csKOI8R }
11229     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11230     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11231     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11232     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11233     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11234     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11235     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11236     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11237     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11238     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11239     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11240     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11241     { IBM1047 IBM-1047 }
11242     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11243     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11244     { UNICODE-1-1 csUnicode11 }
11245     { CESU-8 csCESU-8 }
11246     { BOCU-1 csBOCU-1 }
11247     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11248     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11249       l8 }
11250     { ISO-8859-15 ISO_8859-15 Latin-9 }
11251     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11252     { GBK CP936 MS936 windows-936 }
11253     { JIS_Encoding csJISEncoding }
11254     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11255     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11256       EUC-JP }
11257     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11258     { ISO-10646-UCS-Basic csUnicodeASCII }
11259     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11260     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11261     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11262     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11263     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11264     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11265     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11266     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11267     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11268     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11269     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11270     { Ventura-US csVenturaUS }
11271     { Ventura-International csVenturaInternational }
11272     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11273     { PC8-Turkish csPC8Turkish }
11274     { IBM-Symbols csIBMSymbols }
11275     { IBM-Thai csIBMThai }
11276     { HP-Legal csHPLegal }
11277     { HP-Pi-font csHPPiFont }
11278     { HP-Math8 csHPMath8 }
11279     { Adobe-Symbol-Encoding csHPPSMath }
11280     { HP-DeskTop csHPDesktop }
11281     { Ventura-Math csVenturaMath }
11282     { Microsoft-Publishing csMicrosoftPublishing }
11283     { Windows-31J csWindows31J }
11284     { GB2312 csGB2312 }
11285     { Big5 csBig5 }
11286 }
11287
11288 proc tcl_encoding {enc} {
11289     global encoding_aliases tcl_encoding_cache
11290     if {[info exists tcl_encoding_cache($enc)]} {
11291         return $tcl_encoding_cache($enc)
11292     }
11293     set names [encoding names]
11294     set lcnames [string tolower $names]
11295     set enc [string tolower $enc]
11296     set i [lsearch -exact $lcnames $enc]
11297     if {$i < 0} {
11298         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11299         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11300             set i [lsearch -exact $lcnames $encx]
11301         }
11302     }
11303     if {$i < 0} {
11304         foreach l $encoding_aliases {
11305             set ll [string tolower $l]
11306             if {[lsearch -exact $ll $enc] < 0} continue
11307             # look through the aliases for one that tcl knows about
11308             foreach e $ll {
11309                 set i [lsearch -exact $lcnames $e]
11310                 if {$i < 0} {
11311                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11312                         set i [lsearch -exact $lcnames $ex]
11313                     }
11314                 }
11315                 if {$i >= 0} break
11316             }
11317             break
11318         }
11319     }
11320     set tclenc {}
11321     if {$i >= 0} {
11322         set tclenc [lindex $names $i]
11323     }
11324     set tcl_encoding_cache($enc) $tclenc
11325     return $tclenc
11326 }
11327
11328 proc gitattr {path attr default} {
11329     global path_attr_cache
11330     if {[info exists path_attr_cache($attr,$path)]} {
11331         set r $path_attr_cache($attr,$path)
11332     } else {
11333         set r "unspecified"
11334         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11335             regexp "(.*): $attr: (.*)" $line m f r
11336         }
11337         set path_attr_cache($attr,$path) $r
11338     }
11339     if {$r eq "unspecified"} {
11340         return $default
11341     }
11342     return $r
11343 }
11344
11345 proc cache_gitattr {attr pathlist} {
11346     global path_attr_cache
11347     set newlist {}
11348     foreach path $pathlist {
11349         if {![info exists path_attr_cache($attr,$path)]} {
11350             lappend newlist $path
11351         }
11352     }
11353     set lim 1000
11354     if {[tk windowingsystem] == "win32"} {
11355         # windows has a 32k limit on the arguments to a command...
11356         set lim 30
11357     }
11358     while {$newlist ne {}} {
11359         set head [lrange $newlist 0 [expr {$lim - 1}]]
11360         set newlist [lrange $newlist $lim end]
11361         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11362             foreach row [split $rlist "\n"] {
11363                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11364                     if {[string index $path 0] eq "\""} {
11365                         set path [encoding convertfrom [lindex $path 0]]
11366                     }
11367                     set path_attr_cache($attr,$path) $value
11368                 }
11369             }
11370         }
11371     }
11372 }
11373
11374 proc get_path_encoding {path} {
11375     global gui_encoding perfile_attrs
11376     set tcl_enc $gui_encoding
11377     if {$path ne {} && $perfile_attrs} {
11378         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11379         if {$enc2 ne {}} {
11380             set tcl_enc $enc2
11381         }
11382     }
11383     return $tcl_enc
11384 }
11385
11386 # First check that Tcl/Tk is recent enough
11387 if {[catch {package require Tk 8.4} err]} {
11388     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11389                      Gitk requires at least Tcl/Tk 8.4." list
11390     exit 1
11391 }
11392
11393 # defaults...
11394 set wrcomcmd "git diff-tree --stdin -p --pretty"
11395
11396 set gitencoding {}
11397 catch {
11398     set gitencoding [exec git config --get i18n.commitencoding]
11399 }
11400 catch {
11401     set gitencoding [exec git config --get i18n.logoutputencoding]
11402 }
11403 if {$gitencoding == ""} {
11404     set gitencoding "utf-8"
11405 }
11406 set tclencoding [tcl_encoding $gitencoding]
11407 if {$tclencoding == {}} {
11408     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11409 }
11410
11411 set gui_encoding [encoding system]
11412 catch {
11413     set enc [exec git config --get gui.encoding]
11414     if {$enc ne {}} {
11415         set tclenc [tcl_encoding $enc]
11416         if {$tclenc ne {}} {
11417             set gui_encoding $tclenc
11418         } else {
11419             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11420         }
11421     }
11422 }
11423
11424 if {[tk windowingsystem] eq "aqua"} {
11425     set mainfont {{Lucida Grande} 9}
11426     set textfont {Monaco 9}
11427     set uifont {{Lucida Grande} 9 bold}
11428 } else {
11429     set mainfont {Helvetica 9}
11430     set textfont {Courier 9}
11431     set uifont {Helvetica 9 bold}
11432 }
11433 set tabstop 8
11434 set findmergefiles 0
11435 set maxgraphpct 50
11436 set maxwidth 16
11437 set revlistorder 0
11438 set fastdate 0
11439 set uparrowlen 5
11440 set downarrowlen 5
11441 set mingaplen 100
11442 set cmitmode "patch"
11443 set wrapcomment "none"
11444 set showneartags 1
11445 set hideremotes 0
11446 set maxrefs 20
11447 set maxlinelen 200
11448 set showlocalchanges 1
11449 set limitdiffs 1
11450 set datetimeformat "%Y-%m-%d %H:%M:%S"
11451 set autoselect 1
11452 set autosellen 40
11453 set perfile_attrs 0
11454 set want_ttk 1
11455
11456 if {[tk windowingsystem] eq "aqua"} {
11457     set extdifftool "opendiff"
11458 } else {
11459     set extdifftool "meld"
11460 }
11461
11462 set colors {green red blue magenta darkgrey brown orange}
11463 if {[tk windowingsystem] eq "win32"} {
11464     set uicolor SystemButtonFace
11465     set bgcolor SystemWindow
11466     set fgcolor SystemButtonText
11467     set selectbgcolor SystemHighlight
11468 } else {
11469     set uicolor grey85
11470     set bgcolor white
11471     set fgcolor black
11472     set selectbgcolor gray85
11473 }
11474 set diffcolors {red "#00a000" blue}
11475 set diffcontext 3
11476 set ignorespace 0
11477 set worddiff ""
11478 set markbgcolor "#e0e0ff"
11479
11480 set circlecolors {white blue gray blue blue}
11481
11482 # button for popping up context menus
11483 if {[tk windowingsystem] eq "aqua"} {
11484     set ctxbut <Button-2>
11485 } else {
11486     set ctxbut <Button-3>
11487 }
11488
11489 ## For msgcat loading, first locate the installation location.
11490 if { [info exists ::env(GITK_MSGSDIR)] } {
11491     ## Msgsdir was manually set in the environment.
11492     set gitk_msgsdir $::env(GITK_MSGSDIR)
11493 } else {
11494     ## Let's guess the prefix from argv0.
11495     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11496     set gitk_libdir [file join $gitk_prefix share gitk lib]
11497     set gitk_msgsdir [file join $gitk_libdir msgs]
11498     unset gitk_prefix
11499 }
11500
11501 ## Internationalization (i18n) through msgcat and gettext. See
11502 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11503 package require msgcat
11504 namespace import ::msgcat::mc
11505 ## And eventually load the actual message catalog
11506 ::msgcat::mcload $gitk_msgsdir
11507
11508 catch {source ~/.gitk}
11509
11510 parsefont mainfont $mainfont
11511 eval font create mainfont [fontflags mainfont]
11512 eval font create mainfontbold [fontflags mainfont 1]
11513
11514 parsefont textfont $textfont
11515 eval font create textfont [fontflags textfont]
11516 eval font create textfontbold [fontflags textfont 1]
11517
11518 parsefont uifont $uifont
11519 eval font create uifont [fontflags uifont]
11520
11521 setui $uicolor
11522
11523 setoptions
11524
11525 # check that we can find a .git directory somewhere...
11526 if {[catch {set gitdir [gitdir]}]} {
11527     show_error {} . [mc "Cannot find a git repository here."]
11528     exit 1
11529 }
11530 if {![file isdirectory $gitdir]} {
11531     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11532     exit 1
11533 }
11534
11535 set selecthead {}
11536 set selectheadid {}
11537
11538 set revtreeargs {}
11539 set cmdline_files {}
11540 set i 0
11541 set revtreeargscmd {}
11542 foreach arg $argv {
11543     switch -glob -- $arg {
11544         "" { }
11545         "--" {
11546             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11547             break
11548         }
11549         "--select-commit=*" {
11550             set selecthead [string range $arg 16 end]
11551         }
11552         "--argscmd=*" {
11553             set revtreeargscmd [string range $arg 10 end]
11554         }
11555         default {
11556             lappend revtreeargs $arg
11557         }
11558     }
11559     incr i
11560 }
11561
11562 if {$selecthead eq "HEAD"} {
11563     set selecthead {}
11564 }
11565
11566 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11567     # no -- on command line, but some arguments (other than --argscmd)
11568     if {[catch {
11569         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11570         set cmdline_files [split $f "\n"]
11571         set n [llength $cmdline_files]
11572         set revtreeargs [lrange $revtreeargs 0 end-$n]
11573         # Unfortunately git rev-parse doesn't produce an error when
11574         # something is both a revision and a filename.  To be consistent
11575         # with git log and git rev-list, check revtreeargs for filenames.
11576         foreach arg $revtreeargs {
11577             if {[file exists $arg]} {
11578                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11579                                  and filename" $arg]
11580                 exit 1
11581             }
11582         }
11583     } err]} {
11584         # unfortunately we get both stdout and stderr in $err,
11585         # so look for "fatal:".
11586         set i [string first "fatal:" $err]
11587         if {$i > 0} {
11588             set err [string range $err [expr {$i + 6}] end]
11589         }
11590         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11591         exit 1
11592     }
11593 }
11594
11595 set nullid "0000000000000000000000000000000000000000"
11596 set nullid2 "0000000000000000000000000000000000000001"
11597 set nullfile "/dev/null"
11598
11599 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11600 if {![info exists have_ttk]} {
11601     set have_ttk [llength [info commands ::ttk::style]]
11602 }
11603 set use_ttk [expr {$have_ttk && $want_ttk}]
11604 set NS [expr {$use_ttk ? "ttk" : ""}]
11605
11606 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11607
11608 set show_notes {}
11609 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11610     set show_notes "--show-notes"
11611 }
11612
11613 set runq {}
11614 set history {}
11615 set historyindex 0
11616 set fh_serial 0
11617 set nhl_names {}
11618 set highlight_paths {}
11619 set findpattern {}
11620 set searchdirn -forwards
11621 set boldids {}
11622 set boldnameids {}
11623 set diffelide {0 0}
11624 set markingmatches 0
11625 set linkentercount 0
11626 set need_redisplay 0
11627 set nrows_drawn 0
11628 set firsttabstop 0
11629
11630 set nextviewnum 1
11631 set curview 0
11632 set selectedview 0
11633 set selectedhlview [mc "None"]
11634 set highlight_related [mc "None"]
11635 set highlight_files {}
11636 set viewfiles(0) {}
11637 set viewperm(0) 0
11638 set viewargs(0) {}
11639 set viewargscmd(0) {}
11640
11641 set selectedline {}
11642 set numcommits 0
11643 set loginstance 0
11644 set cmdlineok 0
11645 set stopped 0
11646 set stuffsaved 0
11647 set patchnum 0
11648 set lserial 0
11649 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11650 set cdup {}
11651 if {$isworktree} {
11652     set cdup [exec git rev-parse --show-cdup]
11653 }
11654 set worktree [exec git rev-parse --show-toplevel]
11655 setcoords
11656 makewindow
11657 catch {
11658     image create photo gitlogo      -width 16 -height 16
11659
11660     image create photo gitlogominus -width  4 -height  2
11661     gitlogominus put #C00000 -to 0 0 4 2
11662     gitlogo copy gitlogominus -to  1 5
11663     gitlogo copy gitlogominus -to  6 5
11664     gitlogo copy gitlogominus -to 11 5
11665     image delete gitlogominus
11666
11667     image create photo gitlogoplus  -width  4 -height  4
11668     gitlogoplus  put #008000 -to 1 0 3 4
11669     gitlogoplus  put #008000 -to 0 1 4 3
11670     gitlogo copy gitlogoplus  -to  1 9
11671     gitlogo copy gitlogoplus  -to  6 9
11672     gitlogo copy gitlogoplus  -to 11 9
11673     image delete gitlogoplus
11674
11675     image create photo gitlogo32    -width 32 -height 32
11676     gitlogo32 copy gitlogo -zoom 2 2
11677
11678     wm iconphoto . -default gitlogo gitlogo32
11679 }
11680 # wait for the window to become visible
11681 tkwait visibility .
11682 wm title . "[file tail $argv0]: [file tail [pwd]]"
11683 update
11684 readrefs
11685
11686 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11687     # create a view for the files/dirs specified on the command line
11688     set curview 1
11689     set selectedview 1
11690     set nextviewnum 2
11691     set viewname(1) [mc "Command line"]
11692     set viewfiles(1) $cmdline_files
11693     set viewargs(1) $revtreeargs
11694     set viewargscmd(1) $revtreeargscmd
11695     set viewperm(1) 0
11696     set vdatemode(1) 0
11697     addviewmenu 1
11698     .bar.view entryconf [mca "Edit view..."] -state normal
11699     .bar.view entryconf [mca "Delete view"] -state normal
11700 }
11701
11702 if {[info exists permviews]} {
11703     foreach v $permviews {
11704         set n $nextviewnum
11705         incr nextviewnum
11706         set viewname($n) [lindex $v 0]
11707         set viewfiles($n) [lindex $v 1]
11708         set viewargs($n) [lindex $v 2]
11709         set viewargscmd($n) [lindex $v 3]
11710         set viewperm($n) 1
11711         addviewmenu $n
11712     }
11713 }
11714
11715 if {[tk windowingsystem] eq "win32"} {
11716     focus -force .
11717 }
11718
11719 getcommits {}
11720
11721 # Local variables:
11722 # mode: tcl
11723 # indent-tabs-mode: t
11724 # tab-width: 8
11725 # End: