gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  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 pending_select
3267
3268     if {$commitidx($curview) > 0} {
3269         drawrest
3270     } else {
3271         show_status "No commits selected"
3272     }
3273     set phase {}
3274     catch {unset pending_select}
3275 }
3276
3277 # Don't change the text pane cursor if it is currently the hand cursor,
3278 # showing that we are over a sha1 ID link.
3279 proc settextcursor {c} {
3280     global ctext curtextcursor
3281
3282     if {[$ctext cget -cursor] == $curtextcursor} {
3283         $ctext config -cursor $c
3284     }
3285     set curtextcursor $c
3286 }
3287
3288 proc nowbusy {what} {
3289     global isbusy
3290
3291     if {[array names isbusy] eq {}} {
3292         . config -cursor watch
3293         settextcursor watch
3294     }
3295     set isbusy($what) 1
3296 }
3297
3298 proc notbusy {what} {
3299     global isbusy maincursor textcursor
3300
3301     catch {unset isbusy($what)}
3302     if {[array names isbusy] eq {}} {
3303         . config -cursor $maincursor
3304         settextcursor $textcursor
3305     }
3306 }
3307
3308 proc drawrest {} {
3309     global startmsecs
3310     global rowlaidout commitidx curview
3311     global pending_select
3312
3313     set row $rowlaidout
3314     layoutrows $rowlaidout $commitidx($curview) 1
3315     layouttail
3316     optimize_rows $row 0 $commitidx($curview)
3317     showstuff $commitidx($curview)
3318     if {[info exists pending_select]} {
3319         selectline 0 1
3320     }
3321
3322     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3323     #global numcommits
3324     #puts "overall $drawmsecs ms for $numcommits commits"
3325 }
3326
3327 proc findmatches {f} {
3328     global findtype foundstring foundstrlen
3329     if {$findtype == "Regexp"} {
3330         set matches [regexp -indices -all -inline $foundstring $f]
3331     } else {
3332         if {$findtype == "IgnCase"} {
3333             set str [string tolower $f]
3334         } else {
3335             set str $f
3336         }
3337         set matches {}
3338         set i 0
3339         while {[set j [string first $foundstring $str $i]] >= 0} {
3340             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3341             set i [expr {$j + $foundstrlen}]
3342         }
3343     }
3344     return $matches
3345 }
3346
3347 proc dofind {} {
3348     global findtype findloc findstring markedmatches commitinfo
3349     global numcommits displayorder linehtag linentag linedtag
3350     global mainfont canv canv2 canv3 selectedline
3351     global matchinglines foundstring foundstrlen matchstring
3352     global commitdata
3353
3354     stopfindproc
3355     unmarkmatches
3356     cancel_next_highlight
3357     focus .
3358     set matchinglines {}
3359     if {$findtype == "IgnCase"} {
3360         set foundstring [string tolower $findstring]
3361     } else {
3362         set foundstring $findstring
3363     }
3364     set foundstrlen [string length $findstring]
3365     if {$foundstrlen == 0} return
3366     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3367     set matchstring "*$matchstring*"
3368     if {![info exists selectedline]} {
3369         set oldsel -1
3370     } else {
3371         set oldsel $selectedline
3372     }
3373     set didsel 0
3374     set fldtypes {Headline Author Date Committer CDate Comments}
3375     set l -1
3376     foreach id $displayorder {
3377         set d $commitdata($id)
3378         incr l
3379         if {$findtype == "Regexp"} {
3380             set doesmatch [regexp $foundstring $d]
3381         } elseif {$findtype == "IgnCase"} {
3382             set doesmatch [string match -nocase $matchstring $d]
3383         } else {
3384             set doesmatch [string match $matchstring $d]
3385         }
3386         if {!$doesmatch} continue
3387         if {![info exists commitinfo($id)]} {
3388             getcommit $id
3389         }
3390         set info $commitinfo($id)
3391         set doesmatch 0
3392         foreach f $info ty $fldtypes {
3393             if {$findloc != "All fields" && $findloc != $ty} {
3394                 continue
3395             }
3396             set matches [findmatches $f]
3397             if {$matches == {}} continue
3398             set doesmatch 1
3399             if {$ty == "Headline"} {
3400                 drawcmitrow $l
3401                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3402             } elseif {$ty == "Author"} {
3403                 drawcmitrow $l
3404                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3405             } elseif {$ty == "Date"} {
3406                 drawcmitrow $l
3407                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3408             }
3409         }
3410         if {$doesmatch} {
3411             lappend matchinglines $l
3412             if {!$didsel && $l > $oldsel} {
3413                 findselectline $l
3414                 set didsel 1
3415             }
3416         }
3417     }
3418     if {$matchinglines == {}} {
3419         bell
3420     } elseif {!$didsel} {
3421         findselectline [lindex $matchinglines 0]
3422     }
3423 }
3424
3425 proc findselectline {l} {
3426     global findloc commentend ctext
3427     selectline $l 1
3428     if {$findloc == "All fields" || $findloc == "Comments"} {
3429         # highlight the matches in the comments
3430         set f [$ctext get 1.0 $commentend]
3431         set matches [findmatches $f]
3432         foreach match $matches {
3433             set start [lindex $match 0]
3434             set end [expr {[lindex $match 1] + 1}]
3435             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3436         }
3437     }
3438 }
3439
3440 proc findnext {restart} {
3441     global matchinglines selectedline
3442     if {![info exists matchinglines]} {
3443         if {$restart} {
3444             dofind
3445         }
3446         return
3447     }
3448     if {![info exists selectedline]} return
3449     foreach l $matchinglines {
3450         if {$l > $selectedline} {
3451             findselectline $l
3452             return
3453         }
3454     }
3455     bell
3456 }
3457
3458 proc findprev {} {
3459     global matchinglines selectedline
3460     if {![info exists matchinglines]} {
3461         dofind
3462         return
3463     }
3464     if {![info exists selectedline]} return
3465     set prev {}
3466     foreach l $matchinglines {
3467         if {$l >= $selectedline} break
3468         set prev $l
3469     }
3470     if {$prev != {}} {
3471         findselectline $prev
3472     } else {
3473         bell
3474     }
3475 }
3476
3477 proc stopfindproc {{done 0}} {
3478     global findprocpid findprocfile findids
3479     global ctext findoldcursor phase maincursor textcursor
3480     global findinprogress
3481
3482     catch {unset findids}
3483     if {[info exists findprocpid]} {
3484         if {!$done} {
3485             catch {exec kill $findprocpid}
3486         }
3487         catch {close $findprocfile}
3488         unset findprocpid
3489     }
3490     catch {unset findinprogress}
3491     notbusy find
3492 }
3493
3494 # mark a commit as matching by putting a yellow background
3495 # behind the headline
3496 proc markheadline {l id} {
3497     global canv mainfont linehtag
3498
3499     drawcmitrow $l
3500     set bbox [$canv bbox $linehtag($l)]
3501     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3502     $canv lower $t
3503 }
3504
3505 # mark the bits of a headline, author or date that match a find string
3506 proc markmatches {canv l str tag matches font} {
3507     set bbox [$canv bbox $tag]
3508     set x0 [lindex $bbox 0]
3509     set y0 [lindex $bbox 1]
3510     set y1 [lindex $bbox 3]
3511     foreach match $matches {
3512         set start [lindex $match 0]
3513         set end [lindex $match 1]
3514         if {$start > $end} continue
3515         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3516         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3517         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3518                    [expr {$x0+$xlen+2}] $y1 \
3519                    -outline {} -tags matches -fill yellow]
3520         $canv lower $t
3521     }
3522 }
3523
3524 proc unmarkmatches {} {
3525     global matchinglines findids
3526     allcanvs delete matches
3527     catch {unset matchinglines}
3528     catch {unset findids}
3529 }
3530
3531 proc selcanvline {w x y} {
3532     global canv canvy0 ctext linespc
3533     global rowtextx
3534     set ymax [lindex [$canv cget -scrollregion] 3]
3535     if {$ymax == {}} return
3536     set yfrac [lindex [$canv yview] 0]
3537     set y [expr {$y + $yfrac * $ymax}]
3538     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3539     if {$l < 0} {
3540         set l 0
3541     }
3542     if {$w eq $canv} {
3543         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3544     }
3545     unmarkmatches
3546     selectline $l 1
3547 }
3548
3549 proc commit_descriptor {p} {
3550     global commitinfo
3551     if {![info exists commitinfo($p)]} {
3552         getcommit $p
3553     }
3554     set l "..."
3555     if {[llength $commitinfo($p)] > 1} {
3556         set l [lindex $commitinfo($p) 0]
3557     }
3558     return "$p ($l)\n"
3559 }
3560
3561 # append some text to the ctext widget, and make any SHA1 ID
3562 # that we know about be a clickable link.
3563 proc appendwithlinks {text tags} {
3564     global ctext commitrow linknum curview
3565
3566     set start [$ctext index "end - 1c"]
3567     $ctext insert end $text $tags
3568     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3569     foreach l $links {
3570         set s [lindex $l 0]
3571         set e [lindex $l 1]
3572         set linkid [string range $text $s $e]
3573         if {![info exists commitrow($curview,$linkid)]} continue
3574         incr e
3575         $ctext tag add link "$start + $s c" "$start + $e c"
3576         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3577         $ctext tag bind link$linknum <1> \
3578             [list selectline $commitrow($curview,$linkid) 1]
3579         incr linknum
3580     }
3581     $ctext tag conf link -foreground blue -underline 1
3582     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3583     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3584 }
3585
3586 proc viewnextline {dir} {
3587     global canv linespc
3588
3589     $canv delete hover
3590     set ymax [lindex [$canv cget -scrollregion] 3]
3591     set wnow [$canv yview]
3592     set wtop [expr {[lindex $wnow 0] * $ymax}]
3593     set newtop [expr {$wtop + $dir * $linespc}]
3594     if {$newtop < 0} {
3595         set newtop 0
3596     } elseif {$newtop > $ymax} {
3597         set newtop $ymax
3598     }
3599     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3600 }
3601
3602 # add a list of tag or branch names at position pos
3603 # returns the number of names inserted
3604 proc appendrefs {pos l var} {
3605     global ctext commitrow linknum curview idtags $var
3606
3607     if {[catch {$ctext index $pos}]} {
3608         return 0
3609     }
3610     set tags {}
3611     foreach id $l {
3612         foreach tag [set $var\($id\)] {
3613             lappend tags [concat $tag $id]
3614         }
3615     }
3616     set tags [lsort -index 1 $tags]
3617     set sep {}
3618     foreach tag $tags {
3619         set name [lindex $tag 0]
3620         set id [lindex $tag 1]
3621         set lk link$linknum
3622         incr linknum
3623         $ctext insert $pos $sep
3624         $ctext insert $pos $name $lk
3625         $ctext tag conf $lk -foreground blue
3626         if {[info exists commitrow($curview,$id)]} {
3627             $ctext tag bind $lk <1> \
3628                 [list selectline $commitrow($curview,$id) 1]
3629             $ctext tag conf $lk -underline 1
3630             $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3631             $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3632         }
3633         set sep ", "
3634     }
3635     return [llength $tags]
3636 }
3637
3638 # called when we have finished computing the nearby tags
3639 proc dispneartags {} {
3640     global selectedline currentid ctext anc_tags desc_tags showneartags
3641     global desc_heads
3642
3643     if {![info exists selectedline] || !$showneartags} return
3644     set id $currentid
3645     $ctext conf -state normal
3646     if {[info exists desc_heads($id)]} {
3647         if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3648             $ctext insert "branch -2c" "es"
3649         }
3650     }
3651     if {[info exists anc_tags($id)]} {
3652         appendrefs follows $anc_tags($id) idtags
3653     }
3654     if {[info exists desc_tags($id)]} {
3655         appendrefs precedes $desc_tags($id) idtags
3656     }
3657     $ctext conf -state disabled
3658 }
3659
3660 proc selectline {l isnew} {
3661     global canv canv2 canv3 ctext commitinfo selectedline
3662     global displayorder linehtag linentag linedtag
3663     global canvy0 linespc parentlist childlist
3664     global currentid sha1entry
3665     global commentend idtags linknum
3666     global mergemax numcommits pending_select
3667     global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3668
3669     catch {unset pending_select}
3670     $canv delete hover
3671     normalline
3672     cancel_next_highlight
3673     if {$l < 0 || $l >= $numcommits} return
3674     set y [expr {$canvy0 + $l * $linespc}]
3675     set ymax [lindex [$canv cget -scrollregion] 3]
3676     set ytop [expr {$y - $linespc - 1}]
3677     set ybot [expr {$y + $linespc + 1}]
3678     set wnow [$canv yview]
3679     set wtop [expr {[lindex $wnow 0] * $ymax}]
3680     set wbot [expr {[lindex $wnow 1] * $ymax}]
3681     set wh [expr {$wbot - $wtop}]
3682     set newtop $wtop
3683     if {$ytop < $wtop} {
3684         if {$ybot < $wtop} {
3685             set newtop [expr {$y - $wh / 2.0}]
3686         } else {
3687             set newtop $ytop
3688             if {$newtop > $wtop - $linespc} {
3689                 set newtop [expr {$wtop - $linespc}]
3690             }
3691         }
3692     } elseif {$ybot > $wbot} {
3693         if {$ytop > $wbot} {
3694             set newtop [expr {$y - $wh / 2.0}]
3695         } else {
3696             set newtop [expr {$ybot - $wh}]
3697             if {$newtop < $wtop + $linespc} {
3698                 set newtop [expr {$wtop + $linespc}]
3699             }
3700         }
3701     }
3702     if {$newtop != $wtop} {
3703         if {$newtop < 0} {
3704             set newtop 0
3705         }
3706         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3707         drawvisible
3708     }
3709
3710     if {![info exists linehtag($l)]} return
3711     $canv delete secsel
3712     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3713                -tags secsel -fill [$canv cget -selectbackground]]
3714     $canv lower $t
3715     $canv2 delete secsel
3716     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3717                -tags secsel -fill [$canv2 cget -selectbackground]]
3718     $canv2 lower $t
3719     $canv3 delete secsel
3720     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3721                -tags secsel -fill [$canv3 cget -selectbackground]]
3722     $canv3 lower $t
3723
3724     if {$isnew} {
3725         addtohistory [list selectline $l 0]
3726     }
3727
3728     set selectedline $l
3729
3730     set id [lindex $displayorder $l]
3731     set currentid $id
3732     $sha1entry delete 0 end
3733     $sha1entry insert 0 $id
3734     $sha1entry selection from 0
3735     $sha1entry selection to end
3736     rhighlight_sel $id
3737
3738     $ctext conf -state normal
3739     clear_ctext
3740     set linknum 0
3741     set info $commitinfo($id)
3742     set date [formatdate [lindex $info 2]]
3743     $ctext insert end "Author: [lindex $info 1]  $date\n"
3744     set date [formatdate [lindex $info 4]]
3745     $ctext insert end "Committer: [lindex $info 3]  $date\n"
3746     if {[info exists idtags($id)]} {
3747         $ctext insert end "Tags:"
3748         foreach tag $idtags($id) {
3749             $ctext insert end " $tag"
3750         }
3751         $ctext insert end "\n"
3752     }
3753
3754     set headers {}
3755     set olds [lindex $parentlist $l]
3756     if {[llength $olds] > 1} {
3757         set np 0
3758         foreach p $olds {
3759             if {$np >= $mergemax} {
3760                 set tag mmax
3761             } else {
3762                 set tag m$np
3763             }
3764             $ctext insert end "Parent: " $tag
3765             appendwithlinks [commit_descriptor $p] {}
3766             incr np
3767         }
3768     } else {
3769         foreach p $olds {
3770             append headers "Parent: [commit_descriptor $p]"
3771         }
3772     }
3773
3774     foreach c [lindex $childlist $l] {
3775         append headers "Child:  [commit_descriptor $c]"
3776     }
3777
3778     # make anything that looks like a SHA1 ID be a clickable link
3779     appendwithlinks $headers {}
3780     if {$showneartags} {
3781         if {![info exists allcommits]} {
3782             getallcommits
3783         }
3784         $ctext insert end "Branch: "
3785         $ctext mark set branch "end -1c"
3786         $ctext mark gravity branch left
3787         if {[info exists desc_heads($id)]} {
3788             if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3789                 # turn "Branch" into "Branches"
3790                 $ctext insert "branch -2c" "es"
3791             }
3792         }
3793         $ctext insert end "\nFollows: "
3794         $ctext mark set follows "end -1c"
3795         $ctext mark gravity follows left
3796         if {[info exists anc_tags($id)]} {
3797             appendrefs follows $anc_tags($id) idtags
3798         }
3799         $ctext insert end "\nPrecedes: "
3800         $ctext mark set precedes "end -1c"
3801         $ctext mark gravity precedes left
3802         if {[info exists desc_tags($id)]} {
3803             appendrefs precedes $desc_tags($id) idtags
3804         }
3805         $ctext insert end "\n"
3806     }
3807     $ctext insert end "\n"
3808     appendwithlinks [lindex $info 5] {comment}
3809
3810     $ctext tag delete Comments
3811     $ctext tag remove found 1.0 end
3812     $ctext conf -state disabled
3813     set commentend [$ctext index "end - 1c"]
3814
3815     init_flist "Comments"
3816     if {$cmitmode eq "tree"} {
3817         gettree $id
3818     } elseif {[llength $olds] <= 1} {
3819         startdiff $id
3820     } else {
3821         mergediff $id $l
3822     }
3823 }
3824
3825 proc selfirstline {} {
3826     unmarkmatches
3827     selectline 0 1
3828 }
3829
3830 proc sellastline {} {
3831     global numcommits
3832     unmarkmatches
3833     set l [expr {$numcommits - 1}]
3834     selectline $l 1
3835 }
3836
3837 proc selnextline {dir} {
3838     global selectedline
3839     if {![info exists selectedline]} return
3840     set l [expr {$selectedline + $dir}]
3841     unmarkmatches
3842     selectline $l 1
3843 }
3844
3845 proc selnextpage {dir} {
3846     global canv linespc selectedline numcommits
3847
3848     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3849     if {$lpp < 1} {
3850         set lpp 1
3851     }
3852     allcanvs yview scroll [expr {$dir * $lpp}] units
3853     drawvisible
3854     if {![info exists selectedline]} return
3855     set l [expr {$selectedline + $dir * $lpp}]
3856     if {$l < 0} {
3857         set l 0
3858     } elseif {$l >= $numcommits} {
3859         set l [expr $numcommits - 1]
3860     }
3861     unmarkmatches
3862     selectline $l 1
3863 }
3864
3865 proc unselectline {} {
3866     global selectedline currentid
3867
3868     catch {unset selectedline}
3869     catch {unset currentid}
3870     allcanvs delete secsel
3871     rhighlight_none
3872     cancel_next_highlight
3873 }
3874
3875 proc reselectline {} {
3876     global selectedline
3877
3878     if {[info exists selectedline]} {
3879         selectline $selectedline 0
3880     }
3881 }
3882
3883 proc addtohistory {cmd} {
3884     global history historyindex curview
3885
3886     set elt [list $curview $cmd]
3887     if {$historyindex > 0
3888         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3889         return
3890     }
3891
3892     if {$historyindex < [llength $history]} {
3893         set history [lreplace $history $historyindex end $elt]
3894     } else {
3895         lappend history $elt
3896     }
3897     incr historyindex
3898     if {$historyindex > 1} {
3899         .ctop.top.bar.leftbut conf -state normal
3900     } else {
3901         .ctop.top.bar.leftbut conf -state disabled
3902     }
3903     .ctop.top.bar.rightbut conf -state disabled
3904 }
3905
3906 proc godo {elt} {
3907     global curview
3908
3909     set view [lindex $elt 0]
3910     set cmd [lindex $elt 1]
3911     if {$curview != $view} {
3912         showview $view
3913     }
3914     eval $cmd
3915 }
3916
3917 proc goback {} {
3918     global history historyindex
3919
3920     if {$historyindex > 1} {
3921         incr historyindex -1
3922         godo [lindex $history [expr {$historyindex - 1}]]
3923         .ctop.top.bar.rightbut conf -state normal
3924     }
3925     if {$historyindex <= 1} {
3926         .ctop.top.bar.leftbut conf -state disabled
3927     }
3928 }
3929
3930 proc goforw {} {
3931     global history historyindex
3932
3933     if {$historyindex < [llength $history]} {
3934         set cmd [lindex $history $historyindex]
3935         incr historyindex
3936         godo $cmd
3937         .ctop.top.bar.leftbut conf -state normal
3938     }
3939     if {$historyindex >= [llength $history]} {
3940         .ctop.top.bar.rightbut conf -state disabled
3941     }
3942 }
3943
3944 proc gettree {id} {
3945     global treefilelist treeidlist diffids diffmergeid treepending
3946
3947     set diffids $id
3948     catch {unset diffmergeid}
3949     if {![info exists treefilelist($id)]} {
3950         if {![info exists treepending]} {
3951             if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3952                 return
3953             }
3954             set treepending $id
3955             set treefilelist($id) {}
3956             set treeidlist($id) {}
3957             fconfigure $gtf -blocking 0
3958             fileevent $gtf readable [list gettreeline $gtf $id]
3959         }
3960     } else {
3961         setfilelist $id
3962     }
3963 }
3964
3965 proc gettreeline {gtf id} {
3966     global treefilelist treeidlist treepending cmitmode diffids
3967
3968     while {[gets $gtf line] >= 0} {
3969         if {[lindex $line 1] ne "blob"} continue
3970         set sha1 [lindex $line 2]
3971         set fname [lindex $line 3]
3972         lappend treefilelist($id) $fname
3973         lappend treeidlist($id) $sha1
3974     }
3975     if {![eof $gtf]} return
3976     close $gtf
3977     unset treepending
3978     if {$cmitmode ne "tree"} {
3979         if {![info exists diffmergeid]} {
3980             gettreediffs $diffids
3981         }
3982     } elseif {$id ne $diffids} {
3983         gettree $diffids
3984     } else {
3985         setfilelist $id
3986     }
3987 }
3988
3989 proc showfile {f} {
3990     global treefilelist treeidlist diffids
3991     global ctext commentend
3992
3993     set i [lsearch -exact $treefilelist($diffids) $f]
3994     if {$i < 0} {
3995         puts "oops, $f not in list for id $diffids"
3996         return
3997     }
3998     set blob [lindex $treeidlist($diffids) $i]
3999     if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4000         puts "oops, error reading blob $blob: $err"
4001         return
4002     }
4003     fconfigure $bf -blocking 0
4004     fileevent $bf readable [list getblobline $bf $diffids]
4005     $ctext config -state normal
4006     clear_ctext $commentend
4007     $ctext insert end "\n"
4008     $ctext insert end "$f\n" filesep
4009     $ctext config -state disabled
4010     $ctext yview $commentend
4011 }
4012
4013 proc getblobline {bf id} {
4014     global diffids cmitmode ctext
4015
4016     if {$id ne $diffids || $cmitmode ne "tree"} {
4017         catch {close $bf}
4018         return
4019     }
4020     $ctext config -state normal
4021     while {[gets $bf line] >= 0} {
4022         $ctext insert end "$line\n"
4023     }
4024     if {[eof $bf]} {
4025         # delete last newline
4026         $ctext delete "end - 2c" "end - 1c"
4027         close $bf
4028     }
4029     $ctext config -state disabled
4030 }
4031
4032 proc mergediff {id l} {
4033     global diffmergeid diffopts mdifffd
4034     global diffids
4035     global parentlist
4036
4037     set diffmergeid $id
4038     set diffids $id
4039     # this doesn't seem to actually affect anything...
4040     set env(GIT_DIFF_OPTS) $diffopts
4041     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4042     if {[catch {set mdf [open $cmd r]} err]} {
4043         error_popup "Error getting merge diffs: $err"
4044         return
4045     }
4046     fconfigure $mdf -blocking 0
4047     set mdifffd($id) $mdf
4048     set np [llength [lindex $parentlist $l]]
4049     fileevent $mdf readable [list getmergediffline $mdf $id $np]
4050     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4051 }
4052
4053 proc getmergediffline {mdf id np} {
4054     global diffmergeid ctext cflist nextupdate mergemax
4055     global difffilestart mdifffd
4056
4057     set n [gets $mdf line]
4058     if {$n < 0} {
4059         if {[eof $mdf]} {
4060             close $mdf
4061         }
4062         return
4063     }
4064     if {![info exists diffmergeid] || $id != $diffmergeid
4065         || $mdf != $mdifffd($id)} {
4066         return
4067     }
4068     $ctext conf -state normal
4069     if {[regexp {^diff --cc (.*)} $line match fname]} {
4070         # start of a new file
4071         $ctext insert end "\n"
4072         set here [$ctext index "end - 1c"]
4073         lappend difffilestart $here
4074         add_flist [list $fname]
4075         set l [expr {(78 - [string length $fname]) / 2}]
4076         set pad [string range "----------------------------------------" 1 $l]
4077         $ctext insert end "$pad $fname $pad\n" filesep
4078     } elseif {[regexp {^@@} $line]} {
4079         $ctext insert end "$line\n" hunksep
4080     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4081         # do nothing
4082     } else {
4083         # parse the prefix - one ' ', '-' or '+' for each parent
4084         set spaces {}
4085         set minuses {}
4086         set pluses {}
4087         set isbad 0
4088         for {set j 0} {$j < $np} {incr j} {
4089             set c [string range $line $j $j]
4090             if {$c == " "} {
4091                 lappend spaces $j
4092             } elseif {$c == "-"} {
4093                 lappend minuses $j
4094             } elseif {$c == "+"} {
4095                 lappend pluses $j
4096             } else {
4097                 set isbad 1
4098                 break
4099             }
4100         }
4101         set tags {}
4102         set num {}
4103         if {!$isbad && $minuses ne {} && $pluses eq {}} {
4104             # line doesn't appear in result, parents in $minuses have the line
4105             set num [lindex $minuses 0]
4106         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4107             # line appears in result, parents in $pluses don't have the line
4108             lappend tags mresult
4109             set num [lindex $spaces 0]
4110         }
4111         if {$num ne {}} {
4112             if {$num >= $mergemax} {
4113                 set num "max"
4114             }
4115             lappend tags m$num
4116         }
4117         $ctext insert end "$line\n" $tags
4118     }
4119     $ctext conf -state disabled
4120     if {[clock clicks -milliseconds] >= $nextupdate} {
4121         incr nextupdate 100
4122         fileevent $mdf readable {}
4123         update
4124         fileevent $mdf readable [list getmergediffline $mdf $id $np]
4125     }
4126 }
4127
4128 proc startdiff {ids} {
4129     global treediffs diffids treepending diffmergeid
4130
4131     set diffids $ids
4132     catch {unset diffmergeid}
4133     if {![info exists treediffs($ids)]} {
4134         if {![info exists treepending]} {
4135             gettreediffs $ids
4136         }
4137     } else {
4138         addtocflist $ids
4139     }
4140 }
4141
4142 proc addtocflist {ids} {
4143     global treediffs cflist
4144     add_flist $treediffs($ids)
4145     getblobdiffs $ids
4146 }
4147
4148 proc gettreediffs {ids} {
4149     global treediff treepending
4150     set treepending $ids
4151     set treediff {}
4152     if {[catch \
4153          {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4154         ]} return
4155     fconfigure $gdtf -blocking 0
4156     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4157 }
4158
4159 proc gettreediffline {gdtf ids} {
4160     global treediff treediffs treepending diffids diffmergeid
4161     global cmitmode
4162
4163     set n [gets $gdtf line]
4164     if {$n < 0} {
4165         if {![eof $gdtf]} return
4166         close $gdtf
4167         set treediffs($ids) $treediff
4168         unset treepending
4169         if {$cmitmode eq "tree"} {
4170             gettree $diffids
4171         } elseif {$ids != $diffids} {
4172             if {![info exists diffmergeid]} {
4173                 gettreediffs $diffids
4174             }
4175         } else {
4176             addtocflist $ids
4177         }
4178         return
4179     }
4180     set file [lindex $line 5]
4181     lappend treediff $file
4182 }
4183
4184 proc getblobdiffs {ids} {
4185     global diffopts blobdifffd diffids env curdifftag curtagstart
4186     global nextupdate diffinhdr treediffs
4187
4188     set env(GIT_DIFF_OPTS) $diffopts
4189     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4190     if {[catch {set bdf [open $cmd r]} err]} {
4191         puts "error getting diffs: $err"
4192         return
4193     }
4194     set diffinhdr 0
4195     fconfigure $bdf -blocking 0
4196     set blobdifffd($ids) $bdf
4197     set curdifftag Comments
4198     set curtagstart 0.0
4199     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4200     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4201 }
4202
4203 proc setinlist {var i val} {
4204     global $var
4205
4206     while {[llength [set $var]] < $i} {
4207         lappend $var {}
4208     }
4209     if {[llength [set $var]] == $i} {
4210         lappend $var $val
4211     } else {
4212         lset $var $i $val
4213     }
4214 }
4215
4216 proc getblobdiffline {bdf ids} {
4217     global diffids blobdifffd ctext curdifftag curtagstart
4218     global diffnexthead diffnextnote difffilestart
4219     global nextupdate diffinhdr treediffs
4220
4221     set n [gets $bdf line]
4222     if {$n < 0} {
4223         if {[eof $bdf]} {
4224             close $bdf
4225             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4226                 $ctext tag add $curdifftag $curtagstart end
4227             }
4228         }
4229         return
4230     }
4231     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4232         return
4233     }
4234     $ctext conf -state normal
4235     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4236         # start of a new file
4237         $ctext insert end "\n"
4238         $ctext tag add $curdifftag $curtagstart end
4239         set here [$ctext index "end - 1c"]
4240         set curtagstart $here
4241         set header $newname
4242         set i [lsearch -exact $treediffs($ids) $fname]
4243         if {$i >= 0} {
4244             setinlist difffilestart $i $here
4245         }
4246         if {$newname ne $fname} {
4247             set i [lsearch -exact $treediffs($ids) $newname]
4248             if {$i >= 0} {
4249                 setinlist difffilestart $i $here
4250             }
4251         }
4252         set curdifftag "f:$fname"
4253         $ctext tag delete $curdifftag
4254         set l [expr {(78 - [string length $header]) / 2}]
4255         set pad [string range "----------------------------------------" 1 $l]
4256         $ctext insert end "$pad $header $pad\n" filesep
4257         set diffinhdr 1
4258     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4259         # do nothing
4260     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4261         set diffinhdr 0
4262     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4263                    $line match f1l f1c f2l f2c rest]} {
4264         $ctext insert end "$line\n" hunksep
4265         set diffinhdr 0
4266     } else {
4267         set x [string range $line 0 0]
4268         if {$x == "-" || $x == "+"} {
4269             set tag [expr {$x == "+"}]
4270             $ctext insert end "$line\n" d$tag
4271         } elseif {$x == " "} {
4272             $ctext insert end "$line\n"
4273         } elseif {$diffinhdr || $x == "\\"} {
4274             # e.g. "\ No newline at end of file"
4275             $ctext insert end "$line\n" filesep
4276         } else {
4277             # Something else we don't recognize
4278             if {$curdifftag != "Comments"} {
4279                 $ctext insert end "\n"
4280                 $ctext tag add $curdifftag $curtagstart end
4281                 set curtagstart [$ctext index "end - 1c"]
4282                 set curdifftag Comments
4283             }
4284             $ctext insert end "$line\n" filesep
4285         }
4286     }
4287     $ctext conf -state disabled
4288     if {[clock clicks -milliseconds] >= $nextupdate} {
4289         incr nextupdate 100
4290         fileevent $bdf readable {}
4291         update
4292         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4293     }
4294 }
4295
4296 proc nextfile {} {
4297     global difffilestart ctext
4298     set here [$ctext index @0,0]
4299     foreach loc $difffilestart {
4300         if {[$ctext compare $loc > $here]} {
4301             $ctext yview $loc
4302         }
4303     }
4304 }
4305
4306 proc clear_ctext {{first 1.0}} {
4307     global ctext smarktop smarkbot
4308
4309     set l [lindex [split $first .] 0]
4310     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4311         set smarktop $l
4312     }
4313     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4314         set smarkbot $l
4315     }
4316     $ctext delete $first end
4317 }
4318
4319 proc incrsearch {name ix op} {
4320     global ctext searchstring searchdirn
4321
4322     $ctext tag remove found 1.0 end
4323     if {[catch {$ctext index anchor}]} {
4324         # no anchor set, use start of selection, or of visible area
4325         set sel [$ctext tag ranges sel]
4326         if {$sel ne {}} {
4327             $ctext mark set anchor [lindex $sel 0]
4328         } elseif {$searchdirn eq "-forwards"} {
4329             $ctext mark set anchor @0,0
4330         } else {
4331             $ctext mark set anchor @0,[winfo height $ctext]
4332         }
4333     }
4334     if {$searchstring ne {}} {
4335         set here [$ctext search $searchdirn -- $searchstring anchor]
4336         if {$here ne {}} {
4337             $ctext see $here
4338         }
4339         searchmarkvisible 1
4340     }
4341 }
4342
4343 proc dosearch {} {
4344     global sstring ctext searchstring searchdirn
4345
4346     focus $sstring
4347     $sstring icursor end
4348     set searchdirn -forwards
4349     if {$searchstring ne {}} {
4350         set sel [$ctext tag ranges sel]
4351         if {$sel ne {}} {
4352             set start "[lindex $sel 0] + 1c"
4353         } elseif {[catch {set start [$ctext index anchor]}]} {
4354             set start "@0,0"
4355         }
4356         set match [$ctext search -count mlen -- $searchstring $start]
4357         $ctext tag remove sel 1.0 end
4358         if {$match eq {}} {
4359             bell
4360             return
4361         }
4362         $ctext see $match
4363         set mend "$match + $mlen c"
4364         $ctext tag add sel $match $mend
4365         $ctext mark unset anchor
4366     }
4367 }
4368
4369 proc dosearchback {} {
4370     global sstring ctext searchstring searchdirn
4371
4372     focus $sstring
4373     $sstring icursor end
4374     set searchdirn -backwards
4375     if {$searchstring ne {}} {
4376         set sel [$ctext tag ranges sel]
4377         if {$sel ne {}} {
4378             set start [lindex $sel 0]
4379         } elseif {[catch {set start [$ctext index anchor]}]} {
4380             set start @0,[winfo height $ctext]
4381         }
4382         set match [$ctext search -backwards -count ml -- $searchstring $start]
4383         $ctext tag remove sel 1.0 end
4384         if {$match eq {}} {
4385             bell
4386             return
4387         }
4388         $ctext see $match
4389         set mend "$match + $ml c"
4390         $ctext tag add sel $match $mend
4391         $ctext mark unset anchor
4392     }
4393 }
4394
4395 proc searchmark {first last} {
4396     global ctext searchstring
4397
4398     set mend $first.0
4399     while {1} {
4400         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4401         if {$match eq {}} break
4402         set mend "$match + $mlen c"
4403         $ctext tag add found $match $mend
4404     }
4405 }
4406
4407 proc searchmarkvisible {doall} {
4408     global ctext smarktop smarkbot
4409
4410     set topline [lindex [split [$ctext index @0,0] .] 0]
4411     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4412     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4413         # no overlap with previous
4414         searchmark $topline $botline
4415         set smarktop $topline
4416         set smarkbot $botline
4417     } else {
4418         if {$topline < $smarktop} {
4419             searchmark $topline [expr {$smarktop-1}]
4420             set smarktop $topline
4421         }
4422         if {$botline > $smarkbot} {
4423             searchmark [expr {$smarkbot+1}] $botline
4424             set smarkbot $botline
4425         }
4426     }
4427 }
4428
4429 proc scrolltext {f0 f1} {
4430     global searchstring
4431
4432     .ctop.cdet.left.sb set $f0 $f1
4433     if {$searchstring ne {}} {
4434         searchmarkvisible 0
4435     }
4436 }
4437
4438 proc setcoords {} {
4439     global linespc charspc canvx0 canvy0 mainfont
4440     global xspc1 xspc2 lthickness
4441
4442     set linespc [font metrics $mainfont -linespace]
4443     set charspc [font measure $mainfont "m"]
4444     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4445     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4446     set lthickness [expr {int($linespc / 9) + 1}]
4447     set xspc1(0) $linespc
4448     set xspc2 $linespc
4449 }
4450
4451 proc redisplay {} {
4452     global canv
4453     global selectedline
4454
4455     set ymax [lindex [$canv cget -scrollregion] 3]
4456     if {$ymax eq {} || $ymax == 0} return
4457     set span [$canv yview]
4458     clear_display
4459     setcanvscroll
4460     allcanvs yview moveto [lindex $span 0]
4461     drawvisible
4462     if {[info exists selectedline]} {
4463         selectline $selectedline 0
4464     }
4465 }
4466
4467 proc incrfont {inc} {
4468     global mainfont textfont ctext canv phase
4469     global stopped entries
4470     unmarkmatches
4471     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4472     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4473     setcoords
4474     $ctext conf -font $textfont
4475     $ctext tag conf filesep -font [concat $textfont bold]
4476     foreach e $entries {
4477         $e conf -font $mainfont
4478     }
4479     if {$phase eq "getcommits"} {
4480         $canv itemconf textitems -font $mainfont
4481     }
4482     redisplay
4483 }
4484
4485 proc clearsha1 {} {
4486     global sha1entry sha1string
4487     if {[string length $sha1string] == 40} {
4488         $sha1entry delete 0 end
4489     }
4490 }
4491
4492 proc sha1change {n1 n2 op} {
4493     global sha1string currentid sha1but
4494     if {$sha1string == {}
4495         || ([info exists currentid] && $sha1string == $currentid)} {
4496         set state disabled
4497     } else {
4498         set state normal
4499     }
4500     if {[$sha1but cget -state] == $state} return
4501     if {$state == "normal"} {
4502         $sha1but conf -state normal -relief raised -text "Goto: "
4503     } else {
4504         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4505     }
4506 }
4507
4508 proc gotocommit {} {
4509     global sha1string currentid commitrow tagids headids
4510     global displayorder numcommits curview
4511
4512     if {$sha1string == {}
4513         || ([info exists currentid] && $sha1string == $currentid)} return
4514     if {[info exists tagids($sha1string)]} {
4515         set id $tagids($sha1string)
4516     } elseif {[info exists headids($sha1string)]} {
4517         set id $headids($sha1string)
4518     } else {
4519         set id [string tolower $sha1string]
4520         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4521             set matches {}
4522             foreach i $displayorder {
4523                 if {[string match $id* $i]} {
4524                     lappend matches $i
4525                 }
4526             }
4527             if {$matches ne {}} {
4528                 if {[llength $matches] > 1} {
4529                     error_popup "Short SHA1 id $id is ambiguous"
4530                     return
4531                 }
4532                 set id [lindex $matches 0]
4533             }
4534         }
4535     }
4536     if {[info exists commitrow($curview,$id)]} {
4537         selectline $commitrow($curview,$id) 1
4538         return
4539     }
4540     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4541         set type "SHA1 id"
4542     } else {
4543         set type "Tag/Head"
4544     }
4545     error_popup "$type $sha1string is not known"
4546 }
4547
4548 proc lineenter {x y id} {
4549     global hoverx hovery hoverid hovertimer
4550     global commitinfo canv
4551
4552     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4553     set hoverx $x
4554     set hovery $y
4555     set hoverid $id
4556     if {[info exists hovertimer]} {
4557         after cancel $hovertimer
4558     }
4559     set hovertimer [after 500 linehover]
4560     $canv delete hover
4561 }
4562
4563 proc linemotion {x y id} {
4564     global hoverx hovery hoverid hovertimer
4565
4566     if {[info exists hoverid] && $id == $hoverid} {
4567         set hoverx $x
4568         set hovery $y
4569         if {[info exists hovertimer]} {
4570             after cancel $hovertimer
4571         }
4572         set hovertimer [after 500 linehover]
4573     }
4574 }
4575
4576 proc lineleave {id} {
4577     global hoverid hovertimer canv
4578
4579     if {[info exists hoverid] && $id == $hoverid} {
4580         $canv delete hover
4581         if {[info exists hovertimer]} {
4582             after cancel $hovertimer
4583             unset hovertimer
4584         }
4585         unset hoverid
4586     }
4587 }
4588
4589 proc linehover {} {
4590     global hoverx hovery hoverid hovertimer
4591     global canv linespc lthickness
4592     global commitinfo mainfont
4593
4594     set text [lindex $commitinfo($hoverid) 0]
4595     set ymax [lindex [$canv cget -scrollregion] 3]
4596     if {$ymax == {}} return
4597     set yfrac [lindex [$canv yview] 0]
4598     set x [expr {$hoverx + 2 * $linespc}]
4599     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4600     set x0 [expr {$x - 2 * $lthickness}]
4601     set y0 [expr {$y - 2 * $lthickness}]
4602     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4603     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4604     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4605                -fill \#ffff80 -outline black -width 1 -tags hover]
4606     $canv raise $t
4607     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4608                -font $mainfont]
4609     $canv raise $t
4610 }
4611
4612 proc clickisonarrow {id y} {
4613     global lthickness
4614
4615     set ranges [rowranges $id]
4616     set thresh [expr {2 * $lthickness + 6}]
4617     set n [expr {[llength $ranges] - 1}]
4618     for {set i 1} {$i < $n} {incr i} {
4619         set row [lindex $ranges $i]
4620         if {abs([yc $row] - $y) < $thresh} {
4621             return $i
4622         }
4623     }
4624     return {}
4625 }
4626
4627 proc arrowjump {id n y} {
4628     global canv
4629
4630     # 1 <-> 2, 3 <-> 4, etc...
4631     set n [expr {(($n - 1) ^ 1) + 1}]
4632     set row [lindex [rowranges $id] $n]
4633     set yt [yc $row]
4634     set ymax [lindex [$canv cget -scrollregion] 3]
4635     if {$ymax eq {} || $ymax <= 0} return
4636     set view [$canv yview]
4637     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4638     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4639     if {$yfrac < 0} {
4640         set yfrac 0
4641     }
4642     allcanvs yview moveto $yfrac
4643 }
4644
4645 proc lineclick {x y id isnew} {
4646     global ctext commitinfo children canv thickerline curview
4647
4648     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4649     unmarkmatches
4650     unselectline
4651     normalline
4652     $canv delete hover
4653     # draw this line thicker than normal
4654     set thickerline $id
4655     drawlines $id
4656     if {$isnew} {
4657         set ymax [lindex [$canv cget -scrollregion] 3]
4658         if {$ymax eq {}} return
4659         set yfrac [lindex [$canv yview] 0]
4660         set y [expr {$y + $yfrac * $ymax}]
4661     }
4662     set dirn [clickisonarrow $id $y]
4663     if {$dirn ne {}} {
4664         arrowjump $id $dirn $y
4665         return
4666     }
4667
4668     if {$isnew} {
4669         addtohistory [list lineclick $x $y $id 0]
4670     }
4671     # fill the details pane with info about this line
4672     $ctext conf -state normal
4673     clear_ctext
4674     $ctext tag conf link -foreground blue -underline 1
4675     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4676     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4677     $ctext insert end "Parent:\t"
4678     $ctext insert end $id [list link link0]
4679     $ctext tag bind link0 <1> [list selbyid $id]
4680     set info $commitinfo($id)
4681     $ctext insert end "\n\t[lindex $info 0]\n"
4682     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4683     set date [formatdate [lindex $info 2]]
4684     $ctext insert end "\tDate:\t$date\n"
4685     set kids $children($curview,$id)
4686     if {$kids ne {}} {
4687         $ctext insert end "\nChildren:"
4688         set i 0
4689         foreach child $kids {
4690             incr i
4691             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4692             set info $commitinfo($child)
4693             $ctext insert end "\n\t"
4694             $ctext insert end $child [list link link$i]
4695             $ctext tag bind link$i <1> [list selbyid $child]
4696             $ctext insert end "\n\t[lindex $info 0]"
4697             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4698             set date [formatdate [lindex $info 2]]
4699             $ctext insert end "\n\tDate:\t$date\n"
4700         }
4701     }
4702     $ctext conf -state disabled
4703     init_flist {}
4704 }
4705
4706 proc normalline {} {
4707     global thickerline
4708     if {[info exists thickerline]} {
4709         set id $thickerline
4710         unset thickerline
4711         drawlines $id
4712     }
4713 }
4714
4715 proc selbyid {id} {
4716     global commitrow curview
4717     if {[info exists commitrow($curview,$id)]} {
4718         selectline $commitrow($curview,$id) 1
4719     }
4720 }
4721
4722 proc mstime {} {
4723     global startmstime
4724     if {![info exists startmstime]} {
4725         set startmstime [clock clicks -milliseconds]
4726     }
4727     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4728 }
4729
4730 proc rowmenu {x y id} {
4731     global rowctxmenu commitrow selectedline rowmenuid curview
4732
4733     if {![info exists selectedline]
4734         || $commitrow($curview,$id) eq $selectedline} {
4735         set state disabled
4736     } else {
4737         set state normal
4738     }
4739     $rowctxmenu entryconfigure 0 -state $state
4740     $rowctxmenu entryconfigure 1 -state $state
4741     $rowctxmenu entryconfigure 2 -state $state
4742     set rowmenuid $id
4743     tk_popup $rowctxmenu $x $y
4744 }
4745
4746 proc diffvssel {dirn} {
4747     global rowmenuid selectedline displayorder
4748
4749     if {![info exists selectedline]} return
4750     if {$dirn} {
4751         set oldid [lindex $displayorder $selectedline]
4752         set newid $rowmenuid
4753     } else {
4754         set oldid $rowmenuid
4755         set newid [lindex $displayorder $selectedline]
4756     }
4757     addtohistory [list doseldiff $oldid $newid]
4758     doseldiff $oldid $newid
4759 }
4760
4761 proc doseldiff {oldid newid} {
4762     global ctext
4763     global commitinfo
4764
4765     $ctext conf -state normal
4766     clear_ctext
4767     init_flist "Top"
4768     $ctext insert end "From "
4769     $ctext tag conf link -foreground blue -underline 1
4770     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4771     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4772     $ctext tag bind link0 <1> [list selbyid $oldid]
4773     $ctext insert end $oldid [list link link0]
4774     $ctext insert end "\n     "
4775     $ctext insert end [lindex $commitinfo($oldid) 0]
4776     $ctext insert end "\n\nTo   "
4777     $ctext tag bind link1 <1> [list selbyid $newid]
4778     $ctext insert end $newid [list link link1]
4779     $ctext insert end "\n     "
4780     $ctext insert end [lindex $commitinfo($newid) 0]
4781     $ctext insert end "\n"
4782     $ctext conf -state disabled
4783     $ctext tag delete Comments
4784     $ctext tag remove found 1.0 end
4785     startdiff [list $oldid $newid]
4786 }
4787
4788 proc mkpatch {} {
4789     global rowmenuid currentid commitinfo patchtop patchnum
4790
4791     if {![info exists currentid]} return
4792     set oldid $currentid
4793     set oldhead [lindex $commitinfo($oldid) 0]
4794     set newid $rowmenuid
4795     set newhead [lindex $commitinfo($newid) 0]
4796     set top .patch
4797     set patchtop $top
4798     catch {destroy $top}
4799     toplevel $top
4800     label $top.title -text "Generate patch"
4801     grid $top.title - -pady 10
4802     label $top.from -text "From:"
4803     entry $top.fromsha1 -width 40 -relief flat
4804     $top.fromsha1 insert 0 $oldid
4805     $top.fromsha1 conf -state readonly
4806     grid $top.from $top.fromsha1 -sticky w
4807     entry $top.fromhead -width 60 -relief flat
4808     $top.fromhead insert 0 $oldhead
4809     $top.fromhead conf -state readonly
4810     grid x $top.fromhead -sticky w
4811     label $top.to -text "To:"
4812     entry $top.tosha1 -width 40 -relief flat
4813     $top.tosha1 insert 0 $newid
4814     $top.tosha1 conf -state readonly
4815     grid $top.to $top.tosha1 -sticky w
4816     entry $top.tohead -width 60 -relief flat
4817     $top.tohead insert 0 $newhead
4818     $top.tohead conf -state readonly
4819     grid x $top.tohead -sticky w
4820     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4821     grid $top.rev x -pady 10
4822     label $top.flab -text "Output file:"
4823     entry $top.fname -width 60
4824     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4825     incr patchnum
4826     grid $top.flab $top.fname -sticky w
4827     frame $top.buts
4828     button $top.buts.gen -text "Generate" -command mkpatchgo
4829     button $top.buts.can -text "Cancel" -command mkpatchcan
4830     grid $top.buts.gen $top.buts.can
4831     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4832     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4833     grid $top.buts - -pady 10 -sticky ew
4834     focus $top.fname
4835 }
4836
4837 proc mkpatchrev {} {
4838     global patchtop
4839
4840     set oldid [$patchtop.fromsha1 get]
4841     set oldhead [$patchtop.fromhead get]
4842     set newid [$patchtop.tosha1 get]
4843     set newhead [$patchtop.tohead get]
4844     foreach e [list fromsha1 fromhead tosha1 tohead] \
4845             v [list $newid $newhead $oldid $oldhead] {
4846         $patchtop.$e conf -state normal
4847         $patchtop.$e delete 0 end
4848         $patchtop.$e insert 0 $v
4849         $patchtop.$e conf -state readonly
4850     }
4851 }
4852
4853 proc mkpatchgo {} {
4854     global patchtop
4855
4856     set oldid [$patchtop.fromsha1 get]
4857     set newid [$patchtop.tosha1 get]
4858     set fname [$patchtop.fname get]
4859     if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4860         error_popup "Error creating patch: $err"
4861     }
4862     catch {destroy $patchtop}
4863     unset patchtop
4864 }
4865
4866 proc mkpatchcan {} {
4867     global patchtop
4868
4869     catch {destroy $patchtop}
4870     unset patchtop
4871 }
4872
4873 proc mktag {} {
4874     global rowmenuid mktagtop commitinfo
4875
4876     set top .maketag
4877     set mktagtop $top
4878     catch {destroy $top}
4879     toplevel $top
4880     label $top.title -text "Create tag"
4881     grid $top.title - -pady 10
4882     label $top.id -text "ID:"
4883     entry $top.sha1 -width 40 -relief flat
4884     $top.sha1 insert 0 $rowmenuid
4885     $top.sha1 conf -state readonly
4886     grid $top.id $top.sha1 -sticky w
4887     entry $top.head -width 60 -relief flat
4888     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4889     $top.head conf -state readonly
4890     grid x $top.head -sticky w
4891     label $top.tlab -text "Tag name:"
4892     entry $top.tag -width 60
4893     grid $top.tlab $top.tag -sticky w
4894     frame $top.buts
4895     button $top.buts.gen -text "Create" -command mktaggo
4896     button $top.buts.can -text "Cancel" -command mktagcan
4897     grid $top.buts.gen $top.buts.can
4898     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4899     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4900     grid $top.buts - -pady 10 -sticky ew
4901     focus $top.tag
4902 }
4903
4904 proc domktag {} {
4905     global mktagtop env tagids idtags
4906
4907     set id [$mktagtop.sha1 get]
4908     set tag [$mktagtop.tag get]
4909     if {$tag == {}} {
4910         error_popup "No tag name specified"
4911         return
4912     }
4913     if {[info exists tagids($tag)]} {
4914         error_popup "Tag \"$tag\" already exists"
4915         return
4916     }
4917     if {[catch {
4918         set dir [gitdir]
4919         set fname [file join $dir "refs/tags" $tag]
4920         set f [open $fname w]
4921         puts $f $id
4922         close $f
4923     } err]} {
4924         error_popup "Error creating tag: $err"
4925         return
4926     }
4927
4928     set tagids($tag) $id
4929     lappend idtags($id) $tag
4930     redrawtags $id
4931 }
4932
4933 proc redrawtags {id} {
4934     global canv linehtag commitrow idpos selectedline curview
4935     global mainfont canvxmax
4936
4937     if {![info exists commitrow($curview,$id)]} return
4938     drawcmitrow $commitrow($curview,$id)
4939     $canv delete tag.$id
4940     set xt [eval drawtags $id $idpos($id)]
4941     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4942     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4943     set xr [expr {$xt + [font measure $mainfont $text]}]
4944     if {$xr > $canvxmax} {
4945         set canvxmax $xr
4946         setcanvscroll
4947     }
4948     if {[info exists selectedline]
4949         && $selectedline == $commitrow($curview,$id)} {
4950         selectline $selectedline 0
4951     }
4952 }
4953
4954 proc mktagcan {} {
4955     global mktagtop
4956
4957     catch {destroy $mktagtop}
4958     unset mktagtop
4959 }
4960
4961 proc mktaggo {} {
4962     domktag
4963     mktagcan
4964 }
4965
4966 proc writecommit {} {
4967     global rowmenuid wrcomtop commitinfo wrcomcmd
4968
4969     set top .writecommit
4970     set wrcomtop $top
4971     catch {destroy $top}
4972     toplevel $top
4973     label $top.title -text "Write commit to file"
4974     grid $top.title - -pady 10
4975     label $top.id -text "ID:"
4976     entry $top.sha1 -width 40 -relief flat
4977     $top.sha1 insert 0 $rowmenuid
4978     $top.sha1 conf -state readonly
4979     grid $top.id $top.sha1 -sticky w
4980     entry $top.head -width 60 -relief flat
4981     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4982     $top.head conf -state readonly
4983     grid x $top.head -sticky w
4984     label $top.clab -text "Command:"
4985     entry $top.cmd -width 60 -textvariable wrcomcmd
4986     grid $top.clab $top.cmd -sticky w -pady 10
4987     label $top.flab -text "Output file:"
4988     entry $top.fname -width 60
4989     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4990     grid $top.flab $top.fname -sticky w
4991     frame $top.buts
4992     button $top.buts.gen -text "Write" -command wrcomgo
4993     button $top.buts.can -text "Cancel" -command wrcomcan
4994     grid $top.buts.gen $top.buts.can
4995     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4996     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4997     grid $top.buts - -pady 10 -sticky ew
4998     focus $top.fname
4999 }
5000
5001 proc wrcomgo {} {
5002     global wrcomtop
5003
5004     set id [$wrcomtop.sha1 get]
5005     set cmd "echo $id | [$wrcomtop.cmd get]"
5006     set fname [$wrcomtop.fname get]
5007     if {[catch {exec sh -c $cmd >$fname &} err]} {
5008         error_popup "Error writing commit: $err"
5009     }
5010     catch {destroy $wrcomtop}
5011     unset wrcomtop
5012 }
5013
5014 proc wrcomcan {} {
5015     global wrcomtop
5016
5017     catch {destroy $wrcomtop}
5018     unset wrcomtop
5019 }
5020
5021 # Stuff for finding nearby tags
5022 proc getallcommits {} {
5023     global allcstart allcommits allcfd allids
5024
5025     set allids {}
5026     set fd [open [concat | git rev-list --all --topo-order --parents] r]
5027     set allcfd $fd
5028     fconfigure $fd -blocking 0
5029     set allcommits "reading"
5030     nowbusy allcommits
5031     restartgetall $fd
5032 }
5033
5034 proc discardallcommits {} {
5035     global allparents allchildren allcommits allcfd
5036     global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5037
5038     if {![info exists allcommits]} return
5039     if {$allcommits eq "reading"} {
5040         catch {close $allcfd}
5041     }
5042     foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5043                 alldtags tagisdesc desc_heads} {
5044         catch {unset $v}
5045     }
5046 }
5047
5048 proc restartgetall {fd} {
5049     global allcstart
5050
5051     fileevent $fd readable [list getallclines $fd]
5052     set allcstart [clock clicks -milliseconds]
5053 }
5054
5055 proc combine_dtags {l1 l2} {
5056     global tagisdesc notfirstd
5057
5058     set res [lsort -unique [concat $l1 $l2]]
5059     for {set i 0} {$i < [llength $res]} {incr i} {
5060         set x [lindex $res $i]
5061         for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5062             set y [lindex $res $j]
5063             if {[info exists tagisdesc($x,$y)]} {
5064                 if {$tagisdesc($x,$y) > 0} {
5065                     # x is a descendent of y, exclude x
5066                     set res [lreplace $res $i $i]
5067                     incr i -1
5068                     break
5069                 } else {
5070                     # y is a descendent of x, exclude y
5071                     set res [lreplace $res $j $j]
5072                 }
5073             } else {
5074                 # no relation, keep going
5075                 incr j
5076             }
5077         }
5078     }
5079     return $res
5080 }
5081
5082 proc combine_atags {l1 l2} {
5083     global tagisdesc
5084
5085     set res [lsort -unique [concat $l1 $l2]]
5086     for {set i 0} {$i < [llength $res]} {incr i} {
5087         set x [lindex $res $i]
5088         for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5089             set y [lindex $res $j]
5090             if {[info exists tagisdesc($x,$y)]} {
5091                 if {$tagisdesc($x,$y) < 0} {
5092                     # x is an ancestor of y, exclude x
5093                     set res [lreplace $res $i $i]
5094                     incr i -1
5095                     break
5096                 } else {
5097                     # y is an ancestor of x, exclude y
5098                     set res [lreplace $res $j $j]
5099                 }
5100             } else {
5101                 # no relation, keep going
5102                 incr j
5103             }
5104         }
5105     }
5106     return $res
5107 }
5108
5109 proc forward_pass {id children} {
5110     global idtags desc_tags idheads desc_heads alldtags tagisdesc
5111
5112     set dtags {}
5113     set dheads {}
5114     foreach child $children {
5115         if {[info exists idtags($child)]} {
5116             set ctags [list $child]
5117         } else {
5118             set ctags $desc_tags($child)
5119         }
5120         if {$dtags eq {}} {
5121             set dtags $ctags
5122         } elseif {$ctags ne $dtags} {
5123             set dtags [combine_dtags $dtags $ctags]
5124         }
5125         set cheads $desc_heads($child)
5126         if {$dheads eq {}} {
5127             set dheads $cheads
5128         } elseif {$cheads ne $dheads} {
5129             set dheads [lsort -unique [concat $dheads $cheads]]
5130         }
5131     }
5132     set desc_tags($id) $dtags
5133     if {[info exists idtags($id)]} {
5134         set adt $dtags
5135         foreach tag $dtags {
5136             set adt [concat $adt $alldtags($tag)]
5137         }
5138         set adt [lsort -unique $adt]
5139         set alldtags($id) $adt
5140         foreach tag $adt {
5141             set tagisdesc($id,$tag) -1
5142             set tagisdesc($tag,$id) 1
5143         }
5144     }
5145     if {[info exists idheads($id)]} {
5146         lappend dheads $id
5147     }
5148     set desc_heads($id) $dheads
5149 }
5150
5151 proc getallclines {fd} {
5152     global allparents allchildren allcommits allcstart
5153     global desc_tags anc_tags idtags tagisdesc allids
5154     global desc_heads idheads travindex
5155
5156     while {[gets $fd line] >= 0} {
5157         set id [lindex $line 0]
5158         lappend allids $id
5159         set olds [lrange $line 1 end]
5160         set allparents($id) $olds
5161         if {![info exists allchildren($id)]} {
5162             set allchildren($id) {}
5163         }
5164         foreach p $olds {
5165             lappend allchildren($p) $id
5166         }
5167         # compute nearest tagged descendents as we go
5168         # also compute descendent heads
5169         forward_pass $id $allchildren($id)
5170         if {[clock clicks -milliseconds] - $allcstart >= 50} {
5171             fileevent $fd readable {}
5172             after idle restartgetall $fd
5173             return
5174         }
5175     }
5176     if {[eof $fd]} {
5177         set travindex [llength $allids]
5178         set allcommits "traversing"
5179         after idle restartatags
5180         if {[catch {close $fd} err]} {
5181             error_popup "Error reading full commit graph: $err.\n\
5182                          Results may be incomplete."
5183         }
5184     }
5185 }
5186
5187 # walk backward through the tree and compute nearest tagged ancestors
5188 proc restartatags {} {
5189     global allids allparents idtags anc_tags travindex
5190
5191     set t0 [clock clicks -milliseconds]
5192     set i $travindex
5193     while {[incr i -1] >= 0} {
5194         set id [lindex $allids $i]
5195         set atags {}
5196         foreach p $allparents($id) {
5197             if {[info exists idtags($p)]} {
5198                 set ptags [list $p]
5199             } else {
5200                 set ptags $anc_tags($p)
5201             }
5202             if {$atags eq {}} {
5203                 set atags $ptags
5204             } elseif {$ptags ne $atags} {
5205                 set atags [combine_atags $atags $ptags]
5206             }
5207         }
5208         set anc_tags($id) $atags
5209         if {[clock clicks -milliseconds] - $t0 >= 50} {
5210             set travindex $i
5211             after idle restartatags
5212             return
5213         }
5214     }
5215     set allcommits "done"
5216     set travindex 0
5217     notbusy allcommits
5218     dispneartags
5219 }
5220
5221 proc changedrefs {} {
5222     global desc_heads desc_tags anc_tags allcommits allids
5223     global allchildren allparents idtags travindex
5224
5225     if {![info exists allcommits]} return
5226     catch {unset desc_heads}
5227     catch {unset desc_tags}
5228     catch {unset anc_tags}
5229     catch {unset alldtags}
5230     catch {unset tagisdesc}
5231     foreach id $allids {
5232         forward_pass $id $allchildren($id)
5233     }
5234     if {$allcommits ne "reading"} {
5235         set travindex [llength $allids]
5236         if {$allcommits ne "traversing"} {
5237             set allcommits "traversing"
5238             after idle restartatags
5239         }
5240     }
5241 }
5242
5243 proc rereadrefs {} {
5244     global idtags idheads idotherrefs mainhead
5245
5246     set refids [concat [array names idtags] \
5247                     [array names idheads] [array names idotherrefs]]
5248     foreach id $refids {
5249         if {![info exists ref($id)]} {
5250             set ref($id) [listrefs $id]
5251         }
5252     }
5253     set oldmainhead $mainhead
5254     readrefs
5255     changedrefs
5256     set refids [lsort -unique [concat $refids [array names idtags] \
5257                         [array names idheads] [array names idotherrefs]]]
5258     foreach id $refids {
5259         set v [listrefs $id]
5260         if {![info exists ref($id)] || $ref($id) != $v ||
5261             ($id eq $oldmainhead && $id ne $mainhead) ||
5262             ($id eq $mainhead && $id ne $oldmainhead)} {
5263             redrawtags $id
5264         }
5265     }
5266 }
5267
5268 proc listrefs {id} {
5269     global idtags idheads idotherrefs
5270
5271     set x {}
5272     if {[info exists idtags($id)]} {
5273         set x $idtags($id)
5274     }
5275     set y {}
5276     if {[info exists idheads($id)]} {
5277         set y $idheads($id)
5278     }
5279     set z {}
5280     if {[info exists idotherrefs($id)]} {
5281         set z $idotherrefs($id)
5282     }
5283     return [list $x $y $z]
5284 }
5285
5286 proc showtag {tag isnew} {
5287     global ctext tagcontents tagids linknum
5288
5289     if {$isnew} {
5290         addtohistory [list showtag $tag 0]
5291     }
5292     $ctext conf -state normal
5293     clear_ctext
5294     set linknum 0
5295     if {[info exists tagcontents($tag)]} {
5296         set text $tagcontents($tag)
5297     } else {
5298         set text "Tag: $tag\nId:  $tagids($tag)"
5299     }
5300     appendwithlinks $text {}
5301     $ctext conf -state disabled
5302     init_flist {}
5303 }
5304
5305 proc doquit {} {
5306     global stopped
5307     set stopped 100
5308     destroy .
5309 }
5310
5311 proc doprefs {} {
5312     global maxwidth maxgraphpct diffopts
5313     global oldprefs prefstop showneartags
5314     global bgcolor fgcolor ctext diffcolors
5315
5316     set top .gitkprefs
5317     set prefstop $top
5318     if {[winfo exists $top]} {
5319         raise $top
5320         return
5321     }
5322     foreach v {maxwidth maxgraphpct diffopts showneartags} {
5323         set oldprefs($v) [set $v]
5324     }
5325     toplevel $top
5326     wm title $top "Gitk preferences"
5327     label $top.ldisp -text "Commit list display options"
5328     grid $top.ldisp - -sticky w -pady 10
5329     label $top.spacer -text " "
5330     label $top.maxwidthl -text "Maximum graph width (lines)" \
5331         -font optionfont
5332     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5333     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5334     label $top.maxpctl -text "Maximum graph width (% of pane)" \
5335         -font optionfont
5336     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5337     grid x $top.maxpctl $top.maxpct -sticky w
5338
5339     label $top.ddisp -text "Diff display options"
5340     grid $top.ddisp - -sticky w -pady 10
5341     label $top.diffoptl -text "Options for diff program" \
5342         -font optionfont
5343     entry $top.diffopt -width 20 -textvariable diffopts
5344     grid x $top.diffoptl $top.diffopt -sticky w
5345     frame $top.ntag
5346     label $top.ntag.l -text "Display nearby tags" -font optionfont
5347     checkbutton $top.ntag.b -variable showneartags
5348     pack $top.ntag.b $top.ntag.l -side left
5349     grid x $top.ntag -sticky w
5350
5351     label $top.cdisp -text "Colors: press to choose"
5352     grid $top.cdisp - -sticky w -pady 10
5353     label $top.bg -padx 40 -relief sunk -background $bgcolor
5354     button $top.bgbut -text "Background" -font optionfont \
5355         -command [list choosecolor bgcolor 0 $top.bg background setbg]
5356     grid x $top.bgbut $top.bg -sticky w
5357     label $top.fg -padx 40 -relief sunk -background $fgcolor
5358     button $top.fgbut -text "Foreground" -font optionfont \
5359         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5360     grid x $top.fgbut $top.fg -sticky w
5361     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5362     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5363         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5364                       [list $ctext tag conf d0 -foreground]]
5365     grid x $top.diffoldbut $top.diffold -sticky w
5366     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5367     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5368         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5369                       [list $ctext tag conf d1 -foreground]]
5370     grid x $top.diffnewbut $top.diffnew -sticky w
5371     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5372     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5373         -command [list choosecolor diffcolors 2 $top.hunksep \
5374                       "diff hunk header" \
5375                       [list $ctext tag conf hunksep -foreground]]
5376     grid x $top.hunksepbut $top.hunksep -sticky w
5377
5378     frame $top.buts
5379     button $top.buts.ok -text "OK" -command prefsok
5380     button $top.buts.can -text "Cancel" -command prefscan
5381     grid $top.buts.ok $top.buts.can
5382     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5383     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5384     grid $top.buts - - -pady 10 -sticky ew
5385 }
5386
5387 proc choosecolor {v vi w x cmd} {
5388     global $v
5389
5390     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5391                -title "Gitk: choose color for $x"]
5392     if {$c eq {}} return
5393     $w conf -background $c
5394     lset $v $vi $c
5395     eval $cmd $c
5396 }
5397
5398 proc setbg {c} {
5399     global bglist
5400
5401     foreach w $bglist {
5402         $w conf -background $c
5403     }
5404 }
5405
5406 proc setfg {c} {
5407     global fglist canv
5408
5409     foreach w $fglist {
5410         $w conf -foreground $c
5411     }
5412     allcanvs itemconf text -fill $c
5413     $canv itemconf circle -outline $c
5414 }
5415
5416 proc prefscan {} {
5417     global maxwidth maxgraphpct diffopts
5418     global oldprefs prefstop showneartags
5419
5420     foreach v {maxwidth maxgraphpct diffopts showneartags} {
5421         set $v $oldprefs($v)
5422     }
5423     catch {destroy $prefstop}
5424     unset prefstop
5425 }
5426
5427 proc prefsok {} {
5428     global maxwidth maxgraphpct
5429     global oldprefs prefstop showneartags
5430
5431     catch {destroy $prefstop}
5432     unset prefstop
5433     if {$maxwidth != $oldprefs(maxwidth)
5434         || $maxgraphpct != $oldprefs(maxgraphpct)} {
5435         redisplay
5436     } elseif {$showneartags != $oldprefs(showneartags)} {
5437         reselectline
5438     }
5439 }
5440
5441 proc formatdate {d} {
5442     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5443 }
5444
5445 # This list of encoding names and aliases is distilled from
5446 # http://www.iana.org/assignments/character-sets.
5447 # Not all of them are supported by Tcl.
5448 set encoding_aliases {
5449     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5450       ISO646-US US-ASCII us IBM367 cp367 csASCII }
5451     { ISO-10646-UTF-1 csISO10646UTF1 }
5452     { ISO_646.basic:1983 ref csISO646basic1983 }
5453     { INVARIANT csINVARIANT }
5454     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5455     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5456     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5457     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5458     { NATS-DANO iso-ir-9-1 csNATSDANO }
5459     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5460     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5461     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5462     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5463     { ISO-2022-KR csISO2022KR }
5464     { EUC-KR csEUCKR }
5465     { ISO-2022-JP csISO2022JP }
5466     { ISO-2022-JP-2 csISO2022JP2 }
5467     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5468       csISO13JISC6220jp }
5469     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5470     { IT iso-ir-15 ISO646-IT csISO15Italian }
5471     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5472     { ES iso-ir-17 ISO646-ES csISO17Spanish }
5473     { greek7-old iso-ir-18 csISO18Greek7Old }
5474     { latin-greek iso-ir-19 csISO19LatinGreek }
5475     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5476     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5477     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5478     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5479     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5480     { BS_viewdata iso-ir-47 csISO47BSViewdata }
5481     { INIS iso-ir-49 csISO49INIS }
5482     { INIS-8 iso-ir-50 csISO50INIS8 }
5483     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5484     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5485     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5486     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5487     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5488     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5489       csISO60Norwegian1 }
5490     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5491     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5492     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5493     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5494     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5495     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5496     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5497     { greek7 iso-ir-88 csISO88Greek7 }
5498     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5499     { iso-ir-90 csISO90 }
5500     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5501     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5502       csISO92JISC62991984b }
5503     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5504     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5505     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5506       csISO95JIS62291984handadd }
5507     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5508     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5509     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5510     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5511       CP819 csISOLatin1 }
5512     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5513     { T.61-7bit iso-ir-102 csISO102T617bit }
5514     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5515     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5516     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5517     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5518     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5519     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5520     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5521     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5522       arabic csISOLatinArabic }
5523     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5524     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5525     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5526       greek greek8 csISOLatinGreek }
5527     { T.101-G2 iso-ir-128 csISO128T101G2 }
5528     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5529       csISOLatinHebrew }
5530     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5531     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5532     { CSN_369103 iso-ir-139 csISO139CSN369103 }
5533     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5534     { ISO_6937-2-add iso-ir-142 csISOTextComm }
5535     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5536     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5537       csISOLatinCyrillic }
5538     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5539     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5540     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5541     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5542     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5543     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5544     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5545     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5546     { ISO_10367-box iso-ir-155 csISO10367Box }
5547     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5548     { latin-lap lap iso-ir-158 csISO158Lap }
5549     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5550     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5551     { us-dk csUSDK }
5552     { dk-us csDKUS }
5553     { JIS_X0201 X0201 csHalfWidthKatakana }
5554     { KSC5636 ISO646-KR csKSC5636 }
5555     { ISO-10646-UCS-2 csUnicode }
5556     { ISO-10646-UCS-4 csUCS4 }
5557     { DEC-MCS dec csDECMCS }
5558     { hp-roman8 roman8 r8 csHPRoman8 }
5559     { macintosh mac csMacintosh }
5560     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5561       csIBM037 }
5562     { IBM038 EBCDIC-INT cp038 csIBM038 }
5563     { IBM273 CP273 csIBM273 }
5564     { IBM274 EBCDIC-BE CP274 csIBM274 }
5565     { IBM275 EBCDIC-BR cp275 csIBM275 }
5566     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5567     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5568     { IBM280 CP280 ebcdic-cp-it csIBM280 }
5569     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5570     { IBM284 CP284 ebcdic-cp-es csIBM284 }
5571     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5572     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5573     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5574     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5575     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5576     { IBM424 cp424 ebcdic-cp-he csIBM424 }
5577     { IBM437 cp437 437 csPC8CodePage437 }
5578     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5579     { IBM775 cp775 csPC775Baltic }
5580     { IBM850 cp850 850 csPC850Multilingual }
5581     { IBM851 cp851 851 csIBM851 }
5582     { IBM852 cp852 852 csPCp852 }
5583     { IBM855 cp855 855 csIBM855 }
5584     { IBM857 cp857 857 csIBM857 }
5585     { IBM860 cp860 860 csIBM860 }
5586     { IBM861 cp861 861 cp-is csIBM861 }
5587     { IBM862 cp862 862 csPC862LatinHebrew }
5588     { IBM863 cp863 863 csIBM863 }
5589     { IBM864 cp864 csIBM864 }
5590     { IBM865 cp865 865 csIBM865 }
5591     { IBM866 cp866 866 csIBM866 }
5592     { IBM868 CP868 cp-ar csIBM868 }
5593     { IBM869 cp869 869 cp-gr csIBM869 }
5594     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5595     { IBM871 CP871 ebcdic-cp-is csIBM871 }
5596     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5597     { IBM891 cp891 csIBM891 }
5598     { IBM903 cp903 csIBM903 }
5599     { IBM904 cp904 904 csIBBM904 }
5600     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5601     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5602     { IBM1026 CP1026 csIBM1026 }
5603     { EBCDIC-AT-DE csIBMEBCDICATDE }
5604     { EBCDIC-AT-DE-A csEBCDICATDEA }
5605     { EBCDIC-CA-FR csEBCDICCAFR }
5606     { EBCDIC-DK-NO csEBCDICDKNO }
5607     { EBCDIC-DK-NO-A csEBCDICDKNOA }
5608     { EBCDIC-FI-SE csEBCDICFISE }
5609     { EBCDIC-FI-SE-A csEBCDICFISEA }
5610     { EBCDIC-FR csEBCDICFR }
5611     { EBCDIC-IT csEBCDICIT }
5612     { EBCDIC-PT csEBCDICPT }
5613     { EBCDIC-ES csEBCDICES }
5614     { EBCDIC-ES-A csEBCDICESA }
5615     { EBCDIC-ES-S csEBCDICESS }
5616     { EBCDIC-UK csEBCDICUK }
5617     { EBCDIC-US csEBCDICUS }
5618     { UNKNOWN-8BIT csUnknown8BiT }
5619     { MNEMONIC csMnemonic }
5620     { MNEM csMnem }
5621     { VISCII csVISCII }
5622     { VIQR csVIQR }
5623     { KOI8-R csKOI8R }
5624     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5625     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5626     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5627     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5628     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5629     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5630     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5631     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5632     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5633     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5634     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5635     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5636     { IBM1047 IBM-1047 }
5637     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5638     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5639     { UNICODE-1-1 csUnicode11 }
5640     { CESU-8 csCESU-8 }
5641     { BOCU-1 csBOCU-1 }
5642     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5643     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5644       l8 }
5645     { ISO-8859-15 ISO_8859-15 Latin-9 }
5646     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5647     { GBK CP936 MS936 windows-936 }
5648     { JIS_Encoding csJISEncoding }
5649     { Shift_JIS MS_Kanji csShiftJIS }
5650     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5651       EUC-JP }
5652     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5653     { ISO-10646-UCS-Basic csUnicodeASCII }
5654     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5655     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5656     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5657     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5658     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5659     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5660     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5661     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5662     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5663     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5664     { Adobe-Standard-Encoding csAdobeStandardEncoding }
5665     { Ventura-US csVenturaUS }
5666     { Ventura-International csVenturaInternational }
5667     { PC8-Danish-Norwegian csPC8DanishNorwegian }
5668     { PC8-Turkish csPC8Turkish }
5669     { IBM-Symbols csIBMSymbols }
5670     { IBM-Thai csIBMThai }
5671     { HP-Legal csHPLegal }
5672     { HP-Pi-font csHPPiFont }
5673     { HP-Math8 csHPMath8 }
5674     { Adobe-Symbol-Encoding csHPPSMath }
5675     { HP-DeskTop csHPDesktop }
5676     { Ventura-Math csVenturaMath }
5677     { Microsoft-Publishing csMicrosoftPublishing }
5678     { Windows-31J csWindows31J }
5679     { GB2312 csGB2312 }
5680     { Big5 csBig5 }
5681 }
5682
5683 proc tcl_encoding {enc} {
5684     global encoding_aliases
5685     set names [encoding names]
5686     set lcnames [string tolower $names]
5687     set enc [string tolower $enc]
5688     set i [lsearch -exact $lcnames $enc]
5689     if {$i < 0} {
5690         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5691         if {[regsub {^iso[-_]} $enc iso encx]} {
5692             set i [lsearch -exact $lcnames $encx]
5693         }
5694     }
5695     if {$i < 0} {
5696         foreach l $encoding_aliases {
5697             set ll [string tolower $l]
5698             if {[lsearch -exact $ll $enc] < 0} continue
5699             # look through the aliases for one that tcl knows about
5700             foreach e $ll {
5701                 set i [lsearch -exact $lcnames $e]
5702                 if {$i < 0} {
5703                     if {[regsub {^iso[-_]} $e iso ex]} {
5704                         set i [lsearch -exact $lcnames $ex]
5705                     }
5706                 }
5707                 if {$i >= 0} break
5708             }
5709             break
5710         }
5711     }
5712     if {$i >= 0} {
5713         return [lindex $names $i]
5714     }
5715     return {}
5716 }
5717
5718 # defaults...
5719 set datemode 0
5720 set diffopts "-U 5 -p"
5721 set wrcomcmd "git diff-tree --stdin -p --pretty"
5722
5723 set gitencoding {}
5724 catch {
5725     set gitencoding [exec git repo-config --get i18n.commitencoding]
5726 }
5727 if {$gitencoding == ""} {
5728     set gitencoding "utf-8"
5729 }
5730 set tclencoding [tcl_encoding $gitencoding]
5731 if {$tclencoding == {}} {
5732     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5733 }
5734
5735 set mainfont {Helvetica 9}
5736 set textfont {Courier 9}
5737 set uifont {Helvetica 9 bold}
5738 set findmergefiles 0
5739 set maxgraphpct 50
5740 set maxwidth 16
5741 set revlistorder 0
5742 set fastdate 0
5743 set uparrowlen 7
5744 set downarrowlen 7
5745 set mingaplen 30
5746 set cmitmode "patch"
5747 set wrapcomment "none"
5748 set showneartags 1
5749
5750 set colors {green red blue magenta darkgrey brown orange}
5751 set bgcolor white
5752 set fgcolor black
5753 set diffcolors {red "#00a000" blue}
5754
5755 catch {source ~/.gitk}
5756
5757 font create optionfont -family sans-serif -size -12
5758
5759 set revtreeargs {}
5760 foreach arg $argv {
5761     switch -regexp -- $arg {
5762         "^$" { }
5763         "^-d" { set datemode 1 }
5764         default {
5765             lappend revtreeargs $arg
5766         }
5767     }
5768 }
5769
5770 # check that we can find a .git directory somewhere...
5771 set gitdir [gitdir]
5772 if {![file isdirectory $gitdir]} {
5773     show_error {} . "Cannot find the git directory \"$gitdir\"."
5774     exit 1
5775 }
5776
5777 set cmdline_files {}
5778 set i [lsearch -exact $revtreeargs "--"]
5779 if {$i >= 0} {
5780     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5781     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5782 } elseif {$revtreeargs ne {}} {
5783     if {[catch {
5784         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5785         set cmdline_files [split $f "\n"]
5786         set n [llength $cmdline_files]
5787         set revtreeargs [lrange $revtreeargs 0 end-$n]
5788     } err]} {
5789         # unfortunately we get both stdout and stderr in $err,
5790         # so look for "fatal:".
5791         set i [string first "fatal:" $err]
5792         if {$i > 0} {
5793             set err [string range $err [expr {$i + 6}] end]
5794         }
5795         show_error {} . "Bad arguments to gitk:\n$err"
5796         exit 1
5797     }
5798 }
5799
5800 set history {}
5801 set historyindex 0
5802 set fh_serial 0
5803 set nhl_names {}
5804 set highlight_paths {}
5805 set searchdirn -forwards
5806 set boldrows {}
5807 set boldnamerows {}
5808
5809 set optim_delay 16
5810
5811 set nextviewnum 1
5812 set curview 0
5813 set selectedview 0
5814 set selectedhlview None
5815 set viewfiles(0) {}
5816 set viewperm(0) 0
5817 set viewargs(0) {}
5818
5819 set cmdlineok 0
5820 set stopped 0
5821 set stuffsaved 0
5822 set patchnum 0
5823 setcoords
5824 makewindow
5825 readrefs
5826
5827 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5828     # create a view for the files/dirs specified on the command line
5829     set curview 1
5830     set selectedview 1
5831     set nextviewnum 2
5832     set viewname(1) "Command line"
5833     set viewfiles(1) $cmdline_files
5834     set viewargs(1) $revtreeargs
5835     set viewperm(1) 0
5836     addviewmenu 1
5837     .bar.view entryconf 2 -state normal
5838     .bar.view entryconf 3 -state normal
5839 }
5840
5841 if {[info exists permviews]} {
5842     foreach v $permviews {
5843         set n $nextviewnum
5844         incr nextviewnum
5845         set viewname($n) [lindex $v 0]
5846         set viewfiles($n) [lindex $v 1]
5847         set viewargs($n) [lindex $v 2]
5848         set viewperm($n) 1
5849         addviewmenu $n
5850     }
5851 }
5852 getcommits