git.oblomov.eu Git - git/blob - gitk

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