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