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