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