gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 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 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return [exec git rev-parse --git-dir]
  16     }
  17 }
  18
  19 # A simple scheduler for compute-intensive stuff.
  20 # The aim is to make sure that event handlers for GUI actions can
  21 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22 # run before X event handlers, so reading from a fast source can
  23 # make the GUI completely unresponsive.
  24 proc run args {
  25     global isonrunq runq
  26
  27     set script $args
  28     if {[info exists isonrunq($script)]} return
  29     if {$runq eq {}} {
  30         after idle dorunq
  31     }
  32     lappend runq [list {} $script]
  33     set isonrunq($script) 1
  34 }
  35
  36 proc filerun {fd script} {
  37     fileevent $fd readable [list filereadable $fd $script]
  38 }
  39
  40 proc filereadable {fd script} {
  41     global runq
  42
  43     fileevent $fd readable {}
  44     if {$runq eq {}} {
  45         after idle dorunq
  46     }
  47     lappend runq [list $fd $script]
  48 }
  49
  50 proc dorunq {} {
  51     global isonrunq runq
  52
  53     set tstart [clock clicks -milliseconds]
  54     set t0 $tstart
  55     while {$runq ne {}} {
  56         set fd [lindex $runq 0 0]
  57         set script [lindex $runq 0 1]
  58         set repeat [eval $script]
  59         set t1 [clock clicks -milliseconds]
  60         set t [expr {$t1 - $t0}]
  61         set runq [lrange $runq 1 end]
  62         if {$repeat ne {} && $repeat} {
  63             if {$fd eq {} || $repeat == 2} {
  64                 # script returns 1 if it wants to be readded
  65                 # file readers return 2 if they could do more straight away
  66                 lappend runq [list $fd $script]
  67             } else {
  68                 fileevent $fd readable [list filereadable $fd $script]
  69             }
  70         } elseif {$fd eq {}} {
  71             unset isonrunq($script)
  72         }
  73         set t0 $t1
  74         if {$t1 - $tstart >= 80} break
  75     }
  76     if {$runq ne {}} {
  77         after idle dorunq
  78     }
  79 }
  80
  81 # Start off a git rev-list process and arrange to read its output
  82 proc start_rev_list {view} {
  83     global startmsecs
  84     global commfd leftover tclencoding datemode
  85     global viewargs viewfiles commitidx
  86
  87     set startmsecs [clock clicks -milliseconds]
  88     set commitidx($view) 0
  89     set args $viewargs($view)
  90     if {$viewfiles($view) ne {}} {
  91         set args [concat $args "--" $viewfiles($view)]
  92     }
  93     set order "--topo-order"
  94     if {$datemode} {
  95         set order "--date-order"
  96     }
  97     if {[catch {
  98         set fd [open [concat | git rev-list --header $order \
  99                           --parents --boundary --default HEAD $args] r]
 100     } err]} {
 101         puts stderr "Error executing git rev-list: $err"
 102         exit 1
 103     }
 104     set commfd($view) $fd
 105     set leftover($view) {}
 106     fconfigure $fd -blocking 0 -translation lf
 107     if {$tclencoding != {}} {
 108         fconfigure $fd -encoding $tclencoding
 109     }
 110     filerun $fd [list getcommitlines $fd $view]
 111     nowbusy $view
 112 }
 113
 114 proc stop_rev_list {} {
 115     global commfd curview
 116
 117     if {![info exists commfd($curview)]} return
 118     set fd $commfd($curview)
 119     catch {
 120         set pid [pid $fd]
 121         exec kill $pid
 122     }
 123     catch {close $fd}
 124     unset commfd($curview)
 125 }
 126
 127 proc getcommits {} {
 128     global phase canv mainfont curview
 129
 130     set phase getcommits
 131     initlayout
 132     start_rev_list $curview
 133     show_status "Reading commits..."
 134 }
 135
 136 proc getcommitlines {fd view}  {
 137     global commitlisted
 138     global leftover commfd
 139     global displayorder commitidx commitrow commitdata
 140     global parentlist childlist children curview hlview
 141     global vparentlist vchildlist vdisporder vcmitlisted
 142
 143     set stuff [read $fd 500000]
 144     if {$stuff == {}} {
 145         if {![eof $fd]} {
 146             return 1
 147         }
 148         global viewname
 149         unset commfd($view)
 150         notbusy $view
 151         # set it blocking so we wait for the process to terminate
 152         fconfigure $fd -blocking 1
 153         if {[catch {close $fd} err]} {
 154             set fv {}
 155             if {$view != $curview} {
 156                 set fv " for the \"$viewname($view)\" view"
 157             }
 158             if {[string range $err 0 4] == "usage"} {
 159                 set err "Gitk: error reading commits$fv:\
 160                         bad arguments to git rev-list."
 161                 if {$viewname($view) eq "Command line"} {
 162                     append err \
 163                         "  (Note: arguments to gitk are passed to git rev-list\
 164                          to allow selection of commits to be displayed.)"
 165                 }
 166             } else {
 167                 set err "Error reading commits$fv: $err"
 168             }
 169             error_popup $err
 170         }
 171         if {$view == $curview} {
 172             run chewcommits $view
 173         }
 174         return 0
 175     }
 176     set start 0
 177     set gotsome 0
 178     while 1 {
 179         set i [string first "\0" $stuff $start]
 180         if {$i < 0} {
 181             append leftover($view) [string range $stuff $start end]
 182             break
 183         }
 184         if {$start == 0} {
 185             set cmit $leftover($view)
 186             append cmit [string range $stuff 0 [expr {$i - 1}]]
 187             set leftover($view) {}
 188         } else {
 189             set cmit [string range $stuff $start [expr {$i - 1}]]
 190         }
 191         set start [expr {$i + 1}]
 192         set j [string first "\n" $cmit]
 193         set ok 0
 194         set listed 1
 195         if {$j >= 0} {
 196             set ids [string range $cmit 0 [expr {$j - 1}]]
 197             if {[string range $ids 0 0] == "-"} {
 198                 set listed 0
 199                 set ids [string range $ids 1 end]
 200             }
 201             set ok 1
 202             foreach id $ids {
 203                 if {[string length $id] != 40} {
 204                     set ok 0
 205                     break
 206                 }
 207             }
 208         }
 209         if {!$ok} {
 210             set shortcmit $cmit
 211             if {[string length $shortcmit] > 80} {
 212                 set shortcmit "[string range $shortcmit 0 80]..."
 213             }
 214             error_popup "Can't parse git rev-list output: {$shortcmit}"
 215             exit 1
 216         }
 217         set id [lindex $ids 0]
 218         if {$listed} {
 219             set olds [lrange $ids 1 end]
 220             set i 0
 221             foreach p $olds {
 222                 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 223                     lappend children($view,$p) $id
 224                 }
 225                 incr i
 226             }
 227         } else {
 228             set olds {}
 229         }
 230         if {![info exists children($view,$id)]} {
 231             set children($view,$id) {}
 232         }
 233         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 234         set commitrow($view,$id) $commitidx($view)
 235         incr commitidx($view)
 236         if {$view == $curview} {
 237             lappend parentlist $olds
 238             lappend childlist $children($view,$id)
 239             lappend displayorder $id
 240             lappend commitlisted $listed
 241         } else {
 242             lappend vparentlist($view) $olds
 243             lappend vchildlist($view) $children($view,$id)
 244             lappend vdisporder($view) $id
 245             lappend vcmitlisted($view) $listed
 246         }
 247         set gotsome 1
 248     }
 249     if {$gotsome} {
 250         run chewcommits $view
 251     }
 252     return 2
 253 }
 254
 255 proc chewcommits {view} {
 256     global curview hlview commfd
 257     global selectedline pending_select
 258
 259     set more 0
 260     if {$view == $curview} {
 261         set allread [expr {![info exists commfd($view)]}]
 262         set tlimit [expr {[clock clicks -milliseconds] + 50}]
 263         set more [layoutmore $tlimit $allread]
 264         if {$allread && !$more} {
 265             global displayorder commitidx phase
 266             global numcommits startmsecs
 267
 268             if {[info exists pending_select]} {
 269                 set row [expr {[lindex $displayorder 0] eq $nullid}]
 270                 selectline $row 1
 271             }
 272             if {$commitidx($curview) > 0} {
 273                 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 274                 #puts "overall $ms ms for $numcommits commits"
 275             } else {
 276                 show_status "No commits selected"
 277             }
 278             notbusy layout
 279             set phase {}
 280         }
 281     }
 282     if {[info exists hlview] && $view == $hlview} {
 283         vhighlightmore
 284     }
 285     return $more
 286 }
 287
 288 proc readcommit {id} {
 289     if {[catch {set contents [exec git cat-file commit $id]}]} return
 290     parsecommit $id $contents 0
 291 }
 292
 293 proc updatecommits {} {
 294     global viewdata curview phase displayorder
 295     global children commitrow selectedline thickerline
 296
 297     if {$phase ne {}} {
 298         stop_rev_list
 299         set phase {}
 300     }
 301     set n $curview
 302     foreach id $displayorder {
 303         catch {unset children($n,$id)}
 304         catch {unset commitrow($n,$id)}
 305     }
 306     set curview -1
 307     catch {unset selectedline}
 308     catch {unset thickerline}
 309     catch {unset viewdata($n)}
 310     readrefs
 311     changedrefs
 312     regetallcommits
 313     showview $n
 314 }
 315
 316 proc parsecommit {id contents listed} {
 317     global commitinfo cdate
 318
 319     set inhdr 1
 320     set comment {}
 321     set headline {}
 322     set auname {}
 323     set audate {}
 324     set comname {}
 325     set comdate {}
 326     set hdrend [string first "\n\n" $contents]
 327     if {$hdrend < 0} {
 328         # should never happen...
 329         set hdrend [string length $contents]
 330     }
 331     set header [string range $contents 0 [expr {$hdrend - 1}]]
 332     set comment [string range $contents [expr {$hdrend + 2}] end]
 333     foreach line [split $header "\n"] {
 334         set tag [lindex $line 0]
 335         if {$tag == "author"} {
 336             set audate [lindex $line end-1]
 337             set auname [lrange $line 1 end-2]
 338         } elseif {$tag == "committer"} {
 339             set comdate [lindex $line end-1]
 340             set comname [lrange $line 1 end-2]
 341         }
 342     }
 343     set headline {}
 344     # take the first line of the comment as the headline
 345     set i [string first "\n" $comment]
 346     if {$i >= 0} {
 347         set headline [string trim [string range $comment 0 $i]]
 348     } else {
 349         set headline $comment
 350     }
 351     if {!$listed} {
 352         # git rev-list indents the comment by 4 spaces;
 353         # if we got this via git cat-file, add the indentation
 354         set newcomment {}
 355         foreach line [split $comment "\n"] {
 356             append newcomment "    "
 357             append newcomment $line
 358             append newcomment "\n"
 359         }
 360         set comment $newcomment
 361     }
 362     if {$comdate != {}} {
 363         set cdate($id) $comdate
 364     }
 365     set commitinfo($id) [list $headline $auname $audate \
 366                              $comname $comdate $comment]
 367 }
 368
 369 proc getcommit {id} {
 370     global commitdata commitinfo
 371
 372     if {[info exists commitdata($id)]} {
 373         parsecommit $id $commitdata($id) 1
 374     } else {
 375         readcommit $id
 376         if {![info exists commitinfo($id)]} {
 377             set commitinfo($id) {"No commit information available"}
 378         }
 379     }
 380     return 1
 381 }
 382
 383 proc readrefs {} {
 384     global tagids idtags headids idheads tagcontents
 385     global otherrefids idotherrefs mainhead
 386
 387     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 388         catch {unset $v}
 389     }
 390     set refd [open [list | git show-ref] r]
 391     while {0 <= [set n [gets $refd line]]} {
 392         if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
 393             match id path]} {
 394             continue
 395         }
 396         if {[regexp {^remotes/.*/HEAD$} $path match]} {
 397             continue
 398         }
 399         if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 400             set type others
 401             set name $path
 402         }
 403         if {[regexp {^remotes/} $path match]} {
 404             set type heads
 405         }
 406         if {$type == "tags"} {
 407             set tagids($name) $id
 408             lappend idtags($id) $name
 409             set obj {}
 410             set type {}
 411             set tag {}
 412             catch {
 413                 set commit [exec git rev-parse "$id^0"]
 414                 if {$commit != $id} {
 415                     set tagids($name) $commit
 416                     lappend idtags($commit) $name
 417                 }
 418             }
 419             catch {
 420                 set tagcontents($name) [exec git cat-file tag $id]
 421             }
 422         } elseif { $type == "heads" } {
 423             set headids($name) $id
 424             lappend idheads($id) $name
 425         } else {
 426             set otherrefids($name) $id
 427             lappend idotherrefs($id) $name
 428         }
 429     }
 430     close $refd
 431     set mainhead {}
 432     catch {
 433         set thehead [exec git symbolic-ref HEAD]
 434         if {[string match "refs/heads/*" $thehead]} {
 435             set mainhead [string range $thehead 11 end]
 436         }
 437     }
 438 }
 439
 440 # update things for a head moved to a child of its previous location
 441 proc movehead {id name} {
 442     global headids idheads
 443
 444     removehead $headids($name) $name
 445     set headids($name) $id
 446     lappend idheads($id) $name
 447 }
 448
 449 # update things when a head has been removed
 450 proc removehead {id name} {
 451     global headids idheads
 452
 453     if {$idheads($id) eq $name} {
 454         unset idheads($id)
 455     } else {
 456         set i [lsearch -exact $idheads($id) $name]
 457         if {$i >= 0} {
 458             set idheads($id) [lreplace $idheads($id) $i $i]
 459         }
 460     }
 461     unset headids($name)
 462 }
 463
 464 proc show_error {w top msg} {
 465     message $w.m -text $msg -justify center -aspect 400
 466     pack $w.m -side top -fill x -padx 20 -pady 20
 467     button $w.ok -text OK -command "destroy $top"
 468     pack $w.ok -side bottom -fill x
 469     bind $top <Visibility> "grab $top; focus $top"
 470     bind $top <Key-Return> "destroy $top"
 471     tkwait window $top
 472 }
 473
 474 proc error_popup msg {
 475     set w .error
 476     toplevel $w
 477     wm transient $w .
 478     show_error $w $w $msg
 479 }
 480
 481 proc confirm_popup msg {
 482     global confirm_ok
 483     set confirm_ok 0
 484     set w .confirm
 485     toplevel $w
 486     wm transient $w .
 487     message $w.m -text $msg -justify center -aspect 400
 488     pack $w.m -side top -fill x -padx 20 -pady 20
 489     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 490     pack $w.ok -side left -fill x
 491     button $w.cancel -text Cancel -command "destroy $w"
 492     pack $w.cancel -side right -fill x
 493     bind $w <Visibility> "grab $w; focus $w"
 494     tkwait window $w
 495     return $confirm_ok
 496 }
 497
 498 proc makewindow {} {
 499     global canv canv2 canv3 linespc charspc ctext cflist
 500     global textfont mainfont uifont tabstop
 501     global findtype findtypemenu findloc findstring fstring geometry
 502     global entries sha1entry sha1string sha1but
 503     global maincursor textcursor curtextcursor
 504     global rowctxmenu mergemax wrapcomment
 505     global highlight_files gdttype
 506     global searchstring sstring
 507     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 508     global headctxmenu
 509
 510     menu .bar
 511     .bar add cascade -label "File" -menu .bar.file
 512     .bar configure -font $uifont
 513     menu .bar.file
 514     .bar.file add command -label "Update" -command updatecommits
 515     .bar.file add command -label "Reread references" -command rereadrefs
 516     .bar.file add command -label "Quit" -command doquit
 517     .bar.file configure -font $uifont
 518     menu .bar.edit
 519     .bar add cascade -label "Edit" -menu .bar.edit
 520     .bar.edit add command -label "Preferences" -command doprefs
 521     .bar.edit configure -font $uifont
 522
 523     menu .bar.view -font $uifont
 524     .bar add cascade -label "View" -menu .bar.view
 525     .bar.view add command -label "New view..." -command {newview 0}
 526     .bar.view add command -label "Edit view..." -command editview \
 527         -state disabled
 528     .bar.view add command -label "Delete view" -command delview -state disabled
 529     .bar.view add separator
 530     .bar.view add radiobutton -label "All files" -command {showview 0} \
 531         -variable selectedview -value 0
 532
 533     menu .bar.help
 534     .bar add cascade -label "Help" -menu .bar.help
 535     .bar.help add command -label "About gitk" -command about
 536     .bar.help add command -label "Key bindings" -command keys
 537     .bar.help configure -font $uifont
 538     . configure -menu .bar
 539
 540     # the gui has upper and lower half, parts of a paned window.
 541     panedwindow .ctop -orient vertical
 542
 543     # possibly use assumed geometry
 544     if {![info exists geometry(pwsash0)]} {
 545         set geometry(topheight) [expr {15 * $linespc}]
 546         set geometry(topwidth) [expr {80 * $charspc}]
 547         set geometry(botheight) [expr {15 * $linespc}]
 548         set geometry(botwidth) [expr {50 * $charspc}]
 549         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 550         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 551     }
 552
 553     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 554     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 555     frame .tf.histframe
 556     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 557
 558     # create three canvases
 559     set cscroll .tf.histframe.csb
 560     set canv .tf.histframe.pwclist.canv
 561     canvas $canv \
 562         -selectbackground $selectbgcolor \
 563         -background $bgcolor -bd 0 \
 564         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 565     .tf.histframe.pwclist add $canv
 566     set canv2 .tf.histframe.pwclist.canv2
 567     canvas $canv2 \
 568         -selectbackground $selectbgcolor \
 569         -background $bgcolor -bd 0 -yscrollincr $linespc
 570     .tf.histframe.pwclist add $canv2
 571     set canv3 .tf.histframe.pwclist.canv3
 572     canvas $canv3 \
 573         -selectbackground $selectbgcolor \
 574         -background $bgcolor -bd 0 -yscrollincr $linespc
 575     .tf.histframe.pwclist add $canv3
 576     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 577     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 578
 579     # a scroll bar to rule them
 580     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 581     pack $cscroll -side right -fill y
 582     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 583     lappend bglist $canv $canv2 $canv3
 584     pack .tf.histframe.pwclist -fill both -expand 1 -side left
 585
 586     # we have two button bars at bottom of top frame. Bar 1
 587     frame .tf.bar
 588     frame .tf.lbar -height 15
 589
 590     set sha1entry .tf.bar.sha1
 591     set entries $sha1entry
 592     set sha1but .tf.bar.sha1label
 593     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 594         -command gotocommit -width 8 -font $uifont
 595     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 596     pack .tf.bar.sha1label -side left
 597     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 598     trace add variable sha1string write sha1change
 599     pack $sha1entry -side left -pady 2
 600
 601     image create bitmap bm-left -data {
 602         #define left_width 16
 603         #define left_height 16
 604         static unsigned char left_bits[] = {
 605         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 606         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 607         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 608     }
 609     image create bitmap bm-right -data {
 610         #define right_width 16
 611         #define right_height 16
 612         static unsigned char right_bits[] = {
 613         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 614         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 615         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 616     }
 617     button .tf.bar.leftbut -image bm-left -command goback \
 618         -state disabled -width 26
 619     pack .tf.bar.leftbut -side left -fill y
 620     button .tf.bar.rightbut -image bm-right -command goforw \
 621         -state disabled -width 26
 622     pack .tf.bar.rightbut -side left -fill y
 623
 624     button .tf.bar.findbut -text "Find" -command dofind -font $uifont
 625     pack .tf.bar.findbut -side left
 626     set findstring {}
 627     set fstring .tf.bar.findstring
 628     lappend entries $fstring
 629     entry $fstring -width 30 -font $textfont -textvariable findstring
 630     trace add variable findstring write find_change
 631     pack $fstring -side left -expand 1 -fill x -in .tf.bar
 632     set findtype Exact
 633     set findtypemenu [tk_optionMenu .tf.bar.findtype \
 634                       findtype Exact IgnCase Regexp]
 635     trace add variable findtype write find_change
 636     .tf.bar.findtype configure -font $uifont
 637     .tf.bar.findtype.menu configure -font $uifont
 638     set findloc "All fields"
 639     tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
 640         Comments Author Committer
 641     trace add variable findloc write find_change
 642     .tf.bar.findloc configure -font $uifont
 643     .tf.bar.findloc.menu configure -font $uifont
 644     pack .tf.bar.findloc -side right
 645     pack .tf.bar.findtype -side right
 646
 647     # build up the bottom bar of upper window
 648     label .tf.lbar.flabel -text "Highlight:  Commits " \
 649     -font $uifont
 650     pack .tf.lbar.flabel -side left -fill y
 651     set gdttype "touching paths:"
 652     set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
 653         "adding/removing string:"]
 654     trace add variable gdttype write hfiles_change
 655     $gm conf -font $uifont
 656     .tf.lbar.gdttype conf -font $uifont
 657     pack .tf.lbar.gdttype -side left -fill y
 658     entry .tf.lbar.fent -width 25 -font $textfont \
 659         -textvariable highlight_files
 660     trace add variable highlight_files write hfiles_change
 661     lappend entries .tf.lbar.fent
 662     pack .tf.lbar.fent -side left -fill x -expand 1
 663     label .tf.lbar.vlabel -text " OR in view" -font $uifont
 664     pack .tf.lbar.vlabel -side left -fill y
 665     global viewhlmenu selectedhlview
 666     set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
 667     $viewhlmenu entryconf None -command delvhighlight
 668     $viewhlmenu conf -font $uifont
 669     .tf.lbar.vhl conf -font $uifont
 670     pack .tf.lbar.vhl -side left -fill y
 671     label .tf.lbar.rlabel -text " OR " -font $uifont
 672     pack .tf.lbar.rlabel -side left -fill y
 673     global highlight_related
 674     set m [tk_optionMenu .tf.lbar.relm highlight_related None \
 675         "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 676     $m conf -font $uifont
 677     .tf.lbar.relm conf -font $uifont
 678     trace add variable highlight_related write vrel_change
 679     pack .tf.lbar.relm -side left -fill y
 680
 681     # Finish putting the upper half of the viewer together
 682     pack .tf.lbar -in .tf -side bottom -fill x
 683     pack .tf.bar -in .tf -side bottom -fill x
 684     pack .tf.histframe -fill both -side top -expand 1
 685     .ctop add .tf
 686     .ctop paneconfigure .tf -height $geometry(topheight)
 687     .ctop paneconfigure .tf -width $geometry(topwidth)
 688
 689     # now build up the bottom
 690     panedwindow .pwbottom -orient horizontal
 691
 692     # lower left, a text box over search bar, scroll bar to the right
 693     # if we know window height, then that will set the lower text height, otherwise
 694     # we set lower text height which will drive window height
 695     if {[info exists geometry(main)]} {
 696         frame .bleft -width $geometry(botwidth)
 697     } else {
 698         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 699     }
 700     frame .bleft.top
 701     frame .bleft.mid
 702
 703     button .bleft.top.search -text "Search" -command dosearch \
 704         -font $uifont
 705     pack .bleft.top.search -side left -padx 5
 706     set sstring .bleft.top.sstring
 707     entry $sstring -width 20 -font $textfont -textvariable searchstring
 708     lappend entries $sstring
 709     trace add variable searchstring write incrsearch
 710     pack $sstring -side left -expand 1 -fill x
 711     radiobutton .bleft.mid.diff -text "Diff" \
 712         -command changediffdisp -variable diffelide -value {0 0}
 713     radiobutton .bleft.mid.old -text "Old version" \
 714         -command changediffdisp -variable diffelide -value {0 1}
 715     radiobutton .bleft.mid.new -text "New version" \
 716         -command changediffdisp -variable diffelide -value {1 0}
 717     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 718     set ctext .bleft.ctext
 719     text $ctext -background $bgcolor -foreground $fgcolor \
 720         -tabs "[expr {$tabstop * $charspc}]" \
 721         -state disabled -font $textfont \
 722         -yscrollcommand scrolltext -wrap none
 723     scrollbar .bleft.sb -command "$ctext yview"
 724     pack .bleft.top -side top -fill x
 725     pack .bleft.mid -side top -fill x
 726     pack .bleft.sb -side right -fill y
 727     pack $ctext -side left -fill both -expand 1
 728     lappend bglist $ctext
 729     lappend fglist $ctext
 730
 731     $ctext tag conf comment -wrap $wrapcomment
 732     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 733     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 734     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 735     $ctext tag conf d1 -fore [lindex $diffcolors 1]
 736     $ctext tag conf m0 -fore red
 737     $ctext tag conf m1 -fore blue
 738     $ctext tag conf m2 -fore green
 739     $ctext tag conf m3 -fore purple
 740     $ctext tag conf m4 -fore brown
 741     $ctext tag conf m5 -fore "#009090"
 742     $ctext tag conf m6 -fore magenta
 743     $ctext tag conf m7 -fore "#808000"
 744     $ctext tag conf m8 -fore "#009000"
 745     $ctext tag conf m9 -fore "#ff0080"
 746     $ctext tag conf m10 -fore cyan
 747     $ctext tag conf m11 -fore "#b07070"
 748     $ctext tag conf m12 -fore "#70b0f0"
 749     $ctext tag conf m13 -fore "#70f0b0"
 750     $ctext tag conf m14 -fore "#f0b070"
 751     $ctext tag conf m15 -fore "#ff70b0"
 752     $ctext tag conf mmax -fore darkgrey
 753     set mergemax 16
 754     $ctext tag conf mresult -font [concat $textfont bold]
 755     $ctext tag conf msep -font [concat $textfont bold]
 756     $ctext tag conf found -back yellow
 757
 758     .pwbottom add .bleft
 759     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 760
 761     # lower right
 762     frame .bright
 763     frame .bright.mode
 764     radiobutton .bright.mode.patch -text "Patch" \
 765         -command reselectline -variable cmitmode -value "patch"
 766     .bright.mode.patch configure -font $uifont
 767     radiobutton .bright.mode.tree -text "Tree" \
 768         -command reselectline -variable cmitmode -value "tree"
 769     .bright.mode.tree configure -font $uifont
 770     grid .bright.mode.patch .bright.mode.tree -sticky ew
 771     pack .bright.mode -side top -fill x
 772     set cflist .bright.cfiles
 773     set indent [font measure $mainfont "nn"]
 774     text $cflist \
 775         -selectbackground $selectbgcolor \
 776         -background $bgcolor -foreground $fgcolor \
 777         -font $mainfont \
 778         -tabs [list $indent [expr {2 * $indent}]] \
 779         -yscrollcommand ".bright.sb set" \
 780         -cursor [. cget -cursor] \
 781         -spacing1 1 -spacing3 1
 782     lappend bglist $cflist
 783     lappend fglist $cflist
 784     scrollbar .bright.sb -command "$cflist yview"
 785     pack .bright.sb -side right -fill y
 786     pack $cflist -side left -fill both -expand 1
 787     $cflist tag configure highlight \
 788         -background [$cflist cget -selectbackground]
 789     $cflist tag configure bold -font [concat $mainfont bold]
 790
 791     .pwbottom add .bright
 792     .ctop add .pwbottom
 793
 794     # restore window position if known
 795     if {[info exists geometry(main)]} {
 796         wm geometry . "$geometry(main)"
 797     }
 798
 799     bind .pwbottom <Configure> {resizecdetpanes %W %w}
 800     pack .ctop -fill both -expand 1
 801     bindall <1> {selcanvline %W %x %y}
 802     #bindall <B1-Motion> {selcanvline %W %x %y}
 803     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 804     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 805     bindall <2> "canvscan mark %W %x %y"
 806     bindall <B2-Motion> "canvscan dragto %W %x %y"
 807     bindkey <Home> selfirstline
 808     bindkey <End> sellastline
 809     bind . <Key-Up> "selnextline -1"
 810     bind . <Key-Down> "selnextline 1"
 811     bind . <Shift-Key-Up> "next_highlight -1"
 812     bind . <Shift-Key-Down> "next_highlight 1"
 813     bindkey <Key-Right> "goforw"
 814     bindkey <Key-Left> "goback"
 815     bind . <Key-Prior> "selnextpage -1"
 816     bind . <Key-Next> "selnextpage 1"
 817     bind . <Control-Home> "allcanvs yview moveto 0.0"
 818     bind . <Control-End> "allcanvs yview moveto 1.0"
 819     bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 820     bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 821     bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 822     bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 823     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 824     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 825     bindkey <Key-space> "$ctext yview scroll 1 pages"
 826     bindkey p "selnextline -1"
 827     bindkey n "selnextline 1"
 828     bindkey z "goback"
 829     bindkey x "goforw"
 830     bindkey i "selnextline -1"
 831     bindkey k "selnextline 1"
 832     bindkey j "goback"
 833     bindkey l "goforw"
 834     bindkey b "$ctext yview scroll -1 pages"
 835     bindkey d "$ctext yview scroll 18 units"
 836     bindkey u "$ctext yview scroll -18 units"
 837     bindkey / {findnext 1}
 838     bindkey <Key-Return> {findnext 0}
 839     bindkey ? findprev
 840     bindkey f nextfile
 841     bindkey <F5> updatecommits
 842     bind . <Control-q> doquit
 843     bind . <Control-f> dofind
 844     bind . <Control-g> {findnext 0}
 845     bind . <Control-r> dosearchback
 846     bind . <Control-s> dosearch
 847     bind . <Control-equal> {incrfont 1}
 848     bind . <Control-KP_Add> {incrfont 1}
 849     bind . <Control-minus> {incrfont -1}
 850     bind . <Control-KP_Subtract> {incrfont -1}
 851     wm protocol . WM_DELETE_WINDOW doquit
 852     bind . <Button-1> "click %W"
 853     bind $fstring <Key-Return> dofind
 854     bind $sha1entry <Key-Return> gotocommit
 855     bind $sha1entry <<PasteSelection>> clearsha1
 856     bind $cflist <1> {sel_flist %W %x %y; break}
 857     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 858     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 859
 860     set maincursor [. cget -cursor]
 861     set textcursor [$ctext cget -cursor]
 862     set curtextcursor $textcursor
 863
 864     set rowctxmenu .rowctxmenu
 865     menu $rowctxmenu -tearoff 0
 866     $rowctxmenu add command -label "Diff this -> selected" \
 867         -command {diffvssel 0}
 868     $rowctxmenu add command -label "Diff selected -> this" \
 869         -command {diffvssel 1}
 870     $rowctxmenu add command -label "Make patch" -command mkpatch
 871     $rowctxmenu add command -label "Create tag" -command mktag
 872     $rowctxmenu add command -label "Write commit to file" -command writecommit
 873     $rowctxmenu add command -label "Create new branch" -command mkbranch
 874     $rowctxmenu add command -label "Cherry-pick this commit" \
 875         -command cherrypick
 876
 877     set headctxmenu .headctxmenu
 878     menu $headctxmenu -tearoff 0
 879     $headctxmenu add command -label "Check out this branch" \
 880         -command cobranch
 881     $headctxmenu add command -label "Remove this branch" \
 882         -command rmbranch
 883 }
 884
 885 # mouse-2 makes all windows scan vertically, but only the one
 886 # the cursor is in scans horizontally
 887 proc canvscan {op w x y} {
 888     global canv canv2 canv3
 889     foreach c [list $canv $canv2 $canv3] {
 890         if {$c == $w} {
 891             $c scan $op $x $y
 892         } else {
 893             $c scan $op 0 $y
 894         }
 895     }
 896 }
 897
 898 proc scrollcanv {cscroll f0 f1} {
 899     $cscroll set $f0 $f1
 900     drawfrac $f0 $f1
 901     flushhighlights
 902 }
 903
 904 # when we make a key binding for the toplevel, make sure
 905 # it doesn't get triggered when that key is pressed in the
 906 # find string entry widget.
 907 proc bindkey {ev script} {
 908     global entries
 909     bind . $ev $script
 910     set escript [bind Entry $ev]
 911     if {$escript == {}} {
 912         set escript [bind Entry <Key>]
 913     }
 914     foreach e $entries {
 915         bind $e $ev "$escript; break"
 916     }
 917 }
 918
 919 # set the focus back to the toplevel for any click outside
 920 # the entry widgets
 921 proc click {w} {
 922     global entries
 923     foreach e $entries {
 924         if {$w == $e} return
 925     }
 926     focus .
 927 }
 928
 929 proc savestuff {w} {
 930     global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
 931     global stuffsaved findmergefiles maxgraphpct
 932     global maxwidth showneartags
 933     global viewname viewfiles viewargs viewperm nextviewnum
 934     global cmitmode wrapcomment
 935     global colors bgcolor fgcolor diffcolors selectbgcolor
 936
 937     if {$stuffsaved} return
 938     if {![winfo viewable .]} return
 939     catch {
 940         set f [open "~/.gitk-new" w]
 941         puts $f [list set mainfont $mainfont]
 942         puts $f [list set textfont $textfont]
 943         puts $f [list set uifont $uifont]
 944         puts $f [list set tabstop $tabstop]
 945         puts $f [list set findmergefiles $findmergefiles]
 946         puts $f [list set maxgraphpct $maxgraphpct]
 947         puts $f [list set maxwidth $maxwidth]
 948         puts $f [list set cmitmode $cmitmode]
 949         puts $f [list set wrapcomment $wrapcomment]
 950         puts $f [list set showneartags $showneartags]
 951         puts $f [list set bgcolor $bgcolor]
 952         puts $f [list set fgcolor $fgcolor]
 953         puts $f [list set colors $colors]
 954         puts $f [list set diffcolors $diffcolors]
 955         puts $f [list set selectbgcolor $selectbgcolor]
 956
 957         puts $f "set geometry(main) [wm geometry .]"
 958         puts $f "set geometry(topwidth) [winfo width .tf]"
 959         puts $f "set geometry(topheight) [winfo height .tf]"
 960         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
 961         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
 962         puts $f "set geometry(botwidth) [winfo width .bleft]"
 963         puts $f "set geometry(botheight) [winfo height .bleft]"
 964
 965         puts -nonewline $f "set permviews {"
 966         for {set v 0} {$v < $nextviewnum} {incr v} {
 967             if {$viewperm($v)} {
 968                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
 969             }
 970         }
 971         puts $f "}"
 972         close $f
 973         file rename -force "~/.gitk-new" "~/.gitk"
 974     }
 975     set stuffsaved 1
 976 }
 977
 978 proc resizeclistpanes {win w} {
 979     global oldwidth
 980     if {[info exists oldwidth($win)]} {
 981         set s0 [$win sash coord 0]
 982         set s1 [$win sash coord 1]
 983         if {$w < 60} {
 984             set sash0 [expr {int($w/2 - 2)}]
 985             set sash1 [expr {int($w*5/6 - 2)}]
 986         } else {
 987             set factor [expr {1.0 * $w / $oldwidth($win)}]
 988             set sash0 [expr {int($factor * [lindex $s0 0])}]
 989             set sash1 [expr {int($factor * [lindex $s1 0])}]
 990             if {$sash0 < 30} {
 991                 set sash0 30
 992             }
 993             if {$sash1 < $sash0 + 20} {
 994                 set sash1 [expr {$sash0 + 20}]
 995             }
 996             if {$sash1 > $w - 10} {
 997                 set sash1 [expr {$w - 10}]
 998                 if {$sash0 > $sash1 - 20} {
 999                     set sash0 [expr {$sash1 - 20}]
1000                 }
1001             }
1002         }
1003         $win sash place 0 $sash0 [lindex $s0 1]
1004         $win sash place 1 $sash1 [lindex $s1 1]
1005     }
1006     set oldwidth($win) $w
1007 }
1008
1009 proc resizecdetpanes {win w} {
1010     global oldwidth
1011     if {[info exists oldwidth($win)]} {
1012         set s0 [$win sash coord 0]
1013         if {$w < 60} {
1014             set sash0 [expr {int($w*3/4 - 2)}]
1015         } else {
1016             set factor [expr {1.0 * $w / $oldwidth($win)}]
1017             set sash0 [expr {int($factor * [lindex $s0 0])}]
1018             if {$sash0 < 45} {
1019                 set sash0 45
1020             }
1021             if {$sash0 > $w - 15} {
1022                 set sash0 [expr {$w - 15}]
1023             }
1024         }
1025         $win sash place 0 $sash0 [lindex $s0 1]
1026     }
1027     set oldwidth($win) $w
1028 }
1029
1030 proc allcanvs args {
1031     global canv canv2 canv3
1032     eval $canv $args
1033     eval $canv2 $args
1034     eval $canv3 $args
1035 }
1036
1037 proc bindall {event action} {
1038     global canv canv2 canv3
1039     bind $canv $event $action
1040     bind $canv2 $event $action
1041     bind $canv3 $event $action
1042 }
1043
1044 proc about {} {
1045     global uifont
1046     set w .about
1047     if {[winfo exists $w]} {
1048         raise $w
1049         return
1050     }
1051     toplevel $w
1052     wm title $w "About gitk"
1053     message $w.m -text {
1054 Gitk - a commit viewer for git
1055
1056 Copyright © 2005-2006 Paul Mackerras
1057
1058 Use and redistribute under the terms of the GNU General Public License} \
1059             -justify center -aspect 400 -border 2 -bg white -relief groove
1060     pack $w.m -side top -fill x -padx 2 -pady 2
1061     $w.m configure -font $uifont
1062     button $w.ok -text Close -command "destroy $w" -default active
1063     pack $w.ok -side bottom
1064     $w.ok configure -font $uifont
1065     bind $w <Visibility> "focus $w.ok"
1066     bind $w <Key-Escape> "destroy $w"
1067     bind $w <Key-Return> "destroy $w"
1068 }
1069
1070 proc keys {} {
1071     global uifont
1072     set w .keys
1073     if {[winfo exists $w]} {
1074         raise $w
1075         return
1076     }
1077     toplevel $w
1078     wm title $w "Gitk key bindings"
1079     message $w.m -text {
1080 Gitk key bindings:
1081
1082 <Ctrl-Q>                Quit
1083 <Home>          Move to first commit
1084 <End>           Move to last commit
1085 <Up>, p, i      Move up one commit
1086 <Down>, n, k    Move down one commit
1087 <Left>, z, j    Go back in history list
1088 <Right>, x, l   Go forward in history list
1089 <PageUp>        Move up one page in commit list
1090 <PageDown>      Move down one page in commit list
1091 <Ctrl-Home>     Scroll to top of commit list
1092 <Ctrl-End>      Scroll to bottom of commit list
1093 <Ctrl-Up>       Scroll commit list up one line
1094 <Ctrl-Down>     Scroll commit list down one line
1095 <Ctrl-PageUp>   Scroll commit list up one page
1096 <Ctrl-PageDown> Scroll commit list down one page
1097 <Shift-Up>      Move to previous highlighted line
1098 <Shift-Down>    Move to next highlighted line
1099 <Delete>, b     Scroll diff view up one page
1100 <Backspace>     Scroll diff view up one page
1101 <Space>         Scroll diff view down one page
1102 u               Scroll diff view up 18 lines
1103 d               Scroll diff view down 18 lines
1104 <Ctrl-F>                Find
1105 <Ctrl-G>                Move to next find hit
1106 <Return>        Move to next find hit
1107 /               Move to next find hit, or redo find
1108 ?               Move to previous find hit
1109 f               Scroll diff view to next file
1110 <Ctrl-S>                Search for next hit in diff view
1111 <Ctrl-R>                Search for previous hit in diff view
1112 <Ctrl-KP+>      Increase font size
1113 <Ctrl-plus>     Increase font size
1114 <Ctrl-KP->      Decrease font size
1115 <Ctrl-minus>    Decrease font size
1116 <F5>            Update
1117 } \
1118             -justify left -bg white -border 2 -relief groove
1119     pack $w.m -side top -fill both -padx 2 -pady 2
1120     $w.m configure -font $uifont
1121     button $w.ok -text Close -command "destroy $w" -default active
1122     pack $w.ok -side bottom
1123     $w.ok configure -font $uifont
1124     bind $w <Visibility> "focus $w.ok"
1125     bind $w <Key-Escape> "destroy $w"
1126     bind $w <Key-Return> "destroy $w"
1127 }
1128
1129 # Procedures for manipulating the file list window at the
1130 # bottom right of the overall window.
1131
1132 proc treeview {w l openlevs} {
1133     global treecontents treediropen treeheight treeparent treeindex
1134
1135     set ix 0
1136     set treeindex() 0
1137     set lev 0
1138     set prefix {}
1139     set prefixend -1
1140     set prefendstack {}
1141     set htstack {}
1142     set ht 0
1143     set treecontents() {}
1144     $w conf -state normal
1145     foreach f $l {
1146         while {[string range $f 0 $prefixend] ne $prefix} {
1147             if {$lev <= $openlevs} {
1148                 $w mark set e:$treeindex($prefix) "end -1c"
1149                 $w mark gravity e:$treeindex($prefix) left
1150             }
1151             set treeheight($prefix) $ht
1152             incr ht [lindex $htstack end]
1153             set htstack [lreplace $htstack end end]
1154             set prefixend [lindex $prefendstack end]
1155             set prefendstack [lreplace $prefendstack end end]
1156             set prefix [string range $prefix 0 $prefixend]
1157             incr lev -1
1158         }
1159         set tail [string range $f [expr {$prefixend+1}] end]
1160         while {[set slash [string first "/" $tail]] >= 0} {
1161             lappend htstack $ht
1162             set ht 0
1163             lappend prefendstack $prefixend
1164             incr prefixend [expr {$slash + 1}]
1165             set d [string range $tail 0 $slash]
1166             lappend treecontents($prefix) $d
1167             set oldprefix $prefix
1168             append prefix $d
1169             set treecontents($prefix) {}
1170             set treeindex($prefix) [incr ix]
1171             set treeparent($prefix) $oldprefix
1172             set tail [string range $tail [expr {$slash+1}] end]
1173             if {$lev <= $openlevs} {
1174                 set ht 1
1175                 set treediropen($prefix) [expr {$lev < $openlevs}]
1176                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1177                 $w mark set d:$ix "end -1c"
1178                 $w mark gravity d:$ix left
1179                 set str "\n"
1180                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1181                 $w insert end $str
1182                 $w image create end -align center -image $bm -padx 1 \
1183                     -name a:$ix
1184                 $w insert end $d [highlight_tag $prefix]
1185                 $w mark set s:$ix "end -1c"
1186                 $w mark gravity s:$ix left
1187             }
1188             incr lev
1189         }
1190         if {$tail ne {}} {
1191             if {$lev <= $openlevs} {
1192                 incr ht
1193                 set str "\n"
1194                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1195                 $w insert end $str
1196                 $w insert end $tail [highlight_tag $f]
1197             }
1198             lappend treecontents($prefix) $tail
1199         }
1200     }
1201     while {$htstack ne {}} {
1202         set treeheight($prefix) $ht
1203         incr ht [lindex $htstack end]
1204         set htstack [lreplace $htstack end end]
1205     }
1206     $w conf -state disabled
1207 }
1208
1209 proc linetoelt {l} {
1210     global treeheight treecontents
1211
1212     set y 2
1213     set prefix {}
1214     while {1} {
1215         foreach e $treecontents($prefix) {
1216             if {$y == $l} {
1217                 return "$prefix$e"
1218             }
1219             set n 1
1220             if {[string index $e end] eq "/"} {
1221                 set n $treeheight($prefix$e)
1222                 if {$y + $n > $l} {
1223                     append prefix $e
1224                     incr y
1225                     break
1226                 }
1227             }
1228             incr y $n
1229         }
1230     }
1231 }
1232
1233 proc highlight_tree {y prefix} {
1234     global treeheight treecontents cflist
1235
1236     foreach e $treecontents($prefix) {
1237         set path $prefix$e
1238         if {[highlight_tag $path] ne {}} {
1239             $cflist tag add bold $y.0 "$y.0 lineend"
1240         }
1241         incr y
1242         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1243             set y [highlight_tree $y $path]
1244         }
1245     }
1246     return $y
1247 }
1248
1249 proc treeclosedir {w dir} {
1250     global treediropen treeheight treeparent treeindex
1251
1252     set ix $treeindex($dir)
1253     $w conf -state normal
1254     $w delete s:$ix e:$ix
1255     set treediropen($dir) 0
1256     $w image configure a:$ix -image tri-rt
1257     $w conf -state disabled
1258     set n [expr {1 - $treeheight($dir)}]
1259     while {$dir ne {}} {
1260         incr treeheight($dir) $n
1261         set dir $treeparent($dir)
1262     }
1263 }
1264
1265 proc treeopendir {w dir} {
1266     global treediropen treeheight treeparent treecontents treeindex
1267
1268     set ix $treeindex($dir)
1269     $w conf -state normal
1270     $w image configure a:$ix -image tri-dn
1271     $w mark set e:$ix s:$ix
1272     $w mark gravity e:$ix right
1273     set lev 0
1274     set str "\n"
1275     set n [llength $treecontents($dir)]
1276     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1277         incr lev
1278         append str "\t"
1279         incr treeheight($x) $n
1280     }
1281     foreach e $treecontents($dir) {
1282         set de $dir$e
1283         if {[string index $e end] eq "/"} {
1284             set iy $treeindex($de)
1285             $w mark set d:$iy e:$ix
1286             $w mark gravity d:$iy left
1287             $w insert e:$ix $str
1288             set treediropen($de) 0
1289             $w image create e:$ix -align center -image tri-rt -padx 1 \
1290                 -name a:$iy
1291             $w insert e:$ix $e [highlight_tag $de]
1292             $w mark set s:$iy e:$ix
1293             $w mark gravity s:$iy left
1294             set treeheight($de) 1
1295         } else {
1296             $w insert e:$ix $str
1297             $w insert e:$ix $e [highlight_tag $de]
1298         }
1299     }
1300     $w mark gravity e:$ix left
1301     $w conf -state disabled
1302     set treediropen($dir) 1
1303     set top [lindex [split [$w index @0,0] .] 0]
1304     set ht [$w cget -height]
1305     set l [lindex [split [$w index s:$ix] .] 0]
1306     if {$l < $top} {
1307         $w yview $l.0
1308     } elseif {$l + $n + 1 > $top + $ht} {
1309         set top [expr {$l + $n + 2 - $ht}]
1310         if {$l < $top} {
1311             set top $l
1312         }
1313         $w yview $top.0
1314     }
1315 }
1316
1317 proc treeclick {w x y} {
1318     global treediropen cmitmode ctext cflist cflist_top
1319
1320     if {$cmitmode ne "tree"} return
1321     if {![info exists cflist_top]} return
1322     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1323     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1324     $cflist tag add highlight $l.0 "$l.0 lineend"
1325     set cflist_top $l
1326     if {$l == 1} {
1327         $ctext yview 1.0
1328         return
1329     }
1330     set e [linetoelt $l]
1331     if {[string index $e end] ne "/"} {
1332         showfile $e
1333     } elseif {$treediropen($e)} {
1334         treeclosedir $w $e
1335     } else {
1336         treeopendir $w $e
1337     }
1338 }
1339
1340 proc setfilelist {id} {
1341     global treefilelist cflist
1342
1343     treeview $cflist $treefilelist($id) 0
1344 }
1345
1346 image create bitmap tri-rt -background black -foreground blue -data {
1347     #define tri-rt_width 13
1348     #define tri-rt_height 13
1349     static unsigned char tri-rt_bits[] = {
1350        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1351        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1352        0x00, 0x00};
1353 } -maskdata {
1354     #define tri-rt-mask_width 13
1355     #define tri-rt-mask_height 13
1356     static unsigned char tri-rt-mask_bits[] = {
1357        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1358        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1359        0x08, 0x00};
1360 }
1361 image create bitmap tri-dn -background black -foreground blue -data {
1362     #define tri-dn_width 13
1363     #define tri-dn_height 13
1364     static unsigned char tri-dn_bits[] = {
1365        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1366        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1367        0x00, 0x00};
1368 } -maskdata {
1369     #define tri-dn-mask_width 13
1370     #define tri-dn-mask_height 13
1371     static unsigned char tri-dn-mask_bits[] = {
1372        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1373        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1374        0x00, 0x00};
1375 }
1376
1377 proc init_flist {first} {
1378     global cflist cflist_top selectedline difffilestart
1379
1380     $cflist conf -state normal
1381     $cflist delete 0.0 end
1382     if {$first ne {}} {
1383         $cflist insert end $first
1384         set cflist_top 1
1385         $cflist tag add highlight 1.0 "1.0 lineend"
1386     } else {
1387         catch {unset cflist_top}
1388     }
1389     $cflist conf -state disabled
1390     set difffilestart {}
1391 }
1392
1393 proc highlight_tag {f} {
1394     global highlight_paths
1395
1396     foreach p $highlight_paths {
1397         if {[string match $p $f]} {
1398             return "bold"
1399         }
1400     }
1401     return {}
1402 }
1403
1404 proc highlight_filelist {} {
1405     global cmitmode cflist
1406
1407     $cflist conf -state normal
1408     if {$cmitmode ne "tree"} {
1409         set end [lindex [split [$cflist index end] .] 0]
1410         for {set l 2} {$l < $end} {incr l} {
1411             set line [$cflist get $l.0 "$l.0 lineend"]
1412             if {[highlight_tag $line] ne {}} {
1413                 $cflist tag add bold $l.0 "$l.0 lineend"
1414             }
1415         }
1416     } else {
1417         highlight_tree 2 {}
1418     }
1419     $cflist conf -state disabled
1420 }
1421
1422 proc unhighlight_filelist {} {
1423     global cflist
1424
1425     $cflist conf -state normal
1426     $cflist tag remove bold 1.0 end
1427     $cflist conf -state disabled
1428 }
1429
1430 proc add_flist {fl} {
1431     global cflist
1432
1433     $cflist conf -state normal
1434     foreach f $fl {
1435         $cflist insert end "\n"
1436         $cflist insert end $f [highlight_tag $f]
1437     }
1438     $cflist conf -state disabled
1439 }
1440
1441 proc sel_flist {w x y} {
1442     global ctext difffilestart cflist cflist_top cmitmode
1443
1444     if {$cmitmode eq "tree"} return
1445     if {![info exists cflist_top]} return
1446     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1447     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1448     $cflist tag add highlight $l.0 "$l.0 lineend"
1449     set cflist_top $l
1450     if {$l == 1} {
1451         $ctext yview 1.0
1452     } else {
1453         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1454     }
1455 }
1456
1457 # Functions for adding and removing shell-type quoting
1458
1459 proc shellquote {str} {
1460     if {![string match "*\['\"\\ \t]*" $str]} {
1461         return $str
1462     }
1463     if {![string match "*\['\"\\]*" $str]} {
1464         return "\"$str\""
1465     }
1466     if {![string match "*'*" $str]} {
1467         return "'$str'"
1468     }
1469     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1470 }
1471
1472 proc shellarglist {l} {
1473     set str {}
1474     foreach a $l {
1475         if {$str ne {}} {
1476             append str " "
1477         }
1478         append str [shellquote $a]
1479     }
1480     return $str
1481 }
1482
1483 proc shelldequote {str} {
1484     set ret {}
1485     set used -1
1486     while {1} {
1487         incr used
1488         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1489             append ret [string range $str $used end]
1490             set used [string length $str]
1491             break
1492         }
1493         set first [lindex $first 0]
1494         set ch [string index $str $first]
1495         if {$first > $used} {
1496             append ret [string range $str $used [expr {$first - 1}]]
1497             set used $first
1498         }
1499         if {$ch eq " " || $ch eq "\t"} break
1500         incr used
1501         if {$ch eq "'"} {
1502             set first [string first "'" $str $used]
1503             if {$first < 0} {
1504                 error "unmatched single-quote"
1505             }
1506             append ret [string range $str $used [expr {$first - 1}]]
1507             set used $first
1508             continue
1509         }
1510         if {$ch eq "\\"} {
1511             if {$used >= [string length $str]} {
1512                 error "trailing backslash"
1513             }
1514             append ret [string index $str $used]
1515             continue
1516         }
1517         # here ch == "\""
1518         while {1} {
1519             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1520                 error "unmatched double-quote"
1521             }
1522             set first [lindex $first 0]
1523             set ch [string index $str $first]
1524             if {$first > $used} {
1525                 append ret [string range $str $used [expr {$first - 1}]]
1526                 set used $first
1527             }
1528             if {$ch eq "\""} break
1529             incr used
1530             append ret [string index $str $used]
1531             incr used
1532         }
1533     }
1534     return [list $used $ret]
1535 }
1536
1537 proc shellsplit {str} {
1538     set l {}
1539     while {1} {
1540         set str [string trimleft $str]
1541         if {$str eq {}} break
1542         set dq [shelldequote $str]
1543         set n [lindex $dq 0]
1544         set word [lindex $dq 1]
1545         set str [string range $str $n end]
1546         lappend l $word
1547     }
1548     return $l
1549 }
1550
1551 # Code to implement multiple views
1552
1553 proc newview {ishighlight} {
1554     global nextviewnum newviewname newviewperm uifont newishighlight
1555     global newviewargs revtreeargs
1556
1557     set newishighlight $ishighlight
1558     set top .gitkview
1559     if {[winfo exists $top]} {
1560         raise $top
1561         return
1562     }
1563     set newviewname($nextviewnum) "View $nextviewnum"
1564     set newviewperm($nextviewnum) 0
1565     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1566     vieweditor $top $nextviewnum "Gitk view definition"
1567 }
1568
1569 proc editview {} {
1570     global curview
1571     global viewname viewperm newviewname newviewperm
1572     global viewargs newviewargs
1573
1574     set top .gitkvedit-$curview
1575     if {[winfo exists $top]} {
1576         raise $top
1577         return
1578     }
1579     set newviewname($curview) $viewname($curview)
1580     set newviewperm($curview) $viewperm($curview)
1581     set newviewargs($curview) [shellarglist $viewargs($curview)]
1582     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1583 }
1584
1585 proc vieweditor {top n title} {
1586     global newviewname newviewperm viewfiles
1587     global uifont
1588
1589     toplevel $top
1590     wm title $top $title
1591     label $top.nl -text "Name" -font $uifont
1592     entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1593     grid $top.nl $top.name -sticky w -pady 5
1594     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1595         -font $uifont
1596     grid $top.perm - -pady 5 -sticky w
1597     message $top.al -aspect 1000 -font $uifont \
1598         -text "Commits to include (arguments to git rev-list):"
1599     grid $top.al - -sticky w -pady 5
1600     entry $top.args -width 50 -textvariable newviewargs($n) \
1601         -background white -font $uifont
1602     grid $top.args - -sticky ew -padx 5
1603     message $top.l -aspect 1000 -font $uifont \
1604         -text "Enter files and directories to include, one per line:"
1605     grid $top.l - -sticky w
1606     text $top.t -width 40 -height 10 -background white -font $uifont
1607     if {[info exists viewfiles($n)]} {
1608         foreach f $viewfiles($n) {
1609             $top.t insert end $f
1610             $top.t insert end "\n"
1611         }
1612         $top.t delete {end - 1c} end
1613         $top.t mark set insert 0.0
1614     }
1615     grid $top.t - -sticky ew -padx 5
1616     frame $top.buts
1617     button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1618         -font $uifont
1619     button $top.buts.can -text "Cancel" -command [list destroy $top] \
1620         -font $uifont
1621     grid $top.buts.ok $top.buts.can
1622     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1623     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1624     grid $top.buts - -pady 10 -sticky ew
1625     focus $top.t
1626 }
1627
1628 proc doviewmenu {m first cmd op argv} {
1629     set nmenu [$m index end]
1630     for {set i $first} {$i <= $nmenu} {incr i} {
1631         if {[$m entrycget $i -command] eq $cmd} {
1632             eval $m $op $i $argv
1633             break
1634         }
1635     }
1636 }
1637
1638 proc allviewmenus {n op args} {
1639     global viewhlmenu
1640
1641     doviewmenu .bar.view 5 [list showview $n] $op $args
1642     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1643 }
1644
1645 proc newviewok {top n} {
1646     global nextviewnum newviewperm newviewname newishighlight
1647     global viewname viewfiles viewperm selectedview curview
1648     global viewargs newviewargs viewhlmenu
1649
1650     if {[catch {
1651         set newargs [shellsplit $newviewargs($n)]
1652     } err]} {
1653         error_popup "Error in commit selection arguments: $err"
1654         wm raise $top
1655         focus $top
1656         return
1657     }
1658     set files {}
1659     foreach f [split [$top.t get 0.0 end] "\n"] {
1660         set ft [string trim $f]
1661         if {$ft ne {}} {
1662             lappend files $ft
1663         }
1664     }
1665     if {![info exists viewfiles($n)]} {
1666         # creating a new view
1667         incr nextviewnum
1668         set viewname($n) $newviewname($n)
1669         set viewperm($n) $newviewperm($n)
1670         set viewfiles($n) $files
1671         set viewargs($n) $newargs
1672         addviewmenu $n
1673         if {!$newishighlight} {
1674             run showview $n
1675         } else {
1676             run addvhighlight $n
1677         }
1678     } else {
1679         # editing an existing view
1680         set viewperm($n) $newviewperm($n)
1681         if {$newviewname($n) ne $viewname($n)} {
1682             set viewname($n) $newviewname($n)
1683             doviewmenu .bar.view 5 [list showview $n] \
1684                 entryconf [list -label $viewname($n)]
1685             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1686                 entryconf [list -label $viewname($n) -value $viewname($n)]
1687         }
1688         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1689             set viewfiles($n) $files
1690             set viewargs($n) $newargs
1691             if {$curview == $n} {
1692                 run updatecommits
1693             }
1694         }
1695     }
1696     catch {destroy $top}
1697 }
1698
1699 proc delview {} {
1700     global curview viewdata viewperm hlview selectedhlview
1701
1702     if {$curview == 0} return
1703     if {[info exists hlview] && $hlview == $curview} {
1704         set selectedhlview None
1705         unset hlview
1706     }
1707     allviewmenus $curview delete
1708     set viewdata($curview) {}
1709     set viewperm($curview) 0
1710     showview 0
1711 }
1712
1713 proc addviewmenu {n} {
1714     global viewname viewhlmenu
1715
1716     .bar.view add radiobutton -label $viewname($n) \
1717         -command [list showview $n] -variable selectedview -value $n
1718     $viewhlmenu add radiobutton -label $viewname($n) \
1719         -command [list addvhighlight $n] -variable selectedhlview
1720 }
1721
1722 proc flatten {var} {
1723     global $var
1724
1725     set ret {}
1726     foreach i [array names $var] {
1727         lappend ret $i [set $var\($i\)]
1728     }
1729     return $ret
1730 }
1731
1732 proc unflatten {var l} {
1733     global $var
1734
1735     catch {unset $var}
1736     foreach {i v} $l {
1737         set $var\($i\) $v
1738     }
1739 }
1740
1741 proc showview {n} {
1742     global curview viewdata viewfiles
1743     global displayorder parentlist childlist rowidlist rowoffsets
1744     global colormap rowtextx commitrow nextcolor canvxmax
1745     global numcommits rowrangelist commitlisted idrowranges
1746     global selectedline currentid canv canvy0
1747     global matchinglines treediffs
1748     global pending_select phase
1749     global commitidx rowlaidout rowoptim linesegends
1750     global commfd
1751     global selectedview selectfirst
1752     global vparentlist vchildlist vdisporder vcmitlisted
1753     global hlview selectedhlview
1754
1755     if {$n == $curview} return
1756     set selid {}
1757     if {[info exists selectedline]} {
1758         set selid $currentid
1759         set y [yc $selectedline]
1760         set ymax [lindex [$canv cget -scrollregion] 3]
1761         set span [$canv yview]
1762         set ytop [expr {[lindex $span 0] * $ymax}]
1763         set ybot [expr {[lindex $span 1] * $ymax}]
1764         if {$ytop < $y && $y < $ybot} {
1765             set yscreen [expr {$y - $ytop}]
1766         } else {
1767             set yscreen [expr {($ybot - $ytop) / 2}]
1768         }
1769     } elseif {[info exists pending_select]} {
1770         set selid $pending_select
1771         unset pending_select
1772     }
1773     unselectline
1774     normalline
1775     stopfindproc
1776     if {$curview >= 0} {
1777         set vparentlist($curview) $parentlist
1778         set vchildlist($curview) $childlist
1779         set vdisporder($curview) $displayorder
1780         set vcmitlisted($curview) $commitlisted
1781         if {$phase ne {}} {
1782             set viewdata($curview) \
1783                 [list $phase $rowidlist $rowoffsets $rowrangelist \
1784                      [flatten idrowranges] [flatten idinlist] \
1785                      $rowlaidout $rowoptim $numcommits $linesegends]
1786         } elseif {![info exists viewdata($curview)]
1787                   || [lindex $viewdata($curview) 0] ne {}} {
1788             set viewdata($curview) \
1789                 [list {} $rowidlist $rowoffsets $rowrangelist]
1790         }
1791     }
1792     catch {unset matchinglines}
1793     catch {unset treediffs}
1794     clear_display
1795     if {[info exists hlview] && $hlview == $n} {
1796         unset hlview
1797         set selectedhlview None
1798     }
1799
1800     set curview $n
1801     set selectedview $n
1802     .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1803     .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1804
1805     if {![info exists viewdata($n)]} {
1806         if {$selid ne {}} {
1807             set pending_select $selid
1808         }
1809         getcommits
1810         return
1811     }
1812
1813     set v $viewdata($n)
1814     set phase [lindex $v 0]
1815     set displayorder $vdisporder($n)
1816     set parentlist $vparentlist($n)
1817     set childlist $vchildlist($n)
1818     set commitlisted $vcmitlisted($n)
1819     set rowidlist [lindex $v 1]
1820     set rowoffsets [lindex $v 2]
1821     set rowrangelist [lindex $v 3]
1822     if {$phase eq {}} {
1823         set numcommits [llength $displayorder]
1824         catch {unset idrowranges}
1825     } else {
1826         unflatten idrowranges [lindex $v 4]
1827         unflatten idinlist [lindex $v 5]
1828         set rowlaidout [lindex $v 6]
1829         set rowoptim [lindex $v 7]
1830         set numcommits [lindex $v 8]
1831         set linesegends [lindex $v 9]
1832     }
1833
1834     catch {unset colormap}
1835     catch {unset rowtextx}
1836     set nextcolor 0
1837     set canvxmax [$canv cget -width]
1838     set curview $n
1839     set row 0
1840     setcanvscroll
1841     set yf 0
1842     set row {}
1843     set selectfirst 0
1844     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1845         set row $commitrow($n,$selid)
1846         # try to get the selected row in the same position on the screen
1847         set ymax [lindex [$canv cget -scrollregion] 3]
1848         set ytop [expr {[yc $row] - $yscreen}]
1849         if {$ytop < 0} {
1850             set ytop 0
1851         }
1852         set yf [expr {$ytop * 1.0 / $ymax}]
1853     }
1854     allcanvs yview moveto $yf
1855     drawvisible
1856     if {$row ne {}} {
1857         selectline $row 0
1858     } elseif {$selid ne {}} {
1859         set pending_select $selid
1860     } else {
1861         if {$numcommits > 0} {
1862             selectline 0 0
1863         } else {
1864             set selectfirst 1
1865         }
1866     }
1867     if {$phase ne {}} {
1868         if {$phase eq "getcommits"} {
1869             show_status "Reading commits..."
1870         }
1871         run chewcommits $n
1872     } elseif {$numcommits == 0} {
1873         show_status "No commits selected"
1874     }
1875 }
1876
1877 # Stuff relating to the highlighting facility
1878
1879 proc ishighlighted {row} {
1880     global vhighlights fhighlights nhighlights rhighlights
1881
1882     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1883         return $nhighlights($row)
1884     }
1885     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1886         return $vhighlights($row)
1887     }
1888     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1889         return $fhighlights($row)
1890     }
1891     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1892         return $rhighlights($row)
1893     }
1894     return 0
1895 }
1896
1897 proc bolden {row font} {
1898     global canv linehtag selectedline boldrows
1899
1900     lappend boldrows $row
1901     $canv itemconf $linehtag($row) -font $font
1902     if {[info exists selectedline] && $row == $selectedline} {
1903         $canv delete secsel
1904         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1905                    -outline {{}} -tags secsel \
1906                    -fill [$canv cget -selectbackground]]
1907         $canv lower $t
1908     }
1909 }
1910
1911 proc bolden_name {row font} {
1912     global canv2 linentag selectedline boldnamerows
1913
1914     lappend boldnamerows $row
1915     $canv2 itemconf $linentag($row) -font $font
1916     if {[info exists selectedline] && $row == $selectedline} {
1917         $canv2 delete secsel
1918         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1919                    -outline {{}} -tags secsel \
1920                    -fill [$canv2 cget -selectbackground]]
1921         $canv2 lower $t
1922     }
1923 }
1924
1925 proc unbolden {} {
1926     global mainfont boldrows
1927
1928     set stillbold {}
1929     foreach row $boldrows {
1930         if {![ishighlighted $row]} {
1931             bolden $row $mainfont
1932         } else {
1933             lappend stillbold $row
1934         }
1935     }
1936     set boldrows $stillbold
1937 }
1938
1939 proc addvhighlight {n} {
1940     global hlview curview viewdata vhl_done vhighlights commitidx
1941
1942     if {[info exists hlview]} {
1943         delvhighlight
1944     }
1945     set hlview $n
1946     if {$n != $curview && ![info exists viewdata($n)]} {
1947         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1948         set vparentlist($n) {}
1949         set vchildlist($n) {}
1950         set vdisporder($n) {}
1951         set vcmitlisted($n) {}
1952         start_rev_list $n
1953     }
1954     set vhl_done $commitidx($hlview)
1955     if {$vhl_done > 0} {
1956         drawvisible
1957     }
1958 }
1959
1960 proc delvhighlight {} {
1961     global hlview vhighlights
1962
1963     if {![info exists hlview]} return
1964     unset hlview
1965     catch {unset vhighlights}
1966     unbolden
1967 }
1968
1969 proc vhighlightmore {} {
1970     global hlview vhl_done commitidx vhighlights
1971     global displayorder vdisporder curview mainfont
1972
1973     set font [concat $mainfont bold]
1974     set max $commitidx($hlview)
1975     if {$hlview == $curview} {
1976         set disp $displayorder
1977     } else {
1978         set disp $vdisporder($hlview)
1979     }
1980     set vr [visiblerows]
1981     set r0 [lindex $vr 0]
1982     set r1 [lindex $vr 1]
1983     for {set i $vhl_done} {$i < $max} {incr i} {
1984         set id [lindex $disp $i]
1985         if {[info exists commitrow($curview,$id)]} {
1986             set row $commitrow($curview,$id)
1987             if {$r0 <= $row && $row <= $r1} {
1988                 if {![highlighted $row]} {
1989                     bolden $row $font
1990                 }
1991                 set vhighlights($row) 1
1992             }
1993         }
1994     }
1995     set vhl_done $max
1996 }
1997
1998 proc askvhighlight {row id} {
1999     global hlview vhighlights commitrow iddrawn mainfont
2000
2001     if {[info exists commitrow($hlview,$id)]} {
2002         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2003             bolden $row [concat $mainfont bold]
2004         }
2005         set vhighlights($row) 1
2006     } else {
2007         set vhighlights($row) 0
2008     }
2009 }
2010
2011 proc hfiles_change {name ix op} {
2012     global highlight_files filehighlight fhighlights fh_serial
2013     global mainfont highlight_paths
2014
2015     if {[info exists filehighlight]} {
2016         # delete previous highlights
2017         catch {close $filehighlight}
2018         unset filehighlight
2019         catch {unset fhighlights}
2020         unbolden
2021         unhighlight_filelist
2022     }
2023     set highlight_paths {}
2024     after cancel do_file_hl $fh_serial
2025     incr fh_serial
2026     if {$highlight_files ne {}} {
2027         after 300 do_file_hl $fh_serial
2028     }
2029 }
2030
2031 proc makepatterns {l} {
2032     set ret {}
2033     foreach e $l {
2034         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2035         if {[string index $ee end] eq "/"} {
2036             lappend ret "$ee*"
2037         } else {
2038             lappend ret $ee
2039             lappend ret "$ee/*"
2040         }
2041     }
2042     return $ret
2043 }
2044
2045 proc do_file_hl {serial} {
2046     global highlight_files filehighlight highlight_paths gdttype fhl_list
2047
2048     if {$gdttype eq "touching paths:"} {
2049         if {[catch {set paths [shellsplit $highlight_files]}]} return
2050         set highlight_paths [makepatterns $paths]
2051         highlight_filelist
2052         set gdtargs [concat -- $paths]
2053     } else {
2054         set gdtargs [list "-S$highlight_files"]
2055     }
2056     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2057     set filehighlight [open $cmd r+]
2058     fconfigure $filehighlight -blocking 0
2059     filerun $filehighlight readfhighlight
2060     set fhl_list {}
2061     drawvisible
2062     flushhighlights
2063 }
2064
2065 proc flushhighlights {} {
2066     global filehighlight fhl_list
2067
2068     if {[info exists filehighlight]} {
2069         lappend fhl_list {}
2070         puts $filehighlight ""
2071         flush $filehighlight
2072     }
2073 }
2074
2075 proc askfilehighlight {row id} {
2076     global filehighlight fhighlights fhl_list
2077
2078     lappend fhl_list $id
2079     set fhighlights($row) -1
2080     puts $filehighlight $id
2081 }
2082
2083 proc readfhighlight {} {
2084     global filehighlight fhighlights commitrow curview mainfont iddrawn
2085     global fhl_list
2086
2087     if {![info exists filehighlight]} {
2088         return 0
2089     }
2090     set nr 0
2091     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2092         set line [string trim $line]
2093         set i [lsearch -exact $fhl_list $line]
2094         if {$i < 0} continue
2095         for {set j 0} {$j < $i} {incr j} {
2096             set id [lindex $fhl_list $j]
2097             if {[info exists commitrow($curview,$id)]} {
2098                 set fhighlights($commitrow($curview,$id)) 0
2099             }
2100         }
2101         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2102         if {$line eq {}} continue
2103         if {![info exists commitrow($curview,$line)]} continue
2104         set row $commitrow($curview,$line)
2105         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2106             bolden $row [concat $mainfont bold]
2107         }
2108         set fhighlights($row) 1
2109     }
2110     if {[eof $filehighlight]} {
2111         # strange...
2112         puts "oops, git diff-tree died"
2113         catch {close $filehighlight}
2114         unset filehighlight
2115         return 0
2116     }
2117     next_hlcont
2118     return 1
2119 }
2120
2121 proc find_change {name ix op} {
2122     global nhighlights mainfont boldnamerows
2123     global findstring findpattern findtype
2124
2125     # delete previous highlights, if any
2126     foreach row $boldnamerows {
2127         bolden_name $row $mainfont
2128     }
2129     set boldnamerows {}
2130     catch {unset nhighlights}
2131     unbolden
2132     if {$findtype ne "Regexp"} {
2133         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2134                    $findstring]
2135         set findpattern "*$e*"
2136     }
2137     drawvisible
2138 }
2139
2140 proc askfindhighlight {row id} {
2141     global nhighlights commitinfo iddrawn mainfont
2142     global findstring findtype findloc findpattern
2143
2144     if {![info exists commitinfo($id)]} {
2145         getcommit $id
2146     }
2147     set info $commitinfo($id)
2148     set isbold 0
2149     set fldtypes {Headline Author Date Committer CDate Comments}
2150     foreach f $info ty $fldtypes {
2151         if {$findloc ne "All fields" && $findloc ne $ty} {
2152             continue
2153         }
2154         if {$findtype eq "Regexp"} {
2155             set doesmatch [regexp $findstring $f]
2156         } elseif {$findtype eq "IgnCase"} {
2157             set doesmatch [string match -nocase $findpattern $f]
2158         } else {
2159             set doesmatch [string match $findpattern $f]
2160         }
2161         if {$doesmatch} {
2162             if {$ty eq "Author"} {
2163                 set isbold 2
2164             } else {
2165                 set isbold 1
2166             }
2167         }
2168     }
2169     if {[info exists iddrawn($id)]} {
2170         if {$isbold && ![ishighlighted $row]} {
2171             bolden $row [concat $mainfont bold]
2172         }
2173         if {$isbold >= 2} {
2174             bolden_name $row [concat $mainfont bold]
2175         }
2176     }
2177     set nhighlights($row) $isbold
2178 }
2179
2180 proc vrel_change {name ix op} {
2181     global highlight_related
2182
2183     rhighlight_none
2184     if {$highlight_related ne "None"} {
2185         run drawvisible
2186     }
2187 }
2188
2189 # prepare for testing whether commits are descendents or ancestors of a
2190 proc rhighlight_sel {a} {
2191     global descendent desc_todo ancestor anc_todo
2192     global highlight_related rhighlights
2193
2194     catch {unset descendent}
2195     set desc_todo [list $a]
2196     catch {unset ancestor}
2197     set anc_todo [list $a]
2198     if {$highlight_related ne "None"} {
2199         rhighlight_none
2200         run drawvisible
2201     }
2202 }
2203
2204 proc rhighlight_none {} {
2205     global rhighlights
2206
2207     catch {unset rhighlights}
2208     unbolden
2209 }
2210
2211 proc is_descendent {a} {
2212     global curview children commitrow descendent desc_todo
2213
2214     set v $curview
2215     set la $commitrow($v,$a)
2216     set todo $desc_todo
2217     set leftover {}
2218     set done 0
2219     for {set i 0} {$i < [llength $todo]} {incr i} {
2220         set do [lindex $todo $i]
2221         if {$commitrow($v,$do) < $la} {
2222             lappend leftover $do
2223             continue
2224         }
2225         foreach nk $children($v,$do) {
2226             if {![info exists descendent($nk)]} {
2227                 set descendent($nk) 1
2228                 lappend todo $nk
2229                 if {$nk eq $a} {
2230                     set done 1
2231                 }
2232             }
2233         }
2234         if {$done} {
2235             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2236             return
2237         }
2238     }
2239     set descendent($a) 0
2240     set desc_todo $leftover
2241 }
2242
2243 proc is_ancestor {a} {
2244     global curview parentlist commitrow ancestor anc_todo
2245
2246     set v $curview
2247     set la $commitrow($v,$a)
2248     set todo $anc_todo
2249     set leftover {}
2250     set done 0
2251     for {set i 0} {$i < [llength $todo]} {incr i} {
2252         set do [lindex $todo $i]
2253         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2254             lappend leftover $do
2255             continue
2256         }
2257         foreach np [lindex $parentlist $commitrow($v,$do)] {
2258             if {![info exists ancestor($np)]} {
2259                 set ancestor($np) 1
2260                 lappend todo $np
2261                 if {$np eq $a} {
2262                     set done 1
2263                 }
2264             }
2265         }
2266         if {$done} {
2267             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2268             return
2269         }
2270     }
2271     set ancestor($a) 0
2272     set anc_todo $leftover
2273 }
2274
2275 proc askrelhighlight {row id} {
2276     global descendent highlight_related iddrawn mainfont rhighlights
2277     global selectedline ancestor
2278
2279     if {![info exists selectedline]} return
2280     set isbold 0
2281     if {$highlight_related eq "Descendent" ||
2282         $highlight_related eq "Not descendent"} {
2283         if {![info exists descendent($id)]} {
2284             is_descendent $id
2285         }
2286         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2287             set isbold 1
2288         }
2289     } elseif {$highlight_related eq "Ancestor" ||
2290               $highlight_related eq "Not ancestor"} {
2291         if {![info exists ancestor($id)]} {
2292             is_ancestor $id
2293         }
2294         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2295             set isbold 1
2296         }
2297     }
2298     if {[info exists iddrawn($id)]} {
2299         if {$isbold && ![ishighlighted $row]} {
2300             bolden $row [concat $mainfont bold]
2301         }
2302     }
2303     set rhighlights($row) $isbold
2304 }
2305
2306 proc next_hlcont {} {
2307     global fhl_row fhl_dirn displayorder numcommits
2308     global vhighlights fhighlights nhighlights rhighlights
2309     global hlview filehighlight findstring highlight_related
2310
2311     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2312     set row $fhl_row
2313     while {1} {
2314         if {$row < 0 || $row >= $numcommits} {
2315             bell
2316             set fhl_dirn 0
2317             return
2318         }
2319         set id [lindex $displayorder $row]
2320         if {[info exists hlview]} {
2321             if {![info exists vhighlights($row)]} {
2322                 askvhighlight $row $id
2323             }
2324             if {$vhighlights($row) > 0} break
2325         }
2326         if {$findstring ne {}} {
2327             if {![info exists nhighlights($row)]} {
2328                 askfindhighlight $row $id
2329             }
2330             if {$nhighlights($row) > 0} break
2331         }
2332         if {$highlight_related ne "None"} {
2333             if {![info exists rhighlights($row)]} {
2334                 askrelhighlight $row $id
2335             }
2336             if {$rhighlights($row) > 0} break
2337         }
2338         if {[info exists filehighlight]} {
2339             if {![info exists fhighlights($row)]} {
2340                 # ask for a few more while we're at it...
2341                 set r $row
2342                 for {set n 0} {$n < 100} {incr n} {
2343                     if {![info exists fhighlights($r)]} {
2344                         askfilehighlight $r [lindex $displayorder $r]
2345                     }
2346                     incr r $fhl_dirn
2347                     if {$r < 0 || $r >= $numcommits} break
2348                 }
2349                 flushhighlights
2350             }
2351             if {$fhighlights($row) < 0} {
2352                 set fhl_row $row
2353                 return
2354             }
2355             if {$fhighlights($row) > 0} break
2356         }
2357         incr row $fhl_dirn
2358     }
2359     set fhl_dirn 0
2360     selectline $row 1
2361 }
2362
2363 proc next_highlight {dirn} {
2364     global selectedline fhl_row fhl_dirn
2365     global hlview filehighlight findstring highlight_related
2366
2367     if {![info exists selectedline]} return
2368     if {!([info exists hlview] || $findstring ne {} ||
2369           $highlight_related ne "None" || [info exists filehighlight])} return
2370     set fhl_row [expr {$selectedline + $dirn}]
2371     set fhl_dirn $dirn
2372     next_hlcont
2373 }
2374
2375 proc cancel_next_highlight {} {
2376     global fhl_dirn
2377
2378     set fhl_dirn 0
2379 }
2380
2381 # Graph layout functions
2382
2383 proc shortids {ids} {
2384     set res {}
2385     foreach id $ids {
2386         if {[llength $id] > 1} {
2387             lappend res [shortids $id]
2388         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2389             lappend res [string range $id 0 7]
2390         } else {
2391             lappend res $id
2392         }
2393     }
2394     return $res
2395 }
2396
2397 proc incrange {l x o} {
2398     set n [llength $l]
2399     while {$x < $n} {
2400         set e [lindex $l $x]
2401         if {$e ne {}} {
2402             lset l $x [expr {$e + $o}]
2403         }
2404         incr x
2405     }
2406     return $l
2407 }
2408
2409 proc ntimes {n o} {
2410     set ret {}
2411     for {} {$n > 0} {incr n -1} {
2412         lappend ret $o
2413     }
2414     return $ret
2415 }
2416
2417 proc usedinrange {id l1 l2} {
2418     global children commitrow childlist curview
2419
2420     if {[info exists commitrow($curview,$id)]} {
2421         set r $commitrow($curview,$id)
2422         if {$l1 <= $r && $r <= $l2} {
2423             return [expr {$r - $l1 + 1}]
2424         }
2425         set kids [lindex $childlist $r]
2426     } else {
2427         set kids $children($curview,$id)
2428     }
2429     foreach c $kids {
2430         set r $commitrow($curview,$c)
2431         if {$l1 <= $r && $r <= $l2} {
2432             return [expr {$r - $l1 + 1}]
2433         }
2434     }
2435     return 0
2436 }
2437
2438 proc sanity {row {full 0}} {
2439     global rowidlist rowoffsets
2440
2441     set col -1
2442     set ids [lindex $rowidlist $row]
2443     foreach id $ids {
2444         incr col
2445         if {$id eq {}} continue
2446         if {$col < [llength $ids] - 1 &&
2447             [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2448             puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2449         }
2450         set o [lindex $rowoffsets $row $col]
2451         set y $row
2452         set x $col
2453         while {$o ne {}} {
2454             incr y -1
2455             incr x $o
2456             if {[lindex $rowidlist $y $x] != $id} {
2457                 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2458                 puts "  id=[shortids $id] check started at row $row"
2459                 for {set i $row} {$i >= $y} {incr i -1} {
2460                     puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2461                 }
2462                 break
2463             }
2464             if {!$full} break
2465             set o [lindex $rowoffsets $y $x]
2466         }
2467     }
2468 }
2469
2470 proc makeuparrow {oid x y z} {
2471     global rowidlist rowoffsets uparrowlen idrowranges
2472
2473     for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2474         incr y -1
2475         incr x $z
2476         set off0 [lindex $rowoffsets $y]
2477         for {set x0 $x} {1} {incr x0} {
2478             if {$x0 >= [llength $off0]} {
2479                 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2480                 break
2481             }
2482             set z [lindex $off0 $x0]
2483             if {$z ne {}} {
2484                 incr x0 $z
2485                 break
2486             }
2487         }
2488         set z [expr {$x0 - $x}]
2489         lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2490         lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2491     }
2492     set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2493     lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2494     lappend idrowranges($oid) $y
2495 }
2496
2497 proc initlayout {} {
2498     global rowidlist rowoffsets displayorder commitlisted
2499     global rowlaidout rowoptim
2500     global idinlist rowchk rowrangelist idrowranges
2501     global numcommits canvxmax canv
2502     global nextcolor
2503     global parentlist childlist children
2504     global colormap rowtextx
2505     global linesegends selectfirst
2506
2507     set numcommits 0
2508     set displayorder {}
2509     set commitlisted {}
2510     set parentlist {}
2511     set childlist {}
2512     set rowrangelist {}
2513     set nextcolor 0
2514     set rowidlist {{}}
2515     set rowoffsets {{}}
2516     catch {unset idinlist}
2517     catch {unset rowchk}
2518     set rowlaidout 0
2519     set rowoptim 0
2520     set canvxmax [$canv cget -width]
2521     catch {unset colormap}
2522     catch {unset rowtextx}
2523     catch {unset idrowranges}
2524     set linesegends {}
2525     set selectfirst 1
2526 }
2527
2528 proc setcanvscroll {} {
2529     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2530
2531     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2532     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2533     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2534     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2535 }
2536
2537 proc visiblerows {} {
2538     global canv numcommits linespc
2539
2540     set ymax [lindex [$canv cget -scrollregion] 3]
2541     if {$ymax eq {} || $ymax == 0} return
2542     set f [$canv yview]
2543     set y0 [expr {int([lindex $f 0] * $ymax)}]
2544     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2545     if {$r0 < 0} {
2546         set r0 0
2547     }
2548     set y1 [expr {int([lindex $f 1] * $ymax)}]
2549     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2550     if {$r1 >= $numcommits} {
2551         set r1 [expr {$numcommits - 1}]
2552     }
2553     return [list $r0 $r1]
2554 }
2555
2556 proc layoutmore {tmax allread} {
2557     global rowlaidout rowoptim commitidx numcommits optim_delay
2558     global uparrowlen curview rowidlist idinlist
2559
2560     set showdelay $optim_delay
2561     set optdelay [expr {$uparrowlen + 1}]
2562     while {1} {
2563         if {$rowoptim - $showdelay > $numcommits} {
2564             showstuff [expr {$rowoptim - $showdelay}]
2565         } elseif {$rowlaidout - $optdelay > $rowoptim} {
2566             set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2567             if {$nr > 100} {
2568                 set nr 100
2569             }
2570             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2571             incr rowoptim $nr
2572         } elseif {$commitidx($curview) > $rowlaidout} {
2573             set nr [expr {$commitidx($curview) - $rowlaidout}]
2574             # may need to increase this threshold if uparrowlen or
2575             # mingaplen are increased...
2576             if {$nr > 150} {
2577                 set nr 150
2578             }
2579             set row $rowlaidout
2580             set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2581             if {$rowlaidout == $row} {
2582                 return 0
2583             }
2584         } elseif {$allread} {
2585             set optdelay 0
2586             set nrows $commitidx($curview)
2587             if {[lindex $rowidlist $nrows] ne {} ||
2588                 [array names idinlist] ne {}} {
2589                 layouttail
2590                 set rowlaidout $commitidx($curview)
2591             } elseif {$rowoptim == $nrows} {
2592                 set showdelay 0
2593                 if {$numcommits == $nrows} {
2594                     return 0
2595                 }
2596             }
2597         } else {
2598             return 0
2599         }
2600         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2601             return 1
2602         }
2603     }
2604 }
2605
2606 proc showstuff {canshow} {
2607     global numcommits commitrow pending_select selectedline
2608     global linesegends idrowranges idrangedrawn curview
2609     global displayorder selectfirst
2610
2611     if {$numcommits == 0} {
2612         global phase
2613         set phase "incrdraw"
2614         allcanvs delete all
2615     }
2616     set row $numcommits
2617     set numcommits $canshow
2618     setcanvscroll
2619     set rows [visiblerows]
2620     set r0 [lindex $rows 0]
2621     set r1 [lindex $rows 1]
2622     set selrow -1
2623     for {set r $row} {$r < $canshow} {incr r} {
2624         foreach id [lindex $linesegends [expr {$r+1}]] {
2625             set i -1
2626             foreach {s e} [rowranges $id] {
2627                 incr i
2628                 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2629                     && ![info exists idrangedrawn($id,$i)]} {
2630                     drawlineseg $id $i
2631                     set idrangedrawn($id,$i) 1
2632                 }
2633             }
2634         }
2635     }
2636     if {$canshow > $r1} {
2637         set canshow $r1
2638     }
2639     while {$row < $canshow} {
2640         drawcmitrow $row
2641         incr row
2642     }
2643     if {[info exists pending_select] &&
2644         [info exists commitrow($curview,$pending_select)] &&
2645         $commitrow($curview,$pending_select) < $numcommits} {
2646         selectline $commitrow($curview,$pending_select) 1
2647     }
2648     if {$selectfirst} {
2649         if {[info exists selectedline] || [info exists pending_select]} {
2650             set selectfirst 0
2651         } else {
2652             selectline 0 1
2653             set selectfirst 0
2654         }
2655     }
2656 }
2657
2658 proc layoutrows {row endrow last} {
2659     global rowidlist rowoffsets displayorder
2660     global uparrowlen downarrowlen maxwidth mingaplen
2661     global childlist parentlist
2662     global idrowranges linesegends
2663     global commitidx curview
2664     global idinlist rowchk rowrangelist
2665
2666     set idlist [lindex $rowidlist $row]
2667     set offs [lindex $rowoffsets $row]
2668     while {$row < $endrow} {
2669         set id [lindex $displayorder $row]
2670         set oldolds {}
2671         set newolds {}
2672         foreach p [lindex $parentlist $row] {
2673             if {![info exists idinlist($p)]} {
2674                 lappend newolds $p
2675             } elseif {!$idinlist($p)} {
2676                 lappend oldolds $p
2677             }
2678         }
2679         set lse {}
2680         set nev [expr {[llength $idlist] + [llength $newolds]
2681                        + [llength $oldolds] - $maxwidth + 1}]
2682         if {$nev > 0} {
2683             if {!$last &&
2684                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2685             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2686                 set i [lindex $idlist $x]
2687                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2688                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2689                                [expr {$row + $uparrowlen + $mingaplen}]]
2690                     if {$r == 0} {
2691                         set idlist [lreplace $idlist $x $x]
2692                         set offs [lreplace $offs $x $x]
2693                         set offs [incrange $offs $x 1]
2694                         set idinlist($i) 0
2695                         set rm1 [expr {$row - 1}]
2696                         lappend lse $i
2697                         lappend idrowranges($i) $rm1
2698                         if {[incr nev -1] <= 0} break
2699                         continue
2700                     }
2701                     set rowchk($id) [expr {$row + $r}]
2702                 }
2703             }
2704             lset rowidlist $row $idlist
2705             lset rowoffsets $row $offs
2706         }
2707         lappend linesegends $lse
2708         set col [lsearch -exact $idlist $id]
2709         if {$col < 0} {
2710             set col [llength $idlist]
2711             lappend idlist $id
2712             lset rowidlist $row $idlist
2713             set z {}
2714             if {[lindex $childlist $row] ne {}} {
2715                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2716                 unset idinlist($id)
2717             }
2718             lappend offs $z
2719             lset rowoffsets $row $offs
2720             if {$z ne {}} {
2721                 makeuparrow $id $col $row $z
2722             }
2723         } else {
2724             unset idinlist($id)
2725         }
2726         set ranges {}
2727         if {[info exists idrowranges($id)]} {
2728             set ranges $idrowranges($id)
2729             lappend ranges $row
2730             unset idrowranges($id)
2731         }
2732         lappend rowrangelist $ranges
2733         incr row
2734         set offs [ntimes [llength $idlist] 0]
2735         set l [llength $newolds]
2736         set idlist [eval lreplace \$idlist $col $col $newolds]
2737         set o 0
2738         if {$l != 1} {
2739             set offs [lrange $offs 0 [expr {$col - 1}]]
2740             foreach x $newolds {
2741                 lappend offs {}
2742                 incr o -1
2743             }
2744             incr o
2745             set tmp [expr {[llength $idlist] - [llength $offs]}]
2746             if {$tmp > 0} {
2747                 set offs [concat $offs [ntimes $tmp $o]]
2748             }
2749         } else {
2750             lset offs $col {}
2751         }
2752         foreach i $newolds {
2753             set idinlist($i) 1
2754             set idrowranges($i) $row
2755         }
2756         incr col $l
2757         foreach oid $oldolds {
2758             set idinlist($oid) 1
2759             set idlist [linsert $idlist $col $oid]
2760             set offs [linsert $offs $col $o]
2761             makeuparrow $oid $col $row $o
2762             incr col
2763         }
2764         lappend rowidlist $idlist
2765         lappend rowoffsets $offs
2766     }
2767     return $row
2768 }
2769
2770 proc addextraid {id row} {
2771     global displayorder commitrow commitinfo
2772     global commitidx commitlisted
2773     global parentlist childlist children curview
2774
2775     incr commitidx($curview)
2776     lappend displayorder $id
2777     lappend commitlisted 0
2778     lappend parentlist {}
2779     set commitrow($curview,$id) $row
2780     readcommit $id
2781     if {![info exists commitinfo($id)]} {
2782         set commitinfo($id) {"No commit information available"}
2783     }
2784     if {![info exists children($curview,$id)]} {
2785         set children($curview,$id) {}
2786     }
2787     lappend childlist $children($curview,$id)
2788 }
2789
2790 proc layouttail {} {
2791     global rowidlist rowoffsets idinlist commitidx curview
2792     global idrowranges rowrangelist
2793
2794     set row $commitidx($curview)
2795     set idlist [lindex $rowidlist $row]
2796     while {$idlist ne {}} {
2797         set col [expr {[llength $idlist] - 1}]
2798         set id [lindex $idlist $col]
2799         addextraid $id $row
2800         unset idinlist($id)
2801         lappend idrowranges($id) $row
2802         lappend rowrangelist $idrowranges($id)
2803         unset idrowranges($id)
2804         incr row
2805         set offs [ntimes $col 0]
2806         set idlist [lreplace $idlist $col $col]
2807         lappend rowidlist $idlist
2808         lappend rowoffsets $offs
2809     }
2810
2811     foreach id [array names idinlist] {
2812         unset idinlist($id)
2813         addextraid $id $row
2814         lset rowidlist $row [list $id]
2815         lset rowoffsets $row 0
2816         makeuparrow $id 0 $row 0
2817         lappend idrowranges($id) $row
2818         lappend rowrangelist $idrowranges($id)
2819         unset idrowranges($id)
2820         incr row
2821         lappend rowidlist {}
2822         lappend rowoffsets {}
2823     }
2824 }
2825
2826 proc insert_pad {row col npad} {
2827     global rowidlist rowoffsets
2828
2829     set pad [ntimes $npad {}]
2830     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2831     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2832     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2833 }
2834
2835 proc optimize_rows {row col endrow} {
2836     global rowidlist rowoffsets idrowranges displayorder
2837
2838     for {} {$row < $endrow} {incr row} {
2839         set idlist [lindex $rowidlist $row]
2840         set offs [lindex $rowoffsets $row]
2841         set haspad 0
2842         for {} {$col < [llength $offs]} {incr col} {
2843             if {[lindex $idlist $col] eq {}} {
2844                 set haspad 1
2845                 continue
2846             }
2847             set z [lindex $offs $col]
2848             if {$z eq {}} continue
2849             set isarrow 0
2850             set x0 [expr {$col + $z}]
2851             set y0 [expr {$row - 1}]
2852             set z0 [lindex $rowoffsets $y0 $x0]
2853             if {$z0 eq {}} {
2854                 set id [lindex $idlist $col]
2855                 set ranges [rowranges $id]
2856                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2857                     set isarrow 1
2858                 }
2859             }
2860             # Looking at lines from this row to the previous row,
2861             # make them go straight up if they end in an arrow on
2862             # the previous row; otherwise make them go straight up
2863             # or at 45 degrees.
2864             if {$z < -1 || ($z < 0 && $isarrow)} {
2865                 # Line currently goes left too much;
2866                 # insert pads in the previous row, then optimize it
2867                 set npad [expr {-1 - $z + $isarrow}]
2868                 set offs [incrange $offs $col $npad]
2869                 insert_pad $y0 $x0 $npad
2870                 if {$y0 > 0} {
2871                     optimize_rows $y0 $x0 $row
2872                 }
2873                 set z [lindex $offs $col]
2874                 set x0 [expr {$col + $z}]
2875                 set z0 [lindex $rowoffsets $y0 $x0]
2876             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2877                 # Line currently goes right too much;
2878                 # insert pads in this line and adjust the next's rowoffsets
2879                 set npad [expr {$z - 1 + $isarrow}]
2880                 set y1 [expr {$row + 1}]
2881                 set offs2 [lindex $rowoffsets $y1]
2882                 set x1 -1
2883                 foreach z $offs2 {
2884                     incr x1
2885                     if {$z eq {} || $x1 + $z < $col} continue
2886                     if {$x1 + $z > $col} {
2887                         incr npad
2888                     }
2889                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2890                     break
2891                 }
2892                 set pad [ntimes $npad {}]
2893                 set idlist [eval linsert \$idlist $col $pad]
2894                 set tmp [eval linsert \$offs $col $pad]
2895                 incr col $npad
2896                 set offs [incrange $tmp $col [expr {-$npad}]]
2897                 set z [lindex $offs $col]
2898                 set haspad 1
2899             }
2900             if {$z0 eq {} && !$isarrow} {
2901                 # this line links to its first child on row $row-2
2902                 set rm2 [expr {$row - 2}]
2903                 set id [lindex $displayorder $rm2]
2904                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2905                 if {$xc >= 0} {
2906                     set z0 [expr {$xc - $x0}]
2907                 }
2908             }
2909             # avoid lines jigging left then immediately right
2910             if {$z0 ne {} && $z < 0 && $z0 > 0} {
2911                 insert_pad $y0 $x0 1
2912                 set offs [incrange $offs $col 1]
2913                 optimize_rows $y0 [expr {$x0 + 1}] $row
2914             }
2915         }
2916         if {!$haspad} {
2917             set o {}
2918             # Find the first column that doesn't have a line going right
2919             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2920                 set o [lindex $offs $col]
2921                 if {$o eq {}} {
2922                     # check if this is the link to the first child
2923                     set id [lindex $idlist $col]
2924                     set ranges [rowranges $id]
2925                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
2926                         # it is, work out offset to child
2927                         set y0 [expr {$row - 1}]
2928                         set id [lindex $displayorder $y0]
2929                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2930                         if {$x0 >= 0} {
2931                             set o [expr {$x0 - $col}]
2932                         }
2933                     }
2934                 }
2935                 if {$o eq {} || $o <= 0} break
2936             }
2937             # Insert a pad at that column as long as it has a line and
2938             # isn't the last column, and adjust the next row' offsets
2939             if {$o ne {} && [incr col] < [llength $idlist]} {
2940                 set y1 [expr {$row + 1}]
2941                 set offs2 [lindex $rowoffsets $y1]
2942                 set x1 -1
2943                 foreach z $offs2 {
2944                     incr x1
2945                     if {$z eq {} || $x1 + $z < $col} continue
2946                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
2947                     break
2948                 }
2949                 set idlist [linsert $idlist $col {}]
2950                 set tmp [linsert $offs $col {}]
2951                 incr col
2952                 set offs [incrange $tmp $col -1]
2953             }
2954         }
2955         lset rowidlist $row $idlist
2956         lset rowoffsets $row $offs
2957         set col 0
2958     }
2959 }
2960
2961 proc xc {row col} {
2962     global canvx0 linespc
2963     return [expr {$canvx0 + $col * $linespc}]
2964 }
2965
2966 proc yc {row} {
2967     global canvy0 linespc
2968     return [expr {$canvy0 + $row * $linespc}]
2969 }
2970
2971 proc linewidth {id} {
2972     global thickerline lthickness
2973
2974     set wid $lthickness
2975     if {[info exists thickerline] && $id eq $thickerline} {
2976         set wid [expr {2 * $lthickness}]
2977     }
2978     return $wid
2979 }
2980
2981 proc rowranges {id} {
2982     global phase idrowranges commitrow rowlaidout rowrangelist curview
2983
2984     set ranges {}
2985     if {$phase eq {} ||
2986         ([info exists commitrow($curview,$id)]
2987          && $commitrow($curview,$id) < $rowlaidout)} {
2988         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2989     } elseif {[info exists idrowranges($id)]} {
2990         set ranges $idrowranges($id)
2991     }
2992     return $ranges
2993 }
2994
2995 proc drawlineseg {id i} {
2996     global rowoffsets rowidlist
2997     global displayorder
2998     global canv colormap linespc
2999     global numcommits commitrow curview
3000
3001     set ranges [rowranges $id]
3002     set downarrow 1
3003     if {[info exists commitrow($curview,$id)]
3004         && $commitrow($curview,$id) < $numcommits} {
3005         set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
3006     } else {
3007         set downarrow 1
3008     }
3009     set startrow [lindex $ranges [expr {2 * $i}]]
3010     set row [lindex $ranges [expr {2 * $i + 1}]]
3011     if {$startrow == $row} return
3012     assigncolor $id
3013     set coords {}
3014     set col [lsearch -exact [lindex $rowidlist $row] $id]
3015     if {$col < 0} {
3016         puts "oops: drawline: id $id not on row $row"
3017         return
3018     }
3019     set lasto {}
3020     set ns 0
3021     while {1} {
3022         set o [lindex $rowoffsets $row $col]
3023         if {$o eq {}} break
3024         if {$o ne $lasto} {
3025             # changing direction
3026             set x [xc $row $col]
3027             set y [yc $row]
3028             lappend coords $x $y
3029             set lasto $o
3030         }
3031         incr col $o
3032         incr row -1
3033     }
3034     set x [xc $row $col]
3035     set y [yc $row]
3036     lappend coords $x $y
3037     if {$i == 0} {
3038         # draw the link to the first child as part of this line
3039         incr row -1
3040         set child [lindex $displayorder $row]
3041         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
3042         if {$ccol >= 0} {
3043             set x [xc $row $ccol]
3044             set y [yc $row]
3045             if {$ccol < $col - 1} {
3046                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
3047             } elseif {$ccol > $col + 1} {
3048                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
3049             }
3050             lappend coords $x $y
3051         }
3052     }
3053     if {[llength $coords] < 4} return
3054     if {$downarrow} {
3055         # This line has an arrow at the lower end: check if the arrow is
3056         # on a diagonal segment, and if so, work around the Tk 8.4
3057         # refusal to draw arrows on diagonal lines.
3058         set x0 [lindex $coords 0]
3059         set x1 [lindex $coords 2]
3060         if {$x0 != $x1} {
3061             set y0 [lindex $coords 1]
3062             set y1 [lindex $coords 3]
3063             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3064                 # we have a nearby vertical segment, just trim off the diag bit
3065                 set coords [lrange $coords 2 end]
3066             } else {
3067                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3068                 set xi [expr {$x0 - $slope * $linespc / 2}]
3069                 set yi [expr {$y0 - $linespc / 2}]
3070                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3071             }
3072         }
3073     }
3074     set arrow [expr {2 * ($i > 0) + $downarrow}]
3075     set arrow [lindex {none first last both} $arrow]
3076     set t [$canv create line $coords -width [linewidth $id] \
3077                -fill $colormap($id) -tags lines.$id -arrow $arrow]
3078     $canv lower $t
3079     bindline $t $id
3080 }
3081
3082 proc drawparentlinks {id row col olds} {
3083     global rowidlist canv colormap
3084
3085     set row2 [expr {$row + 1}]
3086     set x [xc $row $col]
3087     set y [yc $row]
3088     set y2 [yc $row2]
3089     set ids [lindex $rowidlist $row2]
3090     # rmx = right-most X coord used
3091     set rmx 0
3092     foreach p $olds {
3093         set i [lsearch -exact $ids $p]
3094         if {$i < 0} {
3095             puts "oops, parent $p of $id not in list"
3096             continue
3097         }
3098         set x2 [xc $row2 $i]
3099         if {$x2 > $rmx} {
3100             set rmx $x2
3101         }
3102         set ranges [rowranges $p]
3103         if {$ranges ne {} && $row2 == [lindex $ranges 0]
3104             && $row2 < [lindex $ranges 1]} {
3105             # drawlineseg will do this one for us
3106             continue
3107         }
3108         assigncolor $p
3109         # should handle duplicated parents here...
3110         set coords [list $x $y]
3111         if {$i < $col - 1} {
3112             lappend coords [xc $row [expr {$i + 1}]] $y
3113         } elseif {$i > $col + 1} {
3114             lappend coords [xc $row [expr {$i - 1}]] $y
3115         }
3116         lappend coords $x2 $y2
3117         set t [$canv create line $coords -width [linewidth $p] \
3118                    -fill $colormap($p) -tags lines.$p]
3119         $canv lower $t
3120         bindline $t $p
3121     }
3122     return $rmx
3123 }
3124
3125 proc drawlines {id} {
3126     global colormap canv
3127     global idrangedrawn
3128     global children iddrawn commitrow rowidlist curview
3129
3130     $canv delete lines.$id
3131     set nr [expr {[llength [rowranges $id]] / 2}]
3132     for {set i 0} {$i < $nr} {incr i} {
3133         if {[info exists idrangedrawn($id,$i)]} {
3134             drawlineseg $id $i
3135         }
3136     }
3137     foreach child $children($curview,$id) {
3138         if {[info exists iddrawn($child)]} {
3139             set row $commitrow($curview,$child)
3140             set col [lsearch -exact [lindex $rowidlist $row] $child]
3141             if {$col >= 0} {
3142                 drawparentlinks $child $row $col [list $id]
3143             }
3144         }
3145     }
3146 }
3147
3148 proc drawcmittext {id row col rmx} {
3149     global linespc canv canv2 canv3 canvy0 fgcolor
3150     global commitlisted commitinfo rowidlist
3151     global rowtextx idpos idtags idheads idotherrefs
3152     global linehtag linentag linedtag
3153     global mainfont canvxmax boldrows boldnamerows fgcolor
3154
3155     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3156     set x [xc $row $col]
3157     set y [yc $row]
3158     set orad [expr {$linespc / 3}]
3159     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3160                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3161                -fill $ofill -outline $fgcolor -width 1 -tags circle]
3162     $canv raise $t
3163     $canv bind $t <1> {selcanvline {} %x %y}
3164     set xt [xc $row [llength [lindex $rowidlist $row]]]
3165     if {$xt < $rmx} {
3166         set xt $rmx
3167     }
3168     set rowtextx($row) $xt
3169     set idpos($id) [list $x $xt $y]
3170     if {[info exists idtags($id)] || [info exists idheads($id)]
3171         || [info exists idotherrefs($id)]} {
3172         set xt [drawtags $id $x $xt $y]
3173     }
3174     set headline [lindex $commitinfo($id) 0]
3175     set name [lindex $commitinfo($id) 1]
3176     set date [lindex $commitinfo($id) 2]
3177     set date [formatdate $date]
3178     set font $mainfont
3179     set nfont $mainfont
3180     set isbold [ishighlighted $row]
3181     if {$isbold > 0} {
3182         lappend boldrows $row
3183         lappend font bold
3184         if {$isbold > 1} {
3185             lappend boldnamerows $row
3186             lappend nfont bold
3187         }
3188     }
3189     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3190                             -text $headline -font $font -tags text]
3191     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3192     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3193                             -text $name -font $nfont -tags text]
3194     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3195                             -text $date -font $mainfont -tags text]
3196     set xr [expr {$xt + [font measure $mainfont $headline]}]
3197     if {$xr > $canvxmax} {
3198         set canvxmax $xr
3199         setcanvscroll
3200     }
3201 }
3202
3203 proc drawcmitrow {row} {
3204     global displayorder rowidlist
3205     global idrangedrawn iddrawn
3206     global commitinfo parentlist numcommits
3207     global filehighlight fhighlights findstring nhighlights
3208     global hlview vhighlights
3209     global highlight_related rhighlights
3210
3211     if {$row >= $numcommits} return
3212     foreach id [lindex $rowidlist $row] {
3213         if {$id eq {}} continue
3214         set i -1
3215         foreach {s e} [rowranges $id] {
3216             incr i
3217             if {$row < $s} continue
3218             if {$e eq {}} break
3219             if {$row <= $e} {
3220                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3221                     drawlineseg $id $i
3222                     set idrangedrawn($id,$i) 1
3223                 }
3224                 break
3225             }
3226         }
3227     }
3228
3229     set id [lindex $displayorder $row]
3230     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3231         askvhighlight $row $id
3232     }
3233     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3234         askfilehighlight $row $id
3235     }
3236     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3237         askfindhighlight $row $id
3238     }
3239     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3240         askrelhighlight $row $id
3241     }
3242     if {[info exists iddrawn($id)]} return
3243     set col [lsearch -exact [lindex $rowidlist $row] $id]
3244     if {$col < 0} {
3245         puts "oops, row $row id $id not in list"
3246         return
3247     }
3248     if {![info exists commitinfo($id)]} {
3249         getcommit $id
3250     }
3251     assigncolor $id
3252     set olds [lindex $parentlist $row]
3253     if {$olds ne {}} {
3254         set rmx [drawparentlinks $id $row $col $olds]
3255     } else {
3256         set rmx 0
3257     }
3258     drawcmittext $id $row $col $rmx
3259     set iddrawn($id) 1
3260 }
3261
3262 proc drawfrac {f0 f1} {
3263     global numcommits canv
3264     global linespc
3265
3266     set ymax [lindex [$canv cget -scrollregion] 3]
3267     if {$ymax eq {} || $ymax == 0} return
3268     set y0 [expr {int($f0 * $ymax)}]
3269     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3270     if {$row < 0} {
3271         set row 0
3272     }
3273     set y1 [expr {int($f1 * $ymax)}]
3274     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3275     if {$endrow >= $numcommits} {
3276         set endrow [expr {$numcommits - 1}]
3277     }
3278     for {} {$row <= $endrow} {incr row} {
3279         drawcmitrow $row
3280     }
3281 }
3282
3283 proc drawvisible {} {
3284     global canv
3285     eval drawfrac [$canv yview]
3286 }
3287
3288 proc clear_display {} {
3289     global iddrawn idrangedrawn
3290     global vhighlights fhighlights nhighlights rhighlights
3291
3292     allcanvs delete all
3293     catch {unset iddrawn}
3294     catch {unset idrangedrawn}
3295     catch {unset vhighlights}
3296     catch {unset fhighlights}
3297     catch {unset nhighlights}
3298     catch {unset rhighlights}
3299 }
3300
3301 proc findcrossings {id} {
3302     global rowidlist parentlist numcommits rowoffsets displayorder
3303
3304     set cross {}
3305     set ccross {}
3306     foreach {s e} [rowranges $id] {
3307         if {$e >= $numcommits} {
3308             set e [expr {$numcommits - 1}]
3309         }
3310         if {$e <= $s} continue
3311         set x [lsearch -exact [lindex $rowidlist $e] $id]
3312         if {$x < 0} {
3313             puts "findcrossings: oops, no [shortids $id] in row $e"
3314             continue
3315         }
3316         for {set row $e} {[incr row -1] >= $s} {} {
3317             set olds [lindex $parentlist $row]
3318             set kid [lindex $displayorder $row]
3319             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3320             if {$kidx < 0} continue
3321             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3322             foreach p $olds {
3323                 set px [lsearch -exact $nextrow $p]
3324                 if {$px < 0} continue
3325                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3326                     if {[lsearch -exact $ccross $p] >= 0} continue
3327                     if {$x == $px + ($kidx < $px? -1: 1)} {
3328                         lappend ccross $p
3329                     } elseif {[lsearch -exact $cross $p] < 0} {
3330                         lappend cross $p
3331                     }
3332                 }
3333             }
3334             set inc [lindex $rowoffsets $row $x]
3335             if {$inc eq {}} break
3336             incr x $inc
3337         }
3338     }
3339     return [concat $ccross {{}} $cross]
3340 }
3341
3342 proc assigncolor {id} {
3343     global colormap colors nextcolor
3344     global commitrow parentlist children children curview
3345
3346     if {[info exists colormap($id)]} return
3347     set ncolors [llength $colors]
3348     if {[info exists children($curview,$id)]} {
3349         set kids $children($curview,$id)
3350     } else {
3351         set kids {}
3352     }
3353     if {[llength $kids] == 1} {
3354         set child [lindex $kids 0]
3355         if {[info exists colormap($child)]
3356             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3357             set colormap($id) $colormap($child)
3358             return
3359         }
3360     }
3361     set badcolors {}
3362     set origbad {}
3363     foreach x [findcrossings $id] {
3364         if {$x eq {}} {
3365             # delimiter between corner crossings and other crossings
3366             if {[llength $badcolors] >= $ncolors - 1} break
3367             set origbad $badcolors
3368         }
3369         if {[info exists colormap($x)]
3370             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3371             lappend badcolors $colormap($x)
3372         }
3373     }
3374     if {[llength $badcolors] >= $ncolors} {
3375         set badcolors $origbad
3376     }
3377     set origbad $badcolors
3378     if {[llength $badcolors] < $ncolors - 1} {
3379         foreach child $kids {
3380             if {[info exists colormap($child)]
3381                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3382                 lappend badcolors $colormap($child)
3383             }
3384             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3385                 if {[info exists colormap($p)]
3386                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3387                     lappend badcolors $colormap($p)
3388                 }
3389             }
3390         }
3391         if {[llength $badcolors] >= $ncolors} {
3392             set badcolors $origbad
3393         }
3394     }
3395     for {set i 0} {$i <= $ncolors} {incr i} {
3396         set c [lindex $colors $nextcolor]
3397         if {[incr nextcolor] >= $ncolors} {
3398             set nextcolor 0
3399         }
3400         if {[lsearch -exact $badcolors $c]} break
3401     }
3402     set colormap($id) $c
3403 }
3404
3405 proc bindline {t id} {
3406     global canv
3407
3408     $canv bind $t <Enter> "lineenter %x %y $id"
3409     $canv bind $t <Motion> "linemotion %x %y $id"
3410     $canv bind $t <Leave> "lineleave $id"
3411     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3412 }
3413
3414 proc drawtags {id x xt y1} {
3415     global idtags idheads idotherrefs mainhead
3416     global linespc lthickness
3417     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3418
3419     set marks {}
3420     set ntags 0
3421     set nheads 0
3422     if {[info exists idtags($id)]} {
3423         set marks $idtags($id)
3424         set ntags [llength $marks]
3425     }
3426     if {[info exists idheads($id)]} {
3427         set marks [concat $marks $idheads($id)]
3428         set nheads [llength $idheads($id)]
3429     }
3430     if {[info exists idotherrefs($id)]} {
3431         set marks [concat $marks $idotherrefs($id)]
3432     }
3433     if {$marks eq {}} {
3434         return $xt
3435     }
3436
3437     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3438     set yt [expr {$y1 - 0.5 * $linespc}]
3439     set yb [expr {$yt + $linespc - 1}]
3440     set xvals {}
3441     set wvals {}
3442     set i -1
3443     foreach tag $marks {
3444         incr i
3445         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3446             set wid [font measure [concat $mainfont bold] $tag]
3447         } else {
3448             set wid [font measure $mainfont $tag]
3449         }
3450         lappend xvals $xt
3451         lappend wvals $wid
3452         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3453     }
3454     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3455                -width $lthickness -fill black -tags tag.$id]
3456     $canv lower $t
3457     foreach tag $marks x $xvals wid $wvals {
3458         set xl [expr {$x + $delta}]
3459         set xr [expr {$x + $delta + $wid + $lthickness}]
3460         set font $mainfont
3461         if {[incr ntags -1] >= 0} {
3462             # draw a tag
3463             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3464                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3465                        -width 1 -outline black -fill yellow -tags tag.$id]
3466             $canv bind $t <1> [list showtag $tag 1]
3467             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3468         } else {
3469             # draw a head or other ref
3470             if {[incr nheads -1] >= 0} {
3471                 set col green
3472                 if {$tag eq $mainhead} {
3473                     lappend font bold
3474                 }
3475             } else {
3476                 set col "#ddddff"
3477             }
3478             set xl [expr {$xl - $delta/2}]
3479             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3480                 -width 1 -outline black -fill $col -tags tag.$id
3481             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3482                 set rwid [font measure $mainfont $remoteprefix]
3483                 set xi [expr {$x + 1}]
3484                 set yti [expr {$yt + 1}]
3485                 set xri [expr {$x + $rwid}]
3486                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3487                         -width 0 -fill "#ffddaa" -tags tag.$id
3488             }
3489         }
3490         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3491                    -font $font -tags [list tag.$id text]]
3492         if {$ntags >= 0} {
3493             $canv bind $t <1> [list showtag $tag 1]
3494         } elseif {$nheads >= 0} {
3495             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3496         }
3497     }
3498     return $xt
3499 }
3500
3501 proc xcoord {i level ln} {
3502     global canvx0 xspc1 xspc2
3503
3504     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3505     if {$i > 0 && $i == $level} {
3506         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3507     } elseif {$i > $level} {
3508         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3509     }
3510     return $x
3511 }
3512
3513 proc show_status {msg} {
3514     global canv mainfont fgcolor
3515
3516     clear_display
3517     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3518         -tags text -fill $fgcolor
3519 }
3520
3521 # Insert a new commit as the child of the commit on row $row.
3522 # The new commit will be displayed on row $row and the commits
3523 # on that row and below will move down one row.
3524 proc insertrow {row newcmit} {
3525     global displayorder parentlist childlist commitlisted
3526     global commitrow curview rowidlist rowoffsets numcommits
3527     global rowrangelist idrowranges rowlaidout rowoptim numcommits
3528     global linesegends selectedline
3529
3530     if {$row >= $numcommits} {
3531         puts "oops, inserting new row $row but only have $numcommits rows"
3532         return
3533     }
3534     set p [lindex $displayorder $row]
3535     set displayorder [linsert $displayorder $row $newcmit]
3536     set parentlist [linsert $parentlist $row $p]
3537     set kids [lindex $childlist $row]
3538     lappend kids $newcmit
3539     lset childlist $row $kids
3540     set childlist [linsert $childlist $row {}]
3541     set commitlisted [linsert $commitlisted $row 1]
3542     set l [llength $displayorder]
3543     for {set r $row} {$r < $l} {incr r} {
3544         set id [lindex $displayorder $r]
3545         set commitrow($curview,$id) $r
3546     }
3547
3548     set idlist [lindex $rowidlist $row]
3549     set offs [lindex $rowoffsets $row]
3550     set newoffs {}
3551     foreach x $idlist {
3552         if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3553             lappend newoffs {}
3554         } else {
3555             lappend newoffs 0
3556         }
3557     }
3558     if {[llength $kids] == 1} {
3559         set col [lsearch -exact $idlist $p]
3560         lset idlist $col $newcmit
3561     } else {
3562         set col [llength $idlist]
3563         lappend idlist $newcmit
3564         lappend offs {}
3565         lset rowoffsets $row $offs
3566     }
3567     set rowidlist [linsert $rowidlist $row $idlist]
3568     set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3569
3570     set rowrangelist [linsert $rowrangelist $row {}]
3571     set l [llength $rowrangelist]
3572     for {set r 0} {$r < $l} {incr r} {
3573         set ranges [lindex $rowrangelist $r]
3574         if {$ranges ne {} && [lindex $ranges end] >= $row} {
3575             set newranges {}
3576             foreach x $ranges {
3577                 if {$x >= $row} {
3578                     lappend newranges [expr {$x + 1}]
3579                 } else {
3580                     lappend newranges $x
3581                 }
3582             }
3583             lset rowrangelist $r $newranges
3584         }
3585     }
3586     if {[llength $kids] > 1} {
3587         set rp1 [expr {$row + 1}]
3588         set ranges [lindex $rowrangelist $rp1]
3589         if {$ranges eq {}} {
3590             set ranges [list $row $rp1]
3591         } elseif {[lindex $ranges end-1] == $rp1} {
3592             lset ranges end-1 $row
3593         }
3594         lset rowrangelist $rp1 $ranges
3595     }
3596     foreach id [array names idrowranges] {
3597         set ranges $idrowranges($id)
3598         if {$ranges ne {} && [lindex $ranges end] >= $row} {
3599             set newranges {}
3600             foreach x $ranges {
3601                 if {$x >= $row} {
3602                     lappend newranges [expr {$x + 1}]
3603                 } else {
3604                     lappend newranges $x
3605                 }
3606             }
3607             set idrowranges($id) $newranges
3608         }
3609     }
3610
3611     set linesegends [linsert $linesegends $row {}]
3612
3613     incr rowlaidout
3614     incr rowoptim
3615     incr numcommits
3616
3617     if {[info exists selectedline] && $selectedline >= $row} {
3618         incr selectedline
3619     }
3620     redisplay
3621 }
3622
3623 # Don't change the text pane cursor if it is currently the hand cursor,
3624 # showing that we are over a sha1 ID link.
3625 proc settextcursor {c} {
3626     global ctext curtextcursor
3627
3628     if {[$ctext cget -cursor] == $curtextcursor} {
3629         $ctext config -cursor $c
3630     }
3631     set curtextcursor $c
3632 }
3633
3634 proc nowbusy {what} {
3635     global isbusy
3636
3637     if {[array names isbusy] eq {}} {
3638         . config -cursor watch
3639         settextcursor watch
3640     }
3641     set isbusy($what) 1
3642 }
3643
3644 proc notbusy {what} {
3645     global isbusy maincursor textcursor
3646
3647     catch {unset isbusy($what)}
3648     if {[array names isbusy] eq {}} {
3649         . config -cursor $maincursor
3650         settextcursor $textcursor
3651     }
3652 }
3653
3654 proc findmatches {f} {
3655     global findtype foundstring foundstrlen
3656     if {$findtype == "Regexp"} {
3657         set matches [regexp -indices -all -inline $foundstring $f]
3658     } else {
3659         if {$findtype == "IgnCase"} {
3660             set str [string tolower $f]
3661         } else {
3662             set str $f
3663         }
3664         set matches {}
3665         set i 0
3666         while {[set j [string first $foundstring $str $i]] >= 0} {
3667             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3668             set i [expr {$j + $foundstrlen}]
3669         }
3670     }
3671     return $matches
3672 }
3673
3674 proc dofind {} {
3675     global findtype findloc findstring markedmatches commitinfo
3676     global numcommits displayorder linehtag linentag linedtag
3677     global mainfont canv canv2 canv3 selectedline
3678     global matchinglines foundstring foundstrlen matchstring
3679     global commitdata
3680
3681     stopfindproc
3682     unmarkmatches
3683     cancel_next_highlight
3684     focus .
3685     set matchinglines {}
3686     if {$findtype == "IgnCase"} {
3687         set foundstring [string tolower $findstring]
3688     } else {
3689         set foundstring $findstring
3690     }
3691     set foundstrlen [string length $findstring]
3692     if {$foundstrlen == 0} return
3693     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3694     set matchstring "*$matchstring*"
3695     if {![info exists selectedline]} {
3696         set oldsel -1
3697     } else {
3698         set oldsel $selectedline
3699     }
3700     set didsel 0
3701     set fldtypes {Headline Author Date Committer CDate Comments}
3702     set l -1
3703     foreach id $displayorder {
3704         set d $commitdata($id)
3705         incr l
3706         if {$findtype == "Regexp"} {
3707             set doesmatch [regexp $foundstring $d]
3708         } elseif {$findtype == "IgnCase"} {
3709             set doesmatch [string match -nocase $matchstring $d]
3710         } else {
3711             set doesmatch [string match $matchstring $d]
3712         }
3713         if {!$doesmatch} continue
3714         if {![info exists commitinfo($id)]} {
3715             getcommit $id
3716         }
3717         set info $commitinfo($id)
3718         set doesmatch 0
3719         foreach f $info ty $fldtypes {
3720             if {$findloc != "All fields" && $findloc != $ty} {
3721                 continue
3722             }
3723             set matches [findmatches $f]
3724             if {$matches == {}} continue
3725             set doesmatch 1
3726             if {$ty == "Headline"} {
3727                 drawcmitrow $l
3728                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3729             } elseif {$ty == "Author"} {
3730                 drawcmitrow $l
3731                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3732             } elseif {$ty == "Date"} {
3733                 drawcmitrow $l
3734                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3735             }
3736         }
3737         if {$doesmatch} {
3738             lappend matchinglines $l
3739             if {!$didsel && $l > $oldsel} {
3740                 findselectline $l
3741                 set didsel 1
3742             }
3743         }
3744     }
3745     if {$matchinglines == {}} {
3746         bell
3747     } elseif {!$didsel} {
3748         findselectline [lindex $matchinglines 0]
3749     }
3750 }
3751
3752 proc findselectline {l} {
3753     global findloc commentend ctext
3754     selectline $l 1
3755     if {$findloc == "All fields" || $findloc == "Comments"} {
3756         # highlight the matches in the comments
3757         set f [$ctext get 1.0 $commentend]
3758         set matches [findmatches $f]
3759         foreach match $matches {
3760             set start [lindex $match 0]
3761             set end [expr {[lindex $match 1] + 1}]
3762             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3763         }
3764     }
3765 }
3766
3767 proc findnext {restart} {
3768     global matchinglines selectedline
3769     if {![info exists matchinglines]} {
3770         if {$restart} {
3771             dofind
3772         }
3773         return
3774     }
3775     if {![info exists selectedline]} return
3776     foreach l $matchinglines {
3777         if {$l > $selectedline} {
3778             findselectline $l
3779             return
3780         }
3781     }
3782     bell
3783 }
3784
3785 proc findprev {} {
3786     global matchinglines selectedline
3787     if {![info exists matchinglines]} {
3788         dofind
3789         return
3790     }
3791     if {![info exists selectedline]} return
3792     set prev {}
3793     foreach l $matchinglines {
3794         if {$l >= $selectedline} break
3795         set prev $l
3796     }
3797     if {$prev != {}} {
3798         findselectline $prev
3799     } else {
3800         bell
3801     }
3802 }
3803
3804 proc stopfindproc {{done 0}} {
3805     global findprocpid findprocfile findids
3806     global ctext findoldcursor phase maincursor textcursor
3807     global findinprogress
3808
3809     catch {unset findids}
3810     if {[info exists findprocpid]} {
3811         if {!$done} {
3812             catch {exec kill $findprocpid}
3813         }
3814         catch {close $findprocfile}
3815         unset findprocpid
3816     }
3817     catch {unset findinprogress}
3818     notbusy find
3819 }
3820
3821 # mark a commit as matching by putting a yellow background
3822 # behind the headline
3823 proc markheadline {l id} {
3824     global canv mainfont linehtag
3825
3826     drawcmitrow $l
3827     set bbox [$canv bbox $linehtag($l)]
3828     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3829     $canv lower $t
3830 }
3831
3832 # mark the bits of a headline, author or date that match a find string
3833 proc markmatches {canv l str tag matches font} {
3834     set bbox [$canv bbox $tag]
3835     set x0 [lindex $bbox 0]
3836     set y0 [lindex $bbox 1]
3837     set y1 [lindex $bbox 3]
3838     foreach match $matches {
3839         set start [lindex $match 0]
3840         set end [lindex $match 1]
3841         if {$start > $end} continue
3842         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3843         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3844         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3845                    [expr {$x0+$xlen+2}] $y1 \
3846                    -outline {} -tags matches -fill yellow]
3847         $canv lower $t
3848     }
3849 }
3850
3851 proc unmarkmatches {} {
3852     global matchinglines findids
3853     allcanvs delete matches
3854     catch {unset matchinglines}
3855     catch {unset findids}
3856 }
3857
3858 proc selcanvline {w x y} {
3859     global canv canvy0 ctext linespc
3860     global rowtextx
3861     set ymax [lindex [$canv cget -scrollregion] 3]
3862     if {$ymax == {}} return
3863     set yfrac [lindex [$canv yview] 0]
3864     set y [expr {$y + $yfrac * $ymax}]
3865     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3866     if {$l < 0} {
3867         set l 0
3868     }
3869     if {$w eq $canv} {
3870         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3871     }
3872     unmarkmatches
3873     selectline $l 1
3874 }
3875
3876 proc commit_descriptor {p} {
3877     global commitinfo
3878     if {![info exists commitinfo($p)]} {
3879         getcommit $p
3880     }
3881     set l "..."
3882     if {[llength $commitinfo($p)] > 1} {
3883         set l [lindex $commitinfo($p) 0]
3884     }
3885     return "$p ($l)\n"
3886 }
3887
3888 # append some text to the ctext widget, and make any SHA1 ID
3889 # that we know about be a clickable link.
3890 proc appendwithlinks {text tags} {
3891     global ctext commitrow linknum curview
3892
3893     set start [$ctext index "end - 1c"]
3894     $ctext insert end $text $tags
3895     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3896     foreach l $links {
3897         set s [lindex $l 0]
3898         set e [lindex $l 1]
3899         set linkid [string range $text $s $e]
3900         if {![info exists commitrow($curview,$linkid)]} continue
3901         incr e
3902         $ctext tag add link "$start + $s c" "$start + $e c"
3903         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3904         $ctext tag bind link$linknum <1> \
3905             [list selectline $commitrow($curview,$linkid) 1]
3906         incr linknum
3907     }
3908     $ctext tag conf link -foreground blue -underline 1
3909     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3910     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3911 }
3912
3913 proc viewnextline {dir} {
3914     global canv linespc
3915
3916     $canv delete hover
3917     set ymax [lindex [$canv cget -scrollregion] 3]
3918     set wnow [$canv yview]
3919     set wtop [expr {[lindex $wnow 0] * $ymax}]
3920     set newtop [expr {$wtop + $dir * $linespc}]
3921     if {$newtop < 0} {
3922         set newtop 0
3923     } elseif {$newtop > $ymax} {
3924         set newtop $ymax
3925     }
3926     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3927 }
3928
3929 # add a list of tag or branch names at position pos
3930 # returns the number of names inserted
3931 proc appendrefs {pos ids var} {
3932     global ctext commitrow linknum curview $var maxrefs
3933
3934     if {[catch {$ctext index $pos}]} {
3935         return 0
3936     }
3937     $ctext conf -state normal
3938     $ctext delete $pos "$pos lineend"
3939     set tags {}
3940     foreach id $ids {
3941         foreach tag [set $var\($id\)] {
3942             lappend tags [list $tag $id]
3943         }
3944     }
3945     if {[llength $tags] > $maxrefs} {
3946         $ctext insert $pos "many ([llength $tags])"
3947     } else {
3948         set tags [lsort -index 0 -decreasing $tags]
3949         set sep {}
3950         foreach ti $tags {
3951             set id [lindex $ti 1]
3952             set lk link$linknum
3953             incr linknum
3954             $ctext tag delete $lk
3955             $ctext insert $pos $sep
3956             $ctext insert $pos [lindex $ti 0] $lk
3957             if {[info exists commitrow($curview,$id)]} {
3958                 $ctext tag conf $lk -foreground blue
3959                 $ctext tag bind $lk <1> \
3960                     [list selectline $commitrow($curview,$id) 1]
3961                 $ctext tag conf $lk -underline 1
3962                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3963                 $ctext tag bind $lk <Leave> \
3964                     { %W configure -cursor $curtextcursor }
3965             }
3966             set sep ", "
3967         }
3968     }
3969     $ctext conf -state disabled
3970     return [llength $tags]
3971 }
3972
3973 # called when we have finished computing the nearby tags
3974 proc dispneartags {delay} {
3975     global selectedline currentid showneartags tagphase
3976
3977     if {![info exists selectedline] || !$showneartags} return
3978     after cancel dispnexttag
3979     if {$delay} {
3980         after 200 dispnexttag
3981         set tagphase -1
3982     } else {
3983         after idle dispnexttag
3984         set tagphase 0
3985     }
3986 }
3987
3988 proc dispnexttag {} {
3989     global selectedline currentid showneartags tagphase ctext
3990
3991     if {![info exists selectedline] || !$showneartags} return
3992     switch -- $tagphase {
3993         0 {
3994             set dtags [desctags $currentid]
3995             if {$dtags ne {}} {
3996                 appendrefs precedes $dtags idtags
3997             }
3998         }
3999         1 {
4000             set atags [anctags $currentid]
4001             if {$atags ne {}} {
4002                 appendrefs follows $atags idtags
4003             }
4004         }
4005         2 {
4006             set dheads [descheads $currentid]
4007             if {$dheads ne {}} {
4008                 if {[appendrefs branch $dheads idheads] > 1
4009                     && [$ctext get "branch -3c"] eq "h"} {
4010                     # turn "Branch" into "Branches"
4011                     $ctext conf -state normal
4012                     $ctext insert "branch -2c" "es"
4013                     $ctext conf -state disabled
4014                 }
4015             }
4016         }
4017     }
4018     if {[incr tagphase] <= 2} {
4019         after idle dispnexttag
4020     }
4021 }
4022
4023 proc selectline {l isnew} {
4024     global canv canv2 canv3 ctext commitinfo selectedline
4025     global displayorder linehtag linentag linedtag
4026     global canvy0 linespc parentlist childlist
4027     global currentid sha1entry
4028     global commentend idtags linknum
4029     global mergemax numcommits pending_select
4030     global cmitmode showneartags allcommits
4031
4032     catch {unset pending_select}
4033     $canv delete hover
4034     normalline
4035     cancel_next_highlight
4036     if {$l < 0 || $l >= $numcommits} return
4037     set y [expr {$canvy0 + $l * $linespc}]
4038     set ymax [lindex [$canv cget -scrollregion] 3]
4039     set ytop [expr {$y - $linespc - 1}]
4040     set ybot [expr {$y + $linespc + 1}]
4041     set wnow [$canv yview]
4042     set wtop [expr {[lindex $wnow 0] * $ymax}]
4043     set wbot [expr {[lindex $wnow 1] * $ymax}]
4044     set wh [expr {$wbot - $wtop}]
4045     set newtop $wtop
4046     if {$ytop < $wtop} {
4047         if {$ybot < $wtop} {
4048             set newtop [expr {$y - $wh / 2.0}]
4049         } else {
4050             set newtop $ytop
4051             if {$newtop > $wtop - $linespc} {
4052                 set newtop [expr {$wtop - $linespc}]
4053             }
4054         }
4055     } elseif {$ybot > $wbot} {
4056         if {$ytop > $wbot} {
4057             set newtop [expr {$y - $wh / 2.0}]
4058         } else {
4059             set newtop [expr {$ybot - $wh}]
4060             if {$newtop < $wtop + $linespc} {
4061                 set newtop [expr {$wtop + $linespc}]
4062             }
4063         }
4064     }
4065     if {$newtop != $wtop} {
4066         if {$newtop < 0} {
4067             set newtop 0
4068         }
4069         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4070         drawvisible
4071     }
4072
4073     if {![info exists linehtag($l)]} return
4074     $canv delete secsel
4075     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4076                -tags secsel -fill [$canv cget -selectbackground]]
4077     $canv lower $t
4078     $canv2 delete secsel
4079     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4080                -tags secsel -fill [$canv2 cget -selectbackground]]
4081     $canv2 lower $t
4082     $canv3 delete secsel
4083     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4084                -tags secsel -fill [$canv3 cget -selectbackground]]
4085     $canv3 lower $t
4086
4087     if {$isnew} {
4088         addtohistory [list selectline $l 0]
4089     }
4090
4091     set selectedline $l
4092
4093     set id [lindex $displayorder $l]
4094     set currentid $id
4095     $sha1entry delete 0 end
4096     $sha1entry insert 0 $id
4097     $sha1entry selection from 0
4098     $sha1entry selection to end
4099     rhighlight_sel $id
4100
4101     $ctext conf -state normal
4102     clear_ctext
4103     set linknum 0
4104     set info $commitinfo($id)
4105     set date [formatdate [lindex $info 2]]
4106     $ctext insert end "Author: [lindex $info 1]  $date\n"
4107     set date [formatdate [lindex $info 4]]
4108     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4109     if {[info exists idtags($id)]} {
4110         $ctext insert end "Tags:"
4111         foreach tag $idtags($id) {
4112             $ctext insert end " $tag"
4113         }
4114         $ctext insert end "\n"
4115     }
4116
4117     set headers {}
4118     set olds [lindex $parentlist $l]
4119     if {[llength $olds] > 1} {
4120         set np 0
4121         foreach p $olds {
4122             if {$np >= $mergemax} {
4123                 set tag mmax
4124             } else {
4125                 set tag m$np
4126             }
4127             $ctext insert end "Parent: " $tag
4128             appendwithlinks [commit_descriptor $p] {}
4129             incr np
4130         }
4131     } else {
4132         foreach p $olds {
4133             append headers "Parent: [commit_descriptor $p]"
4134         }
4135     }
4136
4137     foreach c [lindex $childlist $l] {
4138         append headers "Child:  [commit_descriptor $c]"
4139     }
4140
4141     # make anything that looks like a SHA1 ID be a clickable link
4142     appendwithlinks $headers {}
4143     if {$showneartags} {
4144         if {![info exists allcommits]} {
4145             getallcommits
4146         }
4147         $ctext insert end "Branch: "
4148         $ctext mark set branch "end -1c"
4149         $ctext mark gravity branch left
4150         $ctext insert end "\nFollows: "
4151         $ctext mark set follows "end -1c"
4152         $ctext mark gravity follows left
4153         $ctext insert end "\nPrecedes: "
4154         $ctext mark set precedes "end -1c"
4155         $ctext mark gravity precedes left
4156         $ctext insert end "\n"
4157         dispneartags 1
4158     }
4159     $ctext insert end "\n"
4160     appendwithlinks [lindex $info 5] {comment}
4161
4162     $ctext tag delete Comments
4163     $ctext tag remove found 1.0 end
4164     $ctext conf -state disabled
4165     set commentend [$ctext index "end - 1c"]
4166
4167     init_flist "Comments"
4168     if {$cmitmode eq "tree"} {
4169         gettree $id
4170     } elseif {[llength $olds] <= 1} {
4171         startdiff $id
4172     } else {
4173         mergediff $id $l
4174     }
4175 }
4176
4177 proc selfirstline {} {
4178     unmarkmatches
4179     selectline 0 1
4180 }
4181
4182 proc sellastline {} {
4183     global numcommits
4184     unmarkmatches
4185     set l [expr {$numcommits - 1}]
4186     selectline $l 1
4187 }
4188
4189 proc selnextline {dir} {
4190     global selectedline
4191     if {![info exists selectedline]} return
4192     set l [expr {$selectedline + $dir}]
4193     unmarkmatches
4194     selectline $l 1
4195 }
4196
4197 proc selnextpage {dir} {
4198     global canv linespc selectedline numcommits
4199
4200     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4201     if {$lpp < 1} {
4202         set lpp 1
4203     }
4204     allcanvs yview scroll [expr {$dir * $lpp}] units
4205     drawvisible
4206     if {![info exists selectedline]} return
4207     set l [expr {$selectedline + $dir * $lpp}]
4208     if {$l < 0} {
4209         set l 0
4210     } elseif {$l >= $numcommits} {
4211         set l [expr $numcommits - 1]
4212     }
4213     unmarkmatches
4214     selectline $l 1
4215 }
4216
4217 proc unselectline {} {
4218     global selectedline currentid
4219
4220     catch {unset selectedline}
4221     catch {unset currentid}
4222     allcanvs delete secsel
4223     rhighlight_none
4224     cancel_next_highlight
4225 }
4226
4227 proc reselectline {} {
4228     global selectedline
4229
4230     if {[info exists selectedline]} {
4231         selectline $selectedline 0
4232     }
4233 }
4234
4235 proc addtohistory {cmd} {
4236     global history historyindex curview
4237
4238     set elt [list $curview $cmd]
4239     if {$historyindex > 0
4240         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4241         return
4242     }
4243
4244     if {$historyindex < [llength $history]} {
4245         set history [lreplace $history $historyindex end $elt]
4246     } else {
4247         lappend history $elt
4248     }
4249     incr historyindex
4250     if {$historyindex > 1} {
4251         .tf.bar.leftbut conf -state normal
4252     } else {
4253         .tf.bar.leftbut conf -state disabled
4254     }
4255     .tf.bar.rightbut conf -state disabled
4256 }
4257
4258 proc godo {elt} {
4259     global curview
4260
4261     set view [lindex $elt 0]
4262     set cmd [lindex $elt 1]
4263     if {$curview != $view} {
4264         showview $view
4265     }
4266     eval $cmd
4267 }
4268
4269 proc goback {} {
4270     global history historyindex
4271
4272     if {$historyindex > 1} {
4273         incr historyindex -1
4274         godo [lindex $history [expr {$historyindex - 1}]]
4275         .tf.bar.rightbut conf -state normal
4276     }
4277     if {$historyindex <= 1} {
4278         .tf.bar.leftbut conf -state disabled
4279     }
4280 }
4281
4282 proc goforw {} {
4283     global history historyindex
4284
4285     if {$historyindex < [llength $history]} {
4286         set cmd [lindex $history $historyindex]
4287         incr historyindex
4288         godo $cmd
4289         .tf.bar.leftbut conf -state normal
4290     }
4291     if {$historyindex >= [llength $history]} {
4292         .tf.bar.rightbut conf -state disabled
4293     }
4294 }
4295
4296 proc gettree {id} {
4297     global treefilelist treeidlist diffids diffmergeid treepending
4298
4299     set diffids $id
4300     catch {unset diffmergeid}
4301     if {![info exists treefilelist($id)]} {
4302         if {![info exists treepending]} {
4303             if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4304                 return
4305             }
4306             set treepending $id
4307             set treefilelist($id) {}
4308             set treeidlist($id) {}
4309             fconfigure $gtf -blocking 0
4310             filerun $gtf [list gettreeline $gtf $id]
4311         }
4312     } else {
4313         setfilelist $id
4314     }
4315 }
4316
4317 proc gettreeline {gtf id} {
4318     global treefilelist treeidlist treepending cmitmode diffids
4319
4320     set nl 0
4321     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4322         set tl [split $line "\t"]
4323         if {[lindex $tl 0 1] ne "blob"} continue
4324         set sha1 [lindex $tl 0 2]
4325         set fname [lindex $tl 1]
4326         if {[string index $fname 0] eq "\""} {
4327             set fname [lindex $fname 0]
4328         }
4329         lappend treeidlist($id) $sha1
4330         lappend treefilelist($id) $fname
4331     }
4332     if {![eof $gtf]} {
4333         return [expr {$nl >= 1000? 2: 1}]
4334     }
4335     close $gtf
4336     unset treepending
4337     if {$cmitmode ne "tree"} {
4338         if {![info exists diffmergeid]} {
4339             gettreediffs $diffids
4340         }
4341     } elseif {$id ne $diffids} {
4342         gettree $diffids
4343     } else {
4344         setfilelist $id
4345     }
4346     return 0
4347 }
4348
4349 proc showfile {f} {
4350     global treefilelist treeidlist diffids
4351     global ctext commentend
4352
4353     set i [lsearch -exact $treefilelist($diffids) $f]
4354     if {$i < 0} {
4355         puts "oops, $f not in list for id $diffids"
4356         return
4357     }
4358     set blob [lindex $treeidlist($diffids) $i]
4359     if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4360         puts "oops, error reading blob $blob: $err"
4361         return
4362     }
4363     fconfigure $bf -blocking 0
4364     filerun $bf [list getblobline $bf $diffids]
4365     $ctext config -state normal
4366     clear_ctext $commentend
4367     $ctext insert end "\n"
4368     $ctext insert end "$f\n" filesep
4369     $ctext config -state disabled
4370     $ctext yview $commentend
4371 }
4372
4373 proc getblobline {bf id} {
4374     global diffids cmitmode ctext
4375
4376     if {$id ne $diffids || $cmitmode ne "tree"} {
4377         catch {close $bf}
4378         return 0
4379     }
4380     $ctext config -state normal
4381     set nl 0
4382     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4383         $ctext insert end "$line\n"
4384     }
4385     if {[eof $bf]} {
4386         # delete last newline
4387         $ctext delete "end - 2c" "end - 1c"
4388         close $bf
4389         return 0
4390     }
4391     $ctext config -state disabled
4392     return [expr {$nl >= 1000? 2: 1}]
4393 }
4394
4395 proc mergediff {id l} {
4396     global diffmergeid diffopts mdifffd
4397     global diffids
4398     global parentlist
4399
4400     set diffmergeid $id
4401     set diffids $id
4402     # this doesn't seem to actually affect anything...
4403     set env(GIT_DIFF_OPTS) $diffopts
4404     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4405     if {[catch {set mdf [open $cmd r]} err]} {
4406         error_popup "Error getting merge diffs: $err"
4407         return
4408     }
4409     fconfigure $mdf -blocking 0
4410     set mdifffd($id) $mdf
4411     set np [llength [lindex $parentlist $l]]
4412     filerun $mdf [list getmergediffline $mdf $id $np]
4413 }
4414
4415 proc getmergediffline {mdf id np} {
4416     global diffmergeid ctext cflist mergemax
4417     global difffilestart mdifffd
4418
4419     $ctext conf -state normal
4420     set nr 0
4421     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4422         if {![info exists diffmergeid] || $id != $diffmergeid
4423             || $mdf != $mdifffd($id)} {
4424             close $mdf
4425             return 0
4426         }
4427         if {[regexp {^diff --cc (.*)} $line match fname]} {
4428             # start of a new file
4429             $ctext insert end "\n"
4430             set here [$ctext index "end - 1c"]
4431             lappend difffilestart $here
4432             add_flist [list $fname]
4433             set l [expr {(78 - [string length $fname]) / 2}]
4434             set pad [string range "----------------------------------------" 1 $l]
4435             $ctext insert end "$pad $fname $pad\n" filesep
4436         } elseif {[regexp {^@@} $line]} {
4437             $ctext insert end "$line\n" hunksep
4438         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4439             # do nothing
4440         } else {
4441             # parse the prefix - one ' ', '-' or '+' for each parent
4442             set spaces {}
4443             set minuses {}
4444             set pluses {}
4445             set isbad 0
4446             for {set j 0} {$j < $np} {incr j} {
4447                 set c [string range $line $j $j]
4448                 if {$c == " "} {
4449                     lappend spaces $j
4450                 } elseif {$c == "-"} {
4451                     lappend minuses $j
4452                 } elseif {$c == "+"} {
4453                     lappend pluses $j
4454                 } else {
4455                     set isbad 1
4456                     break
4457                 }
4458             }
4459             set tags {}
4460             set num {}
4461             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4462                 # line doesn't appear in result, parents in $minuses have the line
4463                 set num [lindex $minuses 0]
4464             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4465                 # line appears in result, parents in $pluses don't have the line
4466                 lappend tags mresult
4467                 set num [lindex $spaces 0]
4468             }
4469             if {$num ne {}} {
4470                 if {$num >= $mergemax} {
4471                     set num "max"
4472                 }
4473                 lappend tags m$num
4474             }
4475             $ctext insert end "$line\n" $tags
4476         }
4477     }
4478     $ctext conf -state disabled
4479     if {[eof $mdf]} {
4480         close $mdf
4481         return 0
4482     }
4483     return [expr {$nr >= 1000? 2: 1}]
4484 }
4485
4486 proc startdiff {ids} {
4487     global treediffs diffids treepending diffmergeid
4488
4489     set diffids $ids
4490     catch {unset diffmergeid}
4491     if {![info exists treediffs($ids)]} {
4492         if {![info exists treepending]} {
4493             gettreediffs $ids
4494         }
4495     } else {
4496         addtocflist $ids
4497     }
4498 }
4499
4500 proc addtocflist {ids} {
4501     global treediffs cflist
4502     add_flist $treediffs($ids)
4503     getblobdiffs $ids
4504 }
4505
4506 proc gettreediffs {ids} {
4507     global treediff treepending
4508     set treepending $ids
4509     set treediff {}
4510     if {[catch \
4511          {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4512         ]} return
4513     fconfigure $gdtf -blocking 0
4514     filerun $gdtf [list gettreediffline $gdtf $ids]
4515 }
4516
4517 proc gettreediffline {gdtf ids} {
4518     global treediff treediffs treepending diffids diffmergeid
4519     global cmitmode
4520
4521     set nr 0
4522     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4523         set file [lindex $line 5]
4524         lappend treediff $file
4525     }
4526     if {![eof $gdtf]} {
4527         return [expr {$nr >= 1000? 2: 1}]
4528     }
4529     close $gdtf
4530     set treediffs($ids) $treediff
4531     unset treepending
4532     if {$cmitmode eq "tree"} {
4533         gettree $diffids
4534     } elseif {$ids != $diffids} {
4535         if {![info exists diffmergeid]} {
4536             gettreediffs $diffids
4537         }
4538     } else {
4539         addtocflist $ids
4540     }
4541     return 0
4542 }
4543
4544 proc getblobdiffs {ids} {
4545     global diffopts blobdifffd diffids env curdifftag curtagstart
4546     global diffinhdr treediffs
4547
4548     set env(GIT_DIFF_OPTS) $diffopts
4549     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4550     if {[catch {set bdf [open $cmd r]} err]} {
4551         puts "error getting diffs: $err"
4552         return
4553     }
4554     set diffinhdr 0
4555     fconfigure $bdf -blocking 0
4556     set blobdifffd($ids) $bdf
4557     set curdifftag Comments
4558     set curtagstart 0.0
4559     filerun $bdf [list getblobdiffline $bdf $diffids]
4560 }
4561
4562 proc setinlist {var i val} {
4563     global $var
4564
4565     while {[llength [set $var]] < $i} {
4566         lappend $var {}
4567     }
4568     if {[llength [set $var]] == $i} {
4569         lappend $var $val
4570     } else {
4571         lset $var $i $val
4572     }
4573 }
4574
4575 proc getblobdiffline {bdf ids} {
4576     global diffids blobdifffd ctext curdifftag curtagstart
4577     global diffnexthead diffnextnote difffilestart
4578     global diffinhdr treediffs
4579
4580     set nr 0
4581     $ctext conf -state normal
4582     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4583         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4584             close $bdf
4585             return 0
4586         }
4587         if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4588             # start of a new file
4589             $ctext insert end "\n"
4590             $ctext tag add $curdifftag $curtagstart end
4591             set here [$ctext index "end - 1c"]
4592             set curtagstart $here
4593             set header $newname
4594             set i [lsearch -exact $treediffs($ids) $fname]
4595             if {$i >= 0} {
4596                 setinlist difffilestart $i $here
4597             }
4598             if {$newname ne $fname} {
4599                 set i [lsearch -exact $treediffs($ids) $newname]
4600                 if {$i >= 0} {
4601                     setinlist difffilestart $i $here
4602                 }
4603             }
4604             set curdifftag "f:$fname"
4605             $ctext tag delete $curdifftag
4606             set l [expr {(78 - [string length $header]) / 2}]
4607             set pad [string range "----------------------------------------" \
4608                          1 $l]
4609             $ctext insert end "$pad $header $pad\n" filesep
4610             set diffinhdr 1
4611         } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4612             # do nothing
4613         } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4614             set diffinhdr 0
4615         } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4616                        $line match f1l f1c f2l f2c rest]} {
4617             $ctext insert end "$line\n" hunksep
4618             set diffinhdr 0
4619         } else {
4620             set x [string range $line 0 0]
4621             if {$x == "-" || $x == "+"} {
4622                 set tag [expr {$x == "+"}]
4623                 $ctext insert end "$line\n" d$tag
4624             } elseif {$x == " "} {
4625                 $ctext insert end "$line\n"
4626             } elseif {$diffinhdr || $x == "\\"} {
4627                 # e.g. "\ No newline at end of file"
4628                 $ctext insert end "$line\n" filesep
4629             } else {
4630                 # Something else we don't recognize
4631                 if {$curdifftag != "Comments"} {
4632                     $ctext insert end "\n"
4633                     $ctext tag add $curdifftag $curtagstart end
4634                     set curtagstart [$ctext index "end - 1c"]
4635                     set curdifftag Comments
4636                 }
4637                 $ctext insert end "$line\n" filesep
4638             }
4639         }
4640     }
4641     $ctext conf -state disabled
4642     if {[eof $bdf]} {
4643         close $bdf
4644         if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4645             $ctext tag add $curdifftag $curtagstart end
4646         }
4647         return 0
4648     }
4649     return [expr {$nr >= 1000? 2: 1}]
4650 }
4651
4652 proc changediffdisp {} {
4653     global ctext diffelide
4654
4655     $ctext tag conf d0 -elide [lindex $diffelide 0]
4656     $ctext tag conf d1 -elide [lindex $diffelide 1]
4657 }
4658
4659 proc prevfile {} {
4660     global difffilestart ctext
4661     set prev [lindex $difffilestart 0]
4662     set here [$ctext index @0,0]
4663     foreach loc $difffilestart {
4664         if {[$ctext compare $loc >= $here]} {
4665             $ctext yview $prev
4666             return
4667         }
4668         set prev $loc
4669     }
4670     $ctext yview $prev
4671 }
4672
4673 proc nextfile {} {
4674     global difffilestart ctext
4675     set here [$ctext index @0,0]
4676     foreach loc $difffilestart {
4677         if {[$ctext compare $loc > $here]} {
4678             $ctext yview $loc
4679             return
4680         }
4681     }
4682 }
4683
4684 proc clear_ctext {{first 1.0}} {
4685     global ctext smarktop smarkbot
4686
4687     set l [lindex [split $first .] 0]
4688     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4689         set smarktop $l
4690     }
4691     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4692         set smarkbot $l
4693     }
4694     $ctext delete $first end
4695 }
4696
4697 proc incrsearch {name ix op} {
4698     global ctext searchstring searchdirn
4699
4700     $ctext tag remove found 1.0 end
4701     if {[catch {$ctext index anchor}]} {
4702         # no anchor set, use start of selection, or of visible area
4703         set sel [$ctext tag ranges sel]
4704         if {$sel ne {}} {
4705             $ctext mark set anchor [lindex $sel 0]
4706         } elseif {$searchdirn eq "-forwards"} {
4707             $ctext mark set anchor @0,0
4708         } else {
4709             $ctext mark set anchor @0,[winfo height $ctext]
4710         }
4711     }
4712     if {$searchstring ne {}} {
4713         set here [$ctext search $searchdirn -- $searchstring anchor]
4714         if {$here ne {}} {
4715             $ctext see $here
4716         }
4717         searchmarkvisible 1
4718     }
4719 }
4720
4721 proc dosearch {} {
4722     global sstring ctext searchstring searchdirn
4723
4724     focus $sstring
4725     $sstring icursor end
4726     set searchdirn -forwards
4727     if {$searchstring ne {}} {
4728         set sel [$ctext tag ranges sel]
4729         if {$sel ne {}} {
4730             set start "[lindex $sel 0] + 1c"
4731         } elseif {[catch {set start [$ctext index anchor]}]} {
4732             set start "@0,0"
4733         }
4734         set match [$ctext search -count mlen -- $searchstring $start]
4735         $ctext tag remove sel 1.0 end
4736         if {$match eq {}} {
4737             bell
4738             return
4739         }
4740         $ctext see $match
4741         set mend "$match + $mlen c"
4742         $ctext tag add sel $match $mend
4743         $ctext mark unset anchor
4744     }
4745 }
4746
4747 proc dosearchback {} {
4748     global sstring ctext searchstring searchdirn
4749
4750     focus $sstring
4751     $sstring icursor end
4752     set searchdirn -backwards
4753     if {$searchstring ne {}} {
4754         set sel [$ctext tag ranges sel]
4755         if {$sel ne {}} {
4756             set start [lindex $sel 0]
4757         } elseif {[catch {set start [$ctext index anchor]}]} {
4758             set start @0,[winfo height $ctext]
4759         }
4760         set match [$ctext search -backwards -count ml -- $searchstring $start]
4761         $ctext tag remove sel 1.0 end
4762         if {$match eq {}} {
4763             bell
4764             return
4765         }
4766         $ctext see $match
4767         set mend "$match + $ml c"
4768         $ctext tag add sel $match $mend
4769         $ctext mark unset anchor
4770     }
4771 }
4772
4773 proc searchmark {first last} {
4774     global ctext searchstring
4775
4776     set mend $first.0
4777     while {1} {
4778         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4779         if {$match eq {}} break
4780         set mend "$match + $mlen c"
4781         $ctext tag add found $match $mend
4782     }
4783 }
4784
4785 proc searchmarkvisible {doall} {
4786     global ctext smarktop smarkbot
4787
4788     set topline [lindex [split [$ctext index @0,0] .] 0]
4789     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4790     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4791         # no overlap with previous
4792         searchmark $topline $botline
4793         set smarktop $topline
4794         set smarkbot $botline
4795     } else {
4796         if {$topline < $smarktop} {
4797             searchmark $topline [expr {$smarktop-1}]
4798             set smarktop $topline
4799         }
4800         if {$botline > $smarkbot} {
4801             searchmark [expr {$smarkbot+1}] $botline
4802             set smarkbot $botline
4803         }
4804     }
4805 }
4806
4807 proc scrolltext {f0 f1} {
4808     global searchstring
4809
4810     .bleft.sb set $f0 $f1
4811     if {$searchstring ne {}} {
4812         searchmarkvisible 0
4813     }
4814 }
4815
4816 proc setcoords {} {
4817     global linespc charspc canvx0 canvy0 mainfont
4818     global xspc1 xspc2 lthickness
4819
4820     set linespc [font metrics $mainfont -linespace]
4821     set charspc [font measure $mainfont "m"]
4822     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4823     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4824     set lthickness [expr {int($linespc / 9) + 1}]
4825     set xspc1(0) $linespc
4826     set xspc2 $linespc
4827 }
4828
4829 proc redisplay {} {
4830     global canv
4831     global selectedline
4832
4833     set ymax [lindex [$canv cget -scrollregion] 3]
4834     if {$ymax eq {} || $ymax == 0} return
4835     set span [$canv yview]
4836     clear_display
4837     setcanvscroll
4838     allcanvs yview moveto [lindex $span 0]
4839     drawvisible
4840     if {[info exists selectedline]} {
4841         selectline $selectedline 0
4842         allcanvs yview moveto [lindex $span 0]
4843     }
4844 }
4845
4846 proc incrfont {inc} {
4847     global mainfont textfont ctext canv phase cflist
4848     global charspc tabstop
4849     global stopped entries
4850     unmarkmatches
4851     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4852     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4853     setcoords
4854     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
4855     $cflist conf -font $textfont
4856     $ctext tag conf filesep -font [concat $textfont bold]
4857     foreach e $entries {
4858         $e conf -font $mainfont
4859     }
4860     if {$phase eq "getcommits"} {
4861         $canv itemconf textitems -font $mainfont
4862     }
4863     redisplay
4864 }
4865
4866 proc clearsha1 {} {
4867     global sha1entry sha1string
4868     if {[string length $sha1string] == 40} {
4869         $sha1entry delete 0 end
4870     }
4871 }
4872
4873 proc sha1change {n1 n2 op} {
4874     global sha1string currentid sha1but
4875     if {$sha1string == {}
4876         || ([info exists currentid] && $sha1string == $currentid)} {
4877         set state disabled
4878     } else {
4879         set state normal
4880     }
4881     if {[$sha1but cget -state] == $state} return
4882     if {$state == "normal"} {
4883         $sha1but conf -state normal -relief raised -text "Goto: "
4884     } else {
4885         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4886     }
4887 }
4888
4889 proc gotocommit {} {
4890     global sha1string currentid commitrow tagids headids
4891     global displayorder numcommits curview
4892
4893     if {$sha1string == {}
4894         || ([info exists currentid] && $sha1string == $currentid)} return
4895     if {[info exists tagids($sha1string)]} {
4896         set id $tagids($sha1string)
4897     } elseif {[info exists headids($sha1string)]} {
4898         set id $headids($sha1string)
4899     } else {
4900         set id [string tolower $sha1string]
4901         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4902             set matches {}
4903             foreach i $displayorder {
4904                 if {[string match $id* $i]} {
4905                     lappend matches $i
4906                 }
4907             }
4908             if {$matches ne {}} {
4909                 if {[llength $matches] > 1} {
4910                     error_popup "Short SHA1 id $id is ambiguous"
4911                     return
4912                 }
4913                 set id [lindex $matches 0]
4914             }
4915         }
4916     }
4917     if {[info exists commitrow($curview,$id)]} {
4918         selectline $commitrow($curview,$id) 1
4919         return
4920     }
4921     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4922         set type "SHA1 id"
4923     } else {
4924         set type "Tag/Head"
4925     }
4926     error_popup "$type $sha1string is not known"
4927 }
4928
4929 proc lineenter {x y id} {
4930     global hoverx hovery hoverid hovertimer
4931     global commitinfo canv
4932
4933     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4934     set hoverx $x
4935     set hovery $y
4936     set hoverid $id
4937     if {[info exists hovertimer]} {
4938         after cancel $hovertimer
4939     }
4940     set hovertimer [after 500 linehover]
4941     $canv delete hover
4942 }
4943
4944 proc linemotion {x y id} {
4945     global hoverx hovery hoverid hovertimer
4946
4947     if {[info exists hoverid] && $id == $hoverid} {
4948         set hoverx $x
4949         set hovery $y
4950         if {[info exists hovertimer]} {
4951             after cancel $hovertimer
4952         }
4953         set hovertimer [after 500 linehover]
4954     }
4955 }
4956
4957 proc lineleave {id} {
4958     global hoverid hovertimer canv
4959
4960     if {[info exists hoverid] && $id == $hoverid} {
4961         $canv delete hover
4962         if {[info exists hovertimer]} {
4963             after cancel $hovertimer
4964             unset hovertimer
4965         }
4966         unset hoverid
4967     }
4968 }
4969
4970 proc linehover {} {
4971     global hoverx hovery hoverid hovertimer
4972     global canv linespc lthickness
4973     global commitinfo mainfont
4974
4975     set text [lindex $commitinfo($hoverid) 0]
4976     set ymax [lindex [$canv cget -scrollregion] 3]
4977     if {$ymax == {}} return
4978     set yfrac [lindex [$canv yview] 0]
4979     set x [expr {$hoverx + 2 * $linespc}]
4980     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4981     set x0 [expr {$x - 2 * $lthickness}]
4982     set y0 [expr {$y - 2 * $lthickness}]
4983     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4984     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4985     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4986                -fill \#ffff80 -outline black -width 1 -tags hover]
4987     $canv raise $t
4988     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4989                -font $mainfont]
4990     $canv raise $t
4991 }
4992
4993 proc clickisonarrow {id y} {
4994     global lthickness
4995
4996     set ranges [rowranges $id]
4997     set thresh [expr {2 * $lthickness + 6}]
4998     set n [expr {[llength $ranges] - 1}]
4999     for {set i 1} {$i < $n} {incr i} {
5000         set row [lindex $ranges $i]
5001         if {abs([yc $row] - $y) < $thresh} {
5002             return $i
5003         }
5004     }
5005     return {}
5006 }
5007
5008 proc arrowjump {id n y} {
5009     global canv
5010
5011     # 1 <-> 2, 3 <-> 4, etc...
5012     set n [expr {(($n - 1) ^ 1) + 1}]
5013     set row [lindex [rowranges $id] $n]
5014     set yt [yc $row]
5015     set ymax [lindex [$canv cget -scrollregion] 3]
5016     if {$ymax eq {} || $ymax <= 0} return
5017     set view [$canv yview]
5018     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5019     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5020     if {$yfrac < 0} {
5021         set yfrac 0
5022     }
5023     allcanvs yview moveto $yfrac
5024 }
5025
5026 proc lineclick {x y id isnew} {
5027     global ctext commitinfo children canv thickerline curview
5028
5029     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5030     unmarkmatches
5031     unselectline
5032     normalline
5033     $canv delete hover
5034     # draw this line thicker than normal
5035     set thickerline $id
5036     drawlines $id
5037     if {$isnew} {
5038         set ymax [lindex [$canv cget -scrollregion] 3]
5039         if {$ymax eq {}} return
5040         set yfrac [lindex [$canv yview] 0]
5041         set y [expr {$y + $yfrac * $ymax}]
5042     }
5043     set dirn [clickisonarrow $id $y]
5044     if {$dirn ne {}} {
5045         arrowjump $id $dirn $y
5046         return
5047     }
5048
5049     if {$isnew} {
5050         addtohistory [list lineclick $x $y $id 0]
5051     }
5052     # fill the details pane with info about this line
5053     $ctext conf -state normal
5054     clear_ctext
5055     $ctext tag conf link -foreground blue -underline 1
5056     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5057     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5058     $ctext insert end "Parent:\t"
5059     $ctext insert end $id [list link link0]
5060     $ctext tag bind link0 <1> [list selbyid $id]
5061     set info $commitinfo($id)
5062     $ctext insert end "\n\t[lindex $info 0]\n"
5063     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5064     set date [formatdate [lindex $info 2]]
5065     $ctext insert end "\tDate:\t$date\n"
5066     set kids $children($curview,$id)
5067     if {$kids ne {}} {
5068         $ctext insert end "\nChildren:"
5069         set i 0
5070         foreach child $kids {
5071             incr i
5072             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5073             set info $commitinfo($child)
5074             $ctext insert end "\n\t"
5075             $ctext insert end $child [list link link$i]
5076             $ctext tag bind link$i <1> [list selbyid $child]
5077             $ctext insert end "\n\t[lindex $info 0]"
5078             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5079             set date [formatdate [lindex $info 2]]
5080             $ctext insert end "\n\tDate:\t$date\n"
5081         }
5082     }
5083     $ctext conf -state disabled
5084     init_flist {}
5085 }
5086
5087 proc normalline {} {
5088     global thickerline
5089     if {[info exists thickerline]} {
5090         set id $thickerline
5091         unset thickerline
5092         drawlines $id
5093     }
5094 }
5095
5096 proc selbyid {id} {
5097     global commitrow curview
5098     if {[info exists commitrow($curview,$id)]} {
5099         selectline $commitrow($curview,$id) 1
5100     }
5101 }
5102
5103 proc mstime {} {
5104     global startmstime
5105     if {![info exists startmstime]} {
5106         set startmstime [clock clicks -milliseconds]
5107     }
5108     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5109 }
5110
5111 proc rowmenu {x y id} {
5112     global rowctxmenu commitrow selectedline rowmenuid curview
5113
5114     if {![info exists selectedline]
5115         || $commitrow($curview,$id) eq $selectedline} {
5116         set state disabled
5117     } else {
5118         set state normal
5119     }
5120     $rowctxmenu entryconfigure "Diff this*" -state $state
5121     $rowctxmenu entryconfigure "Diff selected*" -state $state
5122     $rowctxmenu entryconfigure "Make patch" -state $state
5123     set rowmenuid $id
5124     tk_popup $rowctxmenu $x $y
5125 }
5126
5127 proc diffvssel {dirn} {
5128     global rowmenuid selectedline displayorder
5129
5130     if {![info exists selectedline]} return
5131     if {$dirn} {
5132         set oldid [lindex $displayorder $selectedline]
5133         set newid $rowmenuid
5134     } else {
5135         set oldid $rowmenuid
5136         set newid [lindex $displayorder $selectedline]
5137     }
5138     addtohistory [list doseldiff $oldid $newid]
5139     doseldiff $oldid $newid
5140 }
5141
5142 proc doseldiff {oldid newid} {
5143     global ctext
5144     global commitinfo
5145
5146     $ctext conf -state normal
5147     clear_ctext
5148     init_flist "Top"
5149     $ctext insert end "From "
5150     $ctext tag conf link -foreground blue -underline 1
5151     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5152     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5153     $ctext tag bind link0 <1> [list selbyid $oldid]
5154     $ctext insert end $oldid [list link link0]
5155     $ctext insert end "\n     "
5156     $ctext insert end [lindex $commitinfo($oldid) 0]
5157     $ctext insert end "\n\nTo   "
5158     $ctext tag bind link1 <1> [list selbyid $newid]
5159     $ctext insert end $newid [list link link1]
5160     $ctext insert end "\n     "
5161     $ctext insert end [lindex $commitinfo($newid) 0]
5162     $ctext insert end "\n"
5163     $ctext conf -state disabled
5164     $ctext tag delete Comments
5165     $ctext tag remove found 1.0 end
5166     startdiff [list $oldid $newid]
5167 }
5168
5169 proc mkpatch {} {
5170     global rowmenuid currentid commitinfo patchtop patchnum
5171
5172     if {![info exists currentid]} return
5173     set oldid $currentid
5174     set oldhead [lindex $commitinfo($oldid) 0]
5175     set newid $rowmenuid
5176     set newhead [lindex $commitinfo($newid) 0]
5177     set top .patch
5178     set patchtop $top
5179     catch {destroy $top}
5180     toplevel $top
5181     label $top.title -text "Generate patch"
5182     grid $top.title - -pady 10
5183     label $top.from -text "From:"
5184     entry $top.fromsha1 -width 40 -relief flat
5185     $top.fromsha1 insert 0 $oldid
5186     $top.fromsha1 conf -state readonly
5187     grid $top.from $top.fromsha1 -sticky w
5188     entry $top.fromhead -width 60 -relief flat
5189     $top.fromhead insert 0 $oldhead
5190     $top.fromhead conf -state readonly
5191     grid x $top.fromhead -sticky w
5192     label $top.to -text "To:"
5193     entry $top.tosha1 -width 40 -relief flat
5194     $top.tosha1 insert 0 $newid
5195     $top.tosha1 conf -state readonly
5196     grid $top.to $top.tosha1 -sticky w
5197     entry $top.tohead -width 60 -relief flat
5198     $top.tohead insert 0 $newhead
5199     $top.tohead conf -state readonly
5200     grid x $top.tohead -sticky w
5201     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5202     grid $top.rev x -pady 10
5203     label $top.flab -text "Output file:"
5204     entry $top.fname -width 60
5205     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5206     incr patchnum
5207     grid $top.flab $top.fname -sticky w
5208     frame $top.buts
5209     button $top.buts.gen -text "Generate" -command mkpatchgo
5210     button $top.buts.can -text "Cancel" -command mkpatchcan
5211     grid $top.buts.gen $top.buts.can
5212     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5213     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5214     grid $top.buts - -pady 10 -sticky ew
5215     focus $top.fname
5216 }
5217
5218 proc mkpatchrev {} {
5219     global patchtop
5220
5221     set oldid [$patchtop.fromsha1 get]
5222     set oldhead [$patchtop.fromhead get]
5223     set newid [$patchtop.tosha1 get]
5224     set newhead [$patchtop.tohead get]
5225     foreach e [list fromsha1 fromhead tosha1 tohead] \
5226             v [list $newid $newhead $oldid $oldhead] {
5227         $patchtop.$e conf -state normal
5228         $patchtop.$e delete 0 end
5229         $patchtop.$e insert 0 $v
5230         $patchtop.$e conf -state readonly
5231     }
5232 }
5233
5234 proc mkpatchgo {} {
5235     global patchtop
5236
5237     set oldid [$patchtop.fromsha1 get]
5238     set newid [$patchtop.tosha1 get]
5239     set fname [$patchtop.fname get]
5240     if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5241         error_popup "Error creating patch: $err"
5242     }
5243     catch {destroy $patchtop}
5244     unset patchtop
5245 }
5246
5247 proc mkpatchcan {} {
5248     global patchtop
5249
5250     catch {destroy $patchtop}
5251     unset patchtop
5252 }
5253
5254 proc mktag {} {
5255     global rowmenuid mktagtop commitinfo
5256
5257     set top .maketag
5258     set mktagtop $top
5259     catch {destroy $top}
5260     toplevel $top
5261     label $top.title -text "Create tag"
5262     grid $top.title - -pady 10
5263     label $top.id -text "ID:"
5264     entry $top.sha1 -width 40 -relief flat
5265     $top.sha1 insert 0 $rowmenuid
5266     $top.sha1 conf -state readonly
5267     grid $top.id $top.sha1 -sticky w
5268     entry $top.head -width 60 -relief flat
5269     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5270     $top.head conf -state readonly
5271     grid x $top.head -sticky w
5272     label $top.tlab -text "Tag name:"
5273     entry $top.tag -width 60
5274     grid $top.tlab $top.tag -sticky w
5275     frame $top.buts
5276     button $top.buts.gen -text "Create" -command mktaggo
5277     button $top.buts.can -text "Cancel" -command mktagcan
5278     grid $top.buts.gen $top.buts.can
5279     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5280     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5281     grid $top.buts - -pady 10 -sticky ew
5282     focus $top.tag
5283 }
5284
5285 proc domktag {} {
5286     global mktagtop env tagids idtags
5287
5288     set id [$mktagtop.sha1 get]
5289     set tag [$mktagtop.tag get]
5290     if {$tag == {}} {
5291         error_popup "No tag name specified"
5292         return
5293     }
5294     if {[info exists tagids($tag)]} {
5295         error_popup "Tag \"$tag\" already exists"
5296         return
5297     }
5298     if {[catch {
5299         set dir [gitdir]
5300         set fname [file join $dir "refs/tags" $tag]
5301         set f [open $fname w]
5302         puts $f $id
5303         close $f
5304     } err]} {
5305         error_popup "Error creating tag: $err"
5306         return
5307     }
5308
5309     set tagids($tag) $id
5310     lappend idtags($id) $tag
5311     redrawtags $id
5312     addedtag $id
5313 }
5314
5315 proc redrawtags {id} {
5316     global canv linehtag commitrow idpos selectedline curview
5317     global mainfont canvxmax
5318
5319     if {![info exists commitrow($curview,$id)]} return
5320     drawcmitrow $commitrow($curview,$id)
5321     $canv delete tag.$id
5322     set xt [eval drawtags $id $idpos($id)]
5323     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5324     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5325     set xr [expr {$xt + [font measure $mainfont $text]}]
5326     if {$xr > $canvxmax} {
5327         set canvxmax $xr
5328         setcanvscroll
5329     }
5330     if {[info exists selectedline]
5331         && $selectedline == $commitrow($curview,$id)} {
5332         selectline $selectedline 0
5333     }
5334 }
5335
5336 proc mktagcan {} {
5337     global mktagtop
5338
5339     catch {destroy $mktagtop}
5340     unset mktagtop
5341 }
5342
5343 proc mktaggo {} {
5344     domktag
5345     mktagcan
5346 }
5347
5348 proc writecommit {} {
5349     global rowmenuid wrcomtop commitinfo wrcomcmd
5350
5351     set top .writecommit
5352     set wrcomtop $top
5353     catch {destroy $top}
5354     toplevel $top
5355     label $top.title -text "Write commit to file"
5356     grid $top.title - -pady 10
5357     label $top.id -text "ID:"
5358     entry $top.sha1 -width 40 -relief flat
5359     $top.sha1 insert 0 $rowmenuid
5360     $top.sha1 conf -state readonly
5361     grid $top.id $top.sha1 -sticky w
5362     entry $top.head -width 60 -relief flat
5363     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5364     $top.head conf -state readonly
5365     grid x $top.head -sticky w
5366     label $top.clab -text "Command:"
5367     entry $top.cmd -width 60 -textvariable wrcomcmd
5368     grid $top.clab $top.cmd -sticky w -pady 10
5369     label $top.flab -text "Output file:"
5370     entry $top.fname -width 60
5371     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5372     grid $top.flab $top.fname -sticky w
5373     frame $top.buts
5374     button $top.buts.gen -text "Write" -command wrcomgo
5375     button $top.buts.can -text "Cancel" -command wrcomcan
5376     grid $top.buts.gen $top.buts.can
5377     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5378     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5379     grid $top.buts - -pady 10 -sticky ew
5380     focus $top.fname
5381 }
5382
5383 proc wrcomgo {} {
5384     global wrcomtop
5385
5386     set id [$wrcomtop.sha1 get]
5387     set cmd "echo $id | [$wrcomtop.cmd get]"
5388     set fname [$wrcomtop.fname get]
5389     if {[catch {exec sh -c $cmd >$fname &} err]} {
5390         error_popup "Error writing commit: $err"
5391     }
5392     catch {destroy $wrcomtop}
5393     unset wrcomtop
5394 }
5395
5396 proc wrcomcan {} {
5397     global wrcomtop
5398
5399     catch {destroy $wrcomtop}
5400     unset wrcomtop
5401 }
5402
5403 proc mkbranch {} {
5404     global rowmenuid mkbrtop
5405
5406     set top .makebranch
5407     catch {destroy $top}
5408     toplevel $top
5409     label $top.title -text "Create new branch"
5410     grid $top.title - -pady 10
5411     label $top.id -text "ID:"
5412     entry $top.sha1 -width 40 -relief flat
5413     $top.sha1 insert 0 $rowmenuid
5414     $top.sha1 conf -state readonly
5415     grid $top.id $top.sha1 -sticky w
5416     label $top.nlab -text "Name:"
5417     entry $top.name -width 40
5418     grid $top.nlab $top.name -sticky w
5419     frame $top.buts
5420     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5421     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5422     grid $top.buts.go $top.buts.can
5423     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5424     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5425     grid $top.buts - -pady 10 -sticky ew
5426     focus $top.name
5427 }
5428
5429 proc mkbrgo {top} {
5430     global headids idheads
5431
5432     set name [$top.name get]
5433     set id [$top.sha1 get]
5434     if {$name eq {}} {
5435         error_popup "Please specify a name for the new branch"
5436         return
5437     }
5438     catch {destroy $top}
5439     nowbusy newbranch
5440     update
5441     if {[catch {
5442         exec git branch $name $id
5443     } err]} {
5444         notbusy newbranch
5445         error_popup $err
5446     } else {
5447         set headids($name) $id
5448         lappend idheads($id) $name
5449         addedhead $id $name
5450         notbusy newbranch
5451         redrawtags $id
5452         dispneartags 0
5453     }
5454 }
5455
5456 proc cherrypick {} {
5457     global rowmenuid curview commitrow
5458     global mainhead
5459
5460     set oldhead [exec git rev-parse HEAD]
5461     set dheads [descheads $rowmenuid]
5462     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5463         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5464                         included in branch $mainhead -- really re-apply it?"]
5465         if {!$ok} return
5466     }
5467     nowbusy cherrypick
5468     update
5469     # Unfortunately git-cherry-pick writes stuff to stderr even when
5470     # no error occurs, and exec takes that as an indication of error...
5471     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5472         notbusy cherrypick
5473         error_popup $err
5474         return
5475     }
5476     set newhead [exec git rev-parse HEAD]
5477     if {$newhead eq $oldhead} {
5478         notbusy cherrypick
5479         error_popup "No changes committed"
5480         return
5481     }
5482     addnewchild $newhead $oldhead
5483     if {[info exists commitrow($curview,$oldhead)]} {
5484         insertrow $commitrow($curview,$oldhead) $newhead
5485         if {$mainhead ne {}} {
5486             movehead $newhead $mainhead
5487             movedhead $newhead $mainhead
5488         }
5489         redrawtags $oldhead
5490         redrawtags $newhead
5491     }
5492     notbusy cherrypick
5493 }
5494
5495 # context menu for a head
5496 proc headmenu {x y id head} {
5497     global headmenuid headmenuhead headctxmenu
5498
5499     set headmenuid $id
5500     set headmenuhead $head
5501     tk_popup $headctxmenu $x $y
5502 }
5503
5504 proc cobranch {} {
5505     global headmenuid headmenuhead mainhead headids
5506
5507     # check the tree is clean first??
5508     set oldmainhead $mainhead
5509     nowbusy checkout
5510     update
5511     if {[catch {
5512         exec git checkout -q $headmenuhead
5513     } err]} {
5514         notbusy checkout
5515         error_popup $err
5516     } else {
5517         notbusy checkout
5518         set mainhead $headmenuhead
5519         if {[info exists headids($oldmainhead)]} {
5520             redrawtags $headids($oldmainhead)
5521         }
5522         redrawtags $headmenuid
5523     }
5524 }
5525
5526 proc rmbranch {} {
5527     global headmenuid headmenuhead mainhead
5528     global headids idheads
5529
5530     set head $headmenuhead
5531     set id $headmenuid
5532     if {$head eq $mainhead} {
5533         error_popup "Cannot delete the currently checked-out branch"
5534         return
5535     }
5536     set dheads [descheads $id]
5537     if {$dheads eq $headids($head)} {
5538         # the stuff on this branch isn't on any other branch
5539         if {![confirm_popup "The commits on branch $head aren't on any other\
5540                         branch.\nReally delete branch $head?"]} return
5541     }
5542     nowbusy rmbranch
5543     update
5544     if {[catch {exec git branch -D $head} err]} {
5545         notbusy rmbranch
5546         error_popup $err
5547         return
5548     }
5549     removehead $id $head
5550     removedhead $id $head
5551     redrawtags $id
5552     notbusy rmbranch
5553     dispneartags 0
5554 }
5555
5556 # Stuff for finding nearby tags
5557 proc getallcommits {} {
5558     global allcommits allids nbmp nextarc seeds
5559
5560     set allids {}
5561     set nbmp 0
5562     set nextarc 0
5563     set allcommits 0
5564     set seeds {}
5565     regetallcommits
5566 }
5567
5568 # Called when the graph might have changed
5569 proc regetallcommits {} {
5570     global allcommits seeds
5571
5572     set cmd [concat | git rev-list --all --parents]
5573     foreach id $seeds {
5574         lappend cmd "^$id"
5575     }
5576     set fd [open $cmd r]
5577     fconfigure $fd -blocking 0
5578     incr allcommits
5579     nowbusy allcommits
5580     filerun $fd [list getallclines $fd]
5581 }
5582
5583 # Since most commits have 1 parent and 1 child, we group strings of
5584 # such commits into "arcs" joining branch/merge points (BMPs), which
5585 # are commits that either don't have 1 parent or don't have 1 child.
5586 #
5587 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5588 # arcout(id) - outgoing arcs for BMP
5589 # arcids(a) - list of IDs on arc including end but not start
5590 # arcstart(a) - BMP ID at start of arc
5591 # arcend(a) - BMP ID at end of arc
5592 # growing(a) - arc a is still growing
5593 # arctags(a) - IDs out of arcids (excluding end) that have tags
5594 # archeads(a) - IDs out of arcids (excluding end) that have heads
5595 # The start of an arc is at the descendent end, so "incoming" means
5596 # coming from descendents, and "outgoing" means going towards ancestors.
5597
5598 proc getallclines {fd} {
5599     global allids allparents allchildren idtags nextarc nbmp
5600     global arcnos arcids arctags arcout arcend arcstart archeads growing
5601     global seeds allcommits
5602
5603     set nid 0
5604     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
5605         set id [lindex $line 0]
5606         if {[info exists allparents($id)]} {
5607             # seen it already
5608             continue
5609         }
5610         lappend allids $id
5611         set olds [lrange $line 1 end]
5612         set allparents($id) $olds
5613         if {![info exists allchildren($id)]} {
5614             set allchildren($id) {}
5615             set arcnos($id) {}
5616             lappend seeds $id
5617         } else {
5618             set a $arcnos($id)
5619             if {[llength $olds] == 1 && [llength $a] == 1} {
5620                 lappend arcids($a) $id
5621                 if {[info exists idtags($id)]} {
5622                     lappend arctags($a) $id
5623                 }
5624                 if {[info exists idheads($id)]} {
5625                     lappend archeads($a) $id
5626                 }
5627                 if {[info exists allparents($olds)]} {
5628                     # seen parent already
5629                     if {![info exists arcout($olds)]} {
5630                         splitarc $olds
5631                     }
5632                     lappend arcids($a) $olds
5633                     set arcend($a) $olds
5634                     unset growing($a)
5635                 }
5636                 lappend allchildren($olds) $id
5637                 lappend arcnos($olds) $a
5638                 continue
5639             }
5640         }
5641         incr nbmp
5642         foreach a $arcnos($id) {
5643             lappend arcids($a) $id
5644             set arcend($a) $id
5645             unset growing($a)
5646         }
5647
5648         set ao {}
5649         foreach p $olds {
5650             lappend allchildren($p) $id
5651             set a [incr nextarc]
5652             set arcstart($a) $id
5653             set archeads($a) {}
5654             set arctags($a) {}
5655             set archeads($a) {}
5656             set arcids($a) {}
5657             lappend ao $a
5658             set growing($a) 1
5659             if {[info exists allparents($p)]} {
5660                 # seen it already, may need to make a new branch
5661                 if {![info exists arcout($p)]} {
5662                     splitarc $p
5663                 }
5664                 lappend arcids($a) $p
5665                 set arcend($a) $p
5666                 unset growing($a)
5667             }
5668             lappend arcnos($p) $a
5669         }
5670         set arcout($id) $ao
5671     }
5672     if {![eof $fd]} {
5673         return [expr {$nid >= 1000? 2: 1}]
5674     }
5675     close $fd
5676     if {[incr allcommits -1] == 0} {
5677         notbusy allcommits
5678     }
5679     dispneartags 0
5680     return 0
5681 }
5682
5683 proc recalcarc {a} {
5684     global arctags archeads arcids idtags idheads
5685
5686     set at {}
5687     set ah {}
5688     foreach id [lrange $arcids($a) 0 end-1] {
5689         if {[info exists idtags($id)]} {
5690             lappend at $id
5691         }
5692         if {[info exists idheads($id)]} {
5693             lappend ah $id
5694         }
5695     }
5696     set arctags($a) $at
5697     set archeads($a) $ah
5698 }
5699
5700 proc splitarc {p} {
5701     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
5702     global arcstart arcend arcout allparents growing
5703
5704     set a $arcnos($p)
5705     if {[llength $a] != 1} {
5706         puts "oops splitarc called but [llength $a] arcs already"
5707         return
5708     }
5709     set a [lindex $a 0]
5710     set i [lsearch -exact $arcids($a) $p]
5711     if {$i < 0} {
5712         puts "oops splitarc $p not in arc $a"
5713         return
5714     }
5715     set na [incr nextarc]
5716     if {[info exists arcend($a)]} {
5717         set arcend($na) $arcend($a)
5718     } else {
5719         set l [lindex $allparents([lindex $arcids($a) end]) 0]
5720         set j [lsearch -exact $arcnos($l) $a]
5721         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
5722     }
5723     set tail [lrange $arcids($a) [expr {$i+1}] end]
5724     set arcids($a) [lrange $arcids($a) 0 $i]
5725     set arcend($a) $p
5726     set arcstart($na) $p
5727     set arcout($p) $na
5728     set arcids($na) $tail
5729     if {[info exists growing($a)]} {
5730         set growing($na) 1
5731         unset growing($a)
5732     }
5733     incr nbmp
5734
5735     foreach id $tail {
5736         if {[llength $arcnos($id)] == 1} {
5737             set arcnos($id) $na
5738         } else {
5739             set j [lsearch -exact $arcnos($id) $a]
5740             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
5741         }
5742     }
5743
5744     # reconstruct tags and heads lists
5745     if {$arctags($a) ne {} || $archeads($a) ne {}} {
5746         recalcarc $a
5747         recalcarc $na
5748     } else {
5749         set arctags($na) {}
5750         set archeads($na) {}
5751     }
5752 }
5753
5754 # Update things for a new commit added that is a child of one
5755 # existing commit.  Used when cherry-picking.
5756 proc addnewchild {id p} {
5757     global allids allparents allchildren idtags nextarc nbmp
5758     global arcnos arcids arctags arcout arcend arcstart archeads growing
5759     global seeds
5760
5761     lappend allids $id
5762     set allparents($id) [list $p]
5763     set allchildren($id) {}
5764     set arcnos($id) {}
5765     lappend seeds $id
5766     incr nbmp
5767     lappend allchildren($p) $id
5768     set a [incr nextarc]
5769     set arcstart($a) $id
5770     set archeads($a) {}
5771     set arctags($a) {}
5772     set arcids($a) [list $p]
5773     set arcend($a) $p
5774     if {![info exists arcout($p)]} {
5775         splitarc $p
5776     }
5777     lappend arcnos($p) $a
5778     set arcout($id) [list $a]
5779 }
5780
5781 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
5782 # or 0 if neither is true.
5783 proc anc_or_desc {a b} {
5784     global arcout arcstart arcend arcnos cached_isanc
5785
5786     if {$arcnos($a) eq $arcnos($b)} {
5787         # Both are on the same arc(s); either both are the same BMP,
5788         # or if one is not a BMP, the other is also not a BMP or is
5789         # the BMP at end of the arc (and it only has 1 incoming arc).
5790         if {$a eq $b} {
5791             return 0
5792         }
5793         # assert {[llength $arcnos($a)] == 1}
5794         set arc [lindex $arcnos($a) 0]
5795         set i [lsearch -exact $arcids($arc) $a]
5796         set j [lsearch -exact $arcids($arc) $b]
5797         if {$i < 0 || $i > $j} {
5798             return 1
5799         } else {
5800             return -1
5801         }
5802     }
5803
5804     if {![info exists arcout($a)]} {
5805         set arc [lindex $arcnos($a) 0]
5806         if {[info exists arcend($arc)]} {
5807             set aend $arcend($arc)
5808         } else {
5809             set aend {}
5810         }
5811         set a $arcstart($arc)
5812     } else {
5813         set aend $a
5814     }
5815     if {![info exists arcout($b)]} {
5816         set arc [lindex $arcnos($b) 0]
5817         if {[info exists arcend($arc)]} {
5818             set bend $arcend($arc)
5819         } else {
5820             set bend {}
5821         }
5822         set b $arcstart($arc)
5823     } else {
5824         set bend $b
5825     }
5826     if {$a eq $bend} {
5827         return 1
5828     }
5829     if {$b eq $aend} {
5830         return -1
5831     }
5832     if {[info exists cached_isanc($a,$bend)]} {
5833         if {$cached_isanc($a,$bend)} {
5834             return 1
5835         }
5836     }
5837     if {[info exists cached_isanc($b,$aend)]} {
5838         if {$cached_isanc($b,$aend)} {
5839             return -1
5840         }
5841         if {[info exists cached_isanc($a,$bend)]} {
5842             return 0
5843         }
5844     }
5845
5846     set todo [list $a $b]
5847     set anc($a) a
5848     set anc($b) b
5849     for {set i 0} {$i < [llength $todo]} {incr i} {
5850         set x [lindex $todo $i]
5851         if {$anc($x) eq {}} {
5852             continue
5853         }
5854         foreach arc $arcnos($x) {
5855             set xd $arcstart($arc)
5856             if {$xd eq $bend} {
5857                 set cached_isanc($a,$bend) 1
5858                 set cached_isanc($b,$aend) 0
5859                 return 1
5860             } elseif {$xd eq $aend} {
5861                 set cached_isanc($b,$aend) 1
5862                 set cached_isanc($a,$bend) 0
5863                 return -1
5864             }
5865             if {![info exists anc($xd)]} {
5866                 set anc($xd) $anc($x)
5867                 lappend todo $xd
5868             } elseif {$anc($xd) ne $anc($x)} {
5869                 set anc($xd) {}
5870             }
5871         }
5872     }
5873     set cached_isanc($a,$bend) 0
5874     set cached_isanc($b,$aend) 0
5875     return 0
5876 }
5877
5878 # This identifies whether $desc has an ancestor that is
5879 # a growing tip of the graph and which is not an ancestor of $anc
5880 # and returns 0 if so and 1 if not.
5881 # If we subsequently discover a tag on such a growing tip, and that
5882 # turns out to be a descendent of $anc (which it could, since we
5883 # don't necessarily see children before parents), then $desc
5884 # isn't a good choice to display as a descendent tag of
5885 # $anc (since it is the descendent of another tag which is
5886 # a descendent of $anc).  Similarly, $anc isn't a good choice to
5887 # display as a ancestor tag of $desc.
5888 #
5889 proc is_certain {desc anc} {
5890     global arcnos arcout arcstart arcend growing problems
5891
5892     set certain {}
5893     if {[llength $arcnos($anc)] == 1} {
5894         # tags on the same arc are certain
5895         if {$arcnos($desc) eq $arcnos($anc)} {
5896             return 1
5897         }
5898         if {![info exists arcout($anc)]} {
5899             # if $anc is partway along an arc, use the start of the arc instead
5900             set a [lindex $arcnos($anc) 0]
5901             set anc $arcstart($a)
5902         }
5903     }
5904     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
5905         set x $desc
5906     } else {
5907         set a [lindex $arcnos($desc) 0]
5908         set x $arcend($a)
5909     }
5910     if {$x == $anc} {
5911         return 1
5912     }
5913     set anclist [list $x]
5914     set dl($x) 1
5915     set nnh 1
5916     set ngrowanc 0
5917     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
5918         set x [lindex $anclist $i]
5919         if {$dl($x)} {
5920             incr nnh -1
5921         }
5922         set done($x) 1
5923         foreach a $arcout($x) {
5924             if {[info exists growing($a)]} {
5925                 if {![info exists growanc($x)] && $dl($x)} {
5926                     set growanc($x) 1
5927                     incr ngrowanc
5928                 }
5929             } else {
5930                 set y $arcend($a)
5931                 if {[info exists dl($y)]} {
5932                     if {$dl($y)} {
5933                         if {!$dl($x)} {
5934                             set dl($y) 0
5935                             if {![info exists done($y)]} {
5936                                 incr nnh -1
5937                             }
5938                             if {[info exists growanc($x)]} {
5939                                 incr ngrowanc -1
5940                             }
5941                             set xl [list $y]
5942                             for {set k 0} {$k < [llength $xl]} {incr k} {
5943                                 set z [lindex $xl $k]
5944                                 foreach c $arcout($z) {
5945                                     if {[info exists arcend($c)]} {
5946                                         set v $arcend($c)
5947                                         if {[info exists dl($v)] && $dl($v)} {
5948                                             set dl($v) 0
5949                                             if {![info exists done($v)]} {
5950                                                 incr nnh -1
5951                                             }
5952                                             if {[info exists growanc($v)]} {
5953                                                 incr ngrowanc -1
5954                                             }
5955                                             lappend xl $v
5956                                         }
5957                                     }
5958                                 }
5959                             }
5960                         }
5961                     }
5962                 } elseif {$y eq $anc || !$dl($x)} {
5963                     set dl($y) 0
5964                     lappend anclist $y
5965                 } else {
5966                     set dl($y) 1
5967                     lappend anclist $y
5968                     incr nnh
5969                 }
5970             }
5971         }
5972     }
5973     foreach x [array names growanc] {
5974         if {$dl($x)} {
5975             return 0
5976         }
5977         return 0
5978     }
5979     return 1
5980 }
5981
5982 proc validate_arctags {a} {
5983     global arctags idtags
5984
5985     set i -1
5986     set na $arctags($a)
5987     foreach id $arctags($a) {
5988         incr i
5989         if {![info exists idtags($id)]} {
5990             set na [lreplace $na $i $i]
5991             incr i -1
5992         }
5993     }
5994     set arctags($a) $na
5995 }
5996
5997 proc validate_archeads {a} {
5998     global archeads idheads
5999
6000     set i -1
6001     set na $archeads($a)
6002     foreach id $archeads($a) {
6003         incr i
6004         if {![info exists idheads($id)]} {
6005             set na [lreplace $na $i $i]
6006             incr i -1
6007         }
6008     }
6009     set archeads($a) $na
6010 }
6011
6012 # Return the list of IDs that have tags that are descendents of id,
6013 # ignoring IDs that are descendents of IDs already reported.
6014 proc desctags {id} {
6015     global arcnos arcstart arcids arctags idtags allparents
6016     global growing cached_dtags
6017
6018     if {![info exists allparents($id)]} {
6019         return {}
6020     }
6021     set t1 [clock clicks -milliseconds]
6022     set argid $id
6023     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6024         # part-way along an arc; check that arc first
6025         set a [lindex $arcnos($id) 0]
6026         if {$arctags($a) ne {}} {
6027             validate_arctags $a
6028             set i [lsearch -exact $arcids($a) $id]
6029             set tid {}
6030             foreach t $arctags($a) {
6031                 set j [lsearch -exact $arcids($a) $t]
6032                 if {$j >= $i} break
6033                 set tid $t
6034             }
6035             if {$tid ne {}} {
6036                 return $tid
6037             }
6038         }
6039         set id $arcstart($a)
6040         if {[info exists idtags($id)]} {
6041             return $id
6042         }
6043     }
6044     if {[info exists cached_dtags($id)]} {
6045         return $cached_dtags($id)
6046     }
6047
6048     set origid $id
6049     set todo [list $id]
6050     set queued($id) 1
6051     set nc 1
6052     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6053         set id [lindex $todo $i]
6054         set done($id) 1
6055         set ta [info exists hastaggedancestor($id)]
6056         if {!$ta} {
6057             incr nc -1
6058         }
6059         # ignore tags on starting node
6060         if {!$ta && $i > 0} {
6061             if {[info exists idtags($id)]} {
6062                 set tagloc($id) $id
6063                 set ta 1
6064             } elseif {[info exists cached_dtags($id)]} {
6065                 set tagloc($id) $cached_dtags($id)
6066                 set ta 1
6067             }
6068         }
6069         foreach a $arcnos($id) {
6070             set d $arcstart($a)
6071             if {!$ta && $arctags($a) ne {}} {
6072                 validate_arctags $a
6073                 if {$arctags($a) ne {}} {
6074                     lappend tagloc($id) [lindex $arctags($a) end]
6075                 }
6076             }
6077             if {$ta || $arctags($a) ne {}} {
6078                 set tomark [list $d]
6079                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6080                     set dd [lindex $tomark $j]
6081                     if {![info exists hastaggedancestor($dd)]} {
6082                         if {[info exists done($dd)]} {
6083                             foreach b $arcnos($dd) {
6084                                 lappend tomark $arcstart($b)
6085                             }
6086                             if {[info exists tagloc($dd)]} {
6087                                 unset tagloc($dd)
6088                             }
6089                         } elseif {[info exists queued($dd)]} {
6090                             incr nc -1
6091                         }
6092                         set hastaggedancestor($dd) 1
6093                     }
6094                 }
6095             }
6096             if {![info exists queued($d)]} {
6097                 lappend todo $d
6098                 set queued($d) 1
6099                 if {![info exists hastaggedancestor($d)]} {
6100                     incr nc
6101                 }
6102             }
6103         }
6104     }
6105     set tags {}
6106     foreach id [array names tagloc] {
6107         if {![info exists hastaggedancestor($id)]} {
6108             foreach t $tagloc($id) {
6109                 if {[lsearch -exact $tags $t] < 0} {
6110                     lappend tags $t
6111                 }
6112             }
6113         }
6114     }
6115     set t2 [clock clicks -milliseconds]
6116     set loopix $i
6117
6118     # remove tags that are descendents of other tags
6119     for {set i 0} {$i < [llength $tags]} {incr i} {
6120         set a [lindex $tags $i]
6121         for {set j 0} {$j < $i} {incr j} {
6122             set b [lindex $tags $j]
6123             set r [anc_or_desc $a $b]
6124             if {$r == 1} {
6125                 set tags [lreplace $tags $j $j]
6126                 incr j -1
6127                 incr i -1
6128             } elseif {$r == -1} {
6129                 set tags [lreplace $tags $i $i]
6130                 incr i -1
6131                 break
6132             }
6133         }
6134     }
6135
6136     if {[array names growing] ne {}} {
6137         # graph isn't finished, need to check if any tag could get
6138         # eclipsed by another tag coming later.  Simply ignore any
6139         # tags that could later get eclipsed.
6140         set ctags {}
6141         foreach t $tags {
6142             if {[is_certain $t $origid]} {
6143                 lappend ctags $t
6144             }
6145         }
6146         if {$tags eq $ctags} {
6147             set cached_dtags($origid) $tags
6148         } else {
6149             set tags $ctags
6150         }
6151     } else {
6152         set cached_dtags($origid) $tags
6153     }
6154     set t3 [clock clicks -milliseconds]
6155     if {0 && $t3 - $t1 >= 100} {
6156         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6157             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6158     }
6159     return $tags
6160 }
6161
6162 proc anctags {id} {
6163     global arcnos arcids arcout arcend arctags idtags allparents
6164     global growing cached_atags
6165
6166     if {![info exists allparents($id)]} {
6167         return {}
6168     }
6169     set t1 [clock clicks -milliseconds]
6170     set argid $id
6171     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6172         # part-way along an arc; check that arc first
6173         set a [lindex $arcnos($id) 0]
6174         if {$arctags($a) ne {}} {
6175             validate_arctags $a
6176             set i [lsearch -exact $arcids($a) $id]
6177             foreach t $arctags($a) {
6178                 set j [lsearch -exact $arcids($a) $t]
6179                 if {$j > $i} {
6180                     return $t
6181                 }
6182             }
6183         }
6184         if {![info exists arcend($a)]} {
6185             return {}
6186         }
6187         set id $arcend($a)
6188         if {[info exists idtags($id)]} {
6189             return $id
6190         }
6191     }
6192     if {[info exists cached_atags($id)]} {
6193         return $cached_atags($id)
6194     }
6195
6196     set origid $id
6197     set todo [list $id]
6198     set queued($id) 1
6199     set taglist {}
6200     set nc 1
6201     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6202         set id [lindex $todo $i]
6203         set done($id) 1
6204         set td [info exists hastaggeddescendent($id)]
6205         if {!$td} {
6206             incr nc -1
6207         }
6208         # ignore tags on starting node
6209         if {!$td && $i > 0} {
6210             if {[info exists idtags($id)]} {
6211                 set tagloc($id) $id
6212                 set td 1
6213             } elseif {[info exists cached_atags($id)]} {
6214                 set tagloc($id) $cached_atags($id)
6215                 set td 1
6216             }
6217         }
6218         foreach a $arcout($id) {
6219             if {!$td && $arctags($a) ne {}} {
6220                 validate_arctags $a
6221                 if {$arctags($a) ne {}} {
6222                     lappend tagloc($id) [lindex $arctags($a) 0]
6223                 }
6224             }
6225             if {![info exists arcend($a)]} continue
6226             set d $arcend($a)
6227             if {$td || $arctags($a) ne {}} {
6228                 set tomark [list $d]
6229                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6230                     set dd [lindex $tomark $j]
6231                     if {![info exists hastaggeddescendent($dd)]} {
6232                         if {[info exists done($dd)]} {
6233                             foreach b $arcout($dd) {
6234                                 if {[info exists arcend($b)]} {
6235                                     lappend tomark $arcend($b)
6236                                 }
6237                             }
6238                             if {[info exists tagloc($dd)]} {
6239                                 unset tagloc($dd)
6240                             }
6241                         } elseif {[info exists queued($dd)]} {
6242                             incr nc -1
6243                         }
6244                         set hastaggeddescendent($dd) 1
6245                     }
6246                 }
6247             }
6248             if {![info exists queued($d)]} {
6249                 lappend todo $d
6250                 set queued($d) 1
6251                 if {![info exists hastaggeddescendent($d)]} {
6252                     incr nc
6253                 }
6254             }
6255         }
6256     }
6257     set t2 [clock clicks -milliseconds]
6258     set loopix $i
6259     set tags {}
6260     foreach id [array names tagloc] {
6261         if {![info exists hastaggeddescendent($id)]} {
6262             foreach t $tagloc($id) {
6263                 if {[lsearch -exact $tags $t] < 0} {
6264                     lappend tags $t
6265                 }
6266             }
6267         }
6268     }
6269
6270     # remove tags that are ancestors of other tags
6271     for {set i 0} {$i < [llength $tags]} {incr i} {
6272         set a [lindex $tags $i]
6273         for {set j 0} {$j < $i} {incr j} {
6274             set b [lindex $tags $j]
6275             set r [anc_or_desc $a $b]
6276             if {$r == -1} {
6277                 set tags [lreplace $tags $j $j]
6278                 incr j -1
6279                 incr i -1
6280             } elseif {$r == 1} {
6281                 set tags [lreplace $tags $i $i]
6282                 incr i -1
6283                 break
6284             }
6285         }
6286     }
6287
6288     if {[array names growing] ne {}} {
6289         # graph isn't finished, need to check if any tag could get
6290         # eclipsed by another tag coming later.  Simply ignore any
6291         # tags that could later get eclipsed.
6292         set ctags {}
6293         foreach t $tags {
6294             if {[is_certain $origid $t]} {
6295                 lappend ctags $t
6296             }
6297         }
6298         if {$tags eq $ctags} {
6299             set cached_atags($origid) $tags
6300         } else {
6301             set tags $ctags
6302         }
6303     } else {
6304         set cached_atags($origid) $tags
6305     }
6306     set t3 [clock clicks -milliseconds]
6307     if {0 && $t3 - $t1 >= 100} {
6308         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6309             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6310     }
6311     return $tags
6312 }
6313
6314 # Return the list of IDs that have heads that are descendents of id,
6315 # including id itself if it has a head.
6316 proc descheads {id} {
6317     global arcnos arcstart arcids archeads idheads cached_dheads
6318     global allparents
6319
6320     if {![info exists allparents($id)]} {
6321         return {}
6322     }
6323     set ret {}
6324     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6325         # part-way along an arc; check it first
6326         set a [lindex $arcnos($id) 0]
6327         if {$archeads($a) ne {}} {
6328             validate_archeads $a
6329             set i [lsearch -exact $arcids($a) $id]
6330             foreach t $archeads($a) {
6331                 set j [lsearch -exact $arcids($a) $t]
6332                 if {$j > $i} break
6333                 lappend $ret $t
6334             }
6335         }
6336         set id $arcstart($a)
6337     }
6338     set origid $id
6339     set todo [list $id]
6340     set seen($id) 1
6341     for {set i 0} {$i < [llength $todo]} {incr i} {
6342         set id [lindex $todo $i]
6343         if {[info exists cached_dheads($id)]} {
6344             set ret [concat $ret $cached_dheads($id)]
6345         } else {
6346             if {[info exists idheads($id)]} {
6347                 lappend ret $id
6348             }
6349             foreach a $arcnos($id) {
6350                 if {$archeads($a) ne {}} {
6351                     set ret [concat $ret $archeads($a)]
6352                 }
6353                 set d $arcstart($a)
6354                 if {![info exists seen($d)]} {
6355                     lappend todo $d
6356                     set seen($d) 1
6357                 }
6358             }
6359         }
6360     }
6361     set ret [lsort -unique $ret]
6362     set cached_dheads($origid) $ret
6363 }
6364
6365 proc addedtag {id} {
6366     global arcnos arcout cached_dtags cached_atags
6367
6368     if {![info exists arcnos($id)]} return
6369     if {![info exists arcout($id)]} {
6370         recalcarc [lindex $arcnos($id) 0]
6371     }
6372     catch {unset cached_dtags}
6373     catch {unset cached_atags}
6374 }
6375
6376 proc addedhead {hid head} {
6377     global arcnos arcout cached_dheads
6378
6379     if {![info exists arcnos($hid)]} return
6380     if {![info exists arcout($hid)]} {
6381         recalcarc [lindex $arcnos($hid) 0]
6382     }
6383     catch {unset cached_dheads}
6384 }
6385
6386 proc removedhead {hid head} {
6387     global cached_dheads
6388
6389     catch {unset cached_dheads}
6390 }
6391
6392 proc movedhead {hid head} {
6393     global arcnos arcout cached_dheads
6394
6395     if {![info exists arcnos($hid)]} return
6396     if {![info exists arcout($hid)]} {
6397         recalcarc [lindex $arcnos($hid) 0]
6398     }
6399     catch {unset cached_dheads}
6400 }
6401
6402 proc changedrefs {} {
6403     global cached_dheads cached_dtags cached_atags
6404     global arctags archeads arcnos arcout idheads idtags
6405
6406     foreach id [concat [array names idheads] [array names idtags]] {
6407         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6408             set a [lindex $arcnos($id) 0]
6409             if {![info exists donearc($a)]} {
6410                 recalcarc $a
6411                 set donearc($a) 1
6412             }
6413         }
6414     }
6415     catch {unset cached_dtags}
6416     catch {unset cached_atags}
6417     catch {unset cached_dheads}
6418 }
6419
6420 proc rereadrefs {} {
6421     global idtags idheads idotherrefs mainhead
6422
6423     set refids [concat [array names idtags] \
6424                     [array names idheads] [array names idotherrefs]]
6425     foreach id $refids {
6426         if {![info exists ref($id)]} {
6427             set ref($id) [listrefs $id]
6428         }
6429     }
6430     set oldmainhead $mainhead
6431     readrefs
6432     changedrefs
6433     set refids [lsort -unique [concat $refids [array names idtags] \
6434                         [array names idheads] [array names idotherrefs]]]
6435     foreach id $refids {
6436         set v [listrefs $id]
6437         if {![info exists ref($id)] || $ref($id) != $v ||
6438             ($id eq $oldmainhead && $id ne $mainhead) ||
6439             ($id eq $mainhead && $id ne $oldmainhead)} {
6440             redrawtags $id
6441         }
6442     }
6443 }
6444
6445 proc listrefs {id} {
6446     global idtags idheads idotherrefs
6447
6448     set x {}
6449     if {[info exists idtags($id)]} {
6450         set x $idtags($id)
6451     }
6452     set y {}
6453     if {[info exists idheads($id)]} {
6454         set y $idheads($id)
6455     }
6456     set z {}
6457     if {[info exists idotherrefs($id)]} {
6458         set z $idotherrefs($id)
6459     }
6460     return [list $x $y $z]
6461 }
6462
6463 proc showtag {tag isnew} {
6464     global ctext tagcontents tagids linknum
6465
6466     if {$isnew} {
6467         addtohistory [list showtag $tag 0]
6468     }
6469     $ctext conf -state normal
6470     clear_ctext
6471     set linknum 0
6472     if {[info exists tagcontents($tag)]} {
6473         set text $tagcontents($tag)
6474     } else {
6475         set text "Tag: $tag\nId:  $tagids($tag)"
6476     }
6477     appendwithlinks $text {}
6478     $ctext conf -state disabled
6479     init_flist {}
6480 }
6481
6482 proc doquit {} {
6483     global stopped
6484     set stopped 100
6485     savestuff .
6486     destroy .
6487 }
6488
6489 proc doprefs {} {
6490     global maxwidth maxgraphpct diffopts
6491     global oldprefs prefstop showneartags
6492     global bgcolor fgcolor ctext diffcolors selectbgcolor
6493     global uifont tabstop
6494
6495     set top .gitkprefs
6496     set prefstop $top
6497     if {[winfo exists $top]} {
6498         raise $top
6499         return
6500     }
6501     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6502         set oldprefs($v) [set $v]
6503     }
6504     toplevel $top
6505     wm title $top "Gitk preferences"
6506     label $top.ldisp -text "Commit list display options"
6507     $top.ldisp configure -font $uifont
6508     grid $top.ldisp - -sticky w -pady 10
6509     label $top.spacer -text " "
6510     label $top.maxwidthl -text "Maximum graph width (lines)" \
6511         -font optionfont
6512     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6513     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6514     label $top.maxpctl -text "Maximum graph width (% of pane)" \
6515         -font optionfont
6516     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6517     grid x $top.maxpctl $top.maxpct -sticky w
6518
6519     label $top.ddisp -text "Diff display options"
6520     $top.ddisp configure -font $uifont
6521     grid $top.ddisp - -sticky w -pady 10
6522     label $top.diffoptl -text "Options for diff program" \
6523         -font optionfont
6524     entry $top.diffopt -width 20 -textvariable diffopts
6525     grid x $top.diffoptl $top.diffopt -sticky w
6526     frame $top.ntag
6527     label $top.ntag.l -text "Display nearby tags" -font optionfont
6528     checkbutton $top.ntag.b -variable showneartags
6529     pack $top.ntag.b $top.ntag.l -side left
6530     grid x $top.ntag -sticky w
6531     label $top.tabstopl -text "tabstop" -font optionfont
6532     entry $top.tabstop -width 10 -textvariable tabstop
6533     grid x $top.tabstopl $top.tabstop -sticky w
6534
6535     label $top.cdisp -text "Colors: press to choose"
6536     $top.cdisp configure -font $uifont
6537     grid $top.cdisp - -sticky w -pady 10
6538     label $top.bg -padx 40 -relief sunk -background $bgcolor
6539     button $top.bgbut -text "Background" -font optionfont \
6540         -command [list choosecolor bgcolor 0 $top.bg background setbg]
6541     grid x $top.bgbut $top.bg -sticky w
6542     label $top.fg -padx 40 -relief sunk -background $fgcolor
6543     button $top.fgbut -text "Foreground" -font optionfont \
6544         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6545     grid x $top.fgbut $top.fg -sticky w
6546     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6547     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6548         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6549                       [list $ctext tag conf d0 -foreground]]
6550     grid x $top.diffoldbut $top.diffold -sticky w
6551     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6552     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6553         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6554                       [list $ctext tag conf d1 -foreground]]
6555     grid x $top.diffnewbut $top.diffnew -sticky w
6556     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6557     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6558         -command [list choosecolor diffcolors 2 $top.hunksep \
6559                       "diff hunk header" \
6560                       [list $ctext tag conf hunksep -foreground]]
6561     grid x $top.hunksepbut $top.hunksep -sticky w
6562     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6563     button $top.selbgbut -text "Select bg" -font optionfont \
6564         -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6565     grid x $top.selbgbut $top.selbgsep -sticky w
6566
6567     frame $top.buts
6568     button $top.buts.ok -text "OK" -command prefsok -default active
6569     $top.buts.ok configure -font $uifont
6570     button $top.buts.can -text "Cancel" -command prefscan -default normal
6571     $top.buts.can configure -font $uifont
6572     grid $top.buts.ok $top.buts.can
6573     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6574     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6575     grid $top.buts - - -pady 10 -sticky ew
6576     bind $top <Visibility> "focus $top.buts.ok"
6577 }
6578
6579 proc choosecolor {v vi w x cmd} {
6580     global $v
6581
6582     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6583                -title "Gitk: choose color for $x"]
6584     if {$c eq {}} return
6585     $w conf -background $c
6586     lset $v $vi $c
6587     eval $cmd $c
6588 }
6589
6590 proc setselbg {c} {
6591     global bglist cflist
6592     foreach w $bglist {
6593         $w configure -selectbackground $c
6594     }
6595     $cflist tag configure highlight \
6596         -background [$cflist cget -selectbackground]
6597     allcanvs itemconf secsel -fill $c
6598 }
6599
6600 proc setbg {c} {
6601     global bglist
6602
6603     foreach w $bglist {
6604         $w conf -background $c
6605     }
6606 }
6607
6608 proc setfg {c} {
6609     global fglist canv
6610
6611     foreach w $fglist {
6612         $w conf -foreground $c
6613     }
6614     allcanvs itemconf text -fill $c
6615     $canv itemconf circle -outline $c
6616 }
6617
6618 proc prefscan {} {
6619     global maxwidth maxgraphpct diffopts
6620     global oldprefs prefstop showneartags
6621
6622     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6623         set $v $oldprefs($v)
6624     }
6625     catch {destroy $prefstop}
6626     unset prefstop
6627 }
6628
6629 proc prefsok {} {
6630     global maxwidth maxgraphpct
6631     global oldprefs prefstop showneartags
6632     global charspc ctext tabstop
6633
6634     catch {destroy $prefstop}
6635     unset prefstop
6636     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
6637     if {$maxwidth != $oldprefs(maxwidth)
6638         || $maxgraphpct != $oldprefs(maxgraphpct)} {
6639         redisplay
6640     } elseif {$showneartags != $oldprefs(showneartags)} {
6641         reselectline
6642     }
6643 }
6644
6645 proc formatdate {d} {
6646     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6647 }
6648
6649 # This list of encoding names and aliases is distilled from
6650 # http://www.iana.org/assignments/character-sets.
6651 # Not all of them are supported by Tcl.
6652 set encoding_aliases {
6653     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6654       ISO646-US US-ASCII us IBM367 cp367 csASCII }
6655     { ISO-10646-UTF-1 csISO10646UTF1 }
6656     { ISO_646.basic:1983 ref csISO646basic1983 }
6657     { INVARIANT csINVARIANT }
6658     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6659     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6660     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6661     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6662     { NATS-DANO iso-ir-9-1 csNATSDANO }
6663     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6664     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6665     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6666     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6667     { ISO-2022-KR csISO2022KR }
6668     { EUC-KR csEUCKR }
6669     { ISO-2022-JP csISO2022JP }
6670     { ISO-2022-JP-2 csISO2022JP2 }
6671     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6672       csISO13JISC6220jp }
6673     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6674     { IT iso-ir-15 ISO646-IT csISO15Italian }
6675     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6676     { ES iso-ir-17 ISO646-ES csISO17Spanish }
6677     { greek7-old iso-ir-18 csISO18Greek7Old }
6678     { latin-greek iso-ir-19 csISO19LatinGreek }
6679     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6680     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6681     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6682     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6683     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6684     { BS_viewdata iso-ir-47 csISO47BSViewdata }
6685     { INIS iso-ir-49 csISO49INIS }
6686     { INIS-8 iso-ir-50 csISO50INIS8 }
6687     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6688     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6689     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6690     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6691     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6692     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6693       csISO60Norwegian1 }
6694     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6695     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6696     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6697     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6698     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6699     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6700     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6701     { greek7 iso-ir-88 csISO88Greek7 }
6702     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6703     { iso-ir-90 csISO90 }
6704     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6705     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6706       csISO92JISC62991984b }
6707     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6708     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6709     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6710       csISO95JIS62291984handadd }
6711     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6712     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6713     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6714     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6715       CP819 csISOLatin1 }
6716     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6717     { T.61-7bit iso-ir-102 csISO102T617bit }
6718     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6719     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6720     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6721     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6722     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6723     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6724     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6725     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6726       arabic csISOLatinArabic }
6727     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6728     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6729     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6730       greek greek8 csISOLatinGreek }
6731     { T.101-G2 iso-ir-128 csISO128T101G2 }
6732     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6733       csISOLatinHebrew }
6734     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6735     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6736     { CSN_369103 iso-ir-139 csISO139CSN369103 }
6737     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6738     { ISO_6937-2-add iso-ir-142 csISOTextComm }
6739     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6740     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6741       csISOLatinCyrillic }
6742     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6743     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6744     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6745     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6746     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6747     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6748     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6749     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6750     { ISO_10367-box iso-ir-155 csISO10367Box }
6751     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6752     { latin-lap lap iso-ir-158 csISO158Lap }
6753     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6754     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6755     { us-dk csUSDK }
6756     { dk-us csDKUS }
6757     { JIS_X0201 X0201 csHalfWidthKatakana }
6758     { KSC5636 ISO646-KR csKSC5636 }
6759     { ISO-10646-UCS-2 csUnicode }
6760     { ISO-10646-UCS-4 csUCS4 }
6761     { DEC-MCS dec csDECMCS }
6762     { hp-roman8 roman8 r8 csHPRoman8 }
6763     { macintosh mac csMacintosh }
6764     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6765       csIBM037 }
6766     { IBM038 EBCDIC-INT cp038 csIBM038 }
6767     { IBM273 CP273 csIBM273 }
6768     { IBM274 EBCDIC-BE CP274 csIBM274 }
6769     { IBM275 EBCDIC-BR cp275 csIBM275 }
6770     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6771     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6772     { IBM280 CP280 ebcdic-cp-it csIBM280 }
6773     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6774     { IBM284 CP284 ebcdic-cp-es csIBM284 }
6775     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6776     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6777     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6778     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6779     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6780     { IBM424 cp424 ebcdic-cp-he csIBM424 }
6781     { IBM437 cp437 437 csPC8CodePage437 }
6782     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6783     { IBM775 cp775 csPC775Baltic }
6784     { IBM850 cp850 850 csPC850Multilingual }
6785     { IBM851 cp851 851 csIBM851 }
6786     { IBM852 cp852 852 csPCp852 }
6787     { IBM855 cp855 855 csIBM855 }
6788     { IBM857 cp857 857 csIBM857 }
6789     { IBM860 cp860 860 csIBM860 }
6790     { IBM861 cp861 861 cp-is csIBM861 }
6791     { IBM862 cp862 862 csPC862LatinHebrew }
6792     { IBM863 cp863 863 csIBM863 }
6793     { IBM864 cp864 csIBM864 }
6794     { IBM865 cp865 865 csIBM865 }
6795     { IBM866 cp866 866 csIBM866 }
6796     { IBM868 CP868 cp-ar csIBM868 }
6797     { IBM869 cp869 869 cp-gr csIBM869 }
6798     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6799     { IBM871 CP871 ebcdic-cp-is csIBM871 }
6800     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6801     { IBM891 cp891 csIBM891 }
6802     { IBM903 cp903 csIBM903 }
6803     { IBM904 cp904 904 csIBBM904 }
6804     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6805     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6806     { IBM1026 CP1026 csIBM1026 }
6807     { EBCDIC-AT-DE csIBMEBCDICATDE }
6808     { EBCDIC-AT-DE-A csEBCDICATDEA }
6809     { EBCDIC-CA-FR csEBCDICCAFR }
6810     { EBCDIC-DK-NO csEBCDICDKNO }
6811     { EBCDIC-DK-NO-A csEBCDICDKNOA }
6812     { EBCDIC-FI-SE csEBCDICFISE }
6813     { EBCDIC-FI-SE-A csEBCDICFISEA }
6814     { EBCDIC-FR csEBCDICFR }
6815     { EBCDIC-IT csEBCDICIT }
6816     { EBCDIC-PT csEBCDICPT }
6817     { EBCDIC-ES csEBCDICES }
6818     { EBCDIC-ES-A csEBCDICESA }
6819     { EBCDIC-ES-S csEBCDICESS }
6820     { EBCDIC-UK csEBCDICUK }
6821     { EBCDIC-US csEBCDICUS }
6822     { UNKNOWN-8BIT csUnknown8BiT }
6823     { MNEMONIC csMnemonic }
6824     { MNEM csMnem }
6825     { VISCII csVISCII }
6826     { VIQR csVIQR }
6827     { KOI8-R csKOI8R }
6828     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6829     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6830     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6831     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6832     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6833     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6834     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6835     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6836     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6837     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6838     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6839     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6840     { IBM1047 IBM-1047 }
6841     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6842     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6843     { UNICODE-1-1 csUnicode11 }
6844     { CESU-8 csCESU-8 }
6845     { BOCU-1 csBOCU-1 }
6846     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6847     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6848       l8 }
6849     { ISO-8859-15 ISO_8859-15 Latin-9 }
6850     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6851     { GBK CP936 MS936 windows-936 }
6852     { JIS_Encoding csJISEncoding }
6853     { Shift_JIS MS_Kanji csShiftJIS }
6854     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6855       EUC-JP }
6856     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6857     { ISO-10646-UCS-Basic csUnicodeASCII }
6858     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6859     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6860     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6861     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6862     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6863     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6864     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6865     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6866     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6867     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6868     { Adobe-Standard-Encoding csAdobeStandardEncoding }
6869     { Ventura-US csVenturaUS }
6870     { Ventura-International csVenturaInternational }
6871     { PC8-Danish-Norwegian csPC8DanishNorwegian }
6872     { PC8-Turkish csPC8Turkish }
6873     { IBM-Symbols csIBMSymbols }
6874     { IBM-Thai csIBMThai }
6875     { HP-Legal csHPLegal }
6876     { HP-Pi-font csHPPiFont }
6877     { HP-Math8 csHPMath8 }
6878     { Adobe-Symbol-Encoding csHPPSMath }
6879     { HP-DeskTop csHPDesktop }
6880     { Ventura-Math csVenturaMath }
6881     { Microsoft-Publishing csMicrosoftPublishing }
6882     { Windows-31J csWindows31J }
6883     { GB2312 csGB2312 }
6884     { Big5 csBig5 }
6885 }
6886
6887 proc tcl_encoding {enc} {
6888     global encoding_aliases
6889     set names [encoding names]
6890     set lcnames [string tolower $names]
6891     set enc [string tolower $enc]
6892     set i [lsearch -exact $lcnames $enc]
6893     if {$i < 0} {
6894         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6895         if {[regsub {^iso[-_]} $enc iso encx]} {
6896             set i [lsearch -exact $lcnames $encx]
6897         }
6898     }
6899     if {$i < 0} {
6900         foreach l $encoding_aliases {
6901             set ll [string tolower $l]
6902             if {[lsearch -exact $ll $enc] < 0} continue
6903             # look through the aliases for one that tcl knows about
6904             foreach e $ll {
6905                 set i [lsearch -exact $lcnames $e]
6906                 if {$i < 0} {
6907                     if {[regsub {^iso[-_]} $e iso ex]} {
6908                         set i [lsearch -exact $lcnames $ex]
6909                     }
6910                 }
6911                 if {$i >= 0} break
6912             }
6913             break
6914         }
6915     }
6916     if {$i >= 0} {
6917         return [lindex $names $i]
6918     }
6919     return {}
6920 }
6921
6922 # defaults...
6923 set datemode 0
6924 set diffopts "-U 5 -p"
6925 set wrcomcmd "git diff-tree --stdin -p --pretty"
6926
6927 set gitencoding {}
6928 catch {
6929     set gitencoding [exec git config --get i18n.commitencoding]
6930 }
6931 if {$gitencoding == ""} {
6932     set gitencoding "utf-8"
6933 }
6934 set tclencoding [tcl_encoding $gitencoding]
6935 if {$tclencoding == {}} {
6936     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6937 }
6938
6939 set mainfont {Helvetica 9}
6940 set textfont {Courier 9}
6941 set uifont {Helvetica 9 bold}
6942 set tabstop 8
6943 set findmergefiles 0
6944 set maxgraphpct 50
6945 set maxwidth 16
6946 set revlistorder 0
6947 set fastdate 0
6948 set uparrowlen 7
6949 set downarrowlen 7
6950 set mingaplen 30
6951 set cmitmode "patch"
6952 set wrapcomment "none"
6953 set showneartags 1
6954 set maxrefs 20
6955
6956 set colors {green red blue magenta darkgrey brown orange}
6957 set bgcolor white
6958 set fgcolor black
6959 set diffcolors {red "#00a000" blue}
6960 set selectbgcolor gray85
6961
6962 catch {source ~/.gitk}
6963
6964 font create optionfont -family sans-serif -size -12
6965
6966 set revtreeargs {}
6967 foreach arg $argv {
6968     switch -regexp -- $arg {
6969         "^$" { }
6970         "^-d" { set datemode 1 }
6971         default {
6972             lappend revtreeargs $arg
6973         }
6974     }
6975 }
6976
6977 # check that we can find a .git directory somewhere...
6978 set gitdir [gitdir]
6979 if {![file isdirectory $gitdir]} {
6980     show_error {} . "Cannot find the git directory \"$gitdir\"."
6981     exit 1
6982 }
6983
6984 set cmdline_files {}
6985 set i [lsearch -exact $revtreeargs "--"]
6986 if {$i >= 0} {
6987     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6988     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6989 } elseif {$revtreeargs ne {}} {
6990     if {[catch {
6991         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6992         set cmdline_files [split $f "\n"]
6993         set n [llength $cmdline_files]
6994         set revtreeargs [lrange $revtreeargs 0 end-$n]
6995     } err]} {
6996         # unfortunately we get both stdout and stderr in $err,
6997         # so look for "fatal:".
6998         set i [string first "fatal:" $err]
6999         if {$i > 0} {
7000             set err [string range $err [expr {$i + 6}] end]
7001         }
7002         show_error {} . "Bad arguments to gitk:\n$err"
7003         exit 1
7004     }
7005 }
7006
7007 set runq {}
7008 set history {}
7009 set historyindex 0
7010 set fh_serial 0
7011 set nhl_names {}
7012 set highlight_paths {}
7013 set searchdirn -forwards
7014 set boldrows {}
7015 set boldnamerows {}
7016 set diffelide {0 0}
7017
7018 set optim_delay 16
7019
7020 set nextviewnum 1
7021 set curview 0
7022 set selectedview 0
7023 set selectedhlview None
7024 set viewfiles(0) {}
7025 set viewperm(0) 0
7026 set viewargs(0) {}
7027
7028 set cmdlineok 0
7029 set stopped 0
7030 set stuffsaved 0
7031 set patchnum 0
7032 setcoords
7033 makewindow
7034 wm title . "[file tail $argv0]: [file tail [pwd]]"
7035 readrefs
7036
7037 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7038     # create a view for the files/dirs specified on the command line
7039     set curview 1
7040     set selectedview 1
7041     set nextviewnum 2
7042     set viewname(1) "Command line"
7043     set viewfiles(1) $cmdline_files
7044     set viewargs(1) $revtreeargs
7045     set viewperm(1) 0
7046     addviewmenu 1
7047     .bar.view entryconf Edit* -state normal
7048     .bar.view entryconf Delete* -state normal
7049 }
7050
7051 if {[info exists permviews]} {
7052     foreach v $permviews {
7053         set n $nextviewnum
7054         incr nextviewnum
7055         set viewname($n) [lindex $v 0]
7056         set viewfiles($n) [lindex $v 1]
7057         set viewargs($n) [lindex $v 2]
7058         set viewperm($n) 1
7059         addviewmenu $n
7060     }
7061 }
7062 getcommits