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