gitk

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