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