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