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