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