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