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