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