gitk

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