gitkon commit gitk: add menu item for editing the current view (d16c081)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005 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 {} {
  20    global startmsecs nextupdate ncmupdate
  21    global commfd leftover tclencoding datemode
  22    global revtreeargs curview viewfiles
  23
  24    set startmsecs [clock clicks -milliseconds]
  25    set nextupdate [expr {$startmsecs + 100}]
  26    set ncmupdate 1
  27    initlayout
  28    set args $revtreeargs
  29    if {$viewfiles($curview) ne {}} {
  30        set args [concat $args "--" $viewfiles($curview)]
  31    }
  32    set order "--topo-order"
  33    if {$datemode} {
  34        set order "--date-order"
  35    }
  36    if {[catch {
  37        set commfd [open [concat | git-rev-list --header $order \
  38                              --parents --boundary --default HEAD $args] r]
  39    } err]} {
  40        puts stderr "Error executing git-rev-list: $err"
  41        exit 1
  42    }
  43    set leftover {}
  44    fconfigure $commfd -blocking 0 -translation lf
  45    if {$tclencoding != {}} {
  46        fconfigure $commfd -encoding $tclencoding
  47    }
  48    fileevent $commfd readable [list getcommitlines $commfd]
  49    . config -cursor watch
  50    settextcursor watch
  51}
  52
  53proc stop_rev_list {} {
  54    global commfd
  55
  56    if {![info exists commfd]} return
  57    catch {
  58        set pid [pid $commfd]
  59        exec kill $pid
  60    }
  61    catch {close $commfd}
  62    unset commfd
  63}
  64
  65proc getcommits {} {
  66    global phase canv mainfont
  67
  68    set phase getcommits
  69    start_rev_list
  70    $canv delete all
  71    $canv create text 3 3 -anchor nw -text "Reading commits..." \
  72        -font $mainfont -tags textitems
  73}
  74
  75proc getcommitlines {commfd}  {
  76    global commitlisted nextupdate
  77    global leftover
  78    global displayorder commitidx commitrow commitdata
  79    global parentlist childlist children
  80
  81    set stuff [read $commfd]
  82    if {$stuff == {}} {
  83        if {![eof $commfd]} return
  84        # set it blocking so we wait for the process to terminate
  85        fconfigure $commfd -blocking 1
  86        if {![catch {close $commfd} err]} {
  87            after idle finishcommits
  88            return
  89        }
  90        if {[string range $err 0 4] == "usage"} {
  91            set err \
  92                "Gitk: error reading commits: bad arguments to git-rev-list.\
  93                (Note: arguments to gitk are passed to git-rev-list\
  94                to allow selection of commits to be displayed.)"
  95        } else {
  96            set err "Error reading commits: $err"
  97        }
  98        error_popup $err
  99        exit 1
 100    }
 101    set start 0
 102    set gotsome 0
 103    while 1 {
 104        set i [string first "\0" $stuff $start]
 105        if {$i < 0} {
 106            append leftover [string range $stuff $start end]
 107            break
 108        }
 109        if {$start == 0} {
 110            set cmit $leftover
 111            append cmit [string range $stuff 0 [expr {$i - 1}]]
 112            set leftover {}
 113        } else {
 114            set cmit [string range $stuff $start [expr {$i - 1}]]
 115        }
 116        set start [expr {$i + 1}]
 117        set j [string first "\n" $cmit]
 118        set ok 0
 119        set listed 1
 120        if {$j >= 0} {
 121            set ids [string range $cmit 0 [expr {$j - 1}]]
 122            if {[string range $ids 0 0] == "-"} {
 123                set listed 0
 124                set ids [string range $ids 1 end]
 125            }
 126            set ok 1
 127            foreach id $ids {
 128                if {[string length $id] != 40} {
 129                    set ok 0
 130                    break
 131                }
 132            }
 133        }
 134        if {!$ok} {
 135            set shortcmit $cmit
 136            if {[string length $shortcmit] > 80} {
 137                set shortcmit "[string range $shortcmit 0 80]..."
 138            }
 139            error_popup "Can't parse git-rev-list output: {$shortcmit}"
 140            exit 1
 141        }
 142        set id [lindex $ids 0]
 143        if {$listed} {
 144            set olds [lrange $ids 1 end]
 145            set i 0
 146            foreach p $olds {
 147                if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 148                    lappend children($p) $id
 149                }
 150                incr i
 151            }
 152        } else {
 153            set olds {}
 154        }
 155        lappend parentlist $olds
 156        if {[info exists children($id)]} {
 157            lappend childlist $children($id)
 158            unset children($id)
 159        } else {
 160            lappend childlist {}
 161        }
 162        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 163        set commitrow($id) $commitidx
 164        incr commitidx
 165        lappend displayorder $id
 166        lappend commitlisted $listed
 167        set gotsome 1
 168    }
 169    if {$gotsome} {
 170        layoutmore
 171    }
 172    if {[clock clicks -milliseconds] >= $nextupdate} {
 173        doupdate 1
 174    }
 175}
 176
 177proc doupdate {reading} {
 178    global commfd nextupdate numcommits ncmupdate
 179
 180    if {$reading} {
 181        fileevent $commfd readable {}
 182    }
 183    update
 184    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 185    if {$numcommits < 100} {
 186        set ncmupdate [expr {$numcommits + 1}]
 187    } elseif {$numcommits < 10000} {
 188        set ncmupdate [expr {$numcommits + 10}]
 189    } else {
 190        set ncmupdate [expr {$numcommits + 100}]
 191    }
 192    if {$reading} {
 193        fileevent $commfd readable [list getcommitlines $commfd]
 194    }
 195}
 196
 197proc readcommit {id} {
 198    if {[catch {set contents [exec git-cat-file commit $id]}]} return
 199    parsecommit $id $contents 0
 200}
 201
 202proc updatecommits {} {
 203    global viewdata curview revtreeargs phase
 204
 205    if {$phase ne {}} {
 206        stop_rev_list
 207        set phase {}
 208    }
 209    set n $curview
 210    set curview -1
 211    catch {unset viewdata($n)}
 212    readrefs
 213    showview $n
 214}
 215
 216proc parsecommit {id contents listed} {
 217    global commitinfo cdate
 218
 219    set inhdr 1
 220    set comment {}
 221    set headline {}
 222    set auname {}
 223    set audate {}
 224    set comname {}
 225    set comdate {}
 226    set hdrend [string first "\n\n" $contents]
 227    if {$hdrend < 0} {
 228        # should never happen...
 229        set hdrend [string length $contents]
 230    }
 231    set header [string range $contents 0 [expr {$hdrend - 1}]]
 232    set comment [string range $contents [expr {$hdrend + 2}] end]
 233    foreach line [split $header "\n"] {
 234        set tag [lindex $line 0]
 235        if {$tag == "author"} {
 236            set audate [lindex $line end-1]
 237            set auname [lrange $line 1 end-2]
 238        } elseif {$tag == "committer"} {
 239            set comdate [lindex $line end-1]
 240            set comname [lrange $line 1 end-2]
 241        }
 242    }
 243    set headline {}
 244    # take the first line of the comment as the headline
 245    set i [string first "\n" $comment]
 246    if {$i >= 0} {
 247        set headline [string trim [string range $comment 0 $i]]
 248    } else {
 249        set headline $comment
 250    }
 251    if {!$listed} {
 252        # git-rev-list indents the comment by 4 spaces;
 253        # if we got this via git-cat-file, add the indentation
 254        set newcomment {}
 255        foreach line [split $comment "\n"] {
 256            append newcomment "    "
 257            append newcomment $line
 258            append newcomment "\n"
 259        }
 260        set comment $newcomment
 261    }
 262    if {$comdate != {}} {
 263        set cdate($id) $comdate
 264    }
 265    set commitinfo($id) [list $headline $auname $audate \
 266                             $comname $comdate $comment]
 267}
 268
 269proc getcommit {id} {
 270    global commitdata commitinfo
 271
 272    if {[info exists commitdata($id)]} {
 273        parsecommit $id $commitdata($id) 1
 274    } else {
 275        readcommit $id
 276        if {![info exists commitinfo($id)]} {
 277            set commitinfo($id) {"No commit information available"}
 278        }
 279    }
 280    return 1
 281}
 282
 283proc readrefs {} {
 284    global tagids idtags headids idheads tagcontents
 285    global otherrefids idotherrefs
 286
 287    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 288        catch {unset $v}
 289    }
 290    set refd [open [list | git ls-remote [gitdir]] r]
 291    while {0 <= [set n [gets $refd line]]} {
 292        if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 293            match id path]} {
 294            continue
 295        }
 296        if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 297            set type others
 298            set name $path
 299        }
 300        if {$type == "tags"} {
 301            set tagids($name) $id
 302            lappend idtags($id) $name
 303            set obj {}
 304            set type {}
 305            set tag {}
 306            catch {
 307                set commit [exec git-rev-parse "$id^0"]
 308                if {"$commit" != "$id"} {
 309                    set tagids($name) $commit
 310                    lappend idtags($commit) $name
 311                }
 312            }           
 313            catch {
 314                set tagcontents($name) [exec git-cat-file tag "$id"]
 315            }
 316        } elseif { $type == "heads" } {
 317            set headids($name) $id
 318            lappend idheads($id) $name
 319        } else {
 320            set otherrefids($name) $id
 321            lappend idotherrefs($id) $name
 322        }
 323    }
 324    close $refd
 325}
 326
 327proc error_popup msg {
 328    set w .error
 329    toplevel $w
 330    wm transient $w .
 331    message $w.m -text $msg -justify center -aspect 400
 332    pack $w.m -side top -fill x -padx 20 -pady 20
 333    button $w.ok -text OK -command "destroy $w"
 334    pack $w.ok -side bottom -fill x
 335    bind $w <Visibility> "grab $w; focus $w"
 336    bind $w <Key-Return> "destroy $w"
 337    tkwait window $w
 338}
 339
 340proc makewindow {} {
 341    global canv canv2 canv3 linespc charspc ctext cflist
 342    global textfont mainfont uifont
 343    global findtype findtypemenu findloc findstring fstring geometry
 344    global entries sha1entry sha1string sha1but
 345    global maincursor textcursor curtextcursor
 346    global rowctxmenu mergemax
 347
 348    menu .bar
 349    .bar add cascade -label "File" -menu .bar.file
 350    .bar configure -font $uifont
 351    menu .bar.file
 352    .bar.file add command -label "Update" -command updatecommits
 353    .bar.file add command -label "Reread references" -command rereadrefs
 354    .bar.file add command -label "Quit" -command doquit
 355    .bar.file configure -font $uifont
 356    menu .bar.edit
 357    .bar add cascade -label "Edit" -menu .bar.edit
 358    .bar.edit add command -label "Preferences" -command doprefs
 359    .bar.edit configure -font $uifont
 360    menu .bar.view -font $uifont
 361    .bar add cascade -label "View" -menu .bar.view
 362    .bar.view add command -label "New view..." -command newview
 363    .bar.view add command -label "Edit view..." -command editview
 364    .bar.view add command -label "Delete view" -command delview -state disabled
 365    .bar.view add separator
 366    .bar.view add radiobutton -label "All files" -command {showview 0} \
 367        -variable selectedview -value 0
 368    menu .bar.help
 369    .bar add cascade -label "Help" -menu .bar.help
 370    .bar.help add command -label "About gitk" -command about
 371    .bar.help add command -label "Key bindings" -command keys
 372    .bar.help configure -font $uifont
 373    . configure -menu .bar
 374
 375    if {![info exists geometry(canv1)]} {
 376        set geometry(canv1) [expr {45 * $charspc}]
 377        set geometry(canv2) [expr {30 * $charspc}]
 378        set geometry(canv3) [expr {15 * $charspc}]
 379        set geometry(canvh) [expr {25 * $linespc + 4}]
 380        set geometry(ctextw) 80
 381        set geometry(ctexth) 30
 382        set geometry(cflistw) 30
 383    }
 384    panedwindow .ctop -orient vertical
 385    if {[info exists geometry(width)]} {
 386        .ctop conf -width $geometry(width) -height $geometry(height)
 387        set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 388        set geometry(ctexth) [expr {($texth - 8) /
 389                                    [font metrics $textfont -linespace]}]
 390    }
 391    frame .ctop.top
 392    frame .ctop.top.bar
 393    pack .ctop.top.bar -side bottom -fill x
 394    set cscroll .ctop.top.csb
 395    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 396    pack $cscroll -side right -fill y
 397    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 398    pack .ctop.top.clist -side top -fill both -expand 1
 399    .ctop add .ctop.top
 400    set canv .ctop.top.clist.canv
 401    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 402        -bg white -bd 0 \
 403        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 404    .ctop.top.clist add $canv
 405    set canv2 .ctop.top.clist.canv2
 406    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 407        -bg white -bd 0 -yscrollincr $linespc
 408    .ctop.top.clist add $canv2
 409    set canv3 .ctop.top.clist.canv3
 410    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 411        -bg white -bd 0 -yscrollincr $linespc
 412    .ctop.top.clist add $canv3
 413    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 414
 415    set sha1entry .ctop.top.bar.sha1
 416    set entries $sha1entry
 417    set sha1but .ctop.top.bar.sha1label
 418    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 419        -command gotocommit -width 8 -font $uifont
 420    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 421    pack .ctop.top.bar.sha1label -side left
 422    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 423    trace add variable sha1string write sha1change
 424    pack $sha1entry -side left -pady 2
 425
 426    image create bitmap bm-left -data {
 427        #define left_width 16
 428        #define left_height 16
 429        static unsigned char left_bits[] = {
 430        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 431        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 432        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 433    }
 434    image create bitmap bm-right -data {
 435        #define right_width 16
 436        #define right_height 16
 437        static unsigned char right_bits[] = {
 438        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 439        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 440        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 441    }
 442    button .ctop.top.bar.leftbut -image bm-left -command goback \
 443        -state disabled -width 26
 444    pack .ctop.top.bar.leftbut -side left -fill y
 445    button .ctop.top.bar.rightbut -image bm-right -command goforw \
 446        -state disabled -width 26
 447    pack .ctop.top.bar.rightbut -side left -fill y
 448
 449    button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
 450    pack .ctop.top.bar.findbut -side left
 451    set findstring {}
 452    set fstring .ctop.top.bar.findstring
 453    lappend entries $fstring
 454    entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
 455    pack $fstring -side left -expand 1 -fill x
 456    set findtype Exact
 457    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 458                          findtype Exact IgnCase Regexp]
 459    .ctop.top.bar.findtype configure -font $uifont
 460    .ctop.top.bar.findtype.menu configure -font $uifont
 461    set findloc "All fields"
 462    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 463        Comments Author Committer Files Pickaxe
 464    .ctop.top.bar.findloc configure -font $uifont
 465    .ctop.top.bar.findloc.menu configure -font $uifont
 466
 467    pack .ctop.top.bar.findloc -side right
 468    pack .ctop.top.bar.findtype -side right
 469    # for making sure type==Exact whenever loc==Pickaxe
 470    trace add variable findloc write findlocchange
 471
 472    panedwindow .ctop.cdet -orient horizontal
 473    .ctop add .ctop.cdet
 474    frame .ctop.cdet.left
 475    set ctext .ctop.cdet.left.ctext
 476    text $ctext -bg white -state disabled -font $textfont \
 477        -width $geometry(ctextw) -height $geometry(ctexth) \
 478        -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
 479    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 480    pack .ctop.cdet.left.sb -side right -fill y
 481    pack $ctext -side left -fill both -expand 1
 482    .ctop.cdet add .ctop.cdet.left
 483
 484    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 485    $ctext tag conf hunksep -fore blue
 486    $ctext tag conf d0 -fore red
 487    $ctext tag conf d1 -fore "#00a000"
 488    $ctext tag conf m0 -fore red
 489    $ctext tag conf m1 -fore blue
 490    $ctext tag conf m2 -fore green
 491    $ctext tag conf m3 -fore purple
 492    $ctext tag conf m4 -fore brown
 493    $ctext tag conf m5 -fore "#009090"
 494    $ctext tag conf m6 -fore magenta
 495    $ctext tag conf m7 -fore "#808000"
 496    $ctext tag conf m8 -fore "#009000"
 497    $ctext tag conf m9 -fore "#ff0080"
 498    $ctext tag conf m10 -fore cyan
 499    $ctext tag conf m11 -fore "#b07070"
 500    $ctext tag conf m12 -fore "#70b0f0"
 501    $ctext tag conf m13 -fore "#70f0b0"
 502    $ctext tag conf m14 -fore "#f0b070"
 503    $ctext tag conf m15 -fore "#ff70b0"
 504    $ctext tag conf mmax -fore darkgrey
 505    set mergemax 16
 506    $ctext tag conf mresult -font [concat $textfont bold]
 507    $ctext tag conf msep -font [concat $textfont bold]
 508    $ctext tag conf found -back yellow
 509
 510    frame .ctop.cdet.right
 511    set cflist .ctop.cdet.right.cfiles
 512    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 513        -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
 514    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 515    pack .ctop.cdet.right.sb -side right -fill y
 516    pack $cflist -side left -fill both -expand 1
 517    .ctop.cdet add .ctop.cdet.right
 518    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 519
 520    pack .ctop -side top -fill both -expand 1
 521
 522    bindall <1> {selcanvline %W %x %y}
 523    #bindall <B1-Motion> {selcanvline %W %x %y}
 524    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 525    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 526    bindall <2> "canvscan mark %W %x %y"
 527    bindall <B2-Motion> "canvscan dragto %W %x %y"
 528    bindkey <Home> selfirstline
 529    bindkey <End> sellastline
 530    bind . <Key-Up> "selnextline -1"
 531    bind . <Key-Down> "selnextline 1"
 532    bindkey <Key-Right> "goforw"
 533    bindkey <Key-Left> "goback"
 534    bind . <Key-Prior> "selnextpage -1"
 535    bind . <Key-Next> "selnextpage 1"
 536    bind . <Control-Home> "allcanvs yview moveto 0.0"
 537    bind . <Control-End> "allcanvs yview moveto 1.0"
 538    bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 539    bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 540    bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 541    bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 542    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 543    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 544    bindkey <Key-space> "$ctext yview scroll 1 pages"
 545    bindkey p "selnextline -1"
 546    bindkey n "selnextline 1"
 547    bindkey z "goback"
 548    bindkey x "goforw"
 549    bindkey i "selnextline -1"
 550    bindkey k "selnextline 1"
 551    bindkey j "goback"
 552    bindkey l "goforw"
 553    bindkey b "$ctext yview scroll -1 pages"
 554    bindkey d "$ctext yview scroll 18 units"
 555    bindkey u "$ctext yview scroll -18 units"
 556    bindkey / {findnext 1}
 557    bindkey <Key-Return> {findnext 0}
 558    bindkey ? findprev
 559    bindkey f nextfile
 560    bind . <Control-q> doquit
 561    bind . <Control-f> dofind
 562    bind . <Control-g> {findnext 0}
 563    bind . <Control-r> findprev
 564    bind . <Control-equal> {incrfont 1}
 565    bind . <Control-KP_Add> {incrfont 1}
 566    bind . <Control-minus> {incrfont -1}
 567    bind . <Control-KP_Subtract> {incrfont -1}
 568    bind $cflist <<ListboxSelect>> listboxsel
 569    bind . <Destroy> {savestuff %W}
 570    bind . <Button-1> "click %W"
 571    bind $fstring <Key-Return> dofind
 572    bind $sha1entry <Key-Return> gotocommit
 573    bind $sha1entry <<PasteSelection>> clearsha1
 574
 575    set maincursor [. cget -cursor]
 576    set textcursor [$ctext cget -cursor]
 577    set curtextcursor $textcursor
 578
 579    set rowctxmenu .rowctxmenu
 580    menu $rowctxmenu -tearoff 0
 581    $rowctxmenu add command -label "Diff this -> selected" \
 582        -command {diffvssel 0}
 583    $rowctxmenu add command -label "Diff selected -> this" \
 584        -command {diffvssel 1}
 585    $rowctxmenu add command -label "Make patch" -command mkpatch
 586    $rowctxmenu add command -label "Create tag" -command mktag
 587    $rowctxmenu add command -label "Write commit to file" -command writecommit
 588}
 589
 590# mouse-2 makes all windows scan vertically, but only the one
 591# the cursor is in scans horizontally
 592proc canvscan {op w x y} {
 593    global canv canv2 canv3
 594    foreach c [list $canv $canv2 $canv3] {
 595        if {$c == $w} {
 596            $c scan $op $x $y
 597        } else {
 598            $c scan $op 0 $y
 599        }
 600    }
 601}
 602
 603proc scrollcanv {cscroll f0 f1} {
 604    $cscroll set $f0 $f1
 605    drawfrac $f0 $f1
 606}
 607
 608# when we make a key binding for the toplevel, make sure
 609# it doesn't get triggered when that key is pressed in the
 610# find string entry widget.
 611proc bindkey {ev script} {
 612    global entries
 613    bind . $ev $script
 614    set escript [bind Entry $ev]
 615    if {$escript == {}} {
 616        set escript [bind Entry <Key>]
 617    }
 618    foreach e $entries {
 619        bind $e $ev "$escript; break"
 620    }
 621}
 622
 623# set the focus back to the toplevel for any click outside
 624# the entry widgets
 625proc click {w} {
 626    global entries
 627    foreach e $entries {
 628        if {$w == $e} return
 629    }
 630    focus .
 631}
 632
 633proc savestuff {w} {
 634    global canv canv2 canv3 ctext cflist mainfont textfont uifont
 635    global stuffsaved findmergefiles maxgraphpct
 636    global maxwidth
 637    global viewname viewfiles viewperm nextviewnum
 638
 639    if {$stuffsaved} return
 640    if {![winfo viewable .]} return
 641    catch {
 642        set f [open "~/.gitk-new" w]
 643        puts $f [list set mainfont $mainfont]
 644        puts $f [list set textfont $textfont]
 645        puts $f [list set uifont $uifont]
 646        puts $f [list set findmergefiles $findmergefiles]
 647        puts $f [list set maxgraphpct $maxgraphpct]
 648        puts $f [list set maxwidth $maxwidth]
 649        puts $f "set geometry(width) [winfo width .ctop]"
 650        puts $f "set geometry(height) [winfo height .ctop]"
 651        puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 652        puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 653        puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 654        puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 655        set wid [expr {([winfo width $ctext] - 8) \
 656                           / [font measure $textfont "0"]}]
 657        puts $f "set geometry(ctextw) $wid"
 658        set wid [expr {([winfo width $cflist] - 11) \
 659                           / [font measure [$cflist cget -font] "0"]}]
 660        puts $f "set geometry(cflistw) $wid"
 661        puts -nonewline $f "set permviews {"
 662        for {set v 0} {$v < $nextviewnum} {incr v} {
 663            if {$viewperm($v)} {
 664                puts $f "{[list $viewname($v) $viewfiles($v)]}"
 665            }
 666        }
 667        puts $f "}"
 668        close $f
 669        file rename -force "~/.gitk-new" "~/.gitk"
 670    }
 671    set stuffsaved 1
 672}
 673
 674proc resizeclistpanes {win w} {
 675    global oldwidth
 676    if {[info exists oldwidth($win)]} {
 677        set s0 [$win sash coord 0]
 678        set s1 [$win sash coord 1]
 679        if {$w < 60} {
 680            set sash0 [expr {int($w/2 - 2)}]
 681            set sash1 [expr {int($w*5/6 - 2)}]
 682        } else {
 683            set factor [expr {1.0 * $w / $oldwidth($win)}]
 684            set sash0 [expr {int($factor * [lindex $s0 0])}]
 685            set sash1 [expr {int($factor * [lindex $s1 0])}]
 686            if {$sash0 < 30} {
 687                set sash0 30
 688            }
 689            if {$sash1 < $sash0 + 20} {
 690                set sash1 [expr {$sash0 + 20}]
 691            }
 692            if {$sash1 > $w - 10} {
 693                set sash1 [expr {$w - 10}]
 694                if {$sash0 > $sash1 - 20} {
 695                    set sash0 [expr {$sash1 - 20}]
 696                }
 697            }
 698        }
 699        $win sash place 0 $sash0 [lindex $s0 1]
 700        $win sash place 1 $sash1 [lindex $s1 1]
 701    }
 702    set oldwidth($win) $w
 703}
 704
 705proc resizecdetpanes {win w} {
 706    global oldwidth
 707    if {[info exists oldwidth($win)]} {
 708        set s0 [$win sash coord 0]
 709        if {$w < 60} {
 710            set sash0 [expr {int($w*3/4 - 2)}]
 711        } else {
 712            set factor [expr {1.0 * $w / $oldwidth($win)}]
 713            set sash0 [expr {int($factor * [lindex $s0 0])}]
 714            if {$sash0 < 45} {
 715                set sash0 45
 716            }
 717            if {$sash0 > $w - 15} {
 718                set sash0 [expr {$w - 15}]
 719            }
 720        }
 721        $win sash place 0 $sash0 [lindex $s0 1]
 722    }
 723    set oldwidth($win) $w
 724}
 725
 726proc allcanvs args {
 727    global canv canv2 canv3
 728    eval $canv $args
 729    eval $canv2 $args
 730    eval $canv3 $args
 731}
 732
 733proc bindall {event action} {
 734    global canv canv2 canv3
 735    bind $canv $event $action
 736    bind $canv2 $event $action
 737    bind $canv3 $event $action
 738}
 739
 740proc about {} {
 741    set w .about
 742    if {[winfo exists $w]} {
 743        raise $w
 744        return
 745    }
 746    toplevel $w
 747    wm title $w "About gitk"
 748    message $w.m -text {
 749Gitk - a commit viewer for git
 750
 751Copyright © 2005-2006 Paul Mackerras
 752
 753Use and redistribute under the terms of the GNU General Public License} \
 754            -justify center -aspect 400
 755    pack $w.m -side top -fill x -padx 20 -pady 20
 756    button $w.ok -text Close -command "destroy $w"
 757    pack $w.ok -side bottom
 758}
 759
 760proc keys {} {
 761    set w .keys
 762    if {[winfo exists $w]} {
 763        raise $w
 764        return
 765    }
 766    toplevel $w
 767    wm title $w "Gitk key bindings"
 768    message $w.m -text {
 769Gitk key bindings:
 770
 771<Ctrl-Q>                Quit
 772<Home>          Move to first commit
 773<End>           Move to last commit
 774<Up>, p, i      Move up one commit
 775<Down>, n, k    Move down one commit
 776<Left>, z, j    Go back in history list
 777<Right>, x, l   Go forward in history list
 778<PageUp>        Move up one page in commit list
 779<PageDown>      Move down one page in commit list
 780<Ctrl-Home>     Scroll to top of commit list
 781<Ctrl-End>      Scroll to bottom of commit list
 782<Ctrl-Up>       Scroll commit list up one line
 783<Ctrl-Down>     Scroll commit list down one line
 784<Ctrl-PageUp>   Scroll commit list up one page
 785<Ctrl-PageDown> Scroll commit list down one page
 786<Delete>, b     Scroll diff view up one page
 787<Backspace>     Scroll diff view up one page
 788<Space>         Scroll diff view down one page
 789u               Scroll diff view up 18 lines
 790d               Scroll diff view down 18 lines
 791<Ctrl-F>                Find
 792<Ctrl-G>                Move to next find hit
 793<Ctrl-R>                Move to previous find hit
 794<Return>        Move to next find hit
 795/               Move to next find hit, or redo find
 796?               Move to previous find hit
 797f               Scroll diff view to next file
 798<Ctrl-KP+>      Increase font size
 799<Ctrl-plus>     Increase font size
 800<Ctrl-KP->      Decrease font size
 801<Ctrl-minus>    Decrease font size
 802} \
 803            -justify left -bg white -border 2 -relief sunken
 804    pack $w.m -side top -fill both
 805    button $w.ok -text Close -command "destroy $w"
 806    pack $w.ok -side bottom
 807}
 808
 809proc newview {} {
 810    global nextviewnum newviewname newviewperm uifont
 811
 812    set top .gitkview
 813    if {[winfo exists $top]} {
 814        raise $top
 815        return
 816    }
 817    set newviewname($nextviewnum) "View $nextviewnum"
 818    set newviewperm($nextviewnum) 0
 819    vieweditor $top $nextviewnum "Gitk view definition" 
 820}
 821
 822proc editview {} {
 823    global curview
 824    global viewname viewperm newviewname newviewperm
 825
 826    set top .gitkvedit-$curview
 827    if {[winfo exists $top]} {
 828        raise $top
 829        return
 830    }
 831    set newviewname($curview) $viewname($curview)
 832    set newviewperm($curview) $viewperm($curview)
 833    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
 834}
 835
 836proc vieweditor {top n title} {
 837    global newviewname newviewperm viewfiles
 838    global uifont
 839
 840    toplevel $top
 841    wm title $top $title
 842    label $top.nl -text "Name" -font $uifont
 843    entry $top.name -width 20 -textvariable newviewname($n)
 844    grid $top.nl $top.name -sticky w -pady 5
 845    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
 846    grid $top.perm - -pady 5 -sticky w
 847    message $top.l -aspect 500 -font $uifont \
 848        -text "Enter files and directories to include, one per line:"
 849    grid $top.l - -sticky w
 850    text $top.t -width 40 -height 10 -background white
 851    if {[info exists viewfiles($n)]} {
 852        foreach f $viewfiles($n) {
 853            $top.t insert end $f
 854            $top.t insert end "\n"
 855        }
 856        $top.t delete {end - 1c} end
 857        $top.t mark set insert 0.0
 858    }
 859    grid $top.t - -sticky w -padx 5
 860    frame $top.buts
 861    button $top.buts.ok -text "OK" -command [list newviewok $top $n]
 862    button $top.buts.can -text "Cancel" -command [list destroy $top]
 863    grid $top.buts.ok $top.buts.can
 864    grid columnconfigure $top.buts 0 -weight 1 -uniform a
 865    grid columnconfigure $top.buts 1 -weight 1 -uniform a
 866    grid $top.buts - -pady 10 -sticky ew
 867    focus $top.t
 868}
 869
 870proc viewmenuitem {n} {
 871    set nmenu [.bar.view index end]
 872    set targetcmd [list showview $n]
 873    for {set i 6} {$i <= $nmenu} {incr i} {
 874        if {[.bar.view entrycget $i -command] eq $targetcmd} {
 875            return $i
 876        }
 877    }
 878    return {}
 879}
 880
 881proc newviewok {top n} {
 882    global nextviewnum newviewperm newviewname
 883    global viewname viewfiles viewperm selectedview curview
 884
 885    set files {}
 886    foreach f [split [$top.t get 0.0 end] "\n"] {
 887        set ft [string trim $f]
 888        if {$ft ne {}} {
 889            lappend files $ft
 890        }
 891    }
 892    if {![info exists viewfiles($n)]} {
 893        # creating a new view
 894        incr nextviewnum
 895        set viewname($n) $newviewname($n)
 896        set viewperm($n) $newviewperm($n)
 897        set viewfiles($n) $files
 898        .bar.view add radiobutton -label $viewname($n) \
 899            -command [list showview $n] -variable selectedview -value $n
 900        after idle showview $n
 901    } else {
 902        # editing an existing view
 903        set viewperm($n) $newviewperm($n)
 904        if {$newviewname($n) ne $viewname($n)} {
 905            set viewname($n) $newviewname($n)
 906            set i [viewmenuitem $n]
 907            if {$i ne {}} {
 908                .bar.view entryconf $i -label $viewname($n)
 909            }
 910        }
 911        if {$files ne $viewfiles($n)} {
 912            set viewfiles($n) $files
 913            if {$curview == $n} {
 914                after idle updatecommits
 915            }
 916        }
 917    }
 918    catch {destroy $top}
 919}
 920
 921proc delview {} {
 922    global curview viewdata viewperm
 923
 924    if {$curview == 0} return
 925    set i [viewmenuitem $curview]
 926    if {$i ne {}} {
 927        .bar.view delete $i
 928    }
 929    set viewdata($curview) {}
 930    set viewperm($curview) 0
 931    showview 0
 932}
 933
 934proc flatten {var} {
 935    global $var
 936
 937    set ret {}
 938    foreach i [array names $var] {
 939        lappend ret $i [set $var\($i\)]
 940    }
 941    return $ret
 942}
 943
 944proc unflatten {var l} {
 945    global $var
 946
 947    catch {unset $var}
 948    foreach {i v} $l {
 949        set $var\($i\) $v
 950    }
 951}
 952
 953proc showview {n} {
 954    global curview viewdata viewfiles
 955    global displayorder parentlist childlist rowidlist rowoffsets
 956    global colormap rowtextx commitrow
 957    global numcommits rowrangelist commitlisted idrowranges
 958    global selectedline currentid canv canvy0
 959    global matchinglines treediffs
 960    global pending_select phase
 961    global commitidx rowlaidout rowoptim linesegends leftover
 962    global commfd nextupdate
 963    global selectedview
 964
 965    if {$n == $curview} return
 966    set selid {}
 967    if {[info exists selectedline]} {
 968        set selid $currentid
 969        set y [yc $selectedline]
 970        set ymax [lindex [$canv cget -scrollregion] 3]
 971        set span [$canv yview]
 972        set ytop [expr {[lindex $span 0] * $ymax}]
 973        set ybot [expr {[lindex $span 1] * $ymax}]
 974        if {$ytop < $y && $y < $ybot} {
 975            set yscreen [expr {$y - $ytop}]
 976        } else {
 977            set yscreen [expr {($ybot - $ytop) / 2}]
 978        }
 979    }
 980    unselectline
 981    normalline
 982    stopfindproc
 983    if {$curview >= 0} {
 984        if {$phase ne {}} {
 985            set viewdata($curview) \
 986                [list $phase $displayorder $parentlist $childlist $rowidlist \
 987                     $rowoffsets $rowrangelist $commitlisted \
 988                     [flatten children] [flatten idrowranges] \
 989                     [flatten idinlist] \
 990                     $commitidx $rowlaidout $rowoptim $numcommits \
 991                     $linesegends $leftover $commfd]
 992            fileevent $commfd readable {}
 993        } elseif {![info exists viewdata($curview)]
 994                  || [lindex $viewdata($curview) 0] ne {}} {
 995            set viewdata($curview) \
 996                [list {} $displayorder $parentlist $childlist $rowidlist \
 997                     $rowoffsets $rowrangelist $commitlisted]
 998        }
 999    }
1000    catch {unset matchinglines}
1001    catch {unset treediffs}
1002    clear_display
1003
1004    set curview $n
1005    set selectedview $n
1006    .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1007    .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1008
1009    if {![info exists viewdata($n)]} {
1010        set pending_select $selid
1011        getcommits
1012        return
1013    }
1014
1015    set v $viewdata($n)
1016    set phase [lindex $v 0]
1017    set displayorder [lindex $v 1]
1018    set parentlist [lindex $v 2]
1019    set childlist [lindex $v 3]
1020    set rowidlist [lindex $v 4]
1021    set rowoffsets [lindex $v 5]
1022    set rowrangelist [lindex $v 6]
1023    set commitlisted [lindex $v 7]
1024    if {$phase eq {}} {
1025        set numcommits [llength $displayorder]
1026        catch {unset idrowranges}
1027        catch {unset children}
1028    } else {
1029        unflatten children [lindex $v 8]
1030        unflatten idrowranges [lindex $v 9]
1031        unflatten idinlist [lindex $v 10]
1032        set commitidx [lindex $v 11]
1033        set rowlaidout [lindex $v 12]
1034        set rowoptim [lindex $v 13]
1035        set numcommits [lindex $v 14]
1036        set linesegends [lindex $v 15]
1037        set leftover [lindex $v 16]
1038        set commfd [lindex $v 17]
1039        fileevent $commfd readable [list getcommitlines $commfd]
1040        set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1041    }
1042
1043    catch {unset colormap}
1044    catch {unset rowtextx}
1045    catch {unset commitrow}
1046    set curview $n
1047    set row 0
1048    foreach id $displayorder {
1049        set commitrow($id) $row
1050        incr row
1051    }
1052    setcanvscroll
1053    set yf 0
1054    set row 0
1055    if {$selid ne {} && [info exists commitrow($selid)]} {
1056        set row $commitrow($selid)
1057        # try to get the selected row in the same position on the screen
1058        set ymax [lindex [$canv cget -scrollregion] 3]
1059        set ytop [expr {[yc $row] - $yscreen}]
1060        if {$ytop < 0} {
1061            set ytop 0
1062        }
1063        set yf [expr {$ytop * 1.0 / $ymax}]
1064    }
1065    allcanvs yview moveto $yf
1066    drawvisible
1067    selectline $row 0
1068    if {$phase eq {}} {
1069        global maincursor textcursor
1070        . config -cursor $maincursor
1071        settextcursor $textcursor
1072    } else {
1073        . config -cursor watch
1074        settextcursor watch
1075        if {$phase eq "getcommits"} {
1076            global mainfont
1077            $canv create text 3 3 -anchor nw -text "Reading commits..." \
1078                -font $mainfont -tags textitems
1079        }
1080    }
1081}
1082
1083proc shortids {ids} {
1084    set res {}
1085    foreach id $ids {
1086        if {[llength $id] > 1} {
1087            lappend res [shortids $id]
1088        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1089            lappend res [string range $id 0 7]
1090        } else {
1091            lappend res $id
1092        }
1093    }
1094    return $res
1095}
1096
1097proc incrange {l x o} {
1098    set n [llength $l]
1099    while {$x < $n} {
1100        set e [lindex $l $x]
1101        if {$e ne {}} {
1102            lset l $x [expr {$e + $o}]
1103        }
1104        incr x
1105    }
1106    return $l
1107}
1108
1109proc ntimes {n o} {
1110    set ret {}
1111    for {} {$n > 0} {incr n -1} {
1112        lappend ret $o
1113    }
1114    return $ret
1115}
1116
1117proc usedinrange {id l1 l2} {
1118    global children commitrow childlist
1119
1120    if {[info exists commitrow($id)]} {
1121        set r $commitrow($id)
1122        if {$l1 <= $r && $r <= $l2} {
1123            return [expr {$r - $l1 + 1}]
1124        }
1125        set kids [lindex $childlist $r]
1126    } else {
1127        set kids $children($id)
1128    }
1129    foreach c $kids {
1130        set r $commitrow($c)
1131        if {$l1 <= $r && $r <= $l2} {
1132            return [expr {$r - $l1 + 1}]
1133        }
1134    }
1135    return 0
1136}
1137
1138proc sanity {row {full 0}} {
1139    global rowidlist rowoffsets
1140
1141    set col -1
1142    set ids [lindex $rowidlist $row]
1143    foreach id $ids {
1144        incr col
1145        if {$id eq {}} continue
1146        if {$col < [llength $ids] - 1 &&
1147            [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1148            puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1149        }
1150        set o [lindex $rowoffsets $row $col]
1151        set y $row
1152        set x $col
1153        while {$o ne {}} {
1154            incr y -1
1155            incr x $o
1156            if {[lindex $rowidlist $y $x] != $id} {
1157                puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1158                puts "  id=[shortids $id] check started at row $row"
1159                for {set i $row} {$i >= $y} {incr i -1} {
1160                    puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1161                }
1162                break
1163            }
1164            if {!$full} break
1165            set o [lindex $rowoffsets $y $x]
1166        }
1167    }
1168}
1169
1170proc makeuparrow {oid x y z} {
1171    global rowidlist rowoffsets uparrowlen idrowranges
1172
1173    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1174        incr y -1
1175        incr x $z
1176        set off0 [lindex $rowoffsets $y]
1177        for {set x0 $x} {1} {incr x0} {
1178            if {$x0 >= [llength $off0]} {
1179                set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1180                break
1181            }
1182            set z [lindex $off0 $x0]
1183            if {$z ne {}} {
1184                incr x0 $z
1185                break
1186            }
1187        }
1188        set z [expr {$x0 - $x}]
1189        lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1190        lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1191    }
1192    set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1193    lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1194    lappend idrowranges($oid) $y
1195}
1196
1197proc initlayout {} {
1198    global rowidlist rowoffsets displayorder commitlisted
1199    global rowlaidout rowoptim
1200    global idinlist rowchk rowrangelist idrowranges
1201    global commitidx numcommits canvxmax canv
1202    global nextcolor
1203    global parentlist childlist children
1204    global colormap rowtextx commitrow
1205    global linesegends
1206
1207    set commitidx 0
1208    set numcommits 0
1209    set displayorder {}
1210    set commitlisted {}
1211    set parentlist {}
1212    set childlist {}
1213    set rowrangelist {}
1214    catch {unset children}
1215    set nextcolor 0
1216    set rowidlist {{}}
1217    set rowoffsets {{}}
1218    catch {unset idinlist}
1219    catch {unset rowchk}
1220    set rowlaidout 0
1221    set rowoptim 0
1222    set canvxmax [$canv cget -width]
1223    catch {unset colormap}
1224    catch {unset rowtextx}
1225    catch {unset commitrow}
1226    catch {unset idrowranges}
1227    set linesegends {}
1228}
1229
1230proc setcanvscroll {} {
1231    global canv canv2 canv3 numcommits linespc canvxmax canvy0
1232
1233    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1234    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1235    $canv2 conf -scrollregion [list 0 0 0 $ymax]
1236    $canv3 conf -scrollregion [list 0 0 0 $ymax]
1237}
1238
1239proc visiblerows {} {
1240    global canv numcommits linespc
1241
1242    set ymax [lindex [$canv cget -scrollregion] 3]
1243    if {$ymax eq {} || $ymax == 0} return
1244    set f [$canv yview]
1245    set y0 [expr {int([lindex $f 0] * $ymax)}]
1246    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1247    if {$r0 < 0} {
1248        set r0 0
1249    }
1250    set y1 [expr {int([lindex $f 1] * $ymax)}]
1251    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1252    if {$r1 >= $numcommits} {
1253        set r1 [expr {$numcommits - 1}]
1254    }
1255    return [list $r0 $r1]
1256}
1257
1258proc layoutmore {} {
1259    global rowlaidout rowoptim commitidx numcommits optim_delay
1260    global uparrowlen
1261
1262    set row $rowlaidout
1263    set rowlaidout [layoutrows $row $commitidx 0]
1264    set orow [expr {$rowlaidout - $uparrowlen - 1}]
1265    if {$orow > $rowoptim} {
1266        optimize_rows $rowoptim 0 $orow
1267        set rowoptim $orow
1268    }
1269    set canshow [expr {$rowoptim - $optim_delay}]
1270    if {$canshow > $numcommits} {
1271        showstuff $canshow
1272    }
1273}
1274
1275proc showstuff {canshow} {
1276    global numcommits commitrow pending_select selectedline
1277    global linesegends idrowranges idrangedrawn
1278
1279    if {$numcommits == 0} {
1280        global phase
1281        set phase "incrdraw"
1282        allcanvs delete all
1283    }
1284    set row $numcommits
1285    set numcommits $canshow
1286    setcanvscroll
1287    set rows [visiblerows]
1288    set r0 [lindex $rows 0]
1289    set r1 [lindex $rows 1]
1290    set selrow -1
1291    for {set r $row} {$r < $canshow} {incr r} {
1292        foreach id [lindex $linesegends [expr {$r+1}]] {
1293            set i -1
1294            foreach {s e} [rowranges $id] {
1295                incr i
1296                if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1297                    && ![info exists idrangedrawn($id,$i)]} {
1298                    drawlineseg $id $i
1299                    set idrangedrawn($id,$i) 1
1300                }
1301            }
1302        }
1303    }
1304    if {$canshow > $r1} {
1305        set canshow $r1
1306    }
1307    while {$row < $canshow} {
1308        drawcmitrow $row
1309        incr row
1310    }
1311    if {[info exists pending_select] &&
1312        [info exists commitrow($pending_select)] &&
1313        $commitrow($pending_select) < $numcommits} {
1314        selectline $commitrow($pending_select) 1
1315    }
1316    if {![info exists selectedline] && ![info exists pending_select]} {
1317        selectline 0 1
1318    }
1319}
1320
1321proc layoutrows {row endrow last} {
1322    global rowidlist rowoffsets displayorder
1323    global uparrowlen downarrowlen maxwidth mingaplen
1324    global childlist parentlist
1325    global idrowranges linesegends
1326    global commitidx
1327    global idinlist rowchk rowrangelist
1328
1329    set idlist [lindex $rowidlist $row]
1330    set offs [lindex $rowoffsets $row]
1331    while {$row < $endrow} {
1332        set id [lindex $displayorder $row]
1333        set oldolds {}
1334        set newolds {}
1335        foreach p [lindex $parentlist $row] {
1336            if {![info exists idinlist($p)]} {
1337                lappend newolds $p
1338            } elseif {!$idinlist($p)} {
1339                lappend oldolds $p
1340            }
1341        }
1342        set lse {}
1343        set nev [expr {[llength $idlist] + [llength $newolds]
1344                       + [llength $oldolds] - $maxwidth + 1}]
1345        if {$nev > 0} {
1346            if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1347            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1348                set i [lindex $idlist $x]
1349                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1350                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
1351                               [expr {$row + $uparrowlen + $mingaplen}]]
1352                    if {$r == 0} {
1353                        set idlist [lreplace $idlist $x $x]
1354                        set offs [lreplace $offs $x $x]
1355                        set offs [incrange $offs $x 1]
1356                        set idinlist($i) 0
1357                        set rm1 [expr {$row - 1}]
1358                        lappend lse $i
1359                        lappend idrowranges($i) $rm1
1360                        if {[incr nev -1] <= 0} break
1361                        continue
1362                    }
1363                    set rowchk($id) [expr {$row + $r}]
1364                }
1365            }
1366            lset rowidlist $row $idlist
1367            lset rowoffsets $row $offs
1368        }
1369        lappend linesegends $lse
1370        set col [lsearch -exact $idlist $id]
1371        if {$col < 0} {
1372            set col [llength $idlist]
1373            lappend idlist $id
1374            lset rowidlist $row $idlist
1375            set z {}
1376            if {[lindex $childlist $row] ne {}} {
1377                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1378                unset idinlist($id)
1379            }
1380            lappend offs $z
1381            lset rowoffsets $row $offs
1382            if {$z ne {}} {
1383                makeuparrow $id $col $row $z
1384            }
1385        } else {
1386            unset idinlist($id)
1387        }
1388        set ranges {}
1389        if {[info exists idrowranges($id)]} {
1390            set ranges $idrowranges($id)
1391            lappend ranges $row
1392            unset idrowranges($id)
1393        }
1394        lappend rowrangelist $ranges
1395        incr row
1396        set offs [ntimes [llength $idlist] 0]
1397        set l [llength $newolds]
1398        set idlist [eval lreplace \$idlist $col $col $newolds]
1399        set o 0
1400        if {$l != 1} {
1401            set offs [lrange $offs 0 [expr {$col - 1}]]
1402            foreach x $newolds {
1403                lappend offs {}
1404                incr o -1
1405            }
1406            incr o
1407            set tmp [expr {[llength $idlist] - [llength $offs]}]
1408            if {$tmp > 0} {
1409                set offs [concat $offs [ntimes $tmp $o]]
1410            }
1411        } else {
1412            lset offs $col {}
1413        }
1414        foreach i $newolds {
1415            set idinlist($i) 1
1416            set idrowranges($i) $row
1417        }
1418        incr col $l
1419        foreach oid $oldolds {
1420            set idinlist($oid) 1
1421            set idlist [linsert $idlist $col $oid]
1422            set offs [linsert $offs $col $o]
1423            makeuparrow $oid $col $row $o
1424            incr col
1425        }
1426        lappend rowidlist $idlist
1427        lappend rowoffsets $offs
1428    }
1429    return $row
1430}
1431
1432proc addextraid {id row} {
1433    global displayorder commitrow commitinfo
1434    global commitidx commitlisted
1435    global parentlist childlist children
1436
1437    incr commitidx
1438    lappend displayorder $id
1439    lappend commitlisted 0
1440    lappend parentlist {}
1441    set commitrow($id) $row
1442    readcommit $id
1443    if {![info exists commitinfo($id)]} {
1444        set commitinfo($id) {"No commit information available"}
1445    }
1446    if {[info exists children($id)]} {
1447        lappend childlist $children($id)
1448        unset children($id)
1449    } else {
1450        lappend childlist {}
1451    }
1452}
1453
1454proc layouttail {} {
1455    global rowidlist rowoffsets idinlist commitidx
1456    global idrowranges rowrangelist
1457
1458    set row $commitidx
1459    set idlist [lindex $rowidlist $row]
1460    while {$idlist ne {}} {
1461        set col [expr {[llength $idlist] - 1}]
1462        set id [lindex $idlist $col]
1463        addextraid $id $row
1464        unset idinlist($id)
1465        lappend idrowranges($id) $row
1466        lappend rowrangelist $idrowranges($id)
1467        unset idrowranges($id)
1468        incr row
1469        set offs [ntimes $col 0]
1470        set idlist [lreplace $idlist $col $col]
1471        lappend rowidlist $idlist
1472        lappend rowoffsets $offs
1473    }
1474
1475    foreach id [array names idinlist] {
1476        addextraid $id $row
1477        lset rowidlist $row [list $id]
1478        lset rowoffsets $row 0
1479        makeuparrow $id 0 $row 0
1480        lappend idrowranges($id) $row
1481        lappend rowrangelist $idrowranges($id)
1482        unset idrowranges($id)
1483        incr row
1484        lappend rowidlist {}
1485        lappend rowoffsets {}
1486    }
1487}
1488
1489proc insert_pad {row col npad} {
1490    global rowidlist rowoffsets
1491
1492    set pad [ntimes $npad {}]
1493    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1494    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1495    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1496}
1497
1498proc optimize_rows {row col endrow} {
1499    global rowidlist rowoffsets idrowranges displayorder
1500
1501    for {} {$row < $endrow} {incr row} {
1502        set idlist [lindex $rowidlist $row]
1503        set offs [lindex $rowoffsets $row]
1504        set haspad 0
1505        for {} {$col < [llength $offs]} {incr col} {
1506            if {[lindex $idlist $col] eq {}} {
1507                set haspad 1
1508                continue
1509            }
1510            set z [lindex $offs $col]
1511            if {$z eq {}} continue
1512            set isarrow 0
1513            set x0 [expr {$col + $z}]
1514            set y0 [expr {$row - 1}]
1515            set z0 [lindex $rowoffsets $y0 $x0]
1516            if {$z0 eq {}} {
1517                set id [lindex $idlist $col]
1518                set ranges [rowranges $id]
1519                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1520                    set isarrow 1
1521                }
1522            }
1523            if {$z < -1 || ($z < 0 && $isarrow)} {
1524                set npad [expr {-1 - $z + $isarrow}]
1525                set offs [incrange $offs $col $npad]
1526                insert_pad $y0 $x0 $npad
1527                if {$y0 > 0} {
1528                    optimize_rows $y0 $x0 $row
1529                }
1530                set z [lindex $offs $col]
1531                set x0 [expr {$col + $z}]
1532                set z0 [lindex $rowoffsets $y0 $x0]
1533            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1534                set npad [expr {$z - 1 + $isarrow}]
1535                set y1 [expr {$row + 1}]
1536                set offs2 [lindex $rowoffsets $y1]
1537                set x1 -1
1538                foreach z $offs2 {
1539                    incr x1
1540                    if {$z eq {} || $x1 + $z < $col} continue
1541                    if {$x1 + $z > $col} {
1542                        incr npad
1543                    }
1544                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1545                    break
1546                }
1547                set pad [ntimes $npad {}]
1548                set idlist [eval linsert \$idlist $col $pad]
1549                set tmp [eval linsert \$offs $col $pad]
1550                incr col $npad
1551                set offs [incrange $tmp $col [expr {-$npad}]]
1552                set z [lindex $offs $col]
1553                set haspad 1
1554            }
1555            if {$z0 eq {} && !$isarrow} {
1556                # this line links to its first child on row $row-2
1557                set rm2 [expr {$row - 2}]
1558                set id [lindex $displayorder $rm2]
1559                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1560                if {$xc >= 0} {
1561                    set z0 [expr {$xc - $x0}]
1562                }
1563            }
1564            if {$z0 ne {} && $z < 0 && $z0 > 0} {
1565                insert_pad $y0 $x0 1
1566                set offs [incrange $offs $col 1]
1567                optimize_rows $y0 [expr {$x0 + 1}] $row
1568            }
1569        }
1570        if {!$haspad} {
1571            set o {}
1572            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1573                set o [lindex $offs $col]
1574                if {$o eq {}} {
1575                    # check if this is the link to the first child
1576                    set id [lindex $idlist $col]
1577                    set ranges [rowranges $id]
1578                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
1579                        # it is, work out offset to child
1580                        set y0 [expr {$row - 1}]
1581                        set id [lindex $displayorder $y0]
1582                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1583                        if {$x0 >= 0} {
1584                            set o [expr {$x0 - $col}]
1585                        }
1586                    }
1587                }
1588                if {$o eq {} || $o <= 0} break
1589            }
1590            if {$o ne {} && [incr col] < [llength $idlist]} {
1591                set y1 [expr {$row + 1}]
1592                set offs2 [lindex $rowoffsets $y1]
1593                set x1 -1
1594                foreach z $offs2 {
1595                    incr x1
1596                    if {$z eq {} || $x1 + $z < $col} continue
1597                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
1598                    break
1599                }
1600                set idlist [linsert $idlist $col {}]
1601                set tmp [linsert $offs $col {}]
1602                incr col
1603                set offs [incrange $tmp $col -1]
1604            }
1605        }
1606        lset rowidlist $row $idlist
1607        lset rowoffsets $row $offs
1608        set col 0
1609    }
1610}
1611
1612proc xc {row col} {
1613    global canvx0 linespc
1614    return [expr {$canvx0 + $col * $linespc}]
1615}
1616
1617proc yc {row} {
1618    global canvy0 linespc
1619    return [expr {$canvy0 + $row * $linespc}]
1620}
1621
1622proc linewidth {id} {
1623    global thickerline lthickness
1624
1625    set wid $lthickness
1626    if {[info exists thickerline] && $id eq $thickerline} {
1627        set wid [expr {2 * $lthickness}]
1628    }
1629    return $wid
1630}
1631
1632proc rowranges {id} {
1633    global phase idrowranges commitrow rowlaidout rowrangelist
1634
1635    set ranges {}
1636    if {$phase eq {} ||
1637        ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1638        set ranges [lindex $rowrangelist $commitrow($id)]
1639    } elseif {[info exists idrowranges($id)]} {
1640        set ranges $idrowranges($id)
1641    }
1642    return $ranges
1643}
1644
1645proc drawlineseg {id i} {
1646    global rowoffsets rowidlist
1647    global displayorder
1648    global canv colormap linespc
1649    global numcommits commitrow
1650
1651    set ranges [rowranges $id]
1652    set downarrow 1
1653    if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1654        set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1655    } else {
1656        set downarrow 1
1657    }
1658    set startrow [lindex $ranges [expr {2 * $i}]]
1659    set row [lindex $ranges [expr {2 * $i + 1}]]
1660    if {$startrow == $row} return
1661    assigncolor $id
1662    set coords {}
1663    set col [lsearch -exact [lindex $rowidlist $row] $id]
1664    if {$col < 0} {
1665        puts "oops: drawline: id $id not on row $row"
1666        return
1667    }
1668    set lasto {}
1669    set ns 0
1670    while {1} {
1671        set o [lindex $rowoffsets $row $col]
1672        if {$o eq {}} break
1673        if {$o ne $lasto} {
1674            # changing direction
1675            set x [xc $row $col]
1676            set y [yc $row]
1677            lappend coords $x $y
1678            set lasto $o
1679        }
1680        incr col $o
1681        incr row -1
1682    }
1683    set x [xc $row $col]
1684    set y [yc $row]
1685    lappend coords $x $y
1686    if {$i == 0} {
1687        # draw the link to the first child as part of this line
1688        incr row -1
1689        set child [lindex $displayorder $row]
1690        set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1691        if {$ccol >= 0} {
1692            set x [xc $row $ccol]
1693            set y [yc $row]
1694            if {$ccol < $col - 1} {
1695                lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1696            } elseif {$ccol > $col + 1} {
1697                lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1698            }
1699            lappend coords $x $y
1700        }
1701    }
1702    if {[llength $coords] < 4} return
1703    if {$downarrow} {
1704        # This line has an arrow at the lower end: check if the arrow is
1705        # on a diagonal segment, and if so, work around the Tk 8.4
1706        # refusal to draw arrows on diagonal lines.
1707        set x0 [lindex $coords 0]
1708        set x1 [lindex $coords 2]
1709        if {$x0 != $x1} {
1710            set y0 [lindex $coords 1]
1711            set y1 [lindex $coords 3]
1712            if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1713                # we have a nearby vertical segment, just trim off the diag bit
1714                set coords [lrange $coords 2 end]
1715            } else {
1716                set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1717                set xi [expr {$x0 - $slope * $linespc / 2}]
1718                set yi [expr {$y0 - $linespc / 2}]
1719                set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1720            }
1721        }
1722    }
1723    set arrow [expr {2 * ($i > 0) + $downarrow}]
1724    set arrow [lindex {none first last both} $arrow]
1725    set t [$canv create line $coords -width [linewidth $id] \
1726               -fill $colormap($id) -tags lines.$id -arrow $arrow]
1727    $canv lower $t
1728    bindline $t $id
1729}
1730
1731proc drawparentlinks {id row col olds} {
1732    global rowidlist canv colormap
1733
1734    set row2 [expr {$row + 1}]
1735    set x [xc $row $col]
1736    set y [yc $row]
1737    set y2 [yc $row2]
1738    set ids [lindex $rowidlist $row2]
1739    # rmx = right-most X coord used
1740    set rmx 0
1741    foreach p $olds {
1742        set i [lsearch -exact $ids $p]
1743        if {$i < 0} {
1744            puts "oops, parent $p of $id not in list"
1745            continue
1746        }
1747        set x2 [xc $row2 $i]
1748        if {$x2 > $rmx} {
1749            set rmx $x2
1750        }
1751        set ranges [rowranges $p]
1752        if {$ranges ne {} && $row2 == [lindex $ranges 0]
1753            && $row2 < [lindex $ranges 1]} {
1754            # drawlineseg will do this one for us
1755            continue
1756        }
1757        assigncolor $p
1758        # should handle duplicated parents here...
1759        set coords [list $x $y]
1760        if {$i < $col - 1} {
1761            lappend coords [xc $row [expr {$i + 1}]] $y
1762        } elseif {$i > $col + 1} {
1763            lappend coords [xc $row [expr {$i - 1}]] $y
1764        }
1765        lappend coords $x2 $y2
1766        set t [$canv create line $coords -width [linewidth $p] \
1767                   -fill $colormap($p) -tags lines.$p]
1768        $canv lower $t
1769        bindline $t $p
1770    }
1771    return $rmx
1772}
1773
1774proc drawlines {id} {
1775    global colormap canv
1776    global idrangedrawn
1777    global childlist iddrawn commitrow rowidlist
1778
1779    $canv delete lines.$id
1780    set nr [expr {[llength [rowranges $id]] / 2}]
1781    for {set i 0} {$i < $nr} {incr i} {
1782        if {[info exists idrangedrawn($id,$i)]} {
1783            drawlineseg $id $i
1784        }
1785    }
1786    foreach child [lindex $childlist $commitrow($id)] {
1787        if {[info exists iddrawn($child)]} {
1788            set row $commitrow($child)
1789            set col [lsearch -exact [lindex $rowidlist $row] $child]
1790            if {$col >= 0} {
1791                drawparentlinks $child $row $col [list $id]
1792            }
1793        }
1794    }
1795}
1796
1797proc drawcmittext {id row col rmx} {
1798    global linespc canv canv2 canv3 canvy0
1799    global commitlisted commitinfo rowidlist
1800    global rowtextx idpos idtags idheads idotherrefs
1801    global linehtag linentag linedtag
1802    global mainfont namefont canvxmax
1803
1804    set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1805    set x [xc $row $col]
1806    set y [yc $row]
1807    set orad [expr {$linespc / 3}]
1808    set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1809               [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1810               -fill $ofill -outline black -width 1]
1811    $canv raise $t
1812    $canv bind $t <1> {selcanvline {} %x %y}
1813    set xt [xc $row [llength [lindex $rowidlist $row]]]
1814    if {$xt < $rmx} {
1815        set xt $rmx
1816    }
1817    set rowtextx($row) $xt
1818    set idpos($id) [list $x $xt $y]
1819    if {[info exists idtags($id)] || [info exists idheads($id)]
1820        || [info exists idotherrefs($id)]} {
1821        set xt [drawtags $id $x $xt $y]
1822    }
1823    set headline [lindex $commitinfo($id) 0]
1824    set name [lindex $commitinfo($id) 1]
1825    set date [lindex $commitinfo($id) 2]
1826    set date [formatdate $date]
1827    set linehtag($row) [$canv create text $xt $y -anchor w \
1828                            -text $headline -font $mainfont ]
1829    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1830    set linentag($row) [$canv2 create text 3 $y -anchor w \
1831                            -text $name -font $namefont]
1832    set linedtag($row) [$canv3 create text 3 $y -anchor w \
1833                            -text $date -font $mainfont]
1834    set xr [expr {$xt + [font measure $mainfont $headline]}]
1835    if {$xr > $canvxmax} {
1836        set canvxmax $xr
1837        setcanvscroll
1838    }
1839}
1840
1841proc drawcmitrow {row} {
1842    global displayorder rowidlist
1843    global idrangedrawn iddrawn
1844    global commitinfo parentlist numcommits
1845
1846    if {$row >= $numcommits} return
1847    foreach id [lindex $rowidlist $row] {
1848        if {$id eq {}} continue
1849        set i -1
1850        foreach {s e} [rowranges $id] {
1851            incr i
1852            if {$row < $s} continue
1853            if {$e eq {}} break
1854            if {$row <= $e} {
1855                if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1856                    drawlineseg $id $i
1857                    set idrangedrawn($id,$i) 1
1858                }
1859                break
1860            }
1861        }
1862    }
1863
1864    set id [lindex $displayorder $row]
1865    if {[info exists iddrawn($id)]} return
1866    set col [lsearch -exact [lindex $rowidlist $row] $id]
1867    if {$col < 0} {
1868        puts "oops, row $row id $id not in list"
1869        return
1870    }
1871    if {![info exists commitinfo($id)]} {
1872        getcommit $id
1873    }
1874    assigncolor $id
1875    set olds [lindex $parentlist $row]
1876    if {$olds ne {}} {
1877        set rmx [drawparentlinks $id $row $col $olds]
1878    } else {
1879        set rmx 0
1880    }
1881    drawcmittext $id $row $col $rmx
1882    set iddrawn($id) 1
1883}
1884
1885proc drawfrac {f0 f1} {
1886    global numcommits canv
1887    global linespc
1888
1889    set ymax [lindex [$canv cget -scrollregion] 3]
1890    if {$ymax eq {} || $ymax == 0} return
1891    set y0 [expr {int($f0 * $ymax)}]
1892    set row [expr {int(($y0 - 3) / $linespc) - 1}]
1893    if {$row < 0} {
1894        set row 0
1895    }
1896    set y1 [expr {int($f1 * $ymax)}]
1897    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1898    if {$endrow >= $numcommits} {
1899        set endrow [expr {$numcommits - 1}]
1900    }
1901    for {} {$row <= $endrow} {incr row} {
1902        drawcmitrow $row
1903    }
1904}
1905
1906proc drawvisible {} {
1907    global canv
1908    eval drawfrac [$canv yview]
1909}
1910
1911proc clear_display {} {
1912    global iddrawn idrangedrawn
1913
1914    allcanvs delete all
1915    catch {unset iddrawn}
1916    catch {unset idrangedrawn}
1917}
1918
1919proc findcrossings {id} {
1920    global rowidlist parentlist numcommits rowoffsets displayorder
1921
1922    set cross {}
1923    set ccross {}
1924    foreach {s e} [rowranges $id] {
1925        if {$e >= $numcommits} {
1926            set e [expr {$numcommits - 1}]
1927        }
1928        if {$e <= $s} continue
1929        set x [lsearch -exact [lindex $rowidlist $e] $id]
1930        if {$x < 0} {
1931            puts "findcrossings: oops, no [shortids $id] in row $e"
1932            continue
1933        }
1934        for {set row $e} {[incr row -1] >= $s} {} {
1935            set olds [lindex $parentlist $row]
1936            set kid [lindex $displayorder $row]
1937            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1938            if {$kidx < 0} continue
1939            set nextrow [lindex $rowidlist [expr {$row + 1}]]
1940            foreach p $olds {
1941                set px [lsearch -exact $nextrow $p]
1942                if {$px < 0} continue
1943                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1944                    if {[lsearch -exact $ccross $p] >= 0} continue
1945                    if {$x == $px + ($kidx < $px? -1: 1)} {
1946                        lappend ccross $p
1947                    } elseif {[lsearch -exact $cross $p] < 0} {
1948                        lappend cross $p
1949                    }
1950                }
1951            }
1952            set inc [lindex $rowoffsets $row $x]
1953            if {$inc eq {}} break
1954            incr x $inc
1955        }
1956    }
1957    return [concat $ccross {{}} $cross]
1958}
1959
1960proc assigncolor {id} {
1961    global colormap colors nextcolor
1962    global commitrow parentlist children childlist
1963
1964    if {[info exists colormap($id)]} return
1965    set ncolors [llength $colors]
1966    if {[info exists commitrow($id)]} {
1967        set kids [lindex $childlist $commitrow($id)]
1968    } elseif {[info exists children($id)]} {
1969        set kids $children($id)
1970    } else {
1971        set kids {}
1972    }
1973    if {[llength $kids] == 1} {
1974        set child [lindex $kids 0]
1975        if {[info exists colormap($child)]
1976            && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1977            set colormap($id) $colormap($child)
1978            return
1979        }
1980    }
1981    set badcolors {}
1982    set origbad {}
1983    foreach x [findcrossings $id] {
1984        if {$x eq {}} {
1985            # delimiter between corner crossings and other crossings
1986            if {[llength $badcolors] >= $ncolors - 1} break
1987            set origbad $badcolors
1988        }
1989        if {[info exists colormap($x)]
1990            && [lsearch -exact $badcolors $colormap($x)] < 0} {
1991            lappend badcolors $colormap($x)
1992        }
1993    }
1994    if {[llength $badcolors] >= $ncolors} {
1995        set badcolors $origbad
1996    }
1997    set origbad $badcolors
1998    if {[llength $badcolors] < $ncolors - 1} {
1999        foreach child $kids {
2000            if {[info exists colormap($child)]
2001                && [lsearch -exact $badcolors $colormap($child)] < 0} {
2002                lappend badcolors $colormap($child)
2003            }
2004            foreach p [lindex $parentlist $commitrow($child)] {
2005                if {[info exists colormap($p)]
2006                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
2007                    lappend badcolors $colormap($p)
2008                }
2009            }
2010        }
2011        if {[llength $badcolors] >= $ncolors} {
2012            set badcolors $origbad
2013        }
2014    }
2015    for {set i 0} {$i <= $ncolors} {incr i} {
2016        set c [lindex $colors $nextcolor]
2017        if {[incr nextcolor] >= $ncolors} {
2018            set nextcolor 0
2019        }
2020        if {[lsearch -exact $badcolors $c]} break
2021    }
2022    set colormap($id) $c
2023}
2024
2025proc bindline {t id} {
2026    global canv
2027
2028    $canv bind $t <Enter> "lineenter %x %y $id"
2029    $canv bind $t <Motion> "linemotion %x %y $id"
2030    $canv bind $t <Leave> "lineleave $id"
2031    $canv bind $t <Button-1> "lineclick %x %y $id 1"
2032}
2033
2034proc drawtags {id x xt y1} {
2035    global idtags idheads idotherrefs
2036    global linespc lthickness
2037    global canv mainfont commitrow rowtextx
2038
2039    set marks {}
2040    set ntags 0
2041    set nheads 0
2042    if {[info exists idtags($id)]} {
2043        set marks $idtags($id)
2044        set ntags [llength $marks]
2045    }
2046    if {[info exists idheads($id)]} {
2047        set marks [concat $marks $idheads($id)]
2048        set nheads [llength $idheads($id)]
2049    }
2050    if {[info exists idotherrefs($id)]} {
2051        set marks [concat $marks $idotherrefs($id)]
2052    }
2053    if {$marks eq {}} {
2054        return $xt
2055    }
2056
2057    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2058    set yt [expr {$y1 - 0.5 * $linespc}]
2059    set yb [expr {$yt + $linespc - 1}]
2060    set xvals {}
2061    set wvals {}
2062    foreach tag $marks {
2063        set wid [font measure $mainfont $tag]
2064        lappend xvals $xt
2065        lappend wvals $wid
2066        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2067    }
2068    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2069               -width $lthickness -fill black -tags tag.$id]
2070    $canv lower $t
2071    foreach tag $marks x $xvals wid $wvals {
2072        set xl [expr {$x + $delta}]
2073        set xr [expr {$x + $delta + $wid + $lthickness}]
2074        if {[incr ntags -1] >= 0} {
2075            # draw a tag
2076            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2077                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2078                       -width 1 -outline black -fill yellow -tags tag.$id]
2079            $canv bind $t <1> [list showtag $tag 1]
2080            set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2081        } else {
2082            # draw a head or other ref
2083            if {[incr nheads -1] >= 0} {
2084                set col green
2085            } else {
2086                set col "#ddddff"
2087            }
2088            set xl [expr {$xl - $delta/2}]
2089            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2090                -width 1 -outline black -fill $col -tags tag.$id
2091        }
2092        set t [$canv create text $xl $y1 -anchor w -text $tag \
2093                   -font $mainfont -tags tag.$id]
2094        if {$ntags >= 0} {
2095            $canv bind $t <1> [list showtag $tag 1]
2096        }
2097    }
2098    return $xt
2099}
2100
2101proc xcoord {i level ln} {
2102    global canvx0 xspc1 xspc2
2103
2104    set x [expr {$canvx0 + $i * $xspc1($ln)}]
2105    if {$i > 0 && $i == $level} {
2106        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2107    } elseif {$i > $level} {
2108        set x [expr {$x + $xspc2 - $xspc1($ln)}]
2109    }
2110    return $x
2111}
2112
2113proc finishcommits {} {
2114    global commitidx phase
2115    global canv mainfont ctext maincursor textcursor
2116    global findinprogress pending_select
2117
2118    if {$commitidx > 0} {
2119        drawrest
2120    } else {
2121        $canv delete all
2122        $canv create text 3 3 -anchor nw -text "No commits selected" \
2123            -font $mainfont -tags textitems
2124    }
2125    if {![info exists findinprogress]} {
2126        . config -cursor $maincursor
2127        settextcursor $textcursor
2128    }
2129    set phase {}
2130    catch {unset pending_select}
2131}
2132
2133# Don't change the text pane cursor if it is currently the hand cursor,
2134# showing that we are over a sha1 ID link.
2135proc settextcursor {c} {
2136    global ctext curtextcursor
2137
2138    if {[$ctext cget -cursor] == $curtextcursor} {
2139        $ctext config -cursor $c
2140    }
2141    set curtextcursor $c
2142}
2143
2144proc drawrest {} {
2145    global numcommits
2146    global startmsecs
2147    global canvy0 numcommits linespc
2148    global rowlaidout commitidx
2149    global pending_select
2150
2151    set row $rowlaidout
2152    layoutrows $rowlaidout $commitidx 1
2153    layouttail
2154    optimize_rows $row 0 $commitidx
2155    showstuff $commitidx
2156    if {[info exists pending_select]} {
2157        selectline 0 1
2158    }
2159
2160    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2161    #puts "overall $drawmsecs ms for $numcommits commits"
2162}
2163
2164proc findmatches {f} {
2165    global findtype foundstring foundstrlen
2166    if {$findtype == "Regexp"} {
2167        set matches [regexp -indices -all -inline $foundstring $f]
2168    } else {
2169        if {$findtype == "IgnCase"} {
2170            set str [string tolower $f]
2171        } else {
2172            set str $f
2173        }
2174        set matches {}
2175        set i 0
2176        while {[set j [string first $foundstring $str $i]] >= 0} {
2177            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2178            set i [expr {$j + $foundstrlen}]
2179        }
2180    }
2181    return $matches
2182}
2183
2184proc dofind {} {
2185    global findtype findloc findstring markedmatches commitinfo
2186    global numcommits displayorder linehtag linentag linedtag
2187    global mainfont namefont canv canv2 canv3 selectedline
2188    global matchinglines foundstring foundstrlen matchstring
2189    global commitdata
2190
2191    stopfindproc
2192    unmarkmatches
2193    focus .
2194    set matchinglines {}
2195    if {$findloc == "Pickaxe"} {
2196        findpatches
2197        return
2198    }
2199    if {$findtype == "IgnCase"} {
2200        set foundstring [string tolower $findstring]
2201    } else {
2202        set foundstring $findstring
2203    }
2204    set foundstrlen [string length $findstring]
2205    if {$foundstrlen == 0} return
2206    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2207    set matchstring "*$matchstring*"
2208    if {$findloc == "Files"} {
2209        findfiles
2210        return
2211    }
2212    if {![info exists selectedline]} {
2213        set oldsel -1
2214    } else {
2215        set oldsel $selectedline
2216    }
2217    set didsel 0
2218    set fldtypes {Headline Author Date Committer CDate Comment}
2219    set l -1
2220    foreach id $displayorder {
2221        set d $commitdata($id)
2222        incr l
2223        if {$findtype == "Regexp"} {
2224            set doesmatch [regexp $foundstring $d]
2225        } elseif {$findtype == "IgnCase"} {
2226            set doesmatch [string match -nocase $matchstring $d]
2227        } else {
2228            set doesmatch [string match $matchstring $d]
2229        }
2230        if {!$doesmatch} continue
2231        if {![info exists commitinfo($id)]} {
2232            getcommit $id
2233        }
2234        set info $commitinfo($id)
2235        set doesmatch 0
2236        foreach f $info ty $fldtypes {
2237            if {$findloc != "All fields" && $findloc != $ty} {
2238                continue
2239            }
2240            set matches [findmatches $f]
2241            if {$matches == {}} continue
2242            set doesmatch 1
2243            if {$ty == "Headline"} {
2244                drawcmitrow $l
2245                markmatches $canv $l $f $linehtag($l) $matches $mainfont
2246            } elseif {$ty == "Author"} {
2247                drawcmitrow $l
2248                markmatches $canv2 $l $f $linentag($l) $matches $namefont
2249            } elseif {$ty == "Date"} {
2250                drawcmitrow $l
2251                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2252            }
2253        }
2254        if {$doesmatch} {
2255            lappend matchinglines $l
2256            if {!$didsel && $l > $oldsel} {
2257                findselectline $l
2258                set didsel 1
2259            }
2260        }
2261    }
2262    if {$matchinglines == {}} {
2263        bell
2264    } elseif {!$didsel} {
2265        findselectline [lindex $matchinglines 0]
2266    }
2267}
2268
2269proc findselectline {l} {
2270    global findloc commentend ctext
2271    selectline $l 1
2272    if {$findloc == "All fields" || $findloc == "Comments"} {
2273        # highlight the matches in the comments
2274        set f [$ctext get 1.0 $commentend]
2275        set matches [findmatches $f]
2276        foreach match $matches {
2277            set start [lindex $match 0]
2278            set end [expr {[lindex $match 1] + 1}]
2279            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2280        }
2281    }
2282}
2283
2284proc findnext {restart} {
2285    global matchinglines selectedline
2286    if {![info exists matchinglines]} {
2287        if {$restart} {
2288            dofind
2289        }
2290        return
2291    }
2292    if {![info exists selectedline]} return
2293    foreach l $matchinglines {
2294        if {$l > $selectedline} {
2295            findselectline $l
2296            return
2297        }
2298    }
2299    bell
2300}
2301
2302proc findprev {} {
2303    global matchinglines selectedline
2304    if {![info exists matchinglines]} {
2305        dofind
2306        return
2307    }
2308    if {![info exists selectedline]} return
2309    set prev {}
2310    foreach l $matchinglines {
2311        if {$l >= $selectedline} break
2312        set prev $l
2313    }
2314    if {$prev != {}} {
2315        findselectline $prev
2316    } else {
2317        bell
2318    }
2319}
2320
2321proc findlocchange {name ix op} {
2322    global findloc findtype findtypemenu
2323    if {$findloc == "Pickaxe"} {
2324        set findtype Exact
2325        set state disabled
2326    } else {
2327        set state normal
2328    }
2329    $findtypemenu entryconf 1 -state $state
2330    $findtypemenu entryconf 2 -state $state
2331}
2332
2333proc stopfindproc {{done 0}} {
2334    global findprocpid findprocfile findids
2335    global ctext findoldcursor phase maincursor textcursor
2336    global findinprogress
2337
2338    catch {unset findids}
2339    if {[info exists findprocpid]} {
2340        if {!$done} {
2341            catch {exec kill $findprocpid}
2342        }
2343        catch {close $findprocfile}
2344        unset findprocpid
2345    }
2346    if {[info exists findinprogress]} {
2347        unset findinprogress
2348        if {$phase eq {}} {
2349            . config -cursor $maincursor
2350            settextcursor $textcursor
2351        }
2352    }
2353}
2354
2355proc findpatches {} {
2356    global findstring selectedline numcommits
2357    global findprocpid findprocfile
2358    global finddidsel ctext displayorder findinprogress
2359    global findinsertpos
2360
2361    if {$numcommits == 0} return
2362
2363    # make a list of all the ids to search, starting at the one
2364    # after the selected line (if any)
2365    if {[info exists selectedline]} {
2366        set l $selectedline
2367    } else {
2368        set l -1
2369    }
2370    set inputids {}
2371    for {set i 0} {$i < $numcommits} {incr i} {
2372        if {[incr l] >= $numcommits} {
2373            set l 0
2374        }
2375        append inputids [lindex $displayorder $l] "\n"
2376    }
2377
2378    if {[catch {
2379        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2380                         << $inputids] r]
2381    } err]} {
2382        error_popup "Error starting search process: $err"
2383        return
2384    }
2385
2386    set findinsertpos end
2387    set findprocfile $f
2388    set findprocpid [pid $f]
2389    fconfigure $f -blocking 0
2390    fileevent $f readable readfindproc
2391    set finddidsel 0
2392    . config -cursor watch
2393    settextcursor watch
2394    set findinprogress 1
2395}
2396
2397proc readfindproc {} {
2398    global findprocfile finddidsel
2399    global commitrow matchinglines findinsertpos
2400
2401    set n [gets $findprocfile line]
2402    if {$n < 0} {
2403        if {[eof $findprocfile]} {
2404            stopfindproc 1
2405            if {!$finddidsel} {
2406                bell
2407            }
2408        }
2409        return
2410    }
2411    if {![regexp {^[0-9a-f]{40}} $line id]} {
2412        error_popup "Can't parse git-diff-tree output: $line"
2413        stopfindproc
2414        return
2415    }
2416    if {![info exists commitrow($id)]} {
2417        puts stderr "spurious id: $id"
2418        return
2419    }
2420    set l $commitrow($id)
2421    insertmatch $l $id
2422}
2423
2424proc insertmatch {l id} {
2425    global matchinglines findinsertpos finddidsel
2426
2427    if {$findinsertpos == "end"} {
2428        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2429            set matchinglines [linsert $matchinglines 0 $l]
2430            set findinsertpos 1
2431        } else {
2432            lappend matchinglines $l
2433        }
2434    } else {
2435        set matchinglines [linsert $matchinglines $findinsertpos $l]
2436        incr findinsertpos
2437    }
2438    markheadline $l $id
2439    if {!$finddidsel} {
2440        findselectline $l
2441        set finddidsel 1
2442    }
2443}
2444
2445proc findfiles {} {
2446    global selectedline numcommits displayorder ctext
2447    global ffileline finddidsel parentlist
2448    global findinprogress findstartline findinsertpos
2449    global treediffs fdiffid fdiffsneeded fdiffpos
2450    global findmergefiles
2451
2452    if {$numcommits == 0} return
2453
2454    if {[info exists selectedline]} {
2455        set l [expr {$selectedline + 1}]
2456    } else {
2457        set l 0
2458    }
2459    set ffileline $l
2460    set findstartline $l
2461    set diffsneeded {}
2462    set fdiffsneeded {}
2463    while 1 {
2464        set id [lindex $displayorder $l]
2465        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2466            if {![info exists treediffs($id)]} {
2467                append diffsneeded "$id\n"
2468                lappend fdiffsneeded $id
2469            }
2470        }
2471        if {[incr l] >= $numcommits} {
2472            set l 0
2473        }
2474        if {$l == $findstartline} break
2475    }
2476
2477    # start off a git-diff-tree process if needed
2478    if {$diffsneeded ne {}} {
2479        if {[catch {
2480            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2481        } err ]} {
2482            error_popup "Error starting search process: $err"
2483            return
2484        }
2485        catch {unset fdiffid}
2486        set fdiffpos 0
2487        fconfigure $df -blocking 0
2488        fileevent $df readable [list readfilediffs $df]
2489    }
2490
2491    set finddidsel 0
2492    set findinsertpos end
2493    set id [lindex $displayorder $l]
2494    . config -cursor watch
2495    settextcursor watch
2496    set findinprogress 1
2497    findcont
2498    update
2499}
2500
2501proc readfilediffs {df} {
2502    global findid fdiffid fdiffs
2503
2504    set n [gets $df line]
2505    if {$n < 0} {
2506        if {[eof $df]} {
2507            donefilediff
2508            if {[catch {close $df} err]} {
2509                stopfindproc
2510                bell
2511                error_popup "Error in git-diff-tree: $err"
2512            } elseif {[info exists findid]} {
2513                set id $findid
2514                stopfindproc
2515                bell
2516                error_popup "Couldn't find diffs for $id"
2517            }
2518        }
2519        return
2520    }
2521    if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2522        # start of a new string of diffs
2523        donefilediff
2524        set fdiffid $id
2525        set fdiffs {}
2526    } elseif {[string match ":*" $line]} {
2527        lappend fdiffs [lindex $line 5]
2528    }
2529}
2530
2531proc donefilediff {} {
2532    global fdiffid fdiffs treediffs findid
2533    global fdiffsneeded fdiffpos
2534
2535    if {[info exists fdiffid]} {
2536        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2537               && $fdiffpos < [llength $fdiffsneeded]} {
2538            # git-diff-tree doesn't output anything for a commit
2539            # which doesn't change anything
2540            set nullid [lindex $fdiffsneeded $fdiffpos]
2541            set treediffs($nullid) {}
2542            if {[info exists findid] && $nullid eq $findid} {
2543                unset findid
2544                findcont
2545            }
2546            incr fdiffpos
2547        }
2548        incr fdiffpos
2549
2550        if {![info exists treediffs($fdiffid)]} {
2551            set treediffs($fdiffid) $fdiffs
2552        }
2553        if {[info exists findid] && $fdiffid eq $findid} {
2554            unset findid
2555            findcont
2556        }
2557    }
2558}
2559
2560proc findcont {} {
2561    global findid treediffs parentlist
2562    global ffileline findstartline finddidsel
2563    global displayorder numcommits matchinglines findinprogress
2564    global findmergefiles
2565
2566    set l $ffileline
2567    while {1} {
2568        set id [lindex $displayorder $l]
2569        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2570            if {![info exists treediffs($id)]} {
2571                set findid $id
2572                set ffileline $l
2573                return
2574            }
2575            set doesmatch 0
2576            foreach f $treediffs($id) {
2577                set x [findmatches $f]
2578                if {$x != {}} {
2579                    set doesmatch 1
2580                    break
2581                }
2582            }
2583            if {$doesmatch} {
2584                insertmatch $l $id
2585            }
2586        }
2587        if {[incr l] >= $numcommits} {
2588            set l 0
2589        }
2590        if {$l == $findstartline} break
2591    }
2592    stopfindproc
2593    if {!$finddidsel} {
2594        bell
2595    }
2596}
2597
2598# mark a commit as matching by putting a yellow background
2599# behind the headline
2600proc markheadline {l id} {
2601    global canv mainfont linehtag
2602
2603    drawcmitrow $l
2604    set bbox [$canv bbox $linehtag($l)]
2605    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2606    $canv lower $t
2607}
2608
2609# mark the bits of a headline, author or date that match a find string
2610proc markmatches {canv l str tag matches font} {
2611    set bbox [$canv bbox $tag]
2612    set x0 [lindex $bbox 0]
2613    set y0 [lindex $bbox 1]
2614    set y1 [lindex $bbox 3]
2615    foreach match $matches {
2616        set start [lindex $match 0]
2617        set end [lindex $match 1]
2618        if {$start > $end} continue
2619        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2620        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2621        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2622                   [expr {$x0+$xlen+2}] $y1 \
2623                   -outline {} -tags matches -fill yellow]
2624        $canv lower $t
2625    }
2626}
2627
2628proc unmarkmatches {} {
2629    global matchinglines findids
2630    allcanvs delete matches
2631    catch {unset matchinglines}
2632    catch {unset findids}
2633}
2634
2635proc selcanvline {w x y} {
2636    global canv canvy0 ctext linespc
2637    global rowtextx
2638    set ymax [lindex [$canv cget -scrollregion] 3]
2639    if {$ymax == {}} return
2640    set yfrac [lindex [$canv yview] 0]
2641    set y [expr {$y + $yfrac * $ymax}]
2642    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2643    if {$l < 0} {
2644        set l 0
2645    }
2646    if {$w eq $canv} {
2647        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2648    }
2649    unmarkmatches
2650    selectline $l 1
2651}
2652
2653proc commit_descriptor {p} {
2654    global commitinfo
2655    set l "..."
2656    if {[info exists commitinfo($p)]} {
2657        set l [lindex $commitinfo($p) 0]
2658    }
2659    return "$p ($l)"
2660}
2661
2662# append some text to the ctext widget, and make any SHA1 ID
2663# that we know about be a clickable link.
2664proc appendwithlinks {text} {
2665    global ctext commitrow linknum
2666
2667    set start [$ctext index "end - 1c"]
2668    $ctext insert end $text
2669    $ctext insert end "\n"
2670    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2671    foreach l $links {
2672        set s [lindex $l 0]
2673        set e [lindex $l 1]
2674        set linkid [string range $text $s $e]
2675        if {![info exists commitrow($linkid)]} continue
2676        incr e
2677        $ctext tag add link "$start + $s c" "$start + $e c"
2678        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2679        $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2680        incr linknum
2681    }
2682    $ctext tag conf link -foreground blue -underline 1
2683    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2684    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2685}
2686
2687proc viewnextline {dir} {
2688    global canv linespc
2689
2690    $canv delete hover
2691    set ymax [lindex [$canv cget -scrollregion] 3]
2692    set wnow [$canv yview]
2693    set wtop [expr {[lindex $wnow 0] * $ymax}]
2694    set newtop [expr {$wtop + $dir * $linespc}]
2695    if {$newtop < 0} {
2696        set newtop 0
2697    } elseif {$newtop > $ymax} {
2698        set newtop $ymax
2699    }
2700    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2701}
2702
2703proc selectline {l isnew} {
2704    global canv canv2 canv3 ctext commitinfo selectedline
2705    global displayorder linehtag linentag linedtag
2706    global canvy0 linespc parentlist childlist
2707    global cflist currentid sha1entry
2708    global commentend idtags linknum
2709    global mergemax numcommits pending_select
2710
2711    catch {unset pending_select}
2712    $canv delete hover
2713    normalline
2714    if {$l < 0 || $l >= $numcommits} return
2715    set y [expr {$canvy0 + $l * $linespc}]
2716    set ymax [lindex [$canv cget -scrollregion] 3]
2717    set ytop [expr {$y - $linespc - 1}]
2718    set ybot [expr {$y + $linespc + 1}]
2719    set wnow [$canv yview]
2720    set wtop [expr {[lindex $wnow 0] * $ymax}]
2721    set wbot [expr {[lindex $wnow 1] * $ymax}]
2722    set wh [expr {$wbot - $wtop}]
2723    set newtop $wtop
2724    if {$ytop < $wtop} {
2725        if {$ybot < $wtop} {
2726            set newtop [expr {$y - $wh / 2.0}]
2727        } else {
2728            set newtop $ytop
2729            if {$newtop > $wtop - $linespc} {
2730                set newtop [expr {$wtop - $linespc}]
2731            }
2732        }
2733    } elseif {$ybot > $wbot} {
2734        if {$ytop > $wbot} {
2735            set newtop [expr {$y - $wh / 2.0}]
2736        } else {
2737            set newtop [expr {$ybot - $wh}]
2738            if {$newtop < $wtop + $linespc} {
2739                set newtop [expr {$wtop + $linespc}]
2740            }
2741        }
2742    }
2743    if {$newtop != $wtop} {
2744        if {$newtop < 0} {
2745            set newtop 0
2746        }
2747        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2748        drawvisible
2749    }
2750
2751    if {![info exists linehtag($l)]} return
2752    $canv delete secsel
2753    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2754               -tags secsel -fill [$canv cget -selectbackground]]
2755    $canv lower $t
2756    $canv2 delete secsel
2757    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2758               -tags secsel -fill [$canv2 cget -selectbackground]]
2759    $canv2 lower $t
2760    $canv3 delete secsel
2761    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2762               -tags secsel -fill [$canv3 cget -selectbackground]]
2763    $canv3 lower $t
2764
2765    if {$isnew} {
2766        addtohistory [list selectline $l 0]
2767    }
2768
2769    set selectedline $l
2770
2771    set id [lindex $displayorder $l]
2772    set currentid $id
2773    $sha1entry delete 0 end
2774    $sha1entry insert 0 $id
2775    $sha1entry selection from 0
2776    $sha1entry selection to end
2777
2778    $ctext conf -state normal
2779    $ctext delete 0.0 end
2780    set linknum 0
2781    $ctext mark set fmark.0 0.0
2782    $ctext mark gravity fmark.0 left
2783    set info $commitinfo($id)
2784    set date [formatdate [lindex $info 2]]
2785    $ctext insert end "Author: [lindex $info 1]  $date\n"
2786    set date [formatdate [lindex $info 4]]
2787    $ctext insert end "Committer: [lindex $info 3]  $date\n"
2788    if {[info exists idtags($id)]} {
2789        $ctext insert end "Tags:"
2790        foreach tag $idtags($id) {
2791            $ctext insert end " $tag"
2792        }
2793        $ctext insert end "\n"
2794    }
2795 
2796    set comment {}
2797    set olds [lindex $parentlist $l]
2798    if {[llength $olds] > 1} {
2799        set np 0
2800        foreach p $olds {
2801            if {$np >= $mergemax} {
2802                set tag mmax
2803            } else {
2804                set tag m$np
2805            }
2806            $ctext insert end "Parent: " $tag
2807            appendwithlinks [commit_descriptor $p]
2808            incr np
2809        }
2810    } else {
2811        foreach p $olds {
2812            append comment "Parent: [commit_descriptor $p]\n"
2813        }
2814    }
2815
2816    foreach c [lindex $childlist $l] {
2817        append comment "Child:  [commit_descriptor $c]\n"
2818    }
2819    append comment "\n"
2820    append comment [lindex $info 5]
2821
2822    # make anything that looks like a SHA1 ID be a clickable link
2823    appendwithlinks $comment
2824
2825    $ctext tag delete Comments
2826    $ctext tag remove found 1.0 end
2827    $ctext conf -state disabled
2828    set commentend [$ctext index "end - 1c"]
2829
2830    $cflist delete 0 end
2831    $cflist insert end "Comments"
2832    if {[llength $olds] <= 1} {
2833        startdiff $id
2834    } else {
2835        mergediff $id $l
2836    }
2837}
2838
2839proc selfirstline {} {
2840    unmarkmatches
2841    selectline 0 1
2842}
2843
2844proc sellastline {} {
2845    global numcommits
2846    unmarkmatches
2847    set l [expr {$numcommits - 1}]
2848    selectline $l 1
2849}
2850
2851proc selnextline {dir} {
2852    global selectedline
2853    if {![info exists selectedline]} return
2854    set l [expr {$selectedline + $dir}]
2855    unmarkmatches
2856    selectline $l 1
2857}
2858
2859proc selnextpage {dir} {
2860    global canv linespc selectedline numcommits
2861
2862    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2863    if {$lpp < 1} {
2864        set lpp 1
2865    }
2866    allcanvs yview scroll [expr {$dir * $lpp}] units
2867    if {![info exists selectedline]} return
2868    set l [expr {$selectedline + $dir * $lpp}]
2869    if {$l < 0} {
2870        set l 0
2871    } elseif {$l >= $numcommits} {
2872        set l [expr $numcommits - 1]
2873    }
2874    unmarkmatches
2875    selectline $l 1    
2876}
2877
2878proc unselectline {} {
2879    global selectedline currentid
2880
2881    catch {unset selectedline}
2882    catch {unset currentid}
2883    allcanvs delete secsel
2884}
2885
2886proc addtohistory {cmd} {
2887    global history historyindex curview
2888
2889    set elt [list $curview $cmd]
2890    if {$historyindex > 0
2891        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2892        return
2893    }
2894
2895    if {$historyindex < [llength $history]} {
2896        set history [lreplace $history $historyindex end $elt]
2897    } else {
2898        lappend history $elt
2899    }
2900    incr historyindex
2901    if {$historyindex > 1} {
2902        .ctop.top.bar.leftbut conf -state normal
2903    } else {
2904        .ctop.top.bar.leftbut conf -state disabled
2905    }
2906    .ctop.top.bar.rightbut conf -state disabled
2907}
2908
2909proc godo {elt} {
2910    global curview
2911
2912    set view [lindex $elt 0]
2913    set cmd [lindex $elt 1]
2914    if {$curview != $view} {
2915        showview $view
2916    }
2917    eval $cmd
2918}
2919
2920proc goback {} {
2921    global history historyindex
2922
2923    if {$historyindex > 1} {
2924        incr historyindex -1
2925        godo [lindex $history [expr {$historyindex - 1}]]
2926        .ctop.top.bar.rightbut conf -state normal
2927    }
2928    if {$historyindex <= 1} {
2929        .ctop.top.bar.leftbut conf -state disabled
2930    }
2931}
2932
2933proc goforw {} {
2934    global history historyindex
2935
2936    if {$historyindex < [llength $history]} {
2937        set cmd [lindex $history $historyindex]
2938        incr historyindex
2939        godo $cmd
2940        .ctop.top.bar.leftbut conf -state normal
2941    }
2942    if {$historyindex >= [llength $history]} {
2943        .ctop.top.bar.rightbut conf -state disabled
2944    }
2945}
2946
2947proc mergediff {id l} {
2948    global diffmergeid diffopts mdifffd
2949    global difffilestart diffids
2950    global parentlist
2951
2952    set diffmergeid $id
2953    set diffids $id
2954    catch {unset difffilestart}
2955    # this doesn't seem to actually affect anything...
2956    set env(GIT_DIFF_OPTS) $diffopts
2957    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2958    if {[catch {set mdf [open $cmd r]} err]} {
2959        error_popup "Error getting merge diffs: $err"
2960        return
2961    }
2962    fconfigure $mdf -blocking 0
2963    set mdifffd($id) $mdf
2964    set np [llength [lindex $parentlist $l]]
2965    fileevent $mdf readable [list getmergediffline $mdf $id $np]
2966    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2967}
2968
2969proc getmergediffline {mdf id np} {
2970    global diffmergeid ctext cflist nextupdate mergemax
2971    global difffilestart mdifffd
2972
2973    set n [gets $mdf line]
2974    if {$n < 0} {
2975        if {[eof $mdf]} {
2976            close $mdf
2977        }
2978        return
2979    }
2980    if {![info exists diffmergeid] || $id != $diffmergeid
2981        || $mdf != $mdifffd($id)} {
2982        return
2983    }
2984    $ctext conf -state normal
2985    if {[regexp {^diff --cc (.*)} $line match fname]} {
2986        # start of a new file
2987        $ctext insert end "\n"
2988        set here [$ctext index "end - 1c"]
2989        set i [$cflist index end]
2990        $ctext mark set fmark.$i $here
2991        $ctext mark gravity fmark.$i left
2992        set difffilestart([expr {$i-1}]) $here
2993        $cflist insert end $fname
2994        set l [expr {(78 - [string length $fname]) / 2}]
2995        set pad [string range "----------------------------------------" 1 $l]
2996        $ctext insert end "$pad $fname $pad\n" filesep
2997    } elseif {[regexp {^@@} $line]} {
2998        $ctext insert end "$line\n" hunksep
2999    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3000        # do nothing
3001    } else {
3002        # parse the prefix - one ' ', '-' or '+' for each parent
3003        set spaces {}
3004        set minuses {}
3005        set pluses {}
3006        set isbad 0
3007        for {set j 0} {$j < $np} {incr j} {
3008            set c [string range $line $j $j]
3009            if {$c == " "} {
3010                lappend spaces $j
3011            } elseif {$c == "-"} {
3012                lappend minuses $j
3013            } elseif {$c == "+"} {
3014                lappend pluses $j
3015            } else {
3016                set isbad 1
3017                break
3018            }
3019        }
3020        set tags {}
3021        set num {}
3022        if {!$isbad && $minuses ne {} && $pluses eq {}} {
3023            # line doesn't appear in result, parents in $minuses have the line
3024            set num [lindex $minuses 0]
3025        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3026            # line appears in result, parents in $pluses don't have the line
3027            lappend tags mresult
3028            set num [lindex $spaces 0]
3029        }
3030        if {$num ne {}} {
3031            if {$num >= $mergemax} {
3032                set num "max"
3033            }
3034            lappend tags m$num
3035        }
3036        $ctext insert end "$line\n" $tags
3037    }
3038    $ctext conf -state disabled
3039    if {[clock clicks -milliseconds] >= $nextupdate} {
3040        incr nextupdate 100
3041        fileevent $mdf readable {}
3042        update
3043        fileevent $mdf readable [list getmergediffline $mdf $id $np]
3044    }
3045}
3046
3047proc startdiff {ids} {
3048    global treediffs diffids treepending diffmergeid
3049
3050    set diffids $ids
3051    catch {unset diffmergeid}
3052    if {![info exists treediffs($ids)]} {
3053        if {![info exists treepending]} {
3054            gettreediffs $ids
3055        }
3056    } else {
3057        addtocflist $ids
3058    }
3059}
3060
3061proc addtocflist {ids} {
3062    global treediffs cflist
3063    foreach f $treediffs($ids) {
3064        $cflist insert end $f
3065    }
3066    getblobdiffs $ids
3067}
3068
3069proc gettreediffs {ids} {
3070    global treediff treepending
3071    set treepending $ids
3072    set treediff {}
3073    if {[catch \
3074         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3075        ]} return
3076    fconfigure $gdtf -blocking 0
3077    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3078}
3079
3080proc gettreediffline {gdtf ids} {
3081    global treediff treediffs treepending diffids diffmergeid
3082
3083    set n [gets $gdtf line]
3084    if {$n < 0} {
3085        if {![eof $gdtf]} return
3086        close $gdtf
3087        set treediffs($ids) $treediff
3088        unset treepending
3089        if {$ids != $diffids} {
3090            if {![info exists diffmergeid]} {
3091                gettreediffs $diffids
3092            }
3093        } else {
3094            addtocflist $ids
3095        }
3096        return
3097    }
3098    set file [lindex $line 5]
3099    lappend treediff $file
3100}
3101
3102proc getblobdiffs {ids} {
3103    global diffopts blobdifffd diffids env curdifftag curtagstart
3104    global difffilestart nextupdate diffinhdr treediffs
3105
3106    set env(GIT_DIFF_OPTS) $diffopts
3107    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3108    if {[catch {set bdf [open $cmd r]} err]} {
3109        puts "error getting diffs: $err"
3110        return
3111    }
3112    set diffinhdr 0
3113    fconfigure $bdf -blocking 0
3114    set blobdifffd($ids) $bdf
3115    set curdifftag Comments
3116    set curtagstart 0.0
3117    catch {unset difffilestart}
3118    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3119    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3120}
3121
3122proc getblobdiffline {bdf ids} {
3123    global diffids blobdifffd ctext curdifftag curtagstart
3124    global diffnexthead diffnextnote difffilestart
3125    global nextupdate diffinhdr treediffs
3126
3127    set n [gets $bdf line]
3128    if {$n < 0} {
3129        if {[eof $bdf]} {
3130            close $bdf
3131            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3132                $ctext tag add $curdifftag $curtagstart end
3133            }
3134        }
3135        return
3136    }
3137    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3138        return
3139    }
3140    $ctext conf -state normal
3141    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3142        # start of a new file
3143        $ctext insert end "\n"
3144        $ctext tag add $curdifftag $curtagstart end
3145        set curtagstart [$ctext index "end - 1c"]
3146        set header $newname
3147        set here [$ctext index "end - 1c"]
3148        set i [lsearch -exact $treediffs($diffids) $fname]
3149        if {$i >= 0} {
3150            set difffilestart($i) $here
3151            incr i
3152            $ctext mark set fmark.$i $here
3153            $ctext mark gravity fmark.$i left
3154        }
3155        if {$newname != $fname} {
3156            set i [lsearch -exact $treediffs($diffids) $newname]
3157            if {$i >= 0} {
3158                set difffilestart($i) $here
3159                incr i
3160                $ctext mark set fmark.$i $here
3161                $ctext mark gravity fmark.$i left
3162            }
3163        }
3164        set curdifftag "f:$fname"
3165        $ctext tag delete $curdifftag
3166        set l [expr {(78 - [string length $header]) / 2}]
3167        set pad [string range "----------------------------------------" 1 $l]
3168        $ctext insert end "$pad $header $pad\n" filesep
3169        set diffinhdr 1
3170    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3171        # do nothing
3172    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3173        set diffinhdr 0
3174    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3175                   $line match f1l f1c f2l f2c rest]} {
3176        $ctext insert end "$line\n" hunksep
3177        set diffinhdr 0
3178    } else {
3179        set x [string range $line 0 0]
3180        if {$x == "-" || $x == "+"} {
3181            set tag [expr {$x == "+"}]
3182            $ctext insert end "$line\n" d$tag
3183        } elseif {$x == " "} {
3184            $ctext insert end "$line\n"
3185        } elseif {$diffinhdr || $x == "\\"} {
3186            # e.g. "\ No newline at end of file"
3187            $ctext insert end "$line\n" filesep
3188        } else {
3189            # Something else we don't recognize
3190            if {$curdifftag != "Comments"} {
3191                $ctext insert end "\n"
3192                $ctext tag add $curdifftag $curtagstart end
3193                set curtagstart [$ctext index "end - 1c"]
3194                set curdifftag Comments
3195            }
3196            $ctext insert end "$line\n" filesep
3197        }
3198    }
3199    $ctext conf -state disabled
3200    if {[clock clicks -milliseconds] >= $nextupdate} {
3201        incr nextupdate 100
3202        fileevent $bdf readable {}
3203        update
3204        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3205    }
3206}
3207
3208proc nextfile {} {
3209    global difffilestart ctext
3210    set here [$ctext index @0,0]
3211    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3212        if {[$ctext compare $difffilestart($i) > $here]} {
3213            if {![info exists pos]
3214                || [$ctext compare $difffilestart($i) < $pos]} {
3215                set pos $difffilestart($i)
3216            }
3217        }
3218    }
3219    if {[info exists pos]} {
3220        $ctext yview $pos
3221    }
3222}
3223
3224proc listboxsel {} {
3225    global ctext cflist currentid
3226    if {![info exists currentid]} return
3227    set sel [lsort [$cflist curselection]]
3228    if {$sel eq {}} return
3229    set first [lindex $sel 0]
3230    catch {$ctext yview fmark.$first}
3231}
3232
3233proc setcoords {} {
3234    global linespc charspc canvx0 canvy0 mainfont
3235    global xspc1 xspc2 lthickness
3236
3237    set linespc [font metrics $mainfont -linespace]
3238    set charspc [font measure $mainfont "m"]
3239    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3240    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3241    set lthickness [expr {int($linespc / 9) + 1}]
3242    set xspc1(0) $linespc
3243    set xspc2 $linespc
3244}
3245
3246proc redisplay {} {
3247    global canv
3248    global selectedline
3249
3250    set ymax [lindex [$canv cget -scrollregion] 3]
3251    if {$ymax eq {} || $ymax == 0} return
3252    set span [$canv yview]
3253    clear_display
3254    setcanvscroll
3255    allcanvs yview moveto [lindex $span 0]
3256    drawvisible
3257    if {[info exists selectedline]} {
3258        selectline $selectedline 0
3259    }
3260}
3261
3262proc incrfont {inc} {
3263    global mainfont namefont textfont ctext canv phase
3264    global stopped entries
3265    unmarkmatches
3266    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3267    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3268    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3269    setcoords
3270    $ctext conf -font $textfont
3271    $ctext tag conf filesep -font [concat $textfont bold]
3272    foreach e $entries {
3273        $e conf -font $mainfont
3274    }
3275    if {$phase eq "getcommits"} {
3276        $canv itemconf textitems -font $mainfont
3277    }
3278    redisplay
3279}
3280
3281proc clearsha1 {} {
3282    global sha1entry sha1string
3283    if {[string length $sha1string] == 40} {
3284        $sha1entry delete 0 end
3285    }
3286}
3287
3288proc sha1change {n1 n2 op} {
3289    global sha1string currentid sha1but
3290    if {$sha1string == {}
3291        || ([info exists currentid] && $sha1string == $currentid)} {
3292        set state disabled
3293    } else {
3294        set state normal
3295    }
3296    if {[$sha1but cget -state] == $state} return
3297    if {$state == "normal"} {
3298        $sha1but conf -state normal -relief raised -text "Goto: "
3299    } else {
3300        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3301    }
3302}
3303
3304proc gotocommit {} {
3305    global sha1string currentid commitrow tagids headids
3306    global displayorder numcommits
3307
3308    if {$sha1string == {}
3309        || ([info exists currentid] && $sha1string == $currentid)} return
3310    if {[info exists tagids($sha1string)]} {
3311        set id $tagids($sha1string)
3312    } elseif {[info exists headids($sha1string)]} {
3313        set id $headids($sha1string)
3314    } else {
3315        set id [string tolower $sha1string]
3316        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3317            set matches {}
3318            foreach i $displayorder {
3319                if {[string match $id* $i]} {
3320                    lappend matches $i
3321                }
3322            }
3323            if {$matches ne {}} {
3324                if {[llength $matches] > 1} {
3325                    error_popup "Short SHA1 id $id is ambiguous"
3326                    return
3327                }
3328                set id [lindex $matches 0]
3329            }
3330        }
3331    }
3332    if {[info exists commitrow($id)]} {
3333        selectline $commitrow($id) 1
3334        return
3335    }
3336    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3337        set type "SHA1 id"
3338    } else {
3339        set type "Tag/Head"
3340    }
3341    error_popup "$type $sha1string is not known"
3342}
3343
3344proc lineenter {x y id} {
3345    global hoverx hovery hoverid hovertimer
3346    global commitinfo canv
3347
3348    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3349    set hoverx $x
3350    set hovery $y
3351    set hoverid $id
3352    if {[info exists hovertimer]} {
3353        after cancel $hovertimer
3354    }
3355    set hovertimer [after 500 linehover]
3356    $canv delete hover
3357}
3358
3359proc linemotion {x y id} {
3360    global hoverx hovery hoverid hovertimer
3361
3362    if {[info exists hoverid] && $id == $hoverid} {
3363        set hoverx $x
3364        set hovery $y
3365        if {[info exists hovertimer]} {
3366            after cancel $hovertimer
3367        }
3368        set hovertimer [after 500 linehover]
3369    }
3370}
3371
3372proc lineleave {id} {
3373    global hoverid hovertimer canv
3374
3375    if {[info exists hoverid] && $id == $hoverid} {
3376        $canv delete hover
3377        if {[info exists hovertimer]} {
3378            after cancel $hovertimer
3379            unset hovertimer
3380        }
3381        unset hoverid
3382    }
3383}
3384
3385proc linehover {} {
3386    global hoverx hovery hoverid hovertimer
3387    global canv linespc lthickness
3388    global commitinfo mainfont
3389
3390    set text [lindex $commitinfo($hoverid) 0]
3391    set ymax [lindex [$canv cget -scrollregion] 3]
3392    if {$ymax == {}} return
3393    set yfrac [lindex [$canv yview] 0]
3394    set x [expr {$hoverx + 2 * $linespc}]
3395    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3396    set x0 [expr {$x - 2 * $lthickness}]
3397    set y0 [expr {$y - 2 * $lthickness}]
3398    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3399    set y1 [expr {$y + $linespc + 2 * $lthickness}]
3400    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3401               -fill \#ffff80 -outline black -width 1 -tags hover]
3402    $canv raise $t
3403    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3404    $canv raise $t
3405}
3406
3407proc clickisonarrow {id y} {
3408    global lthickness
3409
3410    set ranges [rowranges $id]
3411    set thresh [expr {2 * $lthickness + 6}]
3412    set n [expr {[llength $ranges] - 1}]
3413    for {set i 1} {$i < $n} {incr i} {
3414        set row [lindex $ranges $i]
3415        if {abs([yc $row] - $y) < $thresh} {
3416            return $i
3417        }
3418    }
3419    return {}
3420}
3421
3422proc arrowjump {id n y} {
3423    global canv
3424
3425    # 1 <-> 2, 3 <-> 4, etc...
3426    set n [expr {(($n - 1) ^ 1) + 1}]
3427    set row [lindex [rowranges $id] $n]
3428    set yt [yc $row]
3429    set ymax [lindex [$canv cget -scrollregion] 3]
3430    if {$ymax eq {} || $ymax <= 0} return
3431    set view [$canv yview]
3432    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3433    set yfrac [expr {$yt / $ymax - $yspan / 2}]
3434    if {$yfrac < 0} {
3435        set yfrac 0
3436    }
3437    allcanvs yview moveto $yfrac
3438}
3439
3440proc lineclick {x y id isnew} {
3441    global ctext commitinfo childlist commitrow cflist canv thickerline
3442
3443    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3444    unmarkmatches
3445    unselectline
3446    normalline
3447    $canv delete hover
3448    # draw this line thicker than normal
3449    set thickerline $id
3450    drawlines $id
3451    if {$isnew} {
3452        set ymax [lindex [$canv cget -scrollregion] 3]
3453        if {$ymax eq {}} return
3454        set yfrac [lindex [$canv yview] 0]
3455        set y [expr {$y + $yfrac * $ymax}]
3456    }
3457    set dirn [clickisonarrow $id $y]
3458    if {$dirn ne {}} {
3459        arrowjump $id $dirn $y
3460        return
3461    }
3462
3463    if {$isnew} {
3464        addtohistory [list lineclick $x $y $id 0]
3465    }
3466    # fill the details pane with info about this line
3467    $ctext conf -state normal
3468    $ctext delete 0.0 end
3469    $ctext tag conf link -foreground blue -underline 1
3470    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3471    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3472    $ctext insert end "Parent:\t"
3473    $ctext insert end $id [list link link0]
3474    $ctext tag bind link0 <1> [list selbyid $id]
3475    set info $commitinfo($id)
3476    $ctext insert end "\n\t[lindex $info 0]\n"
3477    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3478    set date [formatdate [lindex $info 2]]
3479    $ctext insert end "\tDate:\t$date\n"
3480    set kids [lindex $childlist $commitrow($id)]
3481    if {$kids ne {}} {
3482        $ctext insert end "\nChildren:"
3483        set i 0
3484        foreach child $kids {
3485            incr i
3486            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3487            set info $commitinfo($child)
3488            $ctext insert end "\n\t"
3489            $ctext insert end $child [list link link$i]
3490            $ctext tag bind link$i <1> [list selbyid $child]
3491            $ctext insert end "\n\t[lindex $info 0]"
3492            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3493            set date [formatdate [lindex $info 2]]
3494            $ctext insert end "\n\tDate:\t$date\n"
3495        }
3496    }
3497    $ctext conf -state disabled
3498
3499    $cflist delete 0 end
3500}
3501
3502proc normalline {} {
3503    global thickerline
3504    if {[info exists thickerline]} {
3505        set id $thickerline
3506        unset thickerline
3507        drawlines $id
3508    }
3509}
3510
3511proc selbyid {id} {
3512    global commitrow
3513    if {[info exists commitrow($id)]} {
3514        selectline $commitrow($id) 1
3515    }
3516}
3517
3518proc mstime {} {
3519    global startmstime
3520    if {![info exists startmstime]} {
3521        set startmstime [clock clicks -milliseconds]
3522    }
3523    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3524}
3525
3526proc rowmenu {x y id} {
3527    global rowctxmenu commitrow selectedline rowmenuid
3528
3529    if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3530        set state disabled
3531    } else {
3532        set state normal
3533    }
3534    $rowctxmenu entryconfigure 0 -state $state
3535    $rowctxmenu entryconfigure 1 -state $state
3536    $rowctxmenu entryconfigure 2 -state $state
3537    set rowmenuid $id
3538    tk_popup $rowctxmenu $x $y
3539}
3540
3541proc diffvssel {dirn} {
3542    global rowmenuid selectedline displayorder
3543
3544    if {![info exists selectedline]} return
3545    if {$dirn} {
3546        set oldid [lindex $displayorder $selectedline]
3547        set newid $rowmenuid
3548    } else {
3549        set oldid $rowmenuid
3550        set newid [lindex $displayorder $selectedline]
3551    }
3552    addtohistory [list doseldiff $oldid $newid]
3553    doseldiff $oldid $newid
3554}
3555
3556proc doseldiff {oldid newid} {
3557    global ctext cflist
3558    global commitinfo
3559
3560    $ctext conf -state normal
3561    $ctext delete 0.0 end
3562    $ctext mark set fmark.0 0.0
3563    $ctext mark gravity fmark.0 left
3564    $cflist delete 0 end
3565    $cflist insert end "Top"
3566    $ctext insert end "From "
3567    $ctext tag conf link -foreground blue -underline 1
3568    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3569    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3570    $ctext tag bind link0 <1> [list selbyid $oldid]
3571    $ctext insert end $oldid [list link link0]
3572    $ctext insert end "\n     "
3573    $ctext insert end [lindex $commitinfo($oldid) 0]
3574    $ctext insert end "\n\nTo   "
3575    $ctext tag bind link1 <1> [list selbyid $newid]
3576    $ctext insert end $newid [list link link1]
3577    $ctext insert end "\n     "
3578    $ctext insert end [lindex $commitinfo($newid) 0]
3579    $ctext insert end "\n"
3580    $ctext conf -state disabled
3581    $ctext tag delete Comments
3582    $ctext tag remove found 1.0 end
3583    startdiff [list $oldid $newid]
3584}
3585
3586proc mkpatch {} {
3587    global rowmenuid currentid commitinfo patchtop patchnum
3588
3589    if {![info exists currentid]} return
3590    set oldid $currentid
3591    set oldhead [lindex $commitinfo($oldid) 0]
3592    set newid $rowmenuid
3593    set newhead [lindex $commitinfo($newid) 0]
3594    set top .patch
3595    set patchtop $top
3596    catch {destroy $top}
3597    toplevel $top
3598    label $top.title -text "Generate patch"
3599    grid $top.title - -pady 10
3600    label $top.from -text "From:"
3601    entry $top.fromsha1 -width 40 -relief flat
3602    $top.fromsha1 insert 0 $oldid
3603    $top.fromsha1 conf -state readonly
3604    grid $top.from $top.fromsha1 -sticky w
3605    entry $top.fromhead -width 60 -relief flat
3606    $top.fromhead insert 0 $oldhead
3607    $top.fromhead conf -state readonly
3608    grid x $top.fromhead -sticky w
3609    label $top.to -text "To:"
3610    entry $top.tosha1 -width 40 -relief flat
3611    $top.tosha1 insert 0 $newid
3612    $top.tosha1 conf -state readonly
3613    grid $top.to $top.tosha1 -sticky w
3614    entry $top.tohead -width 60 -relief flat
3615    $top.tohead insert 0 $newhead
3616    $top.tohead conf -state readonly
3617    grid x $top.tohead -sticky w
3618    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3619    grid $top.rev x -pady 10
3620    label $top.flab -text "Output file:"
3621    entry $top.fname -width 60
3622    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3623    incr patchnum
3624    grid $top.flab $top.fname -sticky w
3625    frame $top.buts
3626    button $top.buts.gen -text "Generate" -command mkpatchgo
3627    button $top.buts.can -text "Cancel" -command mkpatchcan
3628    grid $top.buts.gen $top.buts.can
3629    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3630    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3631    grid $top.buts - -pady 10 -sticky ew
3632    focus $top.fname
3633}
3634
3635proc mkpatchrev {} {
3636    global patchtop
3637
3638    set oldid [$patchtop.fromsha1 get]
3639    set oldhead [$patchtop.fromhead get]
3640    set newid [$patchtop.tosha1 get]
3641    set newhead [$patchtop.tohead get]
3642    foreach e [list fromsha1 fromhead tosha1 tohead] \
3643            v [list $newid $newhead $oldid $oldhead] {
3644        $patchtop.$e conf -state normal
3645        $patchtop.$e delete 0 end
3646        $patchtop.$e insert 0 $v
3647        $patchtop.$e conf -state readonly
3648    }
3649}
3650
3651proc mkpatchgo {} {
3652    global patchtop
3653
3654    set oldid [$patchtop.fromsha1 get]
3655    set newid [$patchtop.tosha1 get]
3656    set fname [$patchtop.fname get]
3657    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3658        error_popup "Error creating patch: $err"
3659    }
3660    catch {destroy $patchtop}
3661    unset patchtop
3662}
3663
3664proc mkpatchcan {} {
3665    global patchtop
3666
3667    catch {destroy $patchtop}
3668    unset patchtop
3669}
3670
3671proc mktag {} {
3672    global rowmenuid mktagtop commitinfo
3673
3674    set top .maketag
3675    set mktagtop $top
3676    catch {destroy $top}
3677    toplevel $top
3678    label $top.title -text "Create tag"
3679    grid $top.title - -pady 10
3680    label $top.id -text "ID:"
3681    entry $top.sha1 -width 40 -relief flat
3682    $top.sha1 insert 0 $rowmenuid
3683    $top.sha1 conf -state readonly
3684    grid $top.id $top.sha1 -sticky w
3685    entry $top.head -width 60 -relief flat
3686    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3687    $top.head conf -state readonly
3688    grid x $top.head -sticky w
3689    label $top.tlab -text "Tag name:"
3690    entry $top.tag -width 60
3691    grid $top.tlab $top.tag -sticky w
3692    frame $top.buts
3693    button $top.buts.gen -text "Create" -command mktaggo
3694    button $top.buts.can -text "Cancel" -command mktagcan
3695    grid $top.buts.gen $top.buts.can
3696    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3697    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3698    grid $top.buts - -pady 10 -sticky ew
3699    focus $top.tag
3700}
3701
3702proc domktag {} {
3703    global mktagtop env tagids idtags
3704
3705    set id [$mktagtop.sha1 get]
3706    set tag [$mktagtop.tag get]
3707    if {$tag == {}} {
3708        error_popup "No tag name specified"
3709        return
3710    }
3711    if {[info exists tagids($tag)]} {
3712        error_popup "Tag \"$tag\" already exists"
3713        return
3714    }
3715    if {[catch {
3716        set dir [gitdir]
3717        set fname [file join $dir "refs/tags" $tag]
3718        set f [open $fname w]
3719        puts $f $id
3720        close $f
3721    } err]} {
3722        error_popup "Error creating tag: $err"
3723        return
3724    }
3725
3726    set tagids($tag) $id
3727    lappend idtags($id) $tag
3728    redrawtags $id
3729}
3730
3731proc redrawtags {id} {
3732    global canv linehtag commitrow idpos selectedline
3733
3734    if {![info exists commitrow($id)]} return
3735    drawcmitrow $commitrow($id)
3736    $canv delete tag.$id
3737    set xt [eval drawtags $id $idpos($id)]
3738    $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3739    if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3740        selectline $selectedline 0
3741    }
3742}
3743
3744proc mktagcan {} {
3745    global mktagtop
3746
3747    catch {destroy $mktagtop}
3748    unset mktagtop
3749}
3750
3751proc mktaggo {} {
3752    domktag
3753    mktagcan
3754}
3755
3756proc writecommit {} {
3757    global rowmenuid wrcomtop commitinfo wrcomcmd
3758
3759    set top .writecommit
3760    set wrcomtop $top
3761    catch {destroy $top}
3762    toplevel $top
3763    label $top.title -text "Write commit to file"
3764    grid $top.title - -pady 10
3765    label $top.id -text "ID:"
3766    entry $top.sha1 -width 40 -relief flat
3767    $top.sha1 insert 0 $rowmenuid
3768    $top.sha1 conf -state readonly
3769    grid $top.id $top.sha1 -sticky w
3770    entry $top.head -width 60 -relief flat
3771    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3772    $top.head conf -state readonly
3773    grid x $top.head -sticky w
3774    label $top.clab -text "Command:"
3775    entry $top.cmd -width 60 -textvariable wrcomcmd
3776    grid $top.clab $top.cmd -sticky w -pady 10
3777    label $top.flab -text "Output file:"
3778    entry $top.fname -width 60
3779    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3780    grid $top.flab $top.fname -sticky w
3781    frame $top.buts
3782    button $top.buts.gen -text "Write" -command wrcomgo
3783    button $top.buts.can -text "Cancel" -command wrcomcan
3784    grid $top.buts.gen $top.buts.can
3785    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787    grid $top.buts - -pady 10 -sticky ew
3788    focus $top.fname
3789}
3790
3791proc wrcomgo {} {
3792    global wrcomtop
3793
3794    set id [$wrcomtop.sha1 get]
3795    set cmd "echo $id | [$wrcomtop.cmd get]"
3796    set fname [$wrcomtop.fname get]
3797    if {[catch {exec sh -c $cmd >$fname &} err]} {
3798        error_popup "Error writing commit: $err"
3799    }
3800    catch {destroy $wrcomtop}
3801    unset wrcomtop
3802}
3803
3804proc wrcomcan {} {
3805    global wrcomtop
3806
3807    catch {destroy $wrcomtop}
3808    unset wrcomtop
3809}
3810
3811proc listrefs {id} {
3812    global idtags idheads idotherrefs
3813
3814    set x {}
3815    if {[info exists idtags($id)]} {
3816        set x $idtags($id)
3817    }
3818    set y {}
3819    if {[info exists idheads($id)]} {
3820        set y $idheads($id)
3821    }
3822    set z {}
3823    if {[info exists idotherrefs($id)]} {
3824        set z $idotherrefs($id)
3825    }
3826    return [list $x $y $z]
3827}
3828
3829proc rereadrefs {} {
3830    global idtags idheads idotherrefs
3831
3832    set refids [concat [array names idtags] \
3833                    [array names idheads] [array names idotherrefs]]
3834    foreach id $refids {
3835        if {![info exists ref($id)]} {
3836            set ref($id) [listrefs $id]
3837        }
3838    }
3839    readrefs
3840    set refids [lsort -unique [concat $refids [array names idtags] \
3841                        [array names idheads] [array names idotherrefs]]]
3842    foreach id $refids {
3843        set v [listrefs $id]
3844        if {![info exists ref($id)] || $ref($id) != $v} {
3845            redrawtags $id
3846        }
3847    }
3848}
3849
3850proc showtag {tag isnew} {
3851    global ctext cflist tagcontents tagids linknum
3852
3853    if {$isnew} {
3854        addtohistory [list showtag $tag 0]
3855    }
3856    $ctext conf -state normal
3857    $ctext delete 0.0 end
3858    set linknum 0
3859    if {[info exists tagcontents($tag)]} {
3860        set text $tagcontents($tag)
3861    } else {
3862        set text "Tag: $tag\nId:  $tagids($tag)"
3863    }
3864    appendwithlinks $text
3865    $ctext conf -state disabled
3866    $cflist delete 0 end
3867}
3868
3869proc doquit {} {
3870    global stopped
3871    set stopped 100
3872    destroy .
3873}
3874
3875proc doprefs {} {
3876    global maxwidth maxgraphpct diffopts findmergefiles
3877    global oldprefs prefstop
3878
3879    set top .gitkprefs
3880    set prefstop $top
3881    if {[winfo exists $top]} {
3882        raise $top
3883        return
3884    }
3885    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3886        set oldprefs($v) [set $v]
3887    }
3888    toplevel $top
3889    wm title $top "Gitk preferences"
3890    label $top.ldisp -text "Commit list display options"
3891    grid $top.ldisp - -sticky w -pady 10
3892    label $top.spacer -text " "
3893    label $top.maxwidthl -text "Maximum graph width (lines)" \
3894        -font optionfont
3895    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3896    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3897    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3898        -font optionfont
3899    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3900    grid x $top.maxpctl $top.maxpct -sticky w
3901    checkbutton $top.findm -variable findmergefiles
3902    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3903        -font optionfont
3904    grid $top.findm $top.findml - -sticky w
3905    label $top.ddisp -text "Diff display options"
3906    grid $top.ddisp - -sticky w -pady 10
3907    label $top.diffoptl -text "Options for diff program" \
3908        -font optionfont
3909    entry $top.diffopt -width 20 -textvariable diffopts
3910    grid x $top.diffoptl $top.diffopt -sticky w
3911    frame $top.buts
3912    button $top.buts.ok -text "OK" -command prefsok
3913    button $top.buts.can -text "Cancel" -command prefscan
3914    grid $top.buts.ok $top.buts.can
3915    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3916    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3917    grid $top.buts - - -pady 10 -sticky ew
3918}
3919
3920proc prefscan {} {
3921    global maxwidth maxgraphpct diffopts findmergefiles
3922    global oldprefs prefstop
3923
3924    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3925        set $v $oldprefs($v)
3926    }
3927    catch {destroy $prefstop}
3928    unset prefstop
3929}
3930
3931proc prefsok {} {
3932    global maxwidth maxgraphpct
3933    global oldprefs prefstop
3934
3935    catch {destroy $prefstop}
3936    unset prefstop
3937    if {$maxwidth != $oldprefs(maxwidth)
3938        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3939        redisplay
3940    }
3941}
3942
3943proc formatdate {d} {
3944    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3945}
3946
3947# This list of encoding names and aliases is distilled from
3948# http://www.iana.org/assignments/character-sets.
3949# Not all of them are supported by Tcl.
3950set encoding_aliases {
3951    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3952      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3953    { ISO-10646-UTF-1 csISO10646UTF1 }
3954    { ISO_646.basic:1983 ref csISO646basic1983 }
3955    { INVARIANT csINVARIANT }
3956    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3957    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3958    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3959    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3960    { NATS-DANO iso-ir-9-1 csNATSDANO }
3961    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3962    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3963    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3964    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3965    { ISO-2022-KR csISO2022KR }
3966    { EUC-KR csEUCKR }
3967    { ISO-2022-JP csISO2022JP }
3968    { ISO-2022-JP-2 csISO2022JP2 }
3969    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3970      csISO13JISC6220jp }
3971    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3972    { IT iso-ir-15 ISO646-IT csISO15Italian }
3973    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3974    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3975    { greek7-old iso-ir-18 csISO18Greek7Old }
3976    { latin-greek iso-ir-19 csISO19LatinGreek }
3977    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3978    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3979    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3980    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3981    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3982    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3983    { INIS iso-ir-49 csISO49INIS }
3984    { INIS-8 iso-ir-50 csISO50INIS8 }
3985    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3986    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3987    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3988    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3989    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3990    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3991      csISO60Norwegian1 }
3992    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3993    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3994    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3995    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3996    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3997    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3998    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3999    { greek7 iso-ir-88 csISO88Greek7 }
4000    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4001    { iso-ir-90 csISO90 }
4002    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4003    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4004      csISO92JISC62991984b }
4005    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4006    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4007    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4008      csISO95JIS62291984handadd }
4009    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4010    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4011    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4012    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4013      CP819 csISOLatin1 }
4014    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4015    { T.61-7bit iso-ir-102 csISO102T617bit }
4016    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4017    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4018    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4019    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4020    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4021    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4022    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4023    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4024      arabic csISOLatinArabic }
4025    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4026    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4027    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4028      greek greek8 csISOLatinGreek }
4029    { T.101-G2 iso-ir-128 csISO128T101G2 }
4030    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4031      csISOLatinHebrew }
4032    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4033    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4034    { CSN_369103 iso-ir-139 csISO139CSN369103 }
4035    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4036    { ISO_6937-2-add iso-ir-142 csISOTextComm }
4037    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4038    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4039      csISOLatinCyrillic }
4040    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4041    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4042    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4043    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4044    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4045    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4046    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4047    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4048    { ISO_10367-box iso-ir-155 csISO10367Box }
4049    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4050    { latin-lap lap iso-ir-158 csISO158Lap }
4051    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4052    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4053    { us-dk csUSDK }
4054    { dk-us csDKUS }
4055    { JIS_X0201 X0201 csHalfWidthKatakana }
4056    { KSC5636 ISO646-KR csKSC5636 }
4057    { ISO-10646-UCS-2 csUnicode }
4058    { ISO-10646-UCS-4 csUCS4 }
4059    { DEC-MCS dec csDECMCS }
4060    { hp-roman8 roman8 r8 csHPRoman8 }
4061    { macintosh mac csMacintosh }
4062    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4063      csIBM037 }
4064    { IBM038 EBCDIC-INT cp038 csIBM038 }
4065    { IBM273 CP273 csIBM273 }
4066    { IBM274 EBCDIC-BE CP274 csIBM274 }
4067    { IBM275 EBCDIC-BR cp275 csIBM275 }
4068    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4069    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4070    { IBM280 CP280 ebcdic-cp-it csIBM280 }
4071    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4072    { IBM284 CP284 ebcdic-cp-es csIBM284 }
4073    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4074    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4075    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4076    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4077    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4078    { IBM424 cp424 ebcdic-cp-he csIBM424 }
4079    { IBM437 cp437 437 csPC8CodePage437 }
4080    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4081    { IBM775 cp775 csPC775Baltic }
4082    { IBM850 cp850 850 csPC850Multilingual }
4083    { IBM851 cp851 851 csIBM851 }
4084    { IBM852 cp852 852 csPCp852 }
4085    { IBM855 cp855 855 csIBM855 }
4086    { IBM857 cp857 857 csIBM857 }
4087    { IBM860 cp860 860 csIBM860 }
4088    { IBM861 cp861 861 cp-is csIBM861 }
4089    { IBM862 cp862 862 csPC862LatinHebrew }
4090    { IBM863 cp863 863 csIBM863 }
4091    { IBM864 cp864 csIBM864 }
4092    { IBM865 cp865 865 csIBM865 }
4093    { IBM866 cp866 866 csIBM866 }
4094    { IBM868 CP868 cp-ar csIBM868 }
4095    { IBM869 cp869 869 cp-gr csIBM869 }
4096    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4097    { IBM871 CP871 ebcdic-cp-is csIBM871 }
4098    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4099    { IBM891 cp891 csIBM891 }
4100    { IBM903 cp903 csIBM903 }
4101    { IBM904 cp904 904 csIBBM904 }
4102    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4103    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4104    { IBM1026 CP1026 csIBM1026 }
4105    { EBCDIC-AT-DE csIBMEBCDICATDE }
4106    { EBCDIC-AT-DE-A csEBCDICATDEA }
4107    { EBCDIC-CA-FR csEBCDICCAFR }
4108    { EBCDIC-DK-NO csEBCDICDKNO }
4109    { EBCDIC-DK-NO-A csEBCDICDKNOA }
4110    { EBCDIC-FI-SE csEBCDICFISE }
4111    { EBCDIC-FI-SE-A csEBCDICFISEA }
4112    { EBCDIC-FR csEBCDICFR }
4113    { EBCDIC-IT csEBCDICIT }
4114    { EBCDIC-PT csEBCDICPT }
4115    { EBCDIC-ES csEBCDICES }
4116    { EBCDIC-ES-A csEBCDICESA }
4117    { EBCDIC-ES-S csEBCDICESS }
4118    { EBCDIC-UK csEBCDICUK }
4119    { EBCDIC-US csEBCDICUS }
4120    { UNKNOWN-8BIT csUnknown8BiT }
4121    { MNEMONIC csMnemonic }
4122    { MNEM csMnem }
4123    { VISCII csVISCII }
4124    { VIQR csVIQR }
4125    { KOI8-R csKOI8R }
4126    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4127    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4128    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4129    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4130    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4131    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4132    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4133    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4134    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4135    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4136    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4137    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4138    { IBM1047 IBM-1047 }
4139    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4140    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4141    { UNICODE-1-1 csUnicode11 }
4142    { CESU-8 csCESU-8 }
4143    { BOCU-1 csBOCU-1 }
4144    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4145    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4146      l8 }
4147    { ISO-8859-15 ISO_8859-15 Latin-9 }
4148    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4149    { GBK CP936 MS936 windows-936 }
4150    { JIS_Encoding csJISEncoding }
4151    { Shift_JIS MS_Kanji csShiftJIS }
4152    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4153      EUC-JP }
4154    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4155    { ISO-10646-UCS-Basic csUnicodeASCII }
4156    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4157    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4158    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4159    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4160    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4161    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4162    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4163    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4164    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4165    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4166    { Adobe-Standard-Encoding csAdobeStandardEncoding }
4167    { Ventura-US csVenturaUS }
4168    { Ventura-International csVenturaInternational }
4169    { PC8-Danish-Norwegian csPC8DanishNorwegian }
4170    { PC8-Turkish csPC8Turkish }
4171    { IBM-Symbols csIBMSymbols }
4172    { IBM-Thai csIBMThai }
4173    { HP-Legal csHPLegal }
4174    { HP-Pi-font csHPPiFont }
4175    { HP-Math8 csHPMath8 }
4176    { Adobe-Symbol-Encoding csHPPSMath }
4177    { HP-DeskTop csHPDesktop }
4178    { Ventura-Math csVenturaMath }
4179    { Microsoft-Publishing csMicrosoftPublishing }
4180    { Windows-31J csWindows31J }
4181    { GB2312 csGB2312 }
4182    { Big5 csBig5 }
4183}
4184
4185proc tcl_encoding {enc} {
4186    global encoding_aliases
4187    set names [encoding names]
4188    set lcnames [string tolower $names]
4189    set enc [string tolower $enc]
4190    set i [lsearch -exact $lcnames $enc]
4191    if {$i < 0} {
4192        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4193        if {[regsub {^iso[-_]} $enc iso encx]} {
4194            set i [lsearch -exact $lcnames $encx]
4195        }
4196    }
4197    if {$i < 0} {
4198        foreach l $encoding_aliases {
4199            set ll [string tolower $l]
4200            if {[lsearch -exact $ll $enc] < 0} continue
4201            # look through the aliases for one that tcl knows about
4202            foreach e $ll {
4203                set i [lsearch -exact $lcnames $e]
4204                if {$i < 0} {
4205                    if {[regsub {^iso[-_]} $e iso ex]} {
4206                        set i [lsearch -exact $lcnames $ex]
4207                    }
4208                }
4209                if {$i >= 0} break
4210            }
4211            break
4212        }
4213    }
4214    if {$i >= 0} {
4215        return [lindex $names $i]
4216    }
4217    return {}
4218}
4219
4220# defaults...
4221set datemode 0
4222set diffopts "-U 5 -p"
4223set wrcomcmd "git-diff-tree --stdin -p --pretty"
4224
4225set gitencoding {}
4226catch {
4227    set gitencoding [exec git-repo-config --get i18n.commitencoding]
4228}
4229if {$gitencoding == ""} {
4230    set gitencoding "utf-8"
4231}
4232set tclencoding [tcl_encoding $gitencoding]
4233if {$tclencoding == {}} {
4234    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4235}
4236
4237set mainfont {Helvetica 9}
4238set textfont {Courier 9}
4239set uifont {Helvetica 9 bold}
4240set findmergefiles 0
4241set maxgraphpct 50
4242set maxwidth 16
4243set revlistorder 0
4244set fastdate 0
4245set uparrowlen 7
4246set downarrowlen 7
4247set mingaplen 30
4248
4249set colors {green red blue magenta darkgrey brown orange}
4250
4251catch {source ~/.gitk}
4252
4253set namefont $mainfont
4254
4255font create optionfont -family sans-serif -size -12
4256
4257set revtreeargs {}
4258foreach arg $argv {
4259    switch -regexp -- $arg {
4260        "^$" { }
4261        "^-d" { set datemode 1 }
4262        default {
4263            lappend revtreeargs $arg
4264        }
4265    }
4266}
4267
4268# check that we can find a .git directory somewhere...
4269set gitdir [gitdir]
4270if {![file isdirectory $gitdir]} {
4271    error_popup "Cannot find the git directory \"$gitdir\"."
4272    exit 1
4273}
4274
4275set history {}
4276set historyindex 0
4277
4278set optim_delay 16
4279
4280set nextviewnum 1
4281set curview 0
4282set selectedview 0
4283set viewfiles(0) {}
4284set viewperm(0) 0
4285
4286set stopped 0
4287set stuffsaved 0
4288set patchnum 0
4289setcoords
4290makewindow
4291readrefs
4292
4293set cmdline_files {}
4294catch {
4295    set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4296    set cmdline_files [split $fileargs "\n"]
4297    set n [llength $cmdline_files]
4298    set revtreeargs [lrange $revtreeargs 0 end-$n]
4299}
4300if {[lindex $revtreeargs end] eq "--"} {
4301    set revtreeargs [lrange $revtreeargs 0 end-1]
4302}
4303
4304if {$cmdline_files ne {}} {
4305    # create a view for the files/dirs specified on the command line
4306    set curview 1
4307    set selectedview 1
4308    set nextviewnum 2
4309    set viewname(1) "Command line"
4310    set viewfiles(1) $cmdline_files
4311    set viewperm(1) 0
4312    .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4313        -variable selectedview -value 1
4314    .bar.view entryconf 2 -state normal
4315    .bar.view entryconf 3 -state normal
4316}
4317
4318if {[info exists permviews]} {
4319    foreach v $permviews {
4320        set n $nextviewnum
4321        incr nextviewnum
4322        set viewname($n) [lindex $v 0]
4323        set viewfiles($n) [lindex $v 1]
4324        set viewperm($n) 1
4325        .bar.view add radiobutton -label $viewname($n) \
4326            -command [list showview $n] -variable selectedview -value $n
4327    }
4328}
4329getcommits