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