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