gitk

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