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