gitk

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