gitk

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