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