Mercurial > hg > gitweb
annotate contrib/hgk @ 412:40cfa2d0c088
[PATCH]: Typo in localrepository.update
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
[PATCH]: Typo in localrepository.update
From: Goffredo Baroncelli <kreijack@libero.it>
I think that there is an error in the method update() of the class
localrepository. The variable 'm2n' was used instead of 'man'; so the
parent2 flags is computed instead of the ancestor flags.
manifest hash: dc11810367615245c4b39660d135ab3c0e71b85d
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.0 (GNU/Linux)
iD8DBQFCuNWpywK+sNU5EO8RAv9ZAKCxwbd242xZQ1CCrW2WDdQ4gclKtACghXYl
7j1YTRpINItwdXzak3cBS60=
=+Tf8
-----END PGP SIGNATURE-----
| author | mpm@selenic.com |
|---|---|
| date | Tue, 21 Jun 2005 19:06:17 -0800 |
| parents | 18c9566ad717 |
| children | cc756ffd4d04 |
| rev | line source |
|---|---|
| 267 | 1 #!/bin/sh |
| 2 # Tcl ignores the next line -*- tcl -*- \ | |
| 3 exec wish "$0" -- "${1+$@}" | |
| 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 # CVS $Revision: 1.20 $ | |
| 11 | |
| 12 proc readfullcommits {rargs} { | |
| 13 global commits commfd phase canv mainfont curcommit allcommitstate | |
| 14 if {$rargs == {}} { | |
| 15 set rargs HEAD | |
| 16 } | |
| 17 set commits {} | |
| 18 set curcommit {} | |
| 19 set allcommitstate none | |
| 20 set phase getcommits | |
| 21 if [catch {set commfd [open "|hgit rev-list -c $rargs" r]} err] { | |
| 22 puts stderr "Error executing hgit rev-list: $err" | |
| 23 exit 1 | |
| 24 } | |
| 25 fconfigure $commfd -blocking 0 | |
| 26 fileevent $commfd readable "getallcommitline $commfd" | |
| 27 $canv delete all | |
| 28 $canv create text 3 3 -anchor nw -text "Reading all commits..." \ | |
| 29 -font $mainfont -tags textitems | |
| 30 } | |
| 31 | |
| 32 proc getcommitline {commfd} { | |
| 33 global commits parents cdate nparents children nchildren | |
| 34 set n [gets $commfd line] | |
| 35 if {$n < 0} { | |
| 36 if {![eof $commfd]} return | |
| 37 # this works around what is apparently a bug in Tcl... | |
| 38 fconfigure $commfd -blocking 1 | |
| 39 if {![catch {close $commfd} err]} { | |
| 40 after idle readallcommits | |
| 41 return | |
| 42 } | |
| 43 if {[string range $err 0 4] == "usage"} { | |
| 44 set err "\ | |
| 45 Gitk: error reading commits: bad arguments to hgit rev-list.\n\ | |
| 46 (Note: arguments to gitk are passed to hgit rev-list\ | |
| 47 to allow selection of commits to be displayed.)" | |
| 48 } else { | |
| 49 set err "Error reading commits: $err" | |
| 50 } | |
| 51 error_popup $err | |
| 52 exit 1 | |
| 53 } | |
| 54 if {![regexp {^[0-9a-f]{40}$} $line]} { | |
| 55 error_popup "Can't parse hgit rev-tree output: {$line}" | |
| 56 exit 1 | |
| 57 } | |
| 58 lappend commits $line | |
| 59 } | |
| 60 | |
| 61 proc readallcommits {} { | |
| 62 global commits | |
| 63 foreach id $commits { | |
| 64 readcommit $id | |
| 65 update | |
| 66 } | |
| 67 drawgraph | |
| 68 } | |
| 69 | |
| 70 proc readonecommit {id contents} { | |
| 71 global commitinfo children nchildren parents nparents cdate | |
| 72 set inhdr 1 | |
| 73 set comment {} | |
| 74 set headline {} | |
| 75 set auname {} | |
| 76 set audate {} | |
| 77 set comname {} | |
| 78 set comdate {} | |
| 79 if {![info exists nchildren($id)]} { | |
| 80 set children($id) {} | |
| 81 set nchildren($id) 0 | |
| 82 } | |
| 83 set parents($id) {} | |
| 84 set nparents($id) 0 | |
| 85 foreach line [split $contents "\n"] { | |
| 86 if {$inhdr} { | |
| 87 if {$line == {}} { | |
| 88 set inhdr 0 | |
| 89 } else { | |
| 90 set tag [lindex $line 0] | |
| 91 if {$tag == "parent"} { | |
| 92 set p [lindex $line 1] | |
| 93 if {![info exists nchildren($p)]} { | |
| 94 set children($p) {} | |
| 95 set nchildren($p) 0 | |
| 96 } | |
| 97 lappend parents($id) $p | |
| 98 incr nparents($id) | |
| 99 if {[lsearch -exact $children($p) $id] < 0} { | |
| 100 lappend children($p) $id | |
| 101 incr nchildren($p) | |
| 102 } | |
| 103 } elseif {$tag == "author"} { | |
| 104 set x [expr {[llength $line] - 2}] | |
| 105 set audate [lindex $line $x] | |
| 106 set auname [lrange $line 1 [expr {$x - 1}]] | |
| 107 } elseif {$tag == "committer"} { | |
| 108 set x [expr {[llength $line] - 2}] | |
| 109 set comdate [lindex $line $x] | |
| 110 set comname [lrange $line 1 [expr {$x - 1}]] | |
| 111 } | |
| 112 } | |
| 113 } else { | |
| 114 if {$comment == {}} { | |
| 115 set headline $line | |
| 116 } else { | |
| 117 append comment "\n" | |
| 118 } | |
| 119 append comment $line | |
| 120 } | |
| 121 } | |
| 122 if {$audate != {}} { | |
| 123 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] | |
| 124 } | |
| 125 if {$comdate != {}} { | |
| 126 set cdate($id) $comdate | |
| 127 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] | |
| 128 } | |
| 129 set commitinfo($id) [list $headline $auname $audate \ | |
| 130 $comname $comdate $comment] | |
| 131 } | |
| 132 | |
| 133 proc getallcommitline {commfd} { | |
| 134 global commits allcommitstate curcommit curcommitid | |
| 135 set n [gets $commfd line] | |
| 136 set s "\n" | |
| 137 if {$n < 0} { | |
| 138 if {![eof $commfd]} return | |
| 139 # this works around what is apparently a bug in Tcl... | |
| 140 fconfigure $commfd -blocking 1 | |
| 141 if {![catch {close $commfd} err]} { | |
| 283 | 142 if {$allcommitstate == "indent"} { |
| 143 readonecommit $curcommitid $curcommit | |
| 144 } | |
| 267 | 145 after idle drawgraph |
| 146 return | |
| 147 } | |
| 148 if {[string range $err 0 4] == "usage"} { | |
| 149 set err "\ | |
| 150 Gitk: error reading commits: bad arguments to hgit rev-list.\n\ | |
| 151 (Note: arguments to gitk are passed to hgit rev-list\ | |
| 152 to allow selection of commits to be displayed.)" | |
| 153 } else { | |
| 154 set err "Error reading commits: $err" | |
| 155 } | |
| 156 error_popup $err | |
| 157 exit 1 | |
| 158 } | |
| 159 if {[string range $line 0 1] != " "} { | |
| 160 if {$allcommitstate == "indent"} { | |
| 161 readonecommit $curcommitid $curcommit | |
| 162 } | |
| 163 if {$allcommitstate == "start"} { | |
| 164 set curcommit $curcommit$line$s | |
| 165 set allcommitstate "indent" | |
| 166 } else { | |
| 167 set curcommitid $line | |
| 168 set curcommit {} | |
| 169 set allcommitstate "start" | |
| 170 lappend commits $line | |
| 171 } | |
| 172 } else { | |
| 173 set d [string range $line 2 end] | |
| 174 set curcommit $curcommit$d$s | |
| 175 } | |
| 176 } | |
| 177 | |
| 178 proc getcommits {rargs} { | |
| 179 global commits commfd phase canv mainfont | |
| 180 if {$rargs == {}} { | |
| 181 set rargs HEAD | |
| 182 } | |
| 183 set commits {} | |
| 184 set phase getcommits | |
| 185 if [catch {set commfd [open "|hgit rev-list $rargs" r]} err] { | |
| 186 puts stderr "Error executing hgit rev-list: $err" | |
| 187 exit 1 | |
| 188 } | |
| 189 fconfigure $commfd -blocking 0 | |
| 190 fileevent $commfd readable "getcommitline $commfd" | |
| 191 $canv delete all | |
| 192 $canv create text 3 3 -anchor nw -text "Reading commits..." \ | |
| 193 -font $mainfont -tags textitems | |
| 194 } | |
| 195 | |
| 196 proc readcommit {id} { | |
| 197 global commitinfo children nchildren parents nparents cdate | |
| 198 set inhdr 1 | |
| 199 set comment {} | |
| 200 set headline {} | |
| 201 set auname {} | |
| 202 set audate {} | |
| 203 set comname {} | |
| 204 set comdate {} | |
| 205 if {![info exists nchildren($id)]} { | |
| 206 set children($id) {} | |
| 207 set nchildren($id) 0 | |
| 208 } | |
| 209 set parents($id) {} | |
| 210 set nparents($id) 0 | |
| 211 if [catch {set contents [exec hgit cat-file commit $id]}] return | |
| 212 readonecommit $id $contents | |
| 213 } | |
| 214 | |
| 215 proc readrefs {} { | |
| 216 global tagids idtags | |
| 217 set tags [glob -nocomplain -types f .git/refs/tags/*] | |
| 218 foreach f $tags { | |
| 219 catch { | |
| 220 set fd [open $f r] | |
| 221 set line [read $fd] | |
| 222 if {[regexp {^[0-9a-f]{40}} $line id]} { | |
| 223 set contents [split [exec hgit cat-file tag $id] "\n"] | |
| 224 set obj {} | |
| 225 set type {} | |
| 226 set tag {} | |
| 227 foreach l $contents { | |
| 228 if {$l == {}} break | |
| 229 switch -- [lindex $l 0] { | |
| 230 "object" {set obj [lindex $l 1]} | |
| 231 "type" {set type [lindex $l 1]} | |
| 232 "tag" {set tag [string range $l 4 end]} | |
| 233 } | |
| 234 } | |
| 235 if {$obj != {} && $type == "commit" && $tag != {}} { | |
| 236 set tagids($tag) $obj | |
| 237 lappend idtags($obj) $tag | |
| 238 } | |
| 239 } | |
| 240 } | |
| 241 } | |
| 242 } | |
| 243 | |
| 244 proc error_popup msg { | |
| 245 set w .error | |
| 246 toplevel $w | |
| 247 wm transient $w . | |
| 248 message $w.m -text $msg -justify center -aspect 400 | |
| 249 pack $w.m -side top -fill x -padx 20 -pady 20 | |
| 250 button $w.ok -text OK -command "destroy $w" | |
| 251 pack $w.ok -side bottom -fill x | |
| 252 bind $w <Visibility> "grab $w; focus $w" | |
| 253 tkwait window $w | |
| 254 } | |
| 255 | |
| 256 proc makewindow {} { | |
| 257 global canv canv2 canv3 linespc charspc ctext cflist textfont | |
| 258 global findtype findloc findstring fstring geometry | |
| 259 global entries sha1entry sha1string sha1but | |
| 260 | |
| 261 menu .bar | |
| 262 .bar add cascade -label "File" -menu .bar.file | |
| 263 menu .bar.file | |
| 264 .bar.file add command -label "Quit" -command doquit | |
| 265 menu .bar.help | |
| 266 .bar add cascade -label "Help" -menu .bar.help | |
| 267 .bar.help add command -label "About gitk" -command about | |
| 268 . configure -menu .bar | |
| 269 | |
| 270 if {![info exists geometry(canv1)]} { | |
| 271 set geometry(canv1) [expr 45 * $charspc] | |
| 272 set geometry(canv2) [expr 30 * $charspc] | |
| 273 set geometry(canv3) [expr 15 * $charspc] | |
| 274 set geometry(canvh) [expr 25 * $linespc + 4] | |
| 275 set geometry(ctextw) 80 | |
| 276 set geometry(ctexth) 30 | |
| 277 set geometry(cflistw) 30 | |
| 278 } | |
| 279 panedwindow .ctop -orient vertical | |
| 280 if {[info exists geometry(width)]} { | |
| 281 .ctop conf -width $geometry(width) -height $geometry(height) | |
| 282 set texth [expr {$geometry(height) - $geometry(canvh) - 56}] | |
| 283 set geometry(ctexth) [expr {($texth - 8) / | |
| 284 [font metrics $textfont -linespace]}] | |
| 285 } | |
| 286 frame .ctop.top | |
| 287 frame .ctop.top.bar | |
| 288 pack .ctop.top.bar -side bottom -fill x | |
| 289 set cscroll .ctop.top.csb | |
| 290 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 | |
| 291 pack $cscroll -side right -fill y | |
| 292 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 | |
| 293 pack .ctop.top.clist -side top -fill both -expand 1 | |
| 294 .ctop add .ctop.top | |
| 295 set canv .ctop.top.clist.canv | |
| 296 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ | |
| 297 -bg white -bd 0 \ | |
| 298 -yscrollincr $linespc -yscrollcommand "$cscroll set" | |
| 299 .ctop.top.clist add $canv | |
| 300 set canv2 .ctop.top.clist.canv2 | |
| 301 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ | |
| 302 -bg white -bd 0 -yscrollincr $linespc | |
| 303 .ctop.top.clist add $canv2 | |
| 304 set canv3 .ctop.top.clist.canv3 | |
| 305 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ | |
| 306 -bg white -bd 0 -yscrollincr $linespc | |
| 307 .ctop.top.clist add $canv3 | |
| 308 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} | |
| 309 | |
| 310 set sha1entry .ctop.top.bar.sha1 | |
| 311 set entries $sha1entry | |
| 312 set sha1but .ctop.top.bar.sha1label | |
| 313 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ | |
| 314 -command gotocommit -width 8 | |
| 315 $sha1but conf -disabledforeground [$sha1but cget -foreground] | |
| 316 pack .ctop.top.bar.sha1label -side left | |
| 317 entry $sha1entry -width 40 -font $textfont -textvariable sha1string | |
| 318 trace add variable sha1string write sha1change | |
| 319 pack $sha1entry -side left -pady 2 | |
| 320 button .ctop.top.bar.findbut -text "Find" -command dofind | |
| 321 pack .ctop.top.bar.findbut -side left | |
| 322 set findstring {} | |
| 323 set fstring .ctop.top.bar.findstring | |
| 324 lappend entries $fstring | |
| 325 entry $fstring -width 30 -font $textfont -textvariable findstring | |
| 326 pack $fstring -side left -expand 1 -fill x | |
| 327 set findtype Exact | |
| 328 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp | |
| 329 set findloc "All fields" | |
| 330 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ | |
| 331 Comments Author Committer | |
| 332 pack .ctop.top.bar.findloc -side right | |
| 333 pack .ctop.top.bar.findtype -side right | |
| 334 | |
| 335 panedwindow .ctop.cdet -orient horizontal | |
| 336 .ctop add .ctop.cdet | |
| 337 frame .ctop.cdet.left | |
| 338 set ctext .ctop.cdet.left.ctext | |
| 339 text $ctext -bg white -state disabled -font $textfont \ | |
| 340 -width $geometry(ctextw) -height $geometry(ctexth) \ | |
| 341 -yscrollcommand ".ctop.cdet.left.sb set" | |
| 342 scrollbar .ctop.cdet.left.sb -command "$ctext yview" | |
| 343 pack .ctop.cdet.left.sb -side right -fill y | |
| 344 pack $ctext -side left -fill both -expand 1 | |
| 345 .ctop.cdet add .ctop.cdet.left | |
| 346 | |
| 347 $ctext tag conf filesep -font [concat $textfont bold] | |
| 348 $ctext tag conf hunksep -back blue -fore white | |
| 349 $ctext tag conf d0 -back "#ff8080" | |
| 350 $ctext tag conf d1 -back green | |
| 351 $ctext tag conf found -back yellow | |
| 352 | |
| 353 frame .ctop.cdet.right | |
| 354 set cflist .ctop.cdet.right.cfiles | |
| 355 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ | |
| 356 -yscrollcommand ".ctop.cdet.right.sb set" | |
| 357 scrollbar .ctop.cdet.right.sb -command "$cflist yview" | |
| 358 pack .ctop.cdet.right.sb -side right -fill y | |
| 359 pack $cflist -side left -fill both -expand 1 | |
| 360 .ctop.cdet add .ctop.cdet.right | |
| 361 bind .ctop.cdet <Configure> {resizecdetpanes %W %w} | |
| 362 | |
| 363 pack .ctop -side top -fill both -expand 1 | |
| 364 | |
| 365 bindall <1> {selcanvline %x %y} | |
| 366 bindall <B1-Motion> {selcanvline %x %y} | |
| 367 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" | |
| 368 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
| 369 bindall <2> "allcanvs scan mark 0 %y" | |
| 370 bindall <B2-Motion> "allcanvs scan dragto 0 %y" | |
| 371 bind . <Key-Up> "selnextline -1" | |
| 372 bind . <Key-Down> "selnextline 1" | |
| 373 bind . <Key-Prior> "allcanvs yview scroll -1 pages" | |
| 374 bind . <Key-Next> "allcanvs yview scroll 1 pages" | |
| 375 bindkey <Key-Delete> "$ctext yview scroll -1 pages" | |
| 376 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |
| 377 bindkey <Key-space> "$ctext yview scroll 1 pages" | |
| 378 bindkey p "selnextline -1" | |
| 379 bindkey n "selnextline 1" | |
| 380 bindkey b "$ctext yview scroll -1 pages" | |
| 381 bindkey d "$ctext yview scroll 18 units" | |
| 382 bindkey u "$ctext yview scroll -18 units" | |
| 383 bindkey / findnext | |
| 384 bindkey ? findprev | |
| 385 bindkey f nextfile | |
| 386 bind . <Control-q> doquit | |
| 387 bind . <Control-f> dofind | |
| 388 bind . <Control-g> findnext | |
| 389 bind . <Control-r> findprev | |
| 390 bind . <Control-equal> {incrfont 1} | |
| 391 bind . <Control-KP_Add> {incrfont 1} | |
| 392 bind . <Control-minus> {incrfont -1} | |
| 393 bind . <Control-KP_Subtract> {incrfont -1} | |
| 394 bind $cflist <<ListboxSelect>> listboxsel | |
| 395 bind . <Destroy> {savestuff %W} | |
| 396 bind . <Button-1> "click %W" | |
| 397 bind $fstring <Key-Return> dofind | |
| 398 bind $sha1entry <Key-Return> gotocommit | |
| 399 } | |
| 400 | |
| 401 # when we make a key binding for the toplevel, make sure | |
| 402 # it doesn't get triggered when that key is pressed in the | |
| 403 # find string entry widget. | |
| 404 proc bindkey {ev script} { | |
| 405 global entries | |
| 406 bind . $ev $script | |
| 407 set escript [bind Entry $ev] | |
| 408 if {$escript == {}} { | |
| 409 set escript [bind Entry <Key>] | |
| 410 } | |
| 411 foreach e $entries { | |
| 412 bind $e $ev "$escript; break" | |
| 413 } | |
| 414 } | |
| 415 | |
| 416 # set the focus back to the toplevel for any click outside | |
| 417 # the entry widgets | |
| 418 proc click {w} { | |
| 419 global entries | |
| 420 foreach e $entries { | |
| 421 if {$w == $e} return | |
| 422 } | |
| 423 focus . | |
| 424 } | |
| 425 | |
| 426 proc savestuff {w} { | |
| 427 global canv canv2 canv3 ctext cflist mainfont textfont | |
| 428 global stuffsaved | |
| 429 if {$stuffsaved} return | |
| 430 if {![winfo viewable .]} return | |
| 431 catch { | |
| 432 set f [open "~/.gitk-new" w] | |
| 433 puts $f "set mainfont {$mainfont}" | |
| 434 puts $f "set textfont {$textfont}" | |
| 435 puts $f "set geometry(width) [winfo width .ctop]" | |
| 436 puts $f "set geometry(height) [winfo height .ctop]" | |
| 437 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" | |
| 438 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" | |
| 439 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" | |
| 440 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" | |
| 441 set wid [expr {([winfo width $ctext] - 8) \ | |
| 442 / [font measure $textfont "0"]}] | |
| 443 puts $f "set geometry(ctextw) $wid" | |
| 444 set wid [expr {([winfo width $cflist] - 11) \ | |
| 445 / [font measure [$cflist cget -font] "0"]}] | |
| 446 puts $f "set geometry(cflistw) $wid" | |
| 447 close $f | |
| 448 file rename -force "~/.gitk-new" "~/.gitk" | |
| 449 } | |
| 450 set stuffsaved 1 | |
| 451 } | |
| 452 | |
| 453 proc resizeclistpanes {win w} { | |
| 454 global oldwidth | |
| 455 if [info exists oldwidth($win)] { | |
| 456 set s0 [$win sash coord 0] | |
| 457 set s1 [$win sash coord 1] | |
| 458 if {$w < 60} { | |
| 459 set sash0 [expr {int($w/2 - 2)}] | |
| 460 set sash1 [expr {int($w*5/6 - 2)}] | |
| 461 } else { | |
| 462 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
| 463 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
| 464 set sash1 [expr {int($factor * [lindex $s1 0])}] | |
| 465 if {$sash0 < 30} { | |
| 466 set sash0 30 | |
| 467 } | |
| 468 if {$sash1 < $sash0 + 20} { | |
| 469 set sash1 [expr $sash0 + 20] | |
| 470 } | |
| 471 if {$sash1 > $w - 10} { | |
| 472 set sash1 [expr $w - 10] | |
| 473 if {$sash0 > $sash1 - 20} { | |
| 474 set sash0 [expr $sash1 - 20] | |
| 475 } | |
| 476 } | |
| 477 } | |
| 478 $win sash place 0 $sash0 [lindex $s0 1] | |
| 479 $win sash place 1 $sash1 [lindex $s1 1] | |
| 480 } | |
| 481 set oldwidth($win) $w | |
| 482 } | |
| 483 | |
| 484 proc resizecdetpanes {win w} { | |
| 485 global oldwidth | |
| 486 if [info exists oldwidth($win)] { | |
| 487 set s0 [$win sash coord 0] | |
| 488 if {$w < 60} { | |
| 489 set sash0 [expr {int($w*3/4 - 2)}] | |
| 490 } else { | |
| 491 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
| 492 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
| 493 if {$sash0 < 45} { | |
| 494 set sash0 45 | |
| 495 } | |
| 496 if {$sash0 > $w - 15} { | |
| 497 set sash0 [expr $w - 15] | |
| 498 } | |
| 499 } | |
| 500 $win sash place 0 $sash0 [lindex $s0 1] | |
| 501 } | |
| 502 set oldwidth($win) $w | |
| 503 } | |
| 504 | |
| 505 proc allcanvs args { | |
| 506 global canv canv2 canv3 | |
| 507 eval $canv $args | |
| 508 eval $canv2 $args | |
| 509 eval $canv3 $args | |
| 510 } | |
| 511 | |
| 512 proc bindall {event action} { | |
| 513 global canv canv2 canv3 | |
| 514 bind $canv $event $action | |
| 515 bind $canv2 $event $action | |
| 516 bind $canv3 $event $action | |
| 517 } | |
| 518 | |
| 519 proc about {} { | |
| 520 set w .about | |
| 521 if {[winfo exists $w]} { | |
| 522 raise $w | |
| 523 return | |
| 524 } | |
| 525 toplevel $w | |
| 526 wm title $w "About gitk" | |
| 527 message $w.m -text { | |
| 528 Gitk version 1.1 | |
| 529 | |
| 530 Copyright © 2005 Paul Mackerras | |
| 531 | |
| 532 Use and redistribute under the terms of the GNU General Public License | |
| 533 | |
| 534 (CVS $Revision: 1.20 $)} \ | |
| 535 -justify center -aspect 400 | |
| 536 pack $w.m -side top -fill x -padx 20 -pady 20 | |
| 537 button $w.ok -text Close -command "destroy $w" | |
| 538 pack $w.ok -side bottom | |
| 539 } | |
| 540 | |
| 541 proc truncatetofit {str width font} { | |
| 542 if {[font measure $font $str] <= $width} { | |
| 543 return $str | |
| 544 } | |
| 545 set best 0 | |
| 546 set bad [string length $str] | |
| 547 set tmp $str | |
| 548 while {$best < $bad - 1} { | |
| 549 set try [expr {int(($best + $bad) / 2)}] | |
| 550 set tmp "[string range $str 0 [expr $try-1]]..." | |
| 551 if {[font measure $font $tmp] <= $width} { | |
| 552 set best $try | |
| 553 } else { | |
| 554 set bad $try | |
| 555 } | |
| 556 } | |
| 557 return $tmp | |
| 558 } | |
| 559 | |
| 560 proc assigncolor {id} { | |
| 561 global commitinfo colormap commcolors colors nextcolor | |
| 562 global colorbycommitter | |
| 563 global parents nparents children nchildren | |
| 564 if [info exists colormap($id)] return | |
| 565 set ncolors [llength $colors] | |
| 566 if {$colorbycommitter} { | |
| 567 if {![info exists commitinfo($id)]} { | |
| 568 readcommit $id | |
| 569 } | |
| 570 set comm [lindex $commitinfo($id) 3] | |
| 571 if {![info exists commcolors($comm)]} { | |
| 572 set commcolors($comm) [lindex $colors $nextcolor] | |
| 573 if {[incr nextcolor] >= $ncolors} { | |
| 574 set nextcolor 0 | |
| 575 } | |
| 576 } | |
| 577 set colormap($id) $commcolors($comm) | |
| 578 } else { | |
| 579 if {$nparents($id) == 1 && $nchildren($id) == 1} { | |
| 580 set child [lindex $children($id) 0] | |
| 581 if {[info exists colormap($child)] | |
| 582 && $nparents($child) == 1} { | |
| 583 set colormap($id) $colormap($child) | |
| 584 return | |
| 585 } | |
| 586 } | |
| 587 set badcolors {} | |
| 588 foreach child $children($id) { | |
| 589 if {[info exists colormap($child)] | |
| 590 && [lsearch -exact $badcolors $colormap($child)] < 0} { | |
| 591 lappend badcolors $colormap($child) | |
| 592 } | |
| 593 if {[info exists parents($child)]} { | |
| 594 foreach p $parents($child) { | |
| 595 if {[info exists colormap($p)] | |
| 596 && [lsearch -exact $badcolors $colormap($p)] < 0} { | |
| 597 lappend badcolors $colormap($p) | |
| 598 } | |
| 599 } | |
| 600 } | |
| 601 } | |
| 602 if {[llength $badcolors] >= $ncolors} { | |
| 603 set badcolors {} | |
| 604 } | |
| 605 for {set i 0} {$i <= $ncolors} {incr i} { | |
| 606 set c [lindex $colors $nextcolor] | |
| 607 if {[incr nextcolor] >= $ncolors} { | |
| 608 set nextcolor 0 | |
| 609 } | |
| 610 if {[lsearch -exact $badcolors $c]} break | |
| 611 } | |
| 612 set colormap($id) $c | |
| 613 } | |
| 614 } | |
| 615 | |
| 616 proc drawgraph {} { | |
| 617 global parents children nparents nchildren commits | |
| 618 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc | |
| 619 global datemode cdate | |
| 620 global lineid linehtag linentag linedtag commitinfo | |
| 621 global nextcolor colormap numcommits | |
| 622 global stopped phase redisplaying selectedline idtags idline | |
| 623 | |
| 624 allcanvs delete all | |
| 625 set start {} | |
| 626 foreach id [array names nchildren] { | |
| 627 if {$nchildren($id) == 0} { | |
| 628 lappend start $id | |
| 629 } | |
| 630 set ncleft($id) $nchildren($id) | |
| 631 if {![info exists nparents($id)]} { | |
| 632 set nparents($id) 0 | |
| 633 } | |
| 634 } | |
| 635 if {$start == {}} { | |
| 636 error_popup "Gitk: ERROR: No starting commits found" | |
| 637 exit 1 | |
| 638 } | |
| 639 | |
| 640 set nextcolor 0 | |
| 641 foreach id $start { | |
| 642 assigncolor $id | |
| 643 } | |
| 644 set todo $start | |
| 645 set level [expr [llength $todo] - 1] | |
| 646 set y2 $canvy0 | |
| 647 set nullentry -1 | |
| 648 set lineno -1 | |
| 649 set numcommits 0 | |
| 650 set phase drawgraph | |
| 651 set lthickness [expr {($linespc / 9) + 1}] | |
| 652 while 1 { | |
| 653 set canvy $y2 | |
| 654 allcanvs conf -scrollregion \ | |
| 655 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]] | |
| 656 update | |
| 657 if {$stopped} break | |
| 658 incr numcommits | |
| 659 incr lineno | |
| 660 set nlines [llength $todo] | |
| 661 set id [lindex $todo $level] | |
| 662 set lineid($lineno) $id | |
| 663 set idline($id) $lineno | |
| 664 set actualparents {} | |
| 665 set ofill white | |
| 666 if {[info exists parents($id)]} { | |
| 667 foreach p $parents($id) { | |
| 668 if {[info exists ncleft($p)]} { | |
| 669 incr ncleft($p) -1 | |
| 670 if {![info exists commitinfo($p)]} { | |
| 671 readcommit $p | |
| 672 if {![info exists commitinfo($p)]} continue | |
| 673 } | |
| 674 lappend actualparents $p | |
| 675 set ofill blue | |
| 676 } | |
| 677 } | |
| 678 } | |
| 679 if {![info exists commitinfo($id)]} { | |
| 680 readcommit $id | |
| 681 if {![info exists commitinfo($id)]} { | |
| 682 set commitinfo($id) {"No commit information available"} | |
| 683 } | |
| 684 } | |
| 685 set x [expr $canvx0 + $level * $linespc] | |
| 686 set y2 [expr $canvy + $linespc] | |
| 687 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} { | |
| 688 set t [$canv create line $x $linestarty($level) $x $canvy \ | |
| 689 -width $lthickness -fill $colormap($id)] | |
| 690 $canv lower $t | |
| 691 } | |
| 692 set linestarty($level) $canvy | |
| 693 set orad [expr {$linespc / 3}] | |
| 694 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \ | |
| 695 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \ | |
| 696 -fill $ofill -outline black -width 1] | |
| 697 $canv raise $t | |
| 698 set xt [expr $canvx0 + $nlines * $linespc] | |
| 699 if {$nparents($id) > 2} { | |
| 700 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}] | |
| 701 } | |
| 702 if {[info exists idtags($id)] && $idtags($id) != {}} { | |
| 703 set delta [expr {int(0.5 * ($linespc - $lthickness))}] | |
| 704 set yt [expr $canvy - 0.5 * $linespc] | |
| 705 set yb [expr $yt + $linespc - 1] | |
| 706 set xvals {} | |
| 707 set wvals {} | |
| 708 foreach tag $idtags($id) { | |
| 709 set wid [font measure $mainfont $tag] | |
| 710 lappend xvals $xt | |
| 711 lappend wvals $wid | |
| 712 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] | |
| 713 } | |
| 714 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \ | |
| 715 -width $lthickness -fill black] | |
| 716 $canv lower $t | |
| 717 foreach tag $idtags($id) x $xvals wid $wvals { | |
| 718 set xl [expr $x + $delta] | |
| 719 set xr [expr $x + $delta + $wid + $lthickness] | |
| 720 $canv create polygon $x [expr $yt + $delta] $xl $yt\ | |
| 721 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ | |
| 722 -width 1 -outline black -fill yellow | |
| 723 $canv create text $xl $canvy -anchor w -text $tag \ | |
| 724 -font $mainfont | |
| 725 } | |
| 726 } | |
| 727 set headline [lindex $commitinfo($id) 0] | |
| 728 set name [lindex $commitinfo($id) 1] | |
| 729 set date [lindex $commitinfo($id) 2] | |
| 730 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \ | |
| 731 -text $headline -font $mainfont ] | |
| 732 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \ | |
| 733 -text $name -font $namefont] | |
| 734 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \ | |
| 735 -text $date -font $mainfont] | |
| 736 if {!$datemode && [llength $actualparents] == 1} { | |
| 737 set p [lindex $actualparents 0] | |
| 738 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { | |
| 739 assigncolor $p | |
| 740 set todo [lreplace $todo $level $level $p] | |
| 741 continue | |
| 742 } | |
| 743 } | |
| 744 | |
| 745 set oldtodo $todo | |
| 746 set oldlevel $level | |
| 747 set lines {} | |
| 748 for {set i 0} {$i < $nlines} {incr i} { | |
| 749 if {[lindex $todo $i] == {}} continue | |
| 750 if {[info exists linestarty($i)]} { | |
| 751 set oldstarty($i) $linestarty($i) | |
| 752 unset linestarty($i) | |
| 753 } | |
| 754 if {$i != $level} { | |
| 755 lappend lines [list $i [lindex $todo $i]] | |
| 756 } | |
| 757 } | |
| 758 if {$nullentry >= 0} { | |
| 759 set todo [lreplace $todo $nullentry $nullentry] | |
| 760 if {$nullentry < $level} { | |
| 761 incr level -1 | |
| 762 } | |
| 763 } | |
| 764 | |
| 765 set todo [lreplace $todo $level $level] | |
| 766 if {$nullentry > $level} { | |
| 767 incr nullentry -1 | |
| 768 } | |
| 769 set i $level | |
| 770 foreach p $actualparents { | |
| 771 set k [lsearch -exact $todo $p] | |
| 772 if {$k < 0} { | |
| 773 assigncolor $p | |
| 774 set todo [linsert $todo $i $p] | |
| 775 if {$nullentry >= $i} { | |
| 776 incr nullentry | |
| 777 } | |
| 778 incr i | |
| 779 } | |
| 780 lappend lines [list $oldlevel $p] | |
| 781 } | |
| 782 | |
| 783 # choose which one to do next time around | |
| 784 set todol [llength $todo] | |
| 785 set level -1 | |
| 786 set latest {} | |
| 787 for {set k $todol} {[incr k -1] >= 0} {} { | |
| 788 set p [lindex $todo $k] | |
| 789 if {$p == {}} continue | |
| 790 if {$ncleft($p) == 0} { | |
| 791 if {$datemode} { | |
| 792 if {$latest == {} || $cdate($p) > $latest} { | |
| 793 set level $k | |
| 794 set latest $cdate($p) | |
| 795 } | |
| 796 } else { | |
| 797 set level $k | |
| 798 break | |
| 799 } | |
| 800 } | |
| 801 } | |
| 802 if {$level < 0} { | |
| 803 if {$todo != {}} { | |
| 804 puts "ERROR: none of the pending commits can be done yet:" | |
| 805 foreach p $todo { | |
| 806 puts " $p" | |
| 807 } | |
| 808 } | |
| 809 break | |
| 810 } | |
| 811 | |
| 812 # If we are reducing, put in a null entry | |
| 813 if {$todol < $nlines} { | |
| 814 if {$nullentry >= 0} { | |
| 815 set i $nullentry | |
| 816 while {$i < $todol | |
| 817 && [lindex $oldtodo $i] == [lindex $todo $i]} { | |
| 818 incr i | |
| 819 } | |
| 820 } else { | |
| 821 set i $oldlevel | |
| 822 if {$level >= $i} { | |
| 823 incr i | |
| 824 } | |
| 825 } | |
| 826 if {$i >= $todol} { | |
| 827 set nullentry -1 | |
| 828 } else { | |
| 829 set nullentry $i | |
| 830 set todo [linsert $todo $nullentry {}] | |
| 831 if {$level >= $i} { | |
| 832 incr level | |
| 833 } | |
| 834 } | |
| 835 } else { | |
| 836 set nullentry -1 | |
| 837 } | |
| 838 | |
| 839 foreach l $lines { | |
| 840 set i [lindex $l 0] | |
| 841 set dst [lindex $l 1] | |
| 842 set j [lsearch -exact $todo $dst] | |
| 843 if {$i == $j} { | |
| 844 if {[info exists oldstarty($i)]} { | |
| 845 set linestarty($i) $oldstarty($i) | |
| 846 } | |
| 847 continue | |
| 848 } | |
| 849 set xi [expr {$canvx0 + $i * $linespc}] | |
| 850 set xj [expr {$canvx0 + $j * $linespc}] | |
| 851 set coords {} | |
| 852 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} { | |
| 853 lappend coords $xi $oldstarty($i) | |
| 854 } | |
| 855 lappend coords $xi $canvy | |
| 856 if {$j < $i - 1} { | |
| 857 lappend coords [expr $xj + $linespc] $canvy | |
| 858 } elseif {$j > $i + 1} { | |
| 859 lappend coords [expr $xj - $linespc] $canvy | |
| 860 } | |
| 861 lappend coords $xj $y2 | |
| 862 set t [$canv create line $coords -width $lthickness \ | |
| 863 -fill $colormap($dst)] | |
| 864 $canv lower $t | |
| 865 if {![info exists linestarty($j)]} { | |
| 866 set linestarty($j) $y2 | |
| 867 } | |
| 868 } | |
| 869 } | |
| 870 set phase {} | |
| 871 if {$redisplaying} { | |
| 872 if {$stopped == 0 && [info exists selectedline]} { | |
| 873 selectline $selectedline | |
| 874 } | |
| 875 if {$stopped == 1} { | |
| 876 set stopped 0 | |
| 877 after idle drawgraph | |
| 878 } else { | |
| 879 set redisplaying 0 | |
| 880 } | |
| 881 } | |
| 882 } | |
| 883 | |
| 884 proc findmatches {f} { | |
| 885 global findtype foundstring foundstrlen | |
| 886 if {$findtype == "Regexp"} { | |
| 887 set matches [regexp -indices -all -inline $foundstring $f] | |
| 888 } else { | |
| 889 if {$findtype == "IgnCase"} { | |
| 890 set str [string tolower $f] | |
| 891 } else { | |
| 892 set str $f | |
| 893 } | |
| 894 set matches {} | |
| 895 set i 0 | |
| 896 while {[set j [string first $foundstring $str $i]] >= 0} { | |
| 897 lappend matches [list $j [expr $j+$foundstrlen-1]] | |
| 898 set i [expr $j + $foundstrlen] | |
| 899 } | |
| 900 } | |
| 901 return $matches | |
| 902 } | |
| 903 | |
| 904 proc dofind {} { | |
| 905 global findtype findloc findstring markedmatches commitinfo | |
| 906 global numcommits lineid linehtag linentag linedtag | |
| 907 global mainfont namefont canv canv2 canv3 selectedline | |
| 908 global matchinglines foundstring foundstrlen idtags | |
| 909 unmarkmatches | |
| 910 focus . | |
| 911 set matchinglines {} | |
| 912 set fldtypes {Headline Author Date Committer CDate Comment} | |
| 913 if {$findtype == "IgnCase"} { | |
| 914 set foundstring [string tolower $findstring] | |
| 915 } else { | |
| 916 set foundstring $findstring | |
| 917 } | |
| 918 set foundstrlen [string length $findstring] | |
| 919 if {$foundstrlen == 0} return | |
| 920 if {![info exists selectedline]} { | |
| 921 set oldsel -1 | |
| 922 } else { | |
| 923 set oldsel $selectedline | |
| 924 } | |
| 925 set didsel 0 | |
| 926 for {set l 0} {$l < $numcommits} {incr l} { | |
| 927 set id $lineid($l) | |
| 928 set info $commitinfo($id) | |
| 929 set doesmatch 0 | |
| 930 foreach f $info ty $fldtypes { | |
| 931 if {$findloc != "All fields" && $findloc != $ty} { | |
| 932 continue | |
| 933 } | |
| 934 set matches [findmatches $f] | |
| 935 if {$matches == {}} continue | |
| 936 set doesmatch 1 | |
| 937 if {$ty == "Headline"} { | |
| 938 markmatches $canv $l $f $linehtag($l) $matches $mainfont | |
| 939 } elseif {$ty == "Author"} { | |
| 940 markmatches $canv2 $l $f $linentag($l) $matches $namefont | |
| 941 } elseif {$ty == "Date"} { | |
| 942 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont | |
| 943 } | |
| 944 } | |
| 945 if {$doesmatch} { | |
| 946 lappend matchinglines $l | |
| 947 if {!$didsel && $l > $oldsel} { | |
| 948 findselectline $l | |
| 949 set didsel 1 | |
| 950 } | |
| 951 } | |
| 952 } | |
| 953 if {$matchinglines == {}} { | |
| 954 bell | |
| 955 } elseif {!$didsel} { | |
| 956 findselectline [lindex $matchinglines 0] | |
| 957 } | |
| 958 } | |
| 959 | |
| 960 proc findselectline {l} { | |
| 961 global findloc commentend ctext | |
| 962 selectline $l | |
| 963 if {$findloc == "All fields" || $findloc == "Comments"} { | |
| 964 # highlight the matches in the comments | |
| 965 set f [$ctext get 1.0 $commentend] | |
| 966 set matches [findmatches $f] | |
| 967 foreach match $matches { | |
| 968 set start [lindex $match 0] | |
| 969 set end [expr [lindex $match 1] + 1] | |
| 970 $ctext tag add found "1.0 + $start c" "1.0 + $end c" | |
| 971 } | |
| 972 } | |
| 973 } | |
| 974 | |
| 975 proc findnext {} { | |
| 976 global matchinglines selectedline | |
| 977 if {![info exists matchinglines]} { | |
| 978 dofind | |
| 979 return | |
| 980 } | |
| 981 if {![info exists selectedline]} return | |
| 982 foreach l $matchinglines { | |
| 983 if {$l > $selectedline} { | |
| 984 findselectline $l | |
| 985 return | |
| 986 } | |
| 987 } | |
| 988 bell | |
| 989 } | |
| 990 | |
| 991 proc findprev {} { | |
| 992 global matchinglines selectedline | |
| 993 if {![info exists matchinglines]} { | |
| 994 dofind | |
| 995 return | |
| 996 } | |
| 997 if {![info exists selectedline]} return | |
| 998 set prev {} | |
| 999 foreach l $matchinglines { | |
| 1000 if {$l >= $selectedline} break | |
| 1001 set prev $l | |
| 1002 } | |
| 1003 if {$prev != {}} { | |
| 1004 findselectline $prev | |
| 1005 } else { | |
| 1006 bell | |
| 1007 } | |
| 1008 } | |
| 1009 | |
| 1010 proc markmatches {canv l str tag matches font} { | |
| 1011 set bbox [$canv bbox $tag] | |
| 1012 set x0 [lindex $bbox 0] | |
| 1013 set y0 [lindex $bbox 1] | |
| 1014 set y1 [lindex $bbox 3] | |
| 1015 foreach match $matches { | |
| 1016 set start [lindex $match 0] | |
| 1017 set end [lindex $match 1] | |
| 1018 if {$start > $end} continue | |
| 1019 set xoff [font measure $font [string range $str 0 [expr $start-1]]] | |
| 1020 set xlen [font measure $font [string range $str 0 [expr $end]]] | |
| 1021 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ | |
| 1022 -outline {} -tags matches -fill yellow] | |
| 1023 $canv lower $t | |
| 1024 } | |
| 1025 } | |
| 1026 | |
| 1027 proc unmarkmatches {} { | |
| 1028 global matchinglines | |
| 1029 allcanvs delete matches | |
| 1030 catch {unset matchinglines} | |
| 1031 } | |
| 1032 | |
| 1033 proc selcanvline {x y} { | |
| 1034 global canv canvy0 ctext linespc selectedline | |
| 1035 global lineid linehtag linentag linedtag | |
| 1036 set ymax [lindex [$canv cget -scrollregion] 3] | |
| 1037 if {$ymax == {}} return | |
| 1038 set yfrac [lindex [$canv yview] 0] | |
| 1039 set y [expr {$y + $yfrac * $ymax}] | |
| 1040 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] | |
| 1041 if {$l < 0} { | |
| 1042 set l 0 | |
| 1043 } | |
| 1044 if {[info exists selectedline] && $selectedline == $l} return | |
| 1045 unmarkmatches | |
| 1046 selectline $l | |
| 1047 } | |
| 1048 | |
| 1049 proc selectline {l} { | |
| 1050 global canv canv2 canv3 ctext commitinfo selectedline | |
| 1051 global lineid linehtag linentag linedtag | |
| 1052 global canvy0 linespc nparents treepending | |
| 1053 global cflist treediffs currentid sha1entry | |
| 1054 global commentend seenfile numcommits idtags | |
| 1055 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return | |
| 1056 $canv delete secsel | |
| 1057 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ | |
| 1058 -tags secsel -fill [$canv cget -selectbackground]] | |
| 1059 $canv lower $t | |
| 1060 $canv2 delete secsel | |
| 1061 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ | |
| 1062 -tags secsel -fill [$canv2 cget -selectbackground]] | |
| 1063 $canv2 lower $t | |
| 1064 $canv3 delete secsel | |
| 1065 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ | |
| 1066 -tags secsel -fill [$canv3 cget -selectbackground]] | |
| 1067 $canv3 lower $t | |
| 1068 set y [expr {$canvy0 + $l * $linespc}] | |
| 1069 set ymax [lindex [$canv cget -scrollregion] 3] | |
| 1070 set ytop [expr {$y - $linespc - 1}] | |
| 1071 set ybot [expr {$y + $linespc + 1}] | |
| 1072 set wnow [$canv yview] | |
| 1073 set wtop [expr [lindex $wnow 0] * $ymax] | |
| 1074 set wbot [expr [lindex $wnow 1] * $ymax] | |
| 1075 set wh [expr {$wbot - $wtop}] | |
| 1076 set newtop $wtop | |
| 1077 if {$ytop < $wtop} { | |
| 1078 if {$ybot < $wtop} { | |
| 1079 set newtop [expr {$y - $wh / 2.0}] | |
| 1080 } else { | |
| 1081 set newtop $ytop | |
| 1082 if {$newtop > $wtop - $linespc} { | |
| 1083 set newtop [expr {$wtop - $linespc}] | |
| 1084 } | |
| 1085 } | |
| 1086 } elseif {$ybot > $wbot} { | |
| 1087 if {$ytop > $wbot} { | |
| 1088 set newtop [expr {$y - $wh / 2.0}] | |
| 1089 } else { | |
| 1090 set newtop [expr {$ybot - $wh}] | |
| 1091 if {$newtop < $wtop + $linespc} { | |
| 1092 set newtop [expr {$wtop + $linespc}] | |
| 1093 } | |
| 1094 } | |
| 1095 } | |
| 1096 if {$newtop != $wtop} { | |
| 1097 if {$newtop < 0} { | |
| 1098 set newtop 0 | |
| 1099 } | |
| 1100 allcanvs yview moveto [expr $newtop * 1.0 / $ymax] | |
| 1101 } | |
| 1102 set selectedline $l | |
| 1103 | |
| 1104 set id $lineid($l) | |
| 1105 set currentid $id | |
| 1106 $sha1entry delete 0 end | |
| 1107 $sha1entry insert 0 $id | |
| 1108 $sha1entry selection from 0 | |
| 1109 $sha1entry selection to end | |
| 1110 | |
| 1111 $ctext conf -state normal | |
| 1112 $ctext delete 0.0 end | |
| 1113 set info $commitinfo($id) | |
| 1114 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" | |
| 1115 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" | |
| 1116 if {[info exists idtags($id)]} { | |
| 1117 $ctext insert end "Tags:" | |
| 1118 foreach tag $idtags($id) { | |
| 1119 $ctext insert end " $tag" | |
| 1120 } | |
| 1121 $ctext insert end "\n" | |
| 1122 } | |
| 1123 $ctext insert end "\n" | |
| 1124 $ctext insert end [lindex $info 5] | |
| 1125 $ctext insert end "\n" | |
| 1126 $ctext tag delete Comments | |
| 1127 $ctext tag remove found 1.0 end | |
| 1128 $ctext conf -state disabled | |
| 1129 set commentend [$ctext index "end - 1c"] | |
| 1130 | |
| 1131 $cflist delete 0 end | |
| 1132 if {$nparents($id) == 1} { | |
| 1133 if {![info exists treediffs($id)]} { | |
| 1134 if {![info exists treepending]} { | |
| 1135 gettreediffs $id | |
| 1136 } | |
| 1137 } else { | |
| 1138 addtocflist $id | |
| 1139 } | |
| 1140 } | |
| 1141 catch {unset seenfile} | |
| 1142 } | |
| 1143 | |
| 1144 proc selnextline {dir} { | |
| 1145 global selectedline | |
| 1146 if {![info exists selectedline]} return | |
| 1147 set l [expr $selectedline + $dir] | |
| 1148 unmarkmatches | |
| 1149 selectline $l | |
| 1150 } | |
| 1151 | |
| 1152 proc addtocflist {id} { | |
| 1153 global currentid treediffs cflist treepending | |
| 1154 if {$id != $currentid} { | |
| 1155 gettreediffs $currentid | |
| 1156 return | |
| 1157 } | |
| 1158 $cflist insert end "All files" | |
| 1159 foreach f $treediffs($currentid) { | |
| 1160 $cflist insert end $f | |
| 1161 } | |
| 1162 getblobdiffs $id | |
| 1163 } | |
| 1164 | |
| 1165 proc gettreediffs {id} { | |
| 1166 global treediffs parents treepending | |
| 1167 set treepending $id | |
| 1168 set treediffs($id) {} | |
| 1169 set p [lindex $parents($id) 0] | |
| 1170 if [catch {set gdtf [open "|hgit diff-tree -r $p $id" r]}] return | |
| 1171 fconfigure $gdtf -blocking 0 | |
| 1172 fileevent $gdtf readable "gettreediffline $gdtf $id" | |
| 1173 } | |
| 1174 | |
| 1175 proc gettreediffline {gdtf id} { | |
| 1176 global treediffs treepending | |
| 1177 set n [gets $gdtf line] | |
| 1178 if {$n < 0} { | |
| 1179 if {![eof $gdtf]} return | |
| 1180 close $gdtf | |
| 1181 unset treepending | |
| 1182 addtocflist $id | |
| 1183 return | |
| 1184 } | |
| 1185 set file [lindex $line 5] | |
| 1186 lappend treediffs($id) $file | |
| 1187 } | |
| 1188 | |
| 1189 proc getblobdiffs {id} { | |
| 1190 global parents diffopts blobdifffd env curdifftag curtagstart | |
| 1191 global diffindex difffilestart | |
| 1192 set p [lindex $parents($id) 0] | |
| 1193 set env(GIT_DIFF_OPTS) $diffopts | |
| 1194 if [catch {set bdf [open "|hgit diff-tree -r -p $p $id" r]} err] { | |
| 1195 puts "error getting diffs: $err" | |
| 1196 return | |
| 1197 } | |
| 1198 fconfigure $bdf -blocking 0 | |
| 1199 set blobdifffd($id) $bdf | |
| 1200 set curdifftag Comments | |
| 1201 set curtagstart 0.0 | |
| 1202 set diffindex 0 | |
| 1203 catch {unset difffilestart} | |
| 1204 fileevent $bdf readable "getblobdiffline $bdf $id" | |
| 1205 } | |
| 1206 | |
| 1207 proc getblobdiffline {bdf id} { | |
| 1208 global currentid blobdifffd ctext curdifftag curtagstart seenfile | |
| 1209 global diffnexthead diffnextnote diffindex difffilestart | |
| 1210 set n [gets $bdf line] | |
| 1211 if {$n < 0} { | |
| 1212 if {[eof $bdf]} { | |
| 1213 close $bdf | |
| 1214 if {$id == $currentid && $bdf == $blobdifffd($id)} { | |
| 1215 $ctext tag add $curdifftag $curtagstart end | |
| 1216 set seenfile($curdifftag) 1 | |
| 1217 } | |
| 1218 } | |
| 1219 return | |
| 1220 } | |
| 1221 if {$id != $currentid || $bdf != $blobdifffd($id)} { | |
| 1222 return | |
| 1223 } | |
| 1224 $ctext conf -state normal | |
|
274
5da941efbb52
[PATCH] hgk should parse dates in the diff output
mpm@selenic.com
parents:
267
diff
changeset
|
1225 if {[regexp {^---[ \t]+([^/])*/([^\t]*)} $line match s0 fname]} { |
| 267 | 1226 # start of a new file |
| 1227 $ctext insert end "\n" | |
| 1228 $ctext tag add $curdifftag $curtagstart end | |
| 1229 set seenfile($curdifftag) 1 | |
| 1230 set curtagstart [$ctext index "end - 1c"] | |
| 1231 set header $fname | |
| 1232 if {[info exists diffnexthead]} { | |
| 1233 set fname $diffnexthead | |
| 1234 set header "$diffnexthead ($diffnextnote)" | |
| 1235 unset diffnexthead | |
| 1236 } | |
| 1237 set difffilestart($diffindex) [$ctext index "end - 1c"] | |
| 1238 incr diffindex | |
| 1239 set curdifftag "f:$fname" | |
| 1240 $ctext tag delete $curdifftag | |
| 1241 set l [expr {(78 - [string length $header]) / 2}] | |
| 1242 set pad [string range "----------------------------------------" 1 $l] | |
| 1243 $ctext insert end "$pad $header $pad\n" filesep | |
| 1244 } elseif {[string range $line 0 2] == "+++"} { | |
| 1245 # no need to do anything with this | |
| 1246 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} { | |
| 1247 set diffnexthead $fn | |
| 1248 set diffnextnote "created, mode $m" | |
| 1249 } elseif {[string range $line 0 8] == "Deleted: "} { | |
| 1250 set diffnexthead [string range $line 9 end] | |
| 1251 set diffnextnote "deleted" | |
| 1252 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} { | |
| 1253 # save the filename in case the next thing is "new file mode ..." | |
| 1254 set diffnexthead $fn | |
| 1255 set diffnextnote "modified" | |
| 1256 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} { | |
| 1257 set diffnextnote "new file, mode $m" | |
| 1258 } elseif {[string range $line 0 11] == "deleted file"} { | |
| 1259 set diffnextnote "deleted" | |
| 1260 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ | |
| 1261 $line match f1l f1c f2l f2c rest]} { | |
| 1262 $ctext insert end "\t" hunksep | |
| 1263 $ctext insert end " $f1l " d0 " $f2l " d1 | |
| 1264 $ctext insert end " $rest \n" hunksep | |
| 1265 } else { | |
| 1266 set x [string range $line 0 0] | |
| 1267 if {$x == "-" || $x == "+"} { | |
| 1268 set tag [expr {$x == "+"}] | |
| 1269 set line [string range $line 1 end] | |
| 1270 $ctext insert end "$line\n" d$tag | |
| 1271 } elseif {$x == " "} { | |
| 1272 set line [string range $line 1 end] | |
| 1273 $ctext insert end "$line\n" | |
| 1274 } elseif {$x == "\\"} { | |
| 1275 # e.g. "\ No newline at end of file" | |
| 1276 $ctext insert end "$line\n" filesep | |
| 1277 } else { | |
| 1278 # Something else we don't recognize | |
| 1279 if {$curdifftag != "Comments"} { | |
| 1280 $ctext insert end "\n" | |
| 1281 $ctext tag add $curdifftag $curtagstart end | |
| 1282 set seenfile($curdifftag) 1 | |
| 1283 set curtagstart [$ctext index "end - 1c"] | |
| 1284 set curdifftag Comments | |
| 1285 } | |
| 1286 $ctext insert end "$line\n" filesep | |
| 1287 } | |
| 1288 } | |
| 1289 $ctext conf -state disabled | |
| 1290 } | |
| 1291 | |
| 1292 proc nextfile {} { | |
| 1293 global difffilestart ctext | |
| 1294 set here [$ctext index @0,0] | |
| 1295 for {set i 0} {[info exists difffilestart($i)]} {incr i} { | |
| 1296 if {[$ctext compare $difffilestart($i) > $here]} { | |
| 1297 $ctext yview $difffilestart($i) | |
| 1298 break | |
| 1299 } | |
| 1300 } | |
| 1301 } | |
| 1302 | |
| 1303 proc listboxsel {} { | |
| 1304 global ctext cflist currentid treediffs seenfile | |
| 1305 if {![info exists currentid]} return | |
| 1306 set sel [$cflist curselection] | |
| 1307 if {$sel == {} || [lsearch -exact $sel 0] >= 0} { | |
| 1308 # show everything | |
| 1309 $ctext tag conf Comments -elide 0 | |
| 1310 foreach f $treediffs($currentid) { | |
| 1311 if [info exists seenfile(f:$f)] { | |
| 1312 $ctext tag conf "f:$f" -elide 0 | |
| 1313 } | |
| 1314 } | |
| 1315 } else { | |
| 1316 # just show selected files | |
| 1317 $ctext tag conf Comments -elide 1 | |
| 1318 set i 1 | |
| 1319 foreach f $treediffs($currentid) { | |
| 1320 set elide [expr {[lsearch -exact $sel $i] < 0}] | |
| 1321 if [info exists seenfile(f:$f)] { | |
| 1322 $ctext tag conf "f:$f" -elide $elide | |
| 1323 } | |
| 1324 incr i | |
| 1325 } | |
| 1326 } | |
| 1327 } | |
| 1328 | |
| 1329 proc setcoords {} { | |
| 1330 global linespc charspc canvx0 canvy0 mainfont | |
| 1331 set linespc [font metrics $mainfont -linespace] | |
| 1332 set charspc [font measure $mainfont "m"] | |
| 1333 set canvy0 [expr 3 + 0.5 * $linespc] | |
| 1334 set canvx0 [expr 3 + 0.5 * $linespc] | |
| 1335 } | |
| 1336 | |
| 1337 proc redisplay {} { | |
| 1338 global selectedline stopped redisplaying phase | |
| 1339 if {$stopped > 1} return | |
| 1340 if {$phase == "getcommits"} return | |
| 1341 set redisplaying 1 | |
| 1342 if {$phase == "drawgraph"} { | |
| 1343 set stopped 1 | |
| 1344 } else { | |
| 1345 drawgraph | |
| 1346 } | |
| 1347 } | |
| 1348 | |
| 1349 proc incrfont {inc} { | |
| 1350 global mainfont namefont textfont selectedline ctext canv phase | |
| 1351 global stopped entries | |
| 1352 unmarkmatches | |
| 1353 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] | |
| 1354 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] | |
| 1355 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] | |
| 1356 setcoords | |
| 1357 $ctext conf -font $textfont | |
| 1358 $ctext tag conf filesep -font [concat $textfont bold] | |
| 1359 foreach e $entries { | |
| 1360 $e conf -font $mainfont | |
| 1361 } | |
| 1362 if {$phase == "getcommits"} { | |
| 1363 $canv itemconf textitems -font $mainfont | |
| 1364 } | |
| 1365 redisplay | |
| 1366 } | |
| 1367 | |
| 1368 proc sha1change {n1 n2 op} { | |
| 1369 global sha1string currentid sha1but | |
| 1370 if {$sha1string == {} | |
| 1371 || ([info exists currentid] && $sha1string == $currentid)} { | |
| 1372 set state disabled | |
| 1373 } else { | |
| 1374 set state normal | |
| 1375 } | |
| 1376 if {[$sha1but cget -state] == $state} return | |
| 1377 if {$state == "normal"} { | |
| 1378 $sha1but conf -state normal -relief raised -text "Goto: " | |
| 1379 } else { | |
| 1380 $sha1but conf -state disabled -relief flat -text "SHA1 ID: " | |
| 1381 } | |
| 1382 } | |
| 1383 | |
| 1384 proc gotocommit {} { | |
| 1385 global sha1string currentid idline tagids | |
| 1386 if {$sha1string == {} | |
| 1387 || ([info exists currentid] && $sha1string == $currentid)} return | |
| 1388 if {[info exists tagids($sha1string)]} { | |
| 1389 set id $tagids($sha1string) | |
| 1390 } else { | |
| 1391 set id [string tolower $sha1string] | |
| 1392 } | |
| 1393 if {[info exists idline($id)]} { | |
| 1394 selectline $idline($id) | |
| 1395 return | |
| 1396 } | |
| 1397 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} { | |
| 1398 set type "SHA1 id" | |
| 1399 } else { | |
| 1400 set type "Tag" | |
| 1401 } | |
| 1402 error_popup "$type $sha1string is not known" | |
| 1403 } | |
| 1404 | |
| 1405 proc doquit {} { | |
| 1406 global stopped | |
| 1407 set stopped 100 | |
| 1408 destroy . | |
| 1409 } | |
| 1410 | |
| 1411 # defaults... | |
| 1412 set datemode 0 | |
| 1413 set boldnames 0 | |
| 1414 set diffopts "-U 5 -p" | |
| 1415 | |
| 1416 set mainfont {Helvetica 9} | |
| 1417 set textfont {Courier 9} | |
| 1418 | |
| 1419 set colors {green red blue magenta darkgrey brown orange} | |
| 1420 set colorbycommitter false | |
| 1421 | |
| 1422 catch {source ~/.gitk} | |
| 1423 | |
| 1424 set namefont $mainfont | |
| 1425 if {$boldnames} { | |
| 1426 lappend namefont bold | |
| 1427 } | |
| 1428 | |
| 1429 set revtreeargs {} | |
| 1430 foreach arg $argv { | |
| 1431 switch -regexp -- $arg { | |
| 1432 "^$" { } | |
| 1433 "^-b" { set boldnames 1 } | |
| 1434 "^-c" { set colorbycommitter 1 } | |
| 1435 "^-d" { set datemode 1 } | |
| 1436 default { | |
| 1437 lappend revtreeargs $arg | |
| 1438 } | |
| 1439 } | |
| 1440 } | |
| 1441 | |
| 1442 set stopped 0 | |
| 1443 set redisplaying 0 | |
| 1444 set stuffsaved 0 | |
| 1445 setcoords | |
| 1446 makewindow | |
| 1447 readrefs | |
| 1448 readfullcommits $revtreeargs |