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