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