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