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