gitk

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