gitk

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