gitk

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