gitkon commit gitk: Move "pickaxe" find function to highlight facility (60f7a7d)
   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 {$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 {$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    global selectedline
1719
1720    if {![info exists hlview]} return
1721    unset hlview
1722    set rows [array names vhighlights]
1723    if {$rows ne {}} {
1724        unset vhighlights
1725        unbolden $rows
1726    }
1727}
1728
1729proc vhighlightmore {} {
1730    global hlview vhl_done commitidx vhighlights
1731    global displayorder vdisporder curview mainfont
1732
1733    set font [concat $mainfont bold]
1734    set max $commitidx($hlview)
1735    if {$hlview == $curview} {
1736        set disp $displayorder
1737    } else {
1738        set disp $vdisporder($hlview)
1739    }
1740    set vr [visiblerows]
1741    set r0 [lindex $vr 0]
1742    set r1 [lindex $vr 1]
1743    for {set i $vhl_done} {$i < $max} {incr i} {
1744        set id [lindex $disp $i]
1745        if {[info exists commitrow($curview,$id)]} {
1746            set row $commitrow($curview,$id)
1747            if {$r0 <= $row && $row <= $r1} {
1748                if {![highlighted $row]} {
1749                    bolden $row $font
1750                }
1751                set vhighlights($row) 1
1752            }
1753        }
1754    }
1755    set vhl_done $max
1756}
1757
1758proc askvhighlight {row id} {
1759    global hlview vhighlights commitrow iddrawn mainfont
1760
1761    if {[info exists commitrow($hlview,$id)]} {
1762        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1763            bolden $row [concat $mainfont bold]
1764        }
1765        set vhighlights($row) 1
1766    } else {
1767        set vhighlights($row) 0
1768    }
1769}
1770
1771proc hfiles_change {name ix op} {
1772    global highlight_files filehighlight fhighlights fh_serial
1773    global mainfont highlight_paths
1774
1775    if {[info exists filehighlight]} {
1776        # delete previous highlights
1777        catch {close $filehighlight}
1778        unset filehighlight
1779        set rows [array names fhighlights]
1780        if {$rows ne {}} {
1781            unset fhighlights
1782            unbolden $rows
1783        }
1784        unhighlight_filelist
1785    }
1786    set highlight_paths {}
1787    after cancel do_file_hl $fh_serial
1788    incr fh_serial
1789    if {$highlight_files ne {}} {
1790        after 300 do_file_hl $fh_serial
1791    }
1792}
1793
1794proc makepatterns {l} {
1795    set ret {}
1796    foreach e $l {
1797        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1798        if {[string index $ee end] eq "/"} {
1799            lappend ret "$ee*"
1800        } else {
1801            lappend ret $ee
1802            lappend ret "$ee/*"
1803        }
1804    }
1805    return $ret
1806}
1807
1808proc do_file_hl {serial} {
1809    global highlight_files filehighlight highlight_paths gdttype
1810
1811    if {$gdttype eq "touching paths:"} {
1812        if {[catch {set paths [shellsplit $highlight_files]}]} return
1813        set highlight_paths [makepatterns $paths]
1814        highlight_filelist
1815        set gdtargs [concat -- $paths]
1816    } else {
1817        set gdtargs [list "-S$highlight_files"]
1818    }
1819    set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1820    set filehighlight [open $cmd r+]
1821    fconfigure $filehighlight -blocking 0
1822    fileevent $filehighlight readable readfhighlight
1823    drawvisible
1824    flushhighlights
1825}
1826
1827proc flushhighlights {} {
1828    global filehighlight
1829
1830    if {[info exists filehighlight]} {
1831        puts $filehighlight ""
1832        flush $filehighlight
1833    }
1834}
1835
1836proc askfilehighlight {row id} {
1837    global filehighlight fhighlights
1838
1839    set fhighlights($row) 0
1840    puts $filehighlight $id
1841}
1842
1843proc readfhighlight {} {
1844    global filehighlight fhighlights commitrow curview mainfont iddrawn
1845
1846    set n [gets $filehighlight line]
1847    if {$n < 0} {
1848        if {[eof $filehighlight]} {
1849            # strange...
1850            puts "oops, git-diff-tree died"
1851            catch {close $filehighlight}
1852            unset filehighlight
1853        }
1854        return
1855    }
1856    set line [string trim $line]
1857    if {$line eq {}} return
1858    if {![info exists commitrow($curview,$line)]} return
1859    set row $commitrow($curview,$line)
1860    if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1861        bolden $row [concat $mainfont bold]
1862    }
1863    set fhighlights($row) 1
1864}
1865
1866proc find_change {name ix op} {
1867    global nhighlights mainfont
1868    global findstring findpattern findtype
1869
1870    # delete previous highlights, if any
1871    set rows [array names nhighlights]
1872    if {$rows ne {}} {
1873        foreach row $rows {
1874            if {$nhighlights($row) >= 2} {
1875                bolden_name $row $mainfont
1876            }
1877        }
1878        unset nhighlights
1879        unbolden $rows
1880    }
1881    if {$findtype ne "Regexp"} {
1882        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1883                   $findstring]
1884        set findpattern "*$e*"
1885    }
1886    drawvisible
1887}
1888
1889proc askfindhighlight {row id} {
1890    global nhighlights commitinfo iddrawn mainfont
1891    global findstring findtype findloc findpattern
1892
1893    if {![info exists commitinfo($id)]} {
1894        getcommit $id
1895    }
1896    set info $commitinfo($id)
1897    set isbold 0
1898    set fldtypes {Headline Author Date Committer CDate Comments}
1899    foreach f $info ty $fldtypes {
1900        if {$findloc ne "All fields" && $findloc ne $ty} {
1901            continue
1902        }
1903        if {$findtype eq "Regexp"} {
1904            set doesmatch [regexp $findstring $f]
1905        } elseif {$findtype eq "IgnCase"} {
1906            set doesmatch [string match -nocase $findpattern $f]
1907        } else {
1908            set doesmatch [string match $findpattern $f]
1909        }
1910        if {$doesmatch} {
1911            if {$ty eq "Author"} {
1912                set isbold 2
1913            } else {
1914                set isbold 1
1915            }
1916        }
1917    }
1918    if {[info exists iddrawn($id)]} {
1919        if {$isbold && ![ishighlighted $row]} {
1920            bolden $row [concat $mainfont bold]
1921        }
1922        if {$isbold >= 2} {
1923            bolden_name $row [concat $mainfont bold]
1924        }
1925    }
1926    set nhighlights($row) $isbold
1927}
1928
1929# Graph layout functions
1930
1931proc shortids {ids} {
1932    set res {}
1933    foreach id $ids {
1934        if {[llength $id] > 1} {
1935            lappend res [shortids $id]
1936        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1937            lappend res [string range $id 0 7]
1938        } else {
1939            lappend res $id
1940        }
1941    }
1942    return $res
1943}
1944
1945proc incrange {l x o} {
1946    set n [llength $l]
1947    while {$x < $n} {
1948        set e [lindex $l $x]
1949        if {$e ne {}} {
1950            lset l $x [expr {$e + $o}]
1951        }
1952        incr x
1953    }
1954    return $l
1955}
1956
1957proc ntimes {n o} {
1958    set ret {}
1959    for {} {$n > 0} {incr n -1} {
1960        lappend ret $o
1961    }
1962    return $ret
1963}
1964
1965proc usedinrange {id l1 l2} {
1966    global children commitrow childlist curview
1967
1968    if {[info exists commitrow($curview,$id)]} {
1969        set r $commitrow($curview,$id)
1970        if {$l1 <= $r && $r <= $l2} {
1971            return [expr {$r - $l1 + 1}]
1972        }
1973        set kids [lindex $childlist $r]
1974    } else {
1975        set kids $children($curview,$id)
1976    }
1977    foreach c $kids {
1978        set r $commitrow($curview,$c)
1979        if {$l1 <= $r && $r <= $l2} {
1980            return [expr {$r - $l1 + 1}]
1981        }
1982    }
1983    return 0
1984}
1985
1986proc sanity {row {full 0}} {
1987    global rowidlist rowoffsets
1988
1989    set col -1
1990    set ids [lindex $rowidlist $row]
1991    foreach id $ids {
1992        incr col
1993        if {$id eq {}} continue
1994        if {$col < [llength $ids] - 1 &&
1995            [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1996            puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1997        }
1998        set o [lindex $rowoffsets $row $col]
1999        set y $row
2000        set x $col
2001        while {$o ne {}} {
2002            incr y -1
2003            incr x $o
2004            if {[lindex $rowidlist $y $x] != $id} {
2005                puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2006                puts "  id=[shortids $id] check started at row $row"
2007                for {set i $row} {$i >= $y} {incr i -1} {
2008                    puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2009                }
2010                break
2011            }
2012            if {!$full} break
2013            set o [lindex $rowoffsets $y $x]
2014        }
2015    }
2016}
2017
2018proc makeuparrow {oid x y z} {
2019    global rowidlist rowoffsets uparrowlen idrowranges
2020
2021    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2022        incr y -1
2023        incr x $z
2024        set off0 [lindex $rowoffsets $y]
2025        for {set x0 $x} {1} {incr x0} {
2026            if {$x0 >= [llength $off0]} {
2027                set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2028                break
2029            }
2030            set z [lindex $off0 $x0]
2031            if {$z ne {}} {
2032                incr x0 $z
2033                break
2034            }
2035        }
2036        set z [expr {$x0 - $x}]
2037        lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2038        lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2039    }
2040    set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2041    lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2042    lappend idrowranges($oid) $y
2043}
2044
2045proc initlayout {} {
2046    global rowidlist rowoffsets displayorder commitlisted
2047    global rowlaidout rowoptim
2048    global idinlist rowchk rowrangelist idrowranges
2049    global numcommits canvxmax canv
2050    global nextcolor
2051    global parentlist childlist children
2052    global colormap rowtextx
2053    global linesegends
2054
2055    set numcommits 0
2056    set displayorder {}
2057    set commitlisted {}
2058    set parentlist {}
2059    set childlist {}
2060    set rowrangelist {}
2061    set nextcolor 0
2062    set rowidlist {{}}
2063    set rowoffsets {{}}
2064    catch {unset idinlist}
2065    catch {unset rowchk}
2066    set rowlaidout 0
2067    set rowoptim 0
2068    set canvxmax [$canv cget -width]
2069    catch {unset colormap}
2070    catch {unset rowtextx}
2071    catch {unset idrowranges}
2072    set linesegends {}
2073}
2074
2075proc setcanvscroll {} {
2076    global canv canv2 canv3 numcommits linespc canvxmax canvy0
2077
2078    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2079    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2080    $canv2 conf -scrollregion [list 0 0 0 $ymax]
2081    $canv3 conf -scrollregion [list 0 0 0 $ymax]
2082}
2083
2084proc visiblerows {} {
2085    global canv numcommits linespc
2086
2087    set ymax [lindex [$canv cget -scrollregion] 3]
2088    if {$ymax eq {} || $ymax == 0} return
2089    set f [$canv yview]
2090    set y0 [expr {int([lindex $f 0] * $ymax)}]
2091    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2092    if {$r0 < 0} {
2093        set r0 0
2094    }
2095    set y1 [expr {int([lindex $f 1] * $ymax)}]
2096    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2097    if {$r1 >= $numcommits} {
2098        set r1 [expr {$numcommits - 1}]
2099    }
2100    return [list $r0 $r1]
2101}
2102
2103proc layoutmore {} {
2104    global rowlaidout rowoptim commitidx numcommits optim_delay
2105    global uparrowlen curview
2106
2107    set row $rowlaidout
2108    set rowlaidout [layoutrows $row $commitidx($curview) 0]
2109    set orow [expr {$rowlaidout - $uparrowlen - 1}]
2110    if {$orow > $rowoptim} {
2111        optimize_rows $rowoptim 0 $orow
2112        set rowoptim $orow
2113    }
2114    set canshow [expr {$rowoptim - $optim_delay}]
2115    if {$canshow > $numcommits} {
2116        showstuff $canshow
2117    }
2118}
2119
2120proc showstuff {canshow} {
2121    global numcommits commitrow pending_select selectedline
2122    global linesegends idrowranges idrangedrawn curview
2123
2124    if {$numcommits == 0} {
2125        global phase
2126        set phase "incrdraw"
2127        allcanvs delete all
2128    }
2129    set row $numcommits
2130    set numcommits $canshow
2131    setcanvscroll
2132    set rows [visiblerows]
2133    set r0 [lindex $rows 0]
2134    set r1 [lindex $rows 1]
2135    set selrow -1
2136    for {set r $row} {$r < $canshow} {incr r} {
2137        foreach id [lindex $linesegends [expr {$r+1}]] {
2138            set i -1
2139            foreach {s e} [rowranges $id] {
2140                incr i
2141                if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2142                    && ![info exists idrangedrawn($id,$i)]} {
2143                    drawlineseg $id $i
2144                    set idrangedrawn($id,$i) 1
2145                }
2146            }
2147        }
2148    }
2149    if {$canshow > $r1} {
2150        set canshow $r1
2151    }
2152    while {$row < $canshow} {
2153        drawcmitrow $row
2154        incr row
2155    }
2156    if {[info exists pending_select] &&
2157        [info exists commitrow($curview,$pending_select)] &&
2158        $commitrow($curview,$pending_select) < $numcommits} {
2159        selectline $commitrow($curview,$pending_select) 1
2160    }
2161    if {![info exists selectedline] && ![info exists pending_select]} {
2162        selectline 0 1
2163    }
2164}
2165
2166proc layoutrows {row endrow last} {
2167    global rowidlist rowoffsets displayorder
2168    global uparrowlen downarrowlen maxwidth mingaplen
2169    global childlist parentlist
2170    global idrowranges linesegends
2171    global commitidx curview
2172    global idinlist rowchk rowrangelist
2173
2174    set idlist [lindex $rowidlist $row]
2175    set offs [lindex $rowoffsets $row]
2176    while {$row < $endrow} {
2177        set id [lindex $displayorder $row]
2178        set oldolds {}
2179        set newolds {}
2180        foreach p [lindex $parentlist $row] {
2181            if {![info exists idinlist($p)]} {
2182                lappend newolds $p
2183            } elseif {!$idinlist($p)} {
2184                lappend oldolds $p
2185            }
2186        }
2187        set lse {}
2188        set nev [expr {[llength $idlist] + [llength $newolds]
2189                       + [llength $oldolds] - $maxwidth + 1}]
2190        if {$nev > 0} {
2191            if {!$last &&
2192                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2193            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2194                set i [lindex $idlist $x]
2195                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2196                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
2197                               [expr {$row + $uparrowlen + $mingaplen}]]
2198                    if {$r == 0} {
2199                        set idlist [lreplace $idlist $x $x]
2200                        set offs [lreplace $offs $x $x]
2201                        set offs [incrange $offs $x 1]
2202                        set idinlist($i) 0
2203                        set rm1 [expr {$row - 1}]
2204                        lappend lse $i
2205                        lappend idrowranges($i) $rm1
2206                        if {[incr nev -1] <= 0} break
2207                        continue
2208                    }
2209                    set rowchk($id) [expr {$row + $r}]
2210                }
2211            }
2212            lset rowidlist $row $idlist
2213            lset rowoffsets $row $offs
2214        }
2215        lappend linesegends $lse
2216        set col [lsearch -exact $idlist $id]
2217        if {$col < 0} {
2218            set col [llength $idlist]
2219            lappend idlist $id
2220            lset rowidlist $row $idlist
2221            set z {}
2222            if {[lindex $childlist $row] ne {}} {
2223                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2224                unset idinlist($id)
2225            }
2226            lappend offs $z
2227            lset rowoffsets $row $offs
2228            if {$z ne {}} {
2229                makeuparrow $id $col $row $z
2230            }
2231        } else {
2232            unset idinlist($id)
2233        }
2234        set ranges {}
2235        if {[info exists idrowranges($id)]} {
2236            set ranges $idrowranges($id)
2237            lappend ranges $row
2238            unset idrowranges($id)
2239        }
2240        lappend rowrangelist $ranges
2241        incr row
2242        set offs [ntimes [llength $idlist] 0]
2243        set l [llength $newolds]
2244        set idlist [eval lreplace \$idlist $col $col $newolds]
2245        set o 0
2246        if {$l != 1} {
2247            set offs [lrange $offs 0 [expr {$col - 1}]]
2248            foreach x $newolds {
2249                lappend offs {}
2250                incr o -1
2251            }
2252            incr o
2253            set tmp [expr {[llength $idlist] - [llength $offs]}]
2254            if {$tmp > 0} {
2255                set offs [concat $offs [ntimes $tmp $o]]
2256            }
2257        } else {
2258            lset offs $col {}
2259        }
2260        foreach i $newolds {
2261            set idinlist($i) 1
2262            set idrowranges($i) $row
2263        }
2264        incr col $l
2265        foreach oid $oldolds {
2266            set idinlist($oid) 1
2267            set idlist [linsert $idlist $col $oid]
2268            set offs [linsert $offs $col $o]
2269            makeuparrow $oid $col $row $o
2270            incr col
2271        }
2272        lappend rowidlist $idlist
2273        lappend rowoffsets $offs
2274    }
2275    return $row
2276}
2277
2278proc addextraid {id row} {
2279    global displayorder commitrow commitinfo
2280    global commitidx commitlisted
2281    global parentlist childlist children curview
2282
2283    incr commitidx($curview)
2284    lappend displayorder $id
2285    lappend commitlisted 0
2286    lappend parentlist {}
2287    set commitrow($curview,$id) $row
2288    readcommit $id
2289    if {![info exists commitinfo($id)]} {
2290        set commitinfo($id) {"No commit information available"}
2291    }
2292    if {![info exists children($curview,$id)]} {
2293        set children($curview,$id) {}
2294    }
2295    lappend childlist $children($curview,$id)
2296}
2297
2298proc layouttail {} {
2299    global rowidlist rowoffsets idinlist commitidx curview
2300    global idrowranges rowrangelist
2301
2302    set row $commitidx($curview)
2303    set idlist [lindex $rowidlist $row]
2304    while {$idlist ne {}} {
2305        set col [expr {[llength $idlist] - 1}]
2306        set id [lindex $idlist $col]
2307        addextraid $id $row
2308        unset idinlist($id)
2309        lappend idrowranges($id) $row
2310        lappend rowrangelist $idrowranges($id)
2311        unset idrowranges($id)
2312        incr row
2313        set offs [ntimes $col 0]
2314        set idlist [lreplace $idlist $col $col]
2315        lappend rowidlist $idlist
2316        lappend rowoffsets $offs
2317    }
2318
2319    foreach id [array names idinlist] {
2320        addextraid $id $row
2321        lset rowidlist $row [list $id]
2322        lset rowoffsets $row 0
2323        makeuparrow $id 0 $row 0
2324        lappend idrowranges($id) $row
2325        lappend rowrangelist $idrowranges($id)
2326        unset idrowranges($id)
2327        incr row
2328        lappend rowidlist {}
2329        lappend rowoffsets {}
2330    }
2331}
2332
2333proc insert_pad {row col npad} {
2334    global rowidlist rowoffsets
2335
2336    set pad [ntimes $npad {}]
2337    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2338    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2339    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2340}
2341
2342proc optimize_rows {row col endrow} {
2343    global rowidlist rowoffsets idrowranges displayorder
2344
2345    for {} {$row < $endrow} {incr row} {
2346        set idlist [lindex $rowidlist $row]
2347        set offs [lindex $rowoffsets $row]
2348        set haspad 0
2349        for {} {$col < [llength $offs]} {incr col} {
2350            if {[lindex $idlist $col] eq {}} {
2351                set haspad 1
2352                continue
2353            }
2354            set z [lindex $offs $col]
2355            if {$z eq {}} continue
2356            set isarrow 0
2357            set x0 [expr {$col + $z}]
2358            set y0 [expr {$row - 1}]
2359            set z0 [lindex $rowoffsets $y0 $x0]
2360            if {$z0 eq {}} {
2361                set id [lindex $idlist $col]
2362                set ranges [rowranges $id]
2363                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2364                    set isarrow 1
2365                }
2366            }
2367            if {$z < -1 || ($z < 0 && $isarrow)} {
2368                set npad [expr {-1 - $z + $isarrow}]
2369                set offs [incrange $offs $col $npad]
2370                insert_pad $y0 $x0 $npad
2371                if {$y0 > 0} {
2372                    optimize_rows $y0 $x0 $row
2373                }
2374                set z [lindex $offs $col]
2375                set x0 [expr {$col + $z}]
2376                set z0 [lindex $rowoffsets $y0 $x0]
2377            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2378                set npad [expr {$z - 1 + $isarrow}]
2379                set y1 [expr {$row + 1}]
2380                set offs2 [lindex $rowoffsets $y1]
2381                set x1 -1
2382                foreach z $offs2 {
2383                    incr x1
2384                    if {$z eq {} || $x1 + $z < $col} continue
2385                    if {$x1 + $z > $col} {
2386                        incr npad
2387                    }
2388                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2389                    break
2390                }
2391                set pad [ntimes $npad {}]
2392                set idlist [eval linsert \$idlist $col $pad]
2393                set tmp [eval linsert \$offs $col $pad]
2394                incr col $npad
2395                set offs [incrange $tmp $col [expr {-$npad}]]
2396                set z [lindex $offs $col]
2397                set haspad 1
2398            }
2399            if {$z0 eq {} && !$isarrow} {
2400                # this line links to its first child on row $row-2
2401                set rm2 [expr {$row - 2}]
2402                set id [lindex $displayorder $rm2]
2403                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2404                if {$xc >= 0} {
2405                    set z0 [expr {$xc - $x0}]
2406                }
2407            }
2408            if {$z0 ne {} && $z < 0 && $z0 > 0} {
2409                insert_pad $y0 $x0 1
2410                set offs [incrange $offs $col 1]
2411                optimize_rows $y0 [expr {$x0 + 1}] $row
2412            }
2413        }
2414        if {!$haspad} {
2415            set o {}
2416            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2417                set o [lindex $offs $col]
2418                if {$o eq {}} {
2419                    # check if this is the link to the first child
2420                    set id [lindex $idlist $col]
2421                    set ranges [rowranges $id]
2422                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
2423                        # it is, work out offset to child
2424                        set y0 [expr {$row - 1}]
2425                        set id [lindex $displayorder $y0]
2426                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2427                        if {$x0 >= 0} {
2428                            set o [expr {$x0 - $col}]
2429                        }
2430                    }
2431                }
2432                if {$o eq {} || $o <= 0} break
2433            }
2434            if {$o ne {} && [incr col] < [llength $idlist]} {
2435                set y1 [expr {$row + 1}]
2436                set offs2 [lindex $rowoffsets $y1]
2437                set x1 -1
2438                foreach z $offs2 {
2439                    incr x1
2440                    if {$z eq {} || $x1 + $z < $col} continue
2441                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
2442                    break
2443                }
2444                set idlist [linsert $idlist $col {}]
2445                set tmp [linsert $offs $col {}]
2446                incr col
2447                set offs [incrange $tmp $col -1]
2448            }
2449        }
2450        lset rowidlist $row $idlist
2451        lset rowoffsets $row $offs
2452        set col 0
2453    }
2454}
2455
2456proc xc {row col} {
2457    global canvx0 linespc
2458    return [expr {$canvx0 + $col * $linespc}]
2459}
2460
2461proc yc {row} {
2462    global canvy0 linespc
2463    return [expr {$canvy0 + $row * $linespc}]
2464}
2465
2466proc linewidth {id} {
2467    global thickerline lthickness
2468
2469    set wid $lthickness
2470    if {[info exists thickerline] && $id eq $thickerline} {
2471        set wid [expr {2 * $lthickness}]
2472    }
2473    return $wid
2474}
2475
2476proc rowranges {id} {
2477    global phase idrowranges commitrow rowlaidout rowrangelist curview
2478
2479    set ranges {}
2480    if {$phase eq {} ||
2481        ([info exists commitrow($curview,$id)]
2482         && $commitrow($curview,$id) < $rowlaidout)} {
2483        set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2484    } elseif {[info exists idrowranges($id)]} {
2485        set ranges $idrowranges($id)
2486    }
2487    return $ranges
2488}
2489
2490proc drawlineseg {id i} {
2491    global rowoffsets rowidlist
2492    global displayorder
2493    global canv colormap linespc
2494    global numcommits commitrow curview
2495
2496    set ranges [rowranges $id]
2497    set downarrow 1
2498    if {[info exists commitrow($curview,$id)]
2499        && $commitrow($curview,$id) < $numcommits} {
2500        set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2501    } else {
2502        set downarrow 1
2503    }
2504    set startrow [lindex $ranges [expr {2 * $i}]]
2505    set row [lindex $ranges [expr {2 * $i + 1}]]
2506    if {$startrow == $row} return
2507    assigncolor $id
2508    set coords {}
2509    set col [lsearch -exact [lindex $rowidlist $row] $id]
2510    if {$col < 0} {
2511        puts "oops: drawline: id $id not on row $row"
2512        return
2513    }
2514    set lasto {}
2515    set ns 0
2516    while {1} {
2517        set o [lindex $rowoffsets $row $col]
2518        if {$o eq {}} break
2519        if {$o ne $lasto} {
2520            # changing direction
2521            set x [xc $row $col]
2522            set y [yc $row]
2523            lappend coords $x $y
2524            set lasto $o
2525        }
2526        incr col $o
2527        incr row -1
2528    }
2529    set x [xc $row $col]
2530    set y [yc $row]
2531    lappend coords $x $y
2532    if {$i == 0} {
2533        # draw the link to the first child as part of this line
2534        incr row -1
2535        set child [lindex $displayorder $row]
2536        set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2537        if {$ccol >= 0} {
2538            set x [xc $row $ccol]
2539            set y [yc $row]
2540            if {$ccol < $col - 1} {
2541                lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2542            } elseif {$ccol > $col + 1} {
2543                lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2544            }
2545            lappend coords $x $y
2546        }
2547    }
2548    if {[llength $coords] < 4} return
2549    if {$downarrow} {
2550        # This line has an arrow at the lower end: check if the arrow is
2551        # on a diagonal segment, and if so, work around the Tk 8.4
2552        # refusal to draw arrows on diagonal lines.
2553        set x0 [lindex $coords 0]
2554        set x1 [lindex $coords 2]
2555        if {$x0 != $x1} {
2556            set y0 [lindex $coords 1]
2557            set y1 [lindex $coords 3]
2558            if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2559                # we have a nearby vertical segment, just trim off the diag bit
2560                set coords [lrange $coords 2 end]
2561            } else {
2562                set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2563                set xi [expr {$x0 - $slope * $linespc / 2}]
2564                set yi [expr {$y0 - $linespc / 2}]
2565                set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2566            }
2567        }
2568    }
2569    set arrow [expr {2 * ($i > 0) + $downarrow}]
2570    set arrow [lindex {none first last both} $arrow]
2571    set t [$canv create line $coords -width [linewidth $id] \
2572               -fill $colormap($id) -tags lines.$id -arrow $arrow]
2573    $canv lower $t
2574    bindline $t $id
2575}
2576
2577proc drawparentlinks {id row col olds} {
2578    global rowidlist canv colormap
2579
2580    set row2 [expr {$row + 1}]
2581    set x [xc $row $col]
2582    set y [yc $row]
2583    set y2 [yc $row2]
2584    set ids [lindex $rowidlist $row2]
2585    # rmx = right-most X coord used
2586    set rmx 0
2587    foreach p $olds {
2588        set i [lsearch -exact $ids $p]
2589        if {$i < 0} {
2590            puts "oops, parent $p of $id not in list"
2591            continue
2592        }
2593        set x2 [xc $row2 $i]
2594        if {$x2 > $rmx} {
2595            set rmx $x2
2596        }
2597        set ranges [rowranges $p]
2598        if {$ranges ne {} && $row2 == [lindex $ranges 0]
2599            && $row2 < [lindex $ranges 1]} {
2600            # drawlineseg will do this one for us
2601            continue
2602        }
2603        assigncolor $p
2604        # should handle duplicated parents here...
2605        set coords [list $x $y]
2606        if {$i < $col - 1} {
2607            lappend coords [xc $row [expr {$i + 1}]] $y
2608        } elseif {$i > $col + 1} {
2609            lappend coords [xc $row [expr {$i - 1}]] $y
2610        }
2611        lappend coords $x2 $y2
2612        set t [$canv create line $coords -width [linewidth $p] \
2613                   -fill $colormap($p) -tags lines.$p]
2614        $canv lower $t
2615        bindline $t $p
2616    }
2617    return $rmx
2618}
2619
2620proc drawlines {id} {
2621    global colormap canv
2622    global idrangedrawn
2623    global children iddrawn commitrow rowidlist curview
2624
2625    $canv delete lines.$id
2626    set nr [expr {[llength [rowranges $id]] / 2}]
2627    for {set i 0} {$i < $nr} {incr i} {
2628        if {[info exists idrangedrawn($id,$i)]} {
2629            drawlineseg $id $i
2630        }
2631    }
2632    foreach child $children($curview,$id) {
2633        if {[info exists iddrawn($child)]} {
2634            set row $commitrow($curview,$child)
2635            set col [lsearch -exact [lindex $rowidlist $row] $child]
2636            if {$col >= 0} {
2637                drawparentlinks $child $row $col [list $id]
2638            }
2639        }
2640    }
2641}
2642
2643proc drawcmittext {id row col rmx} {
2644    global linespc canv canv2 canv3 canvy0
2645    global commitlisted commitinfo rowidlist
2646    global rowtextx idpos idtags idheads idotherrefs
2647    global linehtag linentag linedtag
2648    global mainfont canvxmax
2649
2650    set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2651    set x [xc $row $col]
2652    set y [yc $row]
2653    set orad [expr {$linespc / 3}]
2654    set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2655               [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2656               -fill $ofill -outline black -width 1]
2657    $canv raise $t
2658    $canv bind $t <1> {selcanvline {} %x %y}
2659    set xt [xc $row [llength [lindex $rowidlist $row]]]
2660    if {$xt < $rmx} {
2661        set xt $rmx
2662    }
2663    set rowtextx($row) $xt
2664    set idpos($id) [list $x $xt $y]
2665    if {[info exists idtags($id)] || [info exists idheads($id)]
2666        || [info exists idotherrefs($id)]} {
2667        set xt [drawtags $id $x $xt $y]
2668    }
2669    set headline [lindex $commitinfo($id) 0]
2670    set name [lindex $commitinfo($id) 1]
2671    set date [lindex $commitinfo($id) 2]
2672    set date [formatdate $date]
2673    set font $mainfont
2674    set nfont $mainfont
2675    set isbold [ishighlighted $row]
2676    if {$isbold > 0} {
2677        lappend font bold
2678        if {$isbold > 1} {
2679            lappend nfont bold
2680        }
2681    }
2682    set linehtag($row) [$canv create text $xt $y -anchor w \
2683                            -text $headline -font $font]
2684    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2685    set linentag($row) [$canv2 create text 3 $y -anchor w \
2686                            -text $name -font $nfont]
2687    set linedtag($row) [$canv3 create text 3 $y -anchor w \
2688                            -text $date -font $mainfont]
2689    set xr [expr {$xt + [font measure $mainfont $headline]}]
2690    if {$xr > $canvxmax} {
2691        set canvxmax $xr
2692        setcanvscroll
2693    }
2694}
2695
2696proc drawcmitrow {row} {
2697    global displayorder rowidlist
2698    global idrangedrawn iddrawn
2699    global commitinfo parentlist numcommits
2700    global filehighlight fhighlights findstring nhighlights
2701    global hlview vhighlights
2702
2703    if {$row >= $numcommits} return
2704    foreach id [lindex $rowidlist $row] {
2705        if {$id eq {}} continue
2706        set i -1
2707        foreach {s e} [rowranges $id] {
2708            incr i
2709            if {$row < $s} continue
2710            if {$e eq {}} break
2711            if {$row <= $e} {
2712                if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2713                    drawlineseg $id $i
2714                    set idrangedrawn($id,$i) 1
2715                }
2716                break
2717            }
2718        }
2719    }
2720
2721    set id [lindex $displayorder $row]
2722    if {[info exists hlview] && ![info exists vhighlights($row)]} {
2723        askvhighlight $row $id
2724    }
2725    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2726        askfilehighlight $row $id
2727    }
2728    if {$findstring ne {} && ![info exists nhighlights($row)]} {
2729        askfindhighlight $row $id
2730    }
2731    if {[info exists iddrawn($id)]} return
2732    set col [lsearch -exact [lindex $rowidlist $row] $id]
2733    if {$col < 0} {
2734        puts "oops, row $row id $id not in list"
2735        return
2736    }
2737    if {![info exists commitinfo($id)]} {
2738        getcommit $id
2739    }
2740    assigncolor $id
2741    set olds [lindex $parentlist $row]
2742    if {$olds ne {}} {
2743        set rmx [drawparentlinks $id $row $col $olds]
2744    } else {
2745        set rmx 0
2746    }
2747    drawcmittext $id $row $col $rmx
2748    set iddrawn($id) 1
2749}
2750
2751proc drawfrac {f0 f1} {
2752    global numcommits canv
2753    global linespc
2754
2755    set ymax [lindex [$canv cget -scrollregion] 3]
2756    if {$ymax eq {} || $ymax == 0} return
2757    set y0 [expr {int($f0 * $ymax)}]
2758    set row [expr {int(($y0 - 3) / $linespc) - 1}]
2759    if {$row < 0} {
2760        set row 0
2761    }
2762    set y1 [expr {int($f1 * $ymax)}]
2763    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2764    if {$endrow >= $numcommits} {
2765        set endrow [expr {$numcommits - 1}]
2766    }
2767    for {} {$row <= $endrow} {incr row} {
2768        drawcmitrow $row
2769    }
2770}
2771
2772proc drawvisible {} {
2773    global canv
2774    eval drawfrac [$canv yview]
2775}
2776
2777proc clear_display {} {
2778    global iddrawn idrangedrawn
2779    global vhighlights fhighlights nhighlights
2780
2781    allcanvs delete all
2782    catch {unset iddrawn}
2783    catch {unset idrangedrawn}
2784    catch {unset vhighlights}
2785    catch {unset fhighlights}
2786    catch {unset nhighlights}
2787}
2788
2789proc findcrossings {id} {
2790    global rowidlist parentlist numcommits rowoffsets displayorder
2791
2792    set cross {}
2793    set ccross {}
2794    foreach {s e} [rowranges $id] {
2795        if {$e >= $numcommits} {
2796            set e [expr {$numcommits - 1}]
2797        }
2798        if {$e <= $s} continue
2799        set x [lsearch -exact [lindex $rowidlist $e] $id]
2800        if {$x < 0} {
2801            puts "findcrossings: oops, no [shortids $id] in row $e"
2802            continue
2803        }
2804        for {set row $e} {[incr row -1] >= $s} {} {
2805            set olds [lindex $parentlist $row]
2806            set kid [lindex $displayorder $row]
2807            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2808            if {$kidx < 0} continue
2809            set nextrow [lindex $rowidlist [expr {$row + 1}]]
2810            foreach p $olds {
2811                set px [lsearch -exact $nextrow $p]
2812                if {$px < 0} continue
2813                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2814                    if {[lsearch -exact $ccross $p] >= 0} continue
2815                    if {$x == $px + ($kidx < $px? -1: 1)} {
2816                        lappend ccross $p
2817                    } elseif {[lsearch -exact $cross $p] < 0} {
2818                        lappend cross $p
2819                    }
2820                }
2821            }
2822            set inc [lindex $rowoffsets $row $x]
2823            if {$inc eq {}} break
2824            incr x $inc
2825        }
2826    }
2827    return [concat $ccross {{}} $cross]
2828}
2829
2830proc assigncolor {id} {
2831    global colormap colors nextcolor
2832    global commitrow parentlist children children curview
2833
2834    if {[info exists colormap($id)]} return
2835    set ncolors [llength $colors]
2836    if {[info exists children($curview,$id)]} {
2837        set kids $children($curview,$id)
2838    } else {
2839        set kids {}
2840    }
2841    if {[llength $kids] == 1} {
2842        set child [lindex $kids 0]
2843        if {[info exists colormap($child)]
2844            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2845            set colormap($id) $colormap($child)
2846            return
2847        }
2848    }
2849    set badcolors {}
2850    set origbad {}
2851    foreach x [findcrossings $id] {
2852        if {$x eq {}} {
2853            # delimiter between corner crossings and other crossings
2854            if {[llength $badcolors] >= $ncolors - 1} break
2855            set origbad $badcolors
2856        }
2857        if {[info exists colormap($x)]
2858            && [lsearch -exact $badcolors $colormap($x)] < 0} {
2859            lappend badcolors $colormap($x)
2860        }
2861    }
2862    if {[llength $badcolors] >= $ncolors} {
2863        set badcolors $origbad
2864    }
2865    set origbad $badcolors
2866    if {[llength $badcolors] < $ncolors - 1} {
2867        foreach child $kids {
2868            if {[info exists colormap($child)]
2869                && [lsearch -exact $badcolors $colormap($child)] < 0} {
2870                lappend badcolors $colormap($child)
2871            }
2872            foreach p [lindex $parentlist $commitrow($curview,$child)] {
2873                if {[info exists colormap($p)]
2874                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
2875                    lappend badcolors $colormap($p)
2876                }
2877            }
2878        }
2879        if {[llength $badcolors] >= $ncolors} {
2880            set badcolors $origbad
2881        }
2882    }
2883    for {set i 0} {$i <= $ncolors} {incr i} {
2884        set c [lindex $colors $nextcolor]
2885        if {[incr nextcolor] >= $ncolors} {
2886            set nextcolor 0
2887        }
2888        if {[lsearch -exact $badcolors $c]} break
2889    }
2890    set colormap($id) $c
2891}
2892
2893proc bindline {t id} {
2894    global canv
2895
2896    $canv bind $t <Enter> "lineenter %x %y $id"
2897    $canv bind $t <Motion> "linemotion %x %y $id"
2898    $canv bind $t <Leave> "lineleave $id"
2899    $canv bind $t <Button-1> "lineclick %x %y $id 1"
2900}
2901
2902proc drawtags {id x xt y1} {
2903    global idtags idheads idotherrefs
2904    global linespc lthickness
2905    global canv mainfont commitrow rowtextx curview
2906
2907    set marks {}
2908    set ntags 0
2909    set nheads 0
2910    if {[info exists idtags($id)]} {
2911        set marks $idtags($id)
2912        set ntags [llength $marks]
2913    }
2914    if {[info exists idheads($id)]} {
2915        set marks [concat $marks $idheads($id)]
2916        set nheads [llength $idheads($id)]
2917    }
2918    if {[info exists idotherrefs($id)]} {
2919        set marks [concat $marks $idotherrefs($id)]
2920    }
2921    if {$marks eq {}} {
2922        return $xt
2923    }
2924
2925    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2926    set yt [expr {$y1 - 0.5 * $linespc}]
2927    set yb [expr {$yt + $linespc - 1}]
2928    set xvals {}
2929    set wvals {}
2930    foreach tag $marks {
2931        set wid [font measure $mainfont $tag]
2932        lappend xvals $xt
2933        lappend wvals $wid
2934        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2935    }
2936    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2937               -width $lthickness -fill black -tags tag.$id]
2938    $canv lower $t
2939    foreach tag $marks x $xvals wid $wvals {
2940        set xl [expr {$x + $delta}]
2941        set xr [expr {$x + $delta + $wid + $lthickness}]
2942        if {[incr ntags -1] >= 0} {
2943            # draw a tag
2944            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2945                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2946                       -width 1 -outline black -fill yellow -tags tag.$id]
2947            $canv bind $t <1> [list showtag $tag 1]
2948            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2949        } else {
2950            # draw a head or other ref
2951            if {[incr nheads -1] >= 0} {
2952                set col green
2953            } else {
2954                set col "#ddddff"
2955            }
2956            set xl [expr {$xl - $delta/2}]
2957            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2958                -width 1 -outline black -fill $col -tags tag.$id
2959            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2960                set rwid [font measure $mainfont $remoteprefix]
2961                set xi [expr {$x + 1}]
2962                set yti [expr {$yt + 1}]
2963                set xri [expr {$x + $rwid}]
2964                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2965                        -width 0 -fill "#ffddaa" -tags tag.$id
2966            }
2967        }
2968        set t [$canv create text $xl $y1 -anchor w -text $tag \
2969                   -font $mainfont -tags tag.$id]
2970        if {$ntags >= 0} {
2971            $canv bind $t <1> [list showtag $tag 1]
2972        }
2973    }
2974    return $xt
2975}
2976
2977proc xcoord {i level ln} {
2978    global canvx0 xspc1 xspc2
2979
2980    set x [expr {$canvx0 + $i * $xspc1($ln)}]
2981    if {$i > 0 && $i == $level} {
2982        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2983    } elseif {$i > $level} {
2984        set x [expr {$x + $xspc2 - $xspc1($ln)}]
2985    }
2986    return $x
2987}
2988
2989proc show_status {msg} {
2990    global canv mainfont
2991
2992    clear_display
2993    $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2994}
2995
2996proc finishcommits {} {
2997    global commitidx phase curview
2998    global canv mainfont ctext maincursor textcursor
2999    global findinprogress pending_select
3000
3001    if {$commitidx($curview) > 0} {
3002        drawrest
3003    } else {
3004        show_status "No commits selected"
3005    }
3006    set phase {}
3007    catch {unset pending_select}
3008}
3009
3010# Don't change the text pane cursor if it is currently the hand cursor,
3011# showing that we are over a sha1 ID link.
3012proc settextcursor {c} {
3013    global ctext curtextcursor
3014
3015    if {[$ctext cget -cursor] == $curtextcursor} {
3016        $ctext config -cursor $c
3017    }
3018    set curtextcursor $c
3019}
3020
3021proc nowbusy {what} {
3022    global isbusy
3023
3024    if {[array names isbusy] eq {}} {
3025        . config -cursor watch
3026        settextcursor watch
3027    }
3028    set isbusy($what) 1
3029}
3030
3031proc notbusy {what} {
3032    global isbusy maincursor textcursor
3033
3034    catch {unset isbusy($what)}
3035    if {[array names isbusy] eq {}} {
3036        . config -cursor $maincursor
3037        settextcursor $textcursor
3038    }
3039}
3040
3041proc drawrest {} {
3042    global numcommits
3043    global startmsecs
3044    global canvy0 numcommits linespc
3045    global rowlaidout commitidx curview
3046    global pending_select
3047
3048    set row $rowlaidout
3049    layoutrows $rowlaidout $commitidx($curview) 1
3050    layouttail
3051    optimize_rows $row 0 $commitidx($curview)
3052    showstuff $commitidx($curview)
3053    if {[info exists pending_select]} {
3054        selectline 0 1
3055    }
3056
3057    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3058    #puts "overall $drawmsecs ms for $numcommits commits"
3059}
3060
3061proc findmatches {f} {
3062    global findtype foundstring foundstrlen
3063    if {$findtype == "Regexp"} {
3064        set matches [regexp -indices -all -inline $foundstring $f]
3065    } else {
3066        if {$findtype == "IgnCase"} {
3067            set str [string tolower $f]
3068        } else {
3069            set str $f
3070        }
3071        set matches {}
3072        set i 0
3073        while {[set j [string first $foundstring $str $i]] >= 0} {
3074            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3075            set i [expr {$j + $foundstrlen}]
3076        }
3077    }
3078    return $matches
3079}
3080
3081proc dofind {} {
3082    global findtype findloc findstring markedmatches commitinfo
3083    global numcommits displayorder linehtag linentag linedtag
3084    global mainfont canv canv2 canv3 selectedline
3085    global matchinglines foundstring foundstrlen matchstring
3086    global commitdata
3087
3088    stopfindproc
3089    unmarkmatches
3090    focus .
3091    set matchinglines {}
3092    if {$findtype == "IgnCase"} {
3093        set foundstring [string tolower $findstring]
3094    } else {
3095        set foundstring $findstring
3096    }
3097    set foundstrlen [string length $findstring]
3098    if {$foundstrlen == 0} return
3099    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3100    set matchstring "*$matchstring*"
3101    if {![info exists selectedline]} {
3102        set oldsel -1
3103    } else {
3104        set oldsel $selectedline
3105    }
3106    set didsel 0
3107    set fldtypes {Headline Author Date Committer CDate Comments}
3108    set l -1
3109    foreach id $displayorder {
3110        set d $commitdata($id)
3111        incr l
3112        if {$findtype == "Regexp"} {
3113            set doesmatch [regexp $foundstring $d]
3114        } elseif {$findtype == "IgnCase"} {
3115            set doesmatch [string match -nocase $matchstring $d]
3116        } else {
3117            set doesmatch [string match $matchstring $d]
3118        }
3119        if {!$doesmatch} continue
3120        if {![info exists commitinfo($id)]} {
3121            getcommit $id
3122        }
3123        set info $commitinfo($id)
3124        set doesmatch 0
3125        foreach f $info ty $fldtypes {
3126            if {$findloc != "All fields" && $findloc != $ty} {
3127                continue
3128            }
3129            set matches [findmatches $f]
3130            if {$matches == {}} continue
3131            set doesmatch 1
3132            if {$ty == "Headline"} {
3133                drawcmitrow $l
3134                markmatches $canv $l $f $linehtag($l) $matches $mainfont
3135            } elseif {$ty == "Author"} {
3136                drawcmitrow $l
3137                markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3138            } elseif {$ty == "Date"} {
3139                drawcmitrow $l
3140                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3141            }
3142        }
3143        if {$doesmatch} {
3144            lappend matchinglines $l
3145            if {!$didsel && $l > $oldsel} {
3146                findselectline $l
3147                set didsel 1
3148            }
3149        }
3150    }
3151    if {$matchinglines == {}} {
3152        bell
3153    } elseif {!$didsel} {
3154        findselectline [lindex $matchinglines 0]
3155    }
3156}
3157
3158proc findselectline {l} {
3159    global findloc commentend ctext
3160    selectline $l 1
3161    if {$findloc == "All fields" || $findloc == "Comments"} {
3162        # highlight the matches in the comments
3163        set f [$ctext get 1.0 $commentend]
3164        set matches [findmatches $f]
3165        foreach match $matches {
3166            set start [lindex $match 0]
3167            set end [expr {[lindex $match 1] + 1}]
3168            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3169        }
3170    }
3171}
3172
3173proc findnext {restart} {
3174    global matchinglines selectedline
3175    if {![info exists matchinglines]} {
3176        if {$restart} {
3177            dofind
3178        }
3179        return
3180    }
3181    if {![info exists selectedline]} return
3182    foreach l $matchinglines {
3183        if {$l > $selectedline} {
3184            findselectline $l
3185            return
3186        }
3187    }
3188    bell
3189}
3190
3191proc findprev {} {
3192    global matchinglines selectedline
3193    if {![info exists matchinglines]} {
3194        dofind
3195        return
3196    }
3197    if {![info exists selectedline]} return
3198    set prev {}
3199    foreach l $matchinglines {
3200        if {$l >= $selectedline} break
3201        set prev $l
3202    }
3203    if {$prev != {}} {
3204        findselectline $prev
3205    } else {
3206        bell
3207    }
3208}
3209
3210proc stopfindproc {{done 0}} {
3211    global findprocpid findprocfile findids
3212    global ctext findoldcursor phase maincursor textcursor
3213    global findinprogress
3214
3215    catch {unset findids}
3216    if {[info exists findprocpid]} {
3217        if {!$done} {
3218            catch {exec kill $findprocpid}
3219        }
3220        catch {close $findprocfile}
3221        unset findprocpid
3222    }
3223    catch {unset findinprogress}
3224    notbusy find
3225}
3226
3227# mark a commit as matching by putting a yellow background
3228# behind the headline
3229proc markheadline {l id} {
3230    global canv mainfont linehtag
3231
3232    drawcmitrow $l
3233    set bbox [$canv bbox $linehtag($l)]
3234    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3235    $canv lower $t
3236}
3237
3238# mark the bits of a headline, author or date that match a find string
3239proc markmatches {canv l str tag matches font} {
3240    set bbox [$canv bbox $tag]
3241    set x0 [lindex $bbox 0]
3242    set y0 [lindex $bbox 1]
3243    set y1 [lindex $bbox 3]
3244    foreach match $matches {
3245        set start [lindex $match 0]
3246        set end [lindex $match 1]
3247        if {$start > $end} continue
3248        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3249        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3250        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3251                   [expr {$x0+$xlen+2}] $y1 \
3252                   -outline {} -tags matches -fill yellow]
3253        $canv lower $t
3254    }
3255}
3256
3257proc unmarkmatches {} {
3258    global matchinglines findids
3259    allcanvs delete matches
3260    catch {unset matchinglines}
3261    catch {unset findids}
3262}
3263
3264proc selcanvline {w x y} {
3265    global canv canvy0 ctext linespc
3266    global rowtextx
3267    set ymax [lindex [$canv cget -scrollregion] 3]
3268    if {$ymax == {}} return
3269    set yfrac [lindex [$canv yview] 0]
3270    set y [expr {$y + $yfrac * $ymax}]
3271    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3272    if {$l < 0} {
3273        set l 0
3274    }
3275    if {$w eq $canv} {
3276        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3277    }
3278    unmarkmatches
3279    selectline $l 1
3280}
3281
3282proc commit_descriptor {p} {
3283    global commitinfo
3284    if {![info exists commitinfo($p)]} {
3285        getcommit $p
3286    }
3287    set l "..."
3288    if {[llength $commitinfo($p)] > 1} {
3289        set l [lindex $commitinfo($p) 0]
3290    }
3291    return "$p ($l)"
3292}
3293
3294# append some text to the ctext widget, and make any SHA1 ID
3295# that we know about be a clickable link.
3296proc appendwithlinks {text} {
3297    global ctext commitrow linknum curview
3298
3299    set start [$ctext index "end - 1c"]
3300    $ctext insert end $text
3301    $ctext insert end "\n"
3302    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3303    foreach l $links {
3304        set s [lindex $l 0]
3305        set e [lindex $l 1]
3306        set linkid [string range $text $s $e]
3307        if {![info exists commitrow($curview,$linkid)]} continue
3308        incr e
3309        $ctext tag add link "$start + $s c" "$start + $e c"
3310        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3311        $ctext tag bind link$linknum <1> \
3312            [list selectline $commitrow($curview,$linkid) 1]
3313        incr linknum
3314    }
3315    $ctext tag conf link -foreground blue -underline 1
3316    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3317    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3318}
3319
3320proc viewnextline {dir} {
3321    global canv linespc
3322
3323    $canv delete hover
3324    set ymax [lindex [$canv cget -scrollregion] 3]
3325    set wnow [$canv yview]
3326    set wtop [expr {[lindex $wnow 0] * $ymax}]
3327    set newtop [expr {$wtop + $dir * $linespc}]
3328    if {$newtop < 0} {
3329        set newtop 0
3330    } elseif {$newtop > $ymax} {
3331        set newtop $ymax
3332    }
3333    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3334}
3335
3336proc selectline {l isnew} {
3337    global canv canv2 canv3 ctext commitinfo selectedline
3338    global displayorder linehtag linentag linedtag
3339    global canvy0 linespc parentlist childlist
3340    global currentid sha1entry
3341    global commentend idtags linknum
3342    global mergemax numcommits pending_select
3343    global cmitmode
3344
3345    catch {unset pending_select}
3346    $canv delete hover
3347    normalline
3348    if {$l < 0 || $l >= $numcommits} return
3349    set y [expr {$canvy0 + $l * $linespc}]
3350    set ymax [lindex [$canv cget -scrollregion] 3]
3351    set ytop [expr {$y - $linespc - 1}]
3352    set ybot [expr {$y + $linespc + 1}]
3353    set wnow [$canv yview]
3354    set wtop [expr {[lindex $wnow 0] * $ymax}]
3355    set wbot [expr {[lindex $wnow 1] * $ymax}]
3356    set wh [expr {$wbot - $wtop}]
3357    set newtop $wtop
3358    if {$ytop < $wtop} {
3359        if {$ybot < $wtop} {
3360            set newtop [expr {$y - $wh / 2.0}]
3361        } else {
3362            set newtop $ytop
3363            if {$newtop > $wtop - $linespc} {
3364                set newtop [expr {$wtop - $linespc}]
3365            }
3366        }
3367    } elseif {$ybot > $wbot} {
3368        if {$ytop > $wbot} {
3369            set newtop [expr {$y - $wh / 2.0}]
3370        } else {
3371            set newtop [expr {$ybot - $wh}]
3372            if {$newtop < $wtop + $linespc} {
3373                set newtop [expr {$wtop + $linespc}]
3374            }
3375        }
3376    }
3377    if {$newtop != $wtop} {
3378        if {$newtop < 0} {
3379            set newtop 0
3380        }
3381        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3382        drawvisible
3383    }
3384
3385    if {![info exists linehtag($l)]} return
3386    $canv delete secsel
3387    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3388               -tags secsel -fill [$canv cget -selectbackground]]
3389    $canv lower $t
3390    $canv2 delete secsel
3391    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3392               -tags secsel -fill [$canv2 cget -selectbackground]]
3393    $canv2 lower $t
3394    $canv3 delete secsel
3395    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3396               -tags secsel -fill [$canv3 cget -selectbackground]]
3397    $canv3 lower $t
3398
3399    if {$isnew} {
3400        addtohistory [list selectline $l 0]
3401    }
3402
3403    set selectedline $l
3404
3405    set id [lindex $displayorder $l]
3406    set currentid $id
3407    $sha1entry delete 0 end
3408    $sha1entry insert 0 $id
3409    $sha1entry selection from 0
3410    $sha1entry selection to end
3411
3412    $ctext conf -state normal
3413    clear_ctext
3414    set linknum 0
3415    set info $commitinfo($id)
3416    set date [formatdate [lindex $info 2]]
3417    $ctext insert end "Author: [lindex $info 1]  $date\n"
3418    set date [formatdate [lindex $info 4]]
3419    $ctext insert end "Committer: [lindex $info 3]  $date\n"
3420    if {[info exists idtags($id)]} {
3421        $ctext insert end "Tags:"
3422        foreach tag $idtags($id) {
3423            $ctext insert end " $tag"
3424        }
3425        $ctext insert end "\n"
3426    }
3427 
3428    set comment {}
3429    set olds [lindex $parentlist $l]
3430    if {[llength $olds] > 1} {
3431        set np 0
3432        foreach p $olds {
3433            if {$np >= $mergemax} {
3434                set tag mmax
3435            } else {
3436                set tag m$np
3437            }
3438            $ctext insert end "Parent: " $tag
3439            appendwithlinks [commit_descriptor $p]
3440            incr np
3441        }
3442    } else {
3443        foreach p $olds {
3444            append comment "Parent: [commit_descriptor $p]\n"
3445        }
3446    }
3447
3448    foreach c [lindex $childlist $l] {
3449        append comment "Child:  [commit_descriptor $c]\n"
3450    }
3451    append comment "\n"
3452    append comment [lindex $info 5]
3453
3454    # make anything that looks like a SHA1 ID be a clickable link
3455    appendwithlinks $comment
3456
3457    $ctext tag delete Comments
3458    $ctext tag remove found 1.0 end
3459    $ctext conf -state disabled
3460    set commentend [$ctext index "end - 1c"]
3461
3462    init_flist "Comments"
3463    if {$cmitmode eq "tree"} {
3464        gettree $id
3465    } elseif {[llength $olds] <= 1} {
3466        startdiff $id
3467    } else {
3468        mergediff $id $l
3469    }
3470}
3471
3472proc selfirstline {} {
3473    unmarkmatches
3474    selectline 0 1
3475}
3476
3477proc sellastline {} {
3478    global numcommits
3479    unmarkmatches
3480    set l [expr {$numcommits - 1}]
3481    selectline $l 1
3482}
3483
3484proc selnextline {dir} {
3485    global selectedline
3486    if {![info exists selectedline]} return
3487    set l [expr {$selectedline + $dir}]
3488    unmarkmatches
3489    selectline $l 1
3490}
3491
3492proc selnextpage {dir} {
3493    global canv linespc selectedline numcommits
3494
3495    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3496    if {$lpp < 1} {
3497        set lpp 1
3498    }
3499    allcanvs yview scroll [expr {$dir * $lpp}] units
3500    drawvisible
3501    if {![info exists selectedline]} return
3502    set l [expr {$selectedline + $dir * $lpp}]
3503    if {$l < 0} {
3504        set l 0
3505    } elseif {$l >= $numcommits} {
3506        set l [expr $numcommits - 1]
3507    }
3508    unmarkmatches
3509    selectline $l 1    
3510}
3511
3512proc unselectline {} {
3513    global selectedline currentid
3514
3515    catch {unset selectedline}
3516    catch {unset currentid}
3517    allcanvs delete secsel
3518}
3519
3520proc reselectline {} {
3521    global selectedline
3522
3523    if {[info exists selectedline]} {
3524        selectline $selectedline 0
3525    }
3526}
3527
3528proc addtohistory {cmd} {
3529    global history historyindex curview
3530
3531    set elt [list $curview $cmd]
3532    if {$historyindex > 0
3533        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3534        return
3535    }
3536
3537    if {$historyindex < [llength $history]} {
3538        set history [lreplace $history $historyindex end $elt]
3539    } else {
3540        lappend history $elt
3541    }
3542    incr historyindex
3543    if {$historyindex > 1} {
3544        .ctop.top.bar.leftbut conf -state normal
3545    } else {
3546        .ctop.top.bar.leftbut conf -state disabled
3547    }
3548    .ctop.top.bar.rightbut conf -state disabled
3549}
3550
3551proc godo {elt} {
3552    global curview
3553
3554    set view [lindex $elt 0]
3555    set cmd [lindex $elt 1]
3556    if {$curview != $view} {
3557        showview $view
3558    }
3559    eval $cmd
3560}
3561
3562proc goback {} {
3563    global history historyindex
3564
3565    if {$historyindex > 1} {
3566        incr historyindex -1
3567        godo [lindex $history [expr {$historyindex - 1}]]
3568        .ctop.top.bar.rightbut conf -state normal
3569    }
3570    if {$historyindex <= 1} {
3571        .ctop.top.bar.leftbut conf -state disabled
3572    }
3573}
3574
3575proc goforw {} {
3576    global history historyindex
3577
3578    if {$historyindex < [llength $history]} {
3579        set cmd [lindex $history $historyindex]
3580        incr historyindex
3581        godo $cmd
3582        .ctop.top.bar.leftbut conf -state normal
3583    }
3584    if {$historyindex >= [llength $history]} {
3585        .ctop.top.bar.rightbut conf -state disabled
3586    }
3587}
3588
3589proc gettree {id} {
3590    global treefilelist treeidlist diffids diffmergeid treepending
3591
3592    set diffids $id
3593    catch {unset diffmergeid}
3594    if {![info exists treefilelist($id)]} {
3595        if {![info exists treepending]} {
3596            if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3597                return
3598            }
3599            set treepending $id
3600            set treefilelist($id) {}
3601            set treeidlist($id) {}
3602            fconfigure $gtf -blocking 0
3603            fileevent $gtf readable [list gettreeline $gtf $id]
3604        }
3605    } else {
3606        setfilelist $id
3607    }
3608}
3609
3610proc gettreeline {gtf id} {
3611    global treefilelist treeidlist treepending cmitmode diffids
3612
3613    while {[gets $gtf line] >= 0} {
3614        if {[lindex $line 1] ne "blob"} continue
3615        set sha1 [lindex $line 2]
3616        set fname [lindex $line 3]
3617        lappend treefilelist($id) $fname
3618        lappend treeidlist($id) $sha1
3619    }
3620    if {![eof $gtf]} return
3621    close $gtf
3622    unset treepending
3623    if {$cmitmode ne "tree"} {
3624        if {![info exists diffmergeid]} {
3625            gettreediffs $diffids
3626        }
3627    } elseif {$id ne $diffids} {
3628        gettree $diffids
3629    } else {
3630        setfilelist $id
3631    }
3632}
3633
3634proc showfile {f} {
3635    global treefilelist treeidlist diffids
3636    global ctext commentend
3637
3638    set i [lsearch -exact $treefilelist($diffids) $f]
3639    if {$i < 0} {
3640        puts "oops, $f not in list for id $diffids"
3641        return
3642    }
3643    set blob [lindex $treeidlist($diffids) $i]
3644    if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3645        puts "oops, error reading blob $blob: $err"
3646        return
3647    }
3648    fconfigure $bf -blocking 0
3649    fileevent $bf readable [list getblobline $bf $diffids]
3650    $ctext config -state normal
3651    clear_ctext $commentend
3652    $ctext insert end "\n"
3653    $ctext insert end "$f\n" filesep
3654    $ctext config -state disabled
3655    $ctext yview $commentend
3656}
3657
3658proc getblobline {bf id} {
3659    global diffids cmitmode ctext
3660
3661    if {$id ne $diffids || $cmitmode ne "tree"} {
3662        catch {close $bf}
3663        return
3664    }
3665    $ctext config -state normal
3666    while {[gets $bf line] >= 0} {
3667        $ctext insert end "$line\n"
3668    }
3669    if {[eof $bf]} {
3670        # delete last newline
3671        $ctext delete "end - 2c" "end - 1c"
3672        close $bf
3673    }
3674    $ctext config -state disabled
3675}
3676
3677proc mergediff {id l} {
3678    global diffmergeid diffopts mdifffd
3679    global diffids
3680    global parentlist
3681
3682    set diffmergeid $id
3683    set diffids $id
3684    # this doesn't seem to actually affect anything...
3685    set env(GIT_DIFF_OPTS) $diffopts
3686    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3687    if {[catch {set mdf [open $cmd r]} err]} {
3688        error_popup "Error getting merge diffs: $err"
3689        return
3690    }
3691    fconfigure $mdf -blocking 0
3692    set mdifffd($id) $mdf
3693    set np [llength [lindex $parentlist $l]]
3694    fileevent $mdf readable [list getmergediffline $mdf $id $np]
3695    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3696}
3697
3698proc getmergediffline {mdf id np} {
3699    global diffmergeid ctext cflist nextupdate mergemax
3700    global difffilestart mdifffd
3701
3702    set n [gets $mdf line]
3703    if {$n < 0} {
3704        if {[eof $mdf]} {
3705            close $mdf
3706        }
3707        return
3708    }
3709    if {![info exists diffmergeid] || $id != $diffmergeid
3710        || $mdf != $mdifffd($id)} {
3711        return
3712    }
3713    $ctext conf -state normal
3714    if {[regexp {^diff --cc (.*)} $line match fname]} {
3715        # start of a new file
3716        $ctext insert end "\n"
3717        set here [$ctext index "end - 1c"]
3718        lappend difffilestart $here
3719        add_flist [list $fname]
3720        set l [expr {(78 - [string length $fname]) / 2}]
3721        set pad [string range "----------------------------------------" 1 $l]
3722        $ctext insert end "$pad $fname $pad\n" filesep
3723    } elseif {[regexp {^@@} $line]} {
3724        $ctext insert end "$line\n" hunksep
3725    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3726        # do nothing
3727    } else {
3728        # parse the prefix - one ' ', '-' or '+' for each parent
3729        set spaces {}
3730        set minuses {}
3731        set pluses {}
3732        set isbad 0
3733        for {set j 0} {$j < $np} {incr j} {
3734            set c [string range $line $j $j]
3735            if {$c == " "} {
3736                lappend spaces $j
3737            } elseif {$c == "-"} {
3738                lappend minuses $j
3739            } elseif {$c == "+"} {
3740                lappend pluses $j
3741            } else {
3742                set isbad 1
3743                break
3744            }
3745        }
3746        set tags {}
3747        set num {}
3748        if {!$isbad && $minuses ne {} && $pluses eq {}} {
3749            # line doesn't appear in result, parents in $minuses have the line
3750            set num [lindex $minuses 0]
3751        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3752            # line appears in result, parents in $pluses don't have the line
3753            lappend tags mresult
3754            set num [lindex $spaces 0]
3755        }
3756        if {$num ne {}} {
3757            if {$num >= $mergemax} {
3758                set num "max"
3759            }
3760            lappend tags m$num
3761        }
3762        $ctext insert end "$line\n" $tags
3763    }
3764    $ctext conf -state disabled
3765    if {[clock clicks -milliseconds] >= $nextupdate} {
3766        incr nextupdate 100
3767        fileevent $mdf readable {}
3768        update
3769        fileevent $mdf readable [list getmergediffline $mdf $id $np]
3770    }
3771}
3772
3773proc startdiff {ids} {
3774    global treediffs diffids treepending diffmergeid
3775
3776    set diffids $ids
3777    catch {unset diffmergeid}
3778    if {![info exists treediffs($ids)]} {
3779        if {![info exists treepending]} {
3780            gettreediffs $ids
3781        }
3782    } else {
3783        addtocflist $ids
3784    }
3785}
3786
3787proc addtocflist {ids} {
3788    global treediffs cflist
3789    add_flist $treediffs($ids)
3790    getblobdiffs $ids
3791}
3792
3793proc gettreediffs {ids} {
3794    global treediff treepending
3795    set treepending $ids
3796    set treediff {}
3797    if {[catch \
3798         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3799        ]} return
3800    fconfigure $gdtf -blocking 0
3801    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3802}
3803
3804proc gettreediffline {gdtf ids} {
3805    global treediff treediffs treepending diffids diffmergeid
3806    global cmitmode
3807
3808    set n [gets $gdtf line]
3809    if {$n < 0} {
3810        if {![eof $gdtf]} return
3811        close $gdtf
3812        set treediffs($ids) $treediff
3813        unset treepending
3814        if {$cmitmode eq "tree"} {
3815            gettree $diffids
3816        } elseif {$ids != $diffids} {
3817            if {![info exists diffmergeid]} {
3818                gettreediffs $diffids
3819            }
3820        } else {
3821            addtocflist $ids
3822        }
3823        return
3824    }
3825    set file [lindex $line 5]
3826    lappend treediff $file
3827}
3828
3829proc getblobdiffs {ids} {
3830    global diffopts blobdifffd diffids env curdifftag curtagstart
3831    global nextupdate diffinhdr treediffs
3832
3833    set env(GIT_DIFF_OPTS) $diffopts
3834    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3835    if {[catch {set bdf [open $cmd r]} err]} {
3836        puts "error getting diffs: $err"
3837        return
3838    }
3839    set diffinhdr 0
3840    fconfigure $bdf -blocking 0
3841    set blobdifffd($ids) $bdf
3842    set curdifftag Comments
3843    set curtagstart 0.0
3844    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3845    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3846}
3847
3848proc setinlist {var i val} {
3849    global $var
3850
3851    while {[llength [set $var]] < $i} {
3852        lappend $var {}
3853    }
3854    if {[llength [set $var]] == $i} {
3855        lappend $var $val
3856    } else {
3857        lset $var $i $val
3858    }
3859}
3860
3861proc getblobdiffline {bdf ids} {
3862    global diffids blobdifffd ctext curdifftag curtagstart
3863    global diffnexthead diffnextnote difffilestart
3864    global nextupdate diffinhdr treediffs
3865
3866    set n [gets $bdf line]
3867    if {$n < 0} {
3868        if {[eof $bdf]} {
3869            close $bdf
3870            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3871                $ctext tag add $curdifftag $curtagstart end
3872            }
3873        }
3874        return
3875    }
3876    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3877        return
3878    }
3879    $ctext conf -state normal
3880    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3881        # start of a new file
3882        $ctext insert end "\n"
3883        $ctext tag add $curdifftag $curtagstart end
3884        set here [$ctext index "end - 1c"]
3885        set curtagstart $here
3886        set header $newname
3887        set i [lsearch -exact $treediffs($ids) $fname]
3888        if {$i >= 0} {
3889            setinlist difffilestart $i $here
3890        }
3891        if {$newname ne $fname} {
3892            set i [lsearch -exact $treediffs($ids) $newname]
3893            if {$i >= 0} {
3894                setinlist difffilestart $i $here
3895            }
3896        }
3897        set curdifftag "f:$fname"
3898        $ctext tag delete $curdifftag
3899        set l [expr {(78 - [string length $header]) / 2}]
3900        set pad [string range "----------------------------------------" 1 $l]
3901        $ctext insert end "$pad $header $pad\n" filesep
3902        set diffinhdr 1
3903    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3904        # do nothing
3905    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3906        set diffinhdr 0
3907    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3908                   $line match f1l f1c f2l f2c rest]} {
3909        $ctext insert end "$line\n" hunksep
3910        set diffinhdr 0
3911    } else {
3912        set x [string range $line 0 0]
3913        if {$x == "-" || $x == "+"} {
3914            set tag [expr {$x == "+"}]
3915            $ctext insert end "$line\n" d$tag
3916        } elseif {$x == " "} {
3917            $ctext insert end "$line\n"
3918        } elseif {$diffinhdr || $x == "\\"} {
3919            # e.g. "\ No newline at end of file"
3920            $ctext insert end "$line\n" filesep
3921        } else {
3922            # Something else we don't recognize
3923            if {$curdifftag != "Comments"} {
3924                $ctext insert end "\n"
3925                $ctext tag add $curdifftag $curtagstart end
3926                set curtagstart [$ctext index "end - 1c"]
3927                set curdifftag Comments
3928            }
3929            $ctext insert end "$line\n" filesep
3930        }
3931    }
3932    $ctext conf -state disabled
3933    if {[clock clicks -milliseconds] >= $nextupdate} {
3934        incr nextupdate 100
3935        fileevent $bdf readable {}
3936        update
3937        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3938    }
3939}
3940
3941proc nextfile {} {
3942    global difffilestart ctext
3943    set here [$ctext index @0,0]
3944    foreach loc $difffilestart {
3945        if {[$ctext compare $loc > $here]} {
3946            $ctext yview $loc
3947        }
3948    }
3949}
3950
3951proc clear_ctext {{first 1.0}} {
3952    global ctext smarktop smarkbot
3953
3954    set l [lindex [split $first .] 0]
3955    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
3956        set smarktop $l
3957    }
3958    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
3959        set smarkbot $l
3960    }
3961    $ctext delete $first end
3962}
3963
3964proc incrsearch {name ix op} {
3965    global ctext searchstring searchdirn
3966
3967    $ctext tag remove found 1.0 end
3968    if {[catch {$ctext index anchor}]} {
3969        # no anchor set, use start of selection, or of visible area
3970        set sel [$ctext tag ranges sel]
3971        if {$sel ne {}} {
3972            $ctext mark set anchor [lindex $sel 0]
3973        } elseif {$searchdirn eq "-forwards"} {
3974            $ctext mark set anchor @0,0
3975        } else {
3976            $ctext mark set anchor @0,[winfo height $ctext]
3977        }
3978    }
3979    if {$searchstring ne {}} {
3980        set here [$ctext search $searchdirn -- $searchstring anchor]
3981        if {$here ne {}} {
3982            $ctext see $here
3983        }
3984        searchmarkvisible 1
3985    }
3986}
3987
3988proc dosearch {} {
3989    global sstring ctext searchstring searchdirn
3990
3991    focus $sstring
3992    $sstring icursor end
3993    set searchdirn -forwards
3994    if {$searchstring ne {}} {
3995        set sel [$ctext tag ranges sel]
3996        if {$sel ne {}} {
3997            set start "[lindex $sel 0] + 1c"
3998        } elseif {[catch {set start [$ctext index anchor]}]} {
3999            set start "@0,0"
4000        }
4001        set match [$ctext search -count mlen -- $searchstring $start]
4002        $ctext tag remove sel 1.0 end
4003        if {$match eq {}} {
4004            bell
4005            return
4006        }
4007        $ctext see $match
4008        set mend "$match + $mlen c"
4009        $ctext tag add sel $match $mend
4010        $ctext mark unset anchor
4011    }
4012}
4013
4014proc dosearchback {} {
4015    global sstring ctext searchstring searchdirn
4016
4017    focus $sstring
4018    $sstring icursor end
4019    set searchdirn -backwards
4020    if {$searchstring ne {}} {
4021        set sel [$ctext tag ranges sel]
4022        if {$sel ne {}} {
4023            set start [lindex $sel 0]
4024        } elseif {[catch {set start [$ctext index anchor]}]} {
4025            set start @0,[winfo height $ctext]
4026        }
4027        set match [$ctext search -backwards -count ml -- $searchstring $start]
4028        $ctext tag remove sel 1.0 end
4029        if {$match eq {}} {
4030            bell
4031            return
4032        }
4033        $ctext see $match
4034        set mend "$match + $ml c"
4035        $ctext tag add sel $match $mend
4036        $ctext mark unset anchor
4037    }
4038}
4039
4040proc searchmark {first last} {
4041    global ctext searchstring
4042
4043    set mend $first.0
4044    while {1} {
4045        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4046        if {$match eq {}} break
4047        set mend "$match + $mlen c"
4048        $ctext tag add found $match $mend
4049    }
4050}
4051
4052proc searchmarkvisible {doall} {
4053    global ctext smarktop smarkbot
4054
4055    set topline [lindex [split [$ctext index @0,0] .] 0]
4056    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4057    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4058        # no overlap with previous
4059        searchmark $topline $botline
4060        set smarktop $topline
4061        set smarkbot $botline
4062    } else {
4063        if {$topline < $smarktop} {
4064            searchmark $topline [expr {$smarktop-1}]
4065            set smarktop $topline
4066        }
4067        if {$botline > $smarkbot} {
4068            searchmark [expr {$smarkbot+1}] $botline
4069            set smarkbot $botline
4070        }
4071    }
4072}
4073
4074proc scrolltext {f0 f1} {
4075    global searchstring
4076
4077    .ctop.cdet.left.sb set $f0 $f1
4078    if {$searchstring ne {}} {
4079        searchmarkvisible 0
4080    }
4081}
4082
4083proc setcoords {} {
4084    global linespc charspc canvx0 canvy0 mainfont
4085    global xspc1 xspc2 lthickness
4086
4087    set linespc [font metrics $mainfont -linespace]
4088    set charspc [font measure $mainfont "m"]
4089    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4090    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4091    set lthickness [expr {int($linespc / 9) + 1}]
4092    set xspc1(0) $linespc
4093    set xspc2 $linespc
4094}
4095
4096proc redisplay {} {
4097    global canv
4098    global selectedline
4099
4100    set ymax [lindex [$canv cget -scrollregion] 3]
4101    if {$ymax eq {} || $ymax == 0} return
4102    set span [$canv yview]
4103    clear_display
4104    setcanvscroll
4105    allcanvs yview moveto [lindex $span 0]
4106    drawvisible
4107    if {[info exists selectedline]} {
4108        selectline $selectedline 0
4109    }
4110}
4111
4112proc incrfont {inc} {
4113    global mainfont textfont ctext canv phase
4114    global stopped entries
4115    unmarkmatches
4116    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4117    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4118    setcoords
4119    $ctext conf -font $textfont
4120    $ctext tag conf filesep -font [concat $textfont bold]
4121    foreach e $entries {
4122        $e conf -font $mainfont
4123    }
4124    if {$phase eq "getcommits"} {
4125        $canv itemconf textitems -font $mainfont
4126    }
4127    redisplay
4128}
4129
4130proc clearsha1 {} {
4131    global sha1entry sha1string
4132    if {[string length $sha1string] == 40} {
4133        $sha1entry delete 0 end
4134    }
4135}
4136
4137proc sha1change {n1 n2 op} {
4138    global sha1string currentid sha1but
4139    if {$sha1string == {}
4140        || ([info exists currentid] && $sha1string == $currentid)} {
4141        set state disabled
4142    } else {
4143        set state normal
4144    }
4145    if {[$sha1but cget -state] == $state} return
4146    if {$state == "normal"} {
4147        $sha1but conf -state normal -relief raised -text "Goto: "
4148    } else {
4149        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4150    }
4151}
4152
4153proc gotocommit {} {
4154    global sha1string currentid commitrow tagids headids
4155    global displayorder numcommits curview
4156
4157    if {$sha1string == {}
4158        || ([info exists currentid] && $sha1string == $currentid)} return
4159    if {[info exists tagids($sha1string)]} {
4160        set id $tagids($sha1string)
4161    } elseif {[info exists headids($sha1string)]} {
4162        set id $headids($sha1string)
4163    } else {
4164        set id [string tolower $sha1string]
4165        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4166            set matches {}
4167            foreach i $displayorder {
4168                if {[string match $id* $i]} {
4169                    lappend matches $i
4170                }
4171            }
4172            if {$matches ne {}} {
4173                if {[llength $matches] > 1} {
4174                    error_popup "Short SHA1 id $id is ambiguous"
4175                    return
4176                }
4177                set id [lindex $matches 0]
4178            }
4179        }
4180    }
4181    if {[info exists commitrow($curview,$id)]} {
4182        selectline $commitrow($curview,$id) 1
4183        return
4184    }
4185    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4186        set type "SHA1 id"
4187    } else {
4188        set type "Tag/Head"
4189    }
4190    error_popup "$type $sha1string is not known"
4191}
4192
4193proc lineenter {x y id} {
4194    global hoverx hovery hoverid hovertimer
4195    global commitinfo canv
4196
4197    if {![info exists commitinfo($id)] && ![getcommit $id]} return
4198    set hoverx $x
4199    set hovery $y
4200    set hoverid $id
4201    if {[info exists hovertimer]} {
4202        after cancel $hovertimer
4203    }
4204    set hovertimer [after 500 linehover]
4205    $canv delete hover
4206}
4207
4208proc linemotion {x y id} {
4209    global hoverx hovery hoverid hovertimer
4210
4211    if {[info exists hoverid] && $id == $hoverid} {
4212        set hoverx $x
4213        set hovery $y
4214        if {[info exists hovertimer]} {
4215            after cancel $hovertimer
4216        }
4217        set hovertimer [after 500 linehover]
4218    }
4219}
4220
4221proc lineleave {id} {
4222    global hoverid hovertimer canv
4223
4224    if {[info exists hoverid] && $id == $hoverid} {
4225        $canv delete hover
4226        if {[info exists hovertimer]} {
4227            after cancel $hovertimer
4228            unset hovertimer
4229        }
4230        unset hoverid
4231    }
4232}
4233
4234proc linehover {} {
4235    global hoverx hovery hoverid hovertimer
4236    global canv linespc lthickness
4237    global commitinfo mainfont
4238
4239    set text [lindex $commitinfo($hoverid) 0]
4240    set ymax [lindex [$canv cget -scrollregion] 3]
4241    if {$ymax == {}} return
4242    set yfrac [lindex [$canv yview] 0]
4243    set x [expr {$hoverx + 2 * $linespc}]
4244    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4245    set x0 [expr {$x - 2 * $lthickness}]
4246    set y0 [expr {$y - 2 * $lthickness}]
4247    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4248    set y1 [expr {$y + $linespc + 2 * $lthickness}]
4249    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4250               -fill \#ffff80 -outline black -width 1 -tags hover]
4251    $canv raise $t
4252    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4253    $canv raise $t
4254}
4255
4256proc clickisonarrow {id y} {
4257    global lthickness
4258
4259    set ranges [rowranges $id]
4260    set thresh [expr {2 * $lthickness + 6}]
4261    set n [expr {[llength $ranges] - 1}]
4262    for {set i 1} {$i < $n} {incr i} {
4263        set row [lindex $ranges $i]
4264        if {abs([yc $row] - $y) < $thresh} {
4265            return $i
4266        }
4267    }
4268    return {}
4269}
4270
4271proc arrowjump {id n y} {
4272    global canv
4273
4274    # 1 <-> 2, 3 <-> 4, etc...
4275    set n [expr {(($n - 1) ^ 1) + 1}]
4276    set row [lindex [rowranges $id] $n]
4277    set yt [yc $row]
4278    set ymax [lindex [$canv cget -scrollregion] 3]
4279    if {$ymax eq {} || $ymax <= 0} return
4280    set view [$canv yview]
4281    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4282    set yfrac [expr {$yt / $ymax - $yspan / 2}]
4283    if {$yfrac < 0} {
4284        set yfrac 0
4285    }
4286    allcanvs yview moveto $yfrac
4287}
4288
4289proc lineclick {x y id isnew} {
4290    global ctext commitinfo children canv thickerline curview
4291
4292    if {![info exists commitinfo($id)] && ![getcommit $id]} return
4293    unmarkmatches
4294    unselectline
4295    normalline
4296    $canv delete hover
4297    # draw this line thicker than normal
4298    set thickerline $id
4299    drawlines $id
4300    if {$isnew} {
4301        set ymax [lindex [$canv cget -scrollregion] 3]
4302        if {$ymax eq {}} return
4303        set yfrac [lindex [$canv yview] 0]
4304        set y [expr {$y + $yfrac * $ymax}]
4305    }
4306    set dirn [clickisonarrow $id $y]
4307    if {$dirn ne {}} {
4308        arrowjump $id $dirn $y
4309        return
4310    }
4311
4312    if {$isnew} {
4313        addtohistory [list lineclick $x $y $id 0]
4314    }
4315    # fill the details pane with info about this line
4316    $ctext conf -state normal
4317    clear_ctext
4318    $ctext tag conf link -foreground blue -underline 1
4319    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4320    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4321    $ctext insert end "Parent:\t"
4322    $ctext insert end $id [list link link0]
4323    $ctext tag bind link0 <1> [list selbyid $id]
4324    set info $commitinfo($id)
4325    $ctext insert end "\n\t[lindex $info 0]\n"
4326    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4327    set date [formatdate [lindex $info 2]]
4328    $ctext insert end "\tDate:\t$date\n"
4329    set kids $children($curview,$id)
4330    if {$kids ne {}} {
4331        $ctext insert end "\nChildren:"
4332        set i 0
4333        foreach child $kids {
4334            incr i
4335            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4336            set info $commitinfo($child)
4337            $ctext insert end "\n\t"
4338            $ctext insert end $child [list link link$i]
4339            $ctext tag bind link$i <1> [list selbyid $child]
4340            $ctext insert end "\n\t[lindex $info 0]"
4341            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4342            set date [formatdate [lindex $info 2]]
4343            $ctext insert end "\n\tDate:\t$date\n"
4344        }
4345    }
4346    $ctext conf -state disabled
4347    init_flist {}
4348}
4349
4350proc normalline {} {
4351    global thickerline
4352    if {[info exists thickerline]} {
4353        set id $thickerline
4354        unset thickerline
4355        drawlines $id
4356    }
4357}
4358
4359proc selbyid {id} {
4360    global commitrow curview
4361    if {[info exists commitrow($curview,$id)]} {
4362        selectline $commitrow($curview,$id) 1
4363    }
4364}
4365
4366proc mstime {} {
4367    global startmstime
4368    if {![info exists startmstime]} {
4369        set startmstime [clock clicks -milliseconds]
4370    }
4371    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4372}
4373
4374proc rowmenu {x y id} {
4375    global rowctxmenu commitrow selectedline rowmenuid curview
4376
4377    if {![info exists selectedline]
4378        || $commitrow($curview,$id) eq $selectedline} {
4379        set state disabled
4380    } else {
4381        set state normal
4382    }
4383    $rowctxmenu entryconfigure 0 -state $state
4384    $rowctxmenu entryconfigure 1 -state $state
4385    $rowctxmenu entryconfigure 2 -state $state
4386    set rowmenuid $id
4387    tk_popup $rowctxmenu $x $y
4388}
4389
4390proc diffvssel {dirn} {
4391    global rowmenuid selectedline displayorder
4392
4393    if {![info exists selectedline]} return
4394    if {$dirn} {
4395        set oldid [lindex $displayorder $selectedline]
4396        set newid $rowmenuid
4397    } else {
4398        set oldid $rowmenuid
4399        set newid [lindex $displayorder $selectedline]
4400    }
4401    addtohistory [list doseldiff $oldid $newid]
4402    doseldiff $oldid $newid
4403}
4404
4405proc doseldiff {oldid newid} {
4406    global ctext
4407    global commitinfo
4408
4409    $ctext conf -state normal
4410    clear_ctext
4411    init_flist "Top"
4412    $ctext insert end "From "
4413    $ctext tag conf link -foreground blue -underline 1
4414    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4415    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4416    $ctext tag bind link0 <1> [list selbyid $oldid]
4417    $ctext insert end $oldid [list link link0]
4418    $ctext insert end "\n     "
4419    $ctext insert end [lindex $commitinfo($oldid) 0]
4420    $ctext insert end "\n\nTo   "
4421    $ctext tag bind link1 <1> [list selbyid $newid]
4422    $ctext insert end $newid [list link link1]
4423    $ctext insert end "\n     "
4424    $ctext insert end [lindex $commitinfo($newid) 0]
4425    $ctext insert end "\n"
4426    $ctext conf -state disabled
4427    $ctext tag delete Comments
4428    $ctext tag remove found 1.0 end
4429    startdiff [list $oldid $newid]
4430}
4431
4432proc mkpatch {} {
4433    global rowmenuid currentid commitinfo patchtop patchnum
4434
4435    if {![info exists currentid]} return
4436    set oldid $currentid
4437    set oldhead [lindex $commitinfo($oldid) 0]
4438    set newid $rowmenuid
4439    set newhead [lindex $commitinfo($newid) 0]
4440    set top .patch
4441    set patchtop $top
4442    catch {destroy $top}
4443    toplevel $top
4444    label $top.title -text "Generate patch"
4445    grid $top.title - -pady 10
4446    label $top.from -text "From:"
4447    entry $top.fromsha1 -width 40 -relief flat
4448    $top.fromsha1 insert 0 $oldid
4449    $top.fromsha1 conf -state readonly
4450    grid $top.from $top.fromsha1 -sticky w
4451    entry $top.fromhead -width 60 -relief flat
4452    $top.fromhead insert 0 $oldhead
4453    $top.fromhead conf -state readonly
4454    grid x $top.fromhead -sticky w
4455    label $top.to -text "To:"
4456    entry $top.tosha1 -width 40 -relief flat
4457    $top.tosha1 insert 0 $newid
4458    $top.tosha1 conf -state readonly
4459    grid $top.to $top.tosha1 -sticky w
4460    entry $top.tohead -width 60 -relief flat
4461    $top.tohead insert 0 $newhead
4462    $top.tohead conf -state readonly
4463    grid x $top.tohead -sticky w
4464    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4465    grid $top.rev x -pady 10
4466    label $top.flab -text "Output file:"
4467    entry $top.fname -width 60
4468    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4469    incr patchnum
4470    grid $top.flab $top.fname -sticky w
4471    frame $top.buts
4472    button $top.buts.gen -text "Generate" -command mkpatchgo
4473    button $top.buts.can -text "Cancel" -command mkpatchcan
4474    grid $top.buts.gen $top.buts.can
4475    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4476    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4477    grid $top.buts - -pady 10 -sticky ew
4478    focus $top.fname
4479}
4480
4481proc mkpatchrev {} {
4482    global patchtop
4483
4484    set oldid [$patchtop.fromsha1 get]
4485    set oldhead [$patchtop.fromhead get]
4486    set newid [$patchtop.tosha1 get]
4487    set newhead [$patchtop.tohead get]
4488    foreach e [list fromsha1 fromhead tosha1 tohead] \
4489            v [list $newid $newhead $oldid $oldhead] {
4490        $patchtop.$e conf -state normal
4491        $patchtop.$e delete 0 end
4492        $patchtop.$e insert 0 $v
4493        $patchtop.$e conf -state readonly
4494    }
4495}
4496
4497proc mkpatchgo {} {
4498    global patchtop
4499
4500    set oldid [$patchtop.fromsha1 get]
4501    set newid [$patchtop.tosha1 get]
4502    set fname [$patchtop.fname get]
4503    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4504        error_popup "Error creating patch: $err"
4505    }
4506    catch {destroy $patchtop}
4507    unset patchtop
4508}
4509
4510proc mkpatchcan {} {
4511    global patchtop
4512
4513    catch {destroy $patchtop}
4514    unset patchtop
4515}
4516
4517proc mktag {} {
4518    global rowmenuid mktagtop commitinfo
4519
4520    set top .maketag
4521    set mktagtop $top
4522    catch {destroy $top}
4523    toplevel $top
4524    label $top.title -text "Create tag"
4525    grid $top.title - -pady 10
4526    label $top.id -text "ID:"
4527    entry $top.sha1 -width 40 -relief flat
4528    $top.sha1 insert 0 $rowmenuid
4529    $top.sha1 conf -state readonly
4530    grid $top.id $top.sha1 -sticky w
4531    entry $top.head -width 60 -relief flat
4532    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4533    $top.head conf -state readonly
4534    grid x $top.head -sticky w
4535    label $top.tlab -text "Tag name:"
4536    entry $top.tag -width 60
4537    grid $top.tlab $top.tag -sticky w
4538    frame $top.buts
4539    button $top.buts.gen -text "Create" -command mktaggo
4540    button $top.buts.can -text "Cancel" -command mktagcan
4541    grid $top.buts.gen $top.buts.can
4542    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4543    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4544    grid $top.buts - -pady 10 -sticky ew
4545    focus $top.tag
4546}
4547
4548proc domktag {} {
4549    global mktagtop env tagids idtags
4550
4551    set id [$mktagtop.sha1 get]
4552    set tag [$mktagtop.tag get]
4553    if {$tag == {}} {
4554        error_popup "No tag name specified"
4555        return
4556    }
4557    if {[info exists tagids($tag)]} {
4558        error_popup "Tag \"$tag\" already exists"
4559        return
4560    }
4561    if {[catch {
4562        set dir [gitdir]
4563        set fname [file join $dir "refs/tags" $tag]
4564        set f [open $fname w]
4565        puts $f $id
4566        close $f
4567    } err]} {
4568        error_popup "Error creating tag: $err"
4569        return
4570    }
4571
4572    set tagids($tag) $id
4573    lappend idtags($id) $tag
4574    redrawtags $id
4575}
4576
4577proc redrawtags {id} {
4578    global canv linehtag commitrow idpos selectedline curview
4579
4580    if {![info exists commitrow($curview,$id)]} return
4581    drawcmitrow $commitrow($curview,$id)
4582    $canv delete tag.$id
4583    set xt [eval drawtags $id $idpos($id)]
4584    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4585    if {[info exists selectedline]
4586        && $selectedline == $commitrow($curview,$id)} {
4587        selectline $selectedline 0
4588    }
4589}
4590
4591proc mktagcan {} {
4592    global mktagtop
4593
4594    catch {destroy $mktagtop}
4595    unset mktagtop
4596}
4597
4598proc mktaggo {} {
4599    domktag
4600    mktagcan
4601}
4602
4603proc writecommit {} {
4604    global rowmenuid wrcomtop commitinfo wrcomcmd
4605
4606    set top .writecommit
4607    set wrcomtop $top
4608    catch {destroy $top}
4609    toplevel $top
4610    label $top.title -text "Write commit to file"
4611    grid $top.title - -pady 10
4612    label $top.id -text "ID:"
4613    entry $top.sha1 -width 40 -relief flat
4614    $top.sha1 insert 0 $rowmenuid
4615    $top.sha1 conf -state readonly
4616    grid $top.id $top.sha1 -sticky w
4617    entry $top.head -width 60 -relief flat
4618    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4619    $top.head conf -state readonly
4620    grid x $top.head -sticky w
4621    label $top.clab -text "Command:"
4622    entry $top.cmd -width 60 -textvariable wrcomcmd
4623    grid $top.clab $top.cmd -sticky w -pady 10
4624    label $top.flab -text "Output file:"
4625    entry $top.fname -width 60
4626    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4627    grid $top.flab $top.fname -sticky w
4628    frame $top.buts
4629    button $top.buts.gen -text "Write" -command wrcomgo
4630    button $top.buts.can -text "Cancel" -command wrcomcan
4631    grid $top.buts.gen $top.buts.can
4632    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4633    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4634    grid $top.buts - -pady 10 -sticky ew
4635    focus $top.fname
4636}
4637
4638proc wrcomgo {} {
4639    global wrcomtop
4640
4641    set id [$wrcomtop.sha1 get]
4642    set cmd "echo $id | [$wrcomtop.cmd get]"
4643    set fname [$wrcomtop.fname get]
4644    if {[catch {exec sh -c $cmd >$fname &} err]} {
4645        error_popup "Error writing commit: $err"
4646    }
4647    catch {destroy $wrcomtop}
4648    unset wrcomtop
4649}
4650
4651proc wrcomcan {} {
4652    global wrcomtop
4653
4654    catch {destroy $wrcomtop}
4655    unset wrcomtop
4656}
4657
4658proc listrefs {id} {
4659    global idtags idheads idotherrefs
4660
4661    set x {}
4662    if {[info exists idtags($id)]} {
4663        set x $idtags($id)
4664    }
4665    set y {}
4666    if {[info exists idheads($id)]} {
4667        set y $idheads($id)
4668    }
4669    set z {}
4670    if {[info exists idotherrefs($id)]} {
4671        set z $idotherrefs($id)
4672    }
4673    return [list $x $y $z]
4674}
4675
4676proc rereadrefs {} {
4677    global idtags idheads idotherrefs
4678
4679    set refids [concat [array names idtags] \
4680                    [array names idheads] [array names idotherrefs]]
4681    foreach id $refids {
4682        if {![info exists ref($id)]} {
4683            set ref($id) [listrefs $id]
4684        }
4685    }
4686    readrefs
4687    set refids [lsort -unique [concat $refids [array names idtags] \
4688                        [array names idheads] [array names idotherrefs]]]
4689    foreach id $refids {
4690        set v [listrefs $id]
4691        if {![info exists ref($id)] || $ref($id) != $v} {
4692            redrawtags $id
4693        }
4694    }
4695}
4696
4697proc showtag {tag isnew} {
4698    global ctext tagcontents tagids linknum
4699
4700    if {$isnew} {
4701        addtohistory [list showtag $tag 0]
4702    }
4703    $ctext conf -state normal
4704    clear_ctext
4705    set linknum 0
4706    if {[info exists tagcontents($tag)]} {
4707        set text $tagcontents($tag)
4708    } else {
4709        set text "Tag: $tag\nId:  $tagids($tag)"
4710    }
4711    appendwithlinks $text
4712    $ctext conf -state disabled
4713    init_flist {}
4714}
4715
4716proc doquit {} {
4717    global stopped
4718    set stopped 100
4719    destroy .
4720}
4721
4722proc doprefs {} {
4723    global maxwidth maxgraphpct diffopts
4724    global oldprefs prefstop
4725
4726    set top .gitkprefs
4727    set prefstop $top
4728    if {[winfo exists $top]} {
4729        raise $top
4730        return
4731    }
4732    foreach v {maxwidth maxgraphpct diffopts} {
4733        set oldprefs($v) [set $v]
4734    }
4735    toplevel $top
4736    wm title $top "Gitk preferences"
4737    label $top.ldisp -text "Commit list display options"
4738    grid $top.ldisp - -sticky w -pady 10
4739    label $top.spacer -text " "
4740    label $top.maxwidthl -text "Maximum graph width (lines)" \
4741        -font optionfont
4742    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4743    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4744    label $top.maxpctl -text "Maximum graph width (% of pane)" \
4745        -font optionfont
4746    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4747    grid x $top.maxpctl $top.maxpct -sticky w
4748    label $top.ddisp -text "Diff display options"
4749    grid $top.ddisp - -sticky w -pady 10
4750    label $top.diffoptl -text "Options for diff program" \
4751        -font optionfont
4752    entry $top.diffopt -width 20 -textvariable diffopts
4753    grid x $top.diffoptl $top.diffopt -sticky w
4754    frame $top.buts
4755    button $top.buts.ok -text "OK" -command prefsok
4756    button $top.buts.can -text "Cancel" -command prefscan
4757    grid $top.buts.ok $top.buts.can
4758    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4759    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4760    grid $top.buts - - -pady 10 -sticky ew
4761}
4762
4763proc prefscan {} {
4764    global maxwidth maxgraphpct diffopts
4765    global oldprefs prefstop
4766
4767    foreach v {maxwidth maxgraphpct diffopts} {
4768        set $v $oldprefs($v)
4769    }
4770    catch {destroy $prefstop}
4771    unset prefstop
4772}
4773
4774proc prefsok {} {
4775    global maxwidth maxgraphpct
4776    global oldprefs prefstop
4777
4778    catch {destroy $prefstop}
4779    unset prefstop
4780    if {$maxwidth != $oldprefs(maxwidth)
4781        || $maxgraphpct != $oldprefs(maxgraphpct)} {
4782        redisplay
4783    }
4784}
4785
4786proc formatdate {d} {
4787    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4788}
4789
4790# This list of encoding names and aliases is distilled from
4791# http://www.iana.org/assignments/character-sets.
4792# Not all of them are supported by Tcl.
4793set encoding_aliases {
4794    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4795      ISO646-US US-ASCII us IBM367 cp367 csASCII }
4796    { ISO-10646-UTF-1 csISO10646UTF1 }
4797    { ISO_646.basic:1983 ref csISO646basic1983 }
4798    { INVARIANT csINVARIANT }
4799    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4800    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4801    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4802    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4803    { NATS-DANO iso-ir-9-1 csNATSDANO }
4804    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4805    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4806    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4807    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4808    { ISO-2022-KR csISO2022KR }
4809    { EUC-KR csEUCKR }
4810    { ISO-2022-JP csISO2022JP }
4811    { ISO-2022-JP-2 csISO2022JP2 }
4812    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4813      csISO13JISC6220jp }
4814    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4815    { IT iso-ir-15 ISO646-IT csISO15Italian }
4816    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4817    { ES iso-ir-17 ISO646-ES csISO17Spanish }
4818    { greek7-old iso-ir-18 csISO18Greek7Old }
4819    { latin-greek iso-ir-19 csISO19LatinGreek }
4820    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4821    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4822    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4823    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4824    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4825    { BS_viewdata iso-ir-47 csISO47BSViewdata }
4826    { INIS iso-ir-49 csISO49INIS }
4827    { INIS-8 iso-ir-50 csISO50INIS8 }
4828    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4829    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4830    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4831    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4832    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4833    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4834      csISO60Norwegian1 }
4835    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4836    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4837    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4838    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4839    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4840    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4841    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4842    { greek7 iso-ir-88 csISO88Greek7 }
4843    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4844    { iso-ir-90 csISO90 }
4845    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4846    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4847      csISO92JISC62991984b }
4848    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4849    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4850    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4851      csISO95JIS62291984handadd }
4852    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4853    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4854    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4855    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4856      CP819 csISOLatin1 }
4857    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4858    { T.61-7bit iso-ir-102 csISO102T617bit }
4859    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4860    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4861    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4862    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4863    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4864    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4865    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4866    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4867      arabic csISOLatinArabic }
4868    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4869    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4870    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4871      greek greek8 csISOLatinGreek }
4872    { T.101-G2 iso-ir-128 csISO128T101G2 }
4873    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4874      csISOLatinHebrew }
4875    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4876    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4877    { CSN_369103 iso-ir-139 csISO139CSN369103 }
4878    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4879    { ISO_6937-2-add iso-ir-142 csISOTextComm }
4880    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4881    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4882      csISOLatinCyrillic }
4883    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4884    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4885    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4886    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4887    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4888    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4889    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4890    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4891    { ISO_10367-box iso-ir-155 csISO10367Box }
4892    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4893    { latin-lap lap iso-ir-158 csISO158Lap }
4894    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4895    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4896    { us-dk csUSDK }
4897    { dk-us csDKUS }
4898    { JIS_X0201 X0201 csHalfWidthKatakana }
4899    { KSC5636 ISO646-KR csKSC5636 }
4900    { ISO-10646-UCS-2 csUnicode }
4901    { ISO-10646-UCS-4 csUCS4 }
4902    { DEC-MCS dec csDECMCS }
4903    { hp-roman8 roman8 r8 csHPRoman8 }
4904    { macintosh mac csMacintosh }
4905    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4906      csIBM037 }
4907    { IBM038 EBCDIC-INT cp038 csIBM038 }
4908    { IBM273 CP273 csIBM273 }
4909    { IBM274 EBCDIC-BE CP274 csIBM274 }
4910    { IBM275 EBCDIC-BR cp275 csIBM275 }
4911    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4912    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4913    { IBM280 CP280 ebcdic-cp-it csIBM280 }
4914    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4915    { IBM284 CP284 ebcdic-cp-es csIBM284 }
4916    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4917    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4918    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4919    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4920    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4921    { IBM424 cp424 ebcdic-cp-he csIBM424 }
4922    { IBM437 cp437 437 csPC8CodePage437 }
4923    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4924    { IBM775 cp775 csPC775Baltic }
4925    { IBM850 cp850 850 csPC850Multilingual }
4926    { IBM851 cp851 851 csIBM851 }
4927    { IBM852 cp852 852 csPCp852 }
4928    { IBM855 cp855 855 csIBM855 }
4929    { IBM857 cp857 857 csIBM857 }
4930    { IBM860 cp860 860 csIBM860 }
4931    { IBM861 cp861 861 cp-is csIBM861 }
4932    { IBM862 cp862 862 csPC862LatinHebrew }
4933    { IBM863 cp863 863 csIBM863 }
4934    { IBM864 cp864 csIBM864 }
4935    { IBM865 cp865 865 csIBM865 }
4936    { IBM866 cp866 866 csIBM866 }
4937    { IBM868 CP868 cp-ar csIBM868 }
4938    { IBM869 cp869 869 cp-gr csIBM869 }
4939    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4940    { IBM871 CP871 ebcdic-cp-is csIBM871 }
4941    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4942    { IBM891 cp891 csIBM891 }
4943    { IBM903 cp903 csIBM903 }
4944    { IBM904 cp904 904 csIBBM904 }
4945    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4946    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4947    { IBM1026 CP1026 csIBM1026 }
4948    { EBCDIC-AT-DE csIBMEBCDICATDE }
4949    { EBCDIC-AT-DE-A csEBCDICATDEA }
4950    { EBCDIC-CA-FR csEBCDICCAFR }
4951    { EBCDIC-DK-NO csEBCDICDKNO }
4952    { EBCDIC-DK-NO-A csEBCDICDKNOA }
4953    { EBCDIC-FI-SE csEBCDICFISE }
4954    { EBCDIC-FI-SE-A csEBCDICFISEA }
4955    { EBCDIC-FR csEBCDICFR }
4956    { EBCDIC-IT csEBCDICIT }
4957    { EBCDIC-PT csEBCDICPT }
4958    { EBCDIC-ES csEBCDICES }
4959    { EBCDIC-ES-A csEBCDICESA }
4960    { EBCDIC-ES-S csEBCDICESS }
4961    { EBCDIC-UK csEBCDICUK }
4962    { EBCDIC-US csEBCDICUS }
4963    { UNKNOWN-8BIT csUnknown8BiT }
4964    { MNEMONIC csMnemonic }
4965    { MNEM csMnem }
4966    { VISCII csVISCII }
4967    { VIQR csVIQR }
4968    { KOI8-R csKOI8R }
4969    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4970    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4971    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4972    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4973    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4974    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4975    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4976    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4977    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4978    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4979    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4980    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4981    { IBM1047 IBM-1047 }
4982    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4983    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4984    { UNICODE-1-1 csUnicode11 }
4985    { CESU-8 csCESU-8 }
4986    { BOCU-1 csBOCU-1 }
4987    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4988    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4989      l8 }
4990    { ISO-8859-15 ISO_8859-15 Latin-9 }
4991    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4992    { GBK CP936 MS936 windows-936 }
4993    { JIS_Encoding csJISEncoding }
4994    { Shift_JIS MS_Kanji csShiftJIS }
4995    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4996      EUC-JP }
4997    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4998    { ISO-10646-UCS-Basic csUnicodeASCII }
4999    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5000    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5001    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5002    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5003    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5004    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5005    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5006    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5007    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5008    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5009    { Adobe-Standard-Encoding csAdobeStandardEncoding }
5010    { Ventura-US csVenturaUS }
5011    { Ventura-International csVenturaInternational }
5012    { PC8-Danish-Norwegian csPC8DanishNorwegian }
5013    { PC8-Turkish csPC8Turkish }
5014    { IBM-Symbols csIBMSymbols }
5015    { IBM-Thai csIBMThai }
5016    { HP-Legal csHPLegal }
5017    { HP-Pi-font csHPPiFont }
5018    { HP-Math8 csHPMath8 }
5019    { Adobe-Symbol-Encoding csHPPSMath }
5020    { HP-DeskTop csHPDesktop }
5021    { Ventura-Math csVenturaMath }
5022    { Microsoft-Publishing csMicrosoftPublishing }
5023    { Windows-31J csWindows31J }
5024    { GB2312 csGB2312 }
5025    { Big5 csBig5 }
5026}
5027
5028proc tcl_encoding {enc} {
5029    global encoding_aliases
5030    set names [encoding names]
5031    set lcnames [string tolower $names]
5032    set enc [string tolower $enc]
5033    set i [lsearch -exact $lcnames $enc]
5034    if {$i < 0} {
5035        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5036        if {[regsub {^iso[-_]} $enc iso encx]} {
5037            set i [lsearch -exact $lcnames $encx]
5038        }
5039    }
5040    if {$i < 0} {
5041        foreach l $encoding_aliases {
5042            set ll [string tolower $l]
5043            if {[lsearch -exact $ll $enc] < 0} continue
5044            # look through the aliases for one that tcl knows about
5045            foreach e $ll {
5046                set i [lsearch -exact $lcnames $e]
5047                if {$i < 0} {
5048                    if {[regsub {^iso[-_]} $e iso ex]} {
5049                        set i [lsearch -exact $lcnames $ex]
5050                    }
5051                }
5052                if {$i >= 0} break
5053            }
5054            break
5055        }
5056    }
5057    if {$i >= 0} {
5058        return [lindex $names $i]
5059    }
5060    return {}
5061}
5062
5063# defaults...
5064set datemode 0
5065set diffopts "-U 5 -p"
5066set wrcomcmd "git-diff-tree --stdin -p --pretty"
5067
5068set gitencoding {}
5069catch {
5070    set gitencoding [exec git-repo-config --get i18n.commitencoding]
5071}
5072if {$gitencoding == ""} {
5073    set gitencoding "utf-8"
5074}
5075set tclencoding [tcl_encoding $gitencoding]
5076if {$tclencoding == {}} {
5077    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5078}
5079
5080set mainfont {Helvetica 9}
5081set textfont {Courier 9}
5082set uifont {Helvetica 9 bold}
5083set findmergefiles 0
5084set maxgraphpct 50
5085set maxwidth 16
5086set revlistorder 0
5087set fastdate 0
5088set uparrowlen 7
5089set downarrowlen 7
5090set mingaplen 30
5091set cmitmode "patch"
5092
5093set colors {green red blue magenta darkgrey brown orange}
5094
5095catch {source ~/.gitk}
5096
5097font create optionfont -family sans-serif -size -12
5098
5099set revtreeargs {}
5100foreach arg $argv {
5101    switch -regexp -- $arg {
5102        "^$" { }
5103        "^-d" { set datemode 1 }
5104        default {
5105            lappend revtreeargs $arg
5106        }
5107    }
5108}
5109
5110# check that we can find a .git directory somewhere...
5111set gitdir [gitdir]
5112if {![file isdirectory $gitdir]} {
5113    show_error . "Cannot find the git directory \"$gitdir\"."
5114    exit 1
5115}
5116
5117set cmdline_files {}
5118set i [lsearch -exact $revtreeargs "--"]
5119if {$i >= 0} {
5120    set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5121    set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5122} elseif {$revtreeargs ne {}} {
5123    if {[catch {
5124        set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5125        set cmdline_files [split $f "\n"]
5126        set n [llength $cmdline_files]
5127        set revtreeargs [lrange $revtreeargs 0 end-$n]
5128    } err]} {
5129        # unfortunately we get both stdout and stderr in $err,
5130        # so look for "fatal:".
5131        set i [string first "fatal:" $err]
5132        if {$i > 0} {
5133            set err [string range [expr {$i + 6}] end]
5134        }
5135        show_error . "Bad arguments to gitk:\n$err"
5136        exit 1
5137    }
5138}
5139
5140set history {}
5141set historyindex 0
5142set fh_serial 0
5143set nhl_names {}
5144set highlight_paths {}
5145set searchdirn -forwards
5146
5147set optim_delay 16
5148
5149set nextviewnum 1
5150set curview 0
5151set selectedview 0
5152set selectedhlview None
5153set viewfiles(0) {}
5154set viewperm(0) 0
5155set viewargs(0) {}
5156
5157set cmdlineok 0
5158set stopped 0
5159set stuffsaved 0
5160set patchnum 0
5161setcoords
5162makewindow
5163readrefs
5164
5165if {$cmdline_files ne {} || $revtreeargs ne {}} {
5166    # create a view for the files/dirs specified on the command line
5167    set curview 1
5168    set selectedview 1
5169    set nextviewnum 2
5170    set viewname(1) "Command line"
5171    set viewfiles(1) $cmdline_files
5172    set viewargs(1) $revtreeargs
5173    set viewperm(1) 0
5174    addviewmenu 1
5175    .bar.view entryconf 2 -state normal
5176    .bar.view entryconf 3 -state normal
5177}
5178
5179if {[info exists permviews]} {
5180    foreach v $permviews {
5181        set n $nextviewnum
5182        incr nextviewnum
5183        set viewname($n) [lindex $v 0]
5184        set viewfiles($n) [lindex $v 1]
5185        set viewargs($n) [lindex $v 2]
5186        set viewperm($n) 1
5187        addviewmenu $n
5188    }
5189}
5190getcommits