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