git.oblomov.eu Git - git/blob - gitk-git/gitk

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