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