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