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