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