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