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