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