gitk

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