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