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 remove found 1.0 end
4404     $ctext conf -state disabled
4405     set commentend [$ctext index "end - 1c"]
4406
4407     init_flist "Comments"
4408     if {$cmitmode eq "tree"} {
4409         gettree $id
4410     } elseif {[llength $olds] <= 1} {
4411         startdiff $id
4412     } else {
4413         mergediff $id $l
4414     }
4415 }
4416
4417 proc selfirstline {} {
4418     unmarkmatches
4419     selectline 0 1
4420 }
4421
4422 proc sellastline {} {
4423     global numcommits
4424     unmarkmatches
4425     set l [expr {$numcommits - 1}]
4426     selectline $l 1
4427 }
4428
4429 proc selnextline {dir} {
4430     global selectedline
4431     if {![info exists selectedline]} return
4432     set l [expr {$selectedline + $dir}]
4433     unmarkmatches
4434     selectline $l 1
4435 }
4436
4437 proc selnextpage {dir} {
4438     global canv linespc selectedline numcommits
4439
4440     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4441     if {$lpp < 1} {
4442         set lpp 1
4443     }
4444     allcanvs yview scroll [expr {$dir * $lpp}] units
4445     drawvisible
4446     if {![info exists selectedline]} return
4447     set l [expr {$selectedline + $dir * $lpp}]
4448     if {$l < 0} {
4449         set l 0
4450     } elseif {$l >= $numcommits} {
4451         set l [expr $numcommits - 1]
4452     }
4453     unmarkmatches
4454     selectline $l 1
4455 }
4456
4457 proc unselectline {} {
4458     global selectedline currentid
4459
4460     catch {unset selectedline}
4461     catch {unset currentid}
4462     allcanvs delete secsel
4463     rhighlight_none
4464     cancel_next_highlight
4465 }
4466
4467 proc reselectline {} {
4468     global selectedline
4469
4470     if {[info exists selectedline]} {
4471         selectline $selectedline 0
4472     }
4473 }
4474
4475 proc addtohistory {cmd} {
4476     global history historyindex curview
4477
4478     set elt [list $curview $cmd]
4479     if {$historyindex > 0
4480         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4481         return
4482     }
4483
4484     if {$historyindex < [llength $history]} {
4485         set history [lreplace $history $historyindex end $elt]
4486     } else {
4487         lappend history $elt
4488     }
4489     incr historyindex
4490     if {$historyindex > 1} {
4491         .tf.bar.leftbut conf -state normal
4492     } else {
4493         .tf.bar.leftbut conf -state disabled
4494     }
4495     .tf.bar.rightbut conf -state disabled
4496 }
4497
4498 proc godo {elt} {
4499     global curview
4500
4501     set view [lindex $elt 0]
4502     set cmd [lindex $elt 1]
4503     if {$curview != $view} {
4504         showview $view
4505     }
4506     eval $cmd
4507 }
4508
4509 proc goback {} {
4510     global history historyindex
4511
4512     if {$historyindex > 1} {
4513         incr historyindex -1
4514         godo [lindex $history [expr {$historyindex - 1}]]
4515         .tf.bar.rightbut conf -state normal
4516     }
4517     if {$historyindex <= 1} {
4518         .tf.bar.leftbut conf -state disabled
4519     }
4520 }
4521
4522 proc goforw {} {
4523     global history historyindex
4524
4525     if {$historyindex < [llength $history]} {
4526         set cmd [lindex $history $historyindex]
4527         incr historyindex
4528         godo $cmd
4529         .tf.bar.leftbut conf -state normal
4530     }
4531     if {$historyindex >= [llength $history]} {
4532         .tf.bar.rightbut conf -state disabled
4533     }
4534 }
4535
4536 proc gettree {id} {
4537     global treefilelist treeidlist diffids diffmergeid treepending nullid
4538
4539     set diffids $id
4540     catch {unset diffmergeid}
4541     if {![info exists treefilelist($id)]} {
4542         if {![info exists treepending]} {
4543             if {$id ne $nullid} {
4544                 set cmd [concat | git ls-tree -r $id]
4545             } else {
4546                 set cmd [concat | git ls-files]
4547             }
4548             if {[catch {set gtf [open $cmd r]}]} {
4549                 return
4550             }
4551             set treepending $id
4552             set treefilelist($id) {}
4553             set treeidlist($id) {}
4554             fconfigure $gtf -blocking 0
4555             filerun $gtf [list gettreeline $gtf $id]
4556         }
4557     } else {
4558         setfilelist $id
4559     }
4560 }
4561
4562 proc gettreeline {gtf id} {
4563     global treefilelist treeidlist treepending cmitmode diffids nullid
4564
4565     set nl 0
4566     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4567         if {$diffids ne $nullid} {
4568             if {[lindex $line 1] ne "blob"} continue
4569             set i [string first "\t" $line]
4570             if {$i < 0} continue
4571             set sha1 [lindex $line 2]
4572             set fname [string range $line [expr {$i+1}] end]
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 i [string first "\t" $line]
4801         if {$i >= 0} {
4802             set file [string range $line [expr {$i+1}] end]
4803             if {[string index $file 0] eq "\""} {
4804                 set file [lindex $file 0]
4805             }
4806             lappend treediff $file
4807         }
4808     }
4809     if {![eof $gdtf]} {
4810         return [expr {$nr >= 1000? 2: 1}]
4811     }
4812     close $gdtf
4813     set treediffs($ids) $treediff
4814     unset treepending
4815     if {$cmitmode eq "tree"} {
4816         gettree $diffids
4817     } elseif {$ids != $diffids} {
4818         if {![info exists diffmergeid]} {
4819             gettreediffs $diffids
4820         }
4821     } else {
4822         addtocflist $ids
4823     }
4824     return 0
4825 }
4826
4827 proc getblobdiffs {ids} {
4828     global diffopts blobdifffd diffids env
4829     global diffinhdr treediffs
4830
4831     set env(GIT_DIFF_OPTS) $diffopts
4832     if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4833         puts "error getting diffs: $err"
4834         return
4835     }
4836     set diffinhdr 0
4837     fconfigure $bdf -blocking 0
4838     set blobdifffd($ids) $bdf
4839     filerun $bdf [list getblobdiffline $bdf $diffids]
4840 }
4841
4842 proc setinlist {var i val} {
4843     global $var
4844
4845     while {[llength [set $var]] < $i} {
4846         lappend $var {}
4847     }
4848     if {[llength [set $var]] == $i} {
4849         lappend $var $val
4850     } else {
4851         lset $var $i $val
4852     }
4853 }
4854
4855 proc makediffhdr {fname ids} {
4856     global ctext curdiffstart treediffs
4857
4858     set i [lsearch -exact $treediffs($ids) $fname]
4859     if {$i >= 0} {
4860         setinlist difffilestart $i $curdiffstart
4861     }
4862     set l [expr {(78 - [string length $fname]) / 2}]
4863     set pad [string range "----------------------------------------" 1 $l]
4864     $ctext insert $curdiffstart "$pad $fname $pad" filesep
4865 }
4866
4867 proc getblobdiffline {bdf ids} {
4868     global diffids blobdifffd ctext curdiffstart
4869     global diffnexthead diffnextnote difffilestart
4870     global diffinhdr treediffs
4871
4872     set nr 0
4873     $ctext conf -state normal
4874     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4875         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4876             close $bdf
4877             return 0
4878         }
4879         if {![string compare -length 11 "diff --git " $line]} {
4880             # trim off "diff --git "
4881             set line [string range $line 11 end]
4882             set diffinhdr 1
4883             # start of a new file
4884             $ctext insert end "\n"
4885             set curdiffstart [$ctext index "end - 1c"]
4886             $ctext insert end "\n" filesep
4887             # If the name hasn't changed the length will be odd,
4888             # the middle char will be a space, and the two bits either
4889             # side will be a/name and b/name, or "a/name" and "b/name".
4890             # If the name has changed we'll get "rename from" and
4891             # "rename to" lines following this, and we'll use them
4892             # to get the filenames.
4893             # This complexity is necessary because spaces in the filename(s)
4894             # don't get escaped.
4895             set l [string length $line]
4896             set i [expr {$l / 2}]
4897             if {!(($l & 1) && [string index $line $i] eq " " &&
4898                   [string range $line 2 [expr {$i - 1}]] eq \
4899                       [string range $line [expr {$i + 3}] end])} {
4900                 continue
4901             }
4902             # unescape if quoted and chop off the a/ from the front
4903             if {[string index $line 0] eq "\""} {
4904                 set fname [string range [lindex $line 0] 2 end]
4905             } else {
4906                 set fname [string range $line 2 [expr {$i - 1}]]
4907             }
4908             makediffhdr $fname $ids
4909
4910         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
4911                        $line match f1l f1c f2l f2c rest]} {
4912             $ctext insert end "$line\n" hunksep
4913             set diffinhdr 0
4914
4915         } elseif {$diffinhdr} {
4916             if {![string compare -length 12 "rename from " $line]} {
4917                 set fname [string range $line 12 end]
4918                 if {[string index $fname 0] eq "\""} {
4919                     set fname [lindex $fname 0]
4920                 }
4921                 set i [lsearch -exact $treediffs($ids) $fname]
4922                 if {$i >= 0} {
4923                     setinlist difffilestart $i $curdiffstart
4924                 }
4925             } elseif {![string compare -length 10 $line "rename to "]} {
4926                 set fname [string range $line 10 end]
4927                 if {[string index $fname 0] eq "\""} {
4928                     set fname [lindex $fname 0]
4929                 }
4930                 makediffhdr $fname $ids
4931             } elseif {[string compare -length 3 $line "---"] == 0} {
4932                 # do nothing
4933                 continue
4934             } elseif {[string compare -length 3 $line "+++"] == 0} {
4935                 set diffinhdr 0
4936                 continue
4937             }
4938             $ctext insert end "$line\n" filesep
4939
4940         } else {
4941             set x [string range $line 0 0]
4942             if {$x == "-" || $x == "+"} {
4943                 set tag [expr {$x == "+"}]
4944                 $ctext insert end "$line\n" d$tag
4945             } elseif {$x == " "} {
4946                 $ctext insert end "$line\n"
4947             } else {
4948                 # "\ No newline at end of file",
4949                 # or something else we don't recognize
4950                 $ctext insert end "$line\n" hunksep
4951             }
4952         }
4953     }
4954     $ctext conf -state disabled
4955     if {[eof $bdf]} {
4956         close $bdf
4957         return 0
4958     }
4959     return [expr {$nr >= 1000? 2: 1}]
4960 }
4961
4962 proc changediffdisp {} {
4963     global ctext diffelide
4964
4965     $ctext tag conf d0 -elide [lindex $diffelide 0]
4966     $ctext tag conf d1 -elide [lindex $diffelide 1]
4967 }
4968
4969 proc prevfile {} {
4970     global difffilestart ctext
4971     set prev [lindex $difffilestart 0]
4972     set here [$ctext index @0,0]
4973     foreach loc $difffilestart {
4974         if {[$ctext compare $loc >= $here]} {
4975             $ctext yview $prev
4976             return
4977         }
4978         set prev $loc
4979     }
4980     $ctext yview $prev
4981 }
4982
4983 proc nextfile {} {
4984     global difffilestart ctext
4985     set here [$ctext index @0,0]
4986     foreach loc $difffilestart {
4987         if {[$ctext compare $loc > $here]} {
4988             $ctext yview $loc
4989             return
4990         }
4991     }
4992 }
4993
4994 proc clear_ctext {{first 1.0}} {
4995     global ctext smarktop smarkbot
4996
4997     set l [lindex [split $first .] 0]
4998     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4999         set smarktop $l
5000     }
5001     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5002         set smarkbot $l
5003     }
5004     $ctext delete $first end
5005 }
5006
5007 proc incrsearch {name ix op} {
5008     global ctext searchstring searchdirn
5009
5010     $ctext tag remove found 1.0 end
5011     if {[catch {$ctext index anchor}]} {
5012         # no anchor set, use start of selection, or of visible area
5013         set sel [$ctext tag ranges sel]
5014         if {$sel ne {}} {
5015             $ctext mark set anchor [lindex $sel 0]
5016         } elseif {$searchdirn eq "-forwards"} {
5017             $ctext mark set anchor @0,0
5018         } else {
5019             $ctext mark set anchor @0,[winfo height $ctext]
5020         }
5021     }
5022     if {$searchstring ne {}} {
5023         set here [$ctext search $searchdirn -- $searchstring anchor]
5024         if {$here ne {}} {
5025             $ctext see $here
5026         }
5027         searchmarkvisible 1
5028     }
5029 }
5030
5031 proc dosearch {} {
5032     global sstring ctext searchstring searchdirn
5033
5034     focus $sstring
5035     $sstring icursor end
5036     set searchdirn -forwards
5037     if {$searchstring ne {}} {
5038         set sel [$ctext tag ranges sel]
5039         if {$sel ne {}} {
5040             set start "[lindex $sel 0] + 1c"
5041         } elseif {[catch {set start [$ctext index anchor]}]} {
5042             set start "@0,0"
5043         }
5044         set match [$ctext search -count mlen -- $searchstring $start]
5045         $ctext tag remove sel 1.0 end
5046         if {$match eq {}} {
5047             bell
5048             return
5049         }
5050         $ctext see $match
5051         set mend "$match + $mlen c"
5052         $ctext tag add sel $match $mend
5053         $ctext mark unset anchor
5054     }
5055 }
5056
5057 proc dosearchback {} {
5058     global sstring ctext searchstring searchdirn
5059
5060     focus $sstring
5061     $sstring icursor end
5062     set searchdirn -backwards
5063     if {$searchstring ne {}} {
5064         set sel [$ctext tag ranges sel]
5065         if {$sel ne {}} {
5066             set start [lindex $sel 0]
5067         } elseif {[catch {set start [$ctext index anchor]}]} {
5068             set start @0,[winfo height $ctext]
5069         }
5070         set match [$ctext search -backwards -count ml -- $searchstring $start]
5071         $ctext tag remove sel 1.0 end
5072         if {$match eq {}} {
5073             bell
5074             return
5075         }
5076         $ctext see $match
5077         set mend "$match + $ml c"
5078         $ctext tag add sel $match $mend
5079         $ctext mark unset anchor
5080     }
5081 }
5082
5083 proc searchmark {first last} {
5084     global ctext searchstring
5085
5086     set mend $first.0
5087     while {1} {
5088         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5089         if {$match eq {}} break
5090         set mend "$match + $mlen c"
5091         $ctext tag add found $match $mend
5092     }
5093 }
5094
5095 proc searchmarkvisible {doall} {
5096     global ctext smarktop smarkbot
5097
5098     set topline [lindex [split [$ctext index @0,0] .] 0]
5099     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5100     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5101         # no overlap with previous
5102         searchmark $topline $botline
5103         set smarktop $topline
5104         set smarkbot $botline
5105     } else {
5106         if {$topline < $smarktop} {
5107             searchmark $topline [expr {$smarktop-1}]
5108             set smarktop $topline
5109         }
5110         if {$botline > $smarkbot} {
5111             searchmark [expr {$smarkbot+1}] $botline
5112             set smarkbot $botline
5113         }
5114     }
5115 }
5116
5117 proc scrolltext {f0 f1} {
5118     global searchstring
5119
5120     .bleft.sb set $f0 $f1
5121     if {$searchstring ne {}} {
5122         searchmarkvisible 0
5123     }
5124 }
5125
5126 proc setcoords {} {
5127     global linespc charspc canvx0 canvy0 mainfont
5128     global xspc1 xspc2 lthickness
5129
5130     set linespc [font metrics $mainfont -linespace]
5131     set charspc [font measure $mainfont "m"]
5132     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5133     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5134     set lthickness [expr {int($linespc / 9) + 1}]
5135     set xspc1(0) $linespc
5136     set xspc2 $linespc
5137 }
5138
5139 proc redisplay {} {
5140     global canv
5141     global selectedline
5142
5143     set ymax [lindex [$canv cget -scrollregion] 3]
5144     if {$ymax eq {} || $ymax == 0} return
5145     set span [$canv yview]
5146     clear_display
5147     setcanvscroll
5148     allcanvs yview moveto [lindex $span 0]
5149     drawvisible
5150     if {[info exists selectedline]} {
5151         selectline $selectedline 0
5152         allcanvs yview moveto [lindex $span 0]
5153     }
5154 }
5155
5156 proc incrfont {inc} {
5157     global mainfont textfont ctext canv phase cflist
5158     global charspc tabstop
5159     global stopped entries
5160     unmarkmatches
5161     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5162     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5163     setcoords
5164     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5165     $cflist conf -font $textfont
5166     $ctext tag conf filesep -font [concat $textfont bold]
5167     foreach e $entries {
5168         $e conf -font $mainfont
5169     }
5170     if {$phase eq "getcommits"} {
5171         $canv itemconf textitems -font $mainfont
5172     }
5173     redisplay
5174 }
5175
5176 proc clearsha1 {} {
5177     global sha1entry sha1string
5178     if {[string length $sha1string] == 40} {
5179         $sha1entry delete 0 end
5180     }
5181 }
5182
5183 proc sha1change {n1 n2 op} {
5184     global sha1string currentid sha1but
5185     if {$sha1string == {}
5186         || ([info exists currentid] && $sha1string == $currentid)} {
5187         set state disabled
5188     } else {
5189         set state normal
5190     }
5191     if {[$sha1but cget -state] == $state} return
5192     if {$state == "normal"} {
5193         $sha1but conf -state normal -relief raised -text "Goto: "
5194     } else {
5195         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5196     }
5197 }
5198
5199 proc gotocommit {} {
5200     global sha1string currentid commitrow tagids headids
5201     global displayorder numcommits curview
5202
5203     if {$sha1string == {}
5204         || ([info exists currentid] && $sha1string == $currentid)} return
5205     if {[info exists tagids($sha1string)]} {
5206         set id $tagids($sha1string)
5207     } elseif {[info exists headids($sha1string)]} {
5208         set id $headids($sha1string)
5209     } else {
5210         set id [string tolower $sha1string]
5211         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5212             set matches {}
5213             foreach i $displayorder {
5214                 if {[string match $id* $i]} {
5215                     lappend matches $i
5216                 }
5217             }
5218             if {$matches ne {}} {
5219                 if {[llength $matches] > 1} {
5220                     error_popup "Short SHA1 id $id is ambiguous"
5221                     return
5222                 }
5223                 set id [lindex $matches 0]
5224             }
5225         }
5226     }
5227     if {[info exists commitrow($curview,$id)]} {
5228         selectline $commitrow($curview,$id) 1
5229         return
5230     }
5231     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5232         set type "SHA1 id"
5233     } else {
5234         set type "Tag/Head"
5235     }
5236     error_popup "$type $sha1string is not known"
5237 }
5238
5239 proc lineenter {x y id} {
5240     global hoverx hovery hoverid hovertimer
5241     global commitinfo canv
5242
5243     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5244     set hoverx $x
5245     set hovery $y
5246     set hoverid $id
5247     if {[info exists hovertimer]} {
5248         after cancel $hovertimer
5249     }
5250     set hovertimer [after 500 linehover]
5251     $canv delete hover
5252 }
5253
5254 proc linemotion {x y id} {
5255     global hoverx hovery hoverid hovertimer
5256
5257     if {[info exists hoverid] && $id == $hoverid} {
5258         set hoverx $x
5259         set hovery $y
5260         if {[info exists hovertimer]} {
5261             after cancel $hovertimer
5262         }
5263         set hovertimer [after 500 linehover]
5264     }
5265 }
5266
5267 proc lineleave {id} {
5268     global hoverid hovertimer canv
5269
5270     if {[info exists hoverid] && $id == $hoverid} {
5271         $canv delete hover
5272         if {[info exists hovertimer]} {
5273             after cancel $hovertimer
5274             unset hovertimer
5275         }
5276         unset hoverid
5277     }
5278 }
5279
5280 proc linehover {} {
5281     global hoverx hovery hoverid hovertimer
5282     global canv linespc lthickness
5283     global commitinfo mainfont
5284
5285     set text [lindex $commitinfo($hoverid) 0]
5286     set ymax [lindex [$canv cget -scrollregion] 3]
5287     if {$ymax == {}} return
5288     set yfrac [lindex [$canv yview] 0]
5289     set x [expr {$hoverx + 2 * $linespc}]
5290     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5291     set x0 [expr {$x - 2 * $lthickness}]
5292     set y0 [expr {$y - 2 * $lthickness}]
5293     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5294     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5295     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5296                -fill \#ffff80 -outline black -width 1 -tags hover]
5297     $canv raise $t
5298     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5299                -font $mainfont]
5300     $canv raise $t
5301 }
5302
5303 proc clickisonarrow {id y} {
5304     global lthickness
5305
5306     set ranges [rowranges $id]
5307     set thresh [expr {2 * $lthickness + 6}]
5308     set n [expr {[llength $ranges] - 1}]
5309     for {set i 1} {$i < $n} {incr i} {
5310         set row [lindex $ranges $i]
5311         if {abs([yc $row] - $y) < $thresh} {
5312             return $i
5313         }
5314     }
5315     return {}
5316 }
5317
5318 proc arrowjump {id n y} {
5319     global canv
5320
5321     # 1 <-> 2, 3 <-> 4, etc...
5322     set n [expr {(($n - 1) ^ 1) + 1}]
5323     set row [lindex [rowranges $id] $n]
5324     set yt [yc $row]
5325     set ymax [lindex [$canv cget -scrollregion] 3]
5326     if {$ymax eq {} || $ymax <= 0} return
5327     set view [$canv yview]
5328     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5329     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5330     if {$yfrac < 0} {
5331         set yfrac 0
5332     }
5333     allcanvs yview moveto $yfrac
5334 }
5335
5336 proc lineclick {x y id isnew} {
5337     global ctext commitinfo children canv thickerline curview
5338
5339     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5340     unmarkmatches
5341     unselectline
5342     normalline
5343     $canv delete hover
5344     # draw this line thicker than normal
5345     set thickerline $id
5346     drawlines $id
5347     if {$isnew} {
5348         set ymax [lindex [$canv cget -scrollregion] 3]
5349         if {$ymax eq {}} return
5350         set yfrac [lindex [$canv yview] 0]
5351         set y [expr {$y + $yfrac * $ymax}]
5352     }
5353     set dirn [clickisonarrow $id $y]
5354     if {$dirn ne {}} {
5355         arrowjump $id $dirn $y
5356         return
5357     }
5358
5359     if {$isnew} {
5360         addtohistory [list lineclick $x $y $id 0]
5361     }
5362     # fill the details pane with info about this line
5363     $ctext conf -state normal
5364     clear_ctext
5365     $ctext tag conf link -foreground blue -underline 1
5366     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5367     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5368     $ctext insert end "Parent:\t"
5369     $ctext insert end $id [list link link0]
5370     $ctext tag bind link0 <1> [list selbyid $id]
5371     set info $commitinfo($id)
5372     $ctext insert end "\n\t[lindex $info 0]\n"
5373     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5374     set date [formatdate [lindex $info 2]]
5375     $ctext insert end "\tDate:\t$date\n"
5376     set kids $children($curview,$id)
5377     if {$kids ne {}} {
5378         $ctext insert end "\nChildren:"
5379         set i 0
5380         foreach child $kids {
5381             incr i
5382             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5383             set info $commitinfo($child)
5384             $ctext insert end "\n\t"
5385             $ctext insert end $child [list link link$i]
5386             $ctext tag bind link$i <1> [list selbyid $child]
5387             $ctext insert end "\n\t[lindex $info 0]"
5388             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5389             set date [formatdate [lindex $info 2]]
5390             $ctext insert end "\n\tDate:\t$date\n"
5391         }
5392     }
5393     $ctext conf -state disabled
5394     init_flist {}
5395 }
5396
5397 proc normalline {} {
5398     global thickerline
5399     if {[info exists thickerline]} {
5400         set id $thickerline
5401         unset thickerline
5402         drawlines $id
5403     }
5404 }
5405
5406 proc selbyid {id} {
5407     global commitrow curview
5408     if {[info exists commitrow($curview,$id)]} {
5409         selectline $commitrow($curview,$id) 1
5410     }
5411 }
5412
5413 proc mstime {} {
5414     global startmstime
5415     if {![info exists startmstime]} {
5416         set startmstime [clock clicks -milliseconds]
5417     }
5418     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5419 }
5420
5421 proc rowmenu {x y id} {
5422     global rowctxmenu commitrow selectedline rowmenuid curview
5423     global nullid fakerowmenu mainhead
5424
5425     set rowmenuid $id
5426     if {![info exists selectedline]
5427         || $commitrow($curview,$id) eq $selectedline} {
5428         set state disabled
5429     } else {
5430         set state normal
5431     }
5432     if {$id ne $nullid} {
5433         set menu $rowctxmenu
5434         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5435     } else {
5436         set menu $fakerowmenu
5437     }
5438     $menu entryconfigure "Diff this*" -state $state
5439     $menu entryconfigure "Diff selected*" -state $state
5440     $menu entryconfigure "Make patch" -state $state
5441     tk_popup $menu $x $y
5442 }
5443
5444 proc diffvssel {dirn} {
5445     global rowmenuid selectedline displayorder
5446
5447     if {![info exists selectedline]} return
5448     if {$dirn} {
5449         set oldid [lindex $displayorder $selectedline]
5450         set newid $rowmenuid
5451     } else {
5452         set oldid $rowmenuid
5453         set newid [lindex $displayorder $selectedline]
5454     }
5455     addtohistory [list doseldiff $oldid $newid]
5456     doseldiff $oldid $newid
5457 }
5458
5459 proc doseldiff {oldid newid} {
5460     global ctext
5461     global commitinfo
5462
5463     $ctext conf -state normal
5464     clear_ctext
5465     init_flist "Top"
5466     $ctext insert end "From "
5467     $ctext tag conf link -foreground blue -underline 1
5468     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5469     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5470     $ctext tag bind link0 <1> [list selbyid $oldid]
5471     $ctext insert end $oldid [list link link0]
5472     $ctext insert end "\n     "
5473     $ctext insert end [lindex $commitinfo($oldid) 0]
5474     $ctext insert end "\n\nTo   "
5475     $ctext tag bind link1 <1> [list selbyid $newid]
5476     $ctext insert end $newid [list link link1]
5477     $ctext insert end "\n     "
5478     $ctext insert end [lindex $commitinfo($newid) 0]
5479     $ctext insert end "\n"
5480     $ctext conf -state disabled
5481     $ctext tag remove found 1.0 end
5482     startdiff [list $oldid $newid]
5483 }
5484
5485 proc mkpatch {} {
5486     global rowmenuid currentid commitinfo patchtop patchnum
5487
5488     if {![info exists currentid]} return
5489     set oldid $currentid
5490     set oldhead [lindex $commitinfo($oldid) 0]
5491     set newid $rowmenuid
5492     set newhead [lindex $commitinfo($newid) 0]
5493     set top .patch
5494     set patchtop $top
5495     catch {destroy $top}
5496     toplevel $top
5497     label $top.title -text "Generate patch"
5498     grid $top.title - -pady 10
5499     label $top.from -text "From:"
5500     entry $top.fromsha1 -width 40 -relief flat
5501     $top.fromsha1 insert 0 $oldid
5502     $top.fromsha1 conf -state readonly
5503     grid $top.from $top.fromsha1 -sticky w
5504     entry $top.fromhead -width 60 -relief flat
5505     $top.fromhead insert 0 $oldhead
5506     $top.fromhead conf -state readonly
5507     grid x $top.fromhead -sticky w
5508     label $top.to -text "To:"
5509     entry $top.tosha1 -width 40 -relief flat
5510     $top.tosha1 insert 0 $newid
5511     $top.tosha1 conf -state readonly
5512     grid $top.to $top.tosha1 -sticky w
5513     entry $top.tohead -width 60 -relief flat
5514     $top.tohead insert 0 $newhead
5515     $top.tohead conf -state readonly
5516     grid x $top.tohead -sticky w
5517     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5518     grid $top.rev x -pady 10
5519     label $top.flab -text "Output file:"
5520     entry $top.fname -width 60
5521     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5522     incr patchnum
5523     grid $top.flab $top.fname -sticky w
5524     frame $top.buts
5525     button $top.buts.gen -text "Generate" -command mkpatchgo
5526     button $top.buts.can -text "Cancel" -command mkpatchcan
5527     grid $top.buts.gen $top.buts.can
5528     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5529     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5530     grid $top.buts - -pady 10 -sticky ew
5531     focus $top.fname
5532 }
5533
5534 proc mkpatchrev {} {
5535     global patchtop
5536
5537     set oldid [$patchtop.fromsha1 get]
5538     set oldhead [$patchtop.fromhead get]
5539     set newid [$patchtop.tosha1 get]
5540     set newhead [$patchtop.tohead get]
5541     foreach e [list fromsha1 fromhead tosha1 tohead] \
5542             v [list $newid $newhead $oldid $oldhead] {
5543         $patchtop.$e conf -state normal
5544         $patchtop.$e delete 0 end
5545         $patchtop.$e insert 0 $v
5546         $patchtop.$e conf -state readonly
5547     }
5548 }
5549
5550 proc mkpatchgo {} {
5551     global patchtop nullid
5552
5553     set oldid [$patchtop.fromsha1 get]
5554     set newid [$patchtop.tosha1 get]
5555     set fname [$patchtop.fname get]
5556     if {$newid eq $nullid} {
5557         set cmd [list git diff-index -p $oldid]
5558     } elseif {$oldid eq $nullid} {
5559         set cmd [list git diff-index -p -R $newid]
5560     } else {
5561         set cmd [list git diff-tree -p $oldid $newid]
5562     }
5563     lappend cmd >$fname &
5564     if {[catch {eval exec $cmd} err]} {
5565         error_popup "Error creating patch: $err"
5566     }
5567     catch {destroy $patchtop}
5568     unset patchtop
5569 }
5570
5571 proc mkpatchcan {} {
5572     global patchtop
5573
5574     catch {destroy $patchtop}
5575     unset patchtop
5576 }
5577
5578 proc mktag {} {
5579     global rowmenuid mktagtop commitinfo
5580
5581     set top .maketag
5582     set mktagtop $top
5583     catch {destroy $top}
5584     toplevel $top
5585     label $top.title -text "Create tag"
5586     grid $top.title - -pady 10
5587     label $top.id -text "ID:"
5588     entry $top.sha1 -width 40 -relief flat
5589     $top.sha1 insert 0 $rowmenuid
5590     $top.sha1 conf -state readonly
5591     grid $top.id $top.sha1 -sticky w
5592     entry $top.head -width 60 -relief flat
5593     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5594     $top.head conf -state readonly
5595     grid x $top.head -sticky w
5596     label $top.tlab -text "Tag name:"
5597     entry $top.tag -width 60
5598     grid $top.tlab $top.tag -sticky w
5599     frame $top.buts
5600     button $top.buts.gen -text "Create" -command mktaggo
5601     button $top.buts.can -text "Cancel" -command mktagcan
5602     grid $top.buts.gen $top.buts.can
5603     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5604     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5605     grid $top.buts - -pady 10 -sticky ew
5606     focus $top.tag
5607 }
5608
5609 proc domktag {} {
5610     global mktagtop env tagids idtags
5611
5612     set id [$mktagtop.sha1 get]
5613     set tag [$mktagtop.tag get]
5614     if {$tag == {}} {
5615         error_popup "No tag name specified"
5616         return
5617     }
5618     if {[info exists tagids($tag)]} {
5619         error_popup "Tag \"$tag\" already exists"
5620         return
5621     }
5622     if {[catch {
5623         set dir [gitdir]
5624         set fname [file join $dir "refs/tags" $tag]
5625         set f [open $fname w]
5626         puts $f $id
5627         close $f
5628     } err]} {
5629         error_popup "Error creating tag: $err"
5630         return
5631     }
5632
5633     set tagids($tag) $id
5634     lappend idtags($id) $tag
5635     redrawtags $id
5636     addedtag $id
5637 }
5638
5639 proc redrawtags {id} {
5640     global canv linehtag commitrow idpos selectedline curview
5641     global mainfont canvxmax iddrawn
5642
5643     if {![info exists commitrow($curview,$id)]} return
5644     if {![info exists iddrawn($id)]} return
5645     drawcommits $commitrow($curview,$id)
5646     $canv delete tag.$id
5647     set xt [eval drawtags $id $idpos($id)]
5648     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5649     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5650     set xr [expr {$xt + [font measure $mainfont $text]}]
5651     if {$xr > $canvxmax} {
5652         set canvxmax $xr
5653         setcanvscroll
5654     }
5655     if {[info exists selectedline]
5656         && $selectedline == $commitrow($curview,$id)} {
5657         selectline $selectedline 0
5658     }
5659 }
5660
5661 proc mktagcan {} {
5662     global mktagtop
5663
5664     catch {destroy $mktagtop}
5665     unset mktagtop
5666 }
5667
5668 proc mktaggo {} {
5669     domktag
5670     mktagcan
5671 }
5672
5673 proc writecommit {} {
5674     global rowmenuid wrcomtop commitinfo wrcomcmd
5675
5676     set top .writecommit
5677     set wrcomtop $top
5678     catch {destroy $top}
5679     toplevel $top
5680     label $top.title -text "Write commit to file"
5681     grid $top.title - -pady 10
5682     label $top.id -text "ID:"
5683     entry $top.sha1 -width 40 -relief flat
5684     $top.sha1 insert 0 $rowmenuid
5685     $top.sha1 conf -state readonly
5686     grid $top.id $top.sha1 -sticky w
5687     entry $top.head -width 60 -relief flat
5688     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5689     $top.head conf -state readonly
5690     grid x $top.head -sticky w
5691     label $top.clab -text "Command:"
5692     entry $top.cmd -width 60 -textvariable wrcomcmd
5693     grid $top.clab $top.cmd -sticky w -pady 10
5694     label $top.flab -text "Output file:"
5695     entry $top.fname -width 60
5696     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5697     grid $top.flab $top.fname -sticky w
5698     frame $top.buts
5699     button $top.buts.gen -text "Write" -command wrcomgo
5700     button $top.buts.can -text "Cancel" -command wrcomcan
5701     grid $top.buts.gen $top.buts.can
5702     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5703     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5704     grid $top.buts - -pady 10 -sticky ew
5705     focus $top.fname
5706 }
5707
5708 proc wrcomgo {} {
5709     global wrcomtop
5710
5711     set id [$wrcomtop.sha1 get]
5712     set cmd "echo $id | [$wrcomtop.cmd get]"
5713     set fname [$wrcomtop.fname get]
5714     if {[catch {exec sh -c $cmd >$fname &} err]} {
5715         error_popup "Error writing commit: $err"
5716     }
5717     catch {destroy $wrcomtop}
5718     unset wrcomtop
5719 }
5720
5721 proc wrcomcan {} {
5722     global wrcomtop
5723
5724     catch {destroy $wrcomtop}
5725     unset wrcomtop
5726 }
5727
5728 proc mkbranch {} {
5729     global rowmenuid mkbrtop
5730
5731     set top .makebranch
5732     catch {destroy $top}
5733     toplevel $top
5734     label $top.title -text "Create new branch"
5735     grid $top.title - -pady 10
5736     label $top.id -text "ID:"
5737     entry $top.sha1 -width 40 -relief flat
5738     $top.sha1 insert 0 $rowmenuid
5739     $top.sha1 conf -state readonly
5740     grid $top.id $top.sha1 -sticky w
5741     label $top.nlab -text "Name:"
5742     entry $top.name -width 40
5743     grid $top.nlab $top.name -sticky w
5744     frame $top.buts
5745     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5746     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5747     grid $top.buts.go $top.buts.can
5748     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5749     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5750     grid $top.buts - -pady 10 -sticky ew
5751     focus $top.name
5752 }
5753
5754 proc mkbrgo {top} {
5755     global headids idheads
5756
5757     set name [$top.name get]
5758     set id [$top.sha1 get]
5759     if {$name eq {}} {
5760         error_popup "Please specify a name for the new branch"
5761         return
5762     }
5763     catch {destroy $top}
5764     nowbusy newbranch
5765     update
5766     if {[catch {
5767         exec git branch $name $id
5768     } err]} {
5769         notbusy newbranch
5770         error_popup $err
5771     } else {
5772         set headids($name) $id
5773         lappend idheads($id) $name
5774         addedhead $id $name
5775         notbusy newbranch
5776         redrawtags $id
5777         dispneartags 0
5778     }
5779 }
5780
5781 proc cherrypick {} {
5782     global rowmenuid curview commitrow
5783     global mainhead
5784
5785     set oldhead [exec git rev-parse HEAD]
5786     set dheads [descheads $rowmenuid]
5787     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5788         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5789                         included in branch $mainhead -- really re-apply it?"]
5790         if {!$ok} return
5791     }
5792     nowbusy cherrypick
5793     update
5794     # Unfortunately git-cherry-pick writes stuff to stderr even when
5795     # no error occurs, and exec takes that as an indication of error...
5796     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5797         notbusy cherrypick
5798         error_popup $err
5799         return
5800     }
5801     set newhead [exec git rev-parse HEAD]
5802     if {$newhead eq $oldhead} {
5803         notbusy cherrypick
5804         error_popup "No changes committed"
5805         return
5806     }
5807     addnewchild $newhead $oldhead
5808     if {[info exists commitrow($curview,$oldhead)]} {
5809         insertrow $commitrow($curview,$oldhead) $newhead
5810         if {$mainhead ne {}} {
5811             movehead $newhead $mainhead
5812             movedhead $newhead $mainhead
5813         }
5814         redrawtags $oldhead
5815         redrawtags $newhead
5816     }
5817     notbusy cherrypick
5818 }
5819
5820 proc resethead {} {
5821     global mainheadid mainhead rowmenuid confirm_ok resettype
5822     global showlocalchanges
5823
5824     set confirm_ok 0
5825     set w ".confirmreset"
5826     toplevel $w
5827     wm transient $w .
5828     wm title $w "Confirm reset"
5829     message $w.m -text \
5830         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5831         -justify center -aspect 1000
5832     pack $w.m -side top -fill x -padx 20 -pady 20
5833     frame $w.f -relief sunken -border 2
5834     message $w.f.rt -text "Reset type:" -aspect 1000
5835     grid $w.f.rt -sticky w
5836     set resettype mixed
5837     radiobutton $w.f.soft -value soft -variable resettype -justify left \
5838         -text "Soft: Leave working tree and index untouched"
5839     grid $w.f.soft -sticky w
5840     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5841         -text "Mixed: Leave working tree untouched, reset index"
5842     grid $w.f.mixed -sticky w
5843     radiobutton $w.f.hard -value hard -variable resettype -justify left \
5844         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5845     grid $w.f.hard -sticky w
5846     pack $w.f -side top -fill x
5847     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5848     pack $w.ok -side left -fill x -padx 20 -pady 20
5849     button $w.cancel -text Cancel -command "destroy $w"
5850     pack $w.cancel -side right -fill x -padx 20 -pady 20
5851     bind $w <Visibility> "grab $w; focus $w"
5852     tkwait window $w
5853     if {!$confirm_ok} return
5854     if {[catch {set fd [open \
5855             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
5856         error_popup $err
5857     } else {
5858         dohidelocalchanges
5859         set w ".resetprogress"
5860         filerun $fd [list readresetstat $fd $w]
5861         toplevel $w
5862         wm transient $w
5863         wm title $w "Reset progress"
5864         message $w.m -text "Reset in progress, please wait..." \
5865             -justify center -aspect 1000
5866         pack $w.m -side top -fill x -padx 20 -pady 5
5867         canvas $w.c -width 150 -height 20 -bg white
5868         $w.c create rect 0 0 0 20 -fill green -tags rect
5869         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
5870         nowbusy reset
5871     }
5872 }
5873
5874 proc readresetstat {fd w} {
5875     global mainhead mainheadid showlocalchanges
5876
5877     if {[gets $fd line] >= 0} {
5878         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
5879             set x [expr {($m * 150) / $n}]
5880             $w.c coords rect 0 0 $x 20
5881         }
5882         return 1
5883     }
5884     destroy $w
5885     notbusy reset
5886     if {[catch {close $fd} err]} {
5887         error_popup $err
5888     }
5889     set oldhead $mainheadid
5890     set newhead [exec git rev-parse HEAD]
5891     if {$newhead ne $oldhead} {
5892         movehead $newhead $mainhead
5893         movedhead $newhead $mainhead
5894         set mainheadid $newhead
5895         redrawtags $oldhead
5896         redrawtags $newhead
5897     }
5898     if {$showlocalchanges} {
5899         doshowlocalchanges
5900     }
5901     return 0
5902 }
5903
5904 # context menu for a head
5905 proc headmenu {x y id head} {
5906     global headmenuid headmenuhead headctxmenu mainhead
5907
5908     set headmenuid $id
5909     set headmenuhead $head
5910     set state normal
5911     if {$head eq $mainhead} {
5912         set state disabled
5913     }
5914     $headctxmenu entryconfigure 0 -state $state
5915     $headctxmenu entryconfigure 1 -state $state
5916     tk_popup $headctxmenu $x $y
5917 }
5918
5919 proc cobranch {} {
5920     global headmenuid headmenuhead mainhead headids
5921     global showlocalchanges mainheadid
5922
5923     # check the tree is clean first??
5924     set oldmainhead $mainhead
5925     nowbusy checkout
5926     update
5927     dohidelocalchanges
5928     if {[catch {
5929         exec git checkout -q $headmenuhead
5930     } err]} {
5931         notbusy checkout
5932         error_popup $err
5933     } else {
5934         notbusy checkout
5935         set mainhead $headmenuhead
5936         set mainheadid $headmenuid
5937         if {[info exists headids($oldmainhead)]} {
5938             redrawtags $headids($oldmainhead)
5939         }
5940         redrawtags $headmenuid
5941     }
5942     if {$showlocalchanges} {
5943         dodiffindex
5944     }
5945 }
5946
5947 proc rmbranch {} {
5948     global headmenuid headmenuhead mainhead
5949     global headids idheads
5950
5951     set head $headmenuhead
5952     set id $headmenuid
5953     # this check shouldn't be needed any more...
5954     if {$head eq $mainhead} {
5955         error_popup "Cannot delete the currently checked-out branch"
5956         return
5957     }
5958     set dheads [descheads $id]
5959     if {$dheads eq $headids($head)} {
5960         # the stuff on this branch isn't on any other branch
5961         if {![confirm_popup "The commits on branch $head aren't on any other\
5962                         branch.\nReally delete branch $head?"]} return
5963     }
5964     nowbusy rmbranch
5965     update
5966     if {[catch {exec git branch -D $head} err]} {
5967         notbusy rmbranch
5968         error_popup $err
5969         return
5970     }
5971     removehead $id $head
5972     removedhead $id $head
5973     redrawtags $id
5974     notbusy rmbranch
5975     dispneartags 0
5976 }
5977
5978 # Stuff for finding nearby tags
5979 proc getallcommits {} {
5980     global allcommits allids nbmp nextarc seeds
5981
5982     set allids {}
5983     set nbmp 0
5984     set nextarc 0
5985     set allcommits 0
5986     set seeds {}
5987     regetallcommits
5988 }
5989
5990 # Called when the graph might have changed
5991 proc regetallcommits {} {
5992     global allcommits seeds
5993
5994     set cmd [concat | git rev-list --all --parents]
5995     foreach id $seeds {
5996         lappend cmd "^$id"
5997     }
5998     set fd [open $cmd r]
5999     fconfigure $fd -blocking 0
6000     incr allcommits
6001     nowbusy allcommits
6002     filerun $fd [list getallclines $fd]
6003 }
6004
6005 # Since most commits have 1 parent and 1 child, we group strings of
6006 # such commits into "arcs" joining branch/merge points (BMPs), which
6007 # are commits that either don't have 1 parent or don't have 1 child.
6008 #
6009 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6010 # arcout(id) - outgoing arcs for BMP
6011 # arcids(a) - list of IDs on arc including end but not start
6012 # arcstart(a) - BMP ID at start of arc
6013 # arcend(a) - BMP ID at end of arc
6014 # growing(a) - arc a is still growing
6015 # arctags(a) - IDs out of arcids (excluding end) that have tags
6016 # archeads(a) - IDs out of arcids (excluding end) that have heads
6017 # The start of an arc is at the descendent end, so "incoming" means
6018 # coming from descendents, and "outgoing" means going towards ancestors.
6019
6020 proc getallclines {fd} {
6021     global allids allparents allchildren idtags idheads nextarc nbmp
6022     global arcnos arcids arctags arcout arcend arcstart archeads growing
6023     global seeds allcommits
6024
6025     set nid 0
6026     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6027         set id [lindex $line 0]
6028         if {[info exists allparents($id)]} {
6029             # seen it already
6030             continue
6031         }
6032         lappend allids $id
6033         set olds [lrange $line 1 end]
6034         set allparents($id) $olds
6035         if {![info exists allchildren($id)]} {
6036             set allchildren($id) {}
6037             set arcnos($id) {}
6038             lappend seeds $id
6039         } else {
6040             set a $arcnos($id)
6041             if {[llength $olds] == 1 && [llength $a] == 1} {
6042                 lappend arcids($a) $id
6043                 if {[info exists idtags($id)]} {
6044                     lappend arctags($a) $id
6045                 }
6046                 if {[info exists idheads($id)]} {
6047                     lappend archeads($a) $id
6048                 }
6049                 if {[info exists allparents($olds)]} {
6050                     # seen parent already
6051                     if {![info exists arcout($olds)]} {
6052                         splitarc $olds
6053                     }
6054                     lappend arcids($a) $olds
6055                     set arcend($a) $olds
6056                     unset growing($a)
6057                 }
6058                 lappend allchildren($olds) $id
6059                 lappend arcnos($olds) $a
6060                 continue
6061             }
6062         }
6063         incr nbmp
6064         foreach a $arcnos($id) {
6065             lappend arcids($a) $id
6066             set arcend($a) $id
6067             unset growing($a)
6068         }
6069
6070         set ao {}
6071         foreach p $olds {
6072             lappend allchildren($p) $id
6073             set a [incr nextarc]
6074             set arcstart($a) $id
6075             set archeads($a) {}
6076             set arctags($a) {}
6077             set archeads($a) {}
6078             set arcids($a) {}
6079             lappend ao $a
6080             set growing($a) 1
6081             if {[info exists allparents($p)]} {
6082                 # seen it already, may need to make a new branch
6083                 if {![info exists arcout($p)]} {
6084                     splitarc $p
6085                 }
6086                 lappend arcids($a) $p
6087                 set arcend($a) $p
6088                 unset growing($a)
6089             }
6090             lappend arcnos($p) $a
6091         }
6092         set arcout($id) $ao
6093     }
6094     if {$nid > 0} {
6095         global cached_dheads cached_dtags cached_atags
6096         catch {unset cached_dheads}
6097         catch {unset cached_dtags}
6098         catch {unset cached_atags}
6099     }
6100     if {![eof $fd]} {
6101         return [expr {$nid >= 1000? 2: 1}]
6102     }
6103     close $fd
6104     if {[incr allcommits -1] == 0} {
6105         notbusy allcommits
6106     }
6107     dispneartags 0
6108     return 0
6109 }
6110
6111 proc recalcarc {a} {
6112     global arctags archeads arcids idtags idheads
6113
6114     set at {}
6115     set ah {}
6116     foreach id [lrange $arcids($a) 0 end-1] {
6117         if {[info exists idtags($id)]} {
6118             lappend at $id
6119         }
6120         if {[info exists idheads($id)]} {
6121             lappend ah $id
6122         }
6123     }
6124     set arctags($a) $at
6125     set archeads($a) $ah
6126 }
6127
6128 proc splitarc {p} {
6129     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6130     global arcstart arcend arcout allparents growing
6131
6132     set a $arcnos($p)
6133     if {[llength $a] != 1} {
6134         puts "oops splitarc called but [llength $a] arcs already"
6135         return
6136     }
6137     set a [lindex $a 0]
6138     set i [lsearch -exact $arcids($a) $p]
6139     if {$i < 0} {
6140         puts "oops splitarc $p not in arc $a"
6141         return
6142     }
6143     set na [incr nextarc]
6144     if {[info exists arcend($a)]} {
6145         set arcend($na) $arcend($a)
6146     } else {
6147         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6148         set j [lsearch -exact $arcnos($l) $a]
6149         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6150     }
6151     set tail [lrange $arcids($a) [expr {$i+1}] end]
6152     set arcids($a) [lrange $arcids($a) 0 $i]
6153     set arcend($a) $p
6154     set arcstart($na) $p
6155     set arcout($p) $na
6156     set arcids($na) $tail
6157     if {[info exists growing($a)]} {
6158         set growing($na) 1
6159         unset growing($a)
6160     }
6161     incr nbmp
6162
6163     foreach id $tail {
6164         if {[llength $arcnos($id)] == 1} {
6165             set arcnos($id) $na
6166         } else {
6167             set j [lsearch -exact $arcnos($id) $a]
6168             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6169         }
6170     }
6171
6172     # reconstruct tags and heads lists
6173     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6174         recalcarc $a
6175         recalcarc $na
6176     } else {
6177         set arctags($na) {}
6178         set archeads($na) {}
6179     }
6180 }
6181
6182 # Update things for a new commit added that is a child of one
6183 # existing commit.  Used when cherry-picking.
6184 proc addnewchild {id p} {
6185     global allids allparents allchildren idtags nextarc nbmp
6186     global arcnos arcids arctags arcout arcend arcstart archeads growing
6187     global seeds
6188
6189     lappend allids $id
6190     set allparents($id) [list $p]
6191     set allchildren($id) {}
6192     set arcnos($id) {}
6193     lappend seeds $id
6194     incr nbmp
6195     lappend allchildren($p) $id
6196     set a [incr nextarc]
6197     set arcstart($a) $id
6198     set archeads($a) {}
6199     set arctags($a) {}
6200     set arcids($a) [list $p]
6201     set arcend($a) $p
6202     if {![info exists arcout($p)]} {
6203         splitarc $p
6204     }
6205     lappend arcnos($p) $a
6206     set arcout($id) [list $a]
6207 }
6208
6209 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6210 # or 0 if neither is true.
6211 proc anc_or_desc {a b} {
6212     global arcout arcstart arcend arcnos cached_isanc
6213
6214     if {$arcnos($a) eq $arcnos($b)} {
6215         # Both are on the same arc(s); either both are the same BMP,
6216         # or if one is not a BMP, the other is also not a BMP or is
6217         # the BMP at end of the arc (and it only has 1 incoming arc).
6218         if {$a eq $b} {
6219             return 0
6220         }
6221         # assert {[llength $arcnos($a)] == 1}
6222         set arc [lindex $arcnos($a) 0]
6223         set i [lsearch -exact $arcids($arc) $a]
6224         set j [lsearch -exact $arcids($arc) $b]
6225         if {$i < 0 || $i > $j} {
6226             return 1
6227         } else {
6228             return -1
6229         }
6230     }
6231
6232     if {![info exists arcout($a)]} {
6233         set arc [lindex $arcnos($a) 0]
6234         if {[info exists arcend($arc)]} {
6235             set aend $arcend($arc)
6236         } else {
6237             set aend {}
6238         }
6239         set a $arcstart($arc)
6240     } else {
6241         set aend $a
6242     }
6243     if {![info exists arcout($b)]} {
6244         set arc [lindex $arcnos($b) 0]
6245         if {[info exists arcend($arc)]} {
6246             set bend $arcend($arc)
6247         } else {
6248             set bend {}
6249         }
6250         set b $arcstart($arc)
6251     } else {
6252         set bend $b
6253     }
6254     if {$a eq $bend} {
6255         return 1
6256     }
6257     if {$b eq $aend} {
6258         return -1
6259     }
6260     if {[info exists cached_isanc($a,$bend)]} {
6261         if {$cached_isanc($a,$bend)} {
6262             return 1
6263         }
6264     }
6265     if {[info exists cached_isanc($b,$aend)]} {
6266         if {$cached_isanc($b,$aend)} {
6267             return -1
6268         }
6269         if {[info exists cached_isanc($a,$bend)]} {
6270             return 0
6271         }
6272     }
6273
6274     set todo [list $a $b]
6275     set anc($a) a
6276     set anc($b) b
6277     for {set i 0} {$i < [llength $todo]} {incr i} {
6278         set x [lindex $todo $i]
6279         if {$anc($x) eq {}} {
6280             continue
6281         }
6282         foreach arc $arcnos($x) {
6283             set xd $arcstart($arc)
6284             if {$xd eq $bend} {
6285                 set cached_isanc($a,$bend) 1
6286                 set cached_isanc($b,$aend) 0
6287                 return 1
6288             } elseif {$xd eq $aend} {
6289                 set cached_isanc($b,$aend) 1
6290                 set cached_isanc($a,$bend) 0
6291                 return -1
6292             }
6293             if {![info exists anc($xd)]} {
6294                 set anc($xd) $anc($x)
6295                 lappend todo $xd
6296             } elseif {$anc($xd) ne $anc($x)} {
6297                 set anc($xd) {}
6298             }
6299         }
6300     }
6301     set cached_isanc($a,$bend) 0
6302     set cached_isanc($b,$aend) 0
6303     return 0
6304 }
6305
6306 # This identifies whether $desc has an ancestor that is
6307 # a growing tip of the graph and which is not an ancestor of $anc
6308 # and returns 0 if so and 1 if not.
6309 # If we subsequently discover a tag on such a growing tip, and that
6310 # turns out to be a descendent of $anc (which it could, since we
6311 # don't necessarily see children before parents), then $desc
6312 # isn't a good choice to display as a descendent tag of
6313 # $anc (since it is the descendent of another tag which is
6314 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6315 # display as a ancestor tag of $desc.
6316 #
6317 proc is_certain {desc anc} {
6318     global arcnos arcout arcstart arcend growing problems
6319
6320     set certain {}
6321     if {[llength $arcnos($anc)] == 1} {
6322         # tags on the same arc are certain
6323         if {$arcnos($desc) eq $arcnos($anc)} {
6324             return 1
6325         }
6326         if {![info exists arcout($anc)]} {
6327             # if $anc is partway along an arc, use the start of the arc instead
6328             set a [lindex $arcnos($anc) 0]
6329             set anc $arcstart($a)
6330         }
6331     }
6332     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6333         set x $desc
6334     } else {
6335         set a [lindex $arcnos($desc) 0]
6336         set x $arcend($a)
6337     }
6338     if {$x == $anc} {
6339         return 1
6340     }
6341     set anclist [list $x]
6342     set dl($x) 1
6343     set nnh 1
6344     set ngrowanc 0
6345     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6346         set x [lindex $anclist $i]
6347         if {$dl($x)} {
6348             incr nnh -1
6349         }
6350         set done($x) 1
6351         foreach a $arcout($x) {
6352             if {[info exists growing($a)]} {
6353                 if {![info exists growanc($x)] && $dl($x)} {
6354                     set growanc($x) 1
6355                     incr ngrowanc
6356                 }
6357             } else {
6358                 set y $arcend($a)
6359                 if {[info exists dl($y)]} {
6360                     if {$dl($y)} {
6361                         if {!$dl($x)} {
6362                             set dl($y) 0
6363                             if {![info exists done($y)]} {
6364                                 incr nnh -1
6365                             }
6366                             if {[info exists growanc($x)]} {
6367                                 incr ngrowanc -1
6368                             }
6369                             set xl [list $y]
6370                             for {set k 0} {$k < [llength $xl]} {incr k} {
6371                                 set z [lindex $xl $k]
6372                                 foreach c $arcout($z) {
6373                                     if {[info exists arcend($c)]} {
6374                                         set v $arcend($c)
6375                                         if {[info exists dl($v)] && $dl($v)} {
6376                                             set dl($v) 0
6377                                             if {![info exists done($v)]} {
6378                                                 incr nnh -1
6379                                             }
6380                                             if {[info exists growanc($v)]} {
6381                                                 incr ngrowanc -1
6382                                             }
6383                                             lappend xl $v
6384                                         }
6385                                     }
6386                                 }
6387                             }
6388                         }
6389                     }
6390                 } elseif {$y eq $anc || !$dl($x)} {
6391                     set dl($y) 0
6392                     lappend anclist $y
6393                 } else {
6394                     set dl($y) 1
6395                     lappend anclist $y
6396                     incr nnh
6397                 }
6398             }
6399         }
6400     }
6401     foreach x [array names growanc] {
6402         if {$dl($x)} {
6403             return 0
6404         }
6405         return 0
6406     }
6407     return 1
6408 }
6409
6410 proc validate_arctags {a} {
6411     global arctags idtags
6412
6413     set i -1
6414     set na $arctags($a)
6415     foreach id $arctags($a) {
6416         incr i
6417         if {![info exists idtags($id)]} {
6418             set na [lreplace $na $i $i]
6419             incr i -1
6420         }
6421     }
6422     set arctags($a) $na
6423 }
6424
6425 proc validate_archeads {a} {
6426     global archeads idheads
6427
6428     set i -1
6429     set na $archeads($a)
6430     foreach id $archeads($a) {
6431         incr i
6432         if {![info exists idheads($id)]} {
6433             set na [lreplace $na $i $i]
6434             incr i -1
6435         }
6436     }
6437     set archeads($a) $na
6438 }
6439
6440 # Return the list of IDs that have tags that are descendents of id,
6441 # ignoring IDs that are descendents of IDs already reported.
6442 proc desctags {id} {
6443     global arcnos arcstart arcids arctags idtags allparents
6444     global growing cached_dtags
6445
6446     if {![info exists allparents($id)]} {
6447         return {}
6448     }
6449     set t1 [clock clicks -milliseconds]
6450     set argid $id
6451     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6452         # part-way along an arc; check that arc first
6453         set a [lindex $arcnos($id) 0]
6454         if {$arctags($a) ne {}} {
6455             validate_arctags $a
6456             set i [lsearch -exact $arcids($a) $id]
6457             set tid {}
6458             foreach t $arctags($a) {
6459                 set j [lsearch -exact $arcids($a) $t]
6460                 if {$j >= $i} break
6461                 set tid $t
6462             }
6463             if {$tid ne {}} {
6464                 return $tid
6465             }
6466         }
6467         set id $arcstart($a)
6468         if {[info exists idtags($id)]} {
6469             return $id
6470         }
6471     }
6472     if {[info exists cached_dtags($id)]} {
6473         return $cached_dtags($id)
6474     }
6475
6476     set origid $id
6477     set todo [list $id]
6478     set queued($id) 1
6479     set nc 1
6480     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6481         set id [lindex $todo $i]
6482         set done($id) 1
6483         set ta [info exists hastaggedancestor($id)]
6484         if {!$ta} {
6485             incr nc -1
6486         }
6487         # ignore tags on starting node
6488         if {!$ta && $i > 0} {
6489             if {[info exists idtags($id)]} {
6490                 set tagloc($id) $id
6491                 set ta 1
6492             } elseif {[info exists cached_dtags($id)]} {
6493                 set tagloc($id) $cached_dtags($id)
6494                 set ta 1
6495             }
6496         }
6497         foreach a $arcnos($id) {
6498             set d $arcstart($a)
6499             if {!$ta && $arctags($a) ne {}} {
6500                 validate_arctags $a
6501                 if {$arctags($a) ne {}} {
6502                     lappend tagloc($id) [lindex $arctags($a) end]
6503                 }
6504             }
6505             if {$ta || $arctags($a) ne {}} {
6506                 set tomark [list $d]
6507                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6508                     set dd [lindex $tomark $j]
6509                     if {![info exists hastaggedancestor($dd)]} {
6510                         if {[info exists done($dd)]} {
6511                             foreach b $arcnos($dd) {
6512                                 lappend tomark $arcstart($b)
6513                             }
6514                             if {[info exists tagloc($dd)]} {
6515                                 unset tagloc($dd)
6516                             }
6517                         } elseif {[info exists queued($dd)]} {
6518                             incr nc -1
6519                         }
6520                         set hastaggedancestor($dd) 1
6521                     }
6522                 }
6523             }
6524             if {![info exists queued($d)]} {
6525                 lappend todo $d
6526                 set queued($d) 1
6527                 if {![info exists hastaggedancestor($d)]} {
6528                     incr nc
6529                 }
6530             }
6531         }
6532     }
6533     set tags {}
6534     foreach id [array names tagloc] {
6535         if {![info exists hastaggedancestor($id)]} {
6536             foreach t $tagloc($id) {
6537                 if {[lsearch -exact $tags $t] < 0} {
6538                     lappend tags $t
6539                 }
6540             }
6541         }
6542     }
6543     set t2 [clock clicks -milliseconds]
6544     set loopix $i
6545
6546     # remove tags that are descendents of other tags
6547     for {set i 0} {$i < [llength $tags]} {incr i} {
6548         set a [lindex $tags $i]
6549         for {set j 0} {$j < $i} {incr j} {
6550             set b [lindex $tags $j]
6551             set r [anc_or_desc $a $b]
6552             if {$r == 1} {
6553                 set tags [lreplace $tags $j $j]
6554                 incr j -1
6555                 incr i -1
6556             } elseif {$r == -1} {
6557                 set tags [lreplace $tags $i $i]
6558                 incr i -1
6559                 break
6560             }
6561         }
6562     }
6563
6564     if {[array names growing] ne {}} {
6565         # graph isn't finished, need to check if any tag could get
6566         # eclipsed by another tag coming later.  Simply ignore any
6567         # tags that could later get eclipsed.
6568         set ctags {}
6569         foreach t $tags {
6570             if {[is_certain $t $origid]} {
6571                 lappend ctags $t
6572             }
6573         }
6574         if {$tags eq $ctags} {
6575             set cached_dtags($origid) $tags
6576         } else {
6577             set tags $ctags
6578         }
6579     } else {
6580         set cached_dtags($origid) $tags
6581     }
6582     set t3 [clock clicks -milliseconds]
6583     if {0 && $t3 - $t1 >= 100} {
6584         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6585             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6586     }
6587     return $tags
6588 }
6589
6590 proc anctags {id} {
6591     global arcnos arcids arcout arcend arctags idtags allparents
6592     global growing cached_atags
6593
6594     if {![info exists allparents($id)]} {
6595         return {}
6596     }
6597     set t1 [clock clicks -milliseconds]
6598     set argid $id
6599     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6600         # part-way along an arc; check that arc first
6601         set a [lindex $arcnos($id) 0]
6602         if {$arctags($a) ne {}} {
6603             validate_arctags $a
6604             set i [lsearch -exact $arcids($a) $id]
6605             foreach t $arctags($a) {
6606                 set j [lsearch -exact $arcids($a) $t]
6607                 if {$j > $i} {
6608                     return $t
6609                 }
6610             }
6611         }
6612         if {![info exists arcend($a)]} {
6613             return {}
6614         }
6615         set id $arcend($a)
6616         if {[info exists idtags($id)]} {
6617             return $id
6618         }
6619     }
6620     if {[info exists cached_atags($id)]} {
6621         return $cached_atags($id)
6622     }
6623
6624     set origid $id
6625     set todo [list $id]
6626     set queued($id) 1
6627     set taglist {}
6628     set nc 1
6629     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6630         set id [lindex $todo $i]
6631         set done($id) 1
6632         set td [info exists hastaggeddescendent($id)]
6633         if {!$td} {
6634             incr nc -1
6635         }
6636         # ignore tags on starting node
6637         if {!$td && $i > 0} {
6638             if {[info exists idtags($id)]} {
6639                 set tagloc($id) $id
6640                 set td 1
6641             } elseif {[info exists cached_atags($id)]} {
6642                 set tagloc($id) $cached_atags($id)
6643                 set td 1
6644             }
6645         }
6646         foreach a $arcout($id) {
6647             if {!$td && $arctags($a) ne {}} {
6648                 validate_arctags $a
6649                 if {$arctags($a) ne {}} {
6650                     lappend tagloc($id) [lindex $arctags($a) 0]
6651                 }
6652             }
6653             if {![info exists arcend($a)]} continue
6654             set d $arcend($a)
6655             if {$td || $arctags($a) ne {}} {
6656                 set tomark [list $d]
6657                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6658                     set dd [lindex $tomark $j]
6659                     if {![info exists hastaggeddescendent($dd)]} {
6660                         if {[info exists done($dd)]} {
6661                             foreach b $arcout($dd) {
6662                                 if {[info exists arcend($b)]} {
6663                                     lappend tomark $arcend($b)
6664                                 }
6665                             }
6666                             if {[info exists tagloc($dd)]} {
6667                                 unset tagloc($dd)
6668                             }
6669                         } elseif {[info exists queued($dd)]} {
6670                             incr nc -1
6671                         }
6672                         set hastaggeddescendent($dd) 1
6673                     }
6674                 }
6675             }
6676             if {![info exists queued($d)]} {
6677                 lappend todo $d
6678                 set queued($d) 1
6679                 if {![info exists hastaggeddescendent($d)]} {
6680                     incr nc
6681                 }
6682             }
6683         }
6684     }
6685     set t2 [clock clicks -milliseconds]
6686     set loopix $i
6687     set tags {}
6688     foreach id [array names tagloc] {
6689         if {![info exists hastaggeddescendent($id)]} {
6690             foreach t $tagloc($id) {
6691                 if {[lsearch -exact $tags $t] < 0} {
6692                     lappend tags $t
6693                 }
6694             }
6695         }
6696     }
6697
6698     # remove tags that are ancestors of other tags
6699     for {set i 0} {$i < [llength $tags]} {incr i} {
6700         set a [lindex $tags $i]
6701         for {set j 0} {$j < $i} {incr j} {
6702             set b [lindex $tags $j]
6703             set r [anc_or_desc $a $b]
6704             if {$r == -1} {
6705                 set tags [lreplace $tags $j $j]
6706                 incr j -1
6707                 incr i -1
6708             } elseif {$r == 1} {
6709                 set tags [lreplace $tags $i $i]
6710                 incr i -1
6711                 break
6712             }
6713         }
6714     }
6715
6716     if {[array names growing] ne {}} {
6717         # graph isn't finished, need to check if any tag could get
6718         # eclipsed by another tag coming later.  Simply ignore any
6719         # tags that could later get eclipsed.
6720         set ctags {}
6721         foreach t $tags {
6722             if {[is_certain $origid $t]} {
6723                 lappend ctags $t
6724             }
6725         }
6726         if {$tags eq $ctags} {
6727             set cached_atags($origid) $tags
6728         } else {
6729             set tags $ctags
6730         }
6731     } else {
6732         set cached_atags($origid) $tags
6733     }
6734     set t3 [clock clicks -milliseconds]
6735     if {0 && $t3 - $t1 >= 100} {
6736         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6737             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6738     }
6739     return $tags
6740 }
6741
6742 # Return the list of IDs that have heads that are descendents of id,
6743 # including id itself if it has a head.
6744 proc descheads {id} {
6745     global arcnos arcstart arcids archeads idheads cached_dheads
6746     global allparents
6747
6748     if {![info exists allparents($id)]} {
6749         return {}
6750     }
6751     set aret {}
6752     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6753         # part-way along an arc; check it first
6754         set a [lindex $arcnos($id) 0]
6755         if {$archeads($a) ne {}} {
6756             validate_archeads $a
6757             set i [lsearch -exact $arcids($a) $id]
6758             foreach t $archeads($a) {
6759                 set j [lsearch -exact $arcids($a) $t]
6760                 if {$j > $i} break
6761                 lappend aret $t
6762             }
6763         }
6764         set id $arcstart($a)
6765     }
6766     set origid $id
6767     set todo [list $id]
6768     set seen($id) 1
6769     set ret {}
6770     for {set i 0} {$i < [llength $todo]} {incr i} {
6771         set id [lindex $todo $i]
6772         if {[info exists cached_dheads($id)]} {
6773             set ret [concat $ret $cached_dheads($id)]
6774         } else {
6775             if {[info exists idheads($id)]} {
6776                 lappend ret $id
6777             }
6778             foreach a $arcnos($id) {
6779                 if {$archeads($a) ne {}} {
6780                     validate_archeads $a
6781                     if {$archeads($a) ne {}} {
6782                         set ret [concat $ret $archeads($a)]
6783                     }
6784                 }
6785                 set d $arcstart($a)
6786                 if {![info exists seen($d)]} {
6787                     lappend todo $d
6788                     set seen($d) 1
6789                 }
6790             }
6791         }
6792     }
6793     set ret [lsort -unique $ret]
6794     set cached_dheads($origid) $ret
6795     return [concat $ret $aret]
6796 }
6797
6798 proc addedtag {id} {
6799     global arcnos arcout cached_dtags cached_atags
6800
6801     if {![info exists arcnos($id)]} return
6802     if {![info exists arcout($id)]} {
6803         recalcarc [lindex $arcnos($id) 0]
6804     }
6805     catch {unset cached_dtags}
6806     catch {unset cached_atags}
6807 }
6808
6809 proc addedhead {hid head} {
6810     global arcnos arcout cached_dheads
6811
6812     if {![info exists arcnos($hid)]} return
6813     if {![info exists arcout($hid)]} {
6814         recalcarc [lindex $arcnos($hid) 0]
6815     }
6816     catch {unset cached_dheads}
6817 }
6818
6819 proc removedhead {hid head} {
6820     global cached_dheads
6821
6822     catch {unset cached_dheads}
6823 }
6824
6825 proc movedhead {hid head} {
6826     global arcnos arcout cached_dheads
6827
6828     if {![info exists arcnos($hid)]} return
6829     if {![info exists arcout($hid)]} {
6830         recalcarc [lindex $arcnos($hid) 0]
6831     }
6832     catch {unset cached_dheads}
6833 }
6834
6835 proc changedrefs {} {
6836     global cached_dheads cached_dtags cached_atags
6837     global arctags archeads arcnos arcout idheads idtags
6838
6839     foreach id [concat [array names idheads] [array names idtags]] {
6840         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6841             set a [lindex $arcnos($id) 0]
6842             if {![info exists donearc($a)]} {
6843                 recalcarc $a
6844                 set donearc($a) 1
6845             }
6846         }
6847     }
6848     catch {unset cached_dtags}
6849     catch {unset cached_atags}
6850     catch {unset cached_dheads}
6851 }
6852
6853 proc rereadrefs {} {
6854     global idtags idheads idotherrefs mainhead
6855
6856     set refids [concat [array names idtags] \
6857                     [array names idheads] [array names idotherrefs]]
6858     foreach id $refids {
6859         if {![info exists ref($id)]} {
6860             set ref($id) [listrefs $id]
6861         }
6862     }
6863     set oldmainhead $mainhead
6864     readrefs
6865     changedrefs
6866     set refids [lsort -unique [concat $refids [array names idtags] \
6867                         [array names idheads] [array names idotherrefs]]]
6868     foreach id $refids {
6869         set v [listrefs $id]
6870         if {![info exists ref($id)] || $ref($id) != $v ||
6871             ($id eq $oldmainhead && $id ne $mainhead) ||
6872             ($id eq $mainhead && $id ne $oldmainhead)} {
6873             redrawtags $id
6874         }
6875     }
6876 }
6877
6878 proc listrefs {id} {
6879     global idtags idheads idotherrefs
6880
6881     set x {}
6882     if {[info exists idtags($id)]} {
6883         set x $idtags($id)
6884     }
6885     set y {}
6886     if {[info exists idheads($id)]} {
6887         set y $idheads($id)
6888     }
6889     set z {}
6890     if {[info exists idotherrefs($id)]} {
6891         set z $idotherrefs($id)
6892     }
6893     return [list $x $y $z]
6894 }
6895
6896 proc showtag {tag isnew} {
6897     global ctext tagcontents tagids linknum tagobjid
6898
6899     if {$isnew} {
6900         addtohistory [list showtag $tag 0]
6901     }
6902     $ctext conf -state normal
6903     clear_ctext
6904     set linknum 0
6905     if {![info exists tagcontents($tag)]} {
6906         catch {
6907             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6908         }
6909     }
6910     if {[info exists tagcontents($tag)]} {
6911         set text $tagcontents($tag)
6912     } else {
6913         set text "Tag: $tag\nId:  $tagids($tag)"
6914     }
6915     appendwithlinks $text {}
6916     $ctext conf -state disabled
6917     init_flist {}
6918 }
6919
6920 proc doquit {} {
6921     global stopped
6922     set stopped 100
6923     savestuff .
6924     destroy .
6925 }
6926
6927 proc doprefs {} {
6928     global maxwidth maxgraphpct diffopts
6929     global oldprefs prefstop showneartags showlocalchanges
6930     global bgcolor fgcolor ctext diffcolors selectbgcolor
6931     global uifont tabstop
6932
6933     set top .gitkprefs
6934     set prefstop $top
6935     if {[winfo exists $top]} {
6936         raise $top
6937         return
6938     }
6939     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6940         set oldprefs($v) [set $v]
6941     }
6942     toplevel $top
6943     wm title $top "Gitk preferences"
6944     label $top.ldisp -text "Commit list display options"
6945     $top.ldisp configure -font $uifont
6946     grid $top.ldisp - -sticky w -pady 10
6947     label $top.spacer -text " "
6948     label $top.maxwidthl -text "Maximum graph width (lines)" \
6949         -font optionfont
6950     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6951     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6952     label $top.maxpctl -text "Maximum graph width (% of pane)" \
6953         -font optionfont
6954     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6955     grid x $top.maxpctl $top.maxpct -sticky w
6956     frame $top.showlocal
6957     label $top.showlocal.l -text "Show local changes" -font optionfont
6958     checkbutton $top.showlocal.b -variable showlocalchanges
6959     pack $top.showlocal.b $top.showlocal.l -side left
6960     grid x $top.showlocal -sticky w
6961
6962     label $top.ddisp -text "Diff display options"
6963     $top.ddisp configure -font $uifont
6964     grid $top.ddisp - -sticky w -pady 10
6965     label $top.diffoptl -text "Options for diff program" \
6966         -font optionfont
6967     entry $top.diffopt -width 20 -textvariable diffopts
6968     grid x $top.diffoptl $top.diffopt -sticky w
6969     frame $top.ntag
6970     label $top.ntag.l -text "Display nearby tags" -font optionfont
6971     checkbutton $top.ntag.b -variable showneartags
6972     pack $top.ntag.b $top.ntag.l -side left
6973     grid x $top.ntag -sticky w
6974     label $top.tabstopl -text "tabstop" -font optionfont
6975     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
6976     grid x $top.tabstopl $top.tabstop -sticky w
6977
6978     label $top.cdisp -text "Colors: press to choose"
6979     $top.cdisp configure -font $uifont
6980     grid $top.cdisp - -sticky w -pady 10
6981     label $top.bg -padx 40 -relief sunk -background $bgcolor
6982     button $top.bgbut -text "Background" -font optionfont \
6983         -command [list choosecolor bgcolor 0 $top.bg background setbg]
6984     grid x $top.bgbut $top.bg -sticky w
6985     label $top.fg -padx 40 -relief sunk -background $fgcolor
6986     button $top.fgbut -text "Foreground" -font optionfont \
6987         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6988     grid x $top.fgbut $top.fg -sticky w
6989     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6990     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6991         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6992                       [list $ctext tag conf d0 -foreground]]
6993     grid x $top.diffoldbut $top.diffold -sticky w
6994     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6995     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6996         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6997                       [list $ctext tag conf d1 -foreground]]
6998     grid x $top.diffnewbut $top.diffnew -sticky w
6999     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7000     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7001         -command [list choosecolor diffcolors 2 $top.hunksep \
7002                       "diff hunk header" \
7003                       [list $ctext tag conf hunksep -foreground]]
7004     grid x $top.hunksepbut $top.hunksep -sticky w
7005     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7006     button $top.selbgbut -text "Select bg" -font optionfont \
7007         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7008     grid x $top.selbgbut $top.selbgsep -sticky w
7009
7010     frame $top.buts
7011     button $top.buts.ok -text "OK" -command prefsok -default active
7012     $top.buts.ok configure -font $uifont
7013     button $top.buts.can -text "Cancel" -command prefscan -default normal
7014     $top.buts.can configure -font $uifont
7015     grid $top.buts.ok $top.buts.can
7016     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7017     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7018     grid $top.buts - - -pady 10 -sticky ew
7019     bind $top <Visibility> "focus $top.buts.ok"
7020 }
7021
7022 proc choosecolor {v vi w x cmd} {
7023     global $v
7024
7025     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7026                -title "Gitk: choose color for $x"]
7027     if {$c eq {}} return
7028     $w conf -background $c
7029     lset $v $vi $c
7030     eval $cmd $c
7031 }
7032
7033 proc setselbg {c} {
7034     global bglist cflist
7035     foreach w $bglist {
7036         $w configure -selectbackground $c
7037     }
7038     $cflist tag configure highlight \
7039         -background [$cflist cget -selectbackground]
7040     allcanvs itemconf secsel -fill $c
7041 }
7042
7043 proc setbg {c} {
7044     global bglist
7045
7046     foreach w $bglist {
7047         $w conf -background $c
7048     }
7049 }
7050
7051 proc setfg {c} {
7052     global fglist canv
7053
7054     foreach w $fglist {
7055         $w conf -foreground $c
7056     }
7057     allcanvs itemconf text -fill $c
7058     $canv itemconf circle -outline $c
7059 }
7060
7061 proc prefscan {} {
7062     global maxwidth maxgraphpct diffopts
7063     global oldprefs prefstop showneartags showlocalchanges
7064
7065     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7066         set $v $oldprefs($v)
7067     }
7068     catch {destroy $prefstop}
7069     unset prefstop
7070 }
7071
7072 proc prefsok {} {
7073     global maxwidth maxgraphpct
7074     global oldprefs prefstop showneartags showlocalchanges
7075     global charspc ctext tabstop
7076
7077     catch {destroy $prefstop}
7078     unset prefstop
7079     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7080     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7081         if {$showlocalchanges} {
7082             doshowlocalchanges
7083         } else {
7084             dohidelocalchanges
7085         }
7086     }
7087     if {$maxwidth != $oldprefs(maxwidth)
7088         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7089         redisplay
7090     } elseif {$showneartags != $oldprefs(showneartags)} {
7091         reselectline
7092     }
7093 }
7094
7095 proc formatdate {d} {
7096     if {$d ne {}} {
7097         set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7098     }
7099     return $d
7100 }
7101
7102 # This list of encoding names and aliases is distilled from
7103 # http://www.iana.org/assignments/character-sets.
7104 # Not all of them are supported by Tcl.
7105 set encoding_aliases {
7106     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7107       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7108     { ISO-10646-UTF-1 csISO10646UTF1 }
7109     { ISO_646.basic:1983 ref csISO646basic1983 }
7110     { INVARIANT csINVARIANT }
7111     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7112     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7113     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7114     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7115     { NATS-DANO iso-ir-9-1 csNATSDANO }
7116     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7117     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7118     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7119     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7120     { ISO-2022-KR csISO2022KR }
7121     { EUC-KR csEUCKR }
7122     { ISO-2022-JP csISO2022JP }
7123     { ISO-2022-JP-2 csISO2022JP2 }
7124     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7125       csISO13JISC6220jp }
7126     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7127     { IT iso-ir-15 ISO646-IT csISO15Italian }
7128     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7129     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7130     { greek7-old iso-ir-18 csISO18Greek7Old }
7131     { latin-greek iso-ir-19 csISO19LatinGreek }
7132     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7133     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7134     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7135     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7136     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7137     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7138     { INIS iso-ir-49 csISO49INIS }
7139     { INIS-8 iso-ir-50 csISO50INIS8 }
7140     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7141     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7142     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7143     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7144     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7145     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7146       csISO60Norwegian1 }
7147     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7148     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7149     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7150     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7151     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7152     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7153     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7154     { greek7 iso-ir-88 csISO88Greek7 }
7155     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7156     { iso-ir-90 csISO90 }
7157     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7158     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7159       csISO92JISC62991984b }
7160     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7161     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7162     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7163       csISO95JIS62291984handadd }
7164     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7165     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7166     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7167     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7168       CP819 csISOLatin1 }
7169     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7170     { T.61-7bit iso-ir-102 csISO102T617bit }
7171     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7172     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7173     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7174     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7175     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7176     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7177     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7178     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7179       arabic csISOLatinArabic }
7180     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7181     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7182     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7183       greek greek8 csISOLatinGreek }
7184     { T.101-G2 iso-ir-128 csISO128T101G2 }
7185     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7186       csISOLatinHebrew }
7187     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7188     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7189     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7190     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7191     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7192     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7193     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7194       csISOLatinCyrillic }
7195     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7196     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7197     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7198     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7199     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7200     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7201     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7202     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7203     { ISO_10367-box iso-ir-155 csISO10367Box }
7204     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7205     { latin-lap lap iso-ir-158 csISO158Lap }
7206     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7207     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7208     { us-dk csUSDK }
7209     { dk-us csDKUS }
7210     { JIS_X0201 X0201 csHalfWidthKatakana }
7211     { KSC5636 ISO646-KR csKSC5636 }
7212     { ISO-10646-UCS-2 csUnicode }
7213     { ISO-10646-UCS-4 csUCS4 }
7214     { DEC-MCS dec csDECMCS }
7215     { hp-roman8 roman8 r8 csHPRoman8 }
7216     { macintosh mac csMacintosh }
7217     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7218       csIBM037 }
7219     { IBM038 EBCDIC-INT cp038 csIBM038 }
7220     { IBM273 CP273 csIBM273 }
7221     { IBM274 EBCDIC-BE CP274 csIBM274 }
7222     { IBM275 EBCDIC-BR cp275 csIBM275 }
7223     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7224     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7225     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7226     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7227     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7228     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7229     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7230     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7231     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7232     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7233     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7234     { IBM437 cp437 437 csPC8CodePage437 }
7235     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7236     { IBM775 cp775 csPC775Baltic }
7237     { IBM850 cp850 850 csPC850Multilingual }
7238     { IBM851 cp851 851 csIBM851 }
7239     { IBM852 cp852 852 csPCp852 }
7240     { IBM855 cp855 855 csIBM855 }
7241     { IBM857 cp857 857 csIBM857 }
7242     { IBM860 cp860 860 csIBM860 }
7243     { IBM861 cp861 861 cp-is csIBM861 }
7244     { IBM862 cp862 862 csPC862LatinHebrew }
7245     { IBM863 cp863 863 csIBM863 }
7246     { IBM864 cp864 csIBM864 }
7247     { IBM865 cp865 865 csIBM865 }
7248     { IBM866 cp866 866 csIBM866 }
7249     { IBM868 CP868 cp-ar csIBM868 }
7250     { IBM869 cp869 869 cp-gr csIBM869 }
7251     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7252     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7253     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7254     { IBM891 cp891 csIBM891 }
7255     { IBM903 cp903 csIBM903 }
7256     { IBM904 cp904 904 csIBBM904 }
7257     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7258     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7259     { IBM1026 CP1026 csIBM1026 }
7260     { EBCDIC-AT-DE csIBMEBCDICATDE }
7261     { EBCDIC-AT-DE-A csEBCDICATDEA }
7262     { EBCDIC-CA-FR csEBCDICCAFR }
7263     { EBCDIC-DK-NO csEBCDICDKNO }
7264     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7265     { EBCDIC-FI-SE csEBCDICFISE }
7266     { EBCDIC-FI-SE-A csEBCDICFISEA }
7267     { EBCDIC-FR csEBCDICFR }
7268     { EBCDIC-IT csEBCDICIT }
7269     { EBCDIC-PT csEBCDICPT }
7270     { EBCDIC-ES csEBCDICES }
7271     { EBCDIC-ES-A csEBCDICESA }
7272     { EBCDIC-ES-S csEBCDICESS }
7273     { EBCDIC-UK csEBCDICUK }
7274     { EBCDIC-US csEBCDICUS }
7275     { UNKNOWN-8BIT csUnknown8BiT }
7276     { MNEMONIC csMnemonic }
7277     { MNEM csMnem }
7278     { VISCII csVISCII }
7279     { VIQR csVIQR }
7280     { KOI8-R csKOI8R }
7281     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7282     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7283     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7284     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7285     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7286     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7287     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7288     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7289     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7290     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7291     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7292     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7293     { IBM1047 IBM-1047 }
7294     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7295     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7296     { UNICODE-1-1 csUnicode11 }
7297     { CESU-8 csCESU-8 }
7298     { BOCU-1 csBOCU-1 }
7299     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7300     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7301       l8 }
7302     { ISO-8859-15 ISO_8859-15 Latin-9 }
7303     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7304     { GBK CP936 MS936 windows-936 }
7305     { JIS_Encoding csJISEncoding }
7306     { Shift_JIS MS_Kanji csShiftJIS }
7307     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7308       EUC-JP }
7309     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7310     { ISO-10646-UCS-Basic csUnicodeASCII }
7311     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7312     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7313     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7314     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7315     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7316     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7317     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7318     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7319     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7320     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7321     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7322     { Ventura-US csVenturaUS }
7323     { Ventura-International csVenturaInternational }
7324     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7325     { PC8-Turkish csPC8Turkish }
7326     { IBM-Symbols csIBMSymbols }
7327     { IBM-Thai csIBMThai }
7328     { HP-Legal csHPLegal }
7329     { HP-Pi-font csHPPiFont }
7330     { HP-Math8 csHPMath8 }
7331     { Adobe-Symbol-Encoding csHPPSMath }
7332     { HP-DeskTop csHPDesktop }
7333     { Ventura-Math csVenturaMath }
7334     { Microsoft-Publishing csMicrosoftPublishing }
7335     { Windows-31J csWindows31J }
7336     { GB2312 csGB2312 }
7337     { Big5 csBig5 }
7338 }
7339
7340 proc tcl_encoding {enc} {
7341     global encoding_aliases
7342     set names [encoding names]
7343     set lcnames [string tolower $names]
7344     set enc [string tolower $enc]
7345     set i [lsearch -exact $lcnames $enc]
7346     if {$i < 0} {
7347         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7348         if {[regsub {^iso[-_]} $enc iso encx]} {
7349             set i [lsearch -exact $lcnames $encx]
7350         }
7351     }
7352     if {$i < 0} {
7353         foreach l $encoding_aliases {
7354             set ll [string tolower $l]
7355             if {[lsearch -exact $ll $enc] < 0} continue
7356             # look through the aliases for one that tcl knows about
7357             foreach e $ll {
7358                 set i [lsearch -exact $lcnames $e]
7359                 if {$i < 0} {
7360                     if {[regsub {^iso[-_]} $e iso ex]} {
7361                         set i [lsearch -exact $lcnames $ex]
7362                     }
7363                 }
7364                 if {$i >= 0} break
7365             }
7366             break
7367         }
7368     }
7369     if {$i >= 0} {
7370         return [lindex $names $i]
7371     }
7372     return {}
7373 }
7374
7375 # defaults...
7376 set datemode 0
7377 set diffopts "-U 5 -p"
7378 set wrcomcmd "git diff-tree --stdin -p --pretty"
7379
7380 set gitencoding {}
7381 catch {
7382     set gitencoding [exec git config --get i18n.commitencoding]
7383 }
7384 if {$gitencoding == ""} {
7385     set gitencoding "utf-8"
7386 }
7387 set tclencoding [tcl_encoding $gitencoding]
7388 if {$tclencoding == {}} {
7389     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7390 }
7391
7392 set mainfont {Helvetica 9}
7393 set textfont {Courier 9}
7394 set uifont {Helvetica 9 bold}
7395 set tabstop 8
7396 set findmergefiles 0
7397 set maxgraphpct 50
7398 set maxwidth 16
7399 set revlistorder 0
7400 set fastdate 0
7401 set uparrowlen 7
7402 set downarrowlen 7
7403 set mingaplen 30
7404 set cmitmode "patch"
7405 set wrapcomment "none"
7406 set showneartags 1
7407 set maxrefs 20
7408 set maxlinelen 200
7409 set showlocalchanges 1
7410
7411 set colors {green red blue magenta darkgrey brown orange}
7412 set bgcolor white
7413 set fgcolor black
7414 set diffcolors {red "#00a000" blue}
7415 set selectbgcolor gray85
7416
7417 catch {source ~/.gitk}
7418
7419 font create optionfont -family sans-serif -size -12
7420
7421 set revtreeargs {}
7422 foreach arg $argv {
7423     switch -regexp -- $arg {
7424         "^$" { }
7425         "^-d" { set datemode 1 }
7426         default {
7427             lappend revtreeargs $arg
7428         }
7429     }
7430 }
7431
7432 # check that we can find a .git directory somewhere...
7433 set gitdir [gitdir]
7434 if {![file isdirectory $gitdir]} {
7435     show_error {} . "Cannot find the git directory \"$gitdir\"."
7436     exit 1
7437 }
7438
7439 set cmdline_files {}
7440 set i [lsearch -exact $revtreeargs "--"]
7441 if {$i >= 0} {
7442     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
7443     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
7444 } elseif {$revtreeargs ne {}} {
7445     if {[catch {
7446         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7447         set cmdline_files [split $f "\n"]
7448         set n [llength $cmdline_files]
7449         set revtreeargs [lrange $revtreeargs 0 end-$n]
7450     } err]} {
7451         # unfortunately we get both stdout and stderr in $err,
7452         # so look for "fatal:".
7453         set i [string first "fatal:" $err]
7454         if {$i > 0} {
7455             set err [string range $err [expr {$i + 6}] end]
7456         }
7457         show_error {} . "Bad arguments to gitk:\n$err"
7458         exit 1
7459     }
7460 }
7461
7462 set nullid "0000000000000000000000000000000000000000"
7463
7464 set runq {}
7465 set history {}
7466 set historyindex 0
7467 set fh_serial 0
7468 set nhl_names {}
7469 set highlight_paths {}
7470 set searchdirn -forwards
7471 set boldrows {}
7472 set boldnamerows {}
7473 set diffelide {0 0}
7474
7475 set optim_delay 16
7476
7477 set nextviewnum 1
7478 set curview 0
7479 set selectedview 0
7480 set selectedhlview None
7481 set viewfiles(0) {}
7482 set viewperm(0) 0
7483 set viewargs(0) {}
7484
7485 set cmdlineok 0
7486 set stopped 0
7487 set stuffsaved 0
7488 set patchnum 0
7489 set lookingforhead 0
7490 set localrow -1
7491 set lserial 0
7492 setcoords
7493 makewindow
7494 wm title . "[file tail $argv0]: [file tail [pwd]]"
7495 readrefs
7496
7497 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7498     # create a view for the files/dirs specified on the command line
7499     set curview 1
7500     set selectedview 1
7501     set nextviewnum 2
7502     set viewname(1) "Command line"
7503     set viewfiles(1) $cmdline_files
7504     set viewargs(1) $revtreeargs
7505     set viewperm(1) 0
7506     addviewmenu 1
7507     .bar.view entryconf Edit* -state normal
7508     .bar.view entryconf Delete* -state normal
7509 }
7510
7511 if {[info exists permviews]} {
7512     foreach v $permviews {
7513         set n $nextviewnum
7514         incr nextviewnum
7515         set viewname($n) [lindex $v 0]
7516         set viewfiles($n) [lindex $v 1]
7517         set viewargs($n) [lindex $v 2]
7518         set viewperm($n) 1
7519         addviewmenu $n
7520     }
7521 }
7522 getcommits