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