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