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