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