git.oblomov.eu Git - git/blob - gitk

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