git.oblomov.eu Git - git/blob - gitk

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