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