gitk

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