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