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