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