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