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