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 linesegends
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 $linesegends]
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         set linesegends [lindex $v 9]
1836     }
1837
1838     catch {unset colormap}
1839     catch {unset rowtextx}
1840     set nextcolor 0
1841     set canvxmax [$canv cget -width]
1842     set curview $n
1843     set row 0
1844     setcanvscroll
1845     set yf 0
1846     set row {}
1847     set selectfirst 0
1848     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1849         set row $commitrow($n,$selid)
1850         # try to get the selected row in the same position on the screen
1851         set ymax [lindex [$canv cget -scrollregion] 3]
1852         set ytop [expr {[yc $row] - $yscreen}]
1853         if {$ytop < 0} {
1854             set ytop 0
1855         }
1856         set yf [expr {$ytop * 1.0 / $ymax}]
1857     }
1858     allcanvs yview moveto $yf
1859     drawvisible
1860     if {$row ne {}} {
1861         selectline $row 0
1862     } elseif {$selid ne {}} {
1863         set pending_select $selid
1864     } else {
1865         if {$numcommits > 0} {
1866             selectline 0 0
1867         } else {
1868             set selectfirst 1
1869         }
1870     }
1871     if {$phase ne {}} {
1872         if {$phase eq "getcommits"} {
1873             show_status "Reading commits..."
1874         }
1875         run chewcommits $n
1876     } elseif {$numcommits == 0} {
1877         show_status "No commits selected"
1878     }
1879 }
1880
1881 # Stuff relating to the highlighting facility
1882
1883 proc ishighlighted {row} {
1884     global vhighlights fhighlights nhighlights rhighlights
1885
1886     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1887         return $nhighlights($row)
1888     }
1889     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1890         return $vhighlights($row)
1891     }
1892     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1893         return $fhighlights($row)
1894     }
1895     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1896         return $rhighlights($row)
1897     }
1898     return 0
1899 }
1900
1901 proc bolden {row font} {
1902     global canv linehtag selectedline boldrows
1903
1904     lappend boldrows $row
1905     $canv itemconf $linehtag($row) -font $font
1906     if {[info exists selectedline] && $row == $selectedline} {
1907         $canv delete secsel
1908         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1909                    -outline {{}} -tags secsel \
1910                    -fill [$canv cget -selectbackground]]
1911         $canv lower $t
1912     }
1913 }
1914
1915 proc bolden_name {row font} {
1916     global canv2 linentag selectedline boldnamerows
1917
1918     lappend boldnamerows $row
1919     $canv2 itemconf $linentag($row) -font $font
1920     if {[info exists selectedline] && $row == $selectedline} {
1921         $canv2 delete secsel
1922         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1923                    -outline {{}} -tags secsel \
1924                    -fill [$canv2 cget -selectbackground]]
1925         $canv2 lower $t
1926     }
1927 }
1928
1929 proc unbolden {} {
1930     global mainfont boldrows
1931
1932     set stillbold {}
1933     foreach row $boldrows {
1934         if {![ishighlighted $row]} {
1935             bolden $row $mainfont
1936         } else {
1937             lappend stillbold $row
1938         }
1939     }
1940     set boldrows $stillbold
1941 }
1942
1943 proc addvhighlight {n} {
1944     global hlview curview viewdata vhl_done vhighlights commitidx
1945
1946     if {[info exists hlview]} {
1947         delvhighlight
1948     }
1949     set hlview $n
1950     if {$n != $curview && ![info exists viewdata($n)]} {
1951         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1952         set vparentlist($n) {}
1953         set vchildlist($n) {}
1954         set vdisporder($n) {}
1955         set vcmitlisted($n) {}
1956         start_rev_list $n
1957     }
1958     set vhl_done $commitidx($hlview)
1959     if {$vhl_done > 0} {
1960         drawvisible
1961     }
1962 }
1963
1964 proc delvhighlight {} {
1965     global hlview vhighlights
1966
1967     if {![info exists hlview]} return
1968     unset hlview
1969     catch {unset vhighlights}
1970     unbolden
1971 }
1972
1973 proc vhighlightmore {} {
1974     global hlview vhl_done commitidx vhighlights
1975     global displayorder vdisporder curview mainfont
1976
1977     set font [concat $mainfont bold]
1978     set max $commitidx($hlview)
1979     if {$hlview == $curview} {
1980         set disp $displayorder
1981     } else {
1982         set disp $vdisporder($hlview)
1983     }
1984     set vr [visiblerows]
1985     set r0 [lindex $vr 0]
1986     set r1 [lindex $vr 1]
1987     for {set i $vhl_done} {$i < $max} {incr i} {
1988         set id [lindex $disp $i]
1989         if {[info exists commitrow($curview,$id)]} {
1990             set row $commitrow($curview,$id)
1991             if {$r0 <= $row && $row <= $r1} {
1992                 if {![highlighted $row]} {
1993                     bolden $row $font
1994                 }
1995                 set vhighlights($row) 1
1996             }
1997         }
1998     }
1999     set vhl_done $max
2000 }
2001
2002 proc askvhighlight {row id} {
2003     global hlview vhighlights commitrow iddrawn mainfont
2004
2005     if {[info exists commitrow($hlview,$id)]} {
2006         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2007             bolden $row [concat $mainfont bold]
2008         }
2009         set vhighlights($row) 1
2010     } else {
2011         set vhighlights($row) 0
2012     }
2013 }
2014
2015 proc hfiles_change {name ix op} {
2016     global highlight_files filehighlight fhighlights fh_serial
2017     global mainfont highlight_paths
2018
2019     if {[info exists filehighlight]} {
2020         # delete previous highlights
2021         catch {close $filehighlight}
2022         unset filehighlight
2023         catch {unset fhighlights}
2024         unbolden
2025         unhighlight_filelist
2026     }
2027     set highlight_paths {}
2028     after cancel do_file_hl $fh_serial
2029     incr fh_serial
2030     if {$highlight_files ne {}} {
2031         after 300 do_file_hl $fh_serial
2032     }
2033 }
2034
2035 proc makepatterns {l} {
2036     set ret {}
2037     foreach e $l {
2038         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2039         if {[string index $ee end] eq "/"} {
2040             lappend ret "$ee*"
2041         } else {
2042             lappend ret $ee
2043             lappend ret "$ee/*"
2044         }
2045     }
2046     return $ret
2047 }
2048
2049 proc do_file_hl {serial} {
2050     global highlight_files filehighlight highlight_paths gdttype fhl_list
2051
2052     if {$gdttype eq "touching paths:"} {
2053         if {[catch {set paths [shellsplit $highlight_files]}]} return
2054         set highlight_paths [makepatterns $paths]
2055         highlight_filelist
2056         set gdtargs [concat -- $paths]
2057     } else {
2058         set gdtargs [list "-S$highlight_files"]
2059     }
2060     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2061     set filehighlight [open $cmd r+]
2062     fconfigure $filehighlight -blocking 0
2063     filerun $filehighlight readfhighlight
2064     set fhl_list {}
2065     drawvisible
2066     flushhighlights
2067 }
2068
2069 proc flushhighlights {} {
2070     global filehighlight fhl_list
2071
2072     if {[info exists filehighlight]} {
2073         lappend fhl_list {}
2074         puts $filehighlight ""
2075         flush $filehighlight
2076     }
2077 }
2078
2079 proc askfilehighlight {row id} {
2080     global filehighlight fhighlights fhl_list
2081
2082     lappend fhl_list $id
2083     set fhighlights($row) -1
2084     puts $filehighlight $id
2085 }
2086
2087 proc readfhighlight {} {
2088     global filehighlight fhighlights commitrow curview mainfont iddrawn
2089     global fhl_list
2090
2091     if {![info exists filehighlight]} {
2092         return 0
2093     }
2094     set nr 0
2095     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2096         set line [string trim $line]
2097         set i [lsearch -exact $fhl_list $line]
2098         if {$i < 0} continue
2099         for {set j 0} {$j < $i} {incr j} {
2100             set id [lindex $fhl_list $j]
2101             if {[info exists commitrow($curview,$id)]} {
2102                 set fhighlights($commitrow($curview,$id)) 0
2103             }
2104         }
2105         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2106         if {$line eq {}} continue
2107         if {![info exists commitrow($curview,$line)]} continue
2108         set row $commitrow($curview,$line)
2109         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2110             bolden $row [concat $mainfont bold]
2111         }
2112         set fhighlights($row) 1
2113     }
2114     if {[eof $filehighlight]} {
2115         # strange...
2116         puts "oops, git diff-tree died"
2117         catch {close $filehighlight}
2118         unset filehighlight
2119         return 0
2120     }
2121     next_hlcont
2122     return 1
2123 }
2124
2125 proc find_change {name ix op} {
2126     global nhighlights mainfont boldnamerows
2127     global findstring findpattern findtype
2128
2129     # delete previous highlights, if any
2130     foreach row $boldnamerows {
2131         bolden_name $row $mainfont
2132     }
2133     set boldnamerows {}
2134     catch {unset nhighlights}
2135     unbolden
2136     if {$findtype ne "Regexp"} {
2137         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2138                    $findstring]
2139         set findpattern "*$e*"
2140     }
2141     drawvisible
2142 }
2143
2144 proc askfindhighlight {row id} {
2145     global nhighlights commitinfo iddrawn mainfont
2146     global findstring findtype findloc findpattern
2147
2148     if {![info exists commitinfo($id)]} {
2149         getcommit $id
2150     }
2151     set info $commitinfo($id)
2152     set isbold 0
2153     set fldtypes {Headline Author Date Committer CDate Comments}
2154     foreach f $info ty $fldtypes {
2155         if {$findloc ne "All fields" && $findloc ne $ty} {
2156             continue
2157         }
2158         if {$findtype eq "Regexp"} {
2159             set doesmatch [regexp $findstring $f]
2160         } elseif {$findtype eq "IgnCase"} {
2161             set doesmatch [string match -nocase $findpattern $f]
2162         } else {
2163             set doesmatch [string match $findpattern $f]
2164         }
2165         if {$doesmatch} {
2166             if {$ty eq "Author"} {
2167                 set isbold 2
2168             } else {
2169                 set isbold 1
2170             }
2171         }
2172     }
2173     if {[info exists iddrawn($id)]} {
2174         if {$isbold && ![ishighlighted $row]} {
2175             bolden $row [concat $mainfont bold]
2176         }
2177         if {$isbold >= 2} {
2178             bolden_name $row [concat $mainfont bold]
2179         }
2180     }
2181     set nhighlights($row) $isbold
2182 }
2183
2184 proc vrel_change {name ix op} {
2185     global highlight_related
2186
2187     rhighlight_none
2188     if {$highlight_related ne "None"} {
2189         run drawvisible
2190     }
2191 }
2192
2193 # prepare for testing whether commits are descendents or ancestors of a
2194 proc rhighlight_sel {a} {
2195     global descendent desc_todo ancestor anc_todo
2196     global highlight_related rhighlights
2197
2198     catch {unset descendent}
2199     set desc_todo [list $a]
2200     catch {unset ancestor}
2201     set anc_todo [list $a]
2202     if {$highlight_related ne "None"} {
2203         rhighlight_none
2204         run drawvisible
2205     }
2206 }
2207
2208 proc rhighlight_none {} {
2209     global rhighlights
2210
2211     catch {unset rhighlights}
2212     unbolden
2213 }
2214
2215 proc is_descendent {a} {
2216     global curview children commitrow descendent desc_todo
2217
2218     set v $curview
2219     set la $commitrow($v,$a)
2220     set todo $desc_todo
2221     set leftover {}
2222     set done 0
2223     for {set i 0} {$i < [llength $todo]} {incr i} {
2224         set do [lindex $todo $i]
2225         if {$commitrow($v,$do) < $la} {
2226             lappend leftover $do
2227             continue
2228         }
2229         foreach nk $children($v,$do) {
2230             if {![info exists descendent($nk)]} {
2231                 set descendent($nk) 1
2232                 lappend todo $nk
2233                 if {$nk eq $a} {
2234                     set done 1
2235                 }
2236             }
2237         }
2238         if {$done} {
2239             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2240             return
2241         }
2242     }
2243     set descendent($a) 0
2244     set desc_todo $leftover
2245 }
2246
2247 proc is_ancestor {a} {
2248     global curview parentlist commitrow ancestor anc_todo
2249
2250     set v $curview
2251     set la $commitrow($v,$a)
2252     set todo $anc_todo
2253     set leftover {}
2254     set done 0
2255     for {set i 0} {$i < [llength $todo]} {incr i} {
2256         set do [lindex $todo $i]
2257         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2258             lappend leftover $do
2259             continue
2260         }
2261         foreach np [lindex $parentlist $commitrow($v,$do)] {
2262             if {![info exists ancestor($np)]} {
2263                 set ancestor($np) 1
2264                 lappend todo $np
2265                 if {$np eq $a} {
2266                     set done 1
2267                 }
2268             }
2269         }
2270         if {$done} {
2271             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2272             return
2273         }
2274     }
2275     set ancestor($a) 0
2276     set anc_todo $leftover
2277 }
2278
2279 proc askrelhighlight {row id} {
2280     global descendent highlight_related iddrawn mainfont rhighlights
2281     global selectedline ancestor
2282
2283     if {![info exists selectedline]} return
2284     set isbold 0
2285     if {$highlight_related eq "Descendent" ||
2286         $highlight_related eq "Not descendent"} {
2287         if {![info exists descendent($id)]} {
2288             is_descendent $id
2289         }
2290         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2291             set isbold 1
2292         }
2293     } elseif {$highlight_related eq "Ancestor" ||
2294               $highlight_related eq "Not ancestor"} {
2295         if {![info exists ancestor($id)]} {
2296             is_ancestor $id
2297         }
2298         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2299             set isbold 1
2300         }
2301     }
2302     if {[info exists iddrawn($id)]} {
2303         if {$isbold && ![ishighlighted $row]} {
2304             bolden $row [concat $mainfont bold]
2305         }
2306     }
2307     set rhighlights($row) $isbold
2308 }
2309
2310 proc next_hlcont {} {
2311     global fhl_row fhl_dirn displayorder numcommits
2312     global vhighlights fhighlights nhighlights rhighlights
2313     global hlview filehighlight findstring highlight_related
2314
2315     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2316     set row $fhl_row
2317     while {1} {
2318         if {$row < 0 || $row >= $numcommits} {
2319             bell
2320             set fhl_dirn 0
2321             return
2322         }
2323         set id [lindex $displayorder $row]
2324         if {[info exists hlview]} {
2325             if {![info exists vhighlights($row)]} {
2326                 askvhighlight $row $id
2327             }
2328             if {$vhighlights($row) > 0} break
2329         }
2330         if {$findstring ne {}} {
2331             if {![info exists nhighlights($row)]} {
2332                 askfindhighlight $row $id
2333             }
2334             if {$nhighlights($row) > 0} break
2335         }
2336         if {$highlight_related ne "None"} {
2337             if {![info exists rhighlights($row)]} {
2338                 askrelhighlight $row $id
2339             }
2340             if {$rhighlights($row) > 0} break
2341         }
2342         if {[info exists filehighlight]} {
2343             if {![info exists fhighlights($row)]} {
2344                 # ask for a few more while we're at it...
2345                 set r $row
2346                 for {set n 0} {$n < 100} {incr n} {
2347                     if {![info exists fhighlights($r)]} {
2348                         askfilehighlight $r [lindex $displayorder $r]
2349                     }
2350                     incr r $fhl_dirn
2351                     if {$r < 0 || $r >= $numcommits} break
2352                 }
2353                 flushhighlights
2354             }
2355             if {$fhighlights($row) < 0} {
2356                 set fhl_row $row
2357                 return
2358             }
2359             if {$fhighlights($row) > 0} break
2360         }
2361         incr row $fhl_dirn
2362     }
2363     set fhl_dirn 0
2364     selectline $row 1
2365 }
2366
2367 proc next_highlight {dirn} {
2368     global selectedline fhl_row fhl_dirn
2369     global hlview filehighlight findstring highlight_related
2370
2371     if {![info exists selectedline]} return
2372     if {!([info exists hlview] || $findstring ne {} ||
2373           $highlight_related ne "None" || [info exists filehighlight])} return
2374     set fhl_row [expr {$selectedline + $dirn}]
2375     set fhl_dirn $dirn
2376     next_hlcont
2377 }
2378
2379 proc cancel_next_highlight {} {
2380     global fhl_dirn
2381
2382     set fhl_dirn 0
2383 }
2384
2385 # Graph layout functions
2386
2387 proc shortids {ids} {
2388     set res {}
2389     foreach id $ids {
2390         if {[llength $id] > 1} {
2391             lappend res [shortids $id]
2392         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2393             lappend res [string range $id 0 7]
2394         } else {
2395             lappend res $id
2396         }
2397     }
2398     return $res
2399 }
2400
2401 proc incrange {l x o} {
2402     set n [llength $l]
2403     while {$x < $n} {
2404         set e [lindex $l $x]
2405         if {$e ne {}} {
2406             lset l $x [expr {$e + $o}]
2407         }
2408         incr x
2409     }
2410     return $l
2411 }
2412
2413 proc ntimes {n o} {
2414     set ret {}
2415     for {} {$n > 0} {incr n -1} {
2416         lappend ret $o
2417     }
2418     return $ret
2419 }
2420
2421 proc usedinrange {id l1 l2} {
2422     global children commitrow childlist curview
2423
2424     if {[info exists commitrow($curview,$id)]} {
2425         set r $commitrow($curview,$id)
2426         if {$l1 <= $r && $r <= $l2} {
2427             return [expr {$r - $l1 + 1}]
2428         }
2429         set kids [lindex $childlist $r]
2430     } else {
2431         set kids $children($curview,$id)
2432     }
2433     foreach c $kids {
2434         set r $commitrow($curview,$c)
2435         if {$l1 <= $r && $r <= $l2} {
2436             return [expr {$r - $l1 + 1}]
2437         }
2438     }
2439     return 0
2440 }
2441
2442 proc sanity {row {full 0}} {
2443     global rowidlist rowoffsets
2444
2445     set col -1
2446     set ids [lindex $rowidlist $row]
2447     foreach id $ids {
2448         incr col
2449         if {$id eq {}} continue
2450         if {$col < [llength $ids] - 1 &&
2451             [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2452             puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2453         }
2454         set o [lindex $rowoffsets $row $col]
2455         set y $row
2456         set x $col
2457         while {$o ne {}} {
2458             incr y -1
2459             incr x $o
2460             if {[lindex $rowidlist $y $x] != $id} {
2461                 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2462                 puts "  id=[shortids $id] check started at row $row"
2463                 for {set i $row} {$i >= $y} {incr i -1} {
2464                     puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2465                 }
2466                 break
2467             }
2468             if {!$full} break
2469             set o [lindex $rowoffsets $y $x]
2470         }
2471     }
2472 }
2473
2474 proc makeuparrow {oid x y z} {
2475     global rowidlist rowoffsets uparrowlen idrowranges displayorder
2476
2477     for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2478         incr y -1
2479         incr x $z
2480         set off0 [lindex $rowoffsets $y]
2481         for {set x0 $x} {1} {incr x0} {
2482             if {$x0 >= [llength $off0]} {
2483                 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2484                 break
2485             }
2486             set z [lindex $off0 $x0]
2487             if {$z ne {}} {
2488                 incr x0 $z
2489                 break
2490             }
2491         }
2492         set z [expr {$x0 - $x}]
2493         lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2494         lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2495     }
2496     set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2497     lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2498     lappend idrowranges($oid) [lindex $displayorder $y]
2499 }
2500
2501 proc initlayout {} {
2502     global rowidlist rowoffsets displayorder commitlisted
2503     global rowlaidout rowoptim
2504     global idinlist rowchk rowrangelist idrowranges
2505     global numcommits canvxmax canv
2506     global nextcolor
2507     global parentlist childlist children
2508     global colormap rowtextx
2509     global linesegends selectfirst
2510
2511     set numcommits 0
2512     set displayorder {}
2513     set commitlisted {}
2514     set parentlist {}
2515     set childlist {}
2516     set rowrangelist {}
2517     set nextcolor 0
2518     set rowidlist {{}}
2519     set rowoffsets {{}}
2520     catch {unset idinlist}
2521     catch {unset rowchk}
2522     set rowlaidout 0
2523     set rowoptim 0
2524     set canvxmax [$canv cget -width]
2525     catch {unset colormap}
2526     catch {unset rowtextx}
2527     catch {unset idrowranges}
2528     set linesegends {}
2529     set selectfirst 1
2530 }
2531
2532 proc setcanvscroll {} {
2533     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2534
2535     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2536     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2537     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2538     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2539 }
2540
2541 proc visiblerows {} {
2542     global canv numcommits linespc
2543
2544     set ymax [lindex [$canv cget -scrollregion] 3]
2545     if {$ymax eq {} || $ymax == 0} return
2546     set f [$canv yview]
2547     set y0 [expr {int([lindex $f 0] * $ymax)}]
2548     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2549     if {$r0 < 0} {
2550         set r0 0
2551     }
2552     set y1 [expr {int([lindex $f 1] * $ymax)}]
2553     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2554     if {$r1 >= $numcommits} {
2555         set r1 [expr {$numcommits - 1}]
2556     }
2557     return [list $r0 $r1]
2558 }
2559
2560 proc layoutmore {tmax allread} {
2561     global rowlaidout rowoptim commitidx numcommits optim_delay
2562     global uparrowlen curview rowidlist idinlist
2563
2564     set showdelay $optim_delay
2565     set optdelay [expr {$uparrowlen + 1}]
2566     while {1} {
2567         if {$rowoptim - $showdelay > $numcommits} {
2568             showstuff [expr {$rowoptim - $showdelay}]
2569         } elseif {$rowlaidout - $optdelay > $rowoptim} {
2570             set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2571             if {$nr > 100} {
2572                 set nr 100
2573             }
2574             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2575             incr rowoptim $nr
2576         } elseif {$commitidx($curview) > $rowlaidout} {
2577             set nr [expr {$commitidx($curview) - $rowlaidout}]
2578             # may need to increase this threshold if uparrowlen or
2579             # mingaplen are increased...
2580             if {$nr > 150} {
2581                 set nr 150
2582             }
2583             set row $rowlaidout
2584             set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2585             if {$rowlaidout == $row} {
2586                 return 0
2587             }
2588         } elseif {$allread} {
2589             set optdelay 0
2590             set nrows $commitidx($curview)
2591             if {[lindex $rowidlist $nrows] ne {} ||
2592                 [array names idinlist] ne {}} {
2593                 layouttail
2594                 set rowlaidout $commitidx($curview)
2595             } elseif {$rowoptim == $nrows} {
2596                 set showdelay 0
2597                 if {$numcommits == $nrows} {
2598                     return 0
2599                 }
2600             }
2601         } else {
2602             return 0
2603         }
2604         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2605             return 1
2606         }
2607     }
2608 }
2609
2610 proc showstuff {canshow} {
2611     global numcommits commitrow pending_select selectedline
2612     global linesegends idrangedrawn curview
2613     global displayorder selectfirst
2614
2615     if {$numcommits == 0} {
2616         global phase
2617         set phase "incrdraw"
2618         allcanvs delete all
2619     }
2620     set row $numcommits
2621     set numcommits $canshow
2622     setcanvscroll
2623     set rows [visiblerows]
2624     set r0 [lindex $rows 0]
2625     set r1 [lindex $rows 1]
2626     set selrow -1
2627     for {set r $row} {$r < $canshow} {incr r} {
2628         foreach id [lindex $linesegends [expr {$r+1}]] {
2629             set i -1
2630             set ranges [rowranges $id]
2631             foreach {s e} $ranges {
2632                 incr i
2633                 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2634                     && ![info exists idrangedrawn($id,$i)]} {
2635                     drawlineseg $id $i $ranges
2636                     set idrangedrawn($id,$i) 1
2637                 }
2638             }
2639         }
2640     }
2641     if {$canshow > $r1} {
2642         set canshow $r1
2643     }
2644     while {$row < $canshow} {
2645         drawcmitrow $row
2646         incr row
2647     }
2648     if {[info exists pending_select] &&
2649         [info exists commitrow($curview,$pending_select)] &&
2650         $commitrow($curview,$pending_select) < $numcommits} {
2651         selectline $commitrow($curview,$pending_select) 1
2652     }
2653     if {$selectfirst} {
2654         if {[info exists selectedline] || [info exists pending_select]} {
2655             set selectfirst 0
2656         } else {
2657             selectline 0 1
2658             set selectfirst 0
2659         }
2660     }
2661 }
2662
2663 proc layoutrows {row endrow last} {
2664     global rowidlist rowoffsets displayorder
2665     global uparrowlen downarrowlen maxwidth mingaplen
2666     global childlist parentlist
2667     global idrowranges linesegends
2668     global commitidx curview
2669     global idinlist rowchk rowrangelist
2670
2671     set idlist [lindex $rowidlist $row]
2672     set offs [lindex $rowoffsets $row]
2673     while {$row < $endrow} {
2674         set id [lindex $displayorder $row]
2675         set oldolds {}
2676         set newolds {}
2677         foreach p [lindex $parentlist $row] {
2678             if {![info exists idinlist($p)]} {
2679                 lappend newolds $p
2680             } elseif {!$idinlist($p)} {
2681                 lappend oldolds $p
2682             }
2683         }
2684         set lse {}
2685         set nev [expr {[llength $idlist] + [llength $newolds]
2686                        + [llength $oldolds] - $maxwidth + 1}]
2687         if {$nev > 0} {
2688             if {!$last &&
2689                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2690             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2691                 set i [lindex $idlist $x]
2692                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2693                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2694                                [expr {$row + $uparrowlen + $mingaplen}]]
2695                     if {$r == 0} {
2696                         set idlist [lreplace $idlist $x $x]
2697                         set offs [lreplace $offs $x $x]
2698                         set offs [incrange $offs $x 1]
2699                         set idinlist($i) 0
2700                         set rm1 [expr {$row - 1}]
2701                         lappend lse $i
2702                         lappend idrowranges($i) [lindex $displayorder $rm1]
2703                         if {[incr nev -1] <= 0} break
2704                         continue
2705                     }
2706                     set rowchk($id) [expr {$row + $r}]
2707                 }
2708             }
2709             lset rowidlist $row $idlist
2710             lset rowoffsets $row $offs
2711         }
2712         lappend linesegends $lse
2713         set col [lsearch -exact $idlist $id]
2714         if {$col < 0} {
2715             set col [llength $idlist]
2716             lappend idlist $id
2717             lset rowidlist $row $idlist
2718             set z {}
2719             if {[lindex $childlist $row] ne {}} {
2720                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2721                 unset idinlist($id)
2722             }
2723             lappend offs $z
2724             lset rowoffsets $row $offs
2725             if {$z ne {}} {
2726                 makeuparrow $id $col $row $z
2727             }
2728         } else {
2729             unset idinlist($id)
2730         }
2731         set ranges {}
2732         if {[info exists idrowranges($id)]} {
2733             set ranges $idrowranges($id)
2734             lappend ranges $id
2735             unset idrowranges($id)
2736         }
2737         lappend rowrangelist $ranges
2738         incr row
2739         set offs [ntimes [llength $idlist] 0]
2740         set l [llength $newolds]
2741         set idlist [eval lreplace \$idlist $col $col $newolds]
2742         set o 0
2743         if {$l != 1} {
2744             set offs [lrange $offs 0 [expr {$col - 1}]]
2745             foreach x $newolds {
2746                 lappend offs {}
2747                 incr o -1
2748             }
2749             incr o
2750             set tmp [expr {[llength $idlist] - [llength $offs]}]
2751             if {$tmp > 0} {
2752                 set offs [concat $offs [ntimes $tmp $o]]
2753             }
2754         } else {
2755             lset offs $col {}
2756         }
2757         foreach i $newolds {
2758             set idinlist($i) 1
2759             set idrowranges($i) $id
2760         }
2761         incr col $l
2762         foreach oid $oldolds {
2763             set idinlist($oid) 1
2764             set idlist [linsert $idlist $col $oid]
2765             set offs [linsert $offs $col $o]
2766             makeuparrow $oid $col $row $o
2767             incr col
2768         }
2769         lappend rowidlist $idlist
2770         lappend rowoffsets $offs
2771     }
2772     return $row
2773 }
2774
2775 proc addextraid {id row} {
2776     global displayorder commitrow commitinfo
2777     global commitidx commitlisted
2778     global parentlist childlist children curview
2779
2780     incr commitidx($curview)
2781     lappend displayorder $id
2782     lappend commitlisted 0
2783     lappend parentlist {}
2784     set commitrow($curview,$id) $row
2785     readcommit $id
2786     if {![info exists commitinfo($id)]} {
2787         set commitinfo($id) {"No commit information available"}
2788     }
2789     if {![info exists children($curview,$id)]} {
2790         set children($curview,$id) {}
2791     }
2792     lappend childlist $children($curview,$id)
2793 }
2794
2795 proc layouttail {} {
2796     global rowidlist rowoffsets idinlist commitidx curview
2797     global idrowranges rowrangelist
2798
2799     set row $commitidx($curview)
2800     set idlist [lindex $rowidlist $row]
2801     while {$idlist ne {}} {
2802         set col [expr {[llength $idlist] - 1}]
2803         set id [lindex $idlist $col]
2804         addextraid $id $row
2805         unset idinlist($id)
2806         lappend idrowranges($id) $row
2807         lappend rowrangelist $idrowranges($id)
2808         unset idrowranges($id)
2809         incr row
2810         set offs [ntimes $col 0]
2811         set idlist [lreplace $idlist $col $col]
2812         lappend rowidlist $idlist
2813         lappend rowoffsets $offs
2814     }
2815
2816     foreach id [array names idinlist] {
2817         unset idinlist($id)
2818         addextraid $id $row
2819         lset rowidlist $row [list $id]
2820         lset rowoffsets $row 0
2821         makeuparrow $id 0 $row 0
2822         lappend idrowranges($id) $row
2823         lappend rowrangelist $idrowranges($id)
2824         unset idrowranges($id)
2825         incr row
2826         lappend rowidlist {}
2827         lappend rowoffsets {}
2828     }
2829 }
2830
2831 proc insert_pad {row col npad} {
2832     global rowidlist rowoffsets
2833
2834     set pad [ntimes $npad {}]
2835     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2836     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2837     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2838 }
2839
2840 proc optimize_rows {row col endrow} {
2841     global rowidlist rowoffsets idrowranges displayorder
2842
2843     for {} {$row < $endrow} {incr row} {
2844         set idlist [lindex $rowidlist $row]
2845         set offs [lindex $rowoffsets $row]
2846         set haspad 0
2847         for {} {$col < [llength $offs]} {incr col} {
2848             if {[lindex $idlist $col] eq {}} {
2849                 set haspad 1
2850                 continue
2851             }
2852             set z [lindex $offs $col]
2853             if {$z eq {}} continue
2854             set isarrow 0
2855             set x0 [expr {$col + $z}]
2856             set y0 [expr {$row - 1}]
2857             set z0 [lindex $rowoffsets $y0 $x0]
2858             if {$z0 eq {}} {
2859                 set id [lindex $idlist $col]
2860                 set ranges [rowranges $id]
2861                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2862                     set isarrow 1
2863                 }
2864             }
2865             # Looking at lines from this row to the previous row,
2866             # make them go straight up if they end in an arrow on
2867             # the previous row; otherwise make them go straight up
2868             # or at 45 degrees.
2869             if {$z < -1 || ($z < 0 && $isarrow)} {
2870                 # Line currently goes left too much;
2871                 # insert pads in the previous row, then optimize it
2872                 set npad [expr {-1 - $z + $isarrow}]
2873                 set offs [incrange $offs $col $npad]
2874                 insert_pad $y0 $x0 $npad
2875                 if {$y0 > 0} {
2876                     optimize_rows $y0 $x0 $row
2877                 }
2878                 set z [lindex $offs $col]
2879                 set x0 [expr {$col + $z}]
2880                 set z0 [lindex $rowoffsets $y0 $x0]
2881             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2882                 # Line currently goes right too much;
2883                 # insert pads in this line and adjust the next's rowoffsets
2884                 set npad [expr {$z - 1 + $isarrow}]
2885                 set y1 [expr {$row + 1}]
2886                 set offs2 [lindex $rowoffsets $y1]
2887                 set x1 -1
2888                 foreach z $offs2 {
2889                     incr x1
2890                     if {$z eq {} || $x1 + $z < $col} continue
2891                     if {$x1 + $z > $col} {
2892                         incr npad
2893                     }
2894                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2895                     break
2896                 }
2897                 set pad [ntimes $npad {}]
2898                 set idlist [eval linsert \$idlist $col $pad]
2899                 set tmp [eval linsert \$offs $col $pad]
2900                 incr col $npad
2901                 set offs [incrange $tmp $col [expr {-$npad}]]
2902                 set z [lindex $offs $col]
2903                 set haspad 1
2904             }
2905             if {$z0 eq {} && !$isarrow} {
2906                 # this line links to its first child on row $row-2
2907                 set rm2 [expr {$row - 2}]
2908                 set id [lindex $displayorder $rm2]
2909                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2910                 if {$xc >= 0} {
2911                     set z0 [expr {$xc - $x0}]
2912                 }
2913             }
2914             # avoid lines jigging left then immediately right
2915             if {$z0 ne {} && $z < 0 && $z0 > 0} {
2916                 insert_pad $y0 $x0 1
2917                 set offs [incrange $offs $col 1]
2918                 optimize_rows $y0 [expr {$x0 + 1}] $row
2919             }
2920         }
2921         if {!$haspad} {
2922             set o {}
2923             # Find the first column that doesn't have a line going right
2924             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2925                 set o [lindex $offs $col]
2926                 if {$o eq {}} {
2927                     # check if this is the link to the first child
2928                     set id [lindex $idlist $col]
2929                     set ranges [rowranges $id]
2930                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
2931                         # it is, work out offset to child
2932                         set y0 [expr {$row - 1}]
2933                         set id [lindex $displayorder $y0]
2934                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2935                         if {$x0 >= 0} {
2936                             set o [expr {$x0 - $col}]
2937                         }
2938                     }
2939                 }
2940                 if {$o eq {} || $o <= 0} break
2941             }
2942             # Insert a pad at that column as long as it has a line and
2943             # isn't the last column, and adjust the next row' offsets
2944             if {$o ne {} && [incr col] < [llength $idlist]} {
2945                 set y1 [expr {$row + 1}]
2946                 set offs2 [lindex $rowoffsets $y1]
2947                 set x1 -1
2948                 foreach z $offs2 {
2949                     incr x1
2950                     if {$z eq {} || $x1 + $z < $col} continue
2951                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
2952                     break
2953                 }
2954                 set idlist [linsert $idlist $col {}]
2955                 set tmp [linsert $offs $col {}]
2956                 incr col
2957                 set offs [incrange $tmp $col -1]
2958             }
2959         }
2960         lset rowidlist $row $idlist
2961         lset rowoffsets $row $offs
2962         set col 0
2963     }
2964 }
2965
2966 proc xc {row col} {
2967     global canvx0 linespc
2968     return [expr {$canvx0 + $col * $linespc}]
2969 }
2970
2971 proc yc {row} {
2972     global canvy0 linespc
2973     return [expr {$canvy0 + $row * $linespc}]
2974 }
2975
2976 proc linewidth {id} {
2977     global thickerline lthickness
2978
2979     set wid $lthickness
2980     if {[info exists thickerline] && $id eq $thickerline} {
2981         set wid [expr {2 * $lthickness}]
2982     }
2983     return $wid
2984 }
2985
2986 proc rowranges {id} {
2987     global phase idrowranges commitrow rowlaidout rowrangelist curview
2988
2989     set ranges {}
2990     if {$phase eq {} ||
2991         ([info exists commitrow($curview,$id)]
2992          && $commitrow($curview,$id) < $rowlaidout)} {
2993         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2994     } elseif {[info exists idrowranges($id)]} {
2995         set ranges $idrowranges($id)
2996     }
2997     set linenos {}
2998     foreach rid $ranges {
2999         lappend linenos $commitrow($curview,$rid)
3000     }
3001     if {$linenos ne {}} {
3002         lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3003     }
3004     return $linenos
3005 }
3006
3007 proc drawlineseg {id i ranges} {
3008     global rowoffsets rowidlist
3009     global displayorder
3010     global canv colormap linespc
3011     global numcommits commitrow curview
3012
3013     set downarrow 1
3014     if {[info exists commitrow($curview,$id)]
3015         && $commitrow($curview,$id) < $numcommits} {
3016         set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
3017     } else {
3018         set downarrow 1
3019     }
3020     set startrow [lindex $ranges [expr {2 * $i}]]
3021     set row [lindex $ranges [expr {2 * $i + 1}]]
3022     if {$startrow == $row} return
3023     assigncolor $id
3024     set coords {}
3025     set col [lsearch -exact [lindex $rowidlist $row] $id]
3026     if {$col < 0} {
3027         puts "oops: drawline: id $id not on row $row"
3028         return
3029     }
3030     set lasto {}
3031     set ns 0
3032     while {1} {
3033         set o [lindex $rowoffsets $row $col]
3034         if {$o eq {}} break
3035         if {$o ne $lasto} {
3036             # changing direction
3037             set x [xc $row $col]
3038             set y [yc $row]
3039             lappend coords $x $y
3040             set lasto $o
3041         }
3042         incr col $o
3043         incr row -1
3044     }
3045     set x [xc $row $col]
3046     set y [yc $row]
3047     lappend coords $x $y
3048     if {$i == 0} {
3049         # draw the link to the first child as part of this line
3050         incr row -1
3051         set child [lindex $displayorder $row]
3052         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
3053         if {$ccol >= 0} {
3054             set x [xc $row $ccol]
3055             set y [yc $row]
3056             if {$ccol < $col - 1} {
3057                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
3058             } elseif {$ccol > $col + 1} {
3059                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
3060             }
3061             lappend coords $x $y
3062         }
3063     }
3064     if {[llength $coords] < 4} return
3065     if {$downarrow} {
3066         # This line has an arrow at the lower end: check if the arrow is
3067         # on a diagonal segment, and if so, work around the Tk 8.4
3068         # refusal to draw arrows on diagonal lines.
3069         set x0 [lindex $coords 0]
3070         set x1 [lindex $coords 2]
3071         if {$x0 != $x1} {
3072             set y0 [lindex $coords 1]
3073             set y1 [lindex $coords 3]
3074             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3075                 # we have a nearby vertical segment, just trim off the diag bit
3076                 set coords [lrange $coords 2 end]
3077             } else {
3078                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3079                 set xi [expr {$x0 - $slope * $linespc / 2}]
3080                 set yi [expr {$y0 - $linespc / 2}]
3081                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3082             }
3083         }
3084     }
3085     set arrow [expr {2 * ($i > 0) + $downarrow}]
3086     set arrow [lindex {none first last both} $arrow]
3087     set t [$canv create line $coords -width [linewidth $id] \
3088                -fill $colormap($id) -tags lines.$id -arrow $arrow]
3089     $canv lower $t
3090     bindline $t $id
3091 }
3092
3093 proc drawparentlinks {id row col olds} {
3094     global rowidlist canv colormap
3095
3096     set row2 [expr {$row + 1}]
3097     set x [xc $row $col]
3098     set y [yc $row]
3099     set y2 [yc $row2]
3100     set ids [lindex $rowidlist $row2]
3101     # rmx = right-most X coord used
3102     set rmx 0
3103     foreach p $olds {
3104         set i [lsearch -exact $ids $p]
3105         if {$i < 0} {
3106             puts "oops, parent $p of $id not in list"
3107             continue
3108         }
3109         set x2 [xc $row2 $i]
3110         if {$x2 > $rmx} {
3111             set rmx $x2
3112         }
3113         set ranges [rowranges $p]
3114         if {$ranges ne {} && $row2 == [lindex $ranges 0]
3115             && $row2 < [lindex $ranges 1]} {
3116             # drawlineseg will do this one for us
3117             continue
3118         }
3119         assigncolor $p
3120         # should handle duplicated parents here...
3121         set coords [list $x $y]
3122         if {$i < $col - 1} {
3123             lappend coords [xc $row [expr {$i + 1}]] $y
3124         } elseif {$i > $col + 1} {
3125             lappend coords [xc $row [expr {$i - 1}]] $y
3126         }
3127         lappend coords $x2 $y2
3128         set t [$canv create line $coords -width [linewidth $p] \
3129                    -fill $colormap($p) -tags lines.$p]
3130         $canv lower $t
3131         bindline $t $p
3132     }
3133     return $rmx
3134 }
3135
3136 proc drawlines {id} {
3137     global colormap canv
3138     global idrangedrawn
3139     global children iddrawn commitrow rowidlist curview
3140
3141     $canv delete lines.$id
3142     set ranges [rowranges $id]
3143     set nr [expr {[llength $ranges] / 2}]
3144     for {set i 0} {$i < $nr} {incr i} {
3145         if {[info exists idrangedrawn($id,$i)]} {
3146             drawlineseg $id $i $ranges
3147         }
3148     }
3149     foreach child $children($curview,$id) {
3150         if {[info exists iddrawn($child)]} {
3151             set row $commitrow($curview,$child)
3152             set col [lsearch -exact [lindex $rowidlist $row] $child]
3153             if {$col >= 0} {
3154                 drawparentlinks $child $row $col [list $id]
3155             }
3156         }
3157     }
3158 }
3159
3160 proc drawcmittext {id row col rmx} {
3161     global linespc canv canv2 canv3 canvy0 fgcolor
3162     global commitlisted commitinfo rowidlist
3163     global rowtextx idpos idtags idheads idotherrefs
3164     global linehtag linentag linedtag
3165     global mainfont canvxmax boldrows boldnamerows fgcolor
3166
3167     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3168     set x [xc $row $col]
3169     set y [yc $row]
3170     set orad [expr {$linespc / 3}]
3171     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3172                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3173                -fill $ofill -outline $fgcolor -width 1 -tags circle]
3174     $canv raise $t
3175     $canv bind $t <1> {selcanvline {} %x %y}
3176     set xt [xc $row [llength [lindex $rowidlist $row]]]
3177     if {$xt < $rmx} {
3178         set xt $rmx
3179     }
3180     set rowtextx($row) $xt
3181     set idpos($id) [list $x $xt $y]
3182     if {[info exists idtags($id)] || [info exists idheads($id)]
3183         || [info exists idotherrefs($id)]} {
3184         set xt [drawtags $id $x $xt $y]
3185     }
3186     set headline [lindex $commitinfo($id) 0]
3187     set name [lindex $commitinfo($id) 1]
3188     set date [lindex $commitinfo($id) 2]
3189     set date [formatdate $date]
3190     set font $mainfont
3191     set nfont $mainfont
3192     set isbold [ishighlighted $row]
3193     if {$isbold > 0} {
3194         lappend boldrows $row
3195         lappend font bold
3196         if {$isbold > 1} {
3197             lappend boldnamerows $row
3198             lappend nfont bold
3199         }
3200     }
3201     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3202                             -text $headline -font $font -tags text]
3203     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3204     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3205                             -text $name -font $nfont -tags text]
3206     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3207                             -text $date -font $mainfont -tags text]
3208     set xr [expr {$xt + [font measure $mainfont $headline]}]
3209     if {$xr > $canvxmax} {
3210         set canvxmax $xr
3211         setcanvscroll
3212     }
3213 }
3214
3215 proc drawcmitrow {row} {
3216     global displayorder rowidlist
3217     global idrangedrawn iddrawn
3218     global commitinfo parentlist numcommits
3219     global filehighlight fhighlights findstring nhighlights
3220     global hlview vhighlights
3221     global highlight_related rhighlights
3222
3223     if {$row >= $numcommits} return
3224     foreach id [lindex $rowidlist $row] {
3225         if {$id eq {}} continue
3226         set i -1
3227         set ranges [rowranges $id]
3228         foreach {s e} $ranges {
3229             incr i
3230             if {$row < $s} continue
3231             if {$e eq {}} break
3232             if {$row <= $e} {
3233                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3234                     drawlineseg $id $i $ranges
3235                     set idrangedrawn($id,$i) 1
3236                 }
3237                 break
3238             }
3239         }
3240     }
3241
3242     set id [lindex $displayorder $row]
3243     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3244         askvhighlight $row $id
3245     }
3246     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3247         askfilehighlight $row $id
3248     }
3249     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3250         askfindhighlight $row $id
3251     }
3252     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3253         askrelhighlight $row $id
3254     }
3255     if {[info exists iddrawn($id)]} return
3256     set col [lsearch -exact [lindex $rowidlist $row] $id]
3257     if {$col < 0} {
3258         puts "oops, row $row id $id not in list"
3259         return
3260     }
3261     if {![info exists commitinfo($id)]} {
3262         getcommit $id
3263     }
3264     assigncolor $id
3265     set olds [lindex $parentlist $row]
3266     if {$olds ne {}} {
3267         set rmx [drawparentlinks $id $row $col $olds]
3268     } else {
3269         set rmx 0
3270     }
3271     drawcmittext $id $row $col $rmx
3272     set iddrawn($id) 1
3273 }
3274
3275 proc drawfrac {f0 f1} {
3276     global numcommits canv
3277     global linespc
3278
3279     set ymax [lindex [$canv cget -scrollregion] 3]
3280     if {$ymax eq {} || $ymax == 0} return
3281     set y0 [expr {int($f0 * $ymax)}]
3282     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3283     if {$row < 0} {
3284         set row 0
3285     }
3286     set y1 [expr {int($f1 * $ymax)}]
3287     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3288     if {$endrow >= $numcommits} {
3289         set endrow [expr {$numcommits - 1}]
3290     }
3291     for {} {$row <= $endrow} {incr row} {
3292         drawcmitrow $row
3293     }
3294 }
3295
3296 proc drawvisible {} {
3297     global canv
3298     eval drawfrac [$canv yview]
3299 }
3300
3301 proc clear_display {} {
3302     global iddrawn idrangedrawn
3303     global vhighlights fhighlights nhighlights rhighlights
3304
3305     allcanvs delete all
3306     catch {unset iddrawn}
3307     catch {unset idrangedrawn}
3308     catch {unset vhighlights}
3309     catch {unset fhighlights}
3310     catch {unset nhighlights}
3311     catch {unset rhighlights}
3312 }
3313
3314 proc findcrossings {id} {
3315     global rowidlist parentlist numcommits rowoffsets displayorder
3316
3317     set cross {}
3318     set ccross {}
3319     foreach {s e} [rowranges $id] {
3320         if {$e >= $numcommits} {
3321             set e [expr {$numcommits - 1}]
3322         }
3323         if {$e <= $s} continue
3324         set x [lsearch -exact [lindex $rowidlist $e] $id]
3325         if {$x < 0} {
3326             puts "findcrossings: oops, no [shortids $id] in row $e"
3327             continue
3328         }
3329         for {set row $e} {[incr row -1] >= $s} {} {
3330             set olds [lindex $parentlist $row]
3331             set kid [lindex $displayorder $row]
3332             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3333             if {$kidx < 0} continue
3334             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3335             foreach p $olds {
3336                 set px [lsearch -exact $nextrow $p]
3337                 if {$px < 0} continue
3338                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3339                     if {[lsearch -exact $ccross $p] >= 0} continue
3340                     if {$x == $px + ($kidx < $px? -1: 1)} {
3341                         lappend ccross $p
3342                     } elseif {[lsearch -exact $cross $p] < 0} {
3343                         lappend cross $p
3344                     }
3345                 }
3346             }
3347             set inc [lindex $rowoffsets $row $x]
3348             if {$inc eq {}} break
3349             incr x $inc
3350         }
3351     }
3352     return [concat $ccross {{}} $cross]
3353 }
3354
3355 proc assigncolor {id} {
3356     global colormap colors nextcolor
3357     global commitrow parentlist children children curview
3358
3359     if {[info exists colormap($id)]} return
3360     set ncolors [llength $colors]
3361     if {[info exists children($curview,$id)]} {
3362         set kids $children($curview,$id)
3363     } else {
3364         set kids {}
3365     }
3366     if {[llength $kids] == 1} {
3367         set child [lindex $kids 0]
3368         if {[info exists colormap($child)]
3369             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3370             set colormap($id) $colormap($child)
3371             return
3372         }
3373     }
3374     set badcolors {}
3375     set origbad {}
3376     foreach x [findcrossings $id] {
3377         if {$x eq {}} {
3378             # delimiter between corner crossings and other crossings
3379             if {[llength $badcolors] >= $ncolors - 1} break
3380             set origbad $badcolors
3381         }
3382         if {[info exists colormap($x)]
3383             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3384             lappend badcolors $colormap($x)
3385         }
3386     }
3387     if {[llength $badcolors] >= $ncolors} {
3388         set badcolors $origbad
3389     }
3390     set origbad $badcolors
3391     if {[llength $badcolors] < $ncolors - 1} {
3392         foreach child $kids {
3393             if {[info exists colormap($child)]
3394                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3395                 lappend badcolors $colormap($child)
3396             }
3397             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3398                 if {[info exists colormap($p)]
3399                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3400                     lappend badcolors $colormap($p)
3401                 }
3402             }
3403         }
3404         if {[llength $badcolors] >= $ncolors} {
3405             set badcolors $origbad
3406         }
3407     }
3408     for {set i 0} {$i <= $ncolors} {incr i} {
3409         set c [lindex $colors $nextcolor]
3410         if {[incr nextcolor] >= $ncolors} {
3411             set nextcolor 0
3412         }
3413         if {[lsearch -exact $badcolors $c]} break
3414     }
3415     set colormap($id) $c
3416 }
3417
3418 proc bindline {t id} {
3419     global canv
3420
3421     $canv bind $t <Enter> "lineenter %x %y $id"
3422     $canv bind $t <Motion> "linemotion %x %y $id"
3423     $canv bind $t <Leave> "lineleave $id"
3424     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3425 }
3426
3427 proc drawtags {id x xt y1} {
3428     global idtags idheads idotherrefs mainhead
3429     global linespc lthickness
3430     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3431
3432     set marks {}
3433     set ntags 0
3434     set nheads 0
3435     if {[info exists idtags($id)]} {
3436         set marks $idtags($id)
3437         set ntags [llength $marks]
3438     }
3439     if {[info exists idheads($id)]} {
3440         set marks [concat $marks $idheads($id)]
3441         set nheads [llength $idheads($id)]
3442     }
3443     if {[info exists idotherrefs($id)]} {
3444         set marks [concat $marks $idotherrefs($id)]
3445     }
3446     if {$marks eq {}} {
3447         return $xt
3448     }
3449
3450     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3451     set yt [expr {$y1 - 0.5 * $linespc}]
3452     set yb [expr {$yt + $linespc - 1}]
3453     set xvals {}
3454     set wvals {}
3455     set i -1
3456     foreach tag $marks {
3457         incr i
3458         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3459             set wid [font measure [concat $mainfont bold] $tag]
3460         } else {
3461             set wid [font measure $mainfont $tag]
3462         }
3463         lappend xvals $xt
3464         lappend wvals $wid
3465         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3466     }
3467     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3468                -width $lthickness -fill black -tags tag.$id]
3469     $canv lower $t
3470     foreach tag $marks x $xvals wid $wvals {
3471         set xl [expr {$x + $delta}]
3472         set xr [expr {$x + $delta + $wid + $lthickness}]
3473         set font $mainfont
3474         if {[incr ntags -1] >= 0} {
3475             # draw a tag
3476             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3477                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3478                        -width 1 -outline black -fill yellow -tags tag.$id]
3479             $canv bind $t <1> [list showtag $tag 1]
3480             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3481         } else {
3482             # draw a head or other ref
3483             if {[incr nheads -1] >= 0} {
3484                 set col green
3485                 if {$tag eq $mainhead} {
3486                     lappend font bold
3487                 }
3488             } else {
3489                 set col "#ddddff"
3490             }
3491             set xl [expr {$xl - $delta/2}]
3492             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3493                 -width 1 -outline black -fill $col -tags tag.$id
3494             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3495                 set rwid [font measure $mainfont $remoteprefix]
3496                 set xi [expr {$x + 1}]
3497                 set yti [expr {$yt + 1}]
3498                 set xri [expr {$x + $rwid}]
3499                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3500                         -width 0 -fill "#ffddaa" -tags tag.$id
3501             }
3502         }
3503         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3504                    -font $font -tags [list tag.$id text]]
3505         if {$ntags >= 0} {
3506             $canv bind $t <1> [list showtag $tag 1]
3507         } elseif {$nheads >= 0} {
3508             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3509         }
3510     }
3511     return $xt
3512 }
3513
3514 proc xcoord {i level ln} {
3515     global canvx0 xspc1 xspc2
3516
3517     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3518     if {$i > 0 && $i == $level} {
3519         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3520     } elseif {$i > $level} {
3521         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3522     }
3523     return $x
3524 }
3525
3526 proc show_status {msg} {
3527     global canv mainfont fgcolor
3528
3529     clear_display
3530     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3531         -tags text -fill $fgcolor
3532 }
3533
3534 # Insert a new commit as the child of the commit on row $row.
3535 # The new commit will be displayed on row $row and the commits
3536 # on that row and below will move down one row.
3537 proc insertrow {row newcmit} {
3538     global displayorder parentlist childlist commitlisted
3539     global commitrow curview rowidlist rowoffsets numcommits
3540     global rowrangelist rowlaidout rowoptim numcommits
3541     global linesegends selectedline
3542
3543     if {$row >= $numcommits} {
3544         puts "oops, inserting new row $row but only have $numcommits rows"
3545         return
3546     }
3547     set p [lindex $displayorder $row]
3548     set displayorder [linsert $displayorder $row $newcmit]
3549     set parentlist [linsert $parentlist $row $p]
3550     set kids [lindex $childlist $row]
3551     lappend kids $newcmit
3552     lset childlist $row $kids
3553     set childlist [linsert $childlist $row {}]
3554     set commitlisted [linsert $commitlisted $row 1]
3555     set l [llength $displayorder]
3556     for {set r $row} {$r < $l} {incr r} {
3557         set id [lindex $displayorder $r]
3558         set commitrow($curview,$id) $r
3559     }
3560
3561     set idlist [lindex $rowidlist $row]
3562     set offs [lindex $rowoffsets $row]
3563     set newoffs {}
3564     foreach x $idlist {
3565         if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3566             lappend newoffs {}
3567         } else {
3568             lappend newoffs 0
3569         }
3570     }
3571     if {[llength $kids] == 1} {
3572         set col [lsearch -exact $idlist $p]
3573         lset idlist $col $newcmit
3574     } else {
3575         set col [llength $idlist]
3576         lappend idlist $newcmit
3577         lappend offs {}
3578         lset rowoffsets $row $offs
3579     }
3580     set rowidlist [linsert $rowidlist $row $idlist]
3581     set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3582
3583     set rowrangelist [linsert $rowrangelist $row {}]
3584     if {[llength $kids] > 1} {
3585         set rp1 [expr {$row + 1}]
3586         set ranges [lindex $rowrangelist $rp1]
3587         if {$ranges eq {}} {
3588             set ranges [list $newcmit $p]
3589         } elseif {[lindex $ranges end-1] eq $p} {
3590             lset ranges end-1 $newcmit
3591         }
3592         lset rowrangelist $rp1 $ranges
3593     }
3594
3595     set linesegends [linsert $linesegends $row {}]
3596
3597     incr rowlaidout
3598     incr rowoptim
3599     incr numcommits
3600
3601     if {[info exists selectedline] && $selectedline >= $row} {
3602         incr selectedline
3603     }
3604     redisplay
3605 }
3606
3607 # Don't change the text pane cursor if it is currently the hand cursor,
3608 # showing that we are over a sha1 ID link.
3609 proc settextcursor {c} {
3610     global ctext curtextcursor
3611
3612     if {[$ctext cget -cursor] == $curtextcursor} {
3613         $ctext config -cursor $c
3614     }
3615     set curtextcursor $c
3616 }
3617
3618 proc nowbusy {what} {
3619     global isbusy
3620
3621     if {[array names isbusy] eq {}} {
3622         . config -cursor watch
3623         settextcursor watch
3624     }
3625     set isbusy($what) 1
3626 }
3627
3628 proc notbusy {what} {
3629     global isbusy maincursor textcursor
3630
3631     catch {unset isbusy($what)}
3632     if {[array names isbusy] eq {}} {
3633         . config -cursor $maincursor
3634         settextcursor $textcursor
3635     }
3636 }
3637
3638 proc findmatches {f} {
3639     global findtype foundstring foundstrlen
3640     if {$findtype == "Regexp"} {
3641         set matches [regexp -indices -all -inline $foundstring $f]
3642     } else {
3643         if {$findtype == "IgnCase"} {
3644             set str [string tolower $f]
3645         } else {
3646             set str $f
3647         }
3648         set matches {}
3649         set i 0
3650         while {[set j [string first $foundstring $str $i]] >= 0} {
3651             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3652             set i [expr {$j + $foundstrlen}]
3653         }
3654     }
3655     return $matches
3656 }
3657
3658 proc dofind {} {
3659     global findtype findloc findstring markedmatches commitinfo
3660     global numcommits displayorder linehtag linentag linedtag
3661     global mainfont canv canv2 canv3 selectedline
3662     global matchinglines foundstring foundstrlen matchstring
3663     global commitdata
3664
3665     stopfindproc
3666     unmarkmatches
3667     cancel_next_highlight
3668     focus .
3669     set matchinglines {}
3670     if {$findtype == "IgnCase"} {
3671         set foundstring [string tolower $findstring]
3672     } else {
3673         set foundstring $findstring
3674     }
3675     set foundstrlen [string length $findstring]
3676     if {$foundstrlen == 0} return
3677     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3678     set matchstring "*$matchstring*"
3679     if {![info exists selectedline]} {
3680         set oldsel -1
3681     } else {
3682         set oldsel $selectedline
3683     }
3684     set didsel 0
3685     set fldtypes {Headline Author Date Committer CDate Comments}
3686     set l -1
3687     foreach id $displayorder {
3688         set d $commitdata($id)
3689         incr l
3690         if {$findtype == "Regexp"} {
3691             set doesmatch [regexp $foundstring $d]
3692         } elseif {$findtype == "IgnCase"} {
3693             set doesmatch [string match -nocase $matchstring $d]
3694         } else {
3695             set doesmatch [string match $matchstring $d]
3696         }
3697         if {!$doesmatch} continue
3698         if {![info exists commitinfo($id)]} {
3699             getcommit $id
3700         }
3701         set info $commitinfo($id)
3702         set doesmatch 0
3703         foreach f $info ty $fldtypes {
3704             if {$findloc != "All fields" && $findloc != $ty} {
3705                 continue
3706             }
3707             set matches [findmatches $f]
3708             if {$matches == {}} continue
3709             set doesmatch 1
3710             if {$ty == "Headline"} {
3711                 drawcmitrow $l
3712                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3713             } elseif {$ty == "Author"} {
3714                 drawcmitrow $l
3715                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3716             } elseif {$ty == "Date"} {
3717                 drawcmitrow $l
3718                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3719             }
3720         }
3721         if {$doesmatch} {
3722             lappend matchinglines $l
3723             if {!$didsel && $l > $oldsel} {
3724                 findselectline $l
3725                 set didsel 1
3726             }
3727         }
3728     }
3729     if {$matchinglines == {}} {
3730         bell
3731     } elseif {!$didsel} {
3732         findselectline [lindex $matchinglines 0]
3733     }
3734 }
3735
3736 proc findselectline {l} {
3737     global findloc commentend ctext
3738     selectline $l 1
3739     if {$findloc == "All fields" || $findloc == "Comments"} {
3740         # highlight the matches in the comments
3741         set f [$ctext get 1.0 $commentend]
3742         set matches [findmatches $f]
3743         foreach match $matches {
3744             set start [lindex $match 0]
3745             set end [expr {[lindex $match 1] + 1}]
3746             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3747         }
3748     }
3749 }
3750
3751 proc findnext {restart} {
3752     global matchinglines selectedline
3753     if {![info exists matchinglines]} {
3754         if {$restart} {
3755             dofind
3756         }
3757         return
3758     }
3759     if {![info exists selectedline]} return
3760     foreach l $matchinglines {
3761         if {$l > $selectedline} {
3762             findselectline $l
3763             return
3764         }
3765     }
3766     bell
3767 }
3768
3769 proc findprev {} {
3770     global matchinglines selectedline
3771     if {![info exists matchinglines]} {
3772         dofind
3773         return
3774     }
3775     if {![info exists selectedline]} return
3776     set prev {}
3777     foreach l $matchinglines {
3778         if {$l >= $selectedline} break
3779         set prev $l
3780     }
3781     if {$prev != {}} {
3782         findselectline $prev
3783     } else {
3784         bell
3785     }
3786 }
3787
3788 proc stopfindproc {{done 0}} {
3789     global findprocpid findprocfile findids
3790     global ctext findoldcursor phase maincursor textcursor
3791     global findinprogress
3792
3793     catch {unset findids}
3794     if {[info exists findprocpid]} {
3795         if {!$done} {
3796             catch {exec kill $findprocpid}
3797         }
3798         catch {close $findprocfile}
3799         unset findprocpid
3800     }
3801     catch {unset findinprogress}
3802     notbusy find
3803 }
3804
3805 # mark a commit as matching by putting a yellow background
3806 # behind the headline
3807 proc markheadline {l id} {
3808     global canv mainfont linehtag
3809
3810     drawcmitrow $l
3811     set bbox [$canv bbox $linehtag($l)]
3812     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3813     $canv lower $t
3814 }
3815
3816 # mark the bits of a headline, author or date that match a find string
3817 proc markmatches {canv l str tag matches font} {
3818     set bbox [$canv bbox $tag]
3819     set x0 [lindex $bbox 0]
3820     set y0 [lindex $bbox 1]
3821     set y1 [lindex $bbox 3]
3822     foreach match $matches {
3823         set start [lindex $match 0]
3824         set end [lindex $match 1]
3825         if {$start > $end} continue
3826         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3827         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3828         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3829                    [expr {$x0+$xlen+2}] $y1 \
3830                    -outline {} -tags matches -fill yellow]
3831         $canv lower $t
3832     }
3833 }
3834
3835 proc unmarkmatches {} {
3836     global matchinglines findids
3837     allcanvs delete matches
3838     catch {unset matchinglines}
3839     catch {unset findids}
3840 }
3841
3842 proc selcanvline {w x y} {
3843     global canv canvy0 ctext linespc
3844     global rowtextx
3845     set ymax [lindex [$canv cget -scrollregion] 3]
3846     if {$ymax == {}} return
3847     set yfrac [lindex [$canv yview] 0]
3848     set y [expr {$y + $yfrac * $ymax}]
3849     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3850     if {$l < 0} {
3851         set l 0
3852     }
3853     if {$w eq $canv} {
3854         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3855     }
3856     unmarkmatches
3857     selectline $l 1
3858 }
3859
3860 proc commit_descriptor {p} {
3861     global commitinfo
3862     if {![info exists commitinfo($p)]} {
3863         getcommit $p
3864     }
3865     set l "..."
3866     if {[llength $commitinfo($p)] > 1} {
3867         set l [lindex $commitinfo($p) 0]
3868     }
3869     return "$p ($l)\n"
3870 }
3871
3872 # append some text to the ctext widget, and make any SHA1 ID
3873 # that we know about be a clickable link.
3874 proc appendwithlinks {text tags} {
3875     global ctext commitrow linknum curview
3876
3877     set start [$ctext index "end - 1c"]
3878     $ctext insert end $text $tags
3879     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3880     foreach l $links {
3881         set s [lindex $l 0]
3882         set e [lindex $l 1]
3883         set linkid [string range $text $s $e]
3884         if {![info exists commitrow($curview,$linkid)]} continue
3885         incr e
3886         $ctext tag add link "$start + $s c" "$start + $e c"
3887         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3888         $ctext tag bind link$linknum <1> \
3889             [list selectline $commitrow($curview,$linkid) 1]
3890         incr linknum
3891     }
3892     $ctext tag conf link -foreground blue -underline 1
3893     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3894     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3895 }
3896
3897 proc viewnextline {dir} {
3898     global canv linespc
3899
3900     $canv delete hover
3901     set ymax [lindex [$canv cget -scrollregion] 3]
3902     set wnow [$canv yview]
3903     set wtop [expr {[lindex $wnow 0] * $ymax}]
3904     set newtop [expr {$wtop + $dir * $linespc}]
3905     if {$newtop < 0} {
3906         set newtop 0
3907     } elseif {$newtop > $ymax} {
3908         set newtop $ymax
3909     }
3910     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3911 }
3912
3913 # add a list of tag or branch names at position pos
3914 # returns the number of names inserted
3915 proc appendrefs {pos ids var} {
3916     global ctext commitrow linknum curview $var maxrefs
3917
3918     if {[catch {$ctext index $pos}]} {
3919         return 0
3920     }
3921     $ctext conf -state normal
3922     $ctext delete $pos "$pos lineend"
3923     set tags {}
3924     foreach id $ids {
3925         foreach tag [set $var\($id\)] {
3926             lappend tags [list $tag $id]
3927         }
3928     }
3929     if {[llength $tags] > $maxrefs} {
3930         $ctext insert $pos "many ([llength $tags])"
3931     } else {
3932         set tags [lsort -index 0 -decreasing $tags]
3933         set sep {}
3934         foreach ti $tags {
3935             set id [lindex $ti 1]
3936             set lk link$linknum
3937             incr linknum
3938             $ctext tag delete $lk
3939             $ctext insert $pos $sep
3940             $ctext insert $pos [lindex $ti 0] $lk
3941             if {[info exists commitrow($curview,$id)]} {
3942                 $ctext tag conf $lk -foreground blue
3943                 $ctext tag bind $lk <1> \
3944                     [list selectline $commitrow($curview,$id) 1]
3945                 $ctext tag conf $lk -underline 1
3946                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3947                 $ctext tag bind $lk <Leave> \
3948                     { %W configure -cursor $curtextcursor }
3949             }
3950             set sep ", "
3951         }
3952     }
3953     $ctext conf -state disabled
3954     return [llength $tags]
3955 }
3956
3957 # called when we have finished computing the nearby tags
3958 proc dispneartags {delay} {
3959     global selectedline currentid showneartags tagphase
3960
3961     if {![info exists selectedline] || !$showneartags} return
3962     after cancel dispnexttag
3963     if {$delay} {
3964         after 200 dispnexttag
3965         set tagphase -1
3966     } else {
3967         after idle dispnexttag
3968         set tagphase 0
3969     }
3970 }
3971
3972 proc dispnexttag {} {
3973     global selectedline currentid showneartags tagphase ctext
3974
3975     if {![info exists selectedline] || !$showneartags} return
3976     switch -- $tagphase {
3977         0 {
3978             set dtags [desctags $currentid]
3979             if {$dtags ne {}} {
3980                 appendrefs precedes $dtags idtags
3981             }
3982         }
3983         1 {
3984             set atags [anctags $currentid]
3985             if {$atags ne {}} {
3986                 appendrefs follows $atags idtags
3987             }
3988         }
3989         2 {
3990             set dheads [descheads $currentid]
3991             if {$dheads ne {}} {
3992                 if {[appendrefs branch $dheads idheads] > 1
3993                     && [$ctext get "branch -3c"] eq "h"} {
3994                     # turn "Branch" into "Branches"
3995                     $ctext conf -state normal
3996                     $ctext insert "branch -2c" "es"
3997                     $ctext conf -state disabled
3998                 }
3999             }
4000         }
4001     }
4002     if {[incr tagphase] <= 2} {
4003         after idle dispnexttag
4004     }
4005 }
4006
4007 proc selectline {l isnew} {
4008     global canv canv2 canv3 ctext commitinfo selectedline
4009     global displayorder linehtag linentag linedtag
4010     global canvy0 linespc parentlist childlist
4011     global currentid sha1entry
4012     global commentend idtags linknum
4013     global mergemax numcommits pending_select
4014     global cmitmode showneartags allcommits
4015
4016     catch {unset pending_select}
4017     $canv delete hover
4018     normalline
4019     cancel_next_highlight
4020     if {$l < 0 || $l >= $numcommits} return
4021     set y [expr {$canvy0 + $l * $linespc}]
4022     set ymax [lindex [$canv cget -scrollregion] 3]
4023     set ytop [expr {$y - $linespc - 1}]
4024     set ybot [expr {$y + $linespc + 1}]
4025     set wnow [$canv yview]
4026     set wtop [expr {[lindex $wnow 0] * $ymax}]
4027     set wbot [expr {[lindex $wnow 1] * $ymax}]
4028     set wh [expr {$wbot - $wtop}]
4029     set newtop $wtop
4030     if {$ytop < $wtop} {
4031         if {$ybot < $wtop} {
4032             set newtop [expr {$y - $wh / 2.0}]
4033         } else {
4034             set newtop $ytop
4035             if {$newtop > $wtop - $linespc} {
4036                 set newtop [expr {$wtop - $linespc}]
4037             }
4038         }
4039     } elseif {$ybot > $wbot} {
4040         if {$ytop > $wbot} {
4041             set newtop [expr {$y - $wh / 2.0}]
4042         } else {
4043             set newtop [expr {$ybot - $wh}]
4044             if {$newtop < $wtop + $linespc} {
4045                 set newtop [expr {$wtop + $linespc}]
4046             }
4047         }
4048     }
4049     if {$newtop != $wtop} {
4050         if {$newtop < 0} {
4051             set newtop 0
4052         }
4053         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4054         drawvisible
4055     }
4056
4057     if {![info exists linehtag($l)]} return
4058     $canv delete secsel
4059     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4060                -tags secsel -fill [$canv cget -selectbackground]]
4061     $canv lower $t
4062     $canv2 delete secsel
4063     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4064                -tags secsel -fill [$canv2 cget -selectbackground]]
4065     $canv2 lower $t
4066     $canv3 delete secsel
4067     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4068                -tags secsel -fill [$canv3 cget -selectbackground]]
4069     $canv3 lower $t
4070
4071     if {$isnew} {
4072         addtohistory [list selectline $l 0]
4073     }
4074
4075     set selectedline $l
4076
4077     set id [lindex $displayorder $l]
4078     set currentid $id
4079     $sha1entry delete 0 end
4080     $sha1entry insert 0 $id
4081     $sha1entry selection from 0
4082     $sha1entry selection to end
4083     rhighlight_sel $id
4084
4085     $ctext conf -state normal
4086     clear_ctext
4087     set linknum 0
4088     set info $commitinfo($id)
4089     set date [formatdate [lindex $info 2]]
4090     $ctext insert end "Author: [lindex $info 1]  $date\n"
4091     set date [formatdate [lindex $info 4]]
4092     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4093     if {[info exists idtags($id)]} {
4094         $ctext insert end "Tags:"
4095         foreach tag $idtags($id) {
4096             $ctext insert end " $tag"
4097         }
4098         $ctext insert end "\n"
4099     }
4100
4101     set headers {}
4102     set olds [lindex $parentlist $l]
4103     if {[llength $olds] > 1} {
4104         set np 0
4105         foreach p $olds {
4106             if {$np >= $mergemax} {
4107                 set tag mmax
4108             } else {
4109                 set tag m$np
4110             }
4111             $ctext insert end "Parent: " $tag
4112             appendwithlinks [commit_descriptor $p] {}
4113             incr np
4114         }
4115     } else {
4116         foreach p $olds {
4117             append headers "Parent: [commit_descriptor $p]"
4118         }
4119     }
4120
4121     foreach c [lindex $childlist $l] {
4122         append headers "Child:  [commit_descriptor $c]"
4123     }
4124
4125     # make anything that looks like a SHA1 ID be a clickable link
4126     appendwithlinks $headers {}
4127     if {$showneartags} {
4128         if {![info exists allcommits]} {
4129             getallcommits
4130         }
4131         $ctext insert end "Branch: "
4132         $ctext mark set branch "end -1c"
4133         $ctext mark gravity branch left
4134         $ctext insert end "\nFollows: "
4135         $ctext mark set follows "end -1c"
4136         $ctext mark gravity follows left
4137         $ctext insert end "\nPrecedes: "
4138         $ctext mark set precedes "end -1c"
4139         $ctext mark gravity precedes left
4140         $ctext insert end "\n"
4141         dispneartags 1
4142     }
4143     $ctext insert end "\n"
4144     set comment [lindex $info 5]
4145     if {[string first "\r" $comment] >= 0} {
4146         set comment [string map {"\r" "\n    "} $comment]
4147     }
4148     appendwithlinks $comment {comment}
4149
4150     $ctext tag delete Comments
4151     $ctext tag remove found 1.0 end
4152     $ctext conf -state disabled
4153     set commentend [$ctext index "end - 1c"]
4154
4155     init_flist "Comments"
4156     if {$cmitmode eq "tree"} {
4157         gettree $id
4158     } elseif {[llength $olds] <= 1} {
4159         startdiff $id
4160     } else {
4161         mergediff $id $l
4162     }
4163 }
4164
4165 proc selfirstline {} {
4166     unmarkmatches
4167     selectline 0 1
4168 }
4169
4170 proc sellastline {} {
4171     global numcommits
4172     unmarkmatches
4173     set l [expr {$numcommits - 1}]
4174     selectline $l 1
4175 }
4176
4177 proc selnextline {dir} {
4178     global selectedline
4179     if {![info exists selectedline]} return
4180     set l [expr {$selectedline + $dir}]
4181     unmarkmatches
4182     selectline $l 1
4183 }
4184
4185 proc selnextpage {dir} {
4186     global canv linespc selectedline numcommits
4187
4188     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4189     if {$lpp < 1} {
4190         set lpp 1
4191     }
4192     allcanvs yview scroll [expr {$dir * $lpp}] units
4193     drawvisible
4194     if {![info exists selectedline]} return
4195     set l [expr {$selectedline + $dir * $lpp}]
4196     if {$l < 0} {
4197         set l 0
4198     } elseif {$l >= $numcommits} {
4199         set l [expr $numcommits - 1]
4200     }
4201     unmarkmatches
4202     selectline $l 1
4203 }
4204
4205 proc unselectline {} {
4206     global selectedline currentid
4207
4208     catch {unset selectedline}
4209     catch {unset currentid}
4210     allcanvs delete secsel
4211     rhighlight_none
4212     cancel_next_highlight
4213 }
4214
4215 proc reselectline {} {
4216     global selectedline
4217
4218     if {[info exists selectedline]} {
4219         selectline $selectedline 0
4220     }
4221 }
4222
4223 proc addtohistory {cmd} {
4224     global history historyindex curview
4225
4226     set elt [list $curview $cmd]
4227     if {$historyindex > 0
4228         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4229         return
4230     }
4231
4232     if {$historyindex < [llength $history]} {
4233         set history [lreplace $history $historyindex end $elt]
4234     } else {
4235         lappend history $elt
4236     }
4237     incr historyindex
4238     if {$historyindex > 1} {
4239         .tf.bar.leftbut conf -state normal
4240     } else {
4241         .tf.bar.leftbut conf -state disabled
4242     }
4243     .tf.bar.rightbut conf -state disabled
4244 }
4245
4246 proc godo {elt} {
4247     global curview
4248
4249     set view [lindex $elt 0]
4250     set cmd [lindex $elt 1]
4251     if {$curview != $view} {
4252         showview $view
4253     }
4254     eval $cmd
4255 }
4256
4257 proc goback {} {
4258     global history historyindex
4259
4260     if {$historyindex > 1} {
4261         incr historyindex -1
4262         godo [lindex $history [expr {$historyindex - 1}]]
4263         .tf.bar.rightbut conf -state normal
4264     }
4265     if {$historyindex <= 1} {
4266         .tf.bar.leftbut conf -state disabled
4267     }
4268 }
4269
4270 proc goforw {} {
4271     global history historyindex
4272
4273     if {$historyindex < [llength $history]} {
4274         set cmd [lindex $history $historyindex]
4275         incr historyindex
4276         godo $cmd
4277         .tf.bar.leftbut conf -state normal
4278     }
4279     if {$historyindex >= [llength $history]} {
4280         .tf.bar.rightbut conf -state disabled
4281     }
4282 }
4283
4284 proc gettree {id} {
4285     global treefilelist treeidlist diffids diffmergeid treepending
4286
4287     set diffids $id
4288     catch {unset diffmergeid}
4289     if {![info exists treefilelist($id)]} {
4290         if {![info exists treepending]} {
4291             if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4292                 return
4293             }
4294             set treepending $id
4295             set treefilelist($id) {}
4296             set treeidlist($id) {}
4297             fconfigure $gtf -blocking 0
4298             filerun $gtf [list gettreeline $gtf $id]
4299         }
4300     } else {
4301         setfilelist $id
4302     }
4303 }
4304
4305 proc gettreeline {gtf id} {
4306     global treefilelist treeidlist treepending cmitmode diffids
4307
4308     set nl 0
4309     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4310         set tl [split $line "\t"]
4311         if {[lindex $tl 0 1] ne "blob"} continue
4312         set sha1 [lindex $tl 0 2]
4313         set fname [lindex $tl 1]
4314         if {[string index $fname 0] eq "\""} {
4315             set fname [lindex $fname 0]
4316         }
4317         lappend treeidlist($id) $sha1
4318         lappend treefilelist($id) $fname
4319     }
4320     if {![eof $gtf]} {
4321         return [expr {$nl >= 1000? 2: 1}]
4322     }
4323     close $gtf
4324     unset treepending
4325     if {$cmitmode ne "tree"} {
4326         if {![info exists diffmergeid]} {
4327             gettreediffs $diffids
4328         }
4329     } elseif {$id ne $diffids} {
4330         gettree $diffids
4331     } else {
4332         setfilelist $id
4333     }
4334     return 0
4335 }
4336
4337 proc showfile {f} {
4338     global treefilelist treeidlist diffids
4339     global ctext commentend
4340
4341     set i [lsearch -exact $treefilelist($diffids) $f]
4342     if {$i < 0} {
4343         puts "oops, $f not in list for id $diffids"
4344         return
4345     }
4346     set blob [lindex $treeidlist($diffids) $i]
4347     if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4348         puts "oops, error reading blob $blob: $err"
4349         return
4350     }
4351     fconfigure $bf -blocking 0
4352     filerun $bf [list getblobline $bf $diffids]
4353     $ctext config -state normal
4354     clear_ctext $commentend
4355     $ctext insert end "\n"
4356     $ctext insert end "$f\n" filesep
4357     $ctext config -state disabled
4358     $ctext yview $commentend
4359 }
4360
4361 proc getblobline {bf id} {
4362     global diffids cmitmode ctext
4363
4364     if {$id ne $diffids || $cmitmode ne "tree"} {
4365         catch {close $bf}
4366         return 0
4367     }
4368     $ctext config -state normal
4369     set nl 0
4370     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4371         $ctext insert end "$line\n"
4372     }
4373     if {[eof $bf]} {
4374         # delete last newline
4375         $ctext delete "end - 2c" "end - 1c"
4376         close $bf
4377         return 0
4378     }
4379     $ctext config -state disabled
4380     return [expr {$nl >= 1000? 2: 1}]
4381 }
4382
4383 proc mergediff {id l} {
4384     global diffmergeid diffopts mdifffd
4385     global diffids
4386     global parentlist
4387
4388     set diffmergeid $id
4389     set diffids $id
4390     # this doesn't seem to actually affect anything...
4391     set env(GIT_DIFF_OPTS) $diffopts
4392     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4393     if {[catch {set mdf [open $cmd r]} err]} {
4394         error_popup "Error getting merge diffs: $err"
4395         return
4396     }
4397     fconfigure $mdf -blocking 0
4398     set mdifffd($id) $mdf
4399     set np [llength [lindex $parentlist $l]]
4400     filerun $mdf [list getmergediffline $mdf $id $np]
4401 }
4402
4403 proc getmergediffline {mdf id np} {
4404     global diffmergeid ctext cflist mergemax
4405     global difffilestart mdifffd
4406
4407     $ctext conf -state normal
4408     set nr 0
4409     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4410         if {![info exists diffmergeid] || $id != $diffmergeid
4411             || $mdf != $mdifffd($id)} {
4412             close $mdf
4413             return 0
4414         }
4415         if {[regexp {^diff --cc (.*)} $line match fname]} {
4416             # start of a new file
4417             $ctext insert end "\n"
4418             set here [$ctext index "end - 1c"]
4419             lappend difffilestart $here
4420             add_flist [list $fname]
4421             set l [expr {(78 - [string length $fname]) / 2}]
4422             set pad [string range "----------------------------------------" 1 $l]
4423             $ctext insert end "$pad $fname $pad\n" filesep
4424         } elseif {[regexp {^@@} $line]} {
4425             $ctext insert end "$line\n" hunksep
4426         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4427             # do nothing
4428         } else {
4429             # parse the prefix - one ' ', '-' or '+' for each parent
4430             set spaces {}
4431             set minuses {}
4432             set pluses {}
4433             set isbad 0
4434             for {set j 0} {$j < $np} {incr j} {
4435                 set c [string range $line $j $j]
4436                 if {$c == " "} {
4437                     lappend spaces $j
4438                 } elseif {$c == "-"} {
4439                     lappend minuses $j
4440                 } elseif {$c == "+"} {
4441                     lappend pluses $j
4442                 } else {
4443                     set isbad 1
4444                     break
4445                 }
4446             }
4447             set tags {}
4448             set num {}
4449             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4450                 # line doesn't appear in result, parents in $minuses have the line
4451                 set num [lindex $minuses 0]
4452             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4453                 # line appears in result, parents in $pluses don't have the line
4454                 lappend tags mresult
4455                 set num [lindex $spaces 0]
4456             }
4457             if {$num ne {}} {
4458                 if {$num >= $mergemax} {
4459                     set num "max"
4460                 }
4461                 lappend tags m$num
4462             }
4463             $ctext insert end "$line\n" $tags
4464         }
4465     }
4466     $ctext conf -state disabled
4467     if {[eof $mdf]} {
4468         close $mdf
4469         return 0
4470     }
4471     return [expr {$nr >= 1000? 2: 1}]
4472 }
4473
4474 proc startdiff {ids} {
4475     global treediffs diffids treepending diffmergeid
4476
4477     set diffids $ids
4478     catch {unset diffmergeid}
4479     if {![info exists treediffs($ids)]} {
4480         if {![info exists treepending]} {
4481             gettreediffs $ids
4482         }
4483     } else {
4484         addtocflist $ids
4485     }
4486 }
4487
4488 proc addtocflist {ids} {
4489     global treediffs cflist
4490     add_flist $treediffs($ids)
4491     getblobdiffs $ids
4492 }
4493
4494 proc gettreediffs {ids} {
4495     global treediff treepending
4496     set treepending $ids
4497     set treediff {}
4498     if {[catch \
4499          {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4500         ]} return
4501     fconfigure $gdtf -blocking 0
4502     filerun $gdtf [list gettreediffline $gdtf $ids]
4503 }
4504
4505 proc gettreediffline {gdtf ids} {
4506     global treediff treediffs treepending diffids diffmergeid
4507     global cmitmode
4508
4509     set nr 0
4510     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4511         set file [lindex $line 5]
4512         lappend treediff $file
4513     }
4514     if {![eof $gdtf]} {
4515         return [expr {$nr >= 1000? 2: 1}]
4516     }
4517     close $gdtf
4518     set treediffs($ids) $treediff
4519     unset treepending
4520     if {$cmitmode eq "tree"} {
4521         gettree $diffids
4522     } elseif {$ids != $diffids} {
4523         if {![info exists diffmergeid]} {
4524             gettreediffs $diffids
4525         }
4526     } else {
4527         addtocflist $ids
4528     }
4529     return 0
4530 }
4531
4532 proc getblobdiffs {ids} {
4533     global diffopts blobdifffd diffids env curdifftag curtagstart
4534     global diffinhdr treediffs
4535
4536     set env(GIT_DIFF_OPTS) $diffopts
4537     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4538     if {[catch {set bdf [open $cmd r]} err]} {
4539         puts "error getting diffs: $err"
4540         return
4541     }
4542     set diffinhdr 0
4543     fconfigure $bdf -blocking 0
4544     set blobdifffd($ids) $bdf
4545     set curdifftag Comments
4546     set curtagstart 0.0
4547     filerun $bdf [list getblobdiffline $bdf $diffids]
4548 }
4549
4550 proc setinlist {var i val} {
4551     global $var
4552
4553     while {[llength [set $var]] < $i} {
4554         lappend $var {}
4555     }
4556     if {[llength [set $var]] == $i} {
4557         lappend $var $val
4558     } else {
4559         lset $var $i $val
4560     }
4561 }
4562
4563 proc getblobdiffline {bdf ids} {
4564     global diffids blobdifffd ctext curdifftag curtagstart
4565     global diffnexthead diffnextnote difffilestart
4566     global diffinhdr treediffs
4567
4568     set nr 0
4569     $ctext conf -state normal
4570     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4571         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4572             close $bdf
4573             return 0
4574         }
4575         if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4576             # start of a new file
4577             $ctext insert end "\n"
4578             $ctext tag add $curdifftag $curtagstart end
4579             set here [$ctext index "end - 1c"]
4580             set curtagstart $here
4581             set header $newname
4582             set i [lsearch -exact $treediffs($ids) $fname]
4583             if {$i >= 0} {
4584                 setinlist difffilestart $i $here
4585             }
4586             if {$newname ne $fname} {
4587                 set i [lsearch -exact $treediffs($ids) $newname]
4588                 if {$i >= 0} {
4589                     setinlist difffilestart $i $here
4590                 }
4591             }
4592             set curdifftag "f:$fname"
4593             $ctext tag delete $curdifftag
4594             set l [expr {(78 - [string length $header]) / 2}]
4595             set pad [string range "----------------------------------------" \
4596                          1 $l]
4597             $ctext insert end "$pad $header $pad\n" filesep
4598             set diffinhdr 1
4599         } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4600             # do nothing
4601         } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4602             set diffinhdr 0
4603         } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4604                        $line match f1l f1c f2l f2c rest]} {
4605             $ctext insert end "$line\n" hunksep
4606             set diffinhdr 0
4607         } else {
4608             set x [string range $line 0 0]
4609             if {$x == "-" || $x == "+"} {
4610                 set tag [expr {$x == "+"}]
4611                 $ctext insert end "$line\n" d$tag
4612             } elseif {$x == " "} {
4613                 $ctext insert end "$line\n"
4614             } elseif {$diffinhdr || $x == "\\"} {
4615                 # e.g. "\ No newline at end of file"
4616                 $ctext insert end "$line\n" filesep
4617             } else {
4618                 # Something else we don't recognize
4619                 if {$curdifftag != "Comments"} {
4620                     $ctext insert end "\n"
4621                     $ctext tag add $curdifftag $curtagstart end
4622                     set curtagstart [$ctext index "end - 1c"]
4623                     set curdifftag Comments
4624                 }
4625                 $ctext insert end "$line\n" filesep
4626             }
4627         }
4628     }
4629     $ctext conf -state disabled
4630     if {[eof $bdf]} {
4631         close $bdf
4632         if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4633             $ctext tag add $curdifftag $curtagstart end
4634         }
4635         return 0
4636     }
4637     return [expr {$nr >= 1000? 2: 1}]
4638 }
4639
4640 proc changediffdisp {} {
4641     global ctext diffelide
4642
4643     $ctext tag conf d0 -elide [lindex $diffelide 0]
4644     $ctext tag conf d1 -elide [lindex $diffelide 1]
4645 }
4646
4647 proc prevfile {} {
4648     global difffilestart ctext
4649     set prev [lindex $difffilestart 0]
4650     set here [$ctext index @0,0]
4651     foreach loc $difffilestart {
4652         if {[$ctext compare $loc >= $here]} {
4653             $ctext yview $prev
4654             return
4655         }
4656         set prev $loc
4657     }
4658     $ctext yview $prev
4659 }
4660
4661 proc nextfile {} {
4662     global difffilestart ctext
4663     set here [$ctext index @0,0]
4664     foreach loc $difffilestart {
4665         if {[$ctext compare $loc > $here]} {
4666             $ctext yview $loc
4667             return
4668         }
4669     }
4670 }
4671
4672 proc clear_ctext {{first 1.0}} {
4673     global ctext smarktop smarkbot
4674
4675     set l [lindex [split $first .] 0]
4676     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4677         set smarktop $l
4678     }
4679     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4680         set smarkbot $l
4681     }
4682     $ctext delete $first end
4683 }
4684
4685 proc incrsearch {name ix op} {
4686     global ctext searchstring searchdirn
4687
4688     $ctext tag remove found 1.0 end
4689     if {[catch {$ctext index anchor}]} {
4690         # no anchor set, use start of selection, or of visible area
4691         set sel [$ctext tag ranges sel]
4692         if {$sel ne {}} {
4693             $ctext mark set anchor [lindex $sel 0]
4694         } elseif {$searchdirn eq "-forwards"} {
4695             $ctext mark set anchor @0,0
4696         } else {
4697             $ctext mark set anchor @0,[winfo height $ctext]
4698         }
4699     }
4700     if {$searchstring ne {}} {
4701         set here [$ctext search $searchdirn -- $searchstring anchor]
4702         if {$here ne {}} {
4703             $ctext see $here
4704         }
4705         searchmarkvisible 1
4706     }
4707 }
4708
4709 proc dosearch {} {
4710     global sstring ctext searchstring searchdirn
4711
4712     focus $sstring
4713     $sstring icursor end
4714     set searchdirn -forwards
4715     if {$searchstring ne {}} {
4716         set sel [$ctext tag ranges sel]
4717         if {$sel ne {}} {
4718             set start "[lindex $sel 0] + 1c"
4719         } elseif {[catch {set start [$ctext index anchor]}]} {
4720             set start "@0,0"
4721         }
4722         set match [$ctext search -count mlen -- $searchstring $start]
4723         $ctext tag remove sel 1.0 end
4724         if {$match eq {}} {
4725             bell
4726             return
4727         }
4728         $ctext see $match
4729         set mend "$match + $mlen c"
4730         $ctext tag add sel $match $mend
4731         $ctext mark unset anchor
4732     }
4733 }
4734
4735 proc dosearchback {} {
4736     global sstring ctext searchstring searchdirn
4737
4738     focus $sstring
4739     $sstring icursor end
4740     set searchdirn -backwards
4741     if {$searchstring ne {}} {
4742         set sel [$ctext tag ranges sel]
4743         if {$sel ne {}} {
4744             set start [lindex $sel 0]
4745         } elseif {[catch {set start [$ctext index anchor]}]} {
4746             set start @0,[winfo height $ctext]
4747         }
4748         set match [$ctext search -backwards -count ml -- $searchstring $start]
4749         $ctext tag remove sel 1.0 end
4750         if {$match eq {}} {
4751             bell
4752             return
4753         }
4754         $ctext see $match
4755         set mend "$match + $ml c"
4756         $ctext tag add sel $match $mend
4757         $ctext mark unset anchor
4758     }
4759 }
4760
4761 proc searchmark {first last} {
4762     global ctext searchstring
4763
4764     set mend $first.0
4765     while {1} {
4766         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4767         if {$match eq {}} break
4768         set mend "$match + $mlen c"
4769         $ctext tag add found $match $mend
4770     }
4771 }
4772
4773 proc searchmarkvisible {doall} {
4774     global ctext smarktop smarkbot
4775
4776     set topline [lindex [split [$ctext index @0,0] .] 0]
4777     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4778     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4779         # no overlap with previous
4780         searchmark $topline $botline
4781         set smarktop $topline
4782         set smarkbot $botline
4783     } else {
4784         if {$topline < $smarktop} {
4785             searchmark $topline [expr {$smarktop-1}]
4786             set smarktop $topline
4787         }
4788         if {$botline > $smarkbot} {
4789             searchmark [expr {$smarkbot+1}] $botline
4790             set smarkbot $botline
4791         }
4792     }
4793 }
4794
4795 proc scrolltext {f0 f1} {
4796     global searchstring
4797
4798     .bleft.sb set $f0 $f1
4799     if {$searchstring ne {}} {
4800         searchmarkvisible 0
4801     }
4802 }
4803
4804 proc setcoords {} {
4805     global linespc charspc canvx0 canvy0 mainfont
4806     global xspc1 xspc2 lthickness
4807
4808     set linespc [font metrics $mainfont -linespace]
4809     set charspc [font measure $mainfont "m"]
4810     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4811     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4812     set lthickness [expr {int($linespc / 9) + 1}]
4813     set xspc1(0) $linespc
4814     set xspc2 $linespc
4815 }
4816
4817 proc redisplay {} {
4818     global canv
4819     global selectedline
4820
4821     set ymax [lindex [$canv cget -scrollregion] 3]
4822     if {$ymax eq {} || $ymax == 0} return
4823     set span [$canv yview]
4824     clear_display
4825     setcanvscroll
4826     allcanvs yview moveto [lindex $span 0]
4827     drawvisible
4828     if {[info exists selectedline]} {
4829         selectline $selectedline 0
4830         allcanvs yview moveto [lindex $span 0]
4831     }
4832 }
4833
4834 proc incrfont {inc} {
4835     global mainfont textfont ctext canv phase cflist
4836     global charspc tabstop
4837     global stopped entries
4838     unmarkmatches
4839     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4840     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4841     setcoords
4842     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
4843     $cflist conf -font $textfont
4844     $ctext tag conf filesep -font [concat $textfont bold]
4845     foreach e $entries {
4846         $e conf -font $mainfont
4847     }
4848     if {$phase eq "getcommits"} {
4849         $canv itemconf textitems -font $mainfont
4850     }
4851     redisplay
4852 }
4853
4854 proc clearsha1 {} {
4855     global sha1entry sha1string
4856     if {[string length $sha1string] == 40} {
4857         $sha1entry delete 0 end
4858     }
4859 }
4860
4861 proc sha1change {n1 n2 op} {
4862     global sha1string currentid sha1but
4863     if {$sha1string == {}
4864         || ([info exists currentid] && $sha1string == $currentid)} {
4865         set state disabled
4866     } else {
4867         set state normal
4868     }
4869     if {[$sha1but cget -state] == $state} return
4870     if {$state == "normal"} {
4871         $sha1but conf -state normal -relief raised -text "Goto: "
4872     } else {
4873         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4874     }
4875 }
4876
4877 proc gotocommit {} {
4878     global sha1string currentid commitrow tagids headids
4879     global displayorder numcommits curview
4880
4881     if {$sha1string == {}
4882         || ([info exists currentid] && $sha1string == $currentid)} return
4883     if {[info exists tagids($sha1string)]} {
4884         set id $tagids($sha1string)
4885     } elseif {[info exists headids($sha1string)]} {
4886         set id $headids($sha1string)
4887     } else {
4888         set id [string tolower $sha1string]
4889         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4890             set matches {}
4891             foreach i $displayorder {
4892                 if {[string match $id* $i]} {
4893                     lappend matches $i
4894                 }
4895             }
4896             if {$matches ne {}} {
4897                 if {[llength $matches] > 1} {
4898                     error_popup "Short SHA1 id $id is ambiguous"
4899                     return
4900                 }
4901                 set id [lindex $matches 0]
4902             }
4903         }
4904     }
4905     if {[info exists commitrow($curview,$id)]} {
4906         selectline $commitrow($curview,$id) 1
4907         return
4908     }
4909     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4910         set type "SHA1 id"
4911     } else {
4912         set type "Tag/Head"
4913     }
4914     error_popup "$type $sha1string is not known"
4915 }
4916
4917 proc lineenter {x y id} {
4918     global hoverx hovery hoverid hovertimer
4919     global commitinfo canv
4920
4921     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4922     set hoverx $x
4923     set hovery $y
4924     set hoverid $id
4925     if {[info exists hovertimer]} {
4926         after cancel $hovertimer
4927     }
4928     set hovertimer [after 500 linehover]
4929     $canv delete hover
4930 }
4931
4932 proc linemotion {x y id} {
4933     global hoverx hovery hoverid hovertimer
4934
4935     if {[info exists hoverid] && $id == $hoverid} {
4936         set hoverx $x
4937         set hovery $y
4938         if {[info exists hovertimer]} {
4939             after cancel $hovertimer
4940         }
4941         set hovertimer [after 500 linehover]
4942     }
4943 }
4944
4945 proc lineleave {id} {
4946     global hoverid hovertimer canv
4947
4948     if {[info exists hoverid] && $id == $hoverid} {
4949         $canv delete hover
4950         if {[info exists hovertimer]} {
4951             after cancel $hovertimer
4952             unset hovertimer
4953         }
4954         unset hoverid
4955     }
4956 }
4957
4958 proc linehover {} {
4959     global hoverx hovery hoverid hovertimer
4960     global canv linespc lthickness
4961     global commitinfo mainfont
4962
4963     set text [lindex $commitinfo($hoverid) 0]
4964     set ymax [lindex [$canv cget -scrollregion] 3]
4965     if {$ymax == {}} return
4966     set yfrac [lindex [$canv yview] 0]
4967     set x [expr {$hoverx + 2 * $linespc}]
4968     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4969     set x0 [expr {$x - 2 * $lthickness}]
4970     set y0 [expr {$y - 2 * $lthickness}]
4971     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4972     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4973     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4974                -fill \#ffff80 -outline black -width 1 -tags hover]
4975     $canv raise $t
4976     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4977                -font $mainfont]
4978     $canv raise $t
4979 }
4980
4981 proc clickisonarrow {id y} {
4982     global lthickness
4983
4984     set ranges [rowranges $id]
4985     set thresh [expr {2 * $lthickness + 6}]
4986     set n [expr {[llength $ranges] - 1}]
4987     for {set i 1} {$i < $n} {incr i} {
4988         set row [lindex $ranges $i]
4989         if {abs([yc $row] - $y) < $thresh} {
4990             return $i
4991         }
4992     }
4993     return {}
4994 }
4995
4996 proc arrowjump {id n y} {
4997     global canv
4998
4999     # 1 <-> 2, 3 <-> 4, etc...
5000     set n [expr {(($n - 1) ^ 1) + 1}]
5001     set row [lindex [rowranges $id] $n]
5002     set yt [yc $row]
5003     set ymax [lindex [$canv cget -scrollregion] 3]
5004     if {$ymax eq {} || $ymax <= 0} return
5005     set view [$canv yview]
5006     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5007     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5008     if {$yfrac < 0} {
5009         set yfrac 0
5010     }
5011     allcanvs yview moveto $yfrac
5012 }
5013
5014 proc lineclick {x y id isnew} {
5015     global ctext commitinfo children canv thickerline curview
5016
5017     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5018     unmarkmatches
5019     unselectline
5020     normalline
5021     $canv delete hover
5022     # draw this line thicker than normal
5023     set thickerline $id
5024     drawlines $id
5025     if {$isnew} {
5026         set ymax [lindex [$canv cget -scrollregion] 3]
5027         if {$ymax eq {}} return
5028         set yfrac [lindex [$canv yview] 0]
5029         set y [expr {$y + $yfrac * $ymax}]
5030     }
5031     set dirn [clickisonarrow $id $y]
5032     if {$dirn ne {}} {
5033         arrowjump $id $dirn $y
5034         return
5035     }
5036
5037     if {$isnew} {
5038         addtohistory [list lineclick $x $y $id 0]
5039     }
5040     # fill the details pane with info about this line
5041     $ctext conf -state normal
5042     clear_ctext
5043     $ctext tag conf link -foreground blue -underline 1
5044     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5045     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5046     $ctext insert end "Parent:\t"
5047     $ctext insert end $id [list link link0]
5048     $ctext tag bind link0 <1> [list selbyid $id]
5049     set info $commitinfo($id)
5050     $ctext insert end "\n\t[lindex $info 0]\n"
5051     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5052     set date [formatdate [lindex $info 2]]
5053     $ctext insert end "\tDate:\t$date\n"
5054     set kids $children($curview,$id)
5055     if {$kids ne {}} {
5056         $ctext insert end "\nChildren:"
5057         set i 0
5058         foreach child $kids {
5059             incr i
5060             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5061             set info $commitinfo($child)
5062             $ctext insert end "\n\t"
5063             $ctext insert end $child [list link link$i]
5064             $ctext tag bind link$i <1> [list selbyid $child]
5065             $ctext insert end "\n\t[lindex $info 0]"
5066             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5067             set date [formatdate [lindex $info 2]]
5068             $ctext insert end "\n\tDate:\t$date\n"
5069         }
5070     }
5071     $ctext conf -state disabled
5072     init_flist {}
5073 }
5074
5075 proc normalline {} {
5076     global thickerline
5077     if {[info exists thickerline]} {
5078         set id $thickerline
5079         unset thickerline
5080         drawlines $id
5081     }
5082 }
5083
5084 proc selbyid {id} {
5085     global commitrow curview
5086     if {[info exists commitrow($curview,$id)]} {
5087         selectline $commitrow($curview,$id) 1
5088     }
5089 }
5090
5091 proc mstime {} {
5092     global startmstime
5093     if {![info exists startmstime]} {
5094         set startmstime [clock clicks -milliseconds]
5095     }
5096     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5097 }
5098
5099 proc rowmenu {x y id} {
5100     global rowctxmenu commitrow selectedline rowmenuid curview
5101
5102     if {![info exists selectedline]
5103         || $commitrow($curview,$id) eq $selectedline} {
5104         set state disabled
5105     } else {
5106         set state normal
5107     }
5108     $rowctxmenu entryconfigure "Diff this*" -state $state
5109     $rowctxmenu entryconfigure "Diff selected*" -state $state
5110     $rowctxmenu entryconfigure "Make patch" -state $state
5111     set rowmenuid $id
5112     tk_popup $rowctxmenu $x $y
5113 }
5114
5115 proc diffvssel {dirn} {
5116     global rowmenuid selectedline displayorder
5117
5118     if {![info exists selectedline]} return
5119     if {$dirn} {
5120         set oldid [lindex $displayorder $selectedline]
5121         set newid $rowmenuid
5122     } else {
5123         set oldid $rowmenuid
5124         set newid [lindex $displayorder $selectedline]
5125     }
5126     addtohistory [list doseldiff $oldid $newid]
5127     doseldiff $oldid $newid
5128 }
5129
5130 proc doseldiff {oldid newid} {
5131     global ctext
5132     global commitinfo
5133
5134     $ctext conf -state normal
5135     clear_ctext
5136     init_flist "Top"
5137     $ctext insert end "From "
5138     $ctext tag conf link -foreground blue -underline 1
5139     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5140     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5141     $ctext tag bind link0 <1> [list selbyid $oldid]
5142     $ctext insert end $oldid [list link link0]
5143     $ctext insert end "\n     "
5144     $ctext insert end [lindex $commitinfo($oldid) 0]
5145     $ctext insert end "\n\nTo   "
5146     $ctext tag bind link1 <1> [list selbyid $newid]
5147     $ctext insert end $newid [list link link1]
5148     $ctext insert end "\n     "
5149     $ctext insert end [lindex $commitinfo($newid) 0]
5150     $ctext insert end "\n"
5151     $ctext conf -state disabled
5152     $ctext tag delete Comments
5153     $ctext tag remove found 1.0 end
5154     startdiff [list $oldid $newid]
5155 }
5156
5157 proc mkpatch {} {
5158     global rowmenuid currentid commitinfo patchtop patchnum
5159
5160     if {![info exists currentid]} return
5161     set oldid $currentid
5162     set oldhead [lindex $commitinfo($oldid) 0]
5163     set newid $rowmenuid
5164     set newhead [lindex $commitinfo($newid) 0]
5165     set top .patch
5166     set patchtop $top
5167     catch {destroy $top}
5168     toplevel $top
5169     label $top.title -text "Generate patch"
5170     grid $top.title - -pady 10
5171     label $top.from -text "From:"
5172     entry $top.fromsha1 -width 40 -relief flat
5173     $top.fromsha1 insert 0 $oldid
5174     $top.fromsha1 conf -state readonly
5175     grid $top.from $top.fromsha1 -sticky w
5176     entry $top.fromhead -width 60 -relief flat
5177     $top.fromhead insert 0 $oldhead
5178     $top.fromhead conf -state readonly
5179     grid x $top.fromhead -sticky w
5180     label $top.to -text "To:"
5181     entry $top.tosha1 -width 40 -relief flat
5182     $top.tosha1 insert 0 $newid
5183     $top.tosha1 conf -state readonly
5184     grid $top.to $top.tosha1 -sticky w
5185     entry $top.tohead -width 60 -relief flat
5186     $top.tohead insert 0 $newhead
5187     $top.tohead conf -state readonly
5188     grid x $top.tohead -sticky w
5189     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5190     grid $top.rev x -pady 10
5191     label $top.flab -text "Output file:"
5192     entry $top.fname -width 60
5193     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5194     incr patchnum
5195     grid $top.flab $top.fname -sticky w
5196     frame $top.buts
5197     button $top.buts.gen -text "Generate" -command mkpatchgo
5198     button $top.buts.can -text "Cancel" -command mkpatchcan
5199     grid $top.buts.gen $top.buts.can
5200     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5201     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5202     grid $top.buts - -pady 10 -sticky ew
5203     focus $top.fname
5204 }
5205
5206 proc mkpatchrev {} {
5207     global patchtop
5208
5209     set oldid [$patchtop.fromsha1 get]
5210     set oldhead [$patchtop.fromhead get]
5211     set newid [$patchtop.tosha1 get]
5212     set newhead [$patchtop.tohead get]
5213     foreach e [list fromsha1 fromhead tosha1 tohead] \
5214             v [list $newid $newhead $oldid $oldhead] {
5215         $patchtop.$e conf -state normal
5216         $patchtop.$e delete 0 end
5217         $patchtop.$e insert 0 $v
5218         $patchtop.$e conf -state readonly
5219     }
5220 }
5221
5222 proc mkpatchgo {} {
5223     global patchtop
5224
5225     set oldid [$patchtop.fromsha1 get]
5226     set newid [$patchtop.tosha1 get]
5227     set fname [$patchtop.fname get]
5228     if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5229         error_popup "Error creating patch: $err"
5230     }
5231     catch {destroy $patchtop}
5232     unset patchtop
5233 }
5234
5235 proc mkpatchcan {} {
5236     global patchtop
5237
5238     catch {destroy $patchtop}
5239     unset patchtop
5240 }
5241
5242 proc mktag {} {
5243     global rowmenuid mktagtop commitinfo
5244
5245     set top .maketag
5246     set mktagtop $top
5247     catch {destroy $top}
5248     toplevel $top
5249     label $top.title -text "Create tag"
5250     grid $top.title - -pady 10
5251     label $top.id -text "ID:"
5252     entry $top.sha1 -width 40 -relief flat
5253     $top.sha1 insert 0 $rowmenuid
5254     $top.sha1 conf -state readonly
5255     grid $top.id $top.sha1 -sticky w
5256     entry $top.head -width 60 -relief flat
5257     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5258     $top.head conf -state readonly
5259     grid x $top.head -sticky w
5260     label $top.tlab -text "Tag name:"
5261     entry $top.tag -width 60
5262     grid $top.tlab $top.tag -sticky w
5263     frame $top.buts
5264     button $top.buts.gen -text "Create" -command mktaggo
5265     button $top.buts.can -text "Cancel" -command mktagcan
5266     grid $top.buts.gen $top.buts.can
5267     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5268     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5269     grid $top.buts - -pady 10 -sticky ew
5270     focus $top.tag
5271 }
5272
5273 proc domktag {} {
5274     global mktagtop env tagids idtags
5275
5276     set id [$mktagtop.sha1 get]
5277     set tag [$mktagtop.tag get]
5278     if {$tag == {}} {
5279         error_popup "No tag name specified"
5280         return
5281     }
5282     if {[info exists tagids($tag)]} {
5283         error_popup "Tag \"$tag\" already exists"
5284         return
5285     }
5286     if {[catch {
5287         set dir [gitdir]
5288         set fname [file join $dir "refs/tags" $tag]
5289         set f [open $fname w]
5290         puts $f $id
5291         close $f
5292     } err]} {
5293         error_popup "Error creating tag: $err"
5294         return
5295     }
5296
5297     set tagids($tag) $id
5298     lappend idtags($id) $tag
5299     redrawtags $id
5300     addedtag $id
5301 }
5302
5303 proc redrawtags {id} {
5304     global canv linehtag commitrow idpos selectedline curview
5305     global mainfont canvxmax
5306
5307     if {![info exists commitrow($curview,$id)]} return
5308     drawcmitrow $commitrow($curview,$id)
5309     $canv delete tag.$id
5310     set xt [eval drawtags $id $idpos($id)]
5311     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5312     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5313     set xr [expr {$xt + [font measure $mainfont $text]}]
5314     if {$xr > $canvxmax} {
5315         set canvxmax $xr
5316         setcanvscroll
5317     }
5318     if {[info exists selectedline]
5319         && $selectedline == $commitrow($curview,$id)} {
5320         selectline $selectedline 0
5321     }
5322 }
5323
5324 proc mktagcan {} {
5325     global mktagtop
5326
5327     catch {destroy $mktagtop}
5328     unset mktagtop
5329 }
5330
5331 proc mktaggo {} {
5332     domktag
5333     mktagcan
5334 }
5335
5336 proc writecommit {} {
5337     global rowmenuid wrcomtop commitinfo wrcomcmd
5338
5339     set top .writecommit
5340     set wrcomtop $top
5341     catch {destroy $top}
5342     toplevel $top
5343     label $top.title -text "Write commit to file"
5344     grid $top.title - -pady 10
5345     label $top.id -text "ID:"
5346     entry $top.sha1 -width 40 -relief flat
5347     $top.sha1 insert 0 $rowmenuid
5348     $top.sha1 conf -state readonly
5349     grid $top.id $top.sha1 -sticky w
5350     entry $top.head -width 60 -relief flat
5351     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5352     $top.head conf -state readonly
5353     grid x $top.head -sticky w
5354     label $top.clab -text "Command:"
5355     entry $top.cmd -width 60 -textvariable wrcomcmd
5356     grid $top.clab $top.cmd -sticky w -pady 10
5357     label $top.flab -text "Output file:"
5358     entry $top.fname -width 60
5359     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5360     grid $top.flab $top.fname -sticky w
5361     frame $top.buts
5362     button $top.buts.gen -text "Write" -command wrcomgo
5363     button $top.buts.can -text "Cancel" -command wrcomcan
5364     grid $top.buts.gen $top.buts.can
5365     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5366     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5367     grid $top.buts - -pady 10 -sticky ew
5368     focus $top.fname
5369 }
5370
5371 proc wrcomgo {} {
5372     global wrcomtop
5373
5374     set id [$wrcomtop.sha1 get]
5375     set cmd "echo $id | [$wrcomtop.cmd get]"
5376     set fname [$wrcomtop.fname get]
5377     if {[catch {exec sh -c $cmd >$fname &} err]} {
5378         error_popup "Error writing commit: $err"
5379     }
5380     catch {destroy $wrcomtop}
5381     unset wrcomtop
5382 }
5383
5384 proc wrcomcan {} {
5385     global wrcomtop
5386
5387     catch {destroy $wrcomtop}
5388     unset wrcomtop
5389 }
5390
5391 proc mkbranch {} {
5392     global rowmenuid mkbrtop
5393
5394     set top .makebranch
5395     catch {destroy $top}
5396     toplevel $top
5397     label $top.title -text "Create new branch"
5398     grid $top.title - -pady 10
5399     label $top.id -text "ID:"
5400     entry $top.sha1 -width 40 -relief flat
5401     $top.sha1 insert 0 $rowmenuid
5402     $top.sha1 conf -state readonly
5403     grid $top.id $top.sha1 -sticky w
5404     label $top.nlab -text "Name:"
5405     entry $top.name -width 40
5406     grid $top.nlab $top.name -sticky w
5407     frame $top.buts
5408     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5409     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5410     grid $top.buts.go $top.buts.can
5411     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5412     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5413     grid $top.buts - -pady 10 -sticky ew
5414     focus $top.name
5415 }
5416
5417 proc mkbrgo {top} {
5418     global headids idheads
5419
5420     set name [$top.name get]
5421     set id [$top.sha1 get]
5422     if {$name eq {}} {
5423         error_popup "Please specify a name for the new branch"
5424         return
5425     }
5426     catch {destroy $top}
5427     nowbusy newbranch
5428     update
5429     if {[catch {
5430         exec git branch $name $id
5431     } err]} {
5432         notbusy newbranch
5433         error_popup $err
5434     } else {
5435         set headids($name) $id
5436         lappend idheads($id) $name
5437         addedhead $id $name
5438         notbusy newbranch
5439         redrawtags $id
5440         dispneartags 0
5441     }
5442 }
5443
5444 proc cherrypick {} {
5445     global rowmenuid curview commitrow
5446     global mainhead
5447
5448     set oldhead [exec git rev-parse HEAD]
5449     set dheads [descheads $rowmenuid]
5450     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5451         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5452                         included in branch $mainhead -- really re-apply it?"]
5453         if {!$ok} return
5454     }
5455     nowbusy cherrypick
5456     update
5457     # Unfortunately git-cherry-pick writes stuff to stderr even when
5458     # no error occurs, and exec takes that as an indication of error...
5459     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5460         notbusy cherrypick
5461         error_popup $err
5462         return
5463     }
5464     set newhead [exec git rev-parse HEAD]
5465     if {$newhead eq $oldhead} {
5466         notbusy cherrypick
5467         error_popup "No changes committed"
5468         return
5469     }
5470     addnewchild $newhead $oldhead
5471     if {[info exists commitrow($curview,$oldhead)]} {
5472         insertrow $commitrow($curview,$oldhead) $newhead
5473         if {$mainhead ne {}} {
5474             movehead $newhead $mainhead
5475             movedhead $newhead $mainhead
5476         }
5477         redrawtags $oldhead
5478         redrawtags $newhead
5479     }
5480     notbusy cherrypick
5481 }
5482
5483 # context menu for a head
5484 proc headmenu {x y id head} {
5485     global headmenuid headmenuhead headctxmenu mainhead
5486
5487     set headmenuid $id
5488     set headmenuhead $head
5489     set state normal
5490     if {$head eq $mainhead} {
5491         set state disabled
5492     }
5493     $headctxmenu entryconfigure 0 -state $state
5494     $headctxmenu entryconfigure 1 -state $state
5495     tk_popup $headctxmenu $x $y
5496 }
5497
5498 proc cobranch {} {
5499     global headmenuid headmenuhead mainhead headids
5500
5501     # check the tree is clean first??
5502     set oldmainhead $mainhead
5503     nowbusy checkout
5504     update
5505     if {[catch {
5506         exec git checkout -q $headmenuhead
5507     } err]} {
5508         notbusy checkout
5509         error_popup $err
5510     } else {
5511         notbusy checkout
5512         set mainhead $headmenuhead
5513         if {[info exists headids($oldmainhead)]} {
5514             redrawtags $headids($oldmainhead)
5515         }
5516         redrawtags $headmenuid
5517     }
5518 }
5519
5520 proc rmbranch {} {
5521     global headmenuid headmenuhead mainhead
5522     global headids idheads
5523
5524     set head $headmenuhead
5525     set id $headmenuid
5526     # this check shouldn't be needed any more...
5527     if {$head eq $mainhead} {
5528         error_popup "Cannot delete the currently checked-out branch"
5529         return
5530     }
5531     set dheads [descheads $id]
5532     if {$dheads eq $headids($head)} {
5533         # the stuff on this branch isn't on any other branch
5534         if {![confirm_popup "The commits on branch $head aren't on any other\
5535                         branch.\nReally delete branch $head?"]} return
5536     }
5537     nowbusy rmbranch
5538     update
5539     if {[catch {exec git branch -D $head} err]} {
5540         notbusy rmbranch
5541         error_popup $err
5542         return
5543     }
5544     removehead $id $head
5545     removedhead $id $head
5546     redrawtags $id
5547     notbusy rmbranch
5548     dispneartags 0
5549 }
5550
5551 # Stuff for finding nearby tags
5552 proc getallcommits {} {
5553     global allcommits allids nbmp nextarc seeds
5554
5555     set allids {}
5556     set nbmp 0
5557     set nextarc 0
5558     set allcommits 0
5559     set seeds {}
5560     regetallcommits
5561 }
5562
5563 # Called when the graph might have changed
5564 proc regetallcommits {} {
5565     global allcommits seeds
5566
5567     set cmd [concat | git rev-list --all --parents]
5568     foreach id $seeds {
5569         lappend cmd "^$id"
5570     }
5571     set fd [open $cmd r]
5572     fconfigure $fd -blocking 0
5573     incr allcommits
5574     nowbusy allcommits
5575     filerun $fd [list getallclines $fd]
5576 }
5577
5578 # Since most commits have 1 parent and 1 child, we group strings of
5579 # such commits into "arcs" joining branch/merge points (BMPs), which
5580 # are commits that either don't have 1 parent or don't have 1 child.
5581 #
5582 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5583 # arcout(id) - outgoing arcs for BMP
5584 # arcids(a) - list of IDs on arc including end but not start
5585 # arcstart(a) - BMP ID at start of arc
5586 # arcend(a) - BMP ID at end of arc
5587 # growing(a) - arc a is still growing
5588 # arctags(a) - IDs out of arcids (excluding end) that have tags
5589 # archeads(a) - IDs out of arcids (excluding end) that have heads
5590 # The start of an arc is at the descendent end, so "incoming" means
5591 # coming from descendents, and "outgoing" means going towards ancestors.
5592
5593 proc getallclines {fd} {
5594     global allids allparents allchildren idtags nextarc nbmp
5595     global arcnos arcids arctags arcout arcend arcstart archeads growing
5596     global seeds allcommits
5597
5598     set nid 0
5599     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
5600         set id [lindex $line 0]
5601         if {[info exists allparents($id)]} {
5602             # seen it already
5603             continue
5604         }
5605         lappend allids $id
5606         set olds [lrange $line 1 end]
5607         set allparents($id) $olds
5608         if {![info exists allchildren($id)]} {
5609             set allchildren($id) {}
5610             set arcnos($id) {}
5611             lappend seeds $id
5612         } else {
5613             set a $arcnos($id)
5614             if {[llength $olds] == 1 && [llength $a] == 1} {
5615                 lappend arcids($a) $id
5616                 if {[info exists idtags($id)]} {
5617                     lappend arctags($a) $id
5618                 }
5619                 if {[info exists idheads($id)]} {
5620                     lappend archeads($a) $id
5621                 }
5622                 if {[info exists allparents($olds)]} {
5623                     # seen parent already
5624                     if {![info exists arcout($olds)]} {
5625                         splitarc $olds
5626                     }
5627                     lappend arcids($a) $olds
5628                     set arcend($a) $olds
5629                     unset growing($a)
5630                 }
5631                 lappend allchildren($olds) $id
5632                 lappend arcnos($olds) $a
5633                 continue
5634             }
5635         }
5636         incr nbmp
5637         foreach a $arcnos($id) {
5638             lappend arcids($a) $id
5639             set arcend($a) $id
5640             unset growing($a)
5641         }
5642
5643         set ao {}
5644         foreach p $olds {
5645             lappend allchildren($p) $id
5646             set a [incr nextarc]
5647             set arcstart($a) $id
5648             set archeads($a) {}
5649             set arctags($a) {}
5650             set archeads($a) {}
5651             set arcids($a) {}
5652             lappend ao $a
5653             set growing($a) 1
5654             if {[info exists allparents($p)]} {
5655                 # seen it already, may need to make a new branch
5656                 if {![info exists arcout($p)]} {
5657                     splitarc $p
5658                 }
5659                 lappend arcids($a) $p
5660                 set arcend($a) $p
5661                 unset growing($a)
5662             }
5663             lappend arcnos($p) $a
5664         }
5665         set arcout($id) $ao
5666     }
5667     if {![eof $fd]} {
5668         return [expr {$nid >= 1000? 2: 1}]
5669     }
5670     close $fd
5671     if {[incr allcommits -1] == 0} {
5672         notbusy allcommits
5673     }
5674     dispneartags 0
5675     return 0
5676 }
5677
5678 proc recalcarc {a} {
5679     global arctags archeads arcids idtags idheads
5680
5681     set at {}
5682     set ah {}
5683     foreach id [lrange $arcids($a) 0 end-1] {
5684         if {[info exists idtags($id)]} {
5685             lappend at $id
5686         }
5687         if {[info exists idheads($id)]} {
5688             lappend ah $id
5689         }
5690     }
5691     set arctags($a) $at
5692     set archeads($a) $ah
5693 }
5694
5695 proc splitarc {p} {
5696     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
5697     global arcstart arcend arcout allparents growing
5698
5699     set a $arcnos($p)
5700     if {[llength $a] != 1} {
5701         puts "oops splitarc called but [llength $a] arcs already"
5702         return
5703     }
5704     set a [lindex $a 0]
5705     set i [lsearch -exact $arcids($a) $p]
5706     if {$i < 0} {
5707         puts "oops splitarc $p not in arc $a"
5708         return
5709     }
5710     set na [incr nextarc]
5711     if {[info exists arcend($a)]} {
5712         set arcend($na) $arcend($a)
5713     } else {
5714         set l [lindex $allparents([lindex $arcids($a) end]) 0]
5715         set j [lsearch -exact $arcnos($l) $a]
5716         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
5717     }
5718     set tail [lrange $arcids($a) [expr {$i+1}] end]
5719     set arcids($a) [lrange $arcids($a) 0 $i]
5720     set arcend($a) $p
5721     set arcstart($na) $p
5722     set arcout($p) $na
5723     set arcids($na) $tail
5724     if {[info exists growing($a)]} {
5725         set growing($na) 1
5726         unset growing($a)
5727     }
5728     incr nbmp
5729
5730     foreach id $tail {
5731         if {[llength $arcnos($id)] == 1} {
5732             set arcnos($id) $na
5733         } else {
5734             set j [lsearch -exact $arcnos($id) $a]
5735             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
5736         }
5737     }
5738
5739     # reconstruct tags and heads lists
5740     if {$arctags($a) ne {} || $archeads($a) ne {}} {
5741         recalcarc $a
5742         recalcarc $na
5743     } else {
5744         set arctags($na) {}
5745         set archeads($na) {}
5746     }
5747 }
5748
5749 # Update things for a new commit added that is a child of one
5750 # existing commit.  Used when cherry-picking.
5751 proc addnewchild {id p} {
5752     global allids allparents allchildren idtags nextarc nbmp
5753     global arcnos arcids arctags arcout arcend arcstart archeads growing
5754     global seeds
5755
5756     lappend allids $id
5757     set allparents($id) [list $p]
5758     set allchildren($id) {}
5759     set arcnos($id) {}
5760     lappend seeds $id
5761     incr nbmp
5762     lappend allchildren($p) $id
5763     set a [incr nextarc]
5764     set arcstart($a) $id
5765     set archeads($a) {}
5766     set arctags($a) {}
5767     set arcids($a) [list $p]
5768     set arcend($a) $p
5769     if {![info exists arcout($p)]} {
5770         splitarc $p
5771     }
5772     lappend arcnos($p) $a
5773     set arcout($id) [list $a]
5774 }
5775
5776 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
5777 # or 0 if neither is true.
5778 proc anc_or_desc {a b} {
5779     global arcout arcstart arcend arcnos cached_isanc
5780
5781     if {$arcnos($a) eq $arcnos($b)} {
5782         # Both are on the same arc(s); either both are the same BMP,
5783         # or if one is not a BMP, the other is also not a BMP or is
5784         # the BMP at end of the arc (and it only has 1 incoming arc).
5785         if {$a eq $b} {
5786             return 0
5787         }
5788         # assert {[llength $arcnos($a)] == 1}
5789         set arc [lindex $arcnos($a) 0]
5790         set i [lsearch -exact $arcids($arc) $a]
5791         set j [lsearch -exact $arcids($arc) $b]
5792         if {$i < 0 || $i > $j} {
5793             return 1
5794         } else {
5795             return -1
5796         }
5797     }
5798
5799     if {![info exists arcout($a)]} {
5800         set arc [lindex $arcnos($a) 0]
5801         if {[info exists arcend($arc)]} {
5802             set aend $arcend($arc)
5803         } else {
5804             set aend {}
5805         }
5806         set a $arcstart($arc)
5807     } else {
5808         set aend $a
5809     }
5810     if {![info exists arcout($b)]} {
5811         set arc [lindex $arcnos($b) 0]
5812         if {[info exists arcend($arc)]} {
5813             set bend $arcend($arc)
5814         } else {
5815             set bend {}
5816         }
5817         set b $arcstart($arc)
5818     } else {
5819         set bend $b
5820     }
5821     if {$a eq $bend} {
5822         return 1
5823     }
5824     if {$b eq $aend} {
5825         return -1
5826     }
5827     if {[info exists cached_isanc($a,$bend)]} {
5828         if {$cached_isanc($a,$bend)} {
5829             return 1
5830         }
5831     }
5832     if {[info exists cached_isanc($b,$aend)]} {
5833         if {$cached_isanc($b,$aend)} {
5834             return -1
5835         }
5836         if {[info exists cached_isanc($a,$bend)]} {
5837             return 0
5838         }
5839     }
5840
5841     set todo [list $a $b]
5842     set anc($a) a
5843     set anc($b) b
5844     for {set i 0} {$i < [llength $todo]} {incr i} {
5845         set x [lindex $todo $i]
5846         if {$anc($x) eq {}} {
5847             continue
5848         }
5849         foreach arc $arcnos($x) {
5850             set xd $arcstart($arc)
5851             if {$xd eq $bend} {
5852                 set cached_isanc($a,$bend) 1
5853                 set cached_isanc($b,$aend) 0
5854                 return 1
5855             } elseif {$xd eq $aend} {
5856                 set cached_isanc($b,$aend) 1
5857                 set cached_isanc($a,$bend) 0
5858                 return -1
5859             }
5860             if {![info exists anc($xd)]} {
5861                 set anc($xd) $anc($x)
5862                 lappend todo $xd
5863             } elseif {$anc($xd) ne $anc($x)} {
5864                 set anc($xd) {}
5865             }
5866         }
5867     }
5868     set cached_isanc($a,$bend) 0
5869     set cached_isanc($b,$aend) 0
5870     return 0
5871 }
5872
5873 # This identifies whether $desc has an ancestor that is
5874 # a growing tip of the graph and which is not an ancestor of $anc
5875 # and returns 0 if so and 1 if not.
5876 # If we subsequently discover a tag on such a growing tip, and that
5877 # turns out to be a descendent of $anc (which it could, since we
5878 # don't necessarily see children before parents), then $desc
5879 # isn't a good choice to display as a descendent tag of
5880 # $anc (since it is the descendent of another tag which is
5881 # a descendent of $anc).  Similarly, $anc isn't a good choice to
5882 # display as a ancestor tag of $desc.
5883 #
5884 proc is_certain {desc anc} {
5885     global arcnos arcout arcstart arcend growing problems
5886
5887     set certain {}
5888     if {[llength $arcnos($anc)] == 1} {
5889         # tags on the same arc are certain
5890         if {$arcnos($desc) eq $arcnos($anc)} {
5891             return 1
5892         }
5893         if {![info exists arcout($anc)]} {
5894             # if $anc is partway along an arc, use the start of the arc instead
5895             set a [lindex $arcnos($anc) 0]
5896             set anc $arcstart($a)
5897         }
5898     }
5899     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
5900         set x $desc
5901     } else {
5902         set a [lindex $arcnos($desc) 0]
5903         set x $arcend($a)
5904     }
5905     if {$x == $anc} {
5906         return 1
5907     }
5908     set anclist [list $x]
5909     set dl($x) 1
5910     set nnh 1
5911     set ngrowanc 0
5912     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
5913         set x [lindex $anclist $i]
5914         if {$dl($x)} {
5915             incr nnh -1
5916         }
5917         set done($x) 1
5918         foreach a $arcout($x) {
5919             if {[info exists growing($a)]} {
5920                 if {![info exists growanc($x)] && $dl($x)} {
5921                     set growanc($x) 1
5922                     incr ngrowanc
5923                 }
5924             } else {
5925                 set y $arcend($a)
5926                 if {[info exists dl($y)]} {
5927                     if {$dl($y)} {
5928                         if {!$dl($x)} {
5929                             set dl($y) 0
5930                             if {![info exists done($y)]} {
5931                                 incr nnh -1
5932                             }
5933                             if {[info exists growanc($x)]} {
5934                                 incr ngrowanc -1
5935                             }
5936                             set xl [list $y]
5937                             for {set k 0} {$k < [llength $xl]} {incr k} {
5938                                 set z [lindex $xl $k]
5939                                 foreach c $arcout($z) {
5940                                     if {[info exists arcend($c)]} {
5941                                         set v $arcend($c)
5942                                         if {[info exists dl($v)] && $dl($v)} {
5943                                             set dl($v) 0
5944                                             if {![info exists done($v)]} {
5945                                                 incr nnh -1
5946                                             }
5947                                             if {[info exists growanc($v)]} {
5948                                                 incr ngrowanc -1
5949                                             }
5950                                             lappend xl $v
5951                                         }
5952                                     }
5953                                 }
5954                             }
5955                         }
5956                     }
5957                 } elseif {$y eq $anc || !$dl($x)} {
5958                     set dl($y) 0
5959                     lappend anclist $y
5960                 } else {
5961                     set dl($y) 1
5962                     lappend anclist $y
5963                     incr nnh
5964                 }
5965             }
5966         }
5967     }
5968     foreach x [array names growanc] {
5969         if {$dl($x)} {
5970             return 0
5971         }
5972         return 0
5973     }
5974     return 1
5975 }
5976
5977 proc validate_arctags {a} {
5978     global arctags idtags
5979
5980     set i -1
5981     set na $arctags($a)
5982     foreach id $arctags($a) {
5983         incr i
5984         if {![info exists idtags($id)]} {
5985             set na [lreplace $na $i $i]
5986             incr i -1
5987         }
5988     }
5989     set arctags($a) $na
5990 }
5991
5992 proc validate_archeads {a} {
5993     global archeads idheads
5994
5995     set i -1
5996     set na $archeads($a)
5997     foreach id $archeads($a) {
5998         incr i
5999         if {![info exists idheads($id)]} {
6000             set na [lreplace $na $i $i]
6001             incr i -1
6002         }
6003     }
6004     set archeads($a) $na
6005 }
6006
6007 # Return the list of IDs that have tags that are descendents of id,
6008 # ignoring IDs that are descendents of IDs already reported.
6009 proc desctags {id} {
6010     global arcnos arcstart arcids arctags idtags allparents
6011     global growing cached_dtags
6012
6013     if {![info exists allparents($id)]} {
6014         return {}
6015     }
6016     set t1 [clock clicks -milliseconds]
6017     set argid $id
6018     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6019         # part-way along an arc; check that arc first
6020         set a [lindex $arcnos($id) 0]
6021         if {$arctags($a) ne {}} {
6022             validate_arctags $a
6023             set i [lsearch -exact $arcids($a) $id]
6024             set tid {}
6025             foreach t $arctags($a) {
6026                 set j [lsearch -exact $arcids($a) $t]
6027                 if {$j >= $i} break
6028                 set tid $t
6029             }
6030             if {$tid ne {}} {
6031                 return $tid
6032             }
6033         }
6034         set id $arcstart($a)
6035         if {[info exists idtags($id)]} {
6036             return $id
6037         }
6038     }
6039     if {[info exists cached_dtags($id)]} {
6040         return $cached_dtags($id)
6041     }
6042
6043     set origid $id
6044     set todo [list $id]
6045     set queued($id) 1
6046     set nc 1
6047     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6048         set id [lindex $todo $i]
6049         set done($id) 1
6050         set ta [info exists hastaggedancestor($id)]
6051         if {!$ta} {
6052             incr nc -1
6053         }
6054         # ignore tags on starting node
6055         if {!$ta && $i > 0} {
6056             if {[info exists idtags($id)]} {
6057                 set tagloc($id) $id
6058                 set ta 1
6059             } elseif {[info exists cached_dtags($id)]} {
6060                 set tagloc($id) $cached_dtags($id)
6061                 set ta 1
6062             }
6063         }
6064         foreach a $arcnos($id) {
6065             set d $arcstart($a)
6066             if {!$ta && $arctags($a) ne {}} {
6067                 validate_arctags $a
6068                 if {$arctags($a) ne {}} {
6069                     lappend tagloc($id) [lindex $arctags($a) end]
6070                 }
6071             }
6072             if {$ta || $arctags($a) ne {}} {
6073                 set tomark [list $d]
6074                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6075                     set dd [lindex $tomark $j]
6076                     if {![info exists hastaggedancestor($dd)]} {
6077                         if {[info exists done($dd)]} {
6078                             foreach b $arcnos($dd) {
6079                                 lappend tomark $arcstart($b)
6080                             }
6081                             if {[info exists tagloc($dd)]} {
6082                                 unset tagloc($dd)
6083                             }
6084                         } elseif {[info exists queued($dd)]} {
6085                             incr nc -1
6086                         }
6087                         set hastaggedancestor($dd) 1
6088                     }
6089                 }
6090             }
6091             if {![info exists queued($d)]} {
6092                 lappend todo $d
6093                 set queued($d) 1
6094                 if {![info exists hastaggedancestor($d)]} {
6095                     incr nc
6096                 }
6097             }
6098         }
6099     }
6100     set tags {}
6101     foreach id [array names tagloc] {
6102         if {![info exists hastaggedancestor($id)]} {
6103             foreach t $tagloc($id) {
6104                 if {[lsearch -exact $tags $t] < 0} {
6105                     lappend tags $t
6106                 }
6107             }
6108         }
6109     }
6110     set t2 [clock clicks -milliseconds]
6111     set loopix $i
6112
6113     # remove tags that are descendents of other tags
6114     for {set i 0} {$i < [llength $tags]} {incr i} {
6115         set a [lindex $tags $i]
6116         for {set j 0} {$j < $i} {incr j} {
6117             set b [lindex $tags $j]
6118             set r [anc_or_desc $a $b]
6119             if {$r == 1} {
6120                 set tags [lreplace $tags $j $j]
6121                 incr j -1
6122                 incr i -1
6123             } elseif {$r == -1} {
6124                 set tags [lreplace $tags $i $i]
6125                 incr i -1
6126                 break
6127             }
6128         }
6129     }
6130
6131     if {[array names growing] ne {}} {
6132         # graph isn't finished, need to check if any tag could get
6133         # eclipsed by another tag coming later.  Simply ignore any
6134         # tags that could later get eclipsed.
6135         set ctags {}
6136         foreach t $tags {
6137             if {[is_certain $t $origid]} {
6138                 lappend ctags $t
6139             }
6140         }
6141         if {$tags eq $ctags} {
6142             set cached_dtags($origid) $tags
6143         } else {
6144             set tags $ctags
6145         }
6146     } else {
6147         set cached_dtags($origid) $tags
6148     }
6149     set t3 [clock clicks -milliseconds]
6150     if {0 && $t3 - $t1 >= 100} {
6151         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6152             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6153     }
6154     return $tags
6155 }
6156
6157 proc anctags {id} {
6158     global arcnos arcids arcout arcend arctags idtags allparents
6159     global growing cached_atags
6160
6161     if {![info exists allparents($id)]} {
6162         return {}
6163     }
6164     set t1 [clock clicks -milliseconds]
6165     set argid $id
6166     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6167         # part-way along an arc; check that arc first
6168         set a [lindex $arcnos($id) 0]
6169         if {$arctags($a) ne {}} {
6170             validate_arctags $a
6171             set i [lsearch -exact $arcids($a) $id]
6172             foreach t $arctags($a) {
6173                 set j [lsearch -exact $arcids($a) $t]
6174                 if {$j > $i} {
6175                     return $t
6176                 }
6177             }
6178         }
6179         if {![info exists arcend($a)]} {
6180             return {}
6181         }
6182         set id $arcend($a)
6183         if {[info exists idtags($id)]} {
6184             return $id
6185         }
6186     }
6187     if {[info exists cached_atags($id)]} {
6188         return $cached_atags($id)
6189     }
6190
6191     set origid $id
6192     set todo [list $id]
6193     set queued($id) 1
6194     set taglist {}
6195     set nc 1
6196     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6197         set id [lindex $todo $i]
6198         set done($id) 1
6199         set td [info exists hastaggeddescendent($id)]
6200         if {!$td} {
6201             incr nc -1
6202         }
6203         # ignore tags on starting node
6204         if {!$td && $i > 0} {
6205             if {[info exists idtags($id)]} {
6206                 set tagloc($id) $id
6207                 set td 1
6208             } elseif {[info exists cached_atags($id)]} {
6209                 set tagloc($id) $cached_atags($id)
6210                 set td 1
6211             }
6212         }
6213         foreach a $arcout($id) {
6214             if {!$td && $arctags($a) ne {}} {
6215                 validate_arctags $a
6216                 if {$arctags($a) ne {}} {
6217                     lappend tagloc($id) [lindex $arctags($a) 0]
6218                 }
6219             }
6220             if {![info exists arcend($a)]} continue
6221             set d $arcend($a)
6222             if {$td || $arctags($a) ne {}} {
6223                 set tomark [list $d]
6224                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6225                     set dd [lindex $tomark $j]
6226                     if {![info exists hastaggeddescendent($dd)]} {
6227                         if {[info exists done($dd)]} {
6228                             foreach b $arcout($dd) {
6229                                 if {[info exists arcend($b)]} {
6230                                     lappend tomark $arcend($b)
6231                                 }
6232                             }
6233                             if {[info exists tagloc($dd)]} {
6234                                 unset tagloc($dd)
6235                             }
6236                         } elseif {[info exists queued($dd)]} {
6237                             incr nc -1
6238                         }
6239                         set hastaggeddescendent($dd) 1
6240                     }
6241                 }
6242             }
6243             if {![info exists queued($d)]} {
6244                 lappend todo $d
6245                 set queued($d) 1
6246                 if {![info exists hastaggeddescendent($d)]} {
6247                     incr nc
6248                 }
6249             }
6250         }
6251     }
6252     set t2 [clock clicks -milliseconds]
6253     set loopix $i
6254     set tags {}
6255     foreach id [array names tagloc] {
6256         if {![info exists hastaggeddescendent($id)]} {
6257             foreach t $tagloc($id) {
6258                 if {[lsearch -exact $tags $t] < 0} {
6259                     lappend tags $t
6260                 }
6261             }
6262         }
6263     }
6264
6265     # remove tags that are ancestors of other tags
6266     for {set i 0} {$i < [llength $tags]} {incr i} {
6267         set a [lindex $tags $i]
6268         for {set j 0} {$j < $i} {incr j} {
6269             set b [lindex $tags $j]
6270             set r [anc_or_desc $a $b]
6271             if {$r == -1} {
6272                 set tags [lreplace $tags $j $j]
6273                 incr j -1
6274                 incr i -1
6275             } elseif {$r == 1} {
6276                 set tags [lreplace $tags $i $i]
6277                 incr i -1
6278                 break
6279             }
6280         }
6281     }
6282
6283     if {[array names growing] ne {}} {
6284         # graph isn't finished, need to check if any tag could get
6285         # eclipsed by another tag coming later.  Simply ignore any
6286         # tags that could later get eclipsed.
6287         set ctags {}
6288         foreach t $tags {
6289             if {[is_certain $origid $t]} {
6290                 lappend ctags $t
6291             }
6292         }
6293         if {$tags eq $ctags} {
6294             set cached_atags($origid) $tags
6295         } else {
6296             set tags $ctags
6297         }
6298     } else {
6299         set cached_atags($origid) $tags
6300     }
6301     set t3 [clock clicks -milliseconds]
6302     if {0 && $t3 - $t1 >= 100} {
6303         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6304             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6305     }
6306     return $tags
6307 }
6308
6309 # Return the list of IDs that have heads that are descendents of id,
6310 # including id itself if it has a head.
6311 proc descheads {id} {
6312     global arcnos arcstart arcids archeads idheads cached_dheads
6313     global allparents
6314
6315     if {![info exists allparents($id)]} {
6316         return {}
6317     }
6318     set ret {}
6319     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6320         # part-way along an arc; check it first
6321         set a [lindex $arcnos($id) 0]
6322         if {$archeads($a) ne {}} {
6323             validate_archeads $a
6324             set i [lsearch -exact $arcids($a) $id]
6325             foreach t $archeads($a) {
6326                 set j [lsearch -exact $arcids($a) $t]
6327                 if {$j > $i} break
6328                 lappend $ret $t
6329             }
6330         }
6331         set id $arcstart($a)
6332     }
6333     set origid $id
6334     set todo [list $id]
6335     set seen($id) 1
6336     for {set i 0} {$i < [llength $todo]} {incr i} {
6337         set id [lindex $todo $i]
6338         if {[info exists cached_dheads($id)]} {
6339             set ret [concat $ret $cached_dheads($id)]
6340         } else {
6341             if {[info exists idheads($id)]} {
6342                 lappend ret $id
6343             }
6344             foreach a $arcnos($id) {
6345                 if {$archeads($a) ne {}} {
6346                     set ret [concat $ret $archeads($a)]
6347                 }
6348                 set d $arcstart($a)
6349                 if {![info exists seen($d)]} {
6350                     lappend todo $d
6351                     set seen($d) 1
6352                 }
6353             }
6354         }
6355     }
6356     set ret [lsort -unique $ret]
6357     set cached_dheads($origid) $ret
6358 }
6359
6360 proc addedtag {id} {
6361     global arcnos arcout cached_dtags cached_atags
6362
6363     if {![info exists arcnos($id)]} return
6364     if {![info exists arcout($id)]} {
6365         recalcarc [lindex $arcnos($id) 0]
6366     }
6367     catch {unset cached_dtags}
6368     catch {unset cached_atags}
6369 }
6370
6371 proc addedhead {hid head} {
6372     global arcnos arcout cached_dheads
6373
6374     if {![info exists arcnos($hid)]} return
6375     if {![info exists arcout($hid)]} {
6376         recalcarc [lindex $arcnos($hid) 0]
6377     }
6378     catch {unset cached_dheads}
6379 }
6380
6381 proc removedhead {hid head} {
6382     global cached_dheads
6383
6384     catch {unset cached_dheads}
6385 }
6386
6387 proc movedhead {hid head} {
6388     global arcnos arcout cached_dheads
6389
6390     if {![info exists arcnos($hid)]} return
6391     if {![info exists arcout($hid)]} {
6392         recalcarc [lindex $arcnos($hid) 0]
6393     }
6394     catch {unset cached_dheads}
6395 }
6396
6397 proc changedrefs {} {
6398     global cached_dheads cached_dtags cached_atags
6399     global arctags archeads arcnos arcout idheads idtags
6400
6401     foreach id [concat [array names idheads] [array names idtags]] {
6402         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6403             set a [lindex $arcnos($id) 0]
6404             if {![info exists donearc($a)]} {
6405                 recalcarc $a
6406                 set donearc($a) 1
6407             }
6408         }
6409     }
6410     catch {unset cached_dtags}
6411     catch {unset cached_atags}
6412     catch {unset cached_dheads}
6413 }
6414
6415 proc rereadrefs {} {
6416     global idtags idheads idotherrefs mainhead
6417
6418     set refids [concat [array names idtags] \
6419                     [array names idheads] [array names idotherrefs]]
6420     foreach id $refids {
6421         if {![info exists ref($id)]} {
6422             set ref($id) [listrefs $id]
6423         }
6424     }
6425     set oldmainhead $mainhead
6426     readrefs
6427     changedrefs
6428     set refids [lsort -unique [concat $refids [array names idtags] \
6429                         [array names idheads] [array names idotherrefs]]]
6430     foreach id $refids {
6431         set v [listrefs $id]
6432         if {![info exists ref($id)] || $ref($id) != $v ||
6433             ($id eq $oldmainhead && $id ne $mainhead) ||
6434             ($id eq $mainhead && $id ne $oldmainhead)} {
6435             redrawtags $id
6436         }
6437     }
6438 }
6439
6440 proc listrefs {id} {
6441     global idtags idheads idotherrefs
6442
6443     set x {}
6444     if {[info exists idtags($id)]} {
6445         set x $idtags($id)
6446     }
6447     set y {}
6448     if {[info exists idheads($id)]} {
6449         set y $idheads($id)
6450     }
6451     set z {}
6452     if {[info exists idotherrefs($id)]} {
6453         set z $idotherrefs($id)
6454     }
6455     return [list $x $y $z]
6456 }
6457
6458 proc showtag {tag isnew} {
6459     global ctext tagcontents tagids linknum
6460
6461     if {$isnew} {
6462         addtohistory [list showtag $tag 0]
6463     }
6464     $ctext conf -state normal
6465     clear_ctext
6466     set linknum 0
6467     if {[info exists tagcontents($tag)]} {
6468         set text $tagcontents($tag)
6469     } else {
6470         set text "Tag: $tag\nId:  $tagids($tag)"
6471     }
6472     appendwithlinks $text {}
6473     $ctext conf -state disabled
6474     init_flist {}
6475 }
6476
6477 proc doquit {} {
6478     global stopped
6479     set stopped 100
6480     savestuff .
6481     destroy .
6482 }
6483
6484 proc doprefs {} {
6485     global maxwidth maxgraphpct diffopts
6486     global oldprefs prefstop showneartags
6487     global bgcolor fgcolor ctext diffcolors selectbgcolor
6488     global uifont tabstop
6489
6490     set top .gitkprefs
6491     set prefstop $top
6492     if {[winfo exists $top]} {
6493         raise $top
6494         return
6495     }
6496     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6497         set oldprefs($v) [set $v]
6498     }
6499     toplevel $top
6500     wm title $top "Gitk preferences"
6501     label $top.ldisp -text "Commit list display options"
6502     $top.ldisp configure -font $uifont
6503     grid $top.ldisp - -sticky w -pady 10
6504     label $top.spacer -text " "
6505     label $top.maxwidthl -text "Maximum graph width (lines)" \
6506         -font optionfont
6507     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6508     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6509     label $top.maxpctl -text "Maximum graph width (% of pane)" \
6510         -font optionfont
6511     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6512     grid x $top.maxpctl $top.maxpct -sticky w
6513
6514     label $top.ddisp -text "Diff display options"
6515     $top.ddisp configure -font $uifont
6516     grid $top.ddisp - -sticky w -pady 10
6517     label $top.diffoptl -text "Options for diff program" \
6518         -font optionfont
6519     entry $top.diffopt -width 20 -textvariable diffopts
6520     grid x $top.diffoptl $top.diffopt -sticky w
6521     frame $top.ntag
6522     label $top.ntag.l -text "Display nearby tags" -font optionfont
6523     checkbutton $top.ntag.b -variable showneartags
6524     pack $top.ntag.b $top.ntag.l -side left
6525     grid x $top.ntag -sticky w
6526     label $top.tabstopl -text "tabstop" -font optionfont
6527     entry $top.tabstop -width 10 -textvariable tabstop
6528     grid x $top.tabstopl $top.tabstop -sticky w
6529
6530     label $top.cdisp -text "Colors: press to choose"
6531     $top.cdisp configure -font $uifont
6532     grid $top.cdisp - -sticky w -pady 10
6533     label $top.bg -padx 40 -relief sunk -background $bgcolor
6534     button $top.bgbut -text "Background" -font optionfont \
6535         -command [list choosecolor bgcolor 0 $top.bg background setbg]
6536     grid x $top.bgbut $top.bg -sticky w
6537     label $top.fg -padx 40 -relief sunk -background $fgcolor
6538     button $top.fgbut -text "Foreground" -font optionfont \
6539         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6540     grid x $top.fgbut $top.fg -sticky w
6541     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6542     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6543         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6544                       [list $ctext tag conf d0 -foreground]]
6545     grid x $top.diffoldbut $top.diffold -sticky w
6546     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6547     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6548         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6549                       [list $ctext tag conf d1 -foreground]]
6550     grid x $top.diffnewbut $top.diffnew -sticky w
6551     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6552     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6553         -command [list choosecolor diffcolors 2 $top.hunksep \
6554                       "diff hunk header" \
6555                       [list $ctext tag conf hunksep -foreground]]
6556     grid x $top.hunksepbut $top.hunksep -sticky w
6557     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6558     button $top.selbgbut -text "Select bg" -font optionfont \
6559         -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6560     grid x $top.selbgbut $top.selbgsep -sticky w
6561
6562     frame $top.buts
6563     button $top.buts.ok -text "OK" -command prefsok -default active
6564     $top.buts.ok configure -font $uifont
6565     button $top.buts.can -text "Cancel" -command prefscan -default normal
6566     $top.buts.can configure -font $uifont
6567     grid $top.buts.ok $top.buts.can
6568     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6569     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6570     grid $top.buts - - -pady 10 -sticky ew
6571     bind $top <Visibility> "focus $top.buts.ok"
6572 }
6573
6574 proc choosecolor {v vi w x cmd} {
6575     global $v
6576
6577     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6578                -title "Gitk: choose color for $x"]
6579     if {$c eq {}} return
6580     $w conf -background $c
6581     lset $v $vi $c
6582     eval $cmd $c
6583 }
6584
6585 proc setselbg {c} {
6586     global bglist cflist
6587     foreach w $bglist {
6588         $w configure -selectbackground $c
6589     }
6590     $cflist tag configure highlight \
6591         -background [$cflist cget -selectbackground]
6592     allcanvs itemconf secsel -fill $c
6593 }
6594
6595 proc setbg {c} {
6596     global bglist
6597
6598     foreach w $bglist {
6599         $w conf -background $c
6600     }
6601 }
6602
6603 proc setfg {c} {
6604     global fglist canv
6605
6606     foreach w $fglist {
6607         $w conf -foreground $c
6608     }
6609     allcanvs itemconf text -fill $c
6610     $canv itemconf circle -outline $c
6611 }
6612
6613 proc prefscan {} {
6614     global maxwidth maxgraphpct diffopts
6615     global oldprefs prefstop showneartags
6616
6617     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6618         set $v $oldprefs($v)
6619     }
6620     catch {destroy $prefstop}
6621     unset prefstop
6622 }
6623
6624 proc prefsok {} {
6625     global maxwidth maxgraphpct
6626     global oldprefs prefstop showneartags
6627     global charspc ctext tabstop
6628
6629     catch {destroy $prefstop}
6630     unset prefstop
6631     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
6632     if {$maxwidth != $oldprefs(maxwidth)
6633         || $maxgraphpct != $oldprefs(maxgraphpct)} {
6634         redisplay
6635     } elseif {$showneartags != $oldprefs(showneartags)} {
6636         reselectline
6637     }
6638 }
6639
6640 proc formatdate {d} {
6641     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6642 }
6643
6644 # This list of encoding names and aliases is distilled from
6645 # http://www.iana.org/assignments/character-sets.
6646 # Not all of them are supported by Tcl.
6647 set encoding_aliases {
6648     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6649       ISO646-US US-ASCII us IBM367 cp367 csASCII }
6650     { ISO-10646-UTF-1 csISO10646UTF1 }
6651     { ISO_646.basic:1983 ref csISO646basic1983 }
6652     { INVARIANT csINVARIANT }
6653     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6654     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6655     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6656     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6657     { NATS-DANO iso-ir-9-1 csNATSDANO }
6658     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6659     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6660     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6661     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6662     { ISO-2022-KR csISO2022KR }
6663     { EUC-KR csEUCKR }
6664     { ISO-2022-JP csISO2022JP }
6665     { ISO-2022-JP-2 csISO2022JP2 }
6666     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6667       csISO13JISC6220jp }
6668     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6669     { IT iso-ir-15 ISO646-IT csISO15Italian }
6670     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6671     { ES iso-ir-17 ISO646-ES csISO17Spanish }
6672     { greek7-old iso-ir-18 csISO18Greek7Old }
6673     { latin-greek iso-ir-19 csISO19LatinGreek }
6674     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6675     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6676     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6677     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6678     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6679     { BS_viewdata iso-ir-47 csISO47BSViewdata }
6680     { INIS iso-ir-49 csISO49INIS }
6681     { INIS-8 iso-ir-50 csISO50INIS8 }
6682     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6683     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6684     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6685     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6686     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6687     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6688       csISO60Norwegian1 }
6689     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6690     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6691     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6692     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6693     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6694     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6695     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6696     { greek7 iso-ir-88 csISO88Greek7 }
6697     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6698     { iso-ir-90 csISO90 }
6699     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6700     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6701       csISO92JISC62991984b }
6702     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6703     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6704     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6705       csISO95JIS62291984handadd }
6706     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6707     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6708     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6709     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6710       CP819 csISOLatin1 }
6711     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6712     { T.61-7bit iso-ir-102 csISO102T617bit }
6713     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6714     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6715     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6716     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6717     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6718     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6719     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6720     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6721       arabic csISOLatinArabic }
6722     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6723     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6724     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6725       greek greek8 csISOLatinGreek }
6726     { T.101-G2 iso-ir-128 csISO128T101G2 }
6727     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6728       csISOLatinHebrew }
6729     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6730     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6731     { CSN_369103 iso-ir-139 csISO139CSN369103 }
6732     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6733     { ISO_6937-2-add iso-ir-142 csISOTextComm }
6734     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6735     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6736       csISOLatinCyrillic }
6737     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6738     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6739     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6740     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6741     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6742     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6743     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6744     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6745     { ISO_10367-box iso-ir-155 csISO10367Box }
6746     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6747     { latin-lap lap iso-ir-158 csISO158Lap }
6748     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6749     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6750     { us-dk csUSDK }
6751     { dk-us csDKUS }
6752     { JIS_X0201 X0201 csHalfWidthKatakana }
6753     { KSC5636 ISO646-KR csKSC5636 }
6754     { ISO-10646-UCS-2 csUnicode }
6755     { ISO-10646-UCS-4 csUCS4 }
6756     { DEC-MCS dec csDECMCS }
6757     { hp-roman8 roman8 r8 csHPRoman8 }
6758     { macintosh mac csMacintosh }
6759     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6760       csIBM037 }
6761     { IBM038 EBCDIC-INT cp038 csIBM038 }
6762     { IBM273 CP273 csIBM273 }
6763     { IBM274 EBCDIC-BE CP274 csIBM274 }
6764     { IBM275 EBCDIC-BR cp275 csIBM275 }
6765     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6766     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6767     { IBM280 CP280 ebcdic-cp-it csIBM280 }
6768     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6769     { IBM284 CP284 ebcdic-cp-es csIBM284 }
6770     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6771     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6772     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6773     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6774     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6775     { IBM424 cp424 ebcdic-cp-he csIBM424 }
6776     { IBM437 cp437 437 csPC8CodePage437 }
6777     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6778     { IBM775 cp775 csPC775Baltic }
6779     { IBM850 cp850 850 csPC850Multilingual }
6780     { IBM851 cp851 851 csIBM851 }
6781     { IBM852 cp852 852 csPCp852 }
6782     { IBM855 cp855 855 csIBM855 }
6783     { IBM857 cp857 857 csIBM857 }
6784     { IBM860 cp860 860 csIBM860 }
6785     { IBM861 cp861 861 cp-is csIBM861 }
6786     { IBM862 cp862 862 csPC862LatinHebrew }
6787     { IBM863 cp863 863 csIBM863 }
6788     { IBM864 cp864 csIBM864 }
6789     { IBM865 cp865 865 csIBM865 }
6790     { IBM866 cp866 866 csIBM866 }
6791     { IBM868 CP868 cp-ar csIBM868 }
6792     { IBM869 cp869 869 cp-gr csIBM869 }
6793     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6794     { IBM871 CP871 ebcdic-cp-is csIBM871 }
6795     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6796     { IBM891 cp891 csIBM891 }
6797     { IBM903 cp903 csIBM903 }
6798     { IBM904 cp904 904 csIBBM904 }
6799     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6800     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6801     { IBM1026 CP1026 csIBM1026 }
6802     { EBCDIC-AT-DE csIBMEBCDICATDE }
6803     { EBCDIC-AT-DE-A csEBCDICATDEA }
6804     { EBCDIC-CA-FR csEBCDICCAFR }
6805     { EBCDIC-DK-NO csEBCDICDKNO }
6806     { EBCDIC-DK-NO-A csEBCDICDKNOA }
6807     { EBCDIC-FI-SE csEBCDICFISE }
6808     { EBCDIC-FI-SE-A csEBCDICFISEA }
6809     { EBCDIC-FR csEBCDICFR }
6810     { EBCDIC-IT csEBCDICIT }
6811     { EBCDIC-PT csEBCDICPT }
6812     { EBCDIC-ES csEBCDICES }
6813     { EBCDIC-ES-A csEBCDICESA }
6814     { EBCDIC-ES-S csEBCDICESS }
6815     { EBCDIC-UK csEBCDICUK }
6816     { EBCDIC-US csEBCDICUS }
6817     { UNKNOWN-8BIT csUnknown8BiT }
6818     { MNEMONIC csMnemonic }
6819     { MNEM csMnem }
6820     { VISCII csVISCII }
6821     { VIQR csVIQR }
6822     { KOI8-R csKOI8R }
6823     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6824     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6825     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6826     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6827     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6828     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6829     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6830     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6831     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6832     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6833     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6834     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6835     { IBM1047 IBM-1047 }
6836     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6837     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6838     { UNICODE-1-1 csUnicode11 }
6839     { CESU-8 csCESU-8 }
6840     { BOCU-1 csBOCU-1 }
6841     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6842     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6843       l8 }
6844     { ISO-8859-15 ISO_8859-15 Latin-9 }
6845     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6846     { GBK CP936 MS936 windows-936 }
6847     { JIS_Encoding csJISEncoding }
6848     { Shift_JIS MS_Kanji csShiftJIS }
6849     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6850       EUC-JP }
6851     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6852     { ISO-10646-UCS-Basic csUnicodeASCII }
6853     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6854     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6855     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6856     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6857     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6858     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6859     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6860     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6861     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6862     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6863     { Adobe-Standard-Encoding csAdobeStandardEncoding }
6864     { Ventura-US csVenturaUS }
6865     { Ventura-International csVenturaInternational }
6866     { PC8-Danish-Norwegian csPC8DanishNorwegian }
6867     { PC8-Turkish csPC8Turkish }
6868     { IBM-Symbols csIBMSymbols }
6869     { IBM-Thai csIBMThai }
6870     { HP-Legal csHPLegal }
6871     { HP-Pi-font csHPPiFont }
6872     { HP-Math8 csHPMath8 }
6873     { Adobe-Symbol-Encoding csHPPSMath }
6874     { HP-DeskTop csHPDesktop }
6875     { Ventura-Math csVenturaMath }
6876     { Microsoft-Publishing csMicrosoftPublishing }
6877     { Windows-31J csWindows31J }
6878     { GB2312 csGB2312 }
6879     { Big5 csBig5 }
6880 }
6881
6882 proc tcl_encoding {enc} {
6883     global encoding_aliases
6884     set names [encoding names]
6885     set lcnames [string tolower $names]
6886     set enc [string tolower $enc]
6887     set i [lsearch -exact $lcnames $enc]
6888     if {$i < 0} {
6889         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6890         if {[regsub {^iso[-_]} $enc iso encx]} {
6891             set i [lsearch -exact $lcnames $encx]
6892         }
6893     }
6894     if {$i < 0} {
6895         foreach l $encoding_aliases {
6896             set ll [string tolower $l]
6897             if {[lsearch -exact $ll $enc] < 0} continue
6898             # look through the aliases for one that tcl knows about
6899             foreach e $ll {
6900                 set i [lsearch -exact $lcnames $e]
6901                 if {$i < 0} {
6902                     if {[regsub {^iso[-_]} $e iso ex]} {
6903                         set i [lsearch -exact $lcnames $ex]
6904                     }
6905                 }
6906                 if {$i >= 0} break
6907             }
6908             break
6909         }
6910     }
6911     if {$i >= 0} {
6912         return [lindex $names $i]
6913     }
6914     return {}
6915 }
6916
6917 # defaults...
6918 set datemode 0
6919 set diffopts "-U 5 -p"
6920 set wrcomcmd "git diff-tree --stdin -p --pretty"
6921
6922 set gitencoding {}
6923 catch {
6924     set gitencoding [exec git config --get i18n.commitencoding]
6925 }
6926 if {$gitencoding == ""} {
6927     set gitencoding "utf-8"
6928 }
6929 set tclencoding [tcl_encoding $gitencoding]
6930 if {$tclencoding == {}} {
6931     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6932 }
6933
6934 set mainfont {Helvetica 9}
6935 set textfont {Courier 9}
6936 set uifont {Helvetica 9 bold}
6937 set tabstop 8
6938 set findmergefiles 0
6939 set maxgraphpct 50
6940 set maxwidth 16
6941 set revlistorder 0
6942 set fastdate 0
6943 set uparrowlen 7
6944 set downarrowlen 7
6945 set mingaplen 30
6946 set cmitmode "patch"
6947 set wrapcomment "none"
6948 set showneartags 1
6949 set maxrefs 20
6950
6951 set colors {green red blue magenta darkgrey brown orange}
6952 set bgcolor white
6953 set fgcolor black
6954 set diffcolors {red "#00a000" blue}
6955 set selectbgcolor gray85
6956
6957 catch {source ~/.gitk}
6958
6959 font create optionfont -family sans-serif -size -12
6960
6961 set revtreeargs {}
6962 foreach arg $argv {
6963     switch -regexp -- $arg {
6964         "^$" { }
6965         "^-d" { set datemode 1 }
6966         default {
6967             lappend revtreeargs $arg
6968         }
6969     }
6970 }
6971
6972 # check that we can find a .git directory somewhere...
6973 set gitdir [gitdir]
6974 if {![file isdirectory $gitdir]} {
6975     show_error {} . "Cannot find the git directory \"$gitdir\"."
6976     exit 1
6977 }
6978
6979 set cmdline_files {}
6980 set i [lsearch -exact $revtreeargs "--"]
6981 if {$i >= 0} {
6982     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6983     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6984 } elseif {$revtreeargs ne {}} {
6985     if {[catch {
6986         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6987         set cmdline_files [split $f "\n"]
6988         set n [llength $cmdline_files]
6989         set revtreeargs [lrange $revtreeargs 0 end-$n]
6990     } err]} {
6991         # unfortunately we get both stdout and stderr in $err,
6992         # so look for "fatal:".
6993         set i [string first "fatal:" $err]
6994         if {$i > 0} {
6995             set err [string range $err [expr {$i + 6}] end]
6996         }
6997         show_error {} . "Bad arguments to gitk:\n$err"
6998         exit 1
6999     }
7000 }
7001
7002 set runq {}
7003 set history {}
7004 set historyindex 0
7005 set fh_serial 0
7006 set nhl_names {}
7007 set highlight_paths {}
7008 set searchdirn -forwards
7009 set boldrows {}
7010 set boldnamerows {}
7011 set diffelide {0 0}
7012
7013 set optim_delay 16
7014
7015 set nextviewnum 1
7016 set curview 0
7017 set selectedview 0
7018 set selectedhlview None
7019 set viewfiles(0) {}
7020 set viewperm(0) 0
7021 set viewargs(0) {}
7022
7023 set cmdlineok 0
7024 set stopped 0
7025 set stuffsaved 0
7026 set patchnum 0
7027 setcoords
7028 makewindow
7029 wm title . "[file tail $argv0]: [file tail [pwd]]"
7030 readrefs
7031
7032 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7033     # create a view for the files/dirs specified on the command line
7034     set curview 1
7035     set selectedview 1
7036     set nextviewnum 2
7037     set viewname(1) "Command line"
7038     set viewfiles(1) $cmdline_files
7039     set viewargs(1) $revtreeargs
7040     set viewperm(1) 0
7041     addviewmenu 1
7042     .bar.view entryconf Edit* -state normal
7043     .bar.view entryconf Delete* -state normal
7044 }
7045
7046 if {[info exists permviews]} {
7047     foreach v $permviews {
7048         set n $nextviewnum
7049         incr nextviewnum
7050         set viewname($n) [lindex $v 0]
7051         set viewfiles($n) [lindex $v 1]
7052         set viewargs($n) [lindex $v 2]
7053         set viewperm($n) 1
7054         addviewmenu $n
7055     }
7056 }
7057 getcommits