gitk

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