gitk

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