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