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