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