gitk

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