gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2009 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 $commitinfo($id) 4]
 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 [lindex $line end-1]
1645             set auname [join [lrange $line 1 end-2] " "]
1646         } elseif {$tag == "committer"} {
1647             set comdate [lindex $line end-1]
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 commitinfo($id) [list $headline $auname $audate \
1675                              $comname $comdate $comment]
1676 }
1677
1678 proc getcommit {id} {
1679     global commitdata commitinfo
1680
1681     if {[info exists commitdata($id)]} {
1682         parsecommit $id $commitdata($id) 1
1683     } else {
1684         readcommit $id
1685         if {![info exists commitinfo($id)]} {
1686             set commitinfo($id) [list [mc "No commit information available"]]
1687         }
1688     }
1689     return 1
1690 }
1691
1692 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1693 # and are present in the current view.
1694 # This is fairly slow...
1695 proc longid {prefix} {
1696     global varcid curview
1697
1698     set ids {}
1699     foreach match [array names varcid "$curview,$prefix*"] {
1700         lappend ids [lindex [split $match ","] 1]
1701     }
1702     return $ids
1703 }
1704
1705 proc readrefs {} {
1706     global tagids idtags headids idheads tagobjid
1707     global otherrefids idotherrefs mainhead mainheadid
1708     global selecthead selectheadid
1709     global hideremotes
1710
1711     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1712         catch {unset $v}
1713     }
1714     set refd [open [list | git show-ref -d] r]
1715     while {[gets $refd line] >= 0} {
1716         if {[string index $line 40] ne " "} continue
1717         set id [string range $line 0 39]
1718         set ref [string range $line 41 end]
1719         if {![string match "refs/*" $ref]} continue
1720         set name [string range $ref 5 end]
1721         if {[string match "remotes/*" $name]} {
1722             if {![string match "*/HEAD" $name] && !$hideremotes} {
1723                 set headids($name) $id
1724                 lappend idheads($id) $name
1725             }
1726         } elseif {[string match "heads/*" $name]} {
1727             set name [string range $name 6 end]
1728             set headids($name) $id
1729             lappend idheads($id) $name
1730         } elseif {[string match "tags/*" $name]} {
1731             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1732             # which is what we want since the former is the commit ID
1733             set name [string range $name 5 end]
1734             if {[string match "*^{}" $name]} {
1735                 set name [string range $name 0 end-3]
1736             } else {
1737                 set tagobjid($name) $id
1738             }
1739             set tagids($name) $id
1740             lappend idtags($id) $name
1741         } else {
1742             set otherrefids($name) $id
1743             lappend idotherrefs($id) $name
1744         }
1745     }
1746     catch {close $refd}
1747     set mainhead {}
1748     set mainheadid {}
1749     catch {
1750         set mainheadid [exec git rev-parse HEAD]
1751         set thehead [exec git symbolic-ref HEAD]
1752         if {[string match "refs/heads/*" $thehead]} {
1753             set mainhead [string range $thehead 11 end]
1754         }
1755     }
1756     set selectheadid {}
1757     if {$selecthead ne {}} {
1758         catch {
1759             set selectheadid [exec git rev-parse --verify $selecthead]
1760         }
1761     }
1762 }
1763
1764 # skip over fake commits
1765 proc first_real_row {} {
1766     global nullid nullid2 numcommits
1767
1768     for {set row 0} {$row < $numcommits} {incr row} {
1769         set id [commitonrow $row]
1770         if {$id ne $nullid && $id ne $nullid2} {
1771             break
1772         }
1773     }
1774     return $row
1775 }
1776
1777 # update things for a head moved to a child of its previous location
1778 proc movehead {id name} {
1779     global headids idheads
1780
1781     removehead $headids($name) $name
1782     set headids($name) $id
1783     lappend idheads($id) $name
1784 }
1785
1786 # update things when a head has been removed
1787 proc removehead {id name} {
1788     global headids idheads
1789
1790     if {$idheads($id) eq $name} {
1791         unset idheads($id)
1792     } else {
1793         set i [lsearch -exact $idheads($id) $name]
1794         if {$i >= 0} {
1795             set idheads($id) [lreplace $idheads($id) $i $i]
1796         }
1797     }
1798     unset headids($name)
1799 }
1800
1801 proc ttk_toplevel {w args} {
1802     global use_ttk
1803     eval [linsert $args 0 ::toplevel $w]
1804     if {$use_ttk} {
1805         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1806     }
1807     return $w
1808 }
1809
1810 proc make_transient {window origin} {
1811     global have_tk85
1812
1813     # In MacOS Tk 8.4 transient appears to work by setting
1814     # overrideredirect, which is utterly useless, since the
1815     # windows get no border, and are not even kept above
1816     # the parent.
1817     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1818
1819     wm transient $window $origin
1820
1821     # Windows fails to place transient windows normally, so
1822     # schedule a callback to center them on the parent.
1823     if {[tk windowingsystem] eq {win32}} {
1824         after idle [list tk::PlaceWindow $window widget $origin]
1825     }
1826 }
1827
1828 proc show_error {w top msg {mc mc}} {
1829     global NS
1830     if {![info exists NS]} {set NS ""}
1831     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1832     message $w.m -text $msg -justify center -aspect 400
1833     pack $w.m -side top -fill x -padx 20 -pady 20
1834     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1835     pack $w.ok -side bottom -fill x
1836     bind $top <Visibility> "grab $top; focus $top"
1837     bind $top <Key-Return> "destroy $top"
1838     bind $top <Key-space>  "destroy $top"
1839     bind $top <Key-Escape> "destroy $top"
1840     tkwait window $top
1841 }
1842
1843 proc error_popup {msg {owner .}} {
1844     if {[tk windowingsystem] eq "win32"} {
1845         tk_messageBox -icon error -type ok -title [wm title .] \
1846             -parent $owner -message $msg
1847     } else {
1848         set w .error
1849         ttk_toplevel $w
1850         make_transient $w $owner
1851         show_error $w $w $msg
1852     }
1853 }
1854
1855 proc confirm_popup {msg {owner .}} {
1856     global confirm_ok NS
1857     set confirm_ok 0
1858     set w .confirm
1859     ttk_toplevel $w
1860     make_transient $w $owner
1861     message $w.m -text $msg -justify center -aspect 400
1862     pack $w.m -side top -fill x -padx 20 -pady 20
1863     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1864     pack $w.ok -side left -fill x
1865     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1866     pack $w.cancel -side right -fill x
1867     bind $w <Visibility> "grab $w; focus $w"
1868     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1869     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1870     bind $w <Key-Escape> "destroy $w"
1871     tk::PlaceWindow $w widget $owner
1872     tkwait window $w
1873     return $confirm_ok
1874 }
1875
1876 proc setoptions {} {
1877     if {[tk windowingsystem] ne "win32"} {
1878         option add *Panedwindow.showHandle 1 startupFile
1879         option add *Panedwindow.sashRelief raised startupFile
1880         if {[tk windowingsystem] ne "aqua"} {
1881             option add *Menu.font uifont startupFile
1882         }
1883     } else {
1884         option add *Menu.TearOff 0 startupFile
1885     }
1886     option add *Button.font uifont startupFile
1887     option add *Checkbutton.font uifont startupFile
1888     option add *Radiobutton.font uifont startupFile
1889     option add *Menubutton.font uifont startupFile
1890     option add *Label.font uifont startupFile
1891     option add *Message.font uifont startupFile
1892     option add *Entry.font textfont startupFile
1893     option add *Text.font textfont startupFile
1894     option add *Labelframe.font uifont startupFile
1895     option add *Spinbox.font textfont startupFile
1896     option add *Listbox.font mainfont startupFile
1897 }
1898
1899 # Make a menu and submenus.
1900 # m is the window name for the menu, items is the list of menu items to add.
1901 # Each item is a list {mc label type description options...}
1902 # mc is ignored; it's so we can put mc there to alert xgettext
1903 # label is the string that appears in the menu
1904 # type is cascade, command or radiobutton (should add checkbutton)
1905 # description depends on type; it's the sublist for cascade, the
1906 # command to invoke for command, or {variable value} for radiobutton
1907 proc makemenu {m items} {
1908     menu $m
1909     if {[tk windowingsystem] eq {aqua}} {
1910         set Meta1 Cmd
1911     } else {
1912         set Meta1 Ctrl
1913     }
1914     foreach i $items {
1915         set name [mc [lindex $i 1]]
1916         set type [lindex $i 2]
1917         set thing [lindex $i 3]
1918         set params [list $type]
1919         if {$name ne {}} {
1920             set u [string first "&" [string map {&& x} $name]]
1921             lappend params -label [string map {&& & & {}} $name]
1922             if {$u >= 0} {
1923                 lappend params -underline $u
1924             }
1925         }
1926         switch -- $type {
1927             "cascade" {
1928                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1929                 lappend params -menu $m.$submenu
1930             }
1931             "command" {
1932                 lappend params -command $thing
1933             }
1934             "radiobutton" {
1935                 lappend params -variable [lindex $thing 0] \
1936                     -value [lindex $thing 1]
1937             }
1938         }
1939         set tail [lrange $i 4 end]
1940         regsub -all {\yMeta1\y} $tail $Meta1 tail
1941         eval $m add $params $tail
1942         if {$type eq "cascade"} {
1943             makemenu $m.$submenu $thing
1944         }
1945     }
1946 }
1947
1948 # translate string and remove ampersands
1949 proc mca {str} {
1950     return [string map {&& & & {}} [mc $str]]
1951 }
1952
1953 proc makedroplist {w varname args} {
1954     global use_ttk
1955     if {$use_ttk} {
1956         set width 0
1957         foreach label $args {
1958             set cx [string length $label]
1959             if {$cx > $width} {set width $cx}
1960         }
1961         set gm [ttk::combobox $w -width $width -state readonly\
1962                     -textvariable $varname -values $args]
1963     } else {
1964         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
1965     }
1966     return $gm
1967 }
1968
1969 proc makewindow {} {
1970     global canv canv2 canv3 linespc charspc ctext cflist cscroll
1971     global tabstop
1972     global findtype findtypemenu findloc findstring fstring geometry
1973     global entries sha1entry sha1string sha1but
1974     global diffcontextstring diffcontext
1975     global ignorespace
1976     global maincursor textcursor curtextcursor
1977     global rowctxmenu fakerowmenu mergemax wrapcomment
1978     global highlight_files gdttype
1979     global searchstring sstring
1980     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1981     global headctxmenu progresscanv progressitem progresscoords statusw
1982     global fprogitem fprogcoord lastprogupdate progupdatepending
1983     global rprogitem rprogcoord rownumsel numcommits
1984     global have_tk85 use_ttk NS
1985     global git_version
1986     global worddiff
1987
1988     # The "mc" arguments here are purely so that xgettext
1989     # sees the following string as needing to be translated
1990     set file {
1991         mc "File" cascade {
1992             {mc "Update" command updatecommits -accelerator F5}
1993             {mc "Reload" command reloadcommits -accelerator Meta1-F5}
1994             {mc "Reread references" command rereadrefs}
1995             {mc "List references" command showrefs -accelerator F2}
1996             {xx "" separator}
1997             {mc "Start git gui" command {exec git gui &}}
1998             {xx "" separator}
1999             {mc "Quit" command doquit -accelerator Meta1-Q}
2000         }}
2001     set edit {
2002         mc "Edit" cascade {
2003             {mc "Preferences" command doprefs}
2004         }}
2005     set view {
2006         mc "View" cascade {
2007             {mc "New view..." command {newview 0} -accelerator Shift-F4}
2008             {mc "Edit view..." command editview -state disabled -accelerator F4}
2009             {mc "Delete view" command delview -state disabled}
2010             {xx "" separator}
2011             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2012         }}
2013     if {[tk windowingsystem] ne "aqua"} {
2014         set help {
2015         mc "Help" cascade {
2016             {mc "About gitk" command about}
2017             {mc "Key bindings" command keys}
2018         }}
2019         set bar [list $file $edit $view $help]
2020     } else {
2021         proc ::tk::mac::ShowPreferences {} {doprefs}
2022         proc ::tk::mac::Quit {} {doquit}
2023         lset file end [lreplace [lindex $file end] end-1 end]
2024         set apple {
2025         xx "Apple" cascade {
2026             {mc "About gitk" command about}
2027             {xx "" separator}
2028         }}
2029         set help {
2030         mc "Help" cascade {
2031             {mc "Key bindings" command keys}
2032         }}
2033         set bar [list $apple $file $view $help]
2034     }
2035     makemenu .bar $bar
2036     . configure -menu .bar
2037
2038     if {$use_ttk} {
2039         # cover the non-themed toplevel with a themed frame.
2040         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2041     }
2042
2043     # the gui has upper and lower half, parts of a paned window.
2044     ${NS}::panedwindow .ctop -orient vertical
2045
2046     # possibly use assumed geometry
2047     if {![info exists geometry(pwsash0)]} {
2048         set geometry(topheight) [expr {15 * $linespc}]
2049         set geometry(topwidth) [expr {80 * $charspc}]
2050         set geometry(botheight) [expr {15 * $linespc}]
2051         set geometry(botwidth) [expr {50 * $charspc}]
2052         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2053         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2054     }
2055
2056     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2057     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2058     ${NS}::frame .tf.histframe
2059     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2060     if {!$use_ttk} {
2061         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2062     }
2063
2064     # create three canvases
2065     set cscroll .tf.histframe.csb
2066     set canv .tf.histframe.pwclist.canv
2067     canvas $canv \
2068         -selectbackground $selectbgcolor \
2069         -background $bgcolor -bd 0 \
2070         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2071     .tf.histframe.pwclist add $canv
2072     set canv2 .tf.histframe.pwclist.canv2
2073     canvas $canv2 \
2074         -selectbackground $selectbgcolor \
2075         -background $bgcolor -bd 0 -yscrollincr $linespc
2076     .tf.histframe.pwclist add $canv2
2077     set canv3 .tf.histframe.pwclist.canv3
2078     canvas $canv3 \
2079         -selectbackground $selectbgcolor \
2080         -background $bgcolor -bd 0 -yscrollincr $linespc
2081     .tf.histframe.pwclist add $canv3
2082     if {$use_ttk} {
2083         bind .tf.histframe.pwclist <Map> {
2084             bind %W <Map> {}
2085             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2086             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2087         }
2088     } else {
2089         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2090         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2091     }
2092
2093     # a scroll bar to rule them
2094     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2095     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2096     pack $cscroll -side right -fill y
2097     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2098     lappend bglist $canv $canv2 $canv3
2099     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2100
2101     # we have two button bars at bottom of top frame. Bar 1
2102     ${NS}::frame .tf.bar
2103     ${NS}::frame .tf.lbar -height 15
2104
2105     set sha1entry .tf.bar.sha1
2106     set entries $sha1entry
2107     set sha1but .tf.bar.sha1label
2108     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2109         -command gotocommit -width 8
2110     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2111     pack .tf.bar.sha1label -side left
2112     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2113     trace add variable sha1string write sha1change
2114     pack $sha1entry -side left -pady 2
2115
2116     image create bitmap bm-left -data {
2117         #define left_width 16
2118         #define left_height 16
2119         static unsigned char left_bits[] = {
2120         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2121         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2122         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2123     }
2124     image create bitmap bm-right -data {
2125         #define right_width 16
2126         #define right_height 16
2127         static unsigned char right_bits[] = {
2128         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2129         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2130         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2131     }
2132     ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
2133         -state disabled -width 26
2134     pack .tf.bar.leftbut -side left -fill y
2135     ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
2136         -state disabled -width 26
2137     pack .tf.bar.rightbut -side left -fill y
2138
2139     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2140     set rownumsel {}
2141     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2142         -relief sunken -anchor e
2143     ${NS}::label .tf.bar.rowlabel2 -text "/"
2144     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2145         -relief sunken -anchor e
2146     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2147         -side left
2148     if {!$use_ttk} {
2149         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2150     }
2151     global selectedline
2152     trace add variable selectedline write selectedline_change
2153
2154     # Status label and progress bar
2155     set statusw .tf.bar.status
2156     ${NS}::label $statusw -width 15 -relief sunken
2157     pack $statusw -side left -padx 5
2158     if {$use_ttk} {
2159         set progresscanv [ttk::progressbar .tf.bar.progress]
2160     } else {
2161         set h [expr {[font metrics uifont -linespace] + 2}]
2162         set progresscanv .tf.bar.progress
2163         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2164         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2165         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2166         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2167     }
2168     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2169     set progresscoords {0 0}
2170     set fprogcoord 0
2171     set rprogcoord 0
2172     bind $progresscanv <Configure> adjustprogress
2173     set lastprogupdate [clock clicks -milliseconds]
2174     set progupdatepending 0
2175
2176     # build up the bottom bar of upper window
2177     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2178     ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2179     ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2180     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2181     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2182         -side left -fill y
2183     set gdttype [mc "containing:"]
2184     set gm [makedroplist .tf.lbar.gdttype gdttype \
2185                 [mc "containing:"] \
2186                 [mc "touching paths:"] \
2187                 [mc "adding/removing string:"]]
2188     trace add variable gdttype write gdttype_change
2189     pack .tf.lbar.gdttype -side left -fill y
2190
2191     set findstring {}
2192     set fstring .tf.lbar.findstring
2193     lappend entries $fstring
2194     ${NS}::entry $fstring -width 30 -textvariable findstring
2195     trace add variable findstring write find_change
2196     set findtype [mc "Exact"]
2197     set findtypemenu [makedroplist .tf.lbar.findtype \
2198                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2199     trace add variable findtype write findcom_change
2200     set findloc [mc "All fields"]
2201     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2202         [mc "Comments"] [mc "Author"] [mc "Committer"]
2203     trace add variable findloc write find_change
2204     pack .tf.lbar.findloc -side right
2205     pack .tf.lbar.findtype -side right
2206     pack $fstring -side left -expand 1 -fill x
2207
2208     # Finish putting the upper half of the viewer together
2209     pack .tf.lbar -in .tf -side bottom -fill x
2210     pack .tf.bar -in .tf -side bottom -fill x
2211     pack .tf.histframe -fill both -side top -expand 1
2212     .ctop add .tf
2213     if {!$use_ttk} {
2214         .ctop paneconfigure .tf -height $geometry(topheight)
2215         .ctop paneconfigure .tf -width $geometry(topwidth)
2216     }
2217
2218     # now build up the bottom
2219     ${NS}::panedwindow .pwbottom -orient horizontal
2220
2221     # lower left, a text box over search bar, scroll bar to the right
2222     # if we know window height, then that will set the lower text height, otherwise
2223     # we set lower text height which will drive window height
2224     if {[info exists geometry(main)]} {
2225         ${NS}::frame .bleft -width $geometry(botwidth)
2226     } else {
2227         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2228     }
2229     ${NS}::frame .bleft.top
2230     ${NS}::frame .bleft.mid
2231     ${NS}::frame .bleft.bottom
2232
2233     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2234     pack .bleft.top.search -side left -padx 5
2235     set sstring .bleft.top.sstring
2236     set searchstring ""
2237     ${NS}::entry $sstring -width 20 -textvariable searchstring
2238     lappend entries $sstring
2239     trace add variable searchstring write incrsearch
2240     pack $sstring -side left -expand 1 -fill x
2241     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2242         -command changediffdisp -variable diffelide -value {0 0}
2243     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2244         -command changediffdisp -variable diffelide -value {0 1}
2245     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2246         -command changediffdisp -variable diffelide -value {1 0}
2247     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2248     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2249     spinbox .bleft.mid.diffcontext -width 5 \
2250         -from 0 -increment 1 -to 10000000 \
2251         -validate all -validatecommand "diffcontextvalidate %P" \
2252         -textvariable diffcontextstring
2253     .bleft.mid.diffcontext set $diffcontext
2254     trace add variable diffcontextstring write diffcontextchange
2255     lappend entries .bleft.mid.diffcontext
2256     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2257     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2258         -command changeignorespace -variable ignorespace
2259     pack .bleft.mid.ignspace -side left -padx 5
2260
2261     set worddiff [mc "Line diff"]
2262     if {[package vcompare $git_version "1.7.2"] >= 0} {
2263         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2264             [mc "Markup words"] [mc "Color words"]
2265         trace add variable worddiff write changeworddiff
2266         pack .bleft.mid.worddiff -side left -padx 5
2267     }
2268
2269     set ctext .bleft.bottom.ctext
2270     text $ctext -background $bgcolor -foreground $fgcolor \
2271         -state disabled -font textfont \
2272         -yscrollcommand scrolltext -wrap none \
2273         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2274     if {$have_tk85} {
2275         $ctext conf -tabstyle wordprocessor
2276     }
2277     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2278     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2279     pack .bleft.top -side top -fill x
2280     pack .bleft.mid -side top -fill x
2281     grid $ctext .bleft.bottom.sb -sticky nsew
2282     grid .bleft.bottom.sbhorizontal -sticky ew
2283     grid columnconfigure .bleft.bottom 0 -weight 1
2284     grid rowconfigure .bleft.bottom 0 -weight 1
2285     grid rowconfigure .bleft.bottom 1 -weight 0
2286     pack .bleft.bottom -side top -fill both -expand 1
2287     lappend bglist $ctext
2288     lappend fglist $ctext
2289
2290     $ctext tag conf comment -wrap $wrapcomment
2291     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2292     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2293     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2294     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2295     $ctext tag conf m0 -fore red
2296     $ctext tag conf m1 -fore blue
2297     $ctext tag conf m2 -fore green
2298     $ctext tag conf m3 -fore purple
2299     $ctext tag conf m4 -fore brown
2300     $ctext tag conf m5 -fore "#009090"
2301     $ctext tag conf m6 -fore magenta
2302     $ctext tag conf m7 -fore "#808000"
2303     $ctext tag conf m8 -fore "#009000"
2304     $ctext tag conf m9 -fore "#ff0080"
2305     $ctext tag conf m10 -fore cyan
2306     $ctext tag conf m11 -fore "#b07070"
2307     $ctext tag conf m12 -fore "#70b0f0"
2308     $ctext tag conf m13 -fore "#70f0b0"
2309     $ctext tag conf m14 -fore "#f0b070"
2310     $ctext tag conf m15 -fore "#ff70b0"
2311     $ctext tag conf mmax -fore darkgrey
2312     set mergemax 16
2313     $ctext tag conf mresult -font textfontbold
2314     $ctext tag conf msep -font textfontbold
2315     $ctext tag conf found -back yellow
2316
2317     .pwbottom add .bleft
2318     if {!$use_ttk} {
2319         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2320     }
2321
2322     # lower right
2323     ${NS}::frame .bright
2324     ${NS}::frame .bright.mode
2325     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2326         -command reselectline -variable cmitmode -value "patch"
2327     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2328         -command reselectline -variable cmitmode -value "tree"
2329     grid .bright.mode.patch .bright.mode.tree -sticky ew
2330     pack .bright.mode -side top -fill x
2331     set cflist .bright.cfiles
2332     set indent [font measure mainfont "nn"]
2333     text $cflist \
2334         -selectbackground $selectbgcolor \
2335         -background $bgcolor -foreground $fgcolor \
2336         -font mainfont \
2337         -tabs [list $indent [expr {2 * $indent}]] \
2338         -yscrollcommand ".bright.sb set" \
2339         -cursor [. cget -cursor] \
2340         -spacing1 1 -spacing3 1
2341     lappend bglist $cflist
2342     lappend fglist $cflist
2343     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2344     pack .bright.sb -side right -fill y
2345     pack $cflist -side left -fill both -expand 1
2346     $cflist tag configure highlight \
2347         -background [$cflist cget -selectbackground]
2348     $cflist tag configure bold -font mainfontbold
2349
2350     .pwbottom add .bright
2351     .ctop add .pwbottom
2352
2353     # restore window width & height if known
2354     if {[info exists geometry(main)]} {
2355         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2356             if {$w > [winfo screenwidth .]} {
2357                 set w [winfo screenwidth .]
2358             }
2359             if {$h > [winfo screenheight .]} {
2360                 set h [winfo screenheight .]
2361             }
2362             wm geometry . "${w}x$h"
2363         }
2364     }
2365
2366     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2367         wm state . $geometry(state)
2368     }
2369
2370     if {[tk windowingsystem] eq {aqua}} {
2371         set M1B M1
2372         set ::BM "3"
2373     } else {
2374         set M1B Control
2375         set ::BM "2"
2376     }
2377
2378     if {$use_ttk} {
2379         bind .ctop <Map> {
2380             bind %W <Map> {}
2381             %W sashpos 0 $::geometry(topheight)
2382         }
2383         bind .pwbottom <Map> {
2384             bind %W <Map> {}
2385             %W sashpos 0 $::geometry(botwidth)
2386         }
2387     }
2388
2389     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2390     pack .ctop -fill both -expand 1
2391     bindall <1> {selcanvline %W %x %y}
2392     #bindall <B1-Motion> {selcanvline %W %x %y}
2393     if {[tk windowingsystem] == "win32"} {
2394         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2395         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2396     } else {
2397         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2398         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2399         if {[tk windowingsystem] eq "aqua"} {
2400             bindall <MouseWheel> {
2401                 set delta [expr {- (%D)}]
2402                 allcanvs yview scroll $delta units
2403             }
2404             bindall <Shift-MouseWheel> {
2405                 set delta [expr {- (%D)}]
2406                 $canv xview scroll $delta units
2407             }
2408         }
2409     }
2410     bindall <$::BM> "canvscan mark %W %x %y"
2411     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2412     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2413     bind . <$M1B-Key-w> doquit
2414     bindkey <Home> selfirstline
2415     bindkey <End> sellastline
2416     bind . <Key-Up> "selnextline -1"
2417     bind . <Key-Down> "selnextline 1"
2418     bind . <Shift-Key-Up> "dofind -1 0"
2419     bind . <Shift-Key-Down> "dofind 1 0"
2420     bindkey <Key-Right> "goforw"
2421     bindkey <Key-Left> "goback"
2422     bind . <Key-Prior> "selnextpage -1"
2423     bind . <Key-Next> "selnextpage 1"
2424     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2425     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2426     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2427     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2428     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2429     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2430     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2431     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2432     bindkey <Key-space> "$ctext yview scroll 1 pages"
2433     bindkey p "selnextline -1"
2434     bindkey n "selnextline 1"
2435     bindkey z "goback"
2436     bindkey x "goforw"
2437     bindkey i "selnextline -1"
2438     bindkey k "selnextline 1"
2439     bindkey j "goback"
2440     bindkey l "goforw"
2441     bindkey b prevfile
2442     bindkey d "$ctext yview scroll 18 units"
2443     bindkey u "$ctext yview scroll -18 units"
2444     bindkey / {focus $fstring}
2445     bindkey <Key-KP_Divide> {focus $fstring}
2446     bindkey <Key-Return> {dofind 1 1}
2447     bindkey ? {dofind -1 1}
2448     bindkey f nextfile
2449     bind . <F5> updatecommits
2450     bind . <$M1B-F5> reloadcommits
2451     bind . <F2> showrefs
2452     bind . <Shift-F4> {newview 0}
2453     catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2454     bind . <F4> edit_or_newview
2455     bind . <$M1B-q> doquit
2456     bind . <$M1B-f> {dofind 1 1}
2457     bind . <$M1B-g> {dofind 1 0}
2458     bind . <$M1B-r> dosearchback
2459     bind . <$M1B-s> dosearch
2460     bind . <$M1B-equal> {incrfont 1}
2461     bind . <$M1B-plus> {incrfont 1}
2462     bind . <$M1B-KP_Add> {incrfont 1}
2463     bind . <$M1B-minus> {incrfont -1}
2464     bind . <$M1B-KP_Subtract> {incrfont -1}
2465     wm protocol . WM_DELETE_WINDOW doquit
2466     bind . <Destroy> {stop_backends}
2467     bind . <Button-1> "click %W"
2468     bind $fstring <Key-Return> {dofind 1 1}
2469     bind $sha1entry <Key-Return> {gotocommit; break}
2470     bind $sha1entry <<PasteSelection>> clearsha1
2471     bind $cflist <1> {sel_flist %W %x %y; break}
2472     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2473     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2474     global ctxbut
2475     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2476     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2477     bind $ctext <Button-1> {focus %W}
2478
2479     set maincursor [. cget -cursor]
2480     set textcursor [$ctext cget -cursor]
2481     set curtextcursor $textcursor
2482
2483     set rowctxmenu .rowctxmenu
2484     makemenu $rowctxmenu {
2485         {mc "Diff this -> selected" command {diffvssel 0}}
2486         {mc "Diff selected -> this" command {diffvssel 1}}
2487         {mc "Make patch" command mkpatch}
2488         {mc "Create tag" command mktag}
2489         {mc "Write commit to file" command writecommit}
2490         {mc "Create new branch" command mkbranch}
2491         {mc "Cherry-pick this commit" command cherrypick}
2492         {mc "Reset HEAD branch to here" command resethead}
2493         {mc "Mark this commit" command markhere}
2494         {mc "Return to mark" command gotomark}
2495         {mc "Find descendant of this and mark" command find_common_desc}
2496         {mc "Compare with marked commit" command compare_commits}
2497     }
2498     $rowctxmenu configure -tearoff 0
2499
2500     set fakerowmenu .fakerowmenu
2501     makemenu $fakerowmenu {
2502         {mc "Diff this -> selected" command {diffvssel 0}}
2503         {mc "Diff selected -> this" command {diffvssel 1}}
2504         {mc "Make patch" command mkpatch}
2505     }
2506     $fakerowmenu configure -tearoff 0
2507
2508     set headctxmenu .headctxmenu
2509     makemenu $headctxmenu {
2510         {mc "Check out this branch" command cobranch}
2511         {mc "Remove this branch" command rmbranch}
2512     }
2513     $headctxmenu configure -tearoff 0
2514
2515     global flist_menu
2516     set flist_menu .flistctxmenu
2517     makemenu $flist_menu {
2518         {mc "Highlight this too" command {flist_hl 0}}
2519         {mc "Highlight this only" command {flist_hl 1}}
2520         {mc "External diff" command {external_diff}}
2521         {mc "Blame parent commit" command {external_blame 1}}
2522     }
2523     $flist_menu configure -tearoff 0
2524
2525     global diff_menu
2526     set diff_menu .diffctxmenu
2527     makemenu $diff_menu {
2528         {mc "Show origin of this line" command show_line_source}
2529         {mc "Run git gui blame on this line" command {external_blame_diff}}
2530     }
2531     $diff_menu configure -tearoff 0
2532 }
2533
2534 # Windows sends all mouse wheel events to the current focused window, not
2535 # the one where the mouse hovers, so bind those events here and redirect
2536 # to the correct window
2537 proc windows_mousewheel_redirector {W X Y D} {
2538     global canv canv2 canv3
2539     set w [winfo containing -displayof $W $X $Y]
2540     if {$w ne ""} {
2541         set u [expr {$D < 0 ? 5 : -5}]
2542         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2543             allcanvs yview scroll $u units
2544         } else {
2545             catch {
2546                 $w yview scroll $u units
2547             }
2548         }
2549     }
2550 }
2551
2552 # Update row number label when selectedline changes
2553 proc selectedline_change {n1 n2 op} {
2554     global selectedline rownumsel
2555
2556     if {$selectedline eq {}} {
2557         set rownumsel {}
2558     } else {
2559         set rownumsel [expr {$selectedline + 1}]
2560     }
2561 }
2562
2563 # mouse-2 makes all windows scan vertically, but only the one
2564 # the cursor is in scans horizontally
2565 proc canvscan {op w x y} {
2566     global canv canv2 canv3
2567     foreach c [list $canv $canv2 $canv3] {
2568         if {$c == $w} {
2569             $c scan $op $x $y
2570         } else {
2571             $c scan $op 0 $y
2572         }
2573     }
2574 }
2575
2576 proc scrollcanv {cscroll f0 f1} {
2577     $cscroll set $f0 $f1
2578     drawvisible
2579     flushhighlights
2580 }
2581
2582 # when we make a key binding for the toplevel, make sure
2583 # it doesn't get triggered when that key is pressed in the
2584 # find string entry widget.
2585 proc bindkey {ev script} {
2586     global entries
2587     bind . $ev $script
2588     set escript [bind Entry $ev]
2589     if {$escript == {}} {
2590         set escript [bind Entry <Key>]
2591     }
2592     foreach e $entries {
2593         bind $e $ev "$escript; break"
2594     }
2595 }
2596
2597 # set the focus back to the toplevel for any click outside
2598 # the entry widgets
2599 proc click {w} {
2600     global ctext entries
2601     foreach e [concat $entries $ctext] {
2602         if {$w == $e} return
2603     }
2604     focus .
2605 }
2606
2607 # Adjust the progress bar for a change in requested extent or canvas size
2608 proc adjustprogress {} {
2609     global progresscanv progressitem progresscoords
2610     global fprogitem fprogcoord lastprogupdate progupdatepending
2611     global rprogitem rprogcoord use_ttk
2612
2613     if {$use_ttk} {
2614         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2615         return
2616     }
2617
2618     set w [expr {[winfo width $progresscanv] - 4}]
2619     set x0 [expr {$w * [lindex $progresscoords 0]}]
2620     set x1 [expr {$w * [lindex $progresscoords 1]}]
2621     set h [winfo height $progresscanv]
2622     $progresscanv coords $progressitem $x0 0 $x1 $h
2623     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2624     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2625     set now [clock clicks -milliseconds]
2626     if {$now >= $lastprogupdate + 100} {
2627         set progupdatepending 0
2628         update
2629     } elseif {!$progupdatepending} {
2630         set progupdatepending 1
2631         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2632     }
2633 }
2634
2635 proc doprogupdate {} {
2636     global lastprogupdate progupdatepending
2637
2638     if {$progupdatepending} {
2639         set progupdatepending 0
2640         set lastprogupdate [clock clicks -milliseconds]
2641         update
2642     }
2643 }
2644
2645 proc savestuff {w} {
2646     global canv canv2 canv3 mainfont textfont uifont tabstop
2647     global stuffsaved findmergefiles maxgraphpct
2648     global maxwidth showneartags showlocalchanges
2649     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2650     global cmitmode wrapcomment datetimeformat limitdiffs
2651     global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2652     global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2653     global hideremotes want_ttk
2654
2655     if {$stuffsaved} return
2656     if {![winfo viewable .]} return
2657     catch {
2658         if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2659         set f [open "~/.gitk-new" w]
2660         if {$::tcl_platform(platform) eq {windows}} {
2661             file attributes "~/.gitk-new" -hidden true
2662         }
2663         puts $f [list set mainfont $mainfont]
2664         puts $f [list set textfont $textfont]
2665         puts $f [list set uifont $uifont]
2666         puts $f [list set tabstop $tabstop]
2667         puts $f [list set findmergefiles $findmergefiles]
2668         puts $f [list set maxgraphpct $maxgraphpct]
2669         puts $f [list set maxwidth $maxwidth]
2670         puts $f [list set cmitmode $cmitmode]
2671         puts $f [list set wrapcomment $wrapcomment]
2672         puts $f [list set autoselect $autoselect]
2673         puts $f [list set autosellen $autosellen]
2674         puts $f [list set showneartags $showneartags]
2675         puts $f [list set hideremotes $hideremotes]
2676         puts $f [list set showlocalchanges $showlocalchanges]
2677         puts $f [list set datetimeformat $datetimeformat]
2678         puts $f [list set limitdiffs $limitdiffs]
2679         puts $f [list set uicolor $uicolor]
2680         puts $f [list set want_ttk $want_ttk]
2681         puts $f [list set bgcolor $bgcolor]
2682         puts $f [list set fgcolor $fgcolor]
2683         puts $f [list set colors $colors]
2684         puts $f [list set diffcolors $diffcolors]
2685         puts $f [list set markbgcolor $markbgcolor]
2686         puts $f [list set diffcontext $diffcontext]
2687         puts $f [list set selectbgcolor $selectbgcolor]
2688         puts $f [list set extdifftool $extdifftool]
2689         puts $f [list set perfile_attrs $perfile_attrs]
2690
2691         puts $f "set geometry(main) [wm geometry .]"
2692         puts $f "set geometry(state) [wm state .]"
2693         puts $f "set geometry(topwidth) [winfo width .tf]"
2694         puts $f "set geometry(topheight) [winfo height .tf]"
2695         if {$use_ttk} {
2696             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2697             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2698         } else {
2699             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2700             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2701         }
2702         puts $f "set geometry(botwidth) [winfo width .bleft]"
2703         puts $f "set geometry(botheight) [winfo height .bleft]"
2704
2705         puts -nonewline $f "set permviews {"
2706         for {set v 0} {$v < $nextviewnum} {incr v} {
2707             if {$viewperm($v)} {
2708                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2709             }
2710         }
2711         puts $f "}"
2712         close $f
2713         file rename -force "~/.gitk-new" "~/.gitk"
2714     }
2715     set stuffsaved 1
2716 }
2717
2718 proc resizeclistpanes {win w} {
2719     global oldwidth use_ttk
2720     if {[info exists oldwidth($win)]} {
2721         if {$use_ttk} {
2722             set s0 [$win sashpos 0]
2723             set s1 [$win sashpos 1]
2724         } else {
2725             set s0 [$win sash coord 0]
2726             set s1 [$win sash coord 1]
2727         }
2728         if {$w < 60} {
2729             set sash0 [expr {int($w/2 - 2)}]
2730             set sash1 [expr {int($w*5/6 - 2)}]
2731         } else {
2732             set factor [expr {1.0 * $w / $oldwidth($win)}]
2733             set sash0 [expr {int($factor * [lindex $s0 0])}]
2734             set sash1 [expr {int($factor * [lindex $s1 0])}]
2735             if {$sash0 < 30} {
2736                 set sash0 30
2737             }
2738             if {$sash1 < $sash0 + 20} {
2739                 set sash1 [expr {$sash0 + 20}]
2740             }
2741             if {$sash1 > $w - 10} {
2742                 set sash1 [expr {$w - 10}]
2743                 if {$sash0 > $sash1 - 20} {
2744                     set sash0 [expr {$sash1 - 20}]
2745                 }
2746             }
2747         }
2748         if {$use_ttk} {
2749             $win sashpos 0 $sash0
2750             $win sashpos 1 $sash1
2751         } else {
2752             $win sash place 0 $sash0 [lindex $s0 1]
2753             $win sash place 1 $sash1 [lindex $s1 1]
2754         }
2755     }
2756     set oldwidth($win) $w
2757 }
2758
2759 proc resizecdetpanes {win w} {
2760     global oldwidth use_ttk
2761     if {[info exists oldwidth($win)]} {
2762         if {$use_ttk} {
2763             set s0 [$win sashpos 0]
2764         } else {
2765             set s0 [$win sash coord 0]
2766         }
2767         if {$w < 60} {
2768             set sash0 [expr {int($w*3/4 - 2)}]
2769         } else {
2770             set factor [expr {1.0 * $w / $oldwidth($win)}]
2771             set sash0 [expr {int($factor * [lindex $s0 0])}]
2772             if {$sash0 < 45} {
2773                 set sash0 45
2774             }
2775             if {$sash0 > $w - 15} {
2776                 set sash0 [expr {$w - 15}]
2777             }
2778         }
2779         if {$use_ttk} {
2780             $win sashpos 0 $sash0
2781         } else {
2782             $win sash place 0 $sash0 [lindex $s0 1]
2783         }
2784     }
2785     set oldwidth($win) $w
2786 }
2787
2788 proc allcanvs args {
2789     global canv canv2 canv3
2790     eval $canv $args
2791     eval $canv2 $args
2792     eval $canv3 $args
2793 }
2794
2795 proc bindall {event action} {
2796     global canv canv2 canv3
2797     bind $canv $event $action
2798     bind $canv2 $event $action
2799     bind $canv3 $event $action
2800 }
2801
2802 proc about {} {
2803     global uifont NS
2804     set w .about
2805     if {[winfo exists $w]} {
2806         raise $w
2807         return
2808     }
2809     ttk_toplevel $w
2810     wm title $w [mc "About gitk"]
2811     make_transient $w .
2812     message $w.m -text [mc "
2813 Gitk - a commit viewer for git
2814
2815 Copyright \u00a9 2005-2010 Paul Mackerras
2816
2817 Use and redistribute under the terms of the GNU General Public License"] \
2818             -justify center -aspect 400 -border 2 -bg white -relief groove
2819     pack $w.m -side top -fill x -padx 2 -pady 2
2820     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2821     pack $w.ok -side bottom
2822     bind $w <Visibility> "focus $w.ok"
2823     bind $w <Key-Escape> "destroy $w"
2824     bind $w <Key-Return> "destroy $w"
2825     tk::PlaceWindow $w widget .
2826 }
2827
2828 proc keys {} {
2829     global NS
2830     set w .keys
2831     if {[winfo exists $w]} {
2832         raise $w
2833         return
2834     }
2835     if {[tk windowingsystem] eq {aqua}} {
2836         set M1T Cmd
2837     } else {
2838         set M1T Ctrl
2839     }
2840     ttk_toplevel $w
2841     wm title $w [mc "Gitk key bindings"]
2842     make_transient $w .
2843     message $w.m -text "
2844 [mc "Gitk key bindings:"]
2845
2846 [mc "<%s-Q>             Quit" $M1T]
2847 [mc "<%s-W>             Close window" $M1T]
2848 [mc "<Home>             Move to first commit"]
2849 [mc "<End>              Move to last commit"]
2850 [mc "<Up>, p, i Move up one commit"]
2851 [mc "<Down>, n, k       Move down one commit"]
2852 [mc "<Left>, z, j       Go back in history list"]
2853 [mc "<Right>, x, l      Go forward in history list"]
2854 [mc "<PageUp>   Move up one page in commit list"]
2855 [mc "<PageDown> Move down one page in commit list"]
2856 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2857 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2858 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2859 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2860 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2861 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2862 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2863 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2864 [mc "<Delete>, b        Scroll diff view up one page"]
2865 [mc "<Backspace>        Scroll diff view up one page"]
2866 [mc "<Space>            Scroll diff view down one page"]
2867 [mc "u          Scroll diff view up 18 lines"]
2868 [mc "d          Scroll diff view down 18 lines"]
2869 [mc "<%s-F>             Find" $M1T]
2870 [mc "<%s-G>             Move to next find hit" $M1T]
2871 [mc "<Return>   Move to next find hit"]
2872 [mc "/          Focus the search box"]
2873 [mc "?          Move to previous find hit"]
2874 [mc "f          Scroll diff view to next file"]
2875 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2876 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2877 [mc "<%s-KP+>   Increase font size" $M1T]
2878 [mc "<%s-plus>  Increase font size" $M1T]
2879 [mc "<%s-KP->   Decrease font size" $M1T]
2880 [mc "<%s-minus> Decrease font size" $M1T]
2881 [mc "<F5>               Update"]
2882 " \
2883             -justify left -bg white -border 2 -relief groove
2884     pack $w.m -side top -fill both -padx 2 -pady 2
2885     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2886     bind $w <Key-Escape> [list destroy $w]
2887     pack $w.ok -side bottom
2888     bind $w <Visibility> "focus $w.ok"
2889     bind $w <Key-Escape> "destroy $w"
2890     bind $w <Key-Return> "destroy $w"
2891 }
2892
2893 # Procedures for manipulating the file list window at the
2894 # bottom right of the overall window.
2895
2896 proc treeview {w l openlevs} {
2897     global treecontents treediropen treeheight treeparent treeindex
2898
2899     set ix 0
2900     set treeindex() 0
2901     set lev 0
2902     set prefix {}
2903     set prefixend -1
2904     set prefendstack {}
2905     set htstack {}
2906     set ht 0
2907     set treecontents() {}
2908     $w conf -state normal
2909     foreach f $l {
2910         while {[string range $f 0 $prefixend] ne $prefix} {
2911             if {$lev <= $openlevs} {
2912                 $w mark set e:$treeindex($prefix) "end -1c"
2913                 $w mark gravity e:$treeindex($prefix) left
2914             }
2915             set treeheight($prefix) $ht
2916             incr ht [lindex $htstack end]
2917             set htstack [lreplace $htstack end end]
2918             set prefixend [lindex $prefendstack end]
2919             set prefendstack [lreplace $prefendstack end end]
2920             set prefix [string range $prefix 0 $prefixend]
2921             incr lev -1
2922         }
2923         set tail [string range $f [expr {$prefixend+1}] end]
2924         while {[set slash [string first "/" $tail]] >= 0} {
2925             lappend htstack $ht
2926             set ht 0
2927             lappend prefendstack $prefixend
2928             incr prefixend [expr {$slash + 1}]
2929             set d [string range $tail 0 $slash]
2930             lappend treecontents($prefix) $d
2931             set oldprefix $prefix
2932             append prefix $d
2933             set treecontents($prefix) {}
2934             set treeindex($prefix) [incr ix]
2935             set treeparent($prefix) $oldprefix
2936             set tail [string range $tail [expr {$slash+1}] end]
2937             if {$lev <= $openlevs} {
2938                 set ht 1
2939                 set treediropen($prefix) [expr {$lev < $openlevs}]
2940                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2941                 $w mark set d:$ix "end -1c"
2942                 $w mark gravity d:$ix left
2943                 set str "\n"
2944                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2945                 $w insert end $str
2946                 $w image create end -align center -image $bm -padx 1 \
2947                     -name a:$ix
2948                 $w insert end $d [highlight_tag $prefix]
2949                 $w mark set s:$ix "end -1c"
2950                 $w mark gravity s:$ix left
2951             }
2952             incr lev
2953         }
2954         if {$tail ne {}} {
2955             if {$lev <= $openlevs} {
2956                 incr ht
2957                 set str "\n"
2958                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2959                 $w insert end $str
2960                 $w insert end $tail [highlight_tag $f]
2961             }
2962             lappend treecontents($prefix) $tail
2963         }
2964     }
2965     while {$htstack ne {}} {
2966         set treeheight($prefix) $ht
2967         incr ht [lindex $htstack end]
2968         set htstack [lreplace $htstack end end]
2969         set prefixend [lindex $prefendstack end]
2970         set prefendstack [lreplace $prefendstack end end]
2971         set prefix [string range $prefix 0 $prefixend]
2972     }
2973     $w conf -state disabled
2974 }
2975
2976 proc linetoelt {l} {
2977     global treeheight treecontents
2978
2979     set y 2
2980     set prefix {}
2981     while {1} {
2982         foreach e $treecontents($prefix) {
2983             if {$y == $l} {
2984                 return "$prefix$e"
2985             }
2986             set n 1
2987             if {[string index $e end] eq "/"} {
2988                 set n $treeheight($prefix$e)
2989                 if {$y + $n > $l} {
2990                     append prefix $e
2991                     incr y
2992                     break
2993                 }
2994             }
2995             incr y $n
2996         }
2997     }
2998 }
2999
3000 proc highlight_tree {y prefix} {
3001     global treeheight treecontents cflist
3002
3003     foreach e $treecontents($prefix) {
3004         set path $prefix$e
3005         if {[highlight_tag $path] ne {}} {
3006             $cflist tag add bold $y.0 "$y.0 lineend"
3007         }
3008         incr y
3009         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3010             set y [highlight_tree $y $path]
3011         }
3012     }
3013     return $y
3014 }
3015
3016 proc treeclosedir {w dir} {
3017     global treediropen treeheight treeparent treeindex
3018
3019     set ix $treeindex($dir)
3020     $w conf -state normal
3021     $w delete s:$ix e:$ix
3022     set treediropen($dir) 0
3023     $w image configure a:$ix -image tri-rt
3024     $w conf -state disabled
3025     set n [expr {1 - $treeheight($dir)}]
3026     while {$dir ne {}} {
3027         incr treeheight($dir) $n
3028         set dir $treeparent($dir)
3029     }
3030 }
3031
3032 proc treeopendir {w dir} {
3033     global treediropen treeheight treeparent treecontents treeindex
3034
3035     set ix $treeindex($dir)
3036     $w conf -state normal
3037     $w image configure a:$ix -image tri-dn
3038     $w mark set e:$ix s:$ix
3039     $w mark gravity e:$ix right
3040     set lev 0
3041     set str "\n"
3042     set n [llength $treecontents($dir)]
3043     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3044         incr lev
3045         append str "\t"
3046         incr treeheight($x) $n
3047     }
3048     foreach e $treecontents($dir) {
3049         set de $dir$e
3050         if {[string index $e end] eq "/"} {
3051             set iy $treeindex($de)
3052             $w mark set d:$iy e:$ix
3053             $w mark gravity d:$iy left
3054             $w insert e:$ix $str
3055             set treediropen($de) 0
3056             $w image create e:$ix -align center -image tri-rt -padx 1 \
3057                 -name a:$iy
3058             $w insert e:$ix $e [highlight_tag $de]
3059             $w mark set s:$iy e:$ix
3060             $w mark gravity s:$iy left
3061             set treeheight($de) 1
3062         } else {
3063             $w insert e:$ix $str
3064             $w insert e:$ix $e [highlight_tag $de]
3065         }
3066     }
3067     $w mark gravity e:$ix right
3068     $w conf -state disabled
3069     set treediropen($dir) 1
3070     set top [lindex [split [$w index @0,0] .] 0]
3071     set ht [$w cget -height]
3072     set l [lindex [split [$w index s:$ix] .] 0]
3073     if {$l < $top} {
3074         $w yview $l.0
3075     } elseif {$l + $n + 1 > $top + $ht} {
3076         set top [expr {$l + $n + 2 - $ht}]
3077         if {$l < $top} {
3078             set top $l
3079         }
3080         $w yview $top.0
3081     }
3082 }
3083
3084 proc treeclick {w x y} {
3085     global treediropen cmitmode ctext cflist cflist_top
3086
3087     if {$cmitmode ne "tree"} return
3088     if {![info exists cflist_top]} return
3089     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3090     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3091     $cflist tag add highlight $l.0 "$l.0 lineend"
3092     set cflist_top $l
3093     if {$l == 1} {
3094         $ctext yview 1.0
3095         return
3096     }
3097     set e [linetoelt $l]
3098     if {[string index $e end] ne "/"} {
3099         showfile $e
3100     } elseif {$treediropen($e)} {
3101         treeclosedir $w $e
3102     } else {
3103         treeopendir $w $e
3104     }
3105 }
3106
3107 proc setfilelist {id} {
3108     global treefilelist cflist jump_to_here
3109
3110     treeview $cflist $treefilelist($id) 0
3111     if {$jump_to_here ne {}} {
3112         set f [lindex $jump_to_here 0]
3113         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3114             showfile $f
3115         }
3116     }
3117 }
3118
3119 image create bitmap tri-rt -background black -foreground blue -data {
3120     #define tri-rt_width 13
3121     #define tri-rt_height 13
3122     static unsigned char tri-rt_bits[] = {
3123        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3124        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3125        0x00, 0x00};
3126 } -maskdata {
3127     #define tri-rt-mask_width 13
3128     #define tri-rt-mask_height 13
3129     static unsigned char tri-rt-mask_bits[] = {
3130        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3131        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3132        0x08, 0x00};
3133 }
3134 image create bitmap tri-dn -background black -foreground blue -data {
3135     #define tri-dn_width 13
3136     #define tri-dn_height 13
3137     static unsigned char tri-dn_bits[] = {
3138        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3139        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3140        0x00, 0x00};
3141 } -maskdata {
3142     #define tri-dn-mask_width 13
3143     #define tri-dn-mask_height 13
3144     static unsigned char tri-dn-mask_bits[] = {
3145        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3146        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3147        0x00, 0x00};
3148 }
3149
3150 image create bitmap reficon-T -background black -foreground yellow -data {
3151     #define tagicon_width 13
3152     #define tagicon_height 9
3153     static unsigned char tagicon_bits[] = {
3154        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3155        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3156 } -maskdata {
3157     #define tagicon-mask_width 13
3158     #define tagicon-mask_height 9
3159     static unsigned char tagicon-mask_bits[] = {
3160        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3161        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3162 }
3163 set rectdata {
3164     #define headicon_width 13
3165     #define headicon_height 9
3166     static unsigned char headicon_bits[] = {
3167        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3168        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3169 }
3170 set rectmask {
3171     #define headicon-mask_width 13
3172     #define headicon-mask_height 9
3173     static unsigned char headicon-mask_bits[] = {
3174        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3175        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3176 }
3177 image create bitmap reficon-H -background black -foreground green \
3178     -data $rectdata -maskdata $rectmask
3179 image create bitmap reficon-o -background black -foreground "#ddddff" \
3180     -data $rectdata -maskdata $rectmask
3181
3182 proc init_flist {first} {
3183     global cflist cflist_top difffilestart
3184
3185     $cflist conf -state normal
3186     $cflist delete 0.0 end
3187     if {$first ne {}} {
3188         $cflist insert end $first
3189         set cflist_top 1
3190         $cflist tag add highlight 1.0 "1.0 lineend"
3191     } else {
3192         catch {unset cflist_top}
3193     }
3194     $cflist conf -state disabled
3195     set difffilestart {}
3196 }
3197
3198 proc highlight_tag {f} {
3199     global highlight_paths
3200
3201     foreach p $highlight_paths {
3202         if {[string match $p $f]} {
3203             return "bold"
3204         }
3205     }
3206     return {}
3207 }
3208
3209 proc highlight_filelist {} {
3210     global cmitmode cflist
3211
3212     $cflist conf -state normal
3213     if {$cmitmode ne "tree"} {
3214         set end [lindex [split [$cflist index end] .] 0]
3215         for {set l 2} {$l < $end} {incr l} {
3216             set line [$cflist get $l.0 "$l.0 lineend"]
3217             if {[highlight_tag $line] ne {}} {
3218                 $cflist tag add bold $l.0 "$l.0 lineend"
3219             }
3220         }
3221     } else {
3222         highlight_tree 2 {}
3223     }
3224     $cflist conf -state disabled
3225 }
3226
3227 proc unhighlight_filelist {} {
3228     global cflist
3229
3230     $cflist conf -state normal
3231     $cflist tag remove bold 1.0 end
3232     $cflist conf -state disabled
3233 }
3234
3235 proc add_flist {fl} {
3236     global cflist
3237
3238     $cflist conf -state normal
3239     foreach f $fl {
3240         $cflist insert end "\n"
3241         $cflist insert end $f [highlight_tag $f]
3242     }
3243     $cflist conf -state disabled
3244 }
3245
3246 proc sel_flist {w x y} {
3247     global ctext difffilestart cflist cflist_top cmitmode
3248
3249     if {$cmitmode eq "tree"} return
3250     if {![info exists cflist_top]} return
3251     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3252     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3253     $cflist tag add highlight $l.0 "$l.0 lineend"
3254     set cflist_top $l
3255     if {$l == 1} {
3256         $ctext yview 1.0
3257     } else {
3258         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3259     }
3260 }
3261
3262 proc pop_flist_menu {w X Y x y} {
3263     global ctext cflist cmitmode flist_menu flist_menu_file
3264     global treediffs diffids
3265
3266     stopfinding
3267     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3268     if {$l <= 1} return
3269     if {$cmitmode eq "tree"} {
3270         set e [linetoelt $l]
3271         if {[string index $e end] eq "/"} return
3272     } else {
3273         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3274     }
3275     set flist_menu_file $e
3276     set xdiffstate "normal"
3277     if {$cmitmode eq "tree"} {
3278         set xdiffstate "disabled"
3279     }
3280     # Disable "External diff" item in tree mode
3281     $flist_menu entryconf 2 -state $xdiffstate
3282     tk_popup $flist_menu $X $Y
3283 }
3284
3285 proc find_ctext_fileinfo {line} {
3286     global ctext_file_names ctext_file_lines
3287
3288     set ok [bsearch $ctext_file_lines $line]
3289     set tline [lindex $ctext_file_lines $ok]
3290
3291     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3292         return {}
3293     } else {
3294         return [list [lindex $ctext_file_names $ok] $tline]
3295     }
3296 }
3297
3298 proc pop_diff_menu {w X Y x y} {
3299     global ctext diff_menu flist_menu_file
3300     global diff_menu_txtpos diff_menu_line
3301     global diff_menu_filebase
3302
3303     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3304     set diff_menu_line [lindex $diff_menu_txtpos 0]
3305     # don't pop up the menu on hunk-separator or file-separator lines
3306     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3307         return
3308     }
3309     stopfinding
3310     set f [find_ctext_fileinfo $diff_menu_line]
3311     if {$f eq {}} return
3312     set flist_menu_file [lindex $f 0]
3313     set diff_menu_filebase [lindex $f 1]
3314     tk_popup $diff_menu $X $Y
3315 }
3316
3317 proc flist_hl {only} {
3318     global flist_menu_file findstring gdttype
3319
3320     set x [shellquote $flist_menu_file]
3321     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3322         set findstring $x
3323     } else {
3324         append findstring " " $x
3325     }
3326     set gdttype [mc "touching paths:"]
3327 }
3328
3329 proc gitknewtmpdir {} {
3330     global diffnum gitktmpdir gitdir
3331
3332     if {![info exists gitktmpdir]} {
3333         set gitktmpdir [file join [file dirname $gitdir] \
3334                             [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 gitdir
3367
3368     if {$diffid == $nullid} {
3369         set difffile [file join [file dirname $gitdir] $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 gitdir
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 [file dirname $gitdir] $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
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 [file dirname $gitdir] $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
4530     if {$gdttype eq [mc "touching paths:"]} {
4531         if {[catch {set paths [shellsplit $highlight_files]}]} return
4532         set highlight_paths [makepatterns $paths]
4533         highlight_filelist
4534         set gdtargs [concat -- $paths]
4535     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4536         set gdtargs [list "-S$highlight_files"]
4537     } else {
4538         # must be "containing:", i.e. we're searching commit info
4539         return
4540     }
4541     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4542     set filehighlight [open $cmd r+]
4543     fconfigure $filehighlight -blocking 0
4544     filerun $filehighlight readfhighlight
4545     set fhl_list {}
4546     drawvisible
4547     flushhighlights
4548 }
4549
4550 proc flushhighlights {} {
4551     global filehighlight fhl_list
4552
4553     if {[info exists filehighlight]} {
4554         lappend fhl_list {}
4555         puts $filehighlight ""
4556         flush $filehighlight
4557     }
4558 }
4559
4560 proc askfilehighlight {row id} {
4561     global filehighlight fhighlights fhl_list
4562
4563     lappend fhl_list $id
4564     set fhighlights($id) -1
4565     puts $filehighlight $id
4566 }
4567
4568 proc readfhighlight {} {
4569     global filehighlight fhighlights curview iddrawn
4570     global fhl_list find_dirn
4571
4572     if {![info exists filehighlight]} {
4573         return 0
4574     }
4575     set nr 0
4576     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4577         set line [string trim $line]
4578         set i [lsearch -exact $fhl_list $line]
4579         if {$i < 0} continue
4580         for {set j 0} {$j < $i} {incr j} {
4581             set id [lindex $fhl_list $j]
4582             set fhighlights($id) 0
4583         }
4584         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4585         if {$line eq {}} continue
4586         if {![commitinview $line $curview]} continue
4587         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4588             bolden $line mainfontbold
4589         }
4590         set fhighlights($line) 1
4591     }
4592     if {[eof $filehighlight]} {
4593         # strange...
4594         puts "oops, git diff-tree died"
4595         catch {close $filehighlight}
4596         unset filehighlight
4597         return 0
4598     }
4599     if {[info exists find_dirn]} {
4600         run findmore
4601     }
4602     return 1
4603 }
4604
4605 proc doesmatch {f} {
4606     global findtype findpattern
4607
4608     if {$findtype eq [mc "Regexp"]} {
4609         return [regexp $findpattern $f]
4610     } elseif {$findtype eq [mc "IgnCase"]} {
4611         return [string match -nocase $findpattern $f]
4612     } else {
4613         return [string match $findpattern $f]
4614     }
4615 }
4616
4617 proc askfindhighlight {row id} {
4618     global nhighlights commitinfo iddrawn
4619     global findloc
4620     global markingmatches
4621
4622     if {![info exists commitinfo($id)]} {
4623         getcommit $id
4624     }
4625     set info $commitinfo($id)
4626     set isbold 0
4627     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4628     foreach f $info ty $fldtypes {
4629         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4630             [doesmatch $f]} {
4631             if {$ty eq [mc "Author"]} {
4632                 set isbold 2
4633                 break
4634             }
4635             set isbold 1
4636         }
4637     }
4638     if {$isbold && [info exists iddrawn($id)]} {
4639         if {![ishighlighted $id]} {
4640             bolden $id mainfontbold
4641             if {$isbold > 1} {
4642                 bolden_name $id mainfontbold
4643             }
4644         }
4645         if {$markingmatches} {
4646             markrowmatches $row $id
4647         }
4648     }
4649     set nhighlights($id) $isbold
4650 }
4651
4652 proc markrowmatches {row id} {
4653     global canv canv2 linehtag linentag commitinfo findloc
4654
4655     set headline [lindex $commitinfo($id) 0]
4656     set author [lindex $commitinfo($id) 1]
4657     $canv delete match$row
4658     $canv2 delete match$row
4659     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4660         set m [findmatches $headline]
4661         if {$m ne {}} {
4662             markmatches $canv $row $headline $linehtag($id) $m \
4663                 [$canv itemcget $linehtag($id) -font] $row
4664         }
4665     }
4666     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4667         set m [findmatches $author]
4668         if {$m ne {}} {
4669             markmatches $canv2 $row $author $linentag($id) $m \
4670                 [$canv2 itemcget $linentag($id) -font] $row
4671         }
4672     }
4673 }
4674
4675 proc vrel_change {name ix op} {
4676     global highlight_related
4677
4678     rhighlight_none
4679     if {$highlight_related ne [mc "None"]} {
4680         run drawvisible
4681     }
4682 }
4683
4684 # prepare for testing whether commits are descendents or ancestors of a
4685 proc rhighlight_sel {a} {
4686     global descendent desc_todo ancestor anc_todo
4687     global highlight_related
4688
4689     catch {unset descendent}
4690     set desc_todo [list $a]
4691     catch {unset ancestor}
4692     set anc_todo [list $a]
4693     if {$highlight_related ne [mc "None"]} {
4694         rhighlight_none
4695         run drawvisible
4696     }
4697 }
4698
4699 proc rhighlight_none {} {
4700     global rhighlights
4701
4702     catch {unset rhighlights}
4703     unbolden
4704 }
4705
4706 proc is_descendent {a} {
4707     global curview children descendent desc_todo
4708
4709     set v $curview
4710     set la [rowofcommit $a]
4711     set todo $desc_todo
4712     set leftover {}
4713     set done 0
4714     for {set i 0} {$i < [llength $todo]} {incr i} {
4715         set do [lindex $todo $i]
4716         if {[rowofcommit $do] < $la} {
4717             lappend leftover $do
4718             continue
4719         }
4720         foreach nk $children($v,$do) {
4721             if {![info exists descendent($nk)]} {
4722                 set descendent($nk) 1
4723                 lappend todo $nk
4724                 if {$nk eq $a} {
4725                     set done 1
4726                 }
4727             }
4728         }
4729         if {$done} {
4730             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4731             return
4732         }
4733     }
4734     set descendent($a) 0
4735     set desc_todo $leftover
4736 }
4737
4738 proc is_ancestor {a} {
4739     global curview parents ancestor anc_todo
4740
4741     set v $curview
4742     set la [rowofcommit $a]
4743     set todo $anc_todo
4744     set leftover {}
4745     set done 0
4746     for {set i 0} {$i < [llength $todo]} {incr i} {
4747         set do [lindex $todo $i]
4748         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4749             lappend leftover $do
4750             continue
4751         }
4752         foreach np $parents($v,$do) {
4753             if {![info exists ancestor($np)]} {
4754                 set ancestor($np) 1
4755                 lappend todo $np
4756                 if {$np eq $a} {
4757                     set done 1
4758                 }
4759             }
4760         }
4761         if {$done} {
4762             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4763             return
4764         }
4765     }
4766     set ancestor($a) 0
4767     set anc_todo $leftover
4768 }
4769
4770 proc askrelhighlight {row id} {
4771     global descendent highlight_related iddrawn rhighlights
4772     global selectedline ancestor
4773
4774     if {$selectedline eq {}} return
4775     set isbold 0
4776     if {$highlight_related eq [mc "Descendant"] ||
4777         $highlight_related eq [mc "Not descendant"]} {
4778         if {![info exists descendent($id)]} {
4779             is_descendent $id
4780         }
4781         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4782             set isbold 1
4783         }
4784     } elseif {$highlight_related eq [mc "Ancestor"] ||
4785               $highlight_related eq [mc "Not ancestor"]} {
4786         if {![info exists ancestor($id)]} {
4787             is_ancestor $id
4788         }
4789         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4790             set isbold 1
4791         }
4792     }
4793     if {[info exists iddrawn($id)]} {
4794         if {$isbold && ![ishighlighted $id]} {
4795             bolden $id mainfontbold
4796         }
4797     }
4798     set rhighlights($id) $isbold
4799 }
4800
4801 # Graph layout functions
4802
4803 proc shortids {ids} {
4804     set res {}
4805     foreach id $ids {
4806         if {[llength $id] > 1} {
4807             lappend res [shortids $id]
4808         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4809             lappend res [string range $id 0 7]
4810         } else {
4811             lappend res $id
4812         }
4813     }
4814     return $res
4815 }
4816
4817 proc ntimes {n o} {
4818     set ret {}
4819     set o [list $o]
4820     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4821         if {($n & $mask) != 0} {
4822             set ret [concat $ret $o]
4823         }
4824         set o [concat $o $o]
4825     }
4826     return $ret
4827 }
4828
4829 proc ordertoken {id} {
4830     global ordertok curview varcid varcstart varctok curview parents children
4831     global nullid nullid2
4832
4833     if {[info exists ordertok($id)]} {
4834         return $ordertok($id)
4835     }
4836     set origid $id
4837     set todo {}
4838     while {1} {
4839         if {[info exists varcid($curview,$id)]} {
4840             set a $varcid($curview,$id)
4841             set p [lindex $varcstart($curview) $a]
4842         } else {
4843             set p [lindex $children($curview,$id) 0]
4844         }
4845         if {[info exists ordertok($p)]} {
4846             set tok $ordertok($p)
4847             break
4848         }
4849         set id [first_real_child $curview,$p]
4850         if {$id eq {}} {
4851             # it's a root
4852             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4853             break
4854         }
4855         if {[llength $parents($curview,$id)] == 1} {
4856             lappend todo [list $p {}]
4857         } else {
4858             set j [lsearch -exact $parents($curview,$id) $p]
4859             if {$j < 0} {
4860                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4861             }
4862             lappend todo [list $p [strrep $j]]
4863         }
4864     }
4865     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4866         set p [lindex $todo $i 0]
4867         append tok [lindex $todo $i 1]
4868         set ordertok($p) $tok
4869     }
4870     set ordertok($origid) $tok
4871     return $tok
4872 }
4873
4874 # Work out where id should go in idlist so that order-token
4875 # values increase from left to right
4876 proc idcol {idlist id {i 0}} {
4877     set t [ordertoken $id]
4878     if {$i < 0} {
4879         set i 0
4880     }
4881     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4882         if {$i > [llength $idlist]} {
4883             set i [llength $idlist]
4884         }
4885         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4886         incr i
4887     } else {
4888         if {$t > [ordertoken [lindex $idlist $i]]} {
4889             while {[incr i] < [llength $idlist] &&
4890                    $t >= [ordertoken [lindex $idlist $i]]} {}
4891         }
4892     }
4893     return $i
4894 }
4895
4896 proc initlayout {} {
4897     global rowidlist rowisopt rowfinal displayorder parentlist
4898     global numcommits canvxmax canv
4899     global nextcolor
4900     global colormap rowtextx
4901
4902     set numcommits 0
4903     set displayorder {}
4904     set parentlist {}
4905     set nextcolor 0
4906     set rowidlist {}
4907     set rowisopt {}
4908     set rowfinal {}
4909     set canvxmax [$canv cget -width]
4910     catch {unset colormap}
4911     catch {unset rowtextx}
4912     setcanvscroll
4913 }
4914
4915 proc setcanvscroll {} {
4916     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4917     global lastscrollset lastscrollrows
4918
4919     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4920     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4921     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4922     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4923     set lastscrollset [clock clicks -milliseconds]
4924     set lastscrollrows $numcommits
4925 }
4926
4927 proc visiblerows {} {
4928     global canv numcommits linespc
4929
4930     set ymax [lindex [$canv cget -scrollregion] 3]
4931     if {$ymax eq {} || $ymax == 0} return
4932     set f [$canv yview]
4933     set y0 [expr {int([lindex $f 0] * $ymax)}]
4934     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4935     if {$r0 < 0} {
4936         set r0 0
4937     }
4938     set y1 [expr {int([lindex $f 1] * $ymax)}]
4939     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4940     if {$r1 >= $numcommits} {
4941         set r1 [expr {$numcommits - 1}]
4942     }
4943     return [list $r0 $r1]
4944 }
4945
4946 proc layoutmore {} {
4947     global commitidx viewcomplete curview
4948     global numcommits pending_select curview
4949     global lastscrollset lastscrollrows
4950
4951     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4952         [clock clicks -milliseconds] - $lastscrollset > 500} {
4953         setcanvscroll
4954     }
4955     if {[info exists pending_select] &&
4956         [commitinview $pending_select $curview]} {
4957         update
4958         selectline [rowofcommit $pending_select] 1
4959     }
4960     drawvisible
4961 }
4962
4963 # With path limiting, we mightn't get the actual HEAD commit,
4964 # so ask git rev-list what is the first ancestor of HEAD that
4965 # touches a file in the path limit.
4966 proc get_viewmainhead {view} {
4967     global viewmainheadid vfilelimit viewinstances mainheadid
4968
4969     catch {
4970         set rfd [open [concat | git rev-list -1 $mainheadid \
4971                            -- $vfilelimit($view)] r]
4972         set j [reg_instance $rfd]
4973         lappend viewinstances($view) $j
4974         fconfigure $rfd -blocking 0
4975         filerun $rfd [list getviewhead $rfd $j $view]
4976         set viewmainheadid($curview) {}
4977     }
4978 }
4979
4980 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4981 proc getviewhead {fd inst view} {
4982     global viewmainheadid commfd curview viewinstances showlocalchanges
4983
4984     set id {}
4985     if {[gets $fd line] < 0} {
4986         if {![eof $fd]} {
4987             return 1
4988         }
4989     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4990         set id $line
4991     }
4992     set viewmainheadid($view) $id
4993     close $fd
4994     unset commfd($inst)
4995     set i [lsearch -exact $viewinstances($view) $inst]
4996     if {$i >= 0} {
4997         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4998     }
4999     if {$showlocalchanges && $id ne {} && $view == $curview} {
5000         doshowlocalchanges
5001     }
5002     return 0
5003 }
5004
5005 proc doshowlocalchanges {} {
5006     global curview viewmainheadid
5007
5008     if {$viewmainheadid($curview) eq {}} return
5009     if {[commitinview $viewmainheadid($curview) $curview]} {
5010         dodiffindex
5011     } else {
5012         interestedin $viewmainheadid($curview) dodiffindex
5013     }
5014 }
5015
5016 proc dohidelocalchanges {} {
5017     global nullid nullid2 lserial curview
5018
5019     if {[commitinview $nullid $curview]} {
5020         removefakerow $nullid
5021     }
5022     if {[commitinview $nullid2 $curview]} {
5023         removefakerow $nullid2
5024     }
5025     incr lserial
5026 }
5027
5028 # spawn off a process to do git diff-index --cached HEAD
5029 proc dodiffindex {} {
5030     global lserial showlocalchanges vfilelimit curview
5031     global isworktree
5032
5033     if {!$showlocalchanges || !$isworktree} return
5034     incr lserial
5035     set cmd "|git diff-index --cached HEAD"
5036     if {$vfilelimit($curview) ne {}} {
5037         set cmd [concat $cmd -- $vfilelimit($curview)]
5038     }
5039     set fd [open $cmd r]
5040     fconfigure $fd -blocking 0
5041     set i [reg_instance $fd]
5042     filerun $fd [list readdiffindex $fd $lserial $i]
5043 }
5044
5045 proc readdiffindex {fd serial inst} {
5046     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5047     global vfilelimit
5048
5049     set isdiff 1
5050     if {[gets $fd line] < 0} {
5051         if {![eof $fd]} {
5052             return 1
5053         }
5054         set isdiff 0
5055     }
5056     # we only need to see one line and we don't really care what it says...
5057     stop_instance $inst
5058
5059     if {$serial != $lserial} {
5060         return 0
5061     }
5062
5063     # now see if there are any local changes not checked in to the index
5064     set cmd "|git diff-files"
5065     if {$vfilelimit($curview) ne {}} {
5066         set cmd [concat $cmd -- $vfilelimit($curview)]
5067     }
5068     set fd [open $cmd r]
5069     fconfigure $fd -blocking 0
5070     set i [reg_instance $fd]
5071     filerun $fd [list readdifffiles $fd $serial $i]
5072
5073     if {$isdiff && ![commitinview $nullid2 $curview]} {
5074         # add the line for the changes in the index to the graph
5075         set hl [mc "Local changes checked in to index but not committed"]
5076         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5077         set commitdata($nullid2) "\n    $hl\n"
5078         if {[commitinview $nullid $curview]} {
5079             removefakerow $nullid
5080         }
5081         insertfakerow $nullid2 $viewmainheadid($curview)
5082     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5083         if {[commitinview $nullid $curview]} {
5084             removefakerow $nullid
5085         }
5086         removefakerow $nullid2
5087     }
5088     return 0
5089 }
5090
5091 proc readdifffiles {fd serial inst} {
5092     global viewmainheadid nullid nullid2 curview
5093     global commitinfo commitdata lserial
5094
5095     set isdiff 1
5096     if {[gets $fd line] < 0} {
5097         if {![eof $fd]} {
5098             return 1
5099         }
5100         set isdiff 0
5101     }
5102     # we only need to see one line and we don't really care what it says...
5103     stop_instance $inst
5104
5105     if {$serial != $lserial} {
5106         return 0
5107     }
5108
5109     if {$isdiff && ![commitinview $nullid $curview]} {
5110         # add the line for the local diff to the graph
5111         set hl [mc "Local uncommitted changes, not checked in to index"]
5112         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5113         set commitdata($nullid) "\n    $hl\n"
5114         if {[commitinview $nullid2 $curview]} {
5115             set p $nullid2
5116         } else {
5117             set p $viewmainheadid($curview)
5118         }
5119         insertfakerow $nullid $p
5120     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5121         removefakerow $nullid
5122     }
5123     return 0
5124 }
5125
5126 proc nextuse {id row} {
5127     global curview children
5128
5129     if {[info exists children($curview,$id)]} {
5130         foreach kid $children($curview,$id) {
5131             if {![commitinview $kid $curview]} {
5132                 return -1
5133             }
5134             if {[rowofcommit $kid] > $row} {
5135                 return [rowofcommit $kid]
5136             }
5137         }
5138     }
5139     if {[commitinview $id $curview]} {
5140         return [rowofcommit $id]
5141     }
5142     return -1
5143 }
5144
5145 proc prevuse {id row} {
5146     global curview children
5147
5148     set ret -1
5149     if {[info exists children($curview,$id)]} {
5150         foreach kid $children($curview,$id) {
5151             if {![commitinview $kid $curview]} break
5152             if {[rowofcommit $kid] < $row} {
5153                 set ret [rowofcommit $kid]
5154             }
5155         }
5156     }
5157     return $ret
5158 }
5159
5160 proc make_idlist {row} {
5161     global displayorder parentlist uparrowlen downarrowlen mingaplen
5162     global commitidx curview children
5163
5164     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5165     if {$r < 0} {
5166         set r 0
5167     }
5168     set ra [expr {$row - $downarrowlen}]
5169     if {$ra < 0} {
5170         set ra 0
5171     }
5172     set rb [expr {$row + $uparrowlen}]
5173     if {$rb > $commitidx($curview)} {
5174         set rb $commitidx($curview)
5175     }
5176     make_disporder $r [expr {$rb + 1}]
5177     set ids {}
5178     for {} {$r < $ra} {incr r} {
5179         set nextid [lindex $displayorder [expr {$r + 1}]]
5180         foreach p [lindex $parentlist $r] {
5181             if {$p eq $nextid} continue
5182             set rn [nextuse $p $r]
5183             if {$rn >= $row &&
5184                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5185                 lappend ids [list [ordertoken $p] $p]
5186             }
5187         }
5188     }
5189     for {} {$r < $row} {incr r} {
5190         set nextid [lindex $displayorder [expr {$r + 1}]]
5191         foreach p [lindex $parentlist $r] {
5192             if {$p eq $nextid} continue
5193             set rn [nextuse $p $r]
5194             if {$rn < 0 || $rn >= $row} {
5195                 lappend ids [list [ordertoken $p] $p]
5196             }
5197         }
5198     }
5199     set id [lindex $displayorder $row]
5200     lappend ids [list [ordertoken $id] $id]
5201     while {$r < $rb} {
5202         foreach p [lindex $parentlist $r] {
5203             set firstkid [lindex $children($curview,$p) 0]
5204             if {[rowofcommit $firstkid] < $row} {
5205                 lappend ids [list [ordertoken $p] $p]
5206             }
5207         }
5208         incr r
5209         set id [lindex $displayorder $r]
5210         if {$id ne {}} {
5211             set firstkid [lindex $children($curview,$id) 0]
5212             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5213                 lappend ids [list [ordertoken $id] $id]
5214             }
5215         }
5216     }
5217     set idlist {}
5218     foreach idx [lsort -unique $ids] {
5219         lappend idlist [lindex $idx 1]
5220     }
5221     return $idlist
5222 }
5223
5224 proc rowsequal {a b} {
5225     while {[set i [lsearch -exact $a {}]] >= 0} {
5226         set a [lreplace $a $i $i]
5227     }
5228     while {[set i [lsearch -exact $b {}]] >= 0} {
5229         set b [lreplace $b $i $i]
5230     }
5231     return [expr {$a eq $b}]
5232 }
5233
5234 proc makeupline {id row rend col} {
5235     global rowidlist uparrowlen downarrowlen mingaplen
5236
5237     for {set r $rend} {1} {set r $rstart} {
5238         set rstart [prevuse $id $r]
5239         if {$rstart < 0} return
5240         if {$rstart < $row} break
5241     }
5242     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5243         set rstart [expr {$rend - $uparrowlen - 1}]
5244     }
5245     for {set r $rstart} {[incr r] <= $row} {} {
5246         set idlist [lindex $rowidlist $r]
5247         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5248             set col [idcol $idlist $id $col]
5249             lset rowidlist $r [linsert $idlist $col $id]
5250             changedrow $r
5251         }
5252     }
5253 }
5254
5255 proc layoutrows {row endrow} {
5256     global rowidlist rowisopt rowfinal displayorder
5257     global uparrowlen downarrowlen maxwidth mingaplen
5258     global children parentlist
5259     global commitidx viewcomplete curview
5260
5261     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5262     set idlist {}
5263     if {$row > 0} {
5264         set rm1 [expr {$row - 1}]
5265         foreach id [lindex $rowidlist $rm1] {
5266             if {$id ne {}} {
5267                 lappend idlist $id
5268             }
5269         }
5270         set final [lindex $rowfinal $rm1]
5271     }
5272     for {} {$row < $endrow} {incr row} {
5273         set rm1 [expr {$row - 1}]
5274         if {$rm1 < 0 || $idlist eq {}} {
5275             set idlist [make_idlist $row]
5276             set final 1
5277         } else {
5278             set id [lindex $displayorder $rm1]
5279             set col [lsearch -exact $idlist $id]
5280             set idlist [lreplace $idlist $col $col]
5281             foreach p [lindex $parentlist $rm1] {
5282                 if {[lsearch -exact $idlist $p] < 0} {
5283                     set col [idcol $idlist $p $col]
5284                     set idlist [linsert $idlist $col $p]
5285                     # if not the first child, we have to insert a line going up
5286                     if {$id ne [lindex $children($curview,$p) 0]} {
5287                         makeupline $p $rm1 $row $col
5288                     }
5289                 }
5290             }
5291             set id [lindex $displayorder $row]
5292             if {$row > $downarrowlen} {
5293                 set termrow [expr {$row - $downarrowlen - 1}]
5294                 foreach p [lindex $parentlist $termrow] {
5295                     set i [lsearch -exact $idlist $p]
5296                     if {$i < 0} continue
5297                     set nr [nextuse $p $termrow]
5298                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5299                         set idlist [lreplace $idlist $i $i]
5300                     }
5301                 }
5302             }
5303             set col [lsearch -exact $idlist $id]
5304             if {$col < 0} {
5305                 set col [idcol $idlist $id]
5306                 set idlist [linsert $idlist $col $id]
5307                 if {$children($curview,$id) ne {}} {
5308                     makeupline $id $rm1 $row $col
5309                 }
5310             }
5311             set r [expr {$row + $uparrowlen - 1}]
5312             if {$r < $commitidx($curview)} {
5313                 set x $col
5314                 foreach p [lindex $parentlist $r] {
5315                     if {[lsearch -exact $idlist $p] >= 0} continue
5316                     set fk [lindex $children($curview,$p) 0]
5317                     if {[rowofcommit $fk] < $row} {
5318                         set x [idcol $idlist $p $x]
5319                         set idlist [linsert $idlist $x $p]
5320                     }
5321                 }
5322                 if {[incr r] < $commitidx($curview)} {
5323                     set p [lindex $displayorder $r]
5324                     if {[lsearch -exact $idlist $p] < 0} {
5325                         set fk [lindex $children($curview,$p) 0]
5326                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5327                             set x [idcol $idlist $p $x]
5328                             set idlist [linsert $idlist $x $p]
5329                         }
5330                     }
5331                 }
5332             }
5333         }
5334         if {$final && !$viewcomplete($curview) &&
5335             $row + $uparrowlen + $mingaplen + $downarrowlen
5336                 >= $commitidx($curview)} {
5337             set final 0
5338         }
5339         set l [llength $rowidlist]
5340         if {$row == $l} {
5341             lappend rowidlist $idlist
5342             lappend rowisopt 0
5343             lappend rowfinal $final
5344         } elseif {$row < $l} {
5345             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5346                 lset rowidlist $row $idlist
5347                 changedrow $row
5348             }
5349             lset rowfinal $row $final
5350         } else {
5351             set pad [ntimes [expr {$row - $l}] {}]
5352             set rowidlist [concat $rowidlist $pad]
5353             lappend rowidlist $idlist
5354             set rowfinal [concat $rowfinal $pad]
5355             lappend rowfinal $final
5356             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5357         }
5358     }
5359     return $row
5360 }
5361
5362 proc changedrow {row} {
5363     global displayorder iddrawn rowisopt need_redisplay
5364
5365     set l [llength $rowisopt]
5366     if {$row < $l} {
5367         lset rowisopt $row 0
5368         if {$row + 1 < $l} {
5369             lset rowisopt [expr {$row + 1}] 0
5370             if {$row + 2 < $l} {
5371                 lset rowisopt [expr {$row + 2}] 0
5372             }
5373         }
5374     }
5375     set id [lindex $displayorder $row]
5376     if {[info exists iddrawn($id)]} {
5377         set need_redisplay 1
5378     }
5379 }
5380
5381 proc insert_pad {row col npad} {
5382     global rowidlist
5383
5384     set pad [ntimes $npad {}]
5385     set idlist [lindex $rowidlist $row]
5386     set bef [lrange $idlist 0 [expr {$col - 1}]]
5387     set aft [lrange $idlist $col end]
5388     set i [lsearch -exact $aft {}]
5389     if {$i > 0} {
5390         set aft [lreplace $aft $i $i]
5391     }
5392     lset rowidlist $row [concat $bef $pad $aft]
5393     changedrow $row
5394 }
5395
5396 proc optimize_rows {row col endrow} {
5397     global rowidlist rowisopt displayorder curview children
5398
5399     if {$row < 1} {
5400         set row 1
5401     }
5402     for {} {$row < $endrow} {incr row; set col 0} {
5403         if {[lindex $rowisopt $row]} continue
5404         set haspad 0
5405         set y0 [expr {$row - 1}]
5406         set ym [expr {$row - 2}]
5407         set idlist [lindex $rowidlist $row]
5408         set previdlist [lindex $rowidlist $y0]
5409         if {$idlist eq {} || $previdlist eq {}} continue
5410         if {$ym >= 0} {
5411             set pprevidlist [lindex $rowidlist $ym]
5412             if {$pprevidlist eq {}} continue
5413         } else {
5414             set pprevidlist {}
5415         }
5416         set x0 -1
5417         set xm -1
5418         for {} {$col < [llength $idlist]} {incr col} {
5419             set id [lindex $idlist $col]
5420             if {[lindex $previdlist $col] eq $id} continue
5421             if {$id eq {}} {
5422                 set haspad 1
5423                 continue
5424             }
5425             set x0 [lsearch -exact $previdlist $id]
5426             if {$x0 < 0} continue
5427             set z [expr {$x0 - $col}]
5428             set isarrow 0
5429             set z0 {}
5430             if {$ym >= 0} {
5431                 set xm [lsearch -exact $pprevidlist $id]
5432                 if {$xm >= 0} {
5433                     set z0 [expr {$xm - $x0}]
5434                 }
5435             }
5436             if {$z0 eq {}} {
5437                 # if row y0 is the first child of $id then it's not an arrow
5438                 if {[lindex $children($curview,$id) 0] ne
5439                     [lindex $displayorder $y0]} {
5440                     set isarrow 1
5441                 }
5442             }
5443             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5444                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5445                 set isarrow 1
5446             }
5447             # Looking at lines from this row to the previous row,
5448             # make them go straight up if they end in an arrow on
5449             # the previous row; otherwise make them go straight up
5450             # or at 45 degrees.
5451             if {$z < -1 || ($z < 0 && $isarrow)} {
5452                 # Line currently goes left too much;
5453                 # insert pads in the previous row, then optimize it
5454                 set npad [expr {-1 - $z + $isarrow}]
5455                 insert_pad $y0 $x0 $npad
5456                 if {$y0 > 0} {
5457                     optimize_rows $y0 $x0 $row
5458                 }
5459                 set previdlist [lindex $rowidlist $y0]
5460                 set x0 [lsearch -exact $previdlist $id]
5461                 set z [expr {$x0 - $col}]
5462                 if {$z0 ne {}} {
5463                     set pprevidlist [lindex $rowidlist $ym]
5464                     set xm [lsearch -exact $pprevidlist $id]
5465                     set z0 [expr {$xm - $x0}]
5466                 }
5467             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5468                 # Line currently goes right too much;
5469                 # insert pads in this line
5470                 set npad [expr {$z - 1 + $isarrow}]
5471                 insert_pad $row $col $npad
5472                 set idlist [lindex $rowidlist $row]
5473                 incr col $npad
5474                 set z [expr {$x0 - $col}]
5475                 set haspad 1
5476             }
5477             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5478                 # this line links to its first child on row $row-2
5479                 set id [lindex $displayorder $ym]
5480                 set xc [lsearch -exact $pprevidlist $id]
5481                 if {$xc >= 0} {
5482                     set z0 [expr {$xc - $x0}]
5483                 }
5484             }
5485             # avoid lines jigging left then immediately right
5486             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5487                 insert_pad $y0 $x0 1
5488                 incr x0
5489                 optimize_rows $y0 $x0 $row
5490                 set previdlist [lindex $rowidlist $y0]
5491             }
5492         }
5493         if {!$haspad} {
5494             # Find the first column that doesn't have a line going right
5495             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5496                 set id [lindex $idlist $col]
5497                 if {$id eq {}} break
5498                 set x0 [lsearch -exact $previdlist $id]
5499                 if {$x0 < 0} {
5500                     # check if this is the link to the first child
5501                     set kid [lindex $displayorder $y0]
5502                     if {[lindex $children($curview,$id) 0] eq $kid} {
5503                         # it is, work out offset to child
5504                         set x0 [lsearch -exact $previdlist $kid]
5505                     }
5506                 }
5507                 if {$x0 <= $col} break
5508             }
5509             # Insert a pad at that column as long as it has a line and
5510             # isn't the last column
5511             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5512                 set idlist [linsert $idlist $col {}]
5513                 lset rowidlist $row $idlist
5514                 changedrow $row
5515             }
5516         }
5517     }
5518 }
5519
5520 proc xc {row col} {
5521     global canvx0 linespc
5522     return [expr {$canvx0 + $col * $linespc}]
5523 }
5524
5525 proc yc {row} {
5526     global canvy0 linespc
5527     return [expr {$canvy0 + $row * $linespc}]
5528 }
5529
5530 proc linewidth {id} {
5531     global thickerline lthickness
5532
5533     set wid $lthickness
5534     if {[info exists thickerline] && $id eq $thickerline} {
5535         set wid [expr {2 * $lthickness}]
5536     }
5537     return $wid
5538 }
5539
5540 proc rowranges {id} {
5541     global curview children uparrowlen downarrowlen
5542     global rowidlist
5543
5544     set kids $children($curview,$id)
5545     if {$kids eq {}} {
5546         return {}
5547     }
5548     set ret {}
5549     lappend kids $id
5550     foreach child $kids {
5551         if {![commitinview $child $curview]} break
5552         set row [rowofcommit $child]
5553         if {![info exists prev]} {
5554             lappend ret [expr {$row + 1}]
5555         } else {
5556             if {$row <= $prevrow} {
5557                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5558             }
5559             # see if the line extends the whole way from prevrow to row
5560             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5561                 [lsearch -exact [lindex $rowidlist \
5562                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5563                 # it doesn't, see where it ends
5564                 set r [expr {$prevrow + $downarrowlen}]
5565                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5566                     while {[incr r -1] > $prevrow &&
5567                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5568                 } else {
5569                     while {[incr r] <= $row &&
5570                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5571                     incr r -1
5572                 }
5573                 lappend ret $r
5574                 # see where it starts up again
5575                 set r [expr {$row - $uparrowlen}]
5576                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5577                     while {[incr r] < $row &&
5578                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5579                 } else {
5580                     while {[incr r -1] >= $prevrow &&
5581                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5582                     incr r
5583                 }
5584                 lappend ret $r
5585             }
5586         }
5587         if {$child eq $id} {
5588             lappend ret $row
5589         }
5590         set prev $child
5591         set prevrow $row
5592     }
5593     return $ret
5594 }
5595
5596 proc drawlineseg {id row endrow arrowlow} {
5597     global rowidlist displayorder iddrawn linesegs
5598     global canv colormap linespc curview maxlinelen parentlist
5599
5600     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5601     set le [expr {$row + 1}]
5602     set arrowhigh 1
5603     while {1} {
5604         set c [lsearch -exact [lindex $rowidlist $le] $id]
5605         if {$c < 0} {
5606             incr le -1
5607             break
5608         }
5609         lappend cols $c
5610         set x [lindex $displayorder $le]
5611         if {$x eq $id} {
5612             set arrowhigh 0
5613             break
5614         }
5615         if {[info exists iddrawn($x)] || $le == $endrow} {
5616             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5617             if {$c >= 0} {
5618                 lappend cols $c
5619                 set arrowhigh 0
5620             }
5621             break
5622         }
5623         incr le
5624     }
5625     if {$le <= $row} {
5626         return $row
5627     }
5628
5629     set lines {}
5630     set i 0
5631     set joinhigh 0
5632     if {[info exists linesegs($id)]} {
5633         set lines $linesegs($id)
5634         foreach li $lines {
5635             set r0 [lindex $li 0]
5636             if {$r0 > $row} {
5637                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5638                     set joinhigh 1
5639                 }
5640                 break
5641             }
5642             incr i
5643         }
5644     }
5645     set joinlow 0
5646     if {$i > 0} {
5647         set li [lindex $lines [expr {$i-1}]]
5648         set r1 [lindex $li 1]
5649         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5650             set joinlow 1
5651         }
5652     }
5653
5654     set x [lindex $cols [expr {$le - $row}]]
5655     set xp [lindex $cols [expr {$le - 1 - $row}]]
5656     set dir [expr {$xp - $x}]
5657     if {$joinhigh} {
5658         set ith [lindex $lines $i 2]
5659         set coords [$canv coords $ith]
5660         set ah [$canv itemcget $ith -arrow]
5661         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5662         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5663         if {$x2 ne {} && $x - $x2 == $dir} {
5664             set coords [lrange $coords 0 end-2]
5665         }
5666     } else {
5667         set coords [list [xc $le $x] [yc $le]]
5668     }
5669     if {$joinlow} {
5670         set itl [lindex $lines [expr {$i-1}] 2]
5671         set al [$canv itemcget $itl -arrow]
5672         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5673     } elseif {$arrowlow} {
5674         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5675             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5676             set arrowlow 0
5677         }
5678     }
5679     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5680     for {set y $le} {[incr y -1] > $row} {} {
5681         set x $xp
5682         set xp [lindex $cols [expr {$y - 1 - $row}]]
5683         set ndir [expr {$xp - $x}]
5684         if {$dir != $ndir || $xp < 0} {
5685             lappend coords [xc $y $x] [yc $y]
5686         }
5687         set dir $ndir
5688     }
5689     if {!$joinlow} {
5690         if {$xp < 0} {
5691             # join parent line to first child
5692             set ch [lindex $displayorder $row]
5693             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5694             if {$xc < 0} {
5695                 puts "oops: drawlineseg: child $ch not on row $row"
5696             } elseif {$xc != $x} {
5697                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5698                     set d [expr {int(0.5 * $linespc)}]
5699                     set x1 [xc $row $x]
5700                     if {$xc < $x} {
5701                         set x2 [expr {$x1 - $d}]
5702                     } else {
5703                         set x2 [expr {$x1 + $d}]
5704                     }
5705                     set y2 [yc $row]
5706                     set y1 [expr {$y2 + $d}]
5707                     lappend coords $x1 $y1 $x2 $y2
5708                 } elseif {$xc < $x - 1} {
5709                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5710                 } elseif {$xc > $x + 1} {
5711                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5712                 }
5713                 set x $xc
5714             }
5715             lappend coords [xc $row $x] [yc $row]
5716         } else {
5717             set xn [xc $row $xp]
5718             set yn [yc $row]
5719             lappend coords $xn $yn
5720         }
5721         if {!$joinhigh} {
5722             assigncolor $id
5723             set t [$canv create line $coords -width [linewidth $id] \
5724                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5725             $canv lower $t
5726             bindline $t $id
5727             set lines [linsert $lines $i [list $row $le $t]]
5728         } else {
5729             $canv coords $ith $coords
5730             if {$arrow ne $ah} {
5731                 $canv itemconf $ith -arrow $arrow
5732             }
5733             lset lines $i 0 $row
5734         }
5735     } else {
5736         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5737         set ndir [expr {$xo - $xp}]
5738         set clow [$canv coords $itl]
5739         if {$dir == $ndir} {
5740             set clow [lrange $clow 2 end]
5741         }
5742         set coords [concat $coords $clow]
5743         if {!$joinhigh} {
5744             lset lines [expr {$i-1}] 1 $le
5745         } else {
5746             # coalesce two pieces
5747             $canv delete $ith
5748             set b [lindex $lines [expr {$i-1}] 0]
5749             set e [lindex $lines $i 1]
5750             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5751         }
5752         $canv coords $itl $coords
5753         if {$arrow ne $al} {
5754             $canv itemconf $itl -arrow $arrow
5755         }
5756     }
5757
5758     set linesegs($id) $lines
5759     return $le
5760 }
5761
5762 proc drawparentlinks {id row} {
5763     global rowidlist canv colormap curview parentlist
5764     global idpos linespc
5765
5766     set rowids [lindex $rowidlist $row]
5767     set col [lsearch -exact $rowids $id]
5768     if {$col < 0} return
5769     set olds [lindex $parentlist $row]
5770     set row2 [expr {$row + 1}]
5771     set x [xc $row $col]
5772     set y [yc $row]
5773     set y2 [yc $row2]
5774     set d [expr {int(0.5 * $linespc)}]
5775     set ymid [expr {$y + $d}]
5776     set ids [lindex $rowidlist $row2]
5777     # rmx = right-most X coord used
5778     set rmx 0
5779     foreach p $olds {
5780         set i [lsearch -exact $ids $p]
5781         if {$i < 0} {
5782             puts "oops, parent $p of $id not in list"
5783             continue
5784         }
5785         set x2 [xc $row2 $i]
5786         if {$x2 > $rmx} {
5787             set rmx $x2
5788         }
5789         set j [lsearch -exact $rowids $p]
5790         if {$j < 0} {
5791             # drawlineseg will do this one for us
5792             continue
5793         }
5794         assigncolor $p
5795         # should handle duplicated parents here...
5796         set coords [list $x $y]
5797         if {$i != $col} {
5798             # if attaching to a vertical segment, draw a smaller
5799             # slant for visual distinctness
5800             if {$i == $j} {
5801                 if {$i < $col} {
5802                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5803                 } else {
5804                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5805                 }
5806             } elseif {$i < $col && $i < $j} {
5807                 # segment slants towards us already
5808                 lappend coords [xc $row $j] $y
5809             } else {
5810                 if {$i < $col - 1} {
5811                     lappend coords [expr {$x2 + $linespc}] $y
5812                 } elseif {$i > $col + 1} {
5813                     lappend coords [expr {$x2 - $linespc}] $y
5814                 }
5815                 lappend coords $x2 $y2
5816             }
5817         } else {
5818             lappend coords $x2 $y2
5819         }
5820         set t [$canv create line $coords -width [linewidth $p] \
5821                    -fill $colormap($p) -tags lines.$p]
5822         $canv lower $t
5823         bindline $t $p
5824     }
5825     if {$rmx > [lindex $idpos($id) 1]} {
5826         lset idpos($id) 1 $rmx
5827         redrawtags $id
5828     }
5829 }
5830
5831 proc drawlines {id} {
5832     global canv
5833
5834     $canv itemconf lines.$id -width [linewidth $id]
5835 }
5836
5837 proc drawcmittext {id row col} {
5838     global linespc canv canv2 canv3 fgcolor curview
5839     global cmitlisted commitinfo rowidlist parentlist
5840     global rowtextx idpos idtags idheads idotherrefs
5841     global linehtag linentag linedtag selectedline
5842     global canvxmax boldids boldnameids fgcolor markedid
5843     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5844
5845     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5846     set listed $cmitlisted($curview,$id)
5847     if {$id eq $nullid} {
5848         set ofill red
5849     } elseif {$id eq $nullid2} {
5850         set ofill green
5851     } elseif {$id eq $mainheadid} {
5852         set ofill yellow
5853     } else {
5854         set ofill [lindex $circlecolors $listed]
5855     }
5856     set x [xc $row $col]
5857     set y [yc $row]
5858     set orad [expr {$linespc / 3}]
5859     if {$listed <= 2} {
5860         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5861                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5862                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5863     } elseif {$listed == 3} {
5864         # triangle pointing left for left-side commits
5865         set t [$canv create polygon \
5866                    [expr {$x - $orad}] $y \
5867                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5868                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5869                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5870     } else {
5871         # triangle pointing right for right-side commits
5872         set t [$canv create polygon \
5873                    [expr {$x + $orad - 1}] $y \
5874                    [expr {$x - $orad}] [expr {$y - $orad}] \
5875                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5876                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5877     }
5878     set circleitem($row) $t
5879     $canv raise $t
5880     $canv bind $t <1> {selcanvline {} %x %y}
5881     set rmx [llength [lindex $rowidlist $row]]
5882     set olds [lindex $parentlist $row]
5883     if {$olds ne {}} {
5884         set nextids [lindex $rowidlist [expr {$row + 1}]]
5885         foreach p $olds {
5886             set i [lsearch -exact $nextids $p]
5887             if {$i > $rmx} {
5888                 set rmx $i
5889             }
5890         }
5891     }
5892     set xt [xc $row $rmx]
5893     set rowtextx($row) $xt
5894     set idpos($id) [list $x $xt $y]
5895     if {[info exists idtags($id)] || [info exists idheads($id)]
5896         || [info exists idotherrefs($id)]} {
5897         set xt [drawtags $id $x $xt $y]
5898     }
5899     set headline [lindex $commitinfo($id) 0]
5900     set name [lindex $commitinfo($id) 1]
5901     set date [lindex $commitinfo($id) 2]
5902     set date [formatdate $date]
5903     set font mainfont
5904     set nfont mainfont
5905     set isbold [ishighlighted $id]
5906     if {$isbold > 0} {
5907         lappend boldids $id
5908         set font mainfontbold
5909         if {$isbold > 1} {
5910             lappend boldnameids $id
5911             set nfont mainfontbold
5912         }
5913     }
5914     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5915                            -text $headline -font $font -tags text]
5916     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5917     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5918                            -text $name -font $nfont -tags text]
5919     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5920                            -text $date -font mainfont -tags text]
5921     if {$selectedline == $row} {
5922         make_secsel $id
5923     }
5924     if {[info exists markedid] && $markedid eq $id} {
5925         make_idmark $id
5926     }
5927     set xr [expr {$xt + [font measure $font $headline]}]
5928     if {$xr > $canvxmax} {
5929         set canvxmax $xr
5930         setcanvscroll
5931     }
5932 }
5933
5934 proc drawcmitrow {row} {
5935     global displayorder rowidlist nrows_drawn
5936     global iddrawn markingmatches
5937     global commitinfo numcommits
5938     global filehighlight fhighlights findpattern nhighlights
5939     global hlview vhighlights
5940     global highlight_related rhighlights
5941
5942     if {$row >= $numcommits} return
5943
5944     set id [lindex $displayorder $row]
5945     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5946         askvhighlight $row $id
5947     }
5948     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5949         askfilehighlight $row $id
5950     }
5951     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5952         askfindhighlight $row $id
5953     }
5954     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5955         askrelhighlight $row $id
5956     }
5957     if {![info exists iddrawn($id)]} {
5958         set col [lsearch -exact [lindex $rowidlist $row] $id]
5959         if {$col < 0} {
5960             puts "oops, row $row id $id not in list"
5961             return
5962         }
5963         if {![info exists commitinfo($id)]} {
5964             getcommit $id
5965         }
5966         assigncolor $id
5967         drawcmittext $id $row $col
5968         set iddrawn($id) 1
5969         incr nrows_drawn
5970     }
5971     if {$markingmatches} {
5972         markrowmatches $row $id
5973     }
5974 }
5975
5976 proc drawcommits {row {endrow {}}} {
5977     global numcommits iddrawn displayorder curview need_redisplay
5978     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5979
5980     if {$row < 0} {
5981         set row 0
5982     }
5983     if {$endrow eq {}} {
5984         set endrow $row
5985     }
5986     if {$endrow >= $numcommits} {
5987         set endrow [expr {$numcommits - 1}]
5988     }
5989
5990     set rl1 [expr {$row - $downarrowlen - 3}]
5991     if {$rl1 < 0} {
5992         set rl1 0
5993     }
5994     set ro1 [expr {$row - 3}]
5995     if {$ro1 < 0} {
5996         set ro1 0
5997     }
5998     set r2 [expr {$endrow + $uparrowlen + 3}]
5999     if {$r2 > $numcommits} {
6000         set r2 $numcommits
6001     }
6002     for {set r $rl1} {$r < $r2} {incr r} {
6003         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6004             if {$rl1 < $r} {
6005                 layoutrows $rl1 $r
6006             }
6007             set rl1 [expr {$r + 1}]
6008         }
6009     }
6010     if {$rl1 < $r} {
6011         layoutrows $rl1 $r
6012     }
6013     optimize_rows $ro1 0 $r2
6014     if {$need_redisplay || $nrows_drawn > 2000} {
6015         clear_display
6016     }
6017
6018     # make the lines join to already-drawn rows either side
6019     set r [expr {$row - 1}]
6020     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6021         set r $row
6022     }
6023     set er [expr {$endrow + 1}]
6024     if {$er >= $numcommits ||
6025         ![info exists iddrawn([lindex $displayorder $er])]} {
6026         set er $endrow
6027     }
6028     for {} {$r <= $er} {incr r} {
6029         set id [lindex $displayorder $r]
6030         set wasdrawn [info exists iddrawn($id)]
6031         drawcmitrow $r
6032         if {$r == $er} break
6033         set nextid [lindex $displayorder [expr {$r + 1}]]
6034         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6035         drawparentlinks $id $r
6036
6037         set rowids [lindex $rowidlist $r]
6038         foreach lid $rowids {
6039             if {$lid eq {}} continue
6040             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6041             if {$lid eq $id} {
6042                 # see if this is the first child of any of its parents
6043                 foreach p [lindex $parentlist $r] {
6044                     if {[lsearch -exact $rowids $p] < 0} {
6045                         # make this line extend up to the child
6046                         set lineend($p) [drawlineseg $p $r $er 0]
6047                     }
6048                 }
6049             } else {
6050                 set lineend($lid) [drawlineseg $lid $r $er 1]
6051             }
6052         }
6053     }
6054 }
6055
6056 proc undolayout {row} {
6057     global uparrowlen mingaplen downarrowlen
6058     global rowidlist rowisopt rowfinal need_redisplay
6059
6060     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6061     if {$r < 0} {
6062         set r 0
6063     }
6064     if {[llength $rowidlist] > $r} {
6065         incr r -1
6066         set rowidlist [lrange $rowidlist 0 $r]
6067         set rowfinal [lrange $rowfinal 0 $r]
6068         set rowisopt [lrange $rowisopt 0 $r]
6069         set need_redisplay 1
6070         run drawvisible
6071     }
6072 }
6073
6074 proc drawvisible {} {
6075     global canv linespc curview vrowmod selectedline targetrow targetid
6076     global need_redisplay cscroll numcommits
6077
6078     set fs [$canv yview]
6079     set ymax [lindex [$canv cget -scrollregion] 3]
6080     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6081     set f0 [lindex $fs 0]
6082     set f1 [lindex $fs 1]
6083     set y0 [expr {int($f0 * $ymax)}]
6084     set y1 [expr {int($f1 * $ymax)}]
6085
6086     if {[info exists targetid]} {
6087         if {[commitinview $targetid $curview]} {
6088             set r [rowofcommit $targetid]
6089             if {$r != $targetrow} {
6090                 # Fix up the scrollregion and change the scrolling position
6091                 # now that our target row has moved.
6092                 set diff [expr {($r - $targetrow) * $linespc}]
6093                 set targetrow $r
6094                 setcanvscroll
6095                 set ymax [lindex [$canv cget -scrollregion] 3]
6096                 incr y0 $diff
6097                 incr y1 $diff
6098                 set f0 [expr {$y0 / $ymax}]
6099                 set f1 [expr {$y1 / $ymax}]
6100                 allcanvs yview moveto $f0
6101                 $cscroll set $f0 $f1
6102                 set need_redisplay 1
6103             }
6104         } else {
6105             unset targetid
6106         }
6107     }
6108
6109     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6110     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6111     if {$endrow >= $vrowmod($curview)} {
6112         update_arcrows $curview
6113     }
6114     if {$selectedline ne {} &&
6115         $row <= $selectedline && $selectedline <= $endrow} {
6116         set targetrow $selectedline
6117     } elseif {[info exists targetid]} {
6118         set targetrow [expr {int(($row + $endrow) / 2)}]
6119     }
6120     if {[info exists targetrow]} {
6121         if {$targetrow >= $numcommits} {
6122             set targetrow [expr {$numcommits - 1}]
6123         }
6124         set targetid [commitonrow $targetrow]
6125     }
6126     drawcommits $row $endrow
6127 }
6128
6129 proc clear_display {} {
6130     global iddrawn linesegs need_redisplay nrows_drawn
6131     global vhighlights fhighlights nhighlights rhighlights
6132     global linehtag linentag linedtag boldids boldnameids
6133
6134     allcanvs delete all
6135     catch {unset iddrawn}
6136     catch {unset linesegs}
6137     catch {unset linehtag}
6138     catch {unset linentag}
6139     catch {unset linedtag}
6140     set boldids {}
6141     set boldnameids {}
6142     catch {unset vhighlights}
6143     catch {unset fhighlights}
6144     catch {unset nhighlights}
6145     catch {unset rhighlights}
6146     set need_redisplay 0
6147     set nrows_drawn 0
6148 }
6149
6150 proc findcrossings {id} {
6151     global rowidlist parentlist numcommits displayorder
6152
6153     set cross {}
6154     set ccross {}
6155     foreach {s e} [rowranges $id] {
6156         if {$e >= $numcommits} {
6157             set e [expr {$numcommits - 1}]
6158         }
6159         if {$e <= $s} continue
6160         for {set row $e} {[incr row -1] >= $s} {} {
6161             set x [lsearch -exact [lindex $rowidlist $row] $id]
6162             if {$x < 0} break
6163             set olds [lindex $parentlist $row]
6164             set kid [lindex $displayorder $row]
6165             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6166             if {$kidx < 0} continue
6167             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6168             foreach p $olds {
6169                 set px [lsearch -exact $nextrow $p]
6170                 if {$px < 0} continue
6171                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6172                     if {[lsearch -exact $ccross $p] >= 0} continue
6173                     if {$x == $px + ($kidx < $px? -1: 1)} {
6174                         lappend ccross $p
6175                     } elseif {[lsearch -exact $cross $p] < 0} {
6176                         lappend cross $p
6177                     }
6178                 }
6179             }
6180         }
6181     }
6182     return [concat $ccross {{}} $cross]
6183 }
6184
6185 proc assigncolor {id} {
6186     global colormap colors nextcolor
6187     global parents children children curview
6188
6189     if {[info exists colormap($id)]} return
6190     set ncolors [llength $colors]
6191     if {[info exists children($curview,$id)]} {
6192         set kids $children($curview,$id)
6193     } else {
6194         set kids {}
6195     }
6196     if {[llength $kids] == 1} {
6197         set child [lindex $kids 0]
6198         if {[info exists colormap($child)]
6199             && [llength $parents($curview,$child)] == 1} {
6200             set colormap($id) $colormap($child)
6201             return
6202         }
6203     }
6204     set badcolors {}
6205     set origbad {}
6206     foreach x [findcrossings $id] {
6207         if {$x eq {}} {
6208             # delimiter between corner crossings and other crossings
6209             if {[llength $badcolors] >= $ncolors - 1} break
6210             set origbad $badcolors
6211         }
6212         if {[info exists colormap($x)]
6213             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6214             lappend badcolors $colormap($x)
6215         }
6216     }
6217     if {[llength $badcolors] >= $ncolors} {
6218         set badcolors $origbad
6219     }
6220     set origbad $badcolors
6221     if {[llength $badcolors] < $ncolors - 1} {
6222         foreach child $kids {
6223             if {[info exists colormap($child)]
6224                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6225                 lappend badcolors $colormap($child)
6226             }
6227             foreach p $parents($curview,$child) {
6228                 if {[info exists colormap($p)]
6229                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6230                     lappend badcolors $colormap($p)
6231                 }
6232             }
6233         }
6234         if {[llength $badcolors] >= $ncolors} {
6235             set badcolors $origbad
6236         }
6237     }
6238     for {set i 0} {$i <= $ncolors} {incr i} {
6239         set c [lindex $colors $nextcolor]
6240         if {[incr nextcolor] >= $ncolors} {
6241             set nextcolor 0
6242         }
6243         if {[lsearch -exact $badcolors $c]} break
6244     }
6245     set colormap($id) $c
6246 }
6247
6248 proc bindline {t id} {
6249     global canv
6250
6251     $canv bind $t <Enter> "lineenter %x %y $id"
6252     $canv bind $t <Motion> "linemotion %x %y $id"
6253     $canv bind $t <Leave> "lineleave $id"
6254     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6255 }
6256
6257 proc drawtags {id x xt y1} {
6258     global idtags idheads idotherrefs mainhead
6259     global linespc lthickness
6260     global canv rowtextx curview fgcolor bgcolor ctxbut
6261
6262     set marks {}
6263     set ntags 0
6264     set nheads 0
6265     if {[info exists idtags($id)]} {
6266         set marks $idtags($id)
6267         set ntags [llength $marks]
6268     }
6269     if {[info exists idheads($id)]} {
6270         set marks [concat $marks $idheads($id)]
6271         set nheads [llength $idheads($id)]
6272     }
6273     if {[info exists idotherrefs($id)]} {
6274         set marks [concat $marks $idotherrefs($id)]
6275     }
6276     if {$marks eq {}} {
6277         return $xt
6278     }
6279
6280     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6281     set yt [expr {$y1 - 0.5 * $linespc}]
6282     set yb [expr {$yt + $linespc - 1}]
6283     set xvals {}
6284     set wvals {}
6285     set i -1
6286     foreach tag $marks {
6287         incr i
6288         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6289             set wid [font measure mainfontbold $tag]
6290         } else {
6291             set wid [font measure mainfont $tag]
6292         }
6293         lappend xvals $xt
6294         lappend wvals $wid
6295         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6296     }
6297     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6298                -width $lthickness -fill black -tags tag.$id]
6299     $canv lower $t
6300     foreach tag $marks x $xvals wid $wvals {
6301         set tag_quoted [string map {% %%} $tag]
6302         set xl [expr {$x + $delta}]
6303         set xr [expr {$x + $delta + $wid + $lthickness}]
6304         set font mainfont
6305         if {[incr ntags -1] >= 0} {
6306             # draw a tag
6307             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6308                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6309                        -width 1 -outline black -fill yellow -tags tag.$id]
6310             $canv bind $t <1> [list showtag $tag_quoted 1]
6311             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6312         } else {
6313             # draw a head or other ref
6314             if {[incr nheads -1] >= 0} {
6315                 set col green
6316                 if {$tag eq $mainhead} {
6317                     set font mainfontbold
6318                 }
6319             } else {
6320                 set col "#ddddff"
6321             }
6322             set xl [expr {$xl - $delta/2}]
6323             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6324                 -width 1 -outline black -fill $col -tags tag.$id
6325             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6326                 set rwid [font measure mainfont $remoteprefix]
6327                 set xi [expr {$x + 1}]
6328                 set yti [expr {$yt + 1}]
6329                 set xri [expr {$x + $rwid}]
6330                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6331                         -width 0 -fill "#ffddaa" -tags tag.$id
6332             }
6333         }
6334         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6335                    -font $font -tags [list tag.$id text]]
6336         if {$ntags >= 0} {
6337             $canv bind $t <1> [list showtag $tag_quoted 1]
6338         } elseif {$nheads >= 0} {
6339             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6340         }
6341     }
6342     return $xt
6343 }
6344
6345 proc xcoord {i level ln} {
6346     global canvx0 xspc1 xspc2
6347
6348     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6349     if {$i > 0 && $i == $level} {
6350         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6351     } elseif {$i > $level} {
6352         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6353     }
6354     return $x
6355 }
6356
6357 proc show_status {msg} {
6358     global canv fgcolor
6359
6360     clear_display
6361     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6362         -tags text -fill $fgcolor
6363 }
6364
6365 # Don't change the text pane cursor if it is currently the hand cursor,
6366 # showing that we are over a sha1 ID link.
6367 proc settextcursor {c} {
6368     global ctext curtextcursor
6369
6370     if {[$ctext cget -cursor] == $curtextcursor} {
6371         $ctext config -cursor $c
6372     }
6373     set curtextcursor $c
6374 }
6375
6376 proc nowbusy {what {name {}}} {
6377     global isbusy busyname statusw
6378
6379     if {[array names isbusy] eq {}} {
6380         . config -cursor watch
6381         settextcursor watch
6382     }
6383     set isbusy($what) 1
6384     set busyname($what) $name
6385     if {$name ne {}} {
6386         $statusw conf -text $name
6387     }
6388 }
6389
6390 proc notbusy {what} {
6391     global isbusy maincursor textcursor busyname statusw
6392
6393     catch {
6394         unset isbusy($what)
6395         if {$busyname($what) ne {} &&
6396             [$statusw cget -text] eq $busyname($what)} {
6397             $statusw conf -text {}
6398         }
6399     }
6400     if {[array names isbusy] eq {}} {
6401         . config -cursor $maincursor
6402         settextcursor $textcursor
6403     }
6404 }
6405
6406 proc findmatches {f} {
6407     global findtype findstring
6408     if {$findtype == [mc "Regexp"]} {
6409         set matches [regexp -indices -all -inline $findstring $f]
6410     } else {
6411         set fs $findstring
6412         if {$findtype == [mc "IgnCase"]} {
6413             set f [string tolower $f]
6414             set fs [string tolower $fs]
6415         }
6416         set matches {}
6417         set i 0
6418         set l [string length $fs]
6419         while {[set j [string first $fs $f $i]] >= 0} {
6420             lappend matches [list $j [expr {$j+$l-1}]]
6421             set i [expr {$j + $l}]
6422         }
6423     }
6424     return $matches
6425 }
6426
6427 proc dofind {{dirn 1} {wrap 1}} {
6428     global findstring findstartline findcurline selectedline numcommits
6429     global gdttype filehighlight fh_serial find_dirn findallowwrap
6430
6431     if {[info exists find_dirn]} {
6432         if {$find_dirn == $dirn} return
6433         stopfinding
6434     }
6435     focus .
6436     if {$findstring eq {} || $numcommits == 0} return
6437     if {$selectedline eq {}} {
6438         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6439     } else {
6440         set findstartline $selectedline
6441     }
6442     set findcurline $findstartline
6443     nowbusy finding [mc "Searching"]
6444     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6445         after cancel do_file_hl $fh_serial
6446         do_file_hl $fh_serial
6447     }
6448     set find_dirn $dirn
6449     set findallowwrap $wrap
6450     run findmore
6451 }
6452
6453 proc stopfinding {} {
6454     global find_dirn findcurline fprogcoord
6455
6456     if {[info exists find_dirn]} {
6457         unset find_dirn
6458         unset findcurline
6459         notbusy finding
6460         set fprogcoord 0
6461         adjustprogress
6462     }
6463     stopblaming
6464 }
6465
6466 proc findmore {} {
6467     global commitdata commitinfo numcommits findpattern findloc
6468     global findstartline findcurline findallowwrap
6469     global find_dirn gdttype fhighlights fprogcoord
6470     global curview varcorder vrownum varccommits vrowmod
6471
6472     if {![info exists find_dirn]} {
6473         return 0
6474     }
6475     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6476     set l $findcurline
6477     set moretodo 0
6478     if {$find_dirn > 0} {
6479         incr l
6480         if {$l >= $numcommits} {
6481             set l 0
6482         }
6483         if {$l <= $findstartline} {
6484             set lim [expr {$findstartline + 1}]
6485         } else {
6486             set lim $numcommits
6487             set moretodo $findallowwrap
6488         }
6489     } else {
6490         if {$l == 0} {
6491             set l $numcommits
6492         }
6493         incr l -1
6494         if {$l >= $findstartline} {
6495             set lim [expr {$findstartline - 1}]
6496         } else {
6497             set lim -1
6498             set moretodo $findallowwrap
6499         }
6500     }
6501     set n [expr {($lim - $l) * $find_dirn}]
6502     if {$n > 500} {
6503         set n 500
6504         set moretodo 1
6505     }
6506     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6507         update_arcrows $curview
6508     }
6509     set found 0
6510     set domore 1
6511     set ai [bsearch $vrownum($curview) $l]
6512     set a [lindex $varcorder($curview) $ai]
6513     set arow [lindex $vrownum($curview) $ai]
6514     set ids [lindex $varccommits($curview,$a)]
6515     set arowend [expr {$arow + [llength $ids]}]
6516     if {$gdttype eq [mc "containing:"]} {
6517         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6518             if {$l < $arow || $l >= $arowend} {
6519                 incr ai $find_dirn
6520                 set a [lindex $varcorder($curview) $ai]
6521                 set arow [lindex $vrownum($curview) $ai]
6522                 set ids [lindex $varccommits($curview,$a)]
6523                 set arowend [expr {$arow + [llength $ids]}]
6524             }
6525             set id [lindex $ids [expr {$l - $arow}]]
6526             # shouldn't happen unless git log doesn't give all the commits...
6527             if {![info exists commitdata($id)] ||
6528                 ![doesmatch $commitdata($id)]} {
6529                 continue
6530             }
6531             if {![info exists commitinfo($id)]} {
6532                 getcommit $id
6533             }
6534             set info $commitinfo($id)
6535             foreach f $info ty $fldtypes {
6536                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6537                     [doesmatch $f]} {
6538                     set found 1
6539                     break
6540                 }
6541             }
6542             if {$found} break
6543         }
6544     } else {
6545         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6546             if {$l < $arow || $l >= $arowend} {
6547                 incr ai $find_dirn
6548                 set a [lindex $varcorder($curview) $ai]
6549                 set arow [lindex $vrownum($curview) $ai]
6550                 set ids [lindex $varccommits($curview,$a)]
6551                 set arowend [expr {$arow + [llength $ids]}]
6552             }
6553             set id [lindex $ids [expr {$l - $arow}]]
6554             if {![info exists fhighlights($id)]} {
6555                 # this sets fhighlights($id) to -1
6556                 askfilehighlight $l $id
6557             }
6558             if {$fhighlights($id) > 0} {
6559                 set found $domore
6560                 break
6561             }
6562             if {$fhighlights($id) < 0} {
6563                 if {$domore} {
6564                     set domore 0
6565                     set findcurline [expr {$l - $find_dirn}]
6566                 }
6567             }
6568         }
6569     }
6570     if {$found || ($domore && !$moretodo)} {
6571         unset findcurline
6572         unset find_dirn
6573         notbusy finding
6574         set fprogcoord 0
6575         adjustprogress
6576         if {$found} {
6577             findselectline $l
6578         } else {
6579             bell
6580         }
6581         return 0
6582     }
6583     if {!$domore} {
6584         flushhighlights
6585     } else {
6586         set findcurline [expr {$l - $find_dirn}]
6587     }
6588     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6589     if {$n < 0} {
6590         incr n $numcommits
6591     }
6592     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6593     adjustprogress
6594     return $domore
6595 }
6596
6597 proc findselectline {l} {
6598     global findloc commentend ctext findcurline markingmatches gdttype
6599
6600     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6601     set findcurline $l
6602     selectline $l 1
6603     if {$markingmatches &&
6604         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6605         # highlight the matches in the comments
6606         set f [$ctext get 1.0 $commentend]
6607         set matches [findmatches $f]
6608         foreach match $matches {
6609             set start [lindex $match 0]
6610             set end [expr {[lindex $match 1] + 1}]
6611             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6612         }
6613     }
6614     drawvisible
6615 }
6616
6617 # mark the bits of a headline or author that match a find string
6618 proc markmatches {canv l str tag matches font row} {
6619     global selectedline
6620
6621     set bbox [$canv bbox $tag]
6622     set x0 [lindex $bbox 0]
6623     set y0 [lindex $bbox 1]
6624     set y1 [lindex $bbox 3]
6625     foreach match $matches {
6626         set start [lindex $match 0]
6627         set end [lindex $match 1]
6628         if {$start > $end} continue
6629         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6630         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6631         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6632                    [expr {$x0+$xlen+2}] $y1 \
6633                    -outline {} -tags [list match$l matches] -fill yellow]
6634         $canv lower $t
6635         if {$row == $selectedline} {
6636             $canv raise $t secsel
6637         }
6638     }
6639 }
6640
6641 proc unmarkmatches {} {
6642     global markingmatches
6643
6644     allcanvs delete matches
6645     set markingmatches 0
6646     stopfinding
6647 }
6648
6649 proc selcanvline {w x y} {
6650     global canv canvy0 ctext linespc
6651     global rowtextx
6652     set ymax [lindex [$canv cget -scrollregion] 3]
6653     if {$ymax == {}} return
6654     set yfrac [lindex [$canv yview] 0]
6655     set y [expr {$y + $yfrac * $ymax}]
6656     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6657     if {$l < 0} {
6658         set l 0
6659     }
6660     if {$w eq $canv} {
6661         set xmax [lindex [$canv cget -scrollregion] 2]
6662         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6663         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6664     }
6665     unmarkmatches
6666     selectline $l 1
6667 }
6668
6669 proc commit_descriptor {p} {
6670     global commitinfo
6671     if {![info exists commitinfo($p)]} {
6672         getcommit $p
6673     }
6674     set l "..."
6675     if {[llength $commitinfo($p)] > 1} {
6676         set l [lindex $commitinfo($p) 0]
6677     }
6678     return "$p ($l)\n"
6679 }
6680
6681 # append some text to the ctext widget, and make any SHA1 ID
6682 # that we know about be a clickable link.
6683 proc appendwithlinks {text tags} {
6684     global ctext linknum curview
6685
6686     set start [$ctext index "end - 1c"]
6687     $ctext insert end $text $tags
6688     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6689     foreach l $links {
6690         set s [lindex $l 0]
6691         set e [lindex $l 1]
6692         set linkid [string range $text $s $e]
6693         incr e
6694         $ctext tag delete link$linknum
6695         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6696         setlink $linkid link$linknum
6697         incr linknum
6698     }
6699 }
6700
6701 proc setlink {id lk} {
6702     global curview ctext pendinglinks
6703
6704     set known 0
6705     if {[string length $id] < 40} {
6706         set matches [longid $id]
6707         if {[llength $matches] > 0} {
6708             if {[llength $matches] > 1} return
6709             set known 1
6710             set id [lindex $matches 0]
6711         }
6712     } else {
6713         set known [commitinview $id $curview]
6714     }
6715     if {$known} {
6716         $ctext tag conf $lk -foreground blue -underline 1
6717         $ctext tag bind $lk <1> [list selbyid $id]
6718         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6719         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6720     } else {
6721         lappend pendinglinks($id) $lk
6722         interestedin $id {makelink %P}
6723     }
6724 }
6725
6726 proc appendshortlink {id {pre {}} {post {}}} {
6727     global ctext linknum
6728
6729     $ctext insert end $pre
6730     $ctext tag delete link$linknum
6731     $ctext insert end [string range $id 0 7] link$linknum
6732     $ctext insert end $post
6733     setlink $id link$linknum
6734     incr linknum
6735 }
6736
6737 proc makelink {id} {
6738     global pendinglinks
6739
6740     if {![info exists pendinglinks($id)]} return
6741     foreach lk $pendinglinks($id) {
6742         setlink $id $lk
6743     }
6744     unset pendinglinks($id)
6745 }
6746
6747 proc linkcursor {w inc} {
6748     global linkentercount curtextcursor
6749
6750     if {[incr linkentercount $inc] > 0} {
6751         $w configure -cursor hand2
6752     } else {
6753         $w configure -cursor $curtextcursor
6754         if {$linkentercount < 0} {
6755             set linkentercount 0
6756         }
6757     }
6758 }
6759
6760 proc viewnextline {dir} {
6761     global canv linespc
6762
6763     $canv delete hover
6764     set ymax [lindex [$canv cget -scrollregion] 3]
6765     set wnow [$canv yview]
6766     set wtop [expr {[lindex $wnow 0] * $ymax}]
6767     set newtop [expr {$wtop + $dir * $linespc}]
6768     if {$newtop < 0} {
6769         set newtop 0
6770     } elseif {$newtop > $ymax} {
6771         set newtop $ymax
6772     }
6773     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6774 }
6775
6776 # add a list of tag or branch names at position pos
6777 # returns the number of names inserted
6778 proc appendrefs {pos ids var} {
6779     global ctext linknum curview $var maxrefs
6780
6781     if {[catch {$ctext index $pos}]} {
6782         return 0
6783     }
6784     $ctext conf -state normal
6785     $ctext delete $pos "$pos lineend"
6786     set tags {}
6787     foreach id $ids {
6788         foreach tag [set $var\($id\)] {
6789             lappend tags [list $tag $id]
6790         }
6791     }
6792     if {[llength $tags] > $maxrefs} {
6793         $ctext insert $pos "[mc "many"] ([llength $tags])"
6794     } else {
6795         set tags [lsort -index 0 -decreasing $tags]
6796         set sep {}
6797         foreach ti $tags {
6798             set id [lindex $ti 1]
6799             set lk link$linknum
6800             incr linknum
6801             $ctext tag delete $lk
6802             $ctext insert $pos $sep
6803             $ctext insert $pos [lindex $ti 0] $lk
6804             setlink $id $lk
6805             set sep ", "
6806         }
6807     }
6808     $ctext conf -state disabled
6809     return [llength $tags]
6810 }
6811
6812 # called when we have finished computing the nearby tags
6813 proc dispneartags {delay} {
6814     global selectedline currentid showneartags tagphase
6815
6816     if {$selectedline eq {} || !$showneartags} return
6817     after cancel dispnexttag
6818     if {$delay} {
6819         after 200 dispnexttag
6820         set tagphase -1
6821     } else {
6822         after idle dispnexttag
6823         set tagphase 0
6824     }
6825 }
6826
6827 proc dispnexttag {} {
6828     global selectedline currentid showneartags tagphase ctext
6829
6830     if {$selectedline eq {} || !$showneartags} return
6831     switch -- $tagphase {
6832         0 {
6833             set dtags [desctags $currentid]
6834             if {$dtags ne {}} {
6835                 appendrefs precedes $dtags idtags
6836             }
6837         }
6838         1 {
6839             set atags [anctags $currentid]
6840             if {$atags ne {}} {
6841                 appendrefs follows $atags idtags
6842             }
6843         }
6844         2 {
6845             set dheads [descheads $currentid]
6846             if {$dheads ne {}} {
6847                 if {[appendrefs branch $dheads idheads] > 1
6848                     && [$ctext get "branch -3c"] eq "h"} {
6849                     # turn "Branch" into "Branches"
6850                     $ctext conf -state normal
6851                     $ctext insert "branch -2c" "es"
6852                     $ctext conf -state disabled
6853                 }
6854             }
6855         }
6856     }
6857     if {[incr tagphase] <= 2} {
6858         after idle dispnexttag
6859     }
6860 }
6861
6862 proc make_secsel {id} {
6863     global linehtag linentag linedtag canv canv2 canv3
6864
6865     if {![info exists linehtag($id)]} return
6866     $canv delete secsel
6867     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6868                -tags secsel -fill [$canv cget -selectbackground]]
6869     $canv lower $t
6870     $canv2 delete secsel
6871     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6872                -tags secsel -fill [$canv2 cget -selectbackground]]
6873     $canv2 lower $t
6874     $canv3 delete secsel
6875     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6876                -tags secsel -fill [$canv3 cget -selectbackground]]
6877     $canv3 lower $t
6878 }
6879
6880 proc make_idmark {id} {
6881     global linehtag canv fgcolor
6882
6883     if {![info exists linehtag($id)]} return
6884     $canv delete markid
6885     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6886                -tags markid -outline $fgcolor]
6887     $canv raise $t
6888 }
6889
6890 proc selectline {l isnew {desired_loc {}}} {
6891     global canv ctext commitinfo selectedline
6892     global canvy0 linespc parents children curview
6893     global currentid sha1entry
6894     global commentend idtags linknum
6895     global mergemax numcommits pending_select
6896     global cmitmode showneartags allcommits
6897     global targetrow targetid lastscrollrows
6898     global autoselect autosellen jump_to_here
6899
6900     catch {unset pending_select}
6901     $canv delete hover
6902     normalline
6903     unsel_reflist
6904     stopfinding
6905     if {$l < 0 || $l >= $numcommits} return
6906     set id [commitonrow $l]
6907     set targetid $id
6908     set targetrow $l
6909     set selectedline $l
6910     set currentid $id
6911     if {$lastscrollrows < $numcommits} {
6912         setcanvscroll
6913     }
6914
6915     set y [expr {$canvy0 + $l * $linespc}]
6916     set ymax [lindex [$canv cget -scrollregion] 3]
6917     set ytop [expr {$y - $linespc - 1}]
6918     set ybot [expr {$y + $linespc + 1}]
6919     set wnow [$canv yview]
6920     set wtop [expr {[lindex $wnow 0] * $ymax}]
6921     set wbot [expr {[lindex $wnow 1] * $ymax}]
6922     set wh [expr {$wbot - $wtop}]
6923     set newtop $wtop
6924     if {$ytop < $wtop} {
6925         if {$ybot < $wtop} {
6926             set newtop [expr {$y - $wh / 2.0}]
6927         } else {
6928             set newtop $ytop
6929             if {$newtop > $wtop - $linespc} {
6930                 set newtop [expr {$wtop - $linespc}]
6931             }
6932         }
6933     } elseif {$ybot > $wbot} {
6934         if {$ytop > $wbot} {
6935             set newtop [expr {$y - $wh / 2.0}]
6936         } else {
6937             set newtop [expr {$ybot - $wh}]
6938             if {$newtop < $wtop + $linespc} {
6939                 set newtop [expr {$wtop + $linespc}]
6940             }
6941         }
6942     }
6943     if {$newtop != $wtop} {
6944         if {$newtop < 0} {
6945             set newtop 0
6946         }
6947         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6948         drawvisible
6949     }
6950
6951     make_secsel $id
6952
6953     if {$isnew} {
6954         addtohistory [list selbyid $id 0] savecmitpos
6955     }
6956
6957     $sha1entry delete 0 end
6958     $sha1entry insert 0 $id
6959     if {$autoselect} {
6960         $sha1entry selection range 0 $autosellen
6961     }
6962     rhighlight_sel $id
6963
6964     $ctext conf -state normal
6965     clear_ctext
6966     set linknum 0
6967     if {![info exists commitinfo($id)]} {
6968         getcommit $id
6969     }
6970     set info $commitinfo($id)
6971     set date [formatdate [lindex $info 2]]
6972     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6973     set date [formatdate [lindex $info 4]]
6974     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6975     if {[info exists idtags($id)]} {
6976         $ctext insert end [mc "Tags:"]
6977         foreach tag $idtags($id) {
6978             $ctext insert end " $tag"
6979         }
6980         $ctext insert end "\n"
6981     }
6982
6983     set headers {}
6984     set olds $parents($curview,$id)
6985     if {[llength $olds] > 1} {
6986         set np 0
6987         foreach p $olds {
6988             if {$np >= $mergemax} {
6989                 set tag mmax
6990             } else {
6991                 set tag m$np
6992             }
6993             $ctext insert end "[mc "Parent"]: " $tag
6994             appendwithlinks [commit_descriptor $p] {}
6995             incr np
6996         }
6997     } else {
6998         foreach p $olds {
6999             append headers "[mc "Parent"]: [commit_descriptor $p]"
7000         }
7001     }
7002
7003     foreach c $children($curview,$id) {
7004         append headers "[mc "Child"]:  [commit_descriptor $c]"
7005     }
7006
7007     # make anything that looks like a SHA1 ID be a clickable link
7008     appendwithlinks $headers {}
7009     if {$showneartags} {
7010         if {![info exists allcommits]} {
7011             getallcommits
7012         }
7013         $ctext insert end "[mc "Branch"]: "
7014         $ctext mark set branch "end -1c"
7015         $ctext mark gravity branch left
7016         $ctext insert end "\n[mc "Follows"]: "
7017         $ctext mark set follows "end -1c"
7018         $ctext mark gravity follows left
7019         $ctext insert end "\n[mc "Precedes"]: "
7020         $ctext mark set precedes "end -1c"
7021         $ctext mark gravity precedes left
7022         $ctext insert end "\n"
7023         dispneartags 1
7024     }
7025     $ctext insert end "\n"
7026     set comment [lindex $info 5]
7027     if {[string first "\r" $comment] >= 0} {
7028         set comment [string map {"\r" "\n    "} $comment]
7029     }
7030     appendwithlinks $comment {comment}
7031
7032     $ctext tag remove found 1.0 end
7033     $ctext conf -state disabled
7034     set commentend [$ctext index "end - 1c"]
7035
7036     set jump_to_here $desired_loc
7037     init_flist [mc "Comments"]
7038     if {$cmitmode eq "tree"} {
7039         gettree $id
7040     } elseif {[llength $olds] <= 1} {
7041         startdiff $id
7042     } else {
7043         mergediff $id
7044     }
7045 }
7046
7047 proc selfirstline {} {
7048     unmarkmatches
7049     selectline 0 1
7050 }
7051
7052 proc sellastline {} {
7053     global numcommits
7054     unmarkmatches
7055     set l [expr {$numcommits - 1}]
7056     selectline $l 1
7057 }
7058
7059 proc selnextline {dir} {
7060     global selectedline
7061     focus .
7062     if {$selectedline eq {}} return
7063     set l [expr {$selectedline + $dir}]
7064     unmarkmatches
7065     selectline $l 1
7066 }
7067
7068 proc selnextpage {dir} {
7069     global canv linespc selectedline numcommits
7070
7071     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7072     if {$lpp < 1} {
7073         set lpp 1
7074     }
7075     allcanvs yview scroll [expr {$dir * $lpp}] units
7076     drawvisible
7077     if {$selectedline eq {}} return
7078     set l [expr {$selectedline + $dir * $lpp}]
7079     if {$l < 0} {
7080         set l 0
7081     } elseif {$l >= $numcommits} {
7082         set l [expr $numcommits - 1]
7083     }
7084     unmarkmatches
7085     selectline $l 1
7086 }
7087
7088 proc unselectline {} {
7089     global selectedline currentid
7090
7091     set selectedline {}
7092     catch {unset currentid}
7093     allcanvs delete secsel
7094     rhighlight_none
7095 }
7096
7097 proc reselectline {} {
7098     global selectedline
7099
7100     if {$selectedline ne {}} {
7101         selectline $selectedline 0
7102     }
7103 }
7104
7105 proc addtohistory {cmd {saveproc {}}} {
7106     global history historyindex curview
7107
7108     unset_posvars
7109     save_position
7110     set elt [list $curview $cmd $saveproc {}]
7111     if {$historyindex > 0
7112         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7113         return
7114     }
7115
7116     if {$historyindex < [llength $history]} {
7117         set history [lreplace $history $historyindex end $elt]
7118     } else {
7119         lappend history $elt
7120     }
7121     incr historyindex
7122     if {$historyindex > 1} {
7123         .tf.bar.leftbut conf -state normal
7124     } else {
7125         .tf.bar.leftbut conf -state disabled
7126     }
7127     .tf.bar.rightbut conf -state disabled
7128 }
7129
7130 # save the scrolling position of the diff display pane
7131 proc save_position {} {
7132     global historyindex history
7133
7134     if {$historyindex < 1} return
7135     set hi [expr {$historyindex - 1}]
7136     set fn [lindex $history $hi 2]
7137     if {$fn ne {}} {
7138         lset history $hi 3 [eval $fn]
7139     }
7140 }
7141
7142 proc unset_posvars {} {
7143     global last_posvars
7144
7145     if {[info exists last_posvars]} {
7146         foreach {var val} $last_posvars {
7147             global $var
7148             catch {unset $var}
7149         }
7150         unset last_posvars
7151     }
7152 }
7153
7154 proc godo {elt} {
7155     global curview last_posvars
7156
7157     set view [lindex $elt 0]
7158     set cmd [lindex $elt 1]
7159     set pv [lindex $elt 3]
7160     if {$curview != $view} {
7161         showview $view
7162     }
7163     unset_posvars
7164     foreach {var val} $pv {
7165         global $var
7166         set $var $val
7167     }
7168     set last_posvars $pv
7169     eval $cmd
7170 }
7171
7172 proc goback {} {
7173     global history historyindex
7174     focus .
7175
7176     if {$historyindex > 1} {
7177         save_position
7178         incr historyindex -1
7179         godo [lindex $history [expr {$historyindex - 1}]]
7180         .tf.bar.rightbut conf -state normal
7181     }
7182     if {$historyindex <= 1} {
7183         .tf.bar.leftbut conf -state disabled
7184     }
7185 }
7186
7187 proc goforw {} {
7188     global history historyindex
7189     focus .
7190
7191     if {$historyindex < [llength $history]} {
7192         save_position
7193         set cmd [lindex $history $historyindex]
7194         incr historyindex
7195         godo $cmd
7196         .tf.bar.leftbut conf -state normal
7197     }
7198     if {$historyindex >= [llength $history]} {
7199         .tf.bar.rightbut conf -state disabled
7200     }
7201 }
7202
7203 proc gettree {id} {
7204     global treefilelist treeidlist diffids diffmergeid treepending
7205     global nullid nullid2
7206
7207     set diffids $id
7208     catch {unset diffmergeid}
7209     if {![info exists treefilelist($id)]} {
7210         if {![info exists treepending]} {
7211             if {$id eq $nullid} {
7212                 set cmd [list | git ls-files]
7213             } elseif {$id eq $nullid2} {
7214                 set cmd [list | git ls-files --stage -t]
7215             } else {
7216                 set cmd [list | git ls-tree -r $id]
7217             }
7218             if {[catch {set gtf [open $cmd r]}]} {
7219                 return
7220             }
7221             set treepending $id
7222             set treefilelist($id) {}
7223             set treeidlist($id) {}
7224             fconfigure $gtf -blocking 0 -encoding binary
7225             filerun $gtf [list gettreeline $gtf $id]
7226         }
7227     } else {
7228         setfilelist $id
7229     }
7230 }
7231
7232 proc gettreeline {gtf id} {
7233     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7234
7235     set nl 0
7236     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7237         if {$diffids eq $nullid} {
7238             set fname $line
7239         } else {
7240             set i [string first "\t" $line]
7241             if {$i < 0} continue
7242             set fname [string range $line [expr {$i+1}] end]
7243             set line [string range $line 0 [expr {$i-1}]]
7244             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7245             set sha1 [lindex $line 2]
7246             lappend treeidlist($id) $sha1
7247         }
7248         if {[string index $fname 0] eq "\""} {
7249             set fname [lindex $fname 0]
7250         }
7251         set fname [encoding convertfrom $fname]
7252         lappend treefilelist($id) $fname
7253     }
7254     if {![eof $gtf]} {
7255         return [expr {$nl >= 1000? 2: 1}]
7256     }
7257     close $gtf
7258     unset treepending
7259     if {$cmitmode ne "tree"} {
7260         if {![info exists diffmergeid]} {
7261             gettreediffs $diffids
7262         }
7263     } elseif {$id ne $diffids} {
7264         gettree $diffids
7265     } else {
7266         setfilelist $id
7267     }
7268     return 0
7269 }
7270
7271 proc showfile {f} {
7272     global treefilelist treeidlist diffids nullid nullid2
7273     global ctext_file_names ctext_file_lines
7274     global ctext commentend
7275
7276     set i [lsearch -exact $treefilelist($diffids) $f]
7277     if {$i < 0} {
7278         puts "oops, $f not in list for id $diffids"
7279         return
7280     }
7281     if {$diffids eq $nullid} {
7282         if {[catch {set bf [open $f r]} err]} {
7283             puts "oops, can't read $f: $err"
7284             return
7285         }
7286     } else {
7287         set blob [lindex $treeidlist($diffids) $i]
7288         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7289             puts "oops, error reading blob $blob: $err"
7290             return
7291         }
7292     }
7293     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7294     filerun $bf [list getblobline $bf $diffids]
7295     $ctext config -state normal
7296     clear_ctext $commentend
7297     lappend ctext_file_names $f
7298     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7299     $ctext insert end "\n"
7300     $ctext insert end "$f\n" filesep
7301     $ctext config -state disabled
7302     $ctext yview $commentend
7303     settabs 0
7304 }
7305
7306 proc getblobline {bf id} {
7307     global diffids cmitmode ctext
7308
7309     if {$id ne $diffids || $cmitmode ne "tree"} {
7310         catch {close $bf}
7311         return 0
7312     }
7313     $ctext config -state normal
7314     set nl 0
7315     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7316         $ctext insert end "$line\n"
7317     }
7318     if {[eof $bf]} {
7319         global jump_to_here ctext_file_names commentend
7320
7321         # delete last newline
7322         $ctext delete "end - 2c" "end - 1c"
7323         close $bf
7324         if {$jump_to_here ne {} &&
7325             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7326             set lnum [expr {[lindex $jump_to_here 1] +
7327                             [lindex [split $commentend .] 0]}]
7328             mark_ctext_line $lnum
7329         }
7330         $ctext config -state disabled
7331         return 0
7332     }
7333     $ctext config -state disabled
7334     return [expr {$nl >= 1000? 2: 1}]
7335 }
7336
7337 proc mark_ctext_line {lnum} {
7338     global ctext markbgcolor
7339
7340     $ctext tag delete omark
7341     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7342     $ctext tag conf omark -background $markbgcolor
7343     $ctext see $lnum.0
7344 }
7345
7346 proc mergediff {id} {
7347     global diffmergeid
7348     global diffids treediffs
7349     global parents curview
7350
7351     set diffmergeid $id
7352     set diffids $id
7353     set treediffs($id) {}
7354     set np [llength $parents($curview,$id)]
7355     settabs $np
7356     getblobdiffs $id
7357 }
7358
7359 proc startdiff {ids} {
7360     global treediffs diffids treepending diffmergeid nullid nullid2
7361
7362     settabs 1
7363     set diffids $ids
7364     catch {unset diffmergeid}
7365     if {![info exists treediffs($ids)] ||
7366         [lsearch -exact $ids $nullid] >= 0 ||
7367         [lsearch -exact $ids $nullid2] >= 0} {
7368         if {![info exists treepending]} {
7369             gettreediffs $ids
7370         }
7371     } else {
7372         addtocflist $ids
7373     }
7374 }
7375
7376 proc path_filter {filter name} {
7377     foreach p $filter {
7378         set l [string length $p]
7379         if {[string index $p end] eq "/"} {
7380             if {[string compare -length $l $p $name] == 0} {
7381                 return 1
7382             }
7383         } else {
7384             if {[string compare -length $l $p $name] == 0 &&
7385                 ([string length $name] == $l ||
7386                  [string index $name $l] eq "/")} {
7387                 return 1
7388             }
7389         }
7390     }
7391     return 0
7392 }
7393
7394 proc addtocflist {ids} {
7395     global treediffs
7396
7397     add_flist $treediffs($ids)
7398     getblobdiffs $ids
7399 }
7400
7401 proc diffcmd {ids flags} {
7402     global nullid nullid2
7403
7404     set i [lsearch -exact $ids $nullid]
7405     set j [lsearch -exact $ids $nullid2]
7406     if {$i >= 0} {
7407         if {[llength $ids] > 1 && $j < 0} {
7408             # comparing working directory with some specific revision
7409             set cmd [concat | git diff-index $flags]
7410             if {$i == 0} {
7411                 lappend cmd -R [lindex $ids 1]
7412             } else {
7413                 lappend cmd [lindex $ids 0]
7414             }
7415         } else {
7416             # comparing working directory with index
7417             set cmd [concat | git diff-files $flags]
7418             if {$j == 1} {
7419                 lappend cmd -R
7420             }
7421         }
7422     } elseif {$j >= 0} {
7423         set cmd [concat | git diff-index --cached $flags]
7424         if {[llength $ids] > 1} {
7425             # comparing index with specific revision
7426             if {$j == 0} {
7427                 lappend cmd -R [lindex $ids 1]
7428             } else {
7429                 lappend cmd [lindex $ids 0]
7430             }
7431         } else {
7432             # comparing index with HEAD
7433             lappend cmd HEAD
7434         }
7435     } else {
7436         set cmd [concat | git diff-tree -r $flags $ids]
7437     }
7438     return $cmd
7439 }
7440
7441 proc gettreediffs {ids} {
7442     global treediff treepending
7443
7444     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7445
7446     set treepending $ids
7447     set treediff {}
7448     fconfigure $gdtf -blocking 0 -encoding binary
7449     filerun $gdtf [list gettreediffline $gdtf $ids]
7450 }
7451
7452 proc gettreediffline {gdtf ids} {
7453     global treediff treediffs treepending diffids diffmergeid
7454     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7455
7456     set nr 0
7457     set sublist {}
7458     set max 1000
7459     if {$perfile_attrs} {
7460         # cache_gitattr is slow, and even slower on win32 where we
7461         # have to invoke it for only about 30 paths at a time
7462         set max 500
7463         if {[tk windowingsystem] == "win32"} {
7464             set max 120
7465         }
7466     }
7467     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7468         set i [string first "\t" $line]
7469         if {$i >= 0} {
7470             set file [string range $line [expr {$i+1}] end]
7471             if {[string index $file 0] eq "\""} {
7472                 set file [lindex $file 0]
7473             }
7474             set file [encoding convertfrom $file]
7475             if {$file ne [lindex $treediff end]} {
7476                 lappend treediff $file
7477                 lappend sublist $file
7478             }
7479         }
7480     }
7481     if {$perfile_attrs} {
7482         cache_gitattr encoding $sublist
7483     }
7484     if {![eof $gdtf]} {
7485         return [expr {$nr >= $max? 2: 1}]
7486     }
7487     close $gdtf
7488     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7489         set flist {}
7490         foreach f $treediff {
7491             if {[path_filter $vfilelimit($curview) $f]} {
7492                 lappend flist $f
7493             }
7494         }
7495         set treediffs($ids) $flist
7496     } else {
7497         set treediffs($ids) $treediff
7498     }
7499     unset treepending
7500     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7501         gettree $diffids
7502     } elseif {$ids != $diffids} {
7503         if {![info exists diffmergeid]} {
7504             gettreediffs $diffids
7505         }
7506     } else {
7507         addtocflist $ids
7508     }
7509     return 0
7510 }
7511
7512 # empty string or positive integer
7513 proc diffcontextvalidate {v} {
7514     return [regexp {^(|[1-9][0-9]*)$} $v]
7515 }
7516
7517 proc diffcontextchange {n1 n2 op} {
7518     global diffcontextstring diffcontext
7519
7520     if {[string is integer -strict $diffcontextstring]} {
7521         if {$diffcontextstring >= 0} {
7522             set diffcontext $diffcontextstring
7523             reselectline
7524         }
7525     }
7526 }
7527
7528 proc changeignorespace {} {
7529     reselectline
7530 }
7531
7532 proc changeworddiff {name ix op} {
7533     reselectline
7534 }
7535
7536 proc getblobdiffs {ids} {
7537     global blobdifffd diffids env
7538     global diffinhdr treediffs
7539     global diffcontext
7540     global ignorespace
7541     global worddiff
7542     global limitdiffs vfilelimit curview
7543     global diffencoding targetline diffnparents
7544     global git_version currdiffsubmod
7545
7546     set textconv {}
7547     if {[package vcompare $git_version "1.6.1"] >= 0} {
7548         set textconv "--textconv"
7549     }
7550     set submodule {}
7551     if {[package vcompare $git_version "1.6.6"] >= 0} {
7552         set submodule "--submodule"
7553     }
7554     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7555     if {$ignorespace} {
7556         append cmd " -w"
7557     }
7558     if {$worddiff ne [mc "Line diff"]} {
7559         append cmd " --word-diff=porcelain"
7560     }
7561     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7562         set cmd [concat $cmd -- $vfilelimit($curview)]
7563     }
7564     if {[catch {set bdf [open $cmd r]} err]} {
7565         error_popup [mc "Error getting diffs: %s" $err]
7566         return
7567     }
7568     set targetline {}
7569     set diffnparents 0
7570     set diffinhdr 0
7571     set diffencoding [get_path_encoding {}]
7572     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7573     set blobdifffd($ids) $bdf
7574     set currdiffsubmod ""
7575     filerun $bdf [list getblobdiffline $bdf $diffids]
7576 }
7577
7578 proc savecmitpos {} {
7579     global ctext cmitmode
7580
7581     if {$cmitmode eq "tree"} {
7582         return {}
7583     }
7584     return [list target_scrollpos [$ctext index @0,0]]
7585 }
7586
7587 proc savectextpos {} {
7588     global ctext
7589
7590     return [list target_scrollpos [$ctext index @0,0]]
7591 }
7592
7593 proc maybe_scroll_ctext {ateof} {
7594     global ctext target_scrollpos
7595
7596     if {![info exists target_scrollpos]} return
7597     if {!$ateof} {
7598         set nlines [expr {[winfo height $ctext]
7599                           / [font metrics textfont -linespace]}]
7600         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7601     }
7602     $ctext yview $target_scrollpos
7603     unset target_scrollpos
7604 }
7605
7606 proc setinlist {var i val} {
7607     global $var
7608
7609     while {[llength [set $var]] < $i} {
7610         lappend $var {}
7611     }
7612     if {[llength [set $var]] == $i} {
7613         lappend $var $val
7614     } else {
7615         lset $var $i $val
7616     }
7617 }
7618
7619 proc makediffhdr {fname ids} {
7620     global ctext curdiffstart treediffs diffencoding
7621     global ctext_file_names jump_to_here targetline diffline
7622
7623     set fname [encoding convertfrom $fname]
7624     set diffencoding [get_path_encoding $fname]
7625     set i [lsearch -exact $treediffs($ids) $fname]
7626     if {$i >= 0} {
7627         setinlist difffilestart $i $curdiffstart
7628     }
7629     lset ctext_file_names end $fname
7630     set l [expr {(78 - [string length $fname]) / 2}]
7631     set pad [string range "----------------------------------------" 1 $l]
7632     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7633     set targetline {}
7634     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7635         set targetline [lindex $jump_to_here 1]
7636     }
7637     set diffline 0
7638 }
7639
7640 proc getblobdiffline {bdf ids} {
7641     global diffids blobdifffd ctext curdiffstart
7642     global diffnexthead diffnextnote difffilestart
7643     global ctext_file_names ctext_file_lines
7644     global diffinhdr treediffs mergemax diffnparents
7645     global diffencoding jump_to_here targetline diffline currdiffsubmod
7646     global worddiff
7647
7648     set nr 0
7649     $ctext conf -state normal
7650     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7651         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7652             catch {close $bdf}
7653             return 0
7654         }
7655         if {![string compare -length 5 "diff " $line]} {
7656             if {![regexp {^diff (--cc|--git) } $line m type]} {
7657                 set line [encoding convertfrom $line]
7658                 $ctext insert end "$line\n" hunksep
7659                 continue
7660             }
7661             # start of a new file
7662             set diffinhdr 1
7663             $ctext insert end "\n"
7664             set curdiffstart [$ctext index "end - 1c"]
7665             lappend ctext_file_names ""
7666             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7667             $ctext insert end "\n" filesep
7668
7669             if {$type eq "--cc"} {
7670                 # start of a new file in a merge diff
7671                 set fname [string range $line 10 end]
7672                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7673                     lappend treediffs($ids) $fname
7674                     add_flist [list $fname]
7675                 }
7676
7677             } else {
7678                 set line [string range $line 11 end]
7679                 # If the name hasn't changed the length will be odd,
7680                 # the middle char will be a space, and the two bits either
7681                 # side will be a/name and b/name, or "a/name" and "b/name".
7682                 # If the name has changed we'll get "rename from" and
7683                 # "rename to" or "copy from" and "copy to" lines following
7684                 # this, and we'll use them to get the filenames.
7685                 # This complexity is necessary because spaces in the
7686                 # filename(s) don't get escaped.
7687                 set l [string length $line]
7688                 set i [expr {$l / 2}]
7689                 if {!(($l & 1) && [string index $line $i] eq " " &&
7690                       [string range $line 2 [expr {$i - 1}]] eq \
7691                           [string range $line [expr {$i + 3}] end])} {
7692                     continue
7693                 }
7694                 # unescape if quoted and chop off the a/ from the front
7695                 if {[string index $line 0] eq "\""} {
7696                     set fname [string range [lindex $line 0] 2 end]
7697                 } else {
7698                     set fname [string range $line 2 [expr {$i - 1}]]
7699                 }
7700             }
7701             makediffhdr $fname $ids
7702
7703         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7704             set fname [encoding convertfrom [string range $line 16 end]]
7705             $ctext insert end "\n"
7706             set curdiffstart [$ctext index "end - 1c"]
7707             lappend ctext_file_names $fname
7708             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7709             $ctext insert end "$line\n" filesep
7710             set i [lsearch -exact $treediffs($ids) $fname]
7711             if {$i >= 0} {
7712                 setinlist difffilestart $i $curdiffstart
7713             }
7714
7715         } elseif {![string compare -length 2 "@@" $line]} {
7716             regexp {^@@+} $line ats
7717             set line [encoding convertfrom $diffencoding $line]
7718             $ctext insert end "$line\n" hunksep
7719             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7720                 set diffline $nl
7721             }
7722             set diffnparents [expr {[string length $ats] - 1}]
7723             set diffinhdr 0
7724
7725         } elseif {![string compare -length 10 "Submodule " $line]} {
7726             # start of a new submodule
7727             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7728                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7729             } else {
7730                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7731             }
7732             if {$currdiffsubmod != $fname} {
7733                 $ctext insert end "\n";     # Add newline after commit message
7734             }
7735             set curdiffstart [$ctext index "end - 1c"]
7736             lappend ctext_file_names ""
7737             if {$currdiffsubmod != $fname} {
7738                 lappend ctext_file_lines $fname
7739                 makediffhdr $fname $ids
7740                 set currdiffsubmod $fname
7741                 $ctext insert end "\n$line\n" filesep
7742             } else {
7743                 $ctext insert end "$line\n" filesep
7744             }
7745         } elseif {![string compare -length 3 "  >" $line]} {
7746             set $currdiffsubmod ""
7747             set line [encoding convertfrom $diffencoding $line]
7748             $ctext insert end "$line\n" dresult
7749         } elseif {![string compare -length 3 "  <" $line]} {
7750             set $currdiffsubmod ""
7751             set line [encoding convertfrom $diffencoding $line]
7752             $ctext insert end "$line\n" d0
7753         } elseif {$diffinhdr} {
7754             if {![string compare -length 12 "rename from " $line]} {
7755                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7756                 if {[string index $fname 0] eq "\""} {
7757                     set fname [lindex $fname 0]
7758                 }
7759                 set fname [encoding convertfrom $fname]
7760                 set i [lsearch -exact $treediffs($ids) $fname]
7761                 if {$i >= 0} {
7762                     setinlist difffilestart $i $curdiffstart
7763                 }
7764             } elseif {![string compare -length 10 $line "rename to "] ||
7765                       ![string compare -length 8 $line "copy to "]} {
7766                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7767                 if {[string index $fname 0] eq "\""} {
7768                     set fname [lindex $fname 0]
7769                 }
7770                 makediffhdr $fname $ids
7771             } elseif {[string compare -length 3 $line "---"] == 0} {
7772                 # do nothing
7773                 continue
7774             } elseif {[string compare -length 3 $line "+++"] == 0} {
7775                 set diffinhdr 0
7776                 continue
7777             }
7778             $ctext insert end "$line\n" filesep
7779
7780         } else {
7781             set line [string map {\x1A ^Z} \
7782                           [encoding convertfrom $diffencoding $line]]
7783             # parse the prefix - one ' ', '-' or '+' for each parent
7784             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7785             set tag [expr {$diffnparents > 1? "m": "d"}]
7786             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7787             set words_pre_markup ""
7788             set words_post_markup ""
7789             if {[string trim $prefix " -+"] eq {}} {
7790                 # prefix only has " ", "-" and "+" in it: normal diff line
7791                 set num [string first "-" $prefix]
7792                 if {$dowords} {
7793                     set line [string range $line 1 end]
7794                 }
7795                 if {$num >= 0} {
7796                     # removed line, first parent with line is $num
7797                     if {$num >= $mergemax} {
7798                         set num "max"
7799                     }
7800                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7801                         $ctext insert end "\[-$line-\]" $tag$num
7802                     } else {
7803                         $ctext insert end "$line" $tag$num
7804                     }
7805                     if {!$dowords} {
7806                         $ctext insert end "\n" $tag$num
7807                     }
7808                 } else {
7809                     set tags {}
7810                     if {[string first "+" $prefix] >= 0} {
7811                         # added line
7812                         lappend tags ${tag}result
7813                         if {$diffnparents > 1} {
7814                             set num [string first " " $prefix]
7815                             if {$num >= 0} {
7816                                 if {$num >= $mergemax} {
7817                                     set num "max"
7818                                 }
7819                                 lappend tags m$num
7820                             }
7821                         }
7822                         set words_pre_markup "{+"
7823                         set words_post_markup "+}"
7824                     }
7825                     if {$targetline ne {}} {
7826                         if {$diffline == $targetline} {
7827                             set seehere [$ctext index "end - 1 chars"]
7828                             set targetline {}
7829                         } else {
7830                             incr diffline
7831                         }
7832                     }
7833                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7834                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7835                     } else {
7836                         $ctext insert end "$line" $tags
7837                     }
7838                     if {!$dowords} {
7839                         $ctext insert end "\n" $tags
7840                     }
7841                 }
7842             } elseif {$dowords && $prefix eq "~"} {
7843                 $ctext insert end "\n" {}
7844             } else {
7845                 # "\ No newline at end of file",
7846                 # or something else we don't recognize
7847                 $ctext insert end "$line\n" hunksep
7848             }
7849         }
7850     }
7851     if {[info exists seehere]} {
7852         mark_ctext_line [lindex [split $seehere .] 0]
7853     }
7854     maybe_scroll_ctext [eof $bdf]
7855     $ctext conf -state disabled
7856     if {[eof $bdf]} {
7857         catch {close $bdf}
7858         return 0
7859     }
7860     return [expr {$nr >= 1000? 2: 1}]
7861 }
7862
7863 proc changediffdisp {} {
7864     global ctext diffelide
7865
7866     $ctext tag conf d0 -elide [lindex $diffelide 0]
7867     $ctext tag conf dresult -elide [lindex $diffelide 1]
7868 }
7869
7870 proc highlightfile {loc cline} {
7871     global ctext cflist cflist_top
7872
7873     $ctext yview $loc
7874     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7875     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7876     $cflist see $cline.0
7877     set cflist_top $cline
7878 }
7879
7880 proc prevfile {} {
7881     global difffilestart ctext cmitmode
7882
7883     if {$cmitmode eq "tree"} return
7884     set prev 0.0
7885     set prevline 1
7886     set here [$ctext index @0,0]
7887     foreach loc $difffilestart {
7888         if {[$ctext compare $loc >= $here]} {
7889             highlightfile $prev $prevline
7890             return
7891         }
7892         set prev $loc
7893         incr prevline
7894     }
7895     highlightfile $prev $prevline
7896 }
7897
7898 proc nextfile {} {
7899     global difffilestart ctext cmitmode
7900
7901     if {$cmitmode eq "tree"} return
7902     set here [$ctext index @0,0]
7903     set line 1
7904     foreach loc $difffilestart {
7905         incr line
7906         if {[$ctext compare $loc > $here]} {
7907             highlightfile $loc $line
7908             return
7909         }
7910     }
7911 }
7912
7913 proc clear_ctext {{first 1.0}} {
7914     global ctext smarktop smarkbot
7915     global ctext_file_names ctext_file_lines
7916     global pendinglinks
7917
7918     set l [lindex [split $first .] 0]
7919     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7920         set smarktop $l
7921     }
7922     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7923         set smarkbot $l
7924     }
7925     $ctext delete $first end
7926     if {$first eq "1.0"} {
7927         catch {unset pendinglinks}
7928     }
7929     set ctext_file_names {}
7930     set ctext_file_lines {}
7931 }
7932
7933 proc settabs {{firstab {}}} {
7934     global firsttabstop tabstop ctext have_tk85
7935
7936     if {$firstab ne {} && $have_tk85} {
7937         set firsttabstop $firstab
7938     }
7939     set w [font measure textfont "0"]
7940     if {$firsttabstop != 0} {
7941         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7942                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7943     } elseif {$have_tk85 || $tabstop != 8} {
7944         $ctext conf -tabs [expr {$tabstop * $w}]
7945     } else {
7946         $ctext conf -tabs {}
7947     }
7948 }
7949
7950 proc incrsearch {name ix op} {
7951     global ctext searchstring searchdirn
7952
7953     $ctext tag remove found 1.0 end
7954     if {[catch {$ctext index anchor}]} {
7955         # no anchor set, use start of selection, or of visible area
7956         set sel [$ctext tag ranges sel]
7957         if {$sel ne {}} {
7958             $ctext mark set anchor [lindex $sel 0]
7959         } elseif {$searchdirn eq "-forwards"} {
7960             $ctext mark set anchor @0,0
7961         } else {
7962             $ctext mark set anchor @0,[winfo height $ctext]
7963         }
7964     }
7965     if {$searchstring ne {}} {
7966         set here [$ctext search $searchdirn -- $searchstring anchor]
7967         if {$here ne {}} {
7968             $ctext see $here
7969         }
7970         searchmarkvisible 1
7971     }
7972 }
7973
7974 proc dosearch {} {
7975     global sstring ctext searchstring searchdirn
7976
7977     focus $sstring
7978     $sstring icursor end
7979     set searchdirn -forwards
7980     if {$searchstring ne {}} {
7981         set sel [$ctext tag ranges sel]
7982         if {$sel ne {}} {
7983             set start "[lindex $sel 0] + 1c"
7984         } elseif {[catch {set start [$ctext index anchor]}]} {
7985             set start "@0,0"
7986         }
7987         set match [$ctext search -count mlen -- $searchstring $start]
7988         $ctext tag remove sel 1.0 end
7989         if {$match eq {}} {
7990             bell
7991             return
7992         }
7993         $ctext see $match
7994         set mend "$match + $mlen c"
7995         $ctext tag add sel $match $mend
7996         $ctext mark unset anchor
7997     }
7998 }
7999
8000 proc dosearchback {} {
8001     global sstring ctext searchstring searchdirn
8002
8003     focus $sstring
8004     $sstring icursor end
8005     set searchdirn -backwards
8006     if {$searchstring ne {}} {
8007         set sel [$ctext tag ranges sel]
8008         if {$sel ne {}} {
8009             set start [lindex $sel 0]
8010         } elseif {[catch {set start [$ctext index anchor]}]} {
8011             set start @0,[winfo height $ctext]
8012         }
8013         set match [$ctext search -backwards -count ml -- $searchstring $start]
8014         $ctext tag remove sel 1.0 end
8015         if {$match eq {}} {
8016             bell
8017             return
8018         }
8019         $ctext see $match
8020         set mend "$match + $ml c"
8021         $ctext tag add sel $match $mend
8022         $ctext mark unset anchor
8023     }
8024 }
8025
8026 proc searchmark {first last} {
8027     global ctext searchstring
8028
8029     set mend $first.0
8030     while {1} {
8031         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8032         if {$match eq {}} break
8033         set mend "$match + $mlen c"
8034         $ctext tag add found $match $mend
8035     }
8036 }
8037
8038 proc searchmarkvisible {doall} {
8039     global ctext smarktop smarkbot
8040
8041     set topline [lindex [split [$ctext index @0,0] .] 0]
8042     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8043     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8044         # no overlap with previous
8045         searchmark $topline $botline
8046         set smarktop $topline
8047         set smarkbot $botline
8048     } else {
8049         if {$topline < $smarktop} {
8050             searchmark $topline [expr {$smarktop-1}]
8051             set smarktop $topline
8052         }
8053         if {$botline > $smarkbot} {
8054             searchmark [expr {$smarkbot+1}] $botline
8055             set smarkbot $botline
8056         }
8057     }
8058 }
8059
8060 proc scrolltext {f0 f1} {
8061     global searchstring
8062
8063     .bleft.bottom.sb set $f0 $f1
8064     if {$searchstring ne {}} {
8065         searchmarkvisible 0
8066     }
8067 }
8068
8069 proc setcoords {} {
8070     global linespc charspc canvx0 canvy0
8071     global xspc1 xspc2 lthickness
8072
8073     set linespc [font metrics mainfont -linespace]
8074     set charspc [font measure mainfont "m"]
8075     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8076     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8077     set lthickness [expr {int($linespc / 9) + 1}]
8078     set xspc1(0) $linespc
8079     set xspc2 $linespc
8080 }
8081
8082 proc redisplay {} {
8083     global canv
8084     global selectedline
8085
8086     set ymax [lindex [$canv cget -scrollregion] 3]
8087     if {$ymax eq {} || $ymax == 0} return
8088     set span [$canv yview]
8089     clear_display
8090     setcanvscroll
8091     allcanvs yview moveto [lindex $span 0]
8092     drawvisible
8093     if {$selectedline ne {}} {
8094         selectline $selectedline 0
8095         allcanvs yview moveto [lindex $span 0]
8096     }
8097 }
8098
8099 proc parsefont {f n} {
8100     global fontattr
8101
8102     set fontattr($f,family) [lindex $n 0]
8103     set s [lindex $n 1]
8104     if {$s eq {} || $s == 0} {
8105         set s 10
8106     } elseif {$s < 0} {
8107         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8108     }
8109     set fontattr($f,size) $s
8110     set fontattr($f,weight) normal
8111     set fontattr($f,slant) roman
8112     foreach style [lrange $n 2 end] {
8113         switch -- $style {
8114             "normal" -
8115             "bold"   {set fontattr($f,weight) $style}
8116             "roman" -
8117             "italic" {set fontattr($f,slant) $style}
8118         }
8119     }
8120 }
8121
8122 proc fontflags {f {isbold 0}} {
8123     global fontattr
8124
8125     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8126                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8127                 -slant $fontattr($f,slant)]
8128 }
8129
8130 proc fontname {f} {
8131     global fontattr
8132
8133     set n [list $fontattr($f,family) $fontattr($f,size)]
8134     if {$fontattr($f,weight) eq "bold"} {
8135         lappend n "bold"
8136     }
8137     if {$fontattr($f,slant) eq "italic"} {
8138         lappend n "italic"
8139     }
8140     return $n
8141 }
8142
8143 proc incrfont {inc} {
8144     global mainfont textfont ctext canv cflist showrefstop
8145     global stopped entries fontattr
8146
8147     unmarkmatches
8148     set s $fontattr(mainfont,size)
8149     incr s $inc
8150     if {$s < 1} {
8151         set s 1
8152     }
8153     set fontattr(mainfont,size) $s
8154     font config mainfont -size $s
8155     font config mainfontbold -size $s
8156     set mainfont [fontname mainfont]
8157     set s $fontattr(textfont,size)
8158     incr s $inc
8159     if {$s < 1} {
8160         set s 1
8161     }
8162     set fontattr(textfont,size) $s
8163     font config textfont -size $s
8164     font config textfontbold -size $s
8165     set textfont [fontname textfont]
8166     setcoords
8167     settabs
8168     redisplay
8169 }
8170
8171 proc clearsha1 {} {
8172     global sha1entry sha1string
8173     if {[string length $sha1string] == 40} {
8174         $sha1entry delete 0 end
8175     }
8176 }
8177
8178 proc sha1change {n1 n2 op} {
8179     global sha1string currentid sha1but
8180     if {$sha1string == {}
8181         || ([info exists currentid] && $sha1string == $currentid)} {
8182         set state disabled
8183     } else {
8184         set state normal
8185     }
8186     if {[$sha1but cget -state] == $state} return
8187     if {$state == "normal"} {
8188         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8189     } else {
8190         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8191     }
8192 }
8193
8194 proc gotocommit {} {
8195     global sha1string tagids headids curview varcid
8196
8197     if {$sha1string == {}
8198         || ([info exists currentid] && $sha1string == $currentid)} return
8199     if {[info exists tagids($sha1string)]} {
8200         set id $tagids($sha1string)
8201     } elseif {[info exists headids($sha1string)]} {
8202         set id $headids($sha1string)
8203     } else {
8204         set id [string tolower $sha1string]
8205         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8206             set matches [longid $id]
8207             if {$matches ne {}} {
8208                 if {[llength $matches] > 1} {
8209                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8210                     return
8211                 }
8212                 set id [lindex $matches 0]
8213             }
8214         } else {
8215             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8216                 error_popup [mc "Revision %s is not known" $sha1string]
8217                 return
8218             }
8219         }
8220     }
8221     if {[commitinview $id $curview]} {
8222         selectline [rowofcommit $id] 1
8223         return
8224     }
8225     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8226         set msg [mc "SHA1 id %s is not known" $sha1string]
8227     } else {
8228         set msg [mc "Revision %s is not in the current view" $sha1string]
8229     }
8230     error_popup $msg
8231 }
8232
8233 proc lineenter {x y id} {
8234     global hoverx hovery hoverid hovertimer
8235     global commitinfo canv
8236
8237     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8238     set hoverx $x
8239     set hovery $y
8240     set hoverid $id
8241     if {[info exists hovertimer]} {
8242         after cancel $hovertimer
8243     }
8244     set hovertimer [after 500 linehover]
8245     $canv delete hover
8246 }
8247
8248 proc linemotion {x y id} {
8249     global hoverx hovery hoverid hovertimer
8250
8251     if {[info exists hoverid] && $id == $hoverid} {
8252         set hoverx $x
8253         set hovery $y
8254         if {[info exists hovertimer]} {
8255             after cancel $hovertimer
8256         }
8257         set hovertimer [after 500 linehover]
8258     }
8259 }
8260
8261 proc lineleave {id} {
8262     global hoverid hovertimer canv
8263
8264     if {[info exists hoverid] && $id == $hoverid} {
8265         $canv delete hover
8266         if {[info exists hovertimer]} {
8267             after cancel $hovertimer
8268             unset hovertimer
8269         }
8270         unset hoverid
8271     }
8272 }
8273
8274 proc linehover {} {
8275     global hoverx hovery hoverid hovertimer
8276     global canv linespc lthickness
8277     global commitinfo
8278
8279     set text [lindex $commitinfo($hoverid) 0]
8280     set ymax [lindex [$canv cget -scrollregion] 3]
8281     if {$ymax == {}} return
8282     set yfrac [lindex [$canv yview] 0]
8283     set x [expr {$hoverx + 2 * $linespc}]
8284     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8285     set x0 [expr {$x - 2 * $lthickness}]
8286     set y0 [expr {$y - 2 * $lthickness}]
8287     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8288     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8289     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8290                -fill \#ffff80 -outline black -width 1 -tags hover]
8291     $canv raise $t
8292     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8293                -font mainfont]
8294     $canv raise $t
8295 }
8296
8297 proc clickisonarrow {id y} {
8298     global lthickness
8299
8300     set ranges [rowranges $id]
8301     set thresh [expr {2 * $lthickness + 6}]
8302     set n [expr {[llength $ranges] - 1}]
8303     for {set i 1} {$i < $n} {incr i} {
8304         set row [lindex $ranges $i]
8305         if {abs([yc $row] - $y) < $thresh} {
8306             return $i
8307         }
8308     }
8309     return {}
8310 }
8311
8312 proc arrowjump {id n y} {
8313     global canv
8314
8315     # 1 <-> 2, 3 <-> 4, etc...
8316     set n [expr {(($n - 1) ^ 1) + 1}]
8317     set row [lindex [rowranges $id] $n]
8318     set yt [yc $row]
8319     set ymax [lindex [$canv cget -scrollregion] 3]
8320     if {$ymax eq {} || $ymax <= 0} return
8321     set view [$canv yview]
8322     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8323     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8324     if {$yfrac < 0} {
8325         set yfrac 0
8326     }
8327     allcanvs yview moveto $yfrac
8328 }
8329
8330 proc lineclick {x y id isnew} {
8331     global ctext commitinfo children canv thickerline curview
8332
8333     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8334     unmarkmatches
8335     unselectline
8336     normalline
8337     $canv delete hover
8338     # draw this line thicker than normal
8339     set thickerline $id
8340     drawlines $id
8341     if {$isnew} {
8342         set ymax [lindex [$canv cget -scrollregion] 3]
8343         if {$ymax eq {}} return
8344         set yfrac [lindex [$canv yview] 0]
8345         set y [expr {$y + $yfrac * $ymax}]
8346     }
8347     set dirn [clickisonarrow $id $y]
8348     if {$dirn ne {}} {
8349         arrowjump $id $dirn $y
8350         return
8351     }
8352
8353     if {$isnew} {
8354         addtohistory [list lineclick $x $y $id 0] savectextpos
8355     }
8356     # fill the details pane with info about this line
8357     $ctext conf -state normal
8358     clear_ctext
8359     settabs 0
8360     $ctext insert end "[mc "Parent"]:\t"
8361     $ctext insert end $id link0
8362     setlink $id link0
8363     set info $commitinfo($id)
8364     $ctext insert end "\n\t[lindex $info 0]\n"
8365     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8366     set date [formatdate [lindex $info 2]]
8367     $ctext insert end "\t[mc "Date"]:\t$date\n"
8368     set kids $children($curview,$id)
8369     if {$kids ne {}} {
8370         $ctext insert end "\n[mc "Children"]:"
8371         set i 0
8372         foreach child $kids {
8373             incr i
8374             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8375             set info $commitinfo($child)
8376             $ctext insert end "\n\t"
8377             $ctext insert end $child link$i
8378             setlink $child link$i
8379             $ctext insert end "\n\t[lindex $info 0]"
8380             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8381             set date [formatdate [lindex $info 2]]
8382             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8383         }
8384     }
8385     maybe_scroll_ctext 1
8386     $ctext conf -state disabled
8387     init_flist {}
8388 }
8389
8390 proc normalline {} {
8391     global thickerline
8392     if {[info exists thickerline]} {
8393         set id $thickerline
8394         unset thickerline
8395         drawlines $id
8396     }
8397 }
8398
8399 proc selbyid {id {isnew 1}} {
8400     global curview
8401     if {[commitinview $id $curview]} {
8402         selectline [rowofcommit $id] $isnew
8403     }
8404 }
8405
8406 proc mstime {} {
8407     global startmstime
8408     if {![info exists startmstime]} {
8409         set startmstime [clock clicks -milliseconds]
8410     }
8411     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8412 }
8413
8414 proc rowmenu {x y id} {
8415     global rowctxmenu selectedline rowmenuid curview
8416     global nullid nullid2 fakerowmenu mainhead markedid
8417
8418     stopfinding
8419     set rowmenuid $id
8420     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8421         set state disabled
8422     } else {
8423         set state normal
8424     }
8425     if {$id ne $nullid && $id ne $nullid2} {
8426         set menu $rowctxmenu
8427         if {$mainhead ne {}} {
8428             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8429         } else {
8430             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8431         }
8432         if {[info exists markedid] && $markedid ne $id} {
8433             $menu entryconfigure 9 -state normal
8434             $menu entryconfigure 10 -state normal
8435             $menu entryconfigure 11 -state normal
8436         } else {
8437             $menu entryconfigure 9 -state disabled
8438             $menu entryconfigure 10 -state disabled
8439             $menu entryconfigure 11 -state disabled
8440         }
8441     } else {
8442         set menu $fakerowmenu
8443     }
8444     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8445     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8446     $menu entryconfigure [mca "Make patch"] -state $state
8447     tk_popup $menu $x $y
8448 }
8449
8450 proc markhere {} {
8451     global rowmenuid markedid canv
8452
8453     set markedid $rowmenuid
8454     make_idmark $markedid
8455 }
8456
8457 proc gotomark {} {
8458     global markedid
8459
8460     if {[info exists markedid]} {
8461         selbyid $markedid
8462     }
8463 }
8464
8465 proc replace_by_kids {l r} {
8466     global curview children
8467
8468     set id [commitonrow $r]
8469     set l [lreplace $l 0 0]
8470     foreach kid $children($curview,$id) {
8471         lappend l [rowofcommit $kid]
8472     }
8473     return [lsort -integer -decreasing -unique $l]
8474 }
8475
8476 proc find_common_desc {} {
8477     global markedid rowmenuid curview children
8478
8479     if {![info exists markedid]} return
8480     if {![commitinview $markedid $curview] ||
8481         ![commitinview $rowmenuid $curview]} return
8482     #set t1 [clock clicks -milliseconds]
8483     set l1 [list [rowofcommit $markedid]]
8484     set l2 [list [rowofcommit $rowmenuid]]
8485     while 1 {
8486         set r1 [lindex $l1 0]
8487         set r2 [lindex $l2 0]
8488         if {$r1 eq {} || $r2 eq {}} break
8489         if {$r1 == $r2} {
8490             selectline $r1 1
8491             break
8492         }
8493         if {$r1 > $r2} {
8494             set l1 [replace_by_kids $l1 $r1]
8495         } else {
8496             set l2 [replace_by_kids $l2 $r2]
8497         }
8498     }
8499     #set t2 [clock clicks -milliseconds]
8500     #puts "took [expr {$t2-$t1}]ms"
8501 }
8502
8503 proc compare_commits {} {
8504     global markedid rowmenuid curview children
8505
8506     if {![info exists markedid]} return
8507     if {![commitinview $markedid $curview]} return
8508     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8509     do_cmp_commits $markedid $rowmenuid
8510 }
8511
8512 proc getpatchid {id} {
8513     global patchids
8514
8515     if {![info exists patchids($id)]} {
8516         set cmd [diffcmd [list $id] {-p --root}]
8517         # trim off the initial "|"
8518         set cmd [lrange $cmd 1 end]
8519         if {[catch {
8520             set x [eval exec $cmd | git patch-id]
8521             set patchids($id) [lindex $x 0]
8522         }]} {
8523             set patchids($id) "error"
8524         }
8525     }
8526     return $patchids($id)
8527 }
8528
8529 proc do_cmp_commits {a b} {
8530     global ctext curview parents children patchids commitinfo
8531
8532     $ctext conf -state normal
8533     clear_ctext
8534     init_flist {}
8535     for {set i 0} {$i < 100} {incr i} {
8536         set skipa 0
8537         set skipb 0
8538         if {[llength $parents($curview,$a)] > 1} {
8539             appendshortlink $a [mc "Skipping merge commit "] "\n"
8540             set skipa 1
8541         } else {
8542             set patcha [getpatchid $a]
8543         }
8544         if {[llength $parents($curview,$b)] > 1} {
8545             appendshortlink $b [mc "Skipping merge commit "] "\n"
8546             set skipb 1
8547         } else {
8548             set patchb [getpatchid $b]
8549         }
8550         if {!$skipa && !$skipb} {
8551             set heada [lindex $commitinfo($a) 0]
8552             set headb [lindex $commitinfo($b) 0]
8553             if {$patcha eq "error"} {
8554                 appendshortlink $a [mc "Error getting patch ID for "] \
8555                     [mc " - stopping\n"]
8556                 break
8557             }
8558             if {$patchb eq "error"} {
8559                 appendshortlink $b [mc "Error getting patch ID for "] \
8560                     [mc " - stopping\n"]
8561                 break
8562             }
8563             if {$patcha eq $patchb} {
8564                 if {$heada eq $headb} {
8565                     appendshortlink $a [mc "Commit "]
8566                     appendshortlink $b " == " "  $heada\n"
8567                 } else {
8568                     appendshortlink $a [mc "Commit "] "  $heada\n"
8569                     appendshortlink $b [mc " is the same patch as\n       "] \
8570                         "  $headb\n"
8571                 }
8572                 set skipa 1
8573                 set skipb 1
8574             } else {
8575                 $ctext insert end "\n"
8576                 appendshortlink $a [mc "Commit "] "  $heada\n"
8577                 appendshortlink $b [mc " differs from\n       "] \
8578                     "  $headb\n"
8579                 $ctext insert end [mc "Diff of commits:\n\n"]
8580                 $ctext conf -state disabled
8581                 update
8582                 diffcommits $a $b
8583                 return
8584             }
8585         }
8586         if {$skipa} {
8587             set kids [real_children $curview,$a]
8588             if {[llength $kids] != 1} {
8589                 $ctext insert end "\n"
8590                 appendshortlink $a [mc "Commit "] \
8591                     [mc " has %s children - stopping\n" [llength $kids]]
8592                 break
8593             }
8594             set a [lindex $kids 0]
8595         }
8596         if {$skipb} {
8597             set kids [real_children $curview,$b]
8598             if {[llength $kids] != 1} {
8599                 appendshortlink $b [mc "Commit "] \
8600                     [mc " has %s children - stopping\n" [llength $kids]]
8601                 break
8602             }
8603             set b [lindex $kids 0]
8604         }
8605     }
8606     $ctext conf -state disabled
8607 }
8608
8609 proc diffcommits {a b} {
8610     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8611
8612     set tmpdir [gitknewtmpdir]
8613     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8614     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8615     if {[catch {
8616         exec git diff-tree -p --pretty $a >$fna
8617         exec git diff-tree -p --pretty $b >$fnb
8618     } err]} {
8619         error_popup [mc "Error writing commit to file: %s" $err]
8620         return
8621     }
8622     if {[catch {
8623         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8624     } err]} {
8625         error_popup [mc "Error diffing commits: %s" $err]
8626         return
8627     }
8628     set diffids [list commits $a $b]
8629     set blobdifffd($diffids) $fd
8630     set diffinhdr 0
8631     set currdiffsubmod ""
8632     filerun $fd [list getblobdiffline $fd $diffids]
8633 }
8634
8635 proc diffvssel {dirn} {
8636     global rowmenuid selectedline
8637
8638     if {$selectedline eq {}} return
8639     if {$dirn} {
8640         set oldid [commitonrow $selectedline]
8641         set newid $rowmenuid
8642     } else {
8643         set oldid $rowmenuid
8644         set newid [commitonrow $selectedline]
8645     }
8646     addtohistory [list doseldiff $oldid $newid] savectextpos
8647     doseldiff $oldid $newid
8648 }
8649
8650 proc doseldiff {oldid newid} {
8651     global ctext
8652     global commitinfo
8653
8654     $ctext conf -state normal
8655     clear_ctext
8656     init_flist [mc "Top"]
8657     $ctext insert end "[mc "From"] "
8658     $ctext insert end $oldid link0
8659     setlink $oldid link0
8660     $ctext insert end "\n     "
8661     $ctext insert end [lindex $commitinfo($oldid) 0]
8662     $ctext insert end "\n\n[mc "To"]   "
8663     $ctext insert end $newid link1
8664     setlink $newid link1
8665     $ctext insert end "\n     "
8666     $ctext insert end [lindex $commitinfo($newid) 0]
8667     $ctext insert end "\n"
8668     $ctext conf -state disabled
8669     $ctext tag remove found 1.0 end
8670     startdiff [list $oldid $newid]
8671 }
8672
8673 proc mkpatch {} {
8674     global rowmenuid currentid commitinfo patchtop patchnum NS
8675
8676     if {![info exists currentid]} return
8677     set oldid $currentid
8678     set oldhead [lindex $commitinfo($oldid) 0]
8679     set newid $rowmenuid
8680     set newhead [lindex $commitinfo($newid) 0]
8681     set top .patch
8682     set patchtop $top
8683     catch {destroy $top}
8684     ttk_toplevel $top
8685     make_transient $top .
8686     ${NS}::label $top.title -text [mc "Generate patch"]
8687     grid $top.title - -pady 10
8688     ${NS}::label $top.from -text [mc "From:"]
8689     ${NS}::entry $top.fromsha1 -width 40
8690     $top.fromsha1 insert 0 $oldid
8691     $top.fromsha1 conf -state readonly
8692     grid $top.from $top.fromsha1 -sticky w
8693     ${NS}::entry $top.fromhead -width 60
8694     $top.fromhead insert 0 $oldhead
8695     $top.fromhead conf -state readonly
8696     grid x $top.fromhead -sticky w
8697     ${NS}::label $top.to -text [mc "To:"]
8698     ${NS}::entry $top.tosha1 -width 40
8699     $top.tosha1 insert 0 $newid
8700     $top.tosha1 conf -state readonly
8701     grid $top.to $top.tosha1 -sticky w
8702     ${NS}::entry $top.tohead -width 60
8703     $top.tohead insert 0 $newhead
8704     $top.tohead conf -state readonly
8705     grid x $top.tohead -sticky w
8706     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8707     grid $top.rev x -pady 10 -padx 5
8708     ${NS}::label $top.flab -text [mc "Output file:"]
8709     ${NS}::entry $top.fname -width 60
8710     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8711     incr patchnum
8712     grid $top.flab $top.fname -sticky w
8713     ${NS}::frame $top.buts
8714     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8715     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8716     bind $top <Key-Return> mkpatchgo
8717     bind $top <Key-Escape> mkpatchcan
8718     grid $top.buts.gen $top.buts.can
8719     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8720     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8721     grid $top.buts - -pady 10 -sticky ew
8722     focus $top.fname
8723 }
8724
8725 proc mkpatchrev {} {
8726     global patchtop
8727
8728     set oldid [$patchtop.fromsha1 get]
8729     set oldhead [$patchtop.fromhead get]
8730     set newid [$patchtop.tosha1 get]
8731     set newhead [$patchtop.tohead get]
8732     foreach e [list fromsha1 fromhead tosha1 tohead] \
8733             v [list $newid $newhead $oldid $oldhead] {
8734         $patchtop.$e conf -state normal
8735         $patchtop.$e delete 0 end
8736         $patchtop.$e insert 0 $v
8737         $patchtop.$e conf -state readonly
8738     }
8739 }
8740
8741 proc mkpatchgo {} {
8742     global patchtop nullid nullid2
8743
8744     set oldid [$patchtop.fromsha1 get]
8745     set newid [$patchtop.tosha1 get]
8746     set fname [$patchtop.fname get]
8747     set cmd [diffcmd [list $oldid $newid] -p]
8748     # trim off the initial "|"
8749     set cmd [lrange $cmd 1 end]
8750     lappend cmd >$fname &
8751     if {[catch {eval exec $cmd} err]} {
8752         error_popup "[mc "Error creating patch:"] $err" $patchtop
8753     }
8754     catch {destroy $patchtop}
8755     unset patchtop
8756 }
8757
8758 proc mkpatchcan {} {
8759     global patchtop
8760
8761     catch {destroy $patchtop}
8762     unset patchtop
8763 }
8764
8765 proc mktag {} {
8766     global rowmenuid mktagtop commitinfo NS
8767
8768     set top .maketag
8769     set mktagtop $top
8770     catch {destroy $top}
8771     ttk_toplevel $top
8772     make_transient $top .
8773     ${NS}::label $top.title -text [mc "Create tag"]
8774     grid $top.title - -pady 10
8775     ${NS}::label $top.id -text [mc "ID:"]
8776     ${NS}::entry $top.sha1 -width 40
8777     $top.sha1 insert 0 $rowmenuid
8778     $top.sha1 conf -state readonly
8779     grid $top.id $top.sha1 -sticky w
8780     ${NS}::entry $top.head -width 60
8781     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8782     $top.head conf -state readonly
8783     grid x $top.head -sticky w
8784     ${NS}::label $top.tlab -text [mc "Tag name:"]
8785     ${NS}::entry $top.tag -width 60
8786     grid $top.tlab $top.tag -sticky w
8787     ${NS}::label $top.op -text [mc "Tag message is optional"]
8788     grid $top.op -columnspan 2 -sticky we
8789     ${NS}::label $top.mlab -text [mc "Tag message:"]
8790     ${NS}::entry $top.msg -width 60
8791     grid $top.mlab $top.msg -sticky w
8792     ${NS}::frame $top.buts
8793     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8794     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8795     bind $top <Key-Return> mktaggo
8796     bind $top <Key-Escape> mktagcan
8797     grid $top.buts.gen $top.buts.can
8798     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8799     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8800     grid $top.buts - -pady 10 -sticky ew
8801     focus $top.tag
8802 }
8803
8804 proc domktag {} {
8805     global mktagtop env tagids idtags
8806
8807     set id [$mktagtop.sha1 get]
8808     set tag [$mktagtop.tag get]
8809     set msg [$mktagtop.msg get]
8810     if {$tag == {}} {
8811         error_popup [mc "No tag name specified"] $mktagtop
8812         return 0
8813     }
8814     if {[info exists tagids($tag)]} {
8815         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8816         return 0
8817     }
8818     if {[catch {
8819         if {$msg != {}} {
8820             exec git tag -a -m $msg $tag $id
8821         } else {
8822             exec git tag $tag $id
8823         }
8824     } err]} {
8825         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8826         return 0
8827     }
8828
8829     set tagids($tag) $id
8830     lappend idtags($id) $tag
8831     redrawtags $id
8832     addedtag $id
8833     dispneartags 0
8834     run refill_reflist
8835     return 1
8836 }
8837
8838 proc redrawtags {id} {
8839     global canv linehtag idpos currentid curview cmitlisted markedid
8840     global canvxmax iddrawn circleitem mainheadid circlecolors
8841
8842     if {![commitinview $id $curview]} return
8843     if {![info exists iddrawn($id)]} return
8844     set row [rowofcommit $id]
8845     if {$id eq $mainheadid} {
8846         set ofill yellow
8847     } else {
8848         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8849     }
8850     $canv itemconf $circleitem($row) -fill $ofill
8851     $canv delete tag.$id
8852     set xt [eval drawtags $id $idpos($id)]
8853     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8854     set text [$canv itemcget $linehtag($id) -text]
8855     set font [$canv itemcget $linehtag($id) -font]
8856     set xr [expr {$xt + [font measure $font $text]}]
8857     if {$xr > $canvxmax} {
8858         set canvxmax $xr
8859         setcanvscroll
8860     }
8861     if {[info exists currentid] && $currentid == $id} {
8862         make_secsel $id
8863     }
8864     if {[info exists markedid] && $markedid eq $id} {
8865         make_idmark $id
8866     }
8867 }
8868
8869 proc mktagcan {} {
8870     global mktagtop
8871
8872     catch {destroy $mktagtop}
8873     unset mktagtop
8874 }
8875
8876 proc mktaggo {} {
8877     if {![domktag]} return
8878     mktagcan
8879 }
8880
8881 proc writecommit {} {
8882     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8883
8884     set top .writecommit
8885     set wrcomtop $top
8886     catch {destroy $top}
8887     ttk_toplevel $top
8888     make_transient $top .
8889     ${NS}::label $top.title -text [mc "Write commit to file"]
8890     grid $top.title - -pady 10
8891     ${NS}::label $top.id -text [mc "ID:"]
8892     ${NS}::entry $top.sha1 -width 40
8893     $top.sha1 insert 0 $rowmenuid
8894     $top.sha1 conf -state readonly
8895     grid $top.id $top.sha1 -sticky w
8896     ${NS}::entry $top.head -width 60
8897     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8898     $top.head conf -state readonly
8899     grid x $top.head -sticky w
8900     ${NS}::label $top.clab -text [mc "Command:"]
8901     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8902     grid $top.clab $top.cmd -sticky w -pady 10
8903     ${NS}::label $top.flab -text [mc "Output file:"]
8904     ${NS}::entry $top.fname -width 60
8905     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8906     grid $top.flab $top.fname -sticky w
8907     ${NS}::frame $top.buts
8908     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8909     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8910     bind $top <Key-Return> wrcomgo
8911     bind $top <Key-Escape> wrcomcan
8912     grid $top.buts.gen $top.buts.can
8913     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8914     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8915     grid $top.buts - -pady 10 -sticky ew
8916     focus $top.fname
8917 }
8918
8919 proc wrcomgo {} {
8920     global wrcomtop
8921
8922     set id [$wrcomtop.sha1 get]
8923     set cmd "echo $id | [$wrcomtop.cmd get]"
8924     set fname [$wrcomtop.fname get]
8925     if {[catch {exec sh -c $cmd >$fname &} err]} {
8926         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8927     }
8928     catch {destroy $wrcomtop}
8929     unset wrcomtop
8930 }
8931
8932 proc wrcomcan {} {
8933     global wrcomtop
8934
8935     catch {destroy $wrcomtop}
8936     unset wrcomtop
8937 }
8938
8939 proc mkbranch {} {
8940     global rowmenuid mkbrtop NS
8941
8942     set top .makebranch
8943     catch {destroy $top}
8944     ttk_toplevel $top
8945     make_transient $top .
8946     ${NS}::label $top.title -text [mc "Create new branch"]
8947     grid $top.title - -pady 10
8948     ${NS}::label $top.id -text [mc "ID:"]
8949     ${NS}::entry $top.sha1 -width 40
8950     $top.sha1 insert 0 $rowmenuid
8951     $top.sha1 conf -state readonly
8952     grid $top.id $top.sha1 -sticky w
8953     ${NS}::label $top.nlab -text [mc "Name:"]
8954     ${NS}::entry $top.name -width 40
8955     grid $top.nlab $top.name -sticky w
8956     ${NS}::frame $top.buts
8957     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8958     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8959     bind $top <Key-Return> [list mkbrgo $top]
8960     bind $top <Key-Escape> "catch {destroy $top}"
8961     grid $top.buts.go $top.buts.can
8962     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8963     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8964     grid $top.buts - -pady 10 -sticky ew
8965     focus $top.name
8966 }
8967
8968 proc mkbrgo {top} {
8969     global headids idheads
8970
8971     set name [$top.name get]
8972     set id [$top.sha1 get]
8973     set cmdargs {}
8974     set old_id {}
8975     if {$name eq {}} {
8976         error_popup [mc "Please specify a name for the new branch"] $top
8977         return
8978     }
8979     if {[info exists headids($name)]} {
8980         if {![confirm_popup [mc \
8981                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8982             return
8983         }
8984         set old_id $headids($name)
8985         lappend cmdargs -f
8986     }
8987     catch {destroy $top}
8988     lappend cmdargs $name $id
8989     nowbusy newbranch
8990     update
8991     if {[catch {
8992         eval exec git branch $cmdargs
8993     } err]} {
8994         notbusy newbranch
8995         error_popup $err
8996     } else {
8997         notbusy newbranch
8998         if {$old_id ne {}} {
8999             movehead $id $name
9000             movedhead $id $name
9001             redrawtags $old_id
9002             redrawtags $id
9003         } else {
9004             set headids($name) $id
9005             lappend idheads($id) $name
9006             addedhead $id $name
9007             redrawtags $id
9008         }
9009         dispneartags 0
9010         run refill_reflist
9011     }
9012 }
9013
9014 proc exec_citool {tool_args {baseid {}}} {
9015     global commitinfo env
9016
9017     set save_env [array get env GIT_AUTHOR_*]
9018
9019     if {$baseid ne {}} {
9020         if {![info exists commitinfo($baseid)]} {
9021             getcommit $baseid
9022         }
9023         set author [lindex $commitinfo($baseid) 1]
9024         set date [lindex $commitinfo($baseid) 2]
9025         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9026                     $author author name email]
9027             && $date ne {}} {
9028             set env(GIT_AUTHOR_NAME) $name
9029             set env(GIT_AUTHOR_EMAIL) $email
9030             set env(GIT_AUTHOR_DATE) $date
9031         }
9032     }
9033
9034     eval exec git citool $tool_args &
9035
9036     array unset env GIT_AUTHOR_*
9037     array set env $save_env
9038 }
9039
9040 proc cherrypick {} {
9041     global rowmenuid curview
9042     global mainhead mainheadid
9043
9044     set oldhead [exec git rev-parse HEAD]
9045     set dheads [descheads $rowmenuid]
9046     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9047         set ok [confirm_popup [mc "Commit %s is already\
9048                 included in branch %s -- really re-apply it?" \
9049                                    [string range $rowmenuid 0 7] $mainhead]]
9050         if {!$ok} return
9051     }
9052     nowbusy cherrypick [mc "Cherry-picking"]
9053     update
9054     # Unfortunately git-cherry-pick writes stuff to stderr even when
9055     # no error occurs, and exec takes that as an indication of error...
9056     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9057         notbusy cherrypick
9058         if {[regexp -line \
9059                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9060                  $err msg fname]} {
9061             error_popup [mc "Cherry-pick failed because of local changes\
9062                         to file '%s'.\nPlease commit, reset or stash\
9063                         your changes and try again." $fname]
9064         } elseif {[regexp -line \
9065                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9066                        $err]} {
9067             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9068                         conflict.\nDo you wish to run git citool to\
9069                         resolve it?"]]} {
9070                 # Force citool to read MERGE_MSG
9071                 file delete [file join [gitdir] "GITGUI_MSG"]
9072                 exec_citool {} $rowmenuid
9073             }
9074         } else {
9075             error_popup $err
9076         }
9077         run updatecommits
9078         return
9079     }
9080     set newhead [exec git rev-parse HEAD]
9081     if {$newhead eq $oldhead} {
9082         notbusy cherrypick
9083         error_popup [mc "No changes committed"]
9084         return
9085     }
9086     addnewchild $newhead $oldhead
9087     if {[commitinview $oldhead $curview]} {
9088         # XXX this isn't right if we have a path limit...
9089         insertrow $newhead $oldhead $curview
9090         if {$mainhead ne {}} {
9091             movehead $newhead $mainhead
9092             movedhead $newhead $mainhead
9093         }
9094         set mainheadid $newhead
9095         redrawtags $oldhead
9096         redrawtags $newhead
9097         selbyid $newhead
9098     }
9099     notbusy cherrypick
9100 }
9101
9102 proc resethead {} {
9103     global mainhead rowmenuid confirm_ok resettype NS
9104
9105     set confirm_ok 0
9106     set w ".confirmreset"
9107     ttk_toplevel $w
9108     make_transient $w .
9109     wm title $w [mc "Confirm reset"]
9110     ${NS}::label $w.m -text \
9111         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9112     pack $w.m -side top -fill x -padx 20 -pady 20
9113     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9114     set resettype mixed
9115     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9116         -text [mc "Soft: Leave working tree and index untouched"]
9117     grid $w.f.soft -sticky w
9118     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9119         -text [mc "Mixed: Leave working tree untouched, reset index"]
9120     grid $w.f.mixed -sticky w
9121     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9122         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9123     grid $w.f.hard -sticky w
9124     pack $w.f -side top -fill x -padx 4
9125     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9126     pack $w.ok -side left -fill x -padx 20 -pady 20
9127     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9128     bind $w <Key-Escape> [list destroy $w]
9129     pack $w.cancel -side right -fill x -padx 20 -pady 20
9130     bind $w <Visibility> "grab $w; focus $w"
9131     tkwait window $w
9132     if {!$confirm_ok} return
9133     if {[catch {set fd [open \
9134             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9135         error_popup $err
9136     } else {
9137         dohidelocalchanges
9138         filerun $fd [list readresetstat $fd]
9139         nowbusy reset [mc "Resetting"]
9140         selbyid $rowmenuid
9141     }
9142 }
9143
9144 proc readresetstat {fd} {
9145     global mainhead mainheadid showlocalchanges rprogcoord
9146
9147     if {[gets $fd line] >= 0} {
9148         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9149             set rprogcoord [expr {1.0 * $m / $n}]
9150             adjustprogress
9151         }
9152         return 1
9153     }
9154     set rprogcoord 0
9155     adjustprogress
9156     notbusy reset
9157     if {[catch {close $fd} err]} {
9158         error_popup $err
9159     }
9160     set oldhead $mainheadid
9161     set newhead [exec git rev-parse HEAD]
9162     if {$newhead ne $oldhead} {
9163         movehead $newhead $mainhead
9164         movedhead $newhead $mainhead
9165         set mainheadid $newhead
9166         redrawtags $oldhead
9167         redrawtags $newhead
9168     }
9169     if {$showlocalchanges} {
9170         doshowlocalchanges
9171     }
9172     return 0
9173 }
9174
9175 # context menu for a head
9176 proc headmenu {x y id head} {
9177     global headmenuid headmenuhead headctxmenu mainhead
9178
9179     stopfinding
9180     set headmenuid $id
9181     set headmenuhead $head
9182     set state normal
9183     if {[string match "remotes/*" $head]} {
9184         set state disabled
9185     }
9186     if {$head eq $mainhead} {
9187         set state disabled
9188     }
9189     $headctxmenu entryconfigure 0 -state $state
9190     $headctxmenu entryconfigure 1 -state $state
9191     tk_popup $headctxmenu $x $y
9192 }
9193
9194 proc cobranch {} {
9195     global headmenuid headmenuhead headids
9196     global showlocalchanges
9197
9198     # check the tree is clean first??
9199     nowbusy checkout [mc "Checking out"]
9200     update
9201     dohidelocalchanges
9202     if {[catch {
9203         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9204     } err]} {
9205         notbusy checkout
9206         error_popup $err
9207         if {$showlocalchanges} {
9208             dodiffindex
9209         }
9210     } else {
9211         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9212     }
9213 }
9214
9215 proc readcheckoutstat {fd newhead newheadid} {
9216     global mainhead mainheadid headids showlocalchanges progresscoords
9217     global viewmainheadid curview
9218
9219     if {[gets $fd line] >= 0} {
9220         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9221             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9222             adjustprogress
9223         }
9224         return 1
9225     }
9226     set progresscoords {0 0}
9227     adjustprogress
9228     notbusy checkout
9229     if {[catch {close $fd} err]} {
9230         error_popup $err
9231     }
9232     set oldmainid $mainheadid
9233     set mainhead $newhead
9234     set mainheadid $newheadid
9235     set viewmainheadid($curview) $newheadid
9236     redrawtags $oldmainid
9237     redrawtags $newheadid
9238     selbyid $newheadid
9239     if {$showlocalchanges} {
9240         dodiffindex
9241     }
9242 }
9243
9244 proc rmbranch {} {
9245     global headmenuid headmenuhead mainhead
9246     global idheads
9247
9248     set head $headmenuhead
9249     set id $headmenuid
9250     # this check shouldn't be needed any more...
9251     if {$head eq $mainhead} {
9252         error_popup [mc "Cannot delete the currently checked-out branch"]
9253         return
9254     }
9255     set dheads [descheads $id]
9256     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9257         # the stuff on this branch isn't on any other branch
9258         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9259                         branch.\nReally delete branch %s?" $head $head]]} return
9260     }
9261     nowbusy rmbranch
9262     update
9263     if {[catch {exec git branch -D $head} err]} {
9264         notbusy rmbranch
9265         error_popup $err
9266         return
9267     }
9268     removehead $id $head
9269     removedhead $id $head
9270     redrawtags $id
9271     notbusy rmbranch
9272     dispneartags 0
9273     run refill_reflist
9274 }
9275
9276 # Display a list of tags and heads
9277 proc showrefs {} {
9278     global showrefstop bgcolor fgcolor selectbgcolor NS
9279     global bglist fglist reflistfilter reflist maincursor
9280
9281     set top .showrefs
9282     set showrefstop $top
9283     if {[winfo exists $top]} {
9284         raise $top
9285         refill_reflist
9286         return
9287     }
9288     ttk_toplevel $top
9289     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9290     make_transient $top .
9291     text $top.list -background $bgcolor -foreground $fgcolor \
9292         -selectbackground $selectbgcolor -font mainfont \
9293         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9294         -width 30 -height 20 -cursor $maincursor \
9295         -spacing1 1 -spacing3 1 -state disabled
9296     $top.list tag configure highlight -background $selectbgcolor
9297     lappend bglist $top.list
9298     lappend fglist $top.list
9299     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9300     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9301     grid $top.list $top.ysb -sticky nsew
9302     grid $top.xsb x -sticky ew
9303     ${NS}::frame $top.f
9304     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9305     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9306     set reflistfilter "*"
9307     trace add variable reflistfilter write reflistfilter_change
9308     pack $top.f.e -side right -fill x -expand 1
9309     pack $top.f.l -side left
9310     grid $top.f - -sticky ew -pady 2
9311     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9312     bind $top <Key-Escape> [list destroy $top]
9313     grid $top.close -
9314     grid columnconfigure $top 0 -weight 1
9315     grid rowconfigure $top 0 -weight 1
9316     bind $top.list <1> {break}
9317     bind $top.list <B1-Motion> {break}
9318     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9319     set reflist {}
9320     refill_reflist
9321 }
9322
9323 proc sel_reflist {w x y} {
9324     global showrefstop reflist headids tagids otherrefids
9325
9326     if {![winfo exists $showrefstop]} return
9327     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9328     set ref [lindex $reflist [expr {$l-1}]]
9329     set n [lindex $ref 0]
9330     switch -- [lindex $ref 1] {
9331         "H" {selbyid $headids($n)}
9332         "T" {selbyid $tagids($n)}
9333         "o" {selbyid $otherrefids($n)}
9334     }
9335     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9336 }
9337
9338 proc unsel_reflist {} {
9339     global showrefstop
9340
9341     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9342     $showrefstop.list tag remove highlight 0.0 end
9343 }
9344
9345 proc reflistfilter_change {n1 n2 op} {
9346     global reflistfilter
9347
9348     after cancel refill_reflist
9349     after 200 refill_reflist
9350 }
9351
9352 proc refill_reflist {} {
9353     global reflist reflistfilter showrefstop headids tagids otherrefids
9354     global curview
9355
9356     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9357     set refs {}
9358     foreach n [array names headids] {
9359         if {[string match $reflistfilter $n]} {
9360             if {[commitinview $headids($n) $curview]} {
9361                 lappend refs [list $n H]
9362             } else {
9363                 interestedin $headids($n) {run refill_reflist}
9364             }
9365         }
9366     }
9367     foreach n [array names tagids] {
9368         if {[string match $reflistfilter $n]} {
9369             if {[commitinview $tagids($n) $curview]} {
9370                 lappend refs [list $n T]
9371             } else {
9372                 interestedin $tagids($n) {run refill_reflist}
9373             }
9374         }
9375     }
9376     foreach n [array names otherrefids] {
9377         if {[string match $reflistfilter $n]} {
9378             if {[commitinview $otherrefids($n) $curview]} {
9379                 lappend refs [list $n o]
9380             } else {
9381                 interestedin $otherrefids($n) {run refill_reflist}
9382             }
9383         }
9384     }
9385     set refs [lsort -index 0 $refs]
9386     if {$refs eq $reflist} return
9387
9388     # Update the contents of $showrefstop.list according to the
9389     # differences between $reflist (old) and $refs (new)
9390     $showrefstop.list conf -state normal
9391     $showrefstop.list insert end "\n"
9392     set i 0
9393     set j 0
9394     while {$i < [llength $reflist] || $j < [llength $refs]} {
9395         if {$i < [llength $reflist]} {
9396             if {$j < [llength $refs]} {
9397                 set cmp [string compare [lindex $reflist $i 0] \
9398                              [lindex $refs $j 0]]
9399                 if {$cmp == 0} {
9400                     set cmp [string compare [lindex $reflist $i 1] \
9401                                  [lindex $refs $j 1]]
9402                 }
9403             } else {
9404                 set cmp -1
9405             }
9406         } else {
9407             set cmp 1
9408         }
9409         switch -- $cmp {
9410             -1 {
9411                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9412                 incr i
9413             }
9414             0 {
9415                 incr i
9416                 incr j
9417             }
9418             1 {
9419                 set l [expr {$j + 1}]
9420                 $showrefstop.list image create $l.0 -align baseline \
9421                     -image reficon-[lindex $refs $j 1] -padx 2
9422                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9423                 incr j
9424             }
9425         }
9426     }
9427     set reflist $refs
9428     # delete last newline
9429     $showrefstop.list delete end-2c end-1c
9430     $showrefstop.list conf -state disabled
9431 }
9432
9433 # Stuff for finding nearby tags
9434 proc getallcommits {} {
9435     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9436     global idheads idtags idotherrefs allparents tagobjid
9437
9438     if {![info exists allcommits]} {
9439         set nextarc 0
9440         set allcommits 0
9441         set seeds {}
9442         set allcwait 0
9443         set cachedarcs 0
9444         set allccache [file join [gitdir] "gitk.cache"]
9445         if {![catch {
9446             set f [open $allccache r]
9447             set allcwait 1
9448             getcache $f
9449         }]} return
9450     }
9451
9452     if {$allcwait} {
9453         return
9454     }
9455     set cmd [list | git rev-list --parents]
9456     set allcupdate [expr {$seeds ne {}}]
9457     if {!$allcupdate} {
9458         set ids "--all"
9459     } else {
9460         set refs [concat [array names idheads] [array names idtags] \
9461                       [array names idotherrefs]]
9462         set ids {}
9463         set tagobjs {}
9464         foreach name [array names tagobjid] {
9465             lappend tagobjs $tagobjid($name)
9466         }
9467         foreach id [lsort -unique $refs] {
9468             if {![info exists allparents($id)] &&
9469                 [lsearch -exact $tagobjs $id] < 0} {
9470                 lappend ids $id
9471             }
9472         }
9473         if {$ids ne {}} {
9474             foreach id $seeds {
9475                 lappend ids "^$id"
9476             }
9477         }
9478     }
9479     if {$ids ne {}} {
9480         set fd [open [concat $cmd $ids] r]
9481         fconfigure $fd -blocking 0
9482         incr allcommits
9483         nowbusy allcommits
9484         filerun $fd [list getallclines $fd]
9485     } else {
9486         dispneartags 0
9487     }
9488 }
9489
9490 # Since most commits have 1 parent and 1 child, we group strings of
9491 # such commits into "arcs" joining branch/merge points (BMPs), which
9492 # are commits that either don't have 1 parent or don't have 1 child.
9493 #
9494 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9495 # arcout(id) - outgoing arcs for BMP
9496 # arcids(a) - list of IDs on arc including end but not start
9497 # arcstart(a) - BMP ID at start of arc
9498 # arcend(a) - BMP ID at end of arc
9499 # growing(a) - arc a is still growing
9500 # arctags(a) - IDs out of arcids (excluding end) that have tags
9501 # archeads(a) - IDs out of arcids (excluding end) that have heads
9502 # The start of an arc is at the descendent end, so "incoming" means
9503 # coming from descendents, and "outgoing" means going towards ancestors.
9504
9505 proc getallclines {fd} {
9506     global allparents allchildren idtags idheads nextarc
9507     global arcnos arcids arctags arcout arcend arcstart archeads growing
9508     global seeds allcommits cachedarcs allcupdate
9509
9510     set nid 0
9511     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9512         set id [lindex $line 0]
9513         if {[info exists allparents($id)]} {
9514             # seen it already
9515             continue
9516         }
9517         set cachedarcs 0
9518         set olds [lrange $line 1 end]
9519         set allparents($id) $olds
9520         if {![info exists allchildren($id)]} {
9521             set allchildren($id) {}
9522             set arcnos($id) {}
9523             lappend seeds $id
9524         } else {
9525             set a $arcnos($id)
9526             if {[llength $olds] == 1 && [llength $a] == 1} {
9527                 lappend arcids($a) $id
9528                 if {[info exists idtags($id)]} {
9529                     lappend arctags($a) $id
9530                 }
9531                 if {[info exists idheads($id)]} {
9532                     lappend archeads($a) $id
9533                 }
9534                 if {[info exists allparents($olds)]} {
9535                     # seen parent already
9536                     if {![info exists arcout($olds)]} {
9537                         splitarc $olds
9538                     }
9539                     lappend arcids($a) $olds
9540                     set arcend($a) $olds
9541                     unset growing($a)
9542                 }
9543                 lappend allchildren($olds) $id
9544                 lappend arcnos($olds) $a
9545                 continue
9546             }
9547         }
9548         foreach a $arcnos($id) {
9549             lappend arcids($a) $id
9550             set arcend($a) $id
9551             unset growing($a)
9552         }
9553
9554         set ao {}
9555         foreach p $olds {
9556             lappend allchildren($p) $id
9557             set a [incr nextarc]
9558             set arcstart($a) $id
9559             set archeads($a) {}
9560             set arctags($a) {}
9561             set archeads($a) {}
9562             set arcids($a) {}
9563             lappend ao $a
9564             set growing($a) 1
9565             if {[info exists allparents($p)]} {
9566                 # seen it already, may need to make a new branch
9567                 if {![info exists arcout($p)]} {
9568                     splitarc $p
9569                 }
9570                 lappend arcids($a) $p
9571                 set arcend($a) $p
9572                 unset growing($a)
9573             }
9574             lappend arcnos($p) $a
9575         }
9576         set arcout($id) $ao
9577     }
9578     if {$nid > 0} {
9579         global cached_dheads cached_dtags cached_atags
9580         catch {unset cached_dheads}
9581         catch {unset cached_dtags}
9582         catch {unset cached_atags}
9583     }
9584     if {![eof $fd]} {
9585         return [expr {$nid >= 1000? 2: 1}]
9586     }
9587     set cacheok 1
9588     if {[catch {
9589         fconfigure $fd -blocking 1
9590         close $fd
9591     } err]} {
9592         # got an error reading the list of commits
9593         # if we were updating, try rereading the whole thing again
9594         if {$allcupdate} {
9595             incr allcommits -1
9596             dropcache $err
9597             return
9598         }
9599         error_popup "[mc "Error reading commit topology information;\
9600                 branch and preceding/following tag information\
9601                 will be incomplete."]\n($err)"
9602         set cacheok 0
9603     }
9604     if {[incr allcommits -1] == 0} {
9605         notbusy allcommits
9606         if {$cacheok} {
9607             run savecache
9608         }
9609     }
9610     dispneartags 0
9611     return 0
9612 }
9613
9614 proc recalcarc {a} {
9615     global arctags archeads arcids idtags idheads
9616
9617     set at {}
9618     set ah {}
9619     foreach id [lrange $arcids($a) 0 end-1] {
9620         if {[info exists idtags($id)]} {
9621             lappend at $id
9622         }
9623         if {[info exists idheads($id)]} {
9624             lappend ah $id
9625         }
9626     }
9627     set arctags($a) $at
9628     set archeads($a) $ah
9629 }
9630
9631 proc splitarc {p} {
9632     global arcnos arcids nextarc arctags archeads idtags idheads
9633     global arcstart arcend arcout allparents growing
9634
9635     set a $arcnos($p)
9636     if {[llength $a] != 1} {
9637         puts "oops splitarc called but [llength $a] arcs already"
9638         return
9639     }
9640     set a [lindex $a 0]
9641     set i [lsearch -exact $arcids($a) $p]
9642     if {$i < 0} {
9643         puts "oops splitarc $p not in arc $a"
9644         return
9645     }
9646     set na [incr nextarc]
9647     if {[info exists arcend($a)]} {
9648         set arcend($na) $arcend($a)
9649     } else {
9650         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9651         set j [lsearch -exact $arcnos($l) $a]
9652         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9653     }
9654     set tail [lrange $arcids($a) [expr {$i+1}] end]
9655     set arcids($a) [lrange $arcids($a) 0 $i]
9656     set arcend($a) $p
9657     set arcstart($na) $p
9658     set arcout($p) $na
9659     set arcids($na) $tail
9660     if {[info exists growing($a)]} {
9661         set growing($na) 1
9662         unset growing($a)
9663     }
9664
9665     foreach id $tail {
9666         if {[llength $arcnos($id)] == 1} {
9667             set arcnos($id) $na
9668         } else {
9669             set j [lsearch -exact $arcnos($id) $a]
9670             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9671         }
9672     }
9673
9674     # reconstruct tags and heads lists
9675     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9676         recalcarc $a
9677         recalcarc $na
9678     } else {
9679         set arctags($na) {}
9680         set archeads($na) {}
9681     }
9682 }
9683
9684 # Update things for a new commit added that is a child of one
9685 # existing commit.  Used when cherry-picking.
9686 proc addnewchild {id p} {
9687     global allparents allchildren idtags nextarc
9688     global arcnos arcids arctags arcout arcend arcstart archeads growing
9689     global seeds allcommits
9690
9691     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9692     set allparents($id) [list $p]
9693     set allchildren($id) {}
9694     set arcnos($id) {}
9695     lappend seeds $id
9696     lappend allchildren($p) $id
9697     set a [incr nextarc]
9698     set arcstart($a) $id
9699     set archeads($a) {}
9700     set arctags($a) {}
9701     set arcids($a) [list $p]
9702     set arcend($a) $p
9703     if {![info exists arcout($p)]} {
9704         splitarc $p
9705     }
9706     lappend arcnos($p) $a
9707     set arcout($id) [list $a]
9708 }
9709
9710 # This implements a cache for the topology information.
9711 # The cache saves, for each arc, the start and end of the arc,
9712 # the ids on the arc, and the outgoing arcs from the end.
9713 proc readcache {f} {
9714     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9715     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9716     global allcwait
9717
9718     set a $nextarc
9719     set lim $cachedarcs
9720     if {$lim - $a > 500} {
9721         set lim [expr {$a + 500}]
9722     }
9723     if {[catch {
9724         if {$a == $lim} {
9725             # finish reading the cache and setting up arctags, etc.
9726             set line [gets $f]
9727             if {$line ne "1"} {error "bad final version"}
9728             close $f
9729             foreach id [array names idtags] {
9730                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9731                     [llength $allparents($id)] == 1} {
9732                     set a [lindex $arcnos($id) 0]
9733                     if {$arctags($a) eq {}} {
9734                         recalcarc $a
9735                     }
9736                 }
9737             }
9738             foreach id [array names idheads] {
9739                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9740                     [llength $allparents($id)] == 1} {
9741                     set a [lindex $arcnos($id) 0]
9742                     if {$archeads($a) eq {}} {
9743                         recalcarc $a
9744                     }
9745                 }
9746             }
9747             foreach id [lsort -unique $possible_seeds] {
9748                 if {$arcnos($id) eq {}} {
9749                     lappend seeds $id
9750                 }
9751             }
9752             set allcwait 0
9753         } else {
9754             while {[incr a] <= $lim} {
9755                 set line [gets $f]
9756                 if {[llength $line] != 3} {error "bad line"}
9757                 set s [lindex $line 0]
9758                 set arcstart($a) $s
9759                 lappend arcout($s) $a
9760                 if {![info exists arcnos($s)]} {
9761                     lappend possible_seeds $s
9762                     set arcnos($s) {}
9763                 }
9764                 set e [lindex $line 1]
9765                 if {$e eq {}} {
9766                     set growing($a) 1
9767                 } else {
9768                     set arcend($a) $e
9769                     if {![info exists arcout($e)]} {
9770                         set arcout($e) {}
9771                     }
9772                 }
9773                 set arcids($a) [lindex $line 2]
9774                 foreach id $arcids($a) {
9775                     lappend allparents($s) $id
9776                     set s $id
9777                     lappend arcnos($id) $a
9778                 }
9779                 if {![info exists allparents($s)]} {
9780                     set allparents($s) {}
9781                 }
9782                 set arctags($a) {}
9783                 set archeads($a) {}
9784             }
9785             set nextarc [expr {$a - 1}]
9786         }
9787     } err]} {
9788         dropcache $err
9789         return 0
9790     }
9791     if {!$allcwait} {
9792         getallcommits
9793     }
9794     return $allcwait
9795 }
9796
9797 proc getcache {f} {
9798     global nextarc cachedarcs possible_seeds
9799
9800     if {[catch {
9801         set line [gets $f]
9802         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9803         # make sure it's an integer
9804         set cachedarcs [expr {int([lindex $line 1])}]
9805         if {$cachedarcs < 0} {error "bad number of arcs"}
9806         set nextarc 0
9807         set possible_seeds {}
9808         run readcache $f
9809     } err]} {
9810         dropcache $err
9811     }
9812     return 0
9813 }
9814
9815 proc dropcache {err} {
9816     global allcwait nextarc cachedarcs seeds
9817
9818     #puts "dropping cache ($err)"
9819     foreach v {arcnos arcout arcids arcstart arcend growing \
9820                    arctags archeads allparents allchildren} {
9821         global $v
9822         catch {unset $v}
9823     }
9824     set allcwait 0
9825     set nextarc 0
9826     set cachedarcs 0
9827     set seeds {}
9828     getallcommits
9829 }
9830
9831 proc writecache {f} {
9832     global cachearc cachedarcs allccache
9833     global arcstart arcend arcnos arcids arcout
9834
9835     set a $cachearc
9836     set lim $cachedarcs
9837     if {$lim - $a > 1000} {
9838         set lim [expr {$a + 1000}]
9839     }
9840     if {[catch {
9841         while {[incr a] <= $lim} {
9842             if {[info exists arcend($a)]} {
9843                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9844             } else {
9845                 puts $f [list $arcstart($a) {} $arcids($a)]
9846             }
9847         }
9848     } err]} {
9849         catch {close $f}
9850         catch {file delete $allccache}
9851         #puts "writing cache failed ($err)"
9852         return 0
9853     }
9854     set cachearc [expr {$a - 1}]
9855     if {$a > $cachedarcs} {
9856         puts $f "1"
9857         close $f
9858         return 0
9859     }
9860     return 1
9861 }
9862
9863 proc savecache {} {
9864     global nextarc cachedarcs cachearc allccache
9865
9866     if {$nextarc == $cachedarcs} return
9867     set cachearc 0
9868     set cachedarcs $nextarc
9869     catch {
9870         set f [open $allccache w]
9871         puts $f [list 1 $cachedarcs]
9872         run writecache $f
9873     }
9874 }
9875
9876 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9877 # or 0 if neither is true.
9878 proc anc_or_desc {a b} {
9879     global arcout arcstart arcend arcnos cached_isanc
9880
9881     if {$arcnos($a) eq $arcnos($b)} {
9882         # Both are on the same arc(s); either both are the same BMP,
9883         # or if one is not a BMP, the other is also not a BMP or is
9884         # the BMP at end of the arc (and it only has 1 incoming arc).
9885         # Or both can be BMPs with no incoming arcs.
9886         if {$a eq $b || $arcnos($a) eq {}} {
9887             return 0
9888         }
9889         # assert {[llength $arcnos($a)] == 1}
9890         set arc [lindex $arcnos($a) 0]
9891         set i [lsearch -exact $arcids($arc) $a]
9892         set j [lsearch -exact $arcids($arc) $b]
9893         if {$i < 0 || $i > $j} {
9894             return 1
9895         } else {
9896             return -1
9897         }
9898     }
9899
9900     if {![info exists arcout($a)]} {
9901         set arc [lindex $arcnos($a) 0]
9902         if {[info exists arcend($arc)]} {
9903             set aend $arcend($arc)
9904         } else {
9905             set aend {}
9906         }
9907         set a $arcstart($arc)
9908     } else {
9909         set aend $a
9910     }
9911     if {![info exists arcout($b)]} {
9912         set arc [lindex $arcnos($b) 0]
9913         if {[info exists arcend($arc)]} {
9914             set bend $arcend($arc)
9915         } else {
9916             set bend {}
9917         }
9918         set b $arcstart($arc)
9919     } else {
9920         set bend $b
9921     }
9922     if {$a eq $bend} {
9923         return 1
9924     }
9925     if {$b eq $aend} {
9926         return -1
9927     }
9928     if {[info exists cached_isanc($a,$bend)]} {
9929         if {$cached_isanc($a,$bend)} {
9930             return 1
9931         }
9932     }
9933     if {[info exists cached_isanc($b,$aend)]} {
9934         if {$cached_isanc($b,$aend)} {
9935             return -1
9936         }
9937         if {[info exists cached_isanc($a,$bend)]} {
9938             return 0
9939         }
9940     }
9941
9942     set todo [list $a $b]
9943     set anc($a) a
9944     set anc($b) b
9945     for {set i 0} {$i < [llength $todo]} {incr i} {
9946         set x [lindex $todo $i]
9947         if {$anc($x) eq {}} {
9948             continue
9949         }
9950         foreach arc $arcnos($x) {
9951             set xd $arcstart($arc)
9952             if {$xd eq $bend} {
9953                 set cached_isanc($a,$bend) 1
9954                 set cached_isanc($b,$aend) 0
9955                 return 1
9956             } elseif {$xd eq $aend} {
9957                 set cached_isanc($b,$aend) 1
9958                 set cached_isanc($a,$bend) 0
9959                 return -1
9960             }
9961             if {![info exists anc($xd)]} {
9962                 set anc($xd) $anc($x)
9963                 lappend todo $xd
9964             } elseif {$anc($xd) ne $anc($x)} {
9965                 set anc($xd) {}
9966             }
9967         }
9968     }
9969     set cached_isanc($a,$bend) 0
9970     set cached_isanc($b,$aend) 0
9971     return 0
9972 }
9973
9974 # This identifies whether $desc has an ancestor that is
9975 # a growing tip of the graph and which is not an ancestor of $anc
9976 # and returns 0 if so and 1 if not.
9977 # If we subsequently discover a tag on such a growing tip, and that
9978 # turns out to be a descendent of $anc (which it could, since we
9979 # don't necessarily see children before parents), then $desc
9980 # isn't a good choice to display as a descendent tag of
9981 # $anc (since it is the descendent of another tag which is
9982 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9983 # display as a ancestor tag of $desc.
9984 #
9985 proc is_certain {desc anc} {
9986     global arcnos arcout arcstart arcend growing problems
9987
9988     set certain {}
9989     if {[llength $arcnos($anc)] == 1} {
9990         # tags on the same arc are certain
9991         if {$arcnos($desc) eq $arcnos($anc)} {
9992             return 1
9993         }
9994         if {![info exists arcout($anc)]} {
9995             # if $anc is partway along an arc, use the start of the arc instead
9996             set a [lindex $arcnos($anc) 0]
9997             set anc $arcstart($a)
9998         }
9999     }
10000     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10001         set x $desc
10002     } else {
10003         set a [lindex $arcnos($desc) 0]
10004         set x $arcend($a)
10005     }
10006     if {$x == $anc} {
10007         return 1
10008     }
10009     set anclist [list $x]
10010     set dl($x) 1
10011     set nnh 1
10012     set ngrowanc 0
10013     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10014         set x [lindex $anclist $i]
10015         if {$dl($x)} {
10016             incr nnh -1
10017         }
10018         set done($x) 1
10019         foreach a $arcout($x) {
10020             if {[info exists growing($a)]} {
10021                 if {![info exists growanc($x)] && $dl($x)} {
10022                     set growanc($x) 1
10023                     incr ngrowanc
10024                 }
10025             } else {
10026                 set y $arcend($a)
10027                 if {[info exists dl($y)]} {
10028                     if {$dl($y)} {
10029                         if {!$dl($x)} {
10030                             set dl($y) 0
10031                             if {![info exists done($y)]} {
10032                                 incr nnh -1
10033                             }
10034                             if {[info exists growanc($x)]} {
10035                                 incr ngrowanc -1
10036                             }
10037                             set xl [list $y]
10038                             for {set k 0} {$k < [llength $xl]} {incr k} {
10039                                 set z [lindex $xl $k]
10040                                 foreach c $arcout($z) {
10041                                     if {[info exists arcend($c)]} {
10042                                         set v $arcend($c)
10043                                         if {[info exists dl($v)] && $dl($v)} {
10044                                             set dl($v) 0
10045                                             if {![info exists done($v)]} {
10046                                                 incr nnh -1
10047                                             }
10048                                             if {[info exists growanc($v)]} {
10049                                                 incr ngrowanc -1
10050                                             }
10051                                             lappend xl $v
10052                                         }
10053                                     }
10054                                 }
10055                             }
10056                         }
10057                     }
10058                 } elseif {$y eq $anc || !$dl($x)} {
10059                     set dl($y) 0
10060                     lappend anclist $y
10061                 } else {
10062                     set dl($y) 1
10063                     lappend anclist $y
10064                     incr nnh
10065                 }
10066             }
10067         }
10068     }
10069     foreach x [array names growanc] {
10070         if {$dl($x)} {
10071             return 0
10072         }
10073         return 0
10074     }
10075     return 1
10076 }
10077
10078 proc validate_arctags {a} {
10079     global arctags idtags
10080
10081     set i -1
10082     set na $arctags($a)
10083     foreach id $arctags($a) {
10084         incr i
10085         if {![info exists idtags($id)]} {
10086             set na [lreplace $na $i $i]
10087             incr i -1
10088         }
10089     }
10090     set arctags($a) $na
10091 }
10092
10093 proc validate_archeads {a} {
10094     global archeads idheads
10095
10096     set i -1
10097     set na $archeads($a)
10098     foreach id $archeads($a) {
10099         incr i
10100         if {![info exists idheads($id)]} {
10101             set na [lreplace $na $i $i]
10102             incr i -1
10103         }
10104     }
10105     set archeads($a) $na
10106 }
10107
10108 # Return the list of IDs that have tags that are descendents of id,
10109 # ignoring IDs that are descendents of IDs already reported.
10110 proc desctags {id} {
10111     global arcnos arcstart arcids arctags idtags allparents
10112     global growing cached_dtags
10113
10114     if {![info exists allparents($id)]} {
10115         return {}
10116     }
10117     set t1 [clock clicks -milliseconds]
10118     set argid $id
10119     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10120         # part-way along an arc; check that arc first
10121         set a [lindex $arcnos($id) 0]
10122         if {$arctags($a) ne {}} {
10123             validate_arctags $a
10124             set i [lsearch -exact $arcids($a) $id]
10125             set tid {}
10126             foreach t $arctags($a) {
10127                 set j [lsearch -exact $arcids($a) $t]
10128                 if {$j >= $i} break
10129                 set tid $t
10130             }
10131             if {$tid ne {}} {
10132                 return $tid
10133             }
10134         }
10135         set id $arcstart($a)
10136         if {[info exists idtags($id)]} {
10137             return $id
10138         }
10139     }
10140     if {[info exists cached_dtags($id)]} {
10141         return $cached_dtags($id)
10142     }
10143
10144     set origid $id
10145     set todo [list $id]
10146     set queued($id) 1
10147     set nc 1
10148     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10149         set id [lindex $todo $i]
10150         set done($id) 1
10151         set ta [info exists hastaggedancestor($id)]
10152         if {!$ta} {
10153             incr nc -1
10154         }
10155         # ignore tags on starting node
10156         if {!$ta && $i > 0} {
10157             if {[info exists idtags($id)]} {
10158                 set tagloc($id) $id
10159                 set ta 1
10160             } elseif {[info exists cached_dtags($id)]} {
10161                 set tagloc($id) $cached_dtags($id)
10162                 set ta 1
10163             }
10164         }
10165         foreach a $arcnos($id) {
10166             set d $arcstart($a)
10167             if {!$ta && $arctags($a) ne {}} {
10168                 validate_arctags $a
10169                 if {$arctags($a) ne {}} {
10170                     lappend tagloc($id) [lindex $arctags($a) end]
10171                 }
10172             }
10173             if {$ta || $arctags($a) ne {}} {
10174                 set tomark [list $d]
10175                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10176                     set dd [lindex $tomark $j]
10177                     if {![info exists hastaggedancestor($dd)]} {
10178                         if {[info exists done($dd)]} {
10179                             foreach b $arcnos($dd) {
10180                                 lappend tomark $arcstart($b)
10181                             }
10182                             if {[info exists tagloc($dd)]} {
10183                                 unset tagloc($dd)
10184                             }
10185                         } elseif {[info exists queued($dd)]} {
10186                             incr nc -1
10187                         }
10188                         set hastaggedancestor($dd) 1
10189                     }
10190                 }
10191             }
10192             if {![info exists queued($d)]} {
10193                 lappend todo $d
10194                 set queued($d) 1
10195                 if {![info exists hastaggedancestor($d)]} {
10196                     incr nc
10197                 }
10198             }
10199         }
10200     }
10201     set tags {}
10202     foreach id [array names tagloc] {
10203         if {![info exists hastaggedancestor($id)]} {
10204             foreach t $tagloc($id) {
10205                 if {[lsearch -exact $tags $t] < 0} {
10206                     lappend tags $t
10207                 }
10208             }
10209         }
10210     }
10211     set t2 [clock clicks -milliseconds]
10212     set loopix $i
10213
10214     # remove tags that are descendents of other tags
10215     for {set i 0} {$i < [llength $tags]} {incr i} {
10216         set a [lindex $tags $i]
10217         for {set j 0} {$j < $i} {incr j} {
10218             set b [lindex $tags $j]
10219             set r [anc_or_desc $a $b]
10220             if {$r == 1} {
10221                 set tags [lreplace $tags $j $j]
10222                 incr j -1
10223                 incr i -1
10224             } elseif {$r == -1} {
10225                 set tags [lreplace $tags $i $i]
10226                 incr i -1
10227                 break
10228             }
10229         }
10230     }
10231
10232     if {[array names growing] ne {}} {
10233         # graph isn't finished, need to check if any tag could get
10234         # eclipsed by another tag coming later.  Simply ignore any
10235         # tags that could later get eclipsed.
10236         set ctags {}
10237         foreach t $tags {
10238             if {[is_certain $t $origid]} {
10239                 lappend ctags $t
10240             }
10241         }
10242         if {$tags eq $ctags} {
10243             set cached_dtags($origid) $tags
10244         } else {
10245             set tags $ctags
10246         }
10247     } else {
10248         set cached_dtags($origid) $tags
10249     }
10250     set t3 [clock clicks -milliseconds]
10251     if {0 && $t3 - $t1 >= 100} {
10252         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10253             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10254     }
10255     return $tags
10256 }
10257
10258 proc anctags {id} {
10259     global arcnos arcids arcout arcend arctags idtags allparents
10260     global growing cached_atags
10261
10262     if {![info exists allparents($id)]} {
10263         return {}
10264     }
10265     set t1 [clock clicks -milliseconds]
10266     set argid $id
10267     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10268         # part-way along an arc; check that arc first
10269         set a [lindex $arcnos($id) 0]
10270         if {$arctags($a) ne {}} {
10271             validate_arctags $a
10272             set i [lsearch -exact $arcids($a) $id]
10273             foreach t $arctags($a) {
10274                 set j [lsearch -exact $arcids($a) $t]
10275                 if {$j > $i} {
10276                     return $t
10277                 }
10278             }
10279         }
10280         if {![info exists arcend($a)]} {
10281             return {}
10282         }
10283         set id $arcend($a)
10284         if {[info exists idtags($id)]} {
10285             return $id
10286         }
10287     }
10288     if {[info exists cached_atags($id)]} {
10289         return $cached_atags($id)
10290     }
10291
10292     set origid $id
10293     set todo [list $id]
10294     set queued($id) 1
10295     set taglist {}
10296     set nc 1
10297     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10298         set id [lindex $todo $i]
10299         set done($id) 1
10300         set td [info exists hastaggeddescendent($id)]
10301         if {!$td} {
10302             incr nc -1
10303         }
10304         # ignore tags on starting node
10305         if {!$td && $i > 0} {
10306             if {[info exists idtags($id)]} {
10307                 set tagloc($id) $id
10308                 set td 1
10309             } elseif {[info exists cached_atags($id)]} {
10310                 set tagloc($id) $cached_atags($id)
10311                 set td 1
10312             }
10313         }
10314         foreach a $arcout($id) {
10315             if {!$td && $arctags($a) ne {}} {
10316                 validate_arctags $a
10317                 if {$arctags($a) ne {}} {
10318                     lappend tagloc($id) [lindex $arctags($a) 0]
10319                 }
10320             }
10321             if {![info exists arcend($a)]} continue
10322             set d $arcend($a)
10323             if {$td || $arctags($a) ne {}} {
10324                 set tomark [list $d]
10325                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10326                     set dd [lindex $tomark $j]
10327                     if {![info exists hastaggeddescendent($dd)]} {
10328                         if {[info exists done($dd)]} {
10329                             foreach b $arcout($dd) {
10330                                 if {[info exists arcend($b)]} {
10331                                     lappend tomark $arcend($b)
10332                                 }
10333                             }
10334                             if {[info exists tagloc($dd)]} {
10335                                 unset tagloc($dd)
10336                             }
10337                         } elseif {[info exists queued($dd)]} {
10338                             incr nc -1
10339                         }
10340                         set hastaggeddescendent($dd) 1
10341                     }
10342                 }
10343             }
10344             if {![info exists queued($d)]} {
10345                 lappend todo $d
10346                 set queued($d) 1
10347                 if {![info exists hastaggeddescendent($d)]} {
10348                     incr nc
10349                 }
10350             }
10351         }
10352     }
10353     set t2 [clock clicks -milliseconds]
10354     set loopix $i
10355     set tags {}
10356     foreach id [array names tagloc] {
10357         if {![info exists hastaggeddescendent($id)]} {
10358             foreach t $tagloc($id) {
10359                 if {[lsearch -exact $tags $t] < 0} {
10360                     lappend tags $t
10361                 }
10362             }
10363         }
10364     }
10365
10366     # remove tags that are ancestors of other tags
10367     for {set i 0} {$i < [llength $tags]} {incr i} {
10368         set a [lindex $tags $i]
10369         for {set j 0} {$j < $i} {incr j} {
10370             set b [lindex $tags $j]
10371             set r [anc_or_desc $a $b]
10372             if {$r == -1} {
10373                 set tags [lreplace $tags $j $j]
10374                 incr j -1
10375                 incr i -1
10376             } elseif {$r == 1} {
10377                 set tags [lreplace $tags $i $i]
10378                 incr i -1
10379                 break
10380             }
10381         }
10382     }
10383
10384     if {[array names growing] ne {}} {
10385         # graph isn't finished, need to check if any tag could get
10386         # eclipsed by another tag coming later.  Simply ignore any
10387         # tags that could later get eclipsed.
10388         set ctags {}
10389         foreach t $tags {
10390             if {[is_certain $origid $t]} {
10391                 lappend ctags $t
10392             }
10393         }
10394         if {$tags eq $ctags} {
10395             set cached_atags($origid) $tags
10396         } else {
10397             set tags $ctags
10398         }
10399     } else {
10400         set cached_atags($origid) $tags
10401     }
10402     set t3 [clock clicks -milliseconds]
10403     if {0 && $t3 - $t1 >= 100} {
10404         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10405             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10406     }
10407     return $tags
10408 }
10409
10410 # Return the list of IDs that have heads that are descendents of id,
10411 # including id itself if it has a head.
10412 proc descheads {id} {
10413     global arcnos arcstart arcids archeads idheads cached_dheads
10414     global allparents
10415
10416     if {![info exists allparents($id)]} {
10417         return {}
10418     }
10419     set aret {}
10420     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10421         # part-way along an arc; check it first
10422         set a [lindex $arcnos($id) 0]
10423         if {$archeads($a) ne {}} {
10424             validate_archeads $a
10425             set i [lsearch -exact $arcids($a) $id]
10426             foreach t $archeads($a) {
10427                 set j [lsearch -exact $arcids($a) $t]
10428                 if {$j > $i} break
10429                 lappend aret $t
10430             }
10431         }
10432         set id $arcstart($a)
10433     }
10434     set origid $id
10435     set todo [list $id]
10436     set seen($id) 1
10437     set ret {}
10438     for {set i 0} {$i < [llength $todo]} {incr i} {
10439         set id [lindex $todo $i]
10440         if {[info exists cached_dheads($id)]} {
10441             set ret [concat $ret $cached_dheads($id)]
10442         } else {
10443             if {[info exists idheads($id)]} {
10444                 lappend ret $id
10445             }
10446             foreach a $arcnos($id) {
10447                 if {$archeads($a) ne {}} {
10448                     validate_archeads $a
10449                     if {$archeads($a) ne {}} {
10450                         set ret [concat $ret $archeads($a)]
10451                     }
10452                 }
10453                 set d $arcstart($a)
10454                 if {![info exists seen($d)]} {
10455                     lappend todo $d
10456                     set seen($d) 1
10457                 }
10458             }
10459         }
10460     }
10461     set ret [lsort -unique $ret]
10462     set cached_dheads($origid) $ret
10463     return [concat $ret $aret]
10464 }
10465
10466 proc addedtag {id} {
10467     global arcnos arcout cached_dtags cached_atags
10468
10469     if {![info exists arcnos($id)]} return
10470     if {![info exists arcout($id)]} {
10471         recalcarc [lindex $arcnos($id) 0]
10472     }
10473     catch {unset cached_dtags}
10474     catch {unset cached_atags}
10475 }
10476
10477 proc addedhead {hid head} {
10478     global arcnos arcout cached_dheads
10479
10480     if {![info exists arcnos($hid)]} return
10481     if {![info exists arcout($hid)]} {
10482         recalcarc [lindex $arcnos($hid) 0]
10483     }
10484     catch {unset cached_dheads}
10485 }
10486
10487 proc removedhead {hid head} {
10488     global cached_dheads
10489
10490     catch {unset cached_dheads}
10491 }
10492
10493 proc movedhead {hid head} {
10494     global arcnos arcout cached_dheads
10495
10496     if {![info exists arcnos($hid)]} return
10497     if {![info exists arcout($hid)]} {
10498         recalcarc [lindex $arcnos($hid) 0]
10499     }
10500     catch {unset cached_dheads}
10501 }
10502
10503 proc changedrefs {} {
10504     global cached_dheads cached_dtags cached_atags
10505     global arctags archeads arcnos arcout idheads idtags
10506
10507     foreach id [concat [array names idheads] [array names idtags]] {
10508         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10509             set a [lindex $arcnos($id) 0]
10510             if {![info exists donearc($a)]} {
10511                 recalcarc $a
10512                 set donearc($a) 1
10513             }
10514         }
10515     }
10516     catch {unset cached_dtags}
10517     catch {unset cached_atags}
10518     catch {unset cached_dheads}
10519 }
10520
10521 proc rereadrefs {} {
10522     global idtags idheads idotherrefs mainheadid
10523
10524     set refids [concat [array names idtags] \
10525                     [array names idheads] [array names idotherrefs]]
10526     foreach id $refids {
10527         if {![info exists ref($id)]} {
10528             set ref($id) [listrefs $id]
10529         }
10530     }
10531     set oldmainhead $mainheadid
10532     readrefs
10533     changedrefs
10534     set refids [lsort -unique [concat $refids [array names idtags] \
10535                         [array names idheads] [array names idotherrefs]]]
10536     foreach id $refids {
10537         set v [listrefs $id]
10538         if {![info exists ref($id)] || $ref($id) != $v} {
10539             redrawtags $id
10540         }
10541     }
10542     if {$oldmainhead ne $mainheadid} {
10543         redrawtags $oldmainhead
10544         redrawtags $mainheadid
10545     }
10546     run refill_reflist
10547 }
10548
10549 proc listrefs {id} {
10550     global idtags idheads idotherrefs
10551
10552     set x {}
10553     if {[info exists idtags($id)]} {
10554         set x $idtags($id)
10555     }
10556     set y {}
10557     if {[info exists idheads($id)]} {
10558         set y $idheads($id)
10559     }
10560     set z {}
10561     if {[info exists idotherrefs($id)]} {
10562         set z $idotherrefs($id)
10563     }
10564     return [list $x $y $z]
10565 }
10566
10567 proc showtag {tag isnew} {
10568     global ctext tagcontents tagids linknum tagobjid
10569
10570     if {$isnew} {
10571         addtohistory [list showtag $tag 0] savectextpos
10572     }
10573     $ctext conf -state normal
10574     clear_ctext
10575     settabs 0
10576     set linknum 0
10577     if {![info exists tagcontents($tag)]} {
10578         catch {
10579            set tagcontents($tag) [exec git cat-file tag $tag]
10580         }
10581     }
10582     if {[info exists tagcontents($tag)]} {
10583         set text $tagcontents($tag)
10584     } else {
10585         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10586     }
10587     appendwithlinks $text {}
10588     maybe_scroll_ctext 1
10589     $ctext conf -state disabled
10590     init_flist {}
10591 }
10592
10593 proc doquit {} {
10594     global stopped
10595     global gitktmpdir
10596
10597     set stopped 100
10598     savestuff .
10599     destroy .
10600
10601     if {[info exists gitktmpdir]} {
10602         catch {file delete -force $gitktmpdir}
10603     }
10604 }
10605
10606 proc mkfontdisp {font top which} {
10607     global fontattr fontpref $font NS use_ttk
10608
10609     set fontpref($font) [set $font]
10610     ${NS}::button $top.${font}but -text $which \
10611         -command [list choosefont $font $which]
10612     ${NS}::label $top.$font -relief flat -font $font \
10613         -text $fontattr($font,family) -justify left
10614     grid x $top.${font}but $top.$font -sticky w
10615 }
10616
10617 proc choosefont {font which} {
10618     global fontparam fontlist fonttop fontattr
10619     global prefstop NS
10620
10621     set fontparam(which) $which
10622     set fontparam(font) $font
10623     set fontparam(family) [font actual $font -family]
10624     set fontparam(size) $fontattr($font,size)
10625     set fontparam(weight) $fontattr($font,weight)
10626     set fontparam(slant) $fontattr($font,slant)
10627     set top .gitkfont
10628     set fonttop $top
10629     if {![winfo exists $top]} {
10630         font create sample
10631         eval font config sample [font actual $font]
10632         ttk_toplevel $top
10633         make_transient $top $prefstop
10634         wm title $top [mc "Gitk font chooser"]
10635         ${NS}::label $top.l -textvariable fontparam(which)
10636         pack $top.l -side top
10637         set fontlist [lsort [font families]]
10638         ${NS}::frame $top.f
10639         listbox $top.f.fam -listvariable fontlist \
10640             -yscrollcommand [list $top.f.sb set]
10641         bind $top.f.fam <<ListboxSelect>> selfontfam
10642         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10643         pack $top.f.sb -side right -fill y
10644         pack $top.f.fam -side left -fill both -expand 1
10645         pack $top.f -side top -fill both -expand 1
10646         ${NS}::frame $top.g
10647         spinbox $top.g.size -from 4 -to 40 -width 4 \
10648             -textvariable fontparam(size) \
10649             -validatecommand {string is integer -strict %s}
10650         checkbutton $top.g.bold -padx 5 \
10651             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10652             -variable fontparam(weight) -onvalue bold -offvalue normal
10653         checkbutton $top.g.ital -padx 5 \
10654             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10655             -variable fontparam(slant) -onvalue italic -offvalue roman
10656         pack $top.g.size $top.g.bold $top.g.ital -side left
10657         pack $top.g -side top
10658         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10659             -background white
10660         $top.c create text 100 25 -anchor center -text $which -font sample \
10661             -fill black -tags text
10662         bind $top.c <Configure> [list centertext $top.c]
10663         pack $top.c -side top -fill x
10664         ${NS}::frame $top.buts
10665         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10666         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10667         bind $top <Key-Return> fontok
10668         bind $top <Key-Escape> fontcan
10669         grid $top.buts.ok $top.buts.can
10670         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10671         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10672         pack $top.buts -side bottom -fill x
10673         trace add variable fontparam write chg_fontparam
10674     } else {
10675         raise $top
10676         $top.c itemconf text -text $which
10677     }
10678     set i [lsearch -exact $fontlist $fontparam(family)]
10679     if {$i >= 0} {
10680         $top.f.fam selection set $i
10681         $top.f.fam see $i
10682     }
10683 }
10684
10685 proc centertext {w} {
10686     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10687 }
10688
10689 proc fontok {} {
10690     global fontparam fontpref prefstop
10691
10692     set f $fontparam(font)
10693     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10694     if {$fontparam(weight) eq "bold"} {
10695         lappend fontpref($f) "bold"
10696     }
10697     if {$fontparam(slant) eq "italic"} {
10698         lappend fontpref($f) "italic"
10699     }
10700     set w $prefstop.$f
10701     $w conf -text $fontparam(family) -font $fontpref($f)
10702
10703     fontcan
10704 }
10705
10706 proc fontcan {} {
10707     global fonttop fontparam
10708
10709     if {[info exists fonttop]} {
10710         catch {destroy $fonttop}
10711         catch {font delete sample}
10712         unset fonttop
10713         unset fontparam
10714     }
10715 }
10716
10717 if {[package vsatisfies [package provide Tk] 8.6]} {
10718     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10719     # function to make use of it.
10720     proc choosefont {font which} {
10721         tk fontchooser configure -title $which -font $font \
10722             -command [list on_choosefont $font $which]
10723         tk fontchooser show
10724     }
10725     proc on_choosefont {font which newfont} {
10726         global fontparam
10727         puts stderr "$font $newfont"
10728         array set f [font actual $newfont]
10729         set fontparam(which) $which
10730         set fontparam(font) $font
10731         set fontparam(family) $f(-family)
10732         set fontparam(size) $f(-size)
10733         set fontparam(weight) $f(-weight)
10734         set fontparam(slant) $f(-slant)
10735         fontok
10736     }
10737 }
10738
10739 proc selfontfam {} {
10740     global fonttop fontparam
10741
10742     set i [$fonttop.f.fam curselection]
10743     if {$i ne {}} {
10744         set fontparam(family) [$fonttop.f.fam get $i]
10745     }
10746 }
10747
10748 proc chg_fontparam {v sub op} {
10749     global fontparam
10750
10751     font config sample -$sub $fontparam($sub)
10752 }
10753
10754 proc doprefs {} {
10755     global maxwidth maxgraphpct use_ttk NS
10756     global oldprefs prefstop showneartags showlocalchanges
10757     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10758     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10759     global hideremotes want_ttk have_ttk
10760
10761     set top .gitkprefs
10762     set prefstop $top
10763     if {[winfo exists $top]} {
10764         raise $top
10765         return
10766     }
10767     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10768                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10769         set oldprefs($v) [set $v]
10770     }
10771     ttk_toplevel $top
10772     wm title $top [mc "Gitk preferences"]
10773     make_transient $top .
10774     ${NS}::label $top.ldisp -text [mc "Commit list display options"]
10775     grid $top.ldisp - -sticky w -pady 10
10776     ${NS}::label $top.spacer -text " "
10777     ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
10778     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10779     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10780     ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
10781     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10782     grid x $top.maxpctl $top.maxpct -sticky w
10783     ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10784         -variable showlocalchanges
10785     grid x $top.showlocal -sticky w
10786     ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1 (length)"] \
10787         -variable autoselect
10788     spinbox $top.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10789     grid x $top.autoselect $top.autosellen -sticky w
10790     ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10791         -variable hideremotes
10792     grid x $top.hideremotes -sticky w
10793
10794     ${NS}::label $top.ddisp -text [mc "Diff display options"]
10795     grid $top.ddisp - -sticky w -pady 10
10796     ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
10797     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10798     grid x $top.tabstopl $top.tabstop -sticky w
10799     ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10800         -variable showneartags
10801     grid x $top.ntag -sticky w
10802     ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10803         -variable limitdiffs
10804     grid x $top.ldiff -sticky w
10805     ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10806         -variable perfile_attrs
10807     grid x $top.lattr -sticky w
10808
10809     ${NS}::entry $top.extdifft -textvariable extdifftool
10810     ${NS}::frame $top.extdifff
10811     ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10812     ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10813     pack $top.extdifff.l $top.extdifff.b -side left
10814     pack configure $top.extdifff.l -padx 10
10815     grid x $top.extdifff $top.extdifft -sticky ew
10816
10817     ${NS}::label $top.lgen -text [mc "General options"]
10818     grid $top.lgen - -sticky w -pady 10
10819     ${NS}::checkbutton $top.want_ttk -variable want_ttk \
10820         -text [mc "Use themed widgets"]
10821     if {$have_ttk} {
10822         ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
10823     } else {
10824         ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
10825     }
10826     grid x $top.want_ttk $top.ttk_note -sticky w
10827
10828     ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
10829     grid $top.cdisp - -sticky w -pady 10
10830     label $top.ui -padx 40 -relief sunk -background $uicolor
10831     ${NS}::button $top.uibut -text [mc "Interface"] \
10832        -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
10833     grid x $top.uibut $top.ui -sticky w
10834     label $top.bg -padx 40 -relief sunk -background $bgcolor
10835     ${NS}::button $top.bgbut -text [mc "Background"] \
10836         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10837     grid x $top.bgbut $top.bg -sticky w
10838     label $top.fg -padx 40 -relief sunk -background $fgcolor
10839     ${NS}::button $top.fgbut -text [mc "Foreground"] \
10840         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10841     grid x $top.fgbut $top.fg -sticky w
10842     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10843     ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
10844         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10845                       [list $ctext tag conf d0 -foreground]]
10846     grid x $top.diffoldbut $top.diffold -sticky w
10847     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10848     ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
10849         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10850                       [list $ctext tag conf dresult -foreground]]
10851     grid x $top.diffnewbut $top.diffnew -sticky w
10852     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10853     ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
10854         -command [list choosecolor diffcolors 2 $top.hunksep \
10855                       [mc "diff hunk header"] \
10856                       [list $ctext tag conf hunksep -foreground]]
10857     grid x $top.hunksepbut $top.hunksep -sticky w
10858     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10859     ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
10860         -command [list choosecolor markbgcolor {} $top.markbgsep \
10861                       [mc "marked line background"] \
10862                       [list $ctext tag conf omark -background]]
10863     grid x $top.markbgbut $top.markbgsep -sticky w
10864     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10865     ${NS}::button $top.selbgbut -text [mc "Select bg"] \
10866         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10867     grid x $top.selbgbut $top.selbgsep -sticky w
10868
10869     ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
10870     grid $top.cfont - -sticky w -pady 10
10871     mkfontdisp mainfont $top [mc "Main font"]
10872     mkfontdisp textfont $top [mc "Diff display font"]
10873     mkfontdisp uifont $top [mc "User interface font"]
10874
10875     ${NS}::frame $top.buts
10876     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10877     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10878     bind $top <Key-Return> prefsok
10879     bind $top <Key-Escape> prefscan
10880     grid $top.buts.ok $top.buts.can
10881     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10882     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10883     grid $top.buts - - -pady 10 -sticky ew
10884     grid columnconfigure $top 2 -weight 1
10885     bind $top <Visibility> "focus $top.buts.ok"
10886 }
10887
10888 proc choose_extdiff {} {
10889     global extdifftool
10890
10891     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10892     if {$prog ne {}} {
10893         set extdifftool $prog
10894     }
10895 }
10896
10897 proc choosecolor {v vi w x cmd} {
10898     global $v
10899
10900     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10901                -title [mc "Gitk: choose color for %s" $x]]
10902     if {$c eq {}} return
10903     $w conf -background $c
10904     lset $v $vi $c
10905     eval $cmd $c
10906 }
10907
10908 proc setselbg {c} {
10909     global bglist cflist
10910     foreach w $bglist {
10911         $w configure -selectbackground $c
10912     }
10913     $cflist tag configure highlight \
10914         -background [$cflist cget -selectbackground]
10915     allcanvs itemconf secsel -fill $c
10916 }
10917
10918 # This sets the background color and the color scheme for the whole UI.
10919 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
10920 # if we don't specify one ourselves, which makes the checkbuttons and
10921 # radiobuttons look bad.  This chooses white for selectColor if the
10922 # background color is light, or black if it is dark.
10923 proc setui {c} {
10924     if {[tk windowingsystem] eq "win32"} { return }
10925     set bg [winfo rgb . $c]
10926     set selc black
10927     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
10928         set selc white
10929     }
10930     tk_setPalette background $c selectColor $selc
10931 }
10932
10933 proc setbg {c} {
10934     global bglist
10935
10936     foreach w $bglist {
10937         $w conf -background $c
10938     }
10939 }
10940
10941 proc setfg {c} {
10942     global fglist canv
10943
10944     foreach w $fglist {
10945         $w conf -foreground $c
10946     }
10947     allcanvs itemconf text -fill $c
10948     $canv itemconf circle -outline $c
10949     $canv itemconf markid -outline $c
10950 }
10951
10952 proc prefscan {} {
10953     global oldprefs prefstop
10954
10955     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10956                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10957         global $v
10958         set $v $oldprefs($v)
10959     }
10960     catch {destroy $prefstop}
10961     unset prefstop
10962     fontcan
10963 }
10964
10965 proc prefsok {} {
10966     global maxwidth maxgraphpct
10967     global oldprefs prefstop showneartags showlocalchanges
10968     global fontpref mainfont textfont uifont
10969     global limitdiffs treediffs perfile_attrs
10970     global hideremotes
10971
10972     catch {destroy $prefstop}
10973     unset prefstop
10974     fontcan
10975     set fontchanged 0
10976     if {$mainfont ne $fontpref(mainfont)} {
10977         set mainfont $fontpref(mainfont)
10978         parsefont mainfont $mainfont
10979         eval font configure mainfont [fontflags mainfont]
10980         eval font configure mainfontbold [fontflags mainfont 1]
10981         setcoords
10982         set fontchanged 1
10983     }
10984     if {$textfont ne $fontpref(textfont)} {
10985         set textfont $fontpref(textfont)
10986         parsefont textfont $textfont
10987         eval font configure textfont [fontflags textfont]
10988         eval font configure textfontbold [fontflags textfont 1]
10989     }
10990     if {$uifont ne $fontpref(uifont)} {
10991         set uifont $fontpref(uifont)
10992         parsefont uifont $uifont
10993         eval font configure uifont [fontflags uifont]
10994     }
10995     settabs
10996     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10997         if {$showlocalchanges} {
10998             doshowlocalchanges
10999         } else {
11000             dohidelocalchanges
11001         }
11002     }
11003     if {$limitdiffs != $oldprefs(limitdiffs) ||
11004         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11005         # treediffs elements are limited by path;
11006         # won't have encodings cached if perfile_attrs was just turned on
11007         catch {unset treediffs}
11008     }
11009     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11010         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11011         redisplay
11012     } elseif {$showneartags != $oldprefs(showneartags) ||
11013           $limitdiffs != $oldprefs(limitdiffs)} {
11014         reselectline
11015     }
11016     if {$hideremotes != $oldprefs(hideremotes)} {
11017         rereadrefs
11018     }
11019 }
11020
11021 proc formatdate {d} {
11022     global datetimeformat
11023     if {$d ne {}} {
11024         set d [clock format $d -format $datetimeformat]
11025     }
11026     return $d
11027 }
11028
11029 # This list of encoding names and aliases is distilled from
11030 # http://www.iana.org/assignments/character-sets.
11031 # Not all of them are supported by Tcl.
11032 set encoding_aliases {
11033     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11034       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11035     { ISO-10646-UTF-1 csISO10646UTF1 }
11036     { ISO_646.basic:1983 ref csISO646basic1983 }
11037     { INVARIANT csINVARIANT }
11038     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11039     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11040     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11041     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11042     { NATS-DANO iso-ir-9-1 csNATSDANO }
11043     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11044     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11045     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11046     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11047     { ISO-2022-KR csISO2022KR }
11048     { EUC-KR csEUCKR }
11049     { ISO-2022-JP csISO2022JP }
11050     { ISO-2022-JP-2 csISO2022JP2 }
11051     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11052       csISO13JISC6220jp }
11053     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11054     { IT iso-ir-15 ISO646-IT csISO15Italian }
11055     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11056     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11057     { greek7-old iso-ir-18 csISO18Greek7Old }
11058     { latin-greek iso-ir-19 csISO19LatinGreek }
11059     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11060     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11061     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11062     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11063     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11064     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11065     { INIS iso-ir-49 csISO49INIS }
11066     { INIS-8 iso-ir-50 csISO50INIS8 }
11067     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11068     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11069     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11070     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11071     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11072     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11073       csISO60Norwegian1 }
11074     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11075     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11076     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11077     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11078     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11079     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11080     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11081     { greek7 iso-ir-88 csISO88Greek7 }
11082     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11083     { iso-ir-90 csISO90 }
11084     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11085     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11086       csISO92JISC62991984b }
11087     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11088     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11089     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11090       csISO95JIS62291984handadd }
11091     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11092     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11093     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11094     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11095       CP819 csISOLatin1 }
11096     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11097     { T.61-7bit iso-ir-102 csISO102T617bit }
11098     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11099     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11100     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11101     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11102     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11103     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11104     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11105     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11106       arabic csISOLatinArabic }
11107     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11108     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11109     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11110       greek greek8 csISOLatinGreek }
11111     { T.101-G2 iso-ir-128 csISO128T101G2 }
11112     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11113       csISOLatinHebrew }
11114     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11115     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11116     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11117     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11118     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11119     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11120     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11121       csISOLatinCyrillic }
11122     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11123     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11124     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11125     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11126     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11127     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11128     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11129     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11130     { ISO_10367-box iso-ir-155 csISO10367Box }
11131     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11132     { latin-lap lap iso-ir-158 csISO158Lap }
11133     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11134     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11135     { us-dk csUSDK }
11136     { dk-us csDKUS }
11137     { JIS_X0201 X0201 csHalfWidthKatakana }
11138     { KSC5636 ISO646-KR csKSC5636 }
11139     { ISO-10646-UCS-2 csUnicode }
11140     { ISO-10646-UCS-4 csUCS4 }
11141     { DEC-MCS dec csDECMCS }
11142     { hp-roman8 roman8 r8 csHPRoman8 }
11143     { macintosh mac csMacintosh }
11144     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11145       csIBM037 }
11146     { IBM038 EBCDIC-INT cp038 csIBM038 }
11147     { IBM273 CP273 csIBM273 }
11148     { IBM274 EBCDIC-BE CP274 csIBM274 }
11149     { IBM275 EBCDIC-BR cp275 csIBM275 }
11150     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11151     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11152     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11153     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11154     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11155     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11156     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11157     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11158     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11159     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11160     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11161     { IBM437 cp437 437 csPC8CodePage437 }
11162     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11163     { IBM775 cp775 csPC775Baltic }
11164     { IBM850 cp850 850 csPC850Multilingual }
11165     { IBM851 cp851 851 csIBM851 }
11166     { IBM852 cp852 852 csPCp852 }
11167     { IBM855 cp855 855 csIBM855 }
11168     { IBM857 cp857 857 csIBM857 }
11169     { IBM860 cp860 860 csIBM860 }
11170     { IBM861 cp861 861 cp-is csIBM861 }
11171     { IBM862 cp862 862 csPC862LatinHebrew }
11172     { IBM863 cp863 863 csIBM863 }
11173     { IBM864 cp864 csIBM864 }
11174     { IBM865 cp865 865 csIBM865 }
11175     { IBM866 cp866 866 csIBM866 }
11176     { IBM868 CP868 cp-ar csIBM868 }
11177     { IBM869 cp869 869 cp-gr csIBM869 }
11178     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11179     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11180     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11181     { IBM891 cp891 csIBM891 }
11182     { IBM903 cp903 csIBM903 }
11183     { IBM904 cp904 904 csIBBM904 }
11184     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11185     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11186     { IBM1026 CP1026 csIBM1026 }
11187     { EBCDIC-AT-DE csIBMEBCDICATDE }
11188     { EBCDIC-AT-DE-A csEBCDICATDEA }
11189     { EBCDIC-CA-FR csEBCDICCAFR }
11190     { EBCDIC-DK-NO csEBCDICDKNO }
11191     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11192     { EBCDIC-FI-SE csEBCDICFISE }
11193     { EBCDIC-FI-SE-A csEBCDICFISEA }
11194     { EBCDIC-FR csEBCDICFR }
11195     { EBCDIC-IT csEBCDICIT }
11196     { EBCDIC-PT csEBCDICPT }
11197     { EBCDIC-ES csEBCDICES }
11198     { EBCDIC-ES-A csEBCDICESA }
11199     { EBCDIC-ES-S csEBCDICESS }
11200     { EBCDIC-UK csEBCDICUK }
11201     { EBCDIC-US csEBCDICUS }
11202     { UNKNOWN-8BIT csUnknown8BiT }
11203     { MNEMONIC csMnemonic }
11204     { MNEM csMnem }
11205     { VISCII csVISCII }
11206     { VIQR csVIQR }
11207     { KOI8-R csKOI8R }
11208     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11209     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11210     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11211     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11212     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11213     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11214     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11215     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11216     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11217     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11218     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11219     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11220     { IBM1047 IBM-1047 }
11221     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11222     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11223     { UNICODE-1-1 csUnicode11 }
11224     { CESU-8 csCESU-8 }
11225     { BOCU-1 csBOCU-1 }
11226     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11227     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11228       l8 }
11229     { ISO-8859-15 ISO_8859-15 Latin-9 }
11230     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11231     { GBK CP936 MS936 windows-936 }
11232     { JIS_Encoding csJISEncoding }
11233     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11234     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11235       EUC-JP }
11236     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11237     { ISO-10646-UCS-Basic csUnicodeASCII }
11238     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11239     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11240     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11241     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11242     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11243     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11244     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11245     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11246     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11247     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11248     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11249     { Ventura-US csVenturaUS }
11250     { Ventura-International csVenturaInternational }
11251     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11252     { PC8-Turkish csPC8Turkish }
11253     { IBM-Symbols csIBMSymbols }
11254     { IBM-Thai csIBMThai }
11255     { HP-Legal csHPLegal }
11256     { HP-Pi-font csHPPiFont }
11257     { HP-Math8 csHPMath8 }
11258     { Adobe-Symbol-Encoding csHPPSMath }
11259     { HP-DeskTop csHPDesktop }
11260     { Ventura-Math csVenturaMath }
11261     { Microsoft-Publishing csMicrosoftPublishing }
11262     { Windows-31J csWindows31J }
11263     { GB2312 csGB2312 }
11264     { Big5 csBig5 }
11265 }
11266
11267 proc tcl_encoding {enc} {
11268     global encoding_aliases tcl_encoding_cache
11269     if {[info exists tcl_encoding_cache($enc)]} {
11270         return $tcl_encoding_cache($enc)
11271     }
11272     set names [encoding names]
11273     set lcnames [string tolower $names]
11274     set enc [string tolower $enc]
11275     set i [lsearch -exact $lcnames $enc]
11276     if {$i < 0} {
11277         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11278         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11279             set i [lsearch -exact $lcnames $encx]
11280         }
11281     }
11282     if {$i < 0} {
11283         foreach l $encoding_aliases {
11284             set ll [string tolower $l]
11285             if {[lsearch -exact $ll $enc] < 0} continue
11286             # look through the aliases for one that tcl knows about
11287             foreach e $ll {
11288                 set i [lsearch -exact $lcnames $e]
11289                 if {$i < 0} {
11290                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11291                         set i [lsearch -exact $lcnames $ex]
11292                     }
11293                 }
11294                 if {$i >= 0} break
11295             }
11296             break
11297         }
11298     }
11299     set tclenc {}
11300     if {$i >= 0} {
11301         set tclenc [lindex $names $i]
11302     }
11303     set tcl_encoding_cache($enc) $tclenc
11304     return $tclenc
11305 }
11306
11307 proc gitattr {path attr default} {
11308     global path_attr_cache
11309     if {[info exists path_attr_cache($attr,$path)]} {
11310         set r $path_attr_cache($attr,$path)
11311     } else {
11312         set r "unspecified"
11313         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11314             regexp "(.*): $attr: (.*)" $line m f r
11315         }
11316         set path_attr_cache($attr,$path) $r
11317     }
11318     if {$r eq "unspecified"} {
11319         return $default
11320     }
11321     return $r
11322 }
11323
11324 proc cache_gitattr {attr pathlist} {
11325     global path_attr_cache
11326     set newlist {}
11327     foreach path $pathlist {
11328         if {![info exists path_attr_cache($attr,$path)]} {
11329             lappend newlist $path
11330         }
11331     }
11332     set lim 1000
11333     if {[tk windowingsystem] == "win32"} {
11334         # windows has a 32k limit on the arguments to a command...
11335         set lim 30
11336     }
11337     while {$newlist ne {}} {
11338         set head [lrange $newlist 0 [expr {$lim - 1}]]
11339         set newlist [lrange $newlist $lim end]
11340         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11341             foreach row [split $rlist "\n"] {
11342                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11343                     if {[string index $path 0] eq "\""} {
11344                         set path [encoding convertfrom [lindex $path 0]]
11345                     }
11346                     set path_attr_cache($attr,$path) $value
11347                 }
11348             }
11349         }
11350     }
11351 }
11352
11353 proc get_path_encoding {path} {
11354     global gui_encoding perfile_attrs
11355     set tcl_enc $gui_encoding
11356     if {$path ne {} && $perfile_attrs} {
11357         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11358         if {$enc2 ne {}} {
11359             set tcl_enc $enc2
11360         }
11361     }
11362     return $tcl_enc
11363 }
11364
11365 # First check that Tcl/Tk is recent enough
11366 if {[catch {package require Tk 8.4} err]} {
11367     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11368                      Gitk requires at least Tcl/Tk 8.4." list
11369     exit 1
11370 }
11371
11372 # defaults...
11373 set wrcomcmd "git diff-tree --stdin -p --pretty"
11374
11375 set gitencoding {}
11376 catch {
11377     set gitencoding [exec git config --get i18n.commitencoding]
11378 }
11379 catch {
11380     set gitencoding [exec git config --get i18n.logoutputencoding]
11381 }
11382 if {$gitencoding == ""} {
11383     set gitencoding "utf-8"
11384 }
11385 set tclencoding [tcl_encoding $gitencoding]
11386 if {$tclencoding == {}} {
11387     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11388 }
11389
11390 set gui_encoding [encoding system]
11391 catch {
11392     set enc [exec git config --get gui.encoding]
11393     if {$enc ne {}} {
11394         set tclenc [tcl_encoding $enc]
11395         if {$tclenc ne {}} {
11396             set gui_encoding $tclenc
11397         } else {
11398             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11399         }
11400     }
11401 }
11402
11403 if {[tk windowingsystem] eq "aqua"} {
11404     set mainfont {{Lucida Grande} 9}
11405     set textfont {Monaco 9}
11406     set uifont {{Lucida Grande} 9 bold}
11407 } else {
11408     set mainfont {Helvetica 9}
11409     set textfont {Courier 9}
11410     set uifont {Helvetica 9 bold}
11411 }
11412 set tabstop 8
11413 set findmergefiles 0
11414 set maxgraphpct 50
11415 set maxwidth 16
11416 set revlistorder 0
11417 set fastdate 0
11418 set uparrowlen 5
11419 set downarrowlen 5
11420 set mingaplen 100
11421 set cmitmode "patch"
11422 set wrapcomment "none"
11423 set showneartags 1
11424 set hideremotes 0
11425 set maxrefs 20
11426 set maxlinelen 200
11427 set showlocalchanges 1
11428 set limitdiffs 1
11429 set datetimeformat "%Y-%m-%d %H:%M:%S"
11430 set autoselect 1
11431 set autosellen 40
11432 set perfile_attrs 0
11433 set want_ttk 1
11434
11435 if {[tk windowingsystem] eq "aqua"} {
11436     set extdifftool "opendiff"
11437 } else {
11438     set extdifftool "meld"
11439 }
11440
11441 set colors {green red blue magenta darkgrey brown orange}
11442 if {[tk windowingsystem] eq "win32"} {
11443     set uicolor SystemButtonFace
11444     set bgcolor SystemWindow
11445     set fgcolor SystemButtonText
11446     set selectbgcolor SystemHighlight
11447 } else {
11448     set uicolor grey85
11449     set bgcolor white
11450     set fgcolor black
11451     set selectbgcolor gray85
11452 }
11453 set diffcolors {red "#00a000" blue}
11454 set diffcontext 3
11455 set ignorespace 0
11456 set worddiff ""
11457 set markbgcolor "#e0e0ff"
11458
11459 set circlecolors {white blue gray blue blue}
11460
11461 # button for popping up context menus
11462 if {[tk windowingsystem] eq "aqua"} {
11463     set ctxbut <Button-2>
11464 } else {
11465     set ctxbut <Button-3>
11466 }
11467
11468 ## For msgcat loading, first locate the installation location.
11469 if { [info exists ::env(GITK_MSGSDIR)] } {
11470     ## Msgsdir was manually set in the environment.
11471     set gitk_msgsdir $::env(GITK_MSGSDIR)
11472 } else {
11473     ## Let's guess the prefix from argv0.
11474     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11475     set gitk_libdir [file join $gitk_prefix share gitk lib]
11476     set gitk_msgsdir [file join $gitk_libdir msgs]
11477     unset gitk_prefix
11478 }
11479
11480 ## Internationalization (i18n) through msgcat and gettext. See
11481 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11482 package require msgcat
11483 namespace import ::msgcat::mc
11484 ## And eventually load the actual message catalog
11485 ::msgcat::mcload $gitk_msgsdir
11486
11487 catch {source ~/.gitk}
11488
11489 parsefont mainfont $mainfont
11490 eval font create mainfont [fontflags mainfont]
11491 eval font create mainfontbold [fontflags mainfont 1]
11492
11493 parsefont textfont $textfont
11494 eval font create textfont [fontflags textfont]
11495 eval font create textfontbold [fontflags textfont 1]
11496
11497 parsefont uifont $uifont
11498 eval font create uifont [fontflags uifont]
11499
11500 setui $uicolor
11501
11502 setoptions
11503
11504 # check that we can find a .git directory somewhere...
11505 if {[catch {set gitdir [gitdir]}]} {
11506     show_error {} . [mc "Cannot find a git repository here."]
11507     exit 1
11508 }
11509 if {![file isdirectory $gitdir]} {
11510     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11511     exit 1
11512 }
11513
11514 set selecthead {}
11515 set selectheadid {}
11516
11517 set revtreeargs {}
11518 set cmdline_files {}
11519 set i 0
11520 set revtreeargscmd {}
11521 foreach arg $argv {
11522     switch -glob -- $arg {
11523         "" { }
11524         "--" {
11525             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11526             break
11527         }
11528         "--select-commit=*" {
11529             set selecthead [string range $arg 16 end]
11530         }
11531         "--argscmd=*" {
11532             set revtreeargscmd [string range $arg 10 end]
11533         }
11534         default {
11535             lappend revtreeargs $arg
11536         }
11537     }
11538     incr i
11539 }
11540
11541 if {$selecthead eq "HEAD"} {
11542     set selecthead {}
11543 }
11544
11545 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11546     # no -- on command line, but some arguments (other than --argscmd)
11547     if {[catch {
11548         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11549         set cmdline_files [split $f "\n"]
11550         set n [llength $cmdline_files]
11551         set revtreeargs [lrange $revtreeargs 0 end-$n]
11552         # Unfortunately git rev-parse doesn't produce an error when
11553         # something is both a revision and a filename.  To be consistent
11554         # with git log and git rev-list, check revtreeargs for filenames.
11555         foreach arg $revtreeargs {
11556             if {[file exists $arg]} {
11557                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11558                                  and filename" $arg]
11559                 exit 1
11560             }
11561         }
11562     } err]} {
11563         # unfortunately we get both stdout and stderr in $err,
11564         # so look for "fatal:".
11565         set i [string first "fatal:" $err]
11566         if {$i > 0} {
11567             set err [string range $err [expr {$i + 6}] end]
11568         }
11569         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11570         exit 1
11571     }
11572 }
11573
11574 set nullid "0000000000000000000000000000000000000000"
11575 set nullid2 "0000000000000000000000000000000000000001"
11576 set nullfile "/dev/null"
11577
11578 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11579 if {![info exists have_ttk]} {
11580     set have_ttk [llength [info commands ::ttk::style]]
11581 }
11582 set use_ttk [expr {$have_ttk && $want_ttk}]
11583 set NS [expr {$use_ttk ? "ttk" : ""}]
11584
11585 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11586
11587 set show_notes {}
11588 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11589     set show_notes "--show-notes"
11590 }
11591
11592 set runq {}
11593 set history {}
11594 set historyindex 0
11595 set fh_serial 0
11596 set nhl_names {}
11597 set highlight_paths {}
11598 set findpattern {}
11599 set searchdirn -forwards
11600 set boldids {}
11601 set boldnameids {}
11602 set diffelide {0 0}
11603 set markingmatches 0
11604 set linkentercount 0
11605 set need_redisplay 0
11606 set nrows_drawn 0
11607 set firsttabstop 0
11608
11609 set nextviewnum 1
11610 set curview 0
11611 set selectedview 0
11612 set selectedhlview [mc "None"]
11613 set highlight_related [mc "None"]
11614 set highlight_files {}
11615 set viewfiles(0) {}
11616 set viewperm(0) 0
11617 set viewargs(0) {}
11618 set viewargscmd(0) {}
11619
11620 set selectedline {}
11621 set numcommits 0
11622 set loginstance 0
11623 set cmdlineok 0
11624 set stopped 0
11625 set stuffsaved 0
11626 set patchnum 0
11627 set lserial 0
11628 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11629 setcoords
11630 makewindow
11631 catch {
11632     image create photo gitlogo      -width 16 -height 16
11633
11634     image create photo gitlogominus -width  4 -height  2
11635     gitlogominus put #C00000 -to 0 0 4 2
11636     gitlogo copy gitlogominus -to  1 5
11637     gitlogo copy gitlogominus -to  6 5
11638     gitlogo copy gitlogominus -to 11 5
11639     image delete gitlogominus
11640
11641     image create photo gitlogoplus  -width  4 -height  4
11642     gitlogoplus  put #008000 -to 1 0 3 4
11643     gitlogoplus  put #008000 -to 0 1 4 3
11644     gitlogo copy gitlogoplus  -to  1 9
11645     gitlogo copy gitlogoplus  -to  6 9
11646     gitlogo copy gitlogoplus  -to 11 9
11647     image delete gitlogoplus
11648
11649     image create photo gitlogo32    -width 32 -height 32
11650     gitlogo32 copy gitlogo -zoom 2 2
11651
11652     wm iconphoto . -default gitlogo gitlogo32
11653 }
11654 # wait for the window to become visible
11655 tkwait visibility .
11656 wm title . "[file tail $argv0]: [file tail [pwd]]"
11657 update
11658 readrefs
11659
11660 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11661     # create a view for the files/dirs specified on the command line
11662     set curview 1
11663     set selectedview 1
11664     set nextviewnum 2
11665     set viewname(1) [mc "Command line"]
11666     set viewfiles(1) $cmdline_files
11667     set viewargs(1) $revtreeargs
11668     set viewargscmd(1) $revtreeargscmd
11669     set viewperm(1) 0
11670     set vdatemode(1) 0
11671     addviewmenu 1
11672     .bar.view entryconf [mca "Edit view..."] -state normal
11673     .bar.view entryconf [mca "Delete view"] -state normal
11674 }
11675
11676 if {[info exists permviews]} {
11677     foreach v $permviews {
11678         set n $nextviewnum
11679         incr nextviewnum
11680         set viewname($n) [lindex $v 0]
11681         set viewfiles($n) [lindex $v 1]
11682         set viewargs($n) [lindex $v 2]
11683         set viewargscmd($n) [lindex $v 3]
11684         set viewperm($n) 1
11685         addviewmenu $n
11686     }
11687 }
11688
11689 if {[tk windowingsystem] eq "win32"} {
11690     focus -force .
11691 }
11692
11693 getcommits {}
11694
11695 # Local variables:
11696 # mode: tcl
11697 # indent-tabs-mode: t
11698 # tab-width: 8
11699 # End: