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