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 commitlisted
1120     global parentlist childlist children
1121
1122     incr commitidx
1123     lappend displayorder $id
1124     lappend commitlisted 0
1125     lappend parentlist {}
1126     set commitrow($id) $row
1127     readcommit $id
1128     if {![info exists commitinfo($id)]} {
1129         set commitinfo($id) {"No commit information available"}
1130     }
1131     if {[info exists children($id)]} {
1132         lappend childlist $children($id)
1133     } else {
1134         lappend childlist {}
1135     }
1136 }
1137
1138 proc layouttail {} {
1139     global rowidlist rowoffsets idinlist commitidx
1140     global idrowranges
1141
1142     set row $commitidx
1143     set idlist [lindex $rowidlist $row]
1144     while {$idlist ne {}} {
1145         set col [expr {[llength $idlist] - 1}]
1146         set id [lindex $idlist $col]
1147         addextraid $id $row
1148         unset idinlist($id)
1149         lappend idrowranges($id) $row
1150         incr row
1151         set offs [ntimes $col 0]
1152         set idlist [lreplace $idlist $col $col]
1153         lappend rowidlist $idlist
1154         lappend rowoffsets $offs
1155     }
1156
1157     foreach id [array names idinlist] {
1158         addextraid $id $row
1159         lset rowidlist $row [list $id]
1160         lset rowoffsets $row 0
1161         makeuparrow $id 0 $row 0
1162         lappend idrowranges($id) $row
1163         incr row
1164         lappend rowidlist {}
1165         lappend rowoffsets {}
1166     }
1167 }
1168
1169 proc insert_pad {row col npad} {
1170     global rowidlist rowoffsets
1171
1172     set pad [ntimes $npad {}]
1173     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1174     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1175     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1176 }
1177
1178 proc optimize_rows {row col endrow} {
1179     global rowidlist rowoffsets idrowranges linesegends displayorder
1180
1181     for {} {$row < $endrow} {incr row} {
1182         set idlist [lindex $rowidlist $row]
1183         set offs [lindex $rowoffsets $row]
1184         set haspad 0
1185         for {} {$col < [llength $offs]} {incr col} {
1186             if {[lindex $idlist $col] eq {}} {
1187                 set haspad 1
1188                 continue
1189             }
1190             set z [lindex $offs $col]
1191             if {$z eq {}} continue
1192             set isarrow 0
1193             set x0 [expr {$col + $z}]
1194             set y0 [expr {$row - 1}]
1195             set z0 [lindex $rowoffsets $y0 $x0]
1196             if {$z0 eq {}} {
1197                 set id [lindex $idlist $col]
1198                 if {[info exists idrowranges($id)] &&
1199                     $y0 > [lindex $idrowranges($id) 0]} {
1200                     set isarrow 1
1201                 }
1202             }
1203             if {$z < -1 || ($z < 0 && $isarrow)} {
1204                 set npad [expr {-1 - $z + $isarrow}]
1205                 set offs [incrange $offs $col $npad]
1206                 insert_pad $y0 $x0 $npad
1207                 if {$y0 > 0} {
1208                     optimize_rows $y0 $x0 $row
1209                 }
1210                 set z [lindex $offs $col]
1211                 set x0 [expr {$col + $z}]
1212                 set z0 [lindex $rowoffsets $y0 $x0]
1213             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1214                 set npad [expr {$z - 1 + $isarrow}]
1215                 set y1 [expr {$row + 1}]
1216                 set offs2 [lindex $rowoffsets $y1]
1217                 set x1 -1
1218                 foreach z $offs2 {
1219                     incr x1
1220                     if {$z eq {} || $x1 + $z < $col} continue
1221                     if {$x1 + $z > $col} {
1222                         incr npad
1223                     }
1224                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1225                     break
1226                 }
1227                 set pad [ntimes $npad {}]
1228                 set idlist [eval linsert \$idlist $col $pad]
1229                 set tmp [eval linsert \$offs $col $pad]
1230                 incr col $npad
1231                 set offs [incrange $tmp $col [expr {-$npad}]]
1232                 set z [lindex $offs $col]
1233                 set haspad 1
1234             }
1235             if {$z0 eq {} && !$isarrow} {
1236                 # this line links to its first child on row $row-2
1237                 set rm2 [expr {$row - 2}]
1238                 set id [lindex $displayorder $rm2]
1239                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1240                 if {$xc >= 0} {
1241                     set z0 [expr {$xc - $x0}]
1242                 }
1243             }
1244             if {$z0 ne {} && $z < 0 && $z0 > 0} {
1245                 insert_pad $y0 $x0 1
1246                 set offs [incrange $offs $col 1]
1247                 optimize_rows $y0 [expr {$x0 + 1}] $row
1248             }
1249         }
1250         if {!$haspad} {
1251             set o {}
1252             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1253                 set o [lindex $offs $col]
1254                 if {$o eq {}} {
1255                     # check if this is the link to the first child
1256                     set id [lindex $idlist $col]
1257                     if {[info exists idrowranges($id)] &&
1258                         $row == [lindex $idrowranges($id) 0]} {
1259                         # it is, work out offset to child
1260                         set y0 [expr {$row - 1}]
1261                         set id [lindex $displayorder $y0]
1262                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1263                         if {$x0 >= 0} {
1264                             set o [expr {$x0 - $col}]
1265                         }
1266                     }
1267                 }
1268                 if {$o eq {} || $o <= 0} break
1269             }
1270             if {$o ne {} && [incr col] < [llength $idlist]} {
1271                 set y1 [expr {$row + 1}]
1272                 set offs2 [lindex $rowoffsets $y1]
1273                 set x1 -1
1274                 foreach z $offs2 {
1275                     incr x1
1276                     if {$z eq {} || $x1 + $z < $col} continue
1277                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
1278                     break
1279                 }
1280                 set idlist [linsert $idlist $col {}]
1281                 set tmp [linsert $offs $col {}]
1282                 incr col
1283                 set offs [incrange $tmp $col -1]
1284             }
1285         }
1286         lset rowidlist $row $idlist
1287         lset rowoffsets $row $offs
1288         set col 0
1289     }
1290 }
1291
1292 proc xc {row col} {
1293     global canvx0 linespc
1294     return [expr {$canvx0 + $col * $linespc}]
1295 }
1296
1297 proc yc {row} {
1298     global canvy0 linespc
1299     return [expr {$canvy0 + $row * $linespc}]
1300 }
1301
1302 proc linewidth {id} {
1303     global thickerline lthickness
1304
1305     set wid $lthickness
1306     if {[info exists thickerline] && $id eq $thickerline} {
1307         set wid [expr {2 * $lthickness}]
1308     }
1309     return $wid
1310 }
1311
1312 proc drawlineseg {id i} {
1313     global rowoffsets rowidlist idrowranges
1314     global displayorder
1315     global canv colormap linespc
1316
1317     set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1318     set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1319     if {$startrow == $row} return
1320     assigncolor $id
1321     set coords {}
1322     set col [lsearch -exact [lindex $rowidlist $row] $id]
1323     if {$col < 0} {
1324         puts "oops: drawline: id $id not on row $row"
1325         return
1326     }
1327     set lasto {}
1328     set ns 0
1329     while {1} {
1330         set o [lindex $rowoffsets $row $col]
1331         if {$o eq {}} break
1332         if {$o ne $lasto} {
1333             # changing direction
1334             set x [xc $row $col]
1335             set y [yc $row]
1336             lappend coords $x $y
1337             set lasto $o
1338         }
1339         incr col $o
1340         incr row -1
1341     }
1342     set x [xc $row $col]
1343     set y [yc $row]
1344     lappend coords $x $y
1345     if {$i == 0} {
1346         # draw the link to the first child as part of this line
1347         incr row -1
1348         set child [lindex $displayorder $row]
1349         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1350         if {$ccol >= 0} {
1351             set x [xc $row $ccol]
1352             set y [yc $row]
1353             if {$ccol < $col - 1} {
1354                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1355             } elseif {$ccol > $col + 1} {
1356                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1357             }
1358             lappend coords $x $y
1359         }
1360     }
1361     if {[llength $coords] < 4} return
1362     set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1363     if {$i < $last} {
1364         # This line has an arrow at the lower end: check if the arrow is
1365         # on a diagonal segment, and if so, work around the Tk 8.4
1366         # refusal to draw arrows on diagonal lines.
1367         set x0 [lindex $coords 0]
1368         set x1 [lindex $coords 2]
1369         if {$x0 != $x1} {
1370             set y0 [lindex $coords 1]
1371             set y1 [lindex $coords 3]
1372             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1373                 # we have a nearby vertical segment, just trim off the diag bit
1374                 set coords [lrange $coords 2 end]
1375             } else {
1376                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1377                 set xi [expr {$x0 - $slope * $linespc / 2}]
1378                 set yi [expr {$y0 - $linespc / 2}]
1379                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1380             }
1381         }
1382     }
1383     set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1384     set arrow [lindex {none first last both} $arrow]
1385     set t [$canv create line $coords -width [linewidth $id] \
1386                -fill $colormap($id) -tags lines.$id -arrow $arrow]
1387     $canv lower $t
1388     bindline $t $id
1389 }
1390
1391 proc drawparentlinks {id row col olds} {
1392     global rowidlist canv colormap idrowranges
1393
1394     set row2 [expr {$row + 1}]
1395     set x [xc $row $col]
1396     set y [yc $row]
1397     set y2 [yc $row2]
1398     set ids [lindex $rowidlist $row2]
1399     # rmx = right-most X coord used
1400     set rmx 0
1401     foreach p $olds {
1402         set i [lsearch -exact $ids $p]
1403         if {$i < 0} {
1404             puts "oops, parent $p of $id not in list"
1405             continue
1406         }
1407         set x2 [xc $row2 $i]
1408         if {$x2 > $rmx} {
1409             set rmx $x2
1410         }
1411         if {[info exists idrowranges($p)] &&
1412             $row2 == [lindex $idrowranges($p) 0] &&
1413             $row2 < [lindex $idrowranges($p) 1]} {
1414             # drawlineseg will do this one for us
1415             continue
1416         }
1417         assigncolor $p
1418         # should handle duplicated parents here...
1419         set coords [list $x $y]
1420         if {$i < $col - 1} {
1421             lappend coords [xc $row [expr {$i + 1}]] $y
1422         } elseif {$i > $col + 1} {
1423             lappend coords [xc $row [expr {$i - 1}]] $y
1424         }
1425         lappend coords $x2 $y2
1426         set t [$canv create line $coords -width [linewidth $p] \
1427                    -fill $colormap($p) -tags lines.$p]
1428         $canv lower $t
1429         bindline $t $p
1430     }
1431     return $rmx
1432 }
1433
1434 proc drawlines {id} {
1435     global colormap canv
1436     global idrowranges idrangedrawn
1437     global childlist iddrawn commitrow rowidlist
1438
1439     $canv delete lines.$id
1440     set nr [expr {[llength $idrowranges($id)] / 2}]
1441     for {set i 0} {$i < $nr} {incr i} {
1442         if {[info exists idrangedrawn($id,$i)]} {
1443             drawlineseg $id $i
1444         }
1445     }
1446     foreach child [lindex $childlist $commitrow($id)] {
1447         if {[info exists iddrawn($child)]} {
1448             set row $commitrow($child)
1449             set col [lsearch -exact [lindex $rowidlist $row] $child]
1450             if {$col >= 0} {
1451                 drawparentlinks $child $row $col [list $id]
1452             }
1453         }
1454     }
1455 }
1456
1457 proc drawcmittext {id row col rmx} {
1458     global linespc canv canv2 canv3 canvy0
1459     global commitlisted commitinfo rowidlist
1460     global rowtextx idpos idtags idheads idotherrefs
1461     global linehtag linentag linedtag
1462     global mainfont namefont canvxmax
1463
1464     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1465     set x [xc $row $col]
1466     set y [yc $row]
1467     set orad [expr {$linespc / 3}]
1468     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1469                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1470                -fill $ofill -outline black -width 1]
1471     $canv raise $t
1472     $canv bind $t <1> {selcanvline {} %x %y}
1473     set xt [xc $row [llength [lindex $rowidlist $row]]]
1474     if {$xt < $rmx} {
1475         set xt $rmx
1476     }
1477     set rowtextx($row) $xt
1478     set idpos($id) [list $x $xt $y]
1479     if {[info exists idtags($id)] || [info exists idheads($id)]
1480         || [info exists idotherrefs($id)]} {
1481         set xt [drawtags $id $x $xt $y]
1482     }
1483     set headline [lindex $commitinfo($id) 0]
1484     set name [lindex $commitinfo($id) 1]
1485     set date [lindex $commitinfo($id) 2]
1486     set date [formatdate $date]
1487     set linehtag($row) [$canv create text $xt $y -anchor w \
1488                             -text $headline -font $mainfont ]
1489     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1490     set linentag($row) [$canv2 create text 3 $y -anchor w \
1491                             -text $name -font $namefont]
1492     set linedtag($row) [$canv3 create text 3 $y -anchor w \
1493                             -text $date -font $mainfont]
1494     set xr [expr {$xt + [font measure $mainfont $headline]}]
1495     if {$xr > $canvxmax} {
1496         set canvxmax $xr
1497         setcanvscroll
1498     }
1499 }
1500
1501 proc drawcmitrow {row} {
1502     global displayorder rowidlist
1503     global idrowranges idrangedrawn iddrawn
1504     global commitinfo parentlist numcommits
1505
1506     if {$row >= $numcommits} return
1507     foreach id [lindex $rowidlist $row] {
1508         if {![info exists idrowranges($id)]} continue
1509         set i -1
1510         foreach {s e} $idrowranges($id) {
1511             incr i
1512             if {$row < $s} continue
1513             if {$e eq {}} break
1514             if {$row <= $e} {
1515                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1516                     drawlineseg $id $i
1517                     set idrangedrawn($id,$i) 1
1518                 }
1519                 break
1520             }
1521         }
1522     }
1523
1524     set id [lindex $displayorder $row]
1525     if {[info exists iddrawn($id)]} return
1526     set col [lsearch -exact [lindex $rowidlist $row] $id]
1527     if {$col < 0} {
1528         puts "oops, row $row id $id not in list"
1529         return
1530     }
1531     if {![info exists commitinfo($id)]} {
1532         getcommit $id
1533     }
1534     assigncolor $id
1535     set olds [lindex $parentlist $row]
1536     if {$olds ne {}} {
1537         set rmx [drawparentlinks $id $row $col $olds]
1538     } else {
1539         set rmx 0
1540     }
1541     drawcmittext $id $row $col $rmx
1542     set iddrawn($id) 1
1543 }
1544
1545 proc drawfrac {f0 f1} {
1546     global numcommits canv
1547     global linespc
1548
1549     set ymax [lindex [$canv cget -scrollregion] 3]
1550     if {$ymax eq {} || $ymax == 0} return
1551     set y0 [expr {int($f0 * $ymax)}]
1552     set row [expr {int(($y0 - 3) / $linespc) - 1}]
1553     if {$row < 0} {
1554         set row 0
1555     }
1556     set y1 [expr {int($f1 * $ymax)}]
1557     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1558     if {$endrow >= $numcommits} {
1559         set endrow [expr {$numcommits - 1}]
1560     }
1561     for {} {$row <= $endrow} {incr row} {
1562         drawcmitrow $row
1563     }
1564 }
1565
1566 proc drawvisible {} {
1567     global canv
1568     eval drawfrac [$canv yview]
1569 }
1570
1571 proc clear_display {} {
1572     global iddrawn idrangedrawn
1573
1574     allcanvs delete all
1575     catch {unset iddrawn}
1576     catch {unset idrangedrawn}
1577 }
1578
1579 proc assigncolor {id} {
1580     global colormap colors nextcolor
1581     global commitrow parentlist children childlist
1582     global cornercrossings crossings
1583
1584     if {[info exists colormap($id)]} return
1585     set ncolors [llength $colors]
1586     if {[info exists commitrow($id)]} {
1587         set kids [lindex $childlist $commitrow($id)]
1588     } elseif {[info exists children($id)]} {
1589         set kids $children($id)
1590     } else {
1591         set kids {}
1592     }
1593     if {[llength $kids] == 1} {
1594         set child [lindex $kids 0]
1595         if {[info exists colormap($child)]
1596             && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1597             set colormap($id) $colormap($child)
1598             return
1599         }
1600     }
1601     set badcolors {}
1602     if {[info exists cornercrossings($id)]} {
1603         foreach x $cornercrossings($id) {
1604             if {[info exists colormap($x)]
1605                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1606                 lappend badcolors $colormap($x)
1607             }
1608         }
1609         if {[llength $badcolors] >= $ncolors} {
1610             set badcolors {}
1611         }
1612     }
1613     set origbad $badcolors
1614     if {[llength $badcolors] < $ncolors - 1} {
1615         if {[info exists crossings($id)]} {
1616             foreach x $crossings($id) {
1617                 if {[info exists colormap($x)]
1618                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
1619                     lappend badcolors $colormap($x)
1620                 }
1621             }
1622             if {[llength $badcolors] >= $ncolors} {
1623                 set badcolors $origbad
1624             }
1625         }
1626         set origbad $badcolors
1627     }
1628     if {[llength $badcolors] < $ncolors - 1} {
1629         foreach child $kids {
1630             if {[info exists colormap($child)]
1631                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1632                 lappend badcolors $colormap($child)
1633             }
1634             foreach p [lindex $parentlist $commitrow($child)] {
1635                 if {[info exists colormap($p)]
1636                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
1637                     lappend badcolors $colormap($p)
1638                 }
1639             }
1640         }
1641         if {[llength $badcolors] >= $ncolors} {
1642             set badcolors $origbad
1643         }
1644     }
1645     for {set i 0} {$i <= $ncolors} {incr i} {
1646         set c [lindex $colors $nextcolor]
1647         if {[incr nextcolor] >= $ncolors} {
1648             set nextcolor 0
1649         }
1650         if {[lsearch -exact $badcolors $c]} break
1651     }
1652     set colormap($id) $c
1653 }
1654
1655 proc bindline {t id} {
1656     global canv
1657
1658     $canv bind $t <Enter> "lineenter %x %y $id"
1659     $canv bind $t <Motion> "linemotion %x %y $id"
1660     $canv bind $t <Leave> "lineleave $id"
1661     $canv bind $t <Button-1> "lineclick %x %y $id 1"
1662 }
1663
1664 proc drawtags {id x xt y1} {
1665     global idtags idheads idotherrefs
1666     global linespc lthickness
1667     global canv mainfont commitrow rowtextx
1668
1669     set marks {}
1670     set ntags 0
1671     set nheads 0
1672     if {[info exists idtags($id)]} {
1673         set marks $idtags($id)
1674         set ntags [llength $marks]
1675     }
1676     if {[info exists idheads($id)]} {
1677         set marks [concat $marks $idheads($id)]
1678         set nheads [llength $idheads($id)]
1679     }
1680     if {[info exists idotherrefs($id)]} {
1681         set marks [concat $marks $idotherrefs($id)]
1682     }
1683     if {$marks eq {}} {
1684         return $xt
1685     }
1686
1687     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1688     set yt [expr {$y1 - 0.5 * $linespc}]
1689     set yb [expr {$yt + $linespc - 1}]
1690     set xvals {}
1691     set wvals {}
1692     foreach tag $marks {
1693         set wid [font measure $mainfont $tag]
1694         lappend xvals $xt
1695         lappend wvals $wid
1696         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1697     }
1698     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1699                -width $lthickness -fill black -tags tag.$id]
1700     $canv lower $t
1701     foreach tag $marks x $xvals wid $wvals {
1702         set xl [expr {$x + $delta}]
1703         set xr [expr {$x + $delta + $wid + $lthickness}]
1704         if {[incr ntags -1] >= 0} {
1705             # draw a tag
1706             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1707                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1708                        -width 1 -outline black -fill yellow -tags tag.$id]
1709             $canv bind $t <1> [list showtag $tag 1]
1710             set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1711         } else {
1712             # draw a head or other ref
1713             if {[incr nheads -1] >= 0} {
1714                 set col green
1715             } else {
1716                 set col "#ddddff"
1717             }
1718             set xl [expr {$xl - $delta/2}]
1719             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1720                 -width 1 -outline black -fill $col -tags tag.$id
1721         }
1722         set t [$canv create text $xl $y1 -anchor w -text $tag \
1723                    -font $mainfont -tags tag.$id]
1724         if {$ntags >= 0} {
1725             $canv bind $t <1> [list showtag $tag 1]
1726         }
1727     }
1728     return $xt
1729 }
1730
1731 proc checkcrossings {row endrow} {
1732     global displayorder parentlist rowidlist
1733
1734     for {} {$row < $endrow} {incr row} {
1735         set id [lindex $displayorder $row]
1736         set i [lsearch -exact [lindex $rowidlist $row] $id]
1737         if {$i < 0} continue
1738         set idlist [lindex $rowidlist [expr {$row+1}]]
1739         foreach p [lindex $parentlist $row] {
1740             set j [lsearch -exact $idlist $p]
1741             if {$j > 0} {
1742                 if {$j < $i - 1} {
1743                     notecrossings $row $p $j $i [expr {$j+1}]
1744                 } elseif {$j > $i + 1} {
1745                     notecrossings $row $p $i $j [expr {$j-1}]
1746                 }
1747             }
1748         }
1749     }
1750 }
1751
1752 proc notecrossings {row id lo hi corner} {
1753     global rowidlist crossings cornercrossings
1754
1755     for {set i $lo} {[incr i] < $hi} {} {
1756         set p [lindex [lindex $rowidlist $row] $i]
1757         if {$p == {}} continue
1758         if {$i == $corner} {
1759             if {![info exists cornercrossings($id)]
1760                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1761                 lappend cornercrossings($id) $p
1762             }
1763             if {![info exists cornercrossings($p)]
1764                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1765                 lappend cornercrossings($p) $id
1766             }
1767         } else {
1768             if {![info exists crossings($id)]
1769                 || [lsearch -exact $crossings($id) $p] < 0} {
1770                 lappend crossings($id) $p
1771             }
1772             if {![info exists crossings($p)]
1773                 || [lsearch -exact $crossings($p) $id] < 0} {
1774                 lappend crossings($p) $id
1775             }
1776         }
1777     }
1778 }
1779
1780 proc xcoord {i level ln} {
1781     global canvx0 xspc1 xspc2
1782
1783     set x [expr {$canvx0 + $i * $xspc1($ln)}]
1784     if {$i > 0 && $i == $level} {
1785         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1786     } elseif {$i > $level} {
1787         set x [expr {$x + $xspc2 - $xspc1($ln)}]
1788     }
1789     return $x
1790 }
1791
1792 proc finishcommits {} {
1793     global commitidx phase
1794     global canv mainfont ctext maincursor textcursor
1795     global findinprogress
1796
1797     if {$commitidx > 0} {
1798         drawrest
1799     } else {
1800         $canv delete all
1801         $canv create text 3 3 -anchor nw -text "No commits selected" \
1802             -font $mainfont -tags textitems
1803     }
1804     if {![info exists findinprogress]} {
1805         . config -cursor $maincursor
1806         settextcursor $textcursor
1807     }
1808     set phase {}
1809 }
1810
1811 # Don't change the text pane cursor if it is currently the hand cursor,
1812 # showing that we are over a sha1 ID link.
1813 proc settextcursor {c} {
1814     global ctext curtextcursor
1815
1816     if {[$ctext cget -cursor] == $curtextcursor} {
1817         $ctext config -cursor $c
1818     }
1819     set curtextcursor $c
1820 }
1821
1822 proc drawrest {} {
1823     global numcommits
1824     global startmsecs
1825     global canvy0 numcommits linespc
1826     global rowlaidout commitidx
1827
1828     set row $rowlaidout
1829     layoutrows $rowlaidout $commitidx 1
1830     layouttail
1831     optimize_rows $row 0 $commitidx
1832     showstuff $commitidx
1833
1834     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1835     #puts "overall $drawmsecs ms for $numcommits commits"
1836 }
1837
1838 proc findmatches {f} {
1839     global findtype foundstring foundstrlen
1840     if {$findtype == "Regexp"} {
1841         set matches [regexp -indices -all -inline $foundstring $f]
1842     } else {
1843         if {$findtype == "IgnCase"} {
1844             set str [string tolower $f]
1845         } else {
1846             set str $f
1847         }
1848         set matches {}
1849         set i 0
1850         while {[set j [string first $foundstring $str $i]] >= 0} {
1851             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1852             set i [expr {$j + $foundstrlen}]
1853         }
1854     }
1855     return $matches
1856 }
1857
1858 proc dofind {} {
1859     global findtype findloc findstring markedmatches commitinfo
1860     global numcommits displayorder linehtag linentag linedtag
1861     global mainfont namefont canv canv2 canv3 selectedline
1862     global matchinglines foundstring foundstrlen matchstring
1863     global commitdata
1864
1865     stopfindproc
1866     unmarkmatches
1867     focus .
1868     set matchinglines {}
1869     if {$findloc == "Pickaxe"} {
1870         findpatches
1871         return
1872     }
1873     if {$findtype == "IgnCase"} {
1874         set foundstring [string tolower $findstring]
1875     } else {
1876         set foundstring $findstring
1877     }
1878     set foundstrlen [string length $findstring]
1879     if {$foundstrlen == 0} return
1880     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1881     set matchstring "*$matchstring*"
1882     if {$findloc == "Files"} {
1883         findfiles
1884         return
1885     }
1886     if {![info exists selectedline]} {
1887         set oldsel -1
1888     } else {
1889         set oldsel $selectedline
1890     }
1891     set didsel 0
1892     set fldtypes {Headline Author Date Committer CDate Comment}
1893     set l -1
1894     foreach id $displayorder {
1895         set d $commitdata($id)
1896         incr l
1897         if {$findtype == "Regexp"} {
1898             set doesmatch [regexp $foundstring $d]
1899         } elseif {$findtype == "IgnCase"} {
1900             set doesmatch [string match -nocase $matchstring $d]
1901         } else {
1902             set doesmatch [string match $matchstring $d]
1903         }
1904         if {!$doesmatch} continue
1905         if {![info exists commitinfo($id)]} {
1906             getcommit $id
1907         }
1908         set info $commitinfo($id)
1909         set doesmatch 0
1910         foreach f $info ty $fldtypes {
1911             if {$findloc != "All fields" && $findloc != $ty} {
1912                 continue
1913             }
1914             set matches [findmatches $f]
1915             if {$matches == {}} continue
1916             set doesmatch 1
1917             if {$ty == "Headline"} {
1918                 drawcmitrow $l
1919                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1920             } elseif {$ty == "Author"} {
1921                 drawcmitrow $l
1922                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1923             } elseif {$ty == "Date"} {
1924                 drawcmitrow $l
1925                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1926             }
1927         }
1928         if {$doesmatch} {
1929             lappend matchinglines $l
1930             if {!$didsel && $l > $oldsel} {
1931                 findselectline $l
1932                 set didsel 1
1933             }
1934         }
1935     }
1936     if {$matchinglines == {}} {
1937         bell
1938     } elseif {!$didsel} {
1939         findselectline [lindex $matchinglines 0]
1940     }
1941 }
1942
1943 proc findselectline {l} {
1944     global findloc commentend ctext
1945     selectline $l 1
1946     if {$findloc == "All fields" || $findloc == "Comments"} {
1947         # highlight the matches in the comments
1948         set f [$ctext get 1.0 $commentend]
1949         set matches [findmatches $f]
1950         foreach match $matches {
1951             set start [lindex $match 0]
1952             set end [expr {[lindex $match 1] + 1}]
1953             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1954         }
1955     }
1956 }
1957
1958 proc findnext {restart} {
1959     global matchinglines selectedline
1960     if {![info exists matchinglines]} {
1961         if {$restart} {
1962             dofind
1963         }
1964         return
1965     }
1966     if {![info exists selectedline]} return
1967     foreach l $matchinglines {
1968         if {$l > $selectedline} {
1969             findselectline $l
1970             return
1971         }
1972     }
1973     bell
1974 }
1975
1976 proc findprev {} {
1977     global matchinglines selectedline
1978     if {![info exists matchinglines]} {
1979         dofind
1980         return
1981     }
1982     if {![info exists selectedline]} return
1983     set prev {}
1984     foreach l $matchinglines {
1985         if {$l >= $selectedline} break
1986         set prev $l
1987     }
1988     if {$prev != {}} {
1989         findselectline $prev
1990     } else {
1991         bell
1992     }
1993 }
1994
1995 proc findlocchange {name ix op} {
1996     global findloc findtype findtypemenu
1997     if {$findloc == "Pickaxe"} {
1998         set findtype Exact
1999         set state disabled
2000     } else {
2001         set state normal
2002     }
2003     $findtypemenu entryconf 1 -state $state
2004     $findtypemenu entryconf 2 -state $state
2005 }
2006
2007 proc stopfindproc {{done 0}} {
2008     global findprocpid findprocfile findids
2009     global ctext findoldcursor phase maincursor textcursor
2010     global findinprogress
2011
2012     catch {unset findids}
2013     if {[info exists findprocpid]} {
2014         if {!$done} {
2015             catch {exec kill $findprocpid}
2016         }
2017         catch {close $findprocfile}
2018         unset findprocpid
2019     }
2020     if {[info exists findinprogress]} {
2021         unset findinprogress
2022         if {$phase != "incrdraw"} {
2023             . config -cursor $maincursor
2024             settextcursor $textcursor
2025         }
2026     }
2027 }
2028
2029 proc findpatches {} {
2030     global findstring selectedline numcommits
2031     global findprocpid findprocfile
2032     global finddidsel ctext displayorder findinprogress
2033     global findinsertpos
2034
2035     if {$numcommits == 0} return
2036
2037     # make a list of all the ids to search, starting at the one
2038     # after the selected line (if any)
2039     if {[info exists selectedline]} {
2040         set l $selectedline
2041     } else {
2042         set l -1
2043     }
2044     set inputids {}
2045     for {set i 0} {$i < $numcommits} {incr i} {
2046         if {[incr l] >= $numcommits} {
2047             set l 0
2048         }
2049         append inputids [lindex $displayorder $l] "\n"
2050     }
2051
2052     if {[catch {
2053         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2054                          << $inputids] r]
2055     } err]} {
2056         error_popup "Error starting search process: $err"
2057         return
2058     }
2059
2060     set findinsertpos end
2061     set findprocfile $f
2062     set findprocpid [pid $f]
2063     fconfigure $f -blocking 0
2064     fileevent $f readable readfindproc
2065     set finddidsel 0
2066     . config -cursor watch
2067     settextcursor watch
2068     set findinprogress 1
2069 }
2070
2071 proc readfindproc {} {
2072     global findprocfile finddidsel
2073     global commitrow matchinglines findinsertpos
2074
2075     set n [gets $findprocfile line]
2076     if {$n < 0} {
2077         if {[eof $findprocfile]} {
2078             stopfindproc 1
2079             if {!$finddidsel} {
2080                 bell
2081             }
2082         }
2083         return
2084     }
2085     if {![regexp {^[0-9a-f]{40}} $line id]} {
2086         error_popup "Can't parse git-diff-tree output: $line"
2087         stopfindproc
2088         return
2089     }
2090     if {![info exists commitrow($id)]} {
2091         puts stderr "spurious id: $id"
2092         return
2093     }
2094     set l $commitrow($id)
2095     insertmatch $l $id
2096 }
2097
2098 proc insertmatch {l id} {
2099     global matchinglines findinsertpos finddidsel
2100
2101     if {$findinsertpos == "end"} {
2102         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2103             set matchinglines [linsert $matchinglines 0 $l]
2104             set findinsertpos 1
2105         } else {
2106             lappend matchinglines $l
2107         }
2108     } else {
2109         set matchinglines [linsert $matchinglines $findinsertpos $l]
2110         incr findinsertpos
2111     }
2112     markheadline $l $id
2113     if {!$finddidsel} {
2114         findselectline $l
2115         set finddidsel 1
2116     }
2117 }
2118
2119 proc findfiles {} {
2120     global selectedline numcommits displayorder ctext
2121     global ffileline finddidsel parentlist
2122     global findinprogress findstartline findinsertpos
2123     global treediffs fdiffid fdiffsneeded fdiffpos
2124     global findmergefiles
2125
2126     if {$numcommits == 0} return
2127
2128     if {[info exists selectedline]} {
2129         set l [expr {$selectedline + 1}]
2130     } else {
2131         set l 0
2132     }
2133     set ffileline $l
2134     set findstartline $l
2135     set diffsneeded {}
2136     set fdiffsneeded {}
2137     while 1 {
2138         set id [lindex $displayorder $l]
2139         if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2140             if {![info exists treediffs($id)]} {
2141                 append diffsneeded "$id\n"
2142                 lappend fdiffsneeded $id
2143             }
2144         }
2145         if {[incr l] >= $numcommits} {
2146             set l 0
2147         }
2148         if {$l == $findstartline} break
2149     }
2150
2151     # start off a git-diff-tree process if needed
2152     if {$diffsneeded ne {}} {
2153         if {[catch {
2154             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2155         } err ]} {
2156             error_popup "Error starting search process: $err"
2157             return
2158         }
2159         catch {unset fdiffid}
2160         set fdiffpos 0
2161         fconfigure $df -blocking 0
2162         fileevent $df readable [list readfilediffs $df]
2163     }
2164
2165     set finddidsel 0
2166     set findinsertpos end
2167     set id [lindex $displayorder $l]
2168     . config -cursor watch
2169     settextcursor watch
2170     set findinprogress 1
2171     findcont
2172     update
2173 }
2174
2175 proc readfilediffs {df} {
2176     global findid fdiffid fdiffs
2177
2178     set n [gets $df line]
2179     if {$n < 0} {
2180         if {[eof $df]} {
2181             donefilediff
2182             if {[catch {close $df} err]} {
2183                 stopfindproc
2184                 bell
2185                 error_popup "Error in git-diff-tree: $err"
2186             } elseif {[info exists findid]} {
2187                 set id $findid
2188                 stopfindproc
2189                 bell
2190                 error_popup "Couldn't find diffs for $id"
2191             }
2192         }
2193         return
2194     }
2195     if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2196         # start of a new string of diffs
2197         donefilediff
2198         set fdiffid $id
2199         set fdiffs {}
2200     } elseif {[string match ":*" $line]} {
2201         lappend fdiffs [lindex $line 5]
2202     }
2203 }
2204
2205 proc donefilediff {} {
2206     global fdiffid fdiffs treediffs findid
2207     global fdiffsneeded fdiffpos
2208
2209     if {[info exists fdiffid]} {
2210         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2211                && $fdiffpos < [llength $fdiffsneeded]} {
2212             # git-diff-tree doesn't output anything for a commit
2213             # which doesn't change anything
2214             set nullid [lindex $fdiffsneeded $fdiffpos]
2215             set treediffs($nullid) {}
2216             if {[info exists findid] && $nullid eq $findid} {
2217                 unset findid
2218                 findcont
2219             }
2220             incr fdiffpos
2221         }
2222         incr fdiffpos
2223
2224         if {![info exists treediffs($fdiffid)]} {
2225             set treediffs($fdiffid) $fdiffs
2226         }
2227         if {[info exists findid] && $fdiffid eq $findid} {
2228             unset findid
2229             findcont
2230         }
2231     }
2232 }
2233
2234 proc findcont {} {
2235     global findid treediffs parentlist
2236     global ffileline findstartline finddidsel
2237     global displayorder numcommits matchinglines findinprogress
2238     global findmergefiles
2239
2240     set l $ffileline
2241     while {1} {
2242         set id [lindex $displayorder $l]
2243         if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2244             if {![info exists treediffs($id)]} {
2245                 set findid $id
2246                 set ffileline $l
2247                 return
2248             }
2249             set doesmatch 0
2250             foreach f $treediffs($id) {
2251                 set x [findmatches $f]
2252                 if {$x != {}} {
2253                     set doesmatch 1
2254                     break
2255                 }
2256             }
2257             if {$doesmatch} {
2258                 insertmatch $l $id
2259             }
2260         }
2261         if {[incr l] >= $numcommits} {
2262             set l 0
2263         }
2264         if {$l == $findstartline} break
2265     }
2266     stopfindproc
2267     if {!$finddidsel} {
2268         bell
2269     }
2270 }
2271
2272 # mark a commit as matching by putting a yellow background
2273 # behind the headline
2274 proc markheadline {l id} {
2275     global canv mainfont linehtag
2276
2277     drawcmitrow $l
2278     set bbox [$canv bbox $linehtag($l)]
2279     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2280     $canv lower $t
2281 }
2282
2283 # mark the bits of a headline, author or date that match a find string
2284 proc markmatches {canv l str tag matches font} {
2285     set bbox [$canv bbox $tag]
2286     set x0 [lindex $bbox 0]
2287     set y0 [lindex $bbox 1]
2288     set y1 [lindex $bbox 3]
2289     foreach match $matches {
2290         set start [lindex $match 0]
2291         set end [lindex $match 1]
2292         if {$start > $end} continue
2293         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2294         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2295         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2296                    [expr {$x0+$xlen+2}] $y1 \
2297                    -outline {} -tags matches -fill yellow]
2298         $canv lower $t
2299     }
2300 }
2301
2302 proc unmarkmatches {} {
2303     global matchinglines findids
2304     allcanvs delete matches
2305     catch {unset matchinglines}
2306     catch {unset findids}
2307 }
2308
2309 proc selcanvline {w x y} {
2310     global canv canvy0 ctext linespc
2311     global rowtextx
2312     set ymax [lindex [$canv cget -scrollregion] 3]
2313     if {$ymax == {}} return
2314     set yfrac [lindex [$canv yview] 0]
2315     set y [expr {$y + $yfrac * $ymax}]
2316     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2317     if {$l < 0} {
2318         set l 0
2319     }
2320     if {$w eq $canv} {
2321         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2322     }
2323     unmarkmatches
2324     selectline $l 1
2325 }
2326
2327 proc commit_descriptor {p} {
2328     global commitinfo
2329     set l "..."
2330     if {[info exists commitinfo($p)]} {
2331         set l [lindex $commitinfo($p) 0]
2332     }
2333     return "$p ($l)"
2334 }
2335
2336 # append some text to the ctext widget, and make any SHA1 ID
2337 # that we know about be a clickable link.
2338 proc appendwithlinks {text} {
2339     global ctext commitrow linknum
2340
2341     set start [$ctext index "end - 1c"]
2342     $ctext insert end $text
2343     $ctext insert end "\n"
2344     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2345     foreach l $links {
2346         set s [lindex $l 0]
2347         set e [lindex $l 1]
2348         set linkid [string range $text $s $e]
2349         if {![info exists commitrow($linkid)]} continue
2350         incr e
2351         $ctext tag add link "$start + $s c" "$start + $e c"
2352         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2353         $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2354         incr linknum
2355     }
2356     $ctext tag conf link -foreground blue -underline 1
2357     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2358     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2359 }
2360
2361 proc viewnextline {dir} {
2362     global canv linespc
2363
2364     $canv delete hover
2365     set ymax [lindex [$canv cget -scrollregion] 3]
2366     set wnow [$canv yview]
2367     set wtop [expr {[lindex $wnow 0] * $ymax}]
2368     set newtop [expr {$wtop + $dir * $linespc}]
2369     if {$newtop < 0} {
2370         set newtop 0
2371     } elseif {$newtop > $ymax} {
2372         set newtop $ymax
2373     }
2374     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2375 }
2376
2377 proc selectline {l isnew} {
2378     global canv canv2 canv3 ctext commitinfo selectedline
2379     global displayorder linehtag linentag linedtag
2380     global canvy0 linespc parentlist childlist
2381     global cflist currentid sha1entry
2382     global commentend idtags linknum
2383     global mergemax numcommits
2384
2385     $canv delete hover
2386     normalline
2387     if {$l < 0 || $l >= $numcommits} return
2388     set y [expr {$canvy0 + $l * $linespc}]
2389     set ymax [lindex [$canv cget -scrollregion] 3]
2390     set ytop [expr {$y - $linespc - 1}]
2391     set ybot [expr {$y + $linespc + 1}]
2392     set wnow [$canv yview]
2393     set wtop [expr {[lindex $wnow 0] * $ymax}]
2394     set wbot [expr {[lindex $wnow 1] * $ymax}]
2395     set wh [expr {$wbot - $wtop}]
2396     set newtop $wtop
2397     if {$ytop < $wtop} {
2398         if {$ybot < $wtop} {
2399             set newtop [expr {$y - $wh / 2.0}]
2400         } else {
2401             set newtop $ytop
2402             if {$newtop > $wtop - $linespc} {
2403                 set newtop [expr {$wtop - $linespc}]
2404             }
2405         }
2406     } elseif {$ybot > $wbot} {
2407         if {$ytop > $wbot} {
2408             set newtop [expr {$y - $wh / 2.0}]
2409         } else {
2410             set newtop [expr {$ybot - $wh}]
2411             if {$newtop < $wtop + $linespc} {
2412                 set newtop [expr {$wtop + $linespc}]
2413             }
2414         }
2415     }
2416     if {$newtop != $wtop} {
2417         if {$newtop < 0} {
2418             set newtop 0
2419         }
2420         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2421         drawvisible
2422     }
2423
2424     if {![info exists linehtag($l)]} return
2425     $canv delete secsel
2426     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2427                -tags secsel -fill [$canv cget -selectbackground]]
2428     $canv lower $t
2429     $canv2 delete secsel
2430     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2431                -tags secsel -fill [$canv2 cget -selectbackground]]
2432     $canv2 lower $t
2433     $canv3 delete secsel
2434     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2435                -tags secsel -fill [$canv3 cget -selectbackground]]
2436     $canv3 lower $t
2437
2438     if {$isnew} {
2439         addtohistory [list selectline $l 0]
2440     }
2441
2442     set selectedline $l
2443
2444     set id [lindex $displayorder $l]
2445     set currentid $id
2446     $sha1entry delete 0 end
2447     $sha1entry insert 0 $id
2448     $sha1entry selection from 0
2449     $sha1entry selection to end
2450
2451     $ctext conf -state normal
2452     $ctext delete 0.0 end
2453     set linknum 0
2454     $ctext mark set fmark.0 0.0
2455     $ctext mark gravity fmark.0 left
2456     set info $commitinfo($id)
2457     set date [formatdate [lindex $info 2]]
2458     $ctext insert end "Author: [lindex $info 1]  $date\n"
2459     set date [formatdate [lindex $info 4]]
2460     $ctext insert end "Committer: [lindex $info 3]  $date\n"
2461     if {[info exists idtags($id)]} {
2462         $ctext insert end "Tags:"
2463         foreach tag $idtags($id) {
2464             $ctext insert end " $tag"
2465         }
2466         $ctext insert end "\n"
2467     }
2468
2469     set comment {}
2470     set olds [lindex $parentlist $l]
2471     if {[llength $olds] > 1} {
2472         set np 0
2473         foreach p $olds {
2474             if {$np >= $mergemax} {
2475                 set tag mmax
2476             } else {
2477                 set tag m$np
2478             }
2479             $ctext insert end "Parent: " $tag
2480             appendwithlinks [commit_descriptor $p]
2481             incr np
2482         }
2483     } else {
2484         foreach p $olds {
2485             append comment "Parent: [commit_descriptor $p]\n"
2486         }
2487     }
2488
2489     foreach c [lindex $childlist $l] {
2490         append comment "Child:  [commit_descriptor $c]\n"
2491     }
2492     append comment "\n"
2493     append comment [lindex $info 5]
2494
2495     # make anything that looks like a SHA1 ID be a clickable link
2496     appendwithlinks $comment
2497
2498     $ctext tag delete Comments
2499     $ctext tag remove found 1.0 end
2500     $ctext conf -state disabled
2501     set commentend [$ctext index "end - 1c"]
2502
2503     $cflist delete 0 end
2504     $cflist insert end "Comments"
2505     if {[llength $olds] <= 1} {
2506         startdiff $id
2507     } else {
2508         mergediff $id $l
2509     }
2510 }
2511
2512 proc selfirstline {} {
2513     unmarkmatches
2514     selectline 0 1
2515 }
2516
2517 proc sellastline {} {
2518     global numcommits
2519     unmarkmatches
2520     set l [expr {$numcommits - 1}]
2521     selectline $l 1
2522 }
2523
2524 proc selnextline {dir} {
2525     global selectedline
2526     if {![info exists selectedline]} return
2527     set l [expr {$selectedline + $dir}]
2528     unmarkmatches
2529     selectline $l 1
2530 }
2531
2532 proc selnextpage {dir} {
2533     global canv linespc selectedline numcommits
2534
2535     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2536     if {$lpp < 1} {
2537         set lpp 1
2538     }
2539     allcanvs yview scroll [expr {$dir * $lpp}] units
2540     if {![info exists selectedline]} return
2541     set l [expr {$selectedline + $dir * $lpp}]
2542     if {$l < 0} {
2543         set l 0
2544     } elseif {$l >= $numcommits} {
2545         set l [expr $numcommits - 1]
2546     }
2547     unmarkmatches
2548     selectline $l 1
2549 }
2550
2551 proc unselectline {} {
2552     global selectedline
2553
2554     catch {unset selectedline}
2555     allcanvs delete secsel
2556 }
2557
2558 proc addtohistory {cmd} {
2559     global history historyindex
2560
2561     if {$historyindex > 0
2562         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2563         return
2564     }
2565
2566     if {$historyindex < [llength $history]} {
2567         set history [lreplace $history $historyindex end $cmd]
2568     } else {
2569         lappend history $cmd
2570     }
2571     incr historyindex
2572     if {$historyindex > 1} {
2573         .ctop.top.bar.leftbut conf -state normal
2574     } else {
2575         .ctop.top.bar.leftbut conf -state disabled
2576     }
2577     .ctop.top.bar.rightbut conf -state disabled
2578 }
2579
2580 proc goback {} {
2581     global history historyindex
2582
2583     if {$historyindex > 1} {
2584         incr historyindex -1
2585         set cmd [lindex $history [expr {$historyindex - 1}]]
2586         eval $cmd
2587         .ctop.top.bar.rightbut conf -state normal
2588     }
2589     if {$historyindex <= 1} {
2590         .ctop.top.bar.leftbut conf -state disabled
2591     }
2592 }
2593
2594 proc goforw {} {
2595     global history historyindex
2596
2597     if {$historyindex < [llength $history]} {
2598         set cmd [lindex $history $historyindex]
2599         incr historyindex
2600         eval $cmd
2601         .ctop.top.bar.leftbut conf -state normal
2602     }
2603     if {$historyindex >= [llength $history]} {
2604         .ctop.top.bar.rightbut conf -state disabled
2605     }
2606 }
2607
2608 proc mergediff {id l} {
2609     global diffmergeid diffopts mdifffd
2610     global difffilestart diffids
2611     global parentlist
2612
2613     set diffmergeid $id
2614     set diffids $id
2615     catch {unset difffilestart}
2616     # this doesn't seem to actually affect anything...
2617     set env(GIT_DIFF_OPTS) $diffopts
2618     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2619     if {[catch {set mdf [open $cmd r]} err]} {
2620         error_popup "Error getting merge diffs: $err"
2621         return
2622     }
2623     fconfigure $mdf -blocking 0
2624     set mdifffd($id) $mdf
2625     set np [llength [lindex $parentlist $l]]
2626     fileevent $mdf readable [list getmergediffline $mdf $id $np]
2627     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2628 }
2629
2630 proc getmergediffline {mdf id np} {
2631     global diffmergeid ctext cflist nextupdate mergemax
2632     global difffilestart mdifffd
2633
2634     set n [gets $mdf line]
2635     if {$n < 0} {
2636         if {[eof $mdf]} {
2637             close $mdf
2638         }
2639         return
2640     }
2641     if {![info exists diffmergeid] || $id != $diffmergeid
2642         || $mdf != $mdifffd($id)} {
2643         return
2644     }
2645     $ctext conf -state normal
2646     if {[regexp {^diff --cc (.*)} $line match fname]} {
2647         # start of a new file
2648         $ctext insert end "\n"
2649         set here [$ctext index "end - 1c"]
2650         set i [$cflist index end]
2651         $ctext mark set fmark.$i $here
2652         $ctext mark gravity fmark.$i left
2653         set difffilestart([expr {$i-1}]) $here
2654         $cflist insert end $fname
2655         set l [expr {(78 - [string length $fname]) / 2}]
2656         set pad [string range "----------------------------------------" 1 $l]
2657         $ctext insert end "$pad $fname $pad\n" filesep
2658     } elseif {[regexp {^@@} $line]} {
2659         $ctext insert end "$line\n" hunksep
2660     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2661         # do nothing
2662     } else {
2663         # parse the prefix - one ' ', '-' or '+' for each parent
2664         set spaces {}
2665         set minuses {}
2666         set pluses {}
2667         set isbad 0
2668         for {set j 0} {$j < $np} {incr j} {
2669             set c [string range $line $j $j]
2670             if {$c == " "} {
2671                 lappend spaces $j
2672             } elseif {$c == "-"} {
2673                 lappend minuses $j
2674             } elseif {$c == "+"} {
2675                 lappend pluses $j
2676             } else {
2677                 set isbad 1
2678                 break
2679             }
2680         }
2681         set tags {}
2682         set num {}
2683         if {!$isbad && $minuses ne {} && $pluses eq {}} {
2684             # line doesn't appear in result, parents in $minuses have the line
2685             set num [lindex $minuses 0]
2686         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2687             # line appears in result, parents in $pluses don't have the line
2688             lappend tags mresult
2689             set num [lindex $spaces 0]
2690         }
2691         if {$num ne {}} {
2692             if {$num >= $mergemax} {
2693                 set num "max"
2694             }
2695             lappend tags m$num
2696         }
2697         $ctext insert end "$line\n" $tags
2698     }
2699     $ctext conf -state disabled
2700     if {[clock clicks -milliseconds] >= $nextupdate} {
2701         incr nextupdate 100
2702         fileevent $mdf readable {}
2703         update
2704         fileevent $mdf readable [list getmergediffline $mdf $id $np]
2705     }
2706 }
2707
2708 proc startdiff {ids} {
2709     global treediffs diffids treepending diffmergeid
2710
2711     set diffids $ids
2712     catch {unset diffmergeid}
2713     if {![info exists treediffs($ids)]} {
2714         if {![info exists treepending]} {
2715             gettreediffs $ids
2716         }
2717     } else {
2718         addtocflist $ids
2719     }
2720 }
2721
2722 proc addtocflist {ids} {
2723     global treediffs cflist
2724     foreach f $treediffs($ids) {
2725         $cflist insert end $f
2726     }
2727     getblobdiffs $ids
2728 }
2729
2730 proc gettreediffs {ids} {
2731     global treediff treepending
2732     set treepending $ids
2733     set treediff {}
2734     if {[catch \
2735          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2736         ]} return
2737     fconfigure $gdtf -blocking 0
2738     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2739 }
2740
2741 proc gettreediffline {gdtf ids} {
2742     global treediff treediffs treepending diffids diffmergeid
2743
2744     set n [gets $gdtf line]
2745     if {$n < 0} {
2746         if {![eof $gdtf]} return
2747         close $gdtf
2748         set treediffs($ids) $treediff
2749         unset treepending
2750         if {$ids != $diffids} {
2751             if {![info exists diffmergeid]} {
2752                 gettreediffs $diffids
2753             }
2754         } else {
2755             addtocflist $ids
2756         }
2757         return
2758     }
2759     set file [lindex $line 5]
2760     lappend treediff $file
2761 }
2762
2763 proc getblobdiffs {ids} {
2764     global diffopts blobdifffd diffids env curdifftag curtagstart
2765     global difffilestart nextupdate diffinhdr treediffs
2766
2767     set env(GIT_DIFF_OPTS) $diffopts
2768     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2769     if {[catch {set bdf [open $cmd r]} err]} {
2770         puts "error getting diffs: $err"
2771         return
2772     }
2773     set diffinhdr 0
2774     fconfigure $bdf -blocking 0
2775     set blobdifffd($ids) $bdf
2776     set curdifftag Comments
2777     set curtagstart 0.0
2778     catch {unset difffilestart}
2779     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2780     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2781 }
2782
2783 proc getblobdiffline {bdf ids} {
2784     global diffids blobdifffd ctext curdifftag curtagstart
2785     global diffnexthead diffnextnote difffilestart
2786     global nextupdate diffinhdr treediffs
2787
2788     set n [gets $bdf line]
2789     if {$n < 0} {
2790         if {[eof $bdf]} {
2791             close $bdf
2792             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2793                 $ctext tag add $curdifftag $curtagstart end
2794             }
2795         }
2796         return
2797     }
2798     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2799         return
2800     }
2801     $ctext conf -state normal
2802     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2803         # start of a new file
2804         $ctext insert end "\n"
2805         $ctext tag add $curdifftag $curtagstart end
2806         set curtagstart [$ctext index "end - 1c"]
2807         set header $newname
2808         set here [$ctext index "end - 1c"]
2809         set i [lsearch -exact $treediffs($diffids) $fname]
2810         if {$i >= 0} {
2811             set difffilestart($i) $here
2812             incr i
2813             $ctext mark set fmark.$i $here
2814             $ctext mark gravity fmark.$i left
2815         }
2816         if {$newname != $fname} {
2817             set i [lsearch -exact $treediffs($diffids) $newname]
2818             if {$i >= 0} {
2819                 set difffilestart($i) $here
2820                 incr i
2821                 $ctext mark set fmark.$i $here
2822                 $ctext mark gravity fmark.$i left
2823             }
2824         }
2825         set curdifftag "f:$fname"
2826         $ctext tag delete $curdifftag
2827         set l [expr {(78 - [string length $header]) / 2}]
2828         set pad [string range "----------------------------------------" 1 $l]
2829         $ctext insert end "$pad $header $pad\n" filesep
2830         set diffinhdr 1
2831     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2832         # do nothing
2833     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2834         set diffinhdr 0
2835     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2836                    $line match f1l f1c f2l f2c rest]} {
2837         $ctext insert end "$line\n" hunksep
2838         set diffinhdr 0
2839     } else {
2840         set x [string range $line 0 0]
2841         if {$x == "-" || $x == "+"} {
2842             set tag [expr {$x == "+"}]
2843             $ctext insert end "$line\n" d$tag
2844         } elseif {$x == " "} {
2845             $ctext insert end "$line\n"
2846         } elseif {$diffinhdr || $x == "\\"} {
2847             # e.g. "\ No newline at end of file"
2848             $ctext insert end "$line\n" filesep
2849         } else {
2850             # Something else we don't recognize
2851             if {$curdifftag != "Comments"} {
2852                 $ctext insert end "\n"
2853                 $ctext tag add $curdifftag $curtagstart end
2854                 set curtagstart [$ctext index "end - 1c"]
2855                 set curdifftag Comments
2856             }
2857             $ctext insert end "$line\n" filesep
2858         }
2859     }
2860     $ctext conf -state disabled
2861     if {[clock clicks -milliseconds] >= $nextupdate} {
2862         incr nextupdate 100
2863         fileevent $bdf readable {}
2864         update
2865         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2866     }
2867 }
2868
2869 proc nextfile {} {
2870     global difffilestart ctext
2871     set here [$ctext index @0,0]
2872     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2873         if {[$ctext compare $difffilestart($i) > $here]} {
2874             if {![info exists pos]
2875                 || [$ctext compare $difffilestart($i) < $pos]} {
2876                 set pos $difffilestart($i)
2877             }
2878         }
2879     }
2880     if {[info exists pos]} {
2881         $ctext yview $pos
2882     }
2883 }
2884
2885 proc listboxsel {} {
2886     global ctext cflist currentid
2887     if {![info exists currentid]} return
2888     set sel [lsort [$cflist curselection]]
2889     if {$sel eq {}} return
2890     set first [lindex $sel 0]
2891     catch {$ctext yview fmark.$first}
2892 }
2893
2894 proc setcoords {} {
2895     global linespc charspc canvx0 canvy0 mainfont
2896     global xspc1 xspc2 lthickness
2897
2898     set linespc [font metrics $mainfont -linespace]
2899     set charspc [font measure $mainfont "m"]
2900     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2901     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2902     set lthickness [expr {int($linespc / 9) + 1}]
2903     set xspc1(0) $linespc
2904     set xspc2 $linespc
2905 }
2906
2907 proc redisplay {} {
2908     global canv
2909     global selectedline
2910
2911     set ymax [lindex [$canv cget -scrollregion] 3]
2912     if {$ymax eq {} || $ymax == 0} return
2913     set span [$canv yview]
2914     clear_display
2915     setcanvscroll
2916     allcanvs yview moveto [lindex $span 0]
2917     drawvisible
2918     if {[info exists selectedline]} {
2919         selectline $selectedline 0
2920     }
2921 }
2922
2923 proc incrfont {inc} {
2924     global mainfont namefont textfont ctext canv phase
2925     global stopped entries
2926     unmarkmatches
2927     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2928     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2929     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2930     setcoords
2931     $ctext conf -font $textfont
2932     $ctext tag conf filesep -font [concat $textfont bold]
2933     foreach e $entries {
2934         $e conf -font $mainfont
2935     }
2936     if {$phase == "getcommits"} {
2937         $canv itemconf textitems -font $mainfont
2938     }
2939     redisplay
2940 }
2941
2942 proc clearsha1 {} {
2943     global sha1entry sha1string
2944     if {[string length $sha1string] == 40} {
2945         $sha1entry delete 0 end
2946     }
2947 }
2948
2949 proc sha1change {n1 n2 op} {
2950     global sha1string currentid sha1but
2951     if {$sha1string == {}
2952         || ([info exists currentid] && $sha1string == $currentid)} {
2953         set state disabled
2954     } else {
2955         set state normal
2956     }
2957     if {[$sha1but cget -state] == $state} return
2958     if {$state == "normal"} {
2959         $sha1but conf -state normal -relief raised -text "Goto: "
2960     } else {
2961         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2962     }
2963 }
2964
2965 proc gotocommit {} {
2966     global sha1string currentid commitrow tagids headids
2967     global displayorder numcommits
2968
2969     if {$sha1string == {}
2970         || ([info exists currentid] && $sha1string == $currentid)} return
2971     if {[info exists tagids($sha1string)]} {
2972         set id $tagids($sha1string)
2973     } elseif {[info exists headids($sha1string)]} {
2974         set id $headids($sha1string)
2975     } else {
2976         set id [string tolower $sha1string]
2977         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2978             set matches {}
2979             foreach i $displayorder {
2980                 if {[string match $id* $i]} {
2981                     lappend matches $i
2982                 }
2983             }
2984             if {$matches ne {}} {
2985                 if {[llength $matches] > 1} {
2986                     error_popup "Short SHA1 id $id is ambiguous"
2987                     return
2988                 }
2989                 set id [lindex $matches 0]
2990             }
2991         }
2992     }
2993     if {[info exists commitrow($id)]} {
2994         selectline $commitrow($id) 1
2995         return
2996     }
2997     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2998         set type "SHA1 id"
2999     } else {
3000         set type "Tag/Head"
3001     }
3002     error_popup "$type $sha1string is not known"
3003 }
3004
3005 proc lineenter {x y id} {
3006     global hoverx hovery hoverid hovertimer
3007     global commitinfo canv
3008
3009     if {![info exists commitinfo($id)] && ![getcommit $id]} return
3010     set hoverx $x
3011     set hovery $y
3012     set hoverid $id
3013     if {[info exists hovertimer]} {
3014         after cancel $hovertimer
3015     }
3016     set hovertimer [after 500 linehover]
3017     $canv delete hover
3018 }
3019
3020 proc linemotion {x y id} {
3021     global hoverx hovery hoverid hovertimer
3022
3023     if {[info exists hoverid] && $id == $hoverid} {
3024         set hoverx $x
3025         set hovery $y
3026         if {[info exists hovertimer]} {
3027             after cancel $hovertimer
3028         }
3029         set hovertimer [after 500 linehover]
3030     }
3031 }
3032
3033 proc lineleave {id} {
3034     global hoverid hovertimer canv
3035
3036     if {[info exists hoverid] && $id == $hoverid} {
3037         $canv delete hover
3038         if {[info exists hovertimer]} {
3039             after cancel $hovertimer
3040             unset hovertimer
3041         }
3042         unset hoverid
3043     }
3044 }
3045
3046 proc linehover {} {
3047     global hoverx hovery hoverid hovertimer
3048     global canv linespc lthickness
3049     global commitinfo mainfont
3050
3051     set text [lindex $commitinfo($hoverid) 0]
3052     set ymax [lindex [$canv cget -scrollregion] 3]
3053     if {$ymax == {}} return
3054     set yfrac [lindex [$canv yview] 0]
3055     set x [expr {$hoverx + 2 * $linespc}]
3056     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3057     set x0 [expr {$x - 2 * $lthickness}]
3058     set y0 [expr {$y - 2 * $lthickness}]
3059     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3060     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3061     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3062                -fill \#ffff80 -outline black -width 1 -tags hover]
3063     $canv raise $t
3064     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3065     $canv raise $t
3066 }
3067
3068 proc clickisonarrow {id y} {
3069     global lthickness idrowranges
3070
3071     set thresh [expr {2 * $lthickness + 6}]
3072     set n [expr {[llength $idrowranges($id)] - 1}]
3073     for {set i 1} {$i < $n} {incr i} {
3074         set row [lindex $idrowranges($id) $i]
3075         if {abs([yc $row] - $y) < $thresh} {
3076             return $i
3077         }
3078     }
3079     return {}
3080 }
3081
3082 proc arrowjump {id n y} {
3083     global idrowranges canv
3084
3085     # 1 <-> 2, 3 <-> 4, etc...
3086     set n [expr {(($n - 1) ^ 1) + 1}]
3087     set row [lindex $idrowranges($id) $n]
3088     set yt [yc $row]
3089     set ymax [lindex [$canv cget -scrollregion] 3]
3090     if {$ymax eq {} || $ymax <= 0} return
3091     set view [$canv yview]
3092     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3093     set yfrac [expr {$yt / $ymax - $yspan / 2}]
3094     if {$yfrac < 0} {
3095         set yfrac 0
3096     }
3097     allcanvs yview moveto $yfrac
3098 }
3099
3100 proc lineclick {x y id isnew} {
3101     global ctext commitinfo childlist commitrow cflist canv thickerline
3102
3103     if {![info exists commitinfo($id)] && ![getcommit $id]} return
3104     unmarkmatches
3105     unselectline
3106     normalline
3107     $canv delete hover
3108     # draw this line thicker than normal
3109     set thickerline $id
3110     drawlines $id
3111     if {$isnew} {
3112         set ymax [lindex [$canv cget -scrollregion] 3]
3113         if {$ymax eq {}} return
3114         set yfrac [lindex [$canv yview] 0]
3115         set y [expr {$y + $yfrac * $ymax}]
3116     }
3117     set dirn [clickisonarrow $id $y]
3118     if {$dirn ne {}} {
3119         arrowjump $id $dirn $y
3120         return
3121     }
3122
3123     if {$isnew} {
3124         addtohistory [list lineclick $x $y $id 0]
3125     }
3126     # fill the details pane with info about this line
3127     $ctext conf -state normal
3128     $ctext delete 0.0 end
3129     $ctext tag conf link -foreground blue -underline 1
3130     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3131     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3132     $ctext insert end "Parent:\t"
3133     $ctext insert end $id [list link link0]
3134     $ctext tag bind link0 <1> [list selbyid $id]
3135     set info $commitinfo($id)
3136     $ctext insert end "\n\t[lindex $info 0]\n"
3137     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3138     set date [formatdate [lindex $info 2]]
3139     $ctext insert end "\tDate:\t$date\n"
3140     set kids [lindex $childlist $commitrow($id)]
3141     if {$kids ne {}} {
3142         $ctext insert end "\nChildren:"
3143         set i 0
3144         foreach child $kids {
3145             incr i
3146             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3147             set info $commitinfo($child)
3148             $ctext insert end "\n\t"
3149             $ctext insert end $child [list link link$i]
3150             $ctext tag bind link$i <1> [list selbyid $child]
3151             $ctext insert end "\n\t[lindex $info 0]"
3152             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3153             set date [formatdate [lindex $info 2]]
3154             $ctext insert end "\n\tDate:\t$date\n"
3155         }
3156     }
3157     $ctext conf -state disabled
3158
3159     $cflist delete 0 end
3160 }
3161
3162 proc normalline {} {
3163     global thickerline
3164     if {[info exists thickerline]} {
3165         set id $thickerline
3166         unset thickerline
3167         drawlines $id
3168     }
3169 }
3170
3171 proc selbyid {id} {
3172     global commitrow
3173     if {[info exists commitrow($id)]} {
3174         selectline $commitrow($id) 1
3175     }
3176 }
3177
3178 proc mstime {} {
3179     global startmstime
3180     if {![info exists startmstime]} {
3181         set startmstime [clock clicks -milliseconds]
3182     }
3183     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3184 }
3185
3186 proc rowmenu {x y id} {
3187     global rowctxmenu commitrow selectedline rowmenuid
3188
3189     if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3190         set state disabled
3191     } else {
3192         set state normal
3193     }
3194     $rowctxmenu entryconfigure 0 -state $state
3195     $rowctxmenu entryconfigure 1 -state $state
3196     $rowctxmenu entryconfigure 2 -state $state
3197     set rowmenuid $id
3198     tk_popup $rowctxmenu $x $y
3199 }
3200
3201 proc diffvssel {dirn} {
3202     global rowmenuid selectedline displayorder
3203
3204     if {![info exists selectedline]} return
3205     if {$dirn} {
3206         set oldid [lindex $displayorder $selectedline]
3207         set newid $rowmenuid
3208     } else {
3209         set oldid $rowmenuid
3210         set newid [lindex $displayorder $selectedline]
3211     }
3212     addtohistory [list doseldiff $oldid $newid]
3213     doseldiff $oldid $newid
3214 }
3215
3216 proc doseldiff {oldid newid} {
3217     global ctext cflist
3218     global commitinfo
3219
3220     $ctext conf -state normal
3221     $ctext delete 0.0 end
3222     $ctext mark set fmark.0 0.0
3223     $ctext mark gravity fmark.0 left
3224     $cflist delete 0 end
3225     $cflist insert end "Top"
3226     $ctext insert end "From "
3227     $ctext tag conf link -foreground blue -underline 1
3228     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3229     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3230     $ctext tag bind link0 <1> [list selbyid $oldid]
3231     $ctext insert end $oldid [list link link0]
3232     $ctext insert end "\n     "
3233     $ctext insert end [lindex $commitinfo($oldid) 0]
3234     $ctext insert end "\n\nTo   "
3235     $ctext tag bind link1 <1> [list selbyid $newid]
3236     $ctext insert end $newid [list link link1]
3237     $ctext insert end "\n     "
3238     $ctext insert end [lindex $commitinfo($newid) 0]
3239     $ctext insert end "\n"
3240     $ctext conf -state disabled
3241     $ctext tag delete Comments
3242     $ctext tag remove found 1.0 end
3243     startdiff [list $oldid $newid]
3244 }
3245
3246 proc mkpatch {} {
3247     global rowmenuid currentid commitinfo patchtop patchnum
3248
3249     if {![info exists currentid]} return
3250     set oldid $currentid
3251     set oldhead [lindex $commitinfo($oldid) 0]
3252     set newid $rowmenuid
3253     set newhead [lindex $commitinfo($newid) 0]
3254     set top .patch
3255     set patchtop $top
3256     catch {destroy $top}
3257     toplevel $top
3258     label $top.title -text "Generate patch"
3259     grid $top.title - -pady 10
3260     label $top.from -text "From:"
3261     entry $top.fromsha1 -width 40 -relief flat
3262     $top.fromsha1 insert 0 $oldid
3263     $top.fromsha1 conf -state readonly
3264     grid $top.from $top.fromsha1 -sticky w
3265     entry $top.fromhead -width 60 -relief flat
3266     $top.fromhead insert 0 $oldhead
3267     $top.fromhead conf -state readonly
3268     grid x $top.fromhead -sticky w
3269     label $top.to -text "To:"
3270     entry $top.tosha1 -width 40 -relief flat
3271     $top.tosha1 insert 0 $newid
3272     $top.tosha1 conf -state readonly
3273     grid $top.to $top.tosha1 -sticky w
3274     entry $top.tohead -width 60 -relief flat
3275     $top.tohead insert 0 $newhead
3276     $top.tohead conf -state readonly
3277     grid x $top.tohead -sticky w
3278     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3279     grid $top.rev x -pady 10
3280     label $top.flab -text "Output file:"
3281     entry $top.fname -width 60
3282     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3283     incr patchnum
3284     grid $top.flab $top.fname -sticky w
3285     frame $top.buts
3286     button $top.buts.gen -text "Generate" -command mkpatchgo
3287     button $top.buts.can -text "Cancel" -command mkpatchcan
3288     grid $top.buts.gen $top.buts.can
3289     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3290     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3291     grid $top.buts - -pady 10 -sticky ew
3292     focus $top.fname
3293 }
3294
3295 proc mkpatchrev {} {
3296     global patchtop
3297
3298     set oldid [$patchtop.fromsha1 get]
3299     set oldhead [$patchtop.fromhead get]
3300     set newid [$patchtop.tosha1 get]
3301     set newhead [$patchtop.tohead get]
3302     foreach e [list fromsha1 fromhead tosha1 tohead] \
3303             v [list $newid $newhead $oldid $oldhead] {
3304         $patchtop.$e conf -state normal
3305         $patchtop.$e delete 0 end
3306         $patchtop.$e insert 0 $v
3307         $patchtop.$e conf -state readonly
3308     }
3309 }
3310
3311 proc mkpatchgo {} {
3312     global patchtop
3313
3314     set oldid [$patchtop.fromsha1 get]
3315     set newid [$patchtop.tosha1 get]
3316     set fname [$patchtop.fname get]
3317     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3318         error_popup "Error creating patch: $err"
3319     }
3320     catch {destroy $patchtop}
3321     unset patchtop
3322 }
3323
3324 proc mkpatchcan {} {
3325     global patchtop
3326
3327     catch {destroy $patchtop}
3328     unset patchtop
3329 }
3330
3331 proc mktag {} {
3332     global rowmenuid mktagtop commitinfo
3333
3334     set top .maketag
3335     set mktagtop $top
3336     catch {destroy $top}
3337     toplevel $top
3338     label $top.title -text "Create tag"
3339     grid $top.title - -pady 10
3340     label $top.id -text "ID:"
3341     entry $top.sha1 -width 40 -relief flat
3342     $top.sha1 insert 0 $rowmenuid
3343     $top.sha1 conf -state readonly
3344     grid $top.id $top.sha1 -sticky w
3345     entry $top.head -width 60 -relief flat
3346     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3347     $top.head conf -state readonly
3348     grid x $top.head -sticky w
3349     label $top.tlab -text "Tag name:"
3350     entry $top.tag -width 60
3351     grid $top.tlab $top.tag -sticky w
3352     frame $top.buts
3353     button $top.buts.gen -text "Create" -command mktaggo
3354     button $top.buts.can -text "Cancel" -command mktagcan
3355     grid $top.buts.gen $top.buts.can
3356     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3357     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3358     grid $top.buts - -pady 10 -sticky ew
3359     focus $top.tag
3360 }
3361
3362 proc domktag {} {
3363     global mktagtop env tagids idtags
3364
3365     set id [$mktagtop.sha1 get]
3366     set tag [$mktagtop.tag get]
3367     if {$tag == {}} {
3368         error_popup "No tag name specified"
3369         return
3370     }
3371     if {[info exists tagids($tag)]} {
3372         error_popup "Tag \"$tag\" already exists"
3373         return
3374     }
3375     if {[catch {
3376         set dir [gitdir]
3377         set fname [file join $dir "refs/tags" $tag]
3378         set f [open $fname w]
3379         puts $f $id
3380         close $f
3381     } err]} {
3382         error_popup "Error creating tag: $err"
3383         return
3384     }
3385
3386     set tagids($tag) $id
3387     lappend idtags($id) $tag
3388     redrawtags $id
3389 }
3390
3391 proc redrawtags {id} {
3392     global canv linehtag commitrow idpos selectedline
3393
3394     if {![info exists commitrow($id)]} return
3395     drawcmitrow $commitrow($id)
3396     $canv delete tag.$id
3397     set xt [eval drawtags $id $idpos($id)]
3398     $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3399     if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3400         selectline $selectedline 0
3401     }
3402 }
3403
3404 proc mktagcan {} {
3405     global mktagtop
3406
3407     catch {destroy $mktagtop}
3408     unset mktagtop
3409 }
3410
3411 proc mktaggo {} {
3412     domktag
3413     mktagcan
3414 }
3415
3416 proc writecommit {} {
3417     global rowmenuid wrcomtop commitinfo wrcomcmd
3418
3419     set top .writecommit
3420     set wrcomtop $top
3421     catch {destroy $top}
3422     toplevel $top
3423     label $top.title -text "Write commit to file"
3424     grid $top.title - -pady 10
3425     label $top.id -text "ID:"
3426     entry $top.sha1 -width 40 -relief flat
3427     $top.sha1 insert 0 $rowmenuid
3428     $top.sha1 conf -state readonly
3429     grid $top.id $top.sha1 -sticky w
3430     entry $top.head -width 60 -relief flat
3431     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3432     $top.head conf -state readonly
3433     grid x $top.head -sticky w
3434     label $top.clab -text "Command:"
3435     entry $top.cmd -width 60 -textvariable wrcomcmd
3436     grid $top.clab $top.cmd -sticky w -pady 10
3437     label $top.flab -text "Output file:"
3438     entry $top.fname -width 60
3439     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3440     grid $top.flab $top.fname -sticky w
3441     frame $top.buts
3442     button $top.buts.gen -text "Write" -command wrcomgo
3443     button $top.buts.can -text "Cancel" -command wrcomcan
3444     grid $top.buts.gen $top.buts.can
3445     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3446     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3447     grid $top.buts - -pady 10 -sticky ew
3448     focus $top.fname
3449 }
3450
3451 proc wrcomgo {} {
3452     global wrcomtop
3453
3454     set id [$wrcomtop.sha1 get]
3455     set cmd "echo $id | [$wrcomtop.cmd get]"
3456     set fname [$wrcomtop.fname get]
3457     if {[catch {exec sh -c $cmd >$fname &} err]} {
3458         error_popup "Error writing commit: $err"
3459     }
3460     catch {destroy $wrcomtop}
3461     unset wrcomtop
3462 }
3463
3464 proc wrcomcan {} {
3465     global wrcomtop
3466
3467     catch {destroy $wrcomtop}
3468     unset wrcomtop
3469 }
3470
3471 proc listrefs {id} {
3472     global idtags idheads idotherrefs
3473
3474     set x {}
3475     if {[info exists idtags($id)]} {
3476         set x $idtags($id)
3477     }
3478     set y {}
3479     if {[info exists idheads($id)]} {
3480         set y $idheads($id)
3481     }
3482     set z {}
3483     if {[info exists idotherrefs($id)]} {
3484         set z $idotherrefs($id)
3485     }
3486     return [list $x $y $z]
3487 }
3488
3489 proc rereadrefs {} {
3490     global idtags idheads idotherrefs
3491
3492     set refids [concat [array names idtags] \
3493                     [array names idheads] [array names idotherrefs]]
3494     foreach id $refids {
3495         if {![info exists ref($id)]} {
3496             set ref($id) [listrefs $id]
3497         }
3498     }
3499     readrefs
3500     set refids [lsort -unique [concat $refids [array names idtags] \
3501                         [array names idheads] [array names idotherrefs]]]
3502     foreach id $refids {
3503         set v [listrefs $id]
3504         if {![info exists ref($id)] || $ref($id) != $v} {
3505             redrawtags $id
3506         }
3507     }
3508 }
3509
3510 proc showtag {tag isnew} {
3511     global ctext cflist tagcontents tagids linknum
3512
3513     if {$isnew} {
3514         addtohistory [list showtag $tag 0]
3515     }
3516     $ctext conf -state normal
3517     $ctext delete 0.0 end
3518     set linknum 0
3519     if {[info exists tagcontents($tag)]} {
3520         set text $tagcontents($tag)
3521     } else {
3522         set text "Tag: $tag\nId:  $tagids($tag)"
3523     }
3524     appendwithlinks $text
3525     $ctext conf -state disabled
3526     $cflist delete 0 end
3527 }
3528
3529 proc doquit {} {
3530     global stopped
3531     set stopped 100
3532     destroy .
3533 }
3534
3535 proc doprefs {} {
3536     global maxwidth maxgraphpct diffopts findmergefiles
3537     global oldprefs prefstop
3538
3539     set top .gitkprefs
3540     set prefstop $top
3541     if {[winfo exists $top]} {
3542         raise $top
3543         return
3544     }
3545     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3546         set oldprefs($v) [set $v]
3547     }
3548     toplevel $top
3549     wm title $top "Gitk preferences"
3550     label $top.ldisp -text "Commit list display options"
3551     grid $top.ldisp - -sticky w -pady 10
3552     label $top.spacer -text " "
3553     label $top.maxwidthl -text "Maximum graph width (lines)" \
3554         -font optionfont
3555     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3556     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3557     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3558         -font optionfont
3559     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3560     grid x $top.maxpctl $top.maxpct -sticky w
3561     checkbutton $top.findm -variable findmergefiles
3562     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3563         -font optionfont
3564     grid $top.findm $top.findml - -sticky w
3565     label $top.ddisp -text "Diff display options"
3566     grid $top.ddisp - -sticky w -pady 10
3567     label $top.diffoptl -text "Options for diff program" \
3568         -font optionfont
3569     entry $top.diffopt -width 20 -textvariable diffopts
3570     grid x $top.diffoptl $top.diffopt -sticky w
3571     frame $top.buts
3572     button $top.buts.ok -text "OK" -command prefsok
3573     button $top.buts.can -text "Cancel" -command prefscan
3574     grid $top.buts.ok $top.buts.can
3575     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3576     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3577     grid $top.buts - - -pady 10 -sticky ew
3578 }
3579
3580 proc prefscan {} {
3581     global maxwidth maxgraphpct diffopts findmergefiles
3582     global oldprefs prefstop
3583
3584     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3585         set $v $oldprefs($v)
3586     }
3587     catch {destroy $prefstop}
3588     unset prefstop
3589 }
3590
3591 proc prefsok {} {
3592     global maxwidth maxgraphpct
3593     global oldprefs prefstop
3594
3595     catch {destroy $prefstop}
3596     unset prefstop
3597     if {$maxwidth != $oldprefs(maxwidth)
3598         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3599         redisplay
3600     }
3601 }
3602
3603 proc formatdate {d} {
3604     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3605 }
3606
3607 # This list of encoding names and aliases is distilled from
3608 # http://www.iana.org/assignments/character-sets.
3609 # Not all of them are supported by Tcl.
3610 set encoding_aliases {
3611     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3612       ISO646-US US-ASCII us IBM367 cp367 csASCII }
3613     { ISO-10646-UTF-1 csISO10646UTF1 }
3614     { ISO_646.basic:1983 ref csISO646basic1983 }
3615     { INVARIANT csINVARIANT }
3616     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3617     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3618     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3619     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3620     { NATS-DANO iso-ir-9-1 csNATSDANO }
3621     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3622     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3623     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3624     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3625     { ISO-2022-KR csISO2022KR }
3626     { EUC-KR csEUCKR }
3627     { ISO-2022-JP csISO2022JP }
3628     { ISO-2022-JP-2 csISO2022JP2 }
3629     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3630       csISO13JISC6220jp }
3631     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3632     { IT iso-ir-15 ISO646-IT csISO15Italian }
3633     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3634     { ES iso-ir-17 ISO646-ES csISO17Spanish }
3635     { greek7-old iso-ir-18 csISO18Greek7Old }
3636     { latin-greek iso-ir-19 csISO19LatinGreek }
3637     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3638     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3639     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3640     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3641     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3642     { BS_viewdata iso-ir-47 csISO47BSViewdata }
3643     { INIS iso-ir-49 csISO49INIS }
3644     { INIS-8 iso-ir-50 csISO50INIS8 }
3645     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3646     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3647     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3648     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3649     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3650     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3651       csISO60Norwegian1 }
3652     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3653     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3654     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3655     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3656     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3657     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3658     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3659     { greek7 iso-ir-88 csISO88Greek7 }
3660     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3661     { iso-ir-90 csISO90 }
3662     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3663     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3664       csISO92JISC62991984b }
3665     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3666     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3667     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3668       csISO95JIS62291984handadd }
3669     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3670     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3671     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3672     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3673       CP819 csISOLatin1 }
3674     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3675     { T.61-7bit iso-ir-102 csISO102T617bit }
3676     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3677     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3678     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3679     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3680     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3681     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3682     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3683     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3684       arabic csISOLatinArabic }
3685     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3686     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3687     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3688       greek greek8 csISOLatinGreek }
3689     { T.101-G2 iso-ir-128 csISO128T101G2 }
3690     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3691       csISOLatinHebrew }
3692     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3693     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3694     { CSN_369103 iso-ir-139 csISO139CSN369103 }
3695     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3696     { ISO_6937-2-add iso-ir-142 csISOTextComm }
3697     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3698     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3699       csISOLatinCyrillic }
3700     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3701     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3702     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3703     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3704     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3705     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3706     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3707     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3708     { ISO_10367-box iso-ir-155 csISO10367Box }
3709     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3710     { latin-lap lap iso-ir-158 csISO158Lap }
3711     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3712     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3713     { us-dk csUSDK }
3714     { dk-us csDKUS }
3715     { JIS_X0201 X0201 csHalfWidthKatakana }
3716     { KSC5636 ISO646-KR csKSC5636 }
3717     { ISO-10646-UCS-2 csUnicode }
3718     { ISO-10646-UCS-4 csUCS4 }
3719     { DEC-MCS dec csDECMCS }
3720     { hp-roman8 roman8 r8 csHPRoman8 }
3721     { macintosh mac csMacintosh }
3722     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3723       csIBM037 }
3724     { IBM038 EBCDIC-INT cp038 csIBM038 }
3725     { IBM273 CP273 csIBM273 }
3726     { IBM274 EBCDIC-BE CP274 csIBM274 }
3727     { IBM275 EBCDIC-BR cp275 csIBM275 }
3728     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3729     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3730     { IBM280 CP280 ebcdic-cp-it csIBM280 }
3731     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3732     { IBM284 CP284 ebcdic-cp-es csIBM284 }
3733     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3734     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3735     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3736     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3737     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3738     { IBM424 cp424 ebcdic-cp-he csIBM424 }
3739     { IBM437 cp437 437 csPC8CodePage437 }
3740     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3741     { IBM775 cp775 csPC775Baltic }
3742     { IBM850 cp850 850 csPC850Multilingual }
3743     { IBM851 cp851 851 csIBM851 }
3744     { IBM852 cp852 852 csPCp852 }
3745     { IBM855 cp855 855 csIBM855 }
3746     { IBM857 cp857 857 csIBM857 }
3747     { IBM860 cp860 860 csIBM860 }
3748     { IBM861 cp861 861 cp-is csIBM861 }
3749     { IBM862 cp862 862 csPC862LatinHebrew }
3750     { IBM863 cp863 863 csIBM863 }
3751     { IBM864 cp864 csIBM864 }
3752     { IBM865 cp865 865 csIBM865 }
3753     { IBM866 cp866 866 csIBM866 }
3754     { IBM868 CP868 cp-ar csIBM868 }
3755     { IBM869 cp869 869 cp-gr csIBM869 }
3756     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3757     { IBM871 CP871 ebcdic-cp-is csIBM871 }
3758     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3759     { IBM891 cp891 csIBM891 }
3760     { IBM903 cp903 csIBM903 }
3761     { IBM904 cp904 904 csIBBM904 }
3762     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3763     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3764     { IBM1026 CP1026 csIBM1026 }
3765     { EBCDIC-AT-DE csIBMEBCDICATDE }
3766     { EBCDIC-AT-DE-A csEBCDICATDEA }
3767     { EBCDIC-CA-FR csEBCDICCAFR }
3768     { EBCDIC-DK-NO csEBCDICDKNO }
3769     { EBCDIC-DK-NO-A csEBCDICDKNOA }
3770     { EBCDIC-FI-SE csEBCDICFISE }
3771     { EBCDIC-FI-SE-A csEBCDICFISEA }
3772     { EBCDIC-FR csEBCDICFR }
3773     { EBCDIC-IT csEBCDICIT }
3774     { EBCDIC-PT csEBCDICPT }
3775     { EBCDIC-ES csEBCDICES }
3776     { EBCDIC-ES-A csEBCDICESA }
3777     { EBCDIC-ES-S csEBCDICESS }
3778     { EBCDIC-UK csEBCDICUK }
3779     { EBCDIC-US csEBCDICUS }
3780     { UNKNOWN-8BIT csUnknown8BiT }
3781     { MNEMONIC csMnemonic }
3782     { MNEM csMnem }
3783     { VISCII csVISCII }
3784     { VIQR csVIQR }
3785     { KOI8-R csKOI8R }
3786     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3787     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3788     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3789     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3790     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3791     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3792     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3793     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3794     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3795     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3796     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3797     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3798     { IBM1047 IBM-1047 }
3799     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3800     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3801     { UNICODE-1-1 csUnicode11 }
3802     { CESU-8 csCESU-8 }
3803     { BOCU-1 csBOCU-1 }
3804     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3805     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3806       l8 }
3807     { ISO-8859-15 ISO_8859-15 Latin-9 }
3808     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3809     { GBK CP936 MS936 windows-936 }
3810     { JIS_Encoding csJISEncoding }
3811     { Shift_JIS MS_Kanji csShiftJIS }
3812     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3813       EUC-JP }
3814     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3815     { ISO-10646-UCS-Basic csUnicodeASCII }
3816     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3817     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3818     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3819     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3820     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3821     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3822     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3823     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3824     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3825     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3826     { Adobe-Standard-Encoding csAdobeStandardEncoding }
3827     { Ventura-US csVenturaUS }
3828     { Ventura-International csVenturaInternational }
3829     { PC8-Danish-Norwegian csPC8DanishNorwegian }
3830     { PC8-Turkish csPC8Turkish }
3831     { IBM-Symbols csIBMSymbols }
3832     { IBM-Thai csIBMThai }
3833     { HP-Legal csHPLegal }
3834     { HP-Pi-font csHPPiFont }
3835     { HP-Math8 csHPMath8 }
3836     { Adobe-Symbol-Encoding csHPPSMath }
3837     { HP-DeskTop csHPDesktop }
3838     { Ventura-Math csVenturaMath }
3839     { Microsoft-Publishing csMicrosoftPublishing }
3840     { Windows-31J csWindows31J }
3841     { GB2312 csGB2312 }
3842     { Big5 csBig5 }
3843 }
3844
3845 proc tcl_encoding {enc} {
3846     global encoding_aliases
3847     set names [encoding names]
3848     set lcnames [string tolower $names]
3849     set enc [string tolower $enc]
3850     set i [lsearch -exact $lcnames $enc]
3851     if {$i < 0} {
3852         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3853         if {[regsub {^iso[-_]} $enc iso encx]} {
3854             set i [lsearch -exact $lcnames $encx]
3855         }
3856     }
3857     if {$i < 0} {
3858         foreach l $encoding_aliases {
3859             set ll [string tolower $l]
3860             if {[lsearch -exact $ll $enc] < 0} continue
3861             # look through the aliases for one that tcl knows about
3862             foreach e $ll {
3863                 set i [lsearch -exact $lcnames $e]
3864                 if {$i < 0} {
3865                     if {[regsub {^iso[-_]} $e iso ex]} {
3866                         set i [lsearch -exact $lcnames $ex]
3867                     }
3868                 }
3869                 if {$i >= 0} break
3870             }
3871             break
3872         }
3873     }
3874     if {$i >= 0} {
3875         return [lindex $names $i]
3876     }
3877     return {}
3878 }
3879
3880 # defaults...
3881 set datemode 0
3882 set diffopts "-U 5 -p"
3883 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3884
3885 set gitencoding {}
3886 catch {
3887     set gitencoding [exec git-repo-config --get i18n.commitencoding]
3888 }
3889 if {$gitencoding == ""} {
3890     set gitencoding "utf-8"
3891 }
3892 set tclencoding [tcl_encoding $gitencoding]
3893 if {$tclencoding == {}} {
3894     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3895 }
3896
3897 set mainfont {Helvetica 9}
3898 set textfont {Courier 9}
3899 set uifont {Helvetica 9 bold}
3900 set findmergefiles 0
3901 set maxgraphpct 50
3902 set maxwidth 16
3903 set revlistorder 0
3904 set fastdate 0
3905 set uparrowlen 7
3906 set downarrowlen 7
3907 set mingaplen 30
3908
3909 set colors {green red blue magenta darkgrey brown orange}
3910
3911 catch {source ~/.gitk}
3912
3913 set namefont $mainfont
3914
3915 font create optionfont -family sans-serif -size -12
3916
3917 set revtreeargs {}
3918 foreach arg $argv {
3919     switch -regexp -- $arg {
3920         "^$" { }
3921         "^-d" { set datemode 1 }
3922         default {
3923             lappend revtreeargs $arg
3924         }
3925     }
3926 }
3927
3928 # check that we can find a .git directory somewhere...
3929 set gitdir [gitdir]
3930 if {![file isdirectory $gitdir]} {
3931     error_popup "Cannot find the git directory \"$gitdir\"."
3932     exit 1
3933 }
3934
3935 set history {}
3936 set historyindex 0
3937
3938 set optim_delay 16
3939
3940 set stopped 0
3941 set stuffsaved 0
3942 set patchnum 0
3943 setcoords
3944 makewindow $revtreeargs
3945 readrefs
3946 getcommits $revtreeargs