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