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