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