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