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