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