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