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