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