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