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