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