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