1proc svn_version {} { 2 global cvsglb 3 4 gen_log:log T "ENTER" 5 6 # We don't need the version. We just need to know if mergeinfo is 7 # going to work in this server/client combination. But let's not forget 8 # how to get the version. 9 10 #set cvsglb(svn_version) "" 11 #set commandline "svn --version" 12 #gen_log:log C "$commandline" 13 #set ret [catch {eval "exec $commandline"} output] 14 #if {$ret} { 15 # cvsfail $output 16 # return 17 #} 18 #foreach infoline [split $output "\n"] { 19 # if {[string match "svn,*" $infoline]} { 20 # set lr [split $infoline] 21 # set version [lindex $lr 2] 22 # gen_log:log D "version $version" 23 # } 24 #} 25 #set cvsglb(svn_version) $version 26 27 set commandline "svn log -g -l 1" 28 set ret [catch {eval "exec $commandline"} output] 29 if {$ret == 0} { 30 set cvsglb(svn_mergeinfo_works) 1 31 gen_log:log D "svn mergeinfo works" 32 } else { 33 set cvsglb(svn_mergeinfo_works) 0 34 gen_log:log D "svn mergeinfo doesn't work" 35 } 36 gen_log:log T "LEAVE" 37} 38 39# Find SVN URL 40proc read_svn_dir {dirname} { 41 global cvscfg 42 global cvsglb 43 global current_tagname 44 global module_dir 45 global cmd 46 47 gen_log:log T "ENTER ($dirname)" 48 # Whether mergeinfo works depends on the server as well as the local svn program, 49 # so it may work for us in one repository but not another 50 svn_version 51 # svn info gets the URL 52 # Have to do eval exec because we need the error output 53 set command "svn info" 54 gen_log:log C "$command" 55 set ret [catch {eval "exec $command"} output] 56 if {$ret} { 57 cvsfail $output 58 return 0 59 } 60 foreach infoline [split $output "\n"] { 61 if {[string match "URL*" $infoline]} { 62 set cvscfg(url) [lrange $infoline 1 end] 63 gen_log:log D "$cvscfg(url)" 64 } 65 } 66 67 if {! [info exists cvscfg(url)]} { 68 set cvscfg(url) "" 69 } 70 if {$cvscfg(url) == ""} { 71 cvsfail "Can't get the SVN URL" 72 return 0 73 } 74 75 set root "" 76 foreach s [list $cvscfg(svn_trunkdir) $cvscfg(svn_branchdir) $cvscfg(svn_tagdir)] { 77 if {[regexp "/$s/" $cvscfg(url)] || [regexp "/$s" $cvscfg(url)]} { 78 set spl [split $cvscfg(url) "/"] 79 set root "" 80 set relp "" 81 set current_tagname "" 82 set state P 83 for {set j 0} {$j < [llength $spl]} {incr j} { 84 set word [lindex $spl $j] 85 switch -- $state { 86 P { 87 if {$word eq $cvscfg(svn_trunkdir)} { 88 gen_log:log D "Matched $word for trunk" 89 set type "trunk" 90 set current_tagname $word 91 set state E 92 } elseif { $word eq $cvscfg(svn_branchdir)} { 93 gen_log:log D "Matched $word for branches" 94 set type "branches" 95 set state W 96 } elseif { $word eq $cvscfg(svn_tagdir)} { 97 gen_log:log D "Matched $word for tags" 98 set type "tags" 99 set state W 100 } else { 101 append root "$word/" 102 #gen_log:log D "No match for $word" 103 } 104 } 105 W { 106 set current_tagname $word 107 set state E 108 } 109 E { 110 lappend relp "$word" 111 } 112 default {} 113 } 114 } 115 set cvscfg(svnroot) [string trimright $root "/"] 116 set cvsglb(root) $cvscfg(svnroot) 117 gen_log:log D "SVN URL: $cvscfg(url)" 118 gen_log:log D "svnroot: $cvscfg(svnroot)" 119 set cvsglb(relpath) [join $relp {/}] 120 gen_log:log D "relpath: $cvsglb(relpath)" 121 regsub -all {%20} $cvsglb(relpath) { } module_dir 122 gen_log:log D "tagname: $current_tagname" 123 } 124 } 125 if {$root == ""} { 126 gen_log:log F "Nonconforming repository" 127 puts "No conforming $cvscfg(svn_trunkdir)/$cvscfg(svn_branchdir)/$cvscfg(svn_tagdir) structure detected in the repository" 128 puts " I won't be able to detect any branches or tags." 129 gen_log:log D "SVN URL: $cvscfg(url)" 130 set cvscfg(svnroot) $cvscfg(url) 131 set cvsglb(root) $cvscfg(svnroot) 132 gen_log:log D "svnroot: $cvscfg(svnroot)" 133 set cvsglb(relpath) "" 134 set cvsglb(svnconform) 0 135 gen_log:log T "LEAVE (-1)" 136 return -1 137 } 138 set cvsglb(svnconform) 1 139 gen_log:log T "LEAVE (0)" 140 return 1 141} 142 143proc svn_lock {do files} { 144 global cvscfg 145 146 if {$files == {}} { 147 cvsfail "Please select one or more files!" .workdir 148 return 149 } 150 switch -- $do { 151 lock { set commandline "svn lock $files"} 152 unlock { set commandline "svn unlock $files"} 153 } 154 set cmd [::exec::new "$commandline"] 155 156 if {$cvscfg(auto_status)} { 157 $cmd\::wait 158 setup_dir 159 } 160} 161 162# Get stuff for main workdir browser 163proc svn_workdir_status {} { 164 global cmd 165 global Filelist 166 167 gen_log:log T "ENTER" 168 set cmd(svn_status) [exec::new "svn status -uvN --xml"] 169 set xmloutput [$cmd(svn_status)\::output] 170 set entrylist [regexp -all -inline {<entry.*?</entry>} $xmloutput] 171 172 if [info exists cmd(svn_status)] { 173 $cmd(svn_status)\::destroy 174 catch {unset cmd(svn_status)} 175 } 176 # do very simple xml parsing 177 foreach entry $entrylist { 178 set filename "" 179 set cauthor "" 180 set lockstatus "" 181 set wrev "" 182 set crev "" 183 184 regexp {<entry\s+path=\"([^\"]*?)\"\s*>} $entry tmp filename 185 regexp {<wc\-status.*</wc\-status>} $entry wcstatusent 186 if { [ regexp {<repos\-status.*</repos\-status>} $entry repstatusent ] } { 187 regexp {<repos\-status\s+([^>]*)>} $repstatusent tmp repstatusheader 188 regexp {item=\"(\w+)\"} $repstatusheader tmp repstatus 189 if { [ regexp {<lock>.*</lock>} $repstatusent replock ] } { 190 set lockstatus "locked" 191 } 192 } else { 193 set repstatus "" 194 } 195 regexp {<author>(.*)</author>} $wcstatusent tmp cauthor 196 regexp {<commit\s+revision=\"(\d+)\"} $wcstatusent tmp crev 197 regexp {<wc\-status\s+([^>]*)>} $wcstatusent tmp wcstatusheader 198 regexp {item=\"(\w+)\"} $wcstatusheader tmp wcstatus 199 regexp {revision=\"(\w+)\"} $wcstatusheader tmp wrev 200 if { [ regexp {<lock>.*</lock>} $wcstatusent wclock ] } { 201 set lockstatus "havelock" 202 } 203 204 # wcstatus="added|normal|deleted|unversioned|modified|none 205 # repstatus="modified|none" 206 set status "" 207 208 set displaymod "" 209 if { [file exists $filename] && [file type $filename] == "link" } { 210 set displaymod "<link> " 211 } 212 if [file isdirectory $filename] { 213 set displaymod "<dir> " 214 } 215 216 set mayhavelock false 217 switch -exact -- $wcstatus { 218 "normal" { 219 if { $repstatus == "modified"} { 220 append displaymod "Out-of-date" 221 } else { 222 append displaymod "Up-to-date" 223 set mayhavelock true 224 } 225 } 226 "modified" { 227 if { $repstatus == "modified"} { 228 append displaymod "Needs Merge" 229 } else { 230 append displaymod "Locally Modified" 231 set mayhavelock true 232 } 233 } 234 "added" { append displaymod "Locally Added" } 235 "deleted" { append displaymod "Locally Removed" } 236 "unversioned" { append displaymod "Not managed by SVN" } 237 "conflicted" { append displaymod "Conflict" } 238 L { append displaymod "Locked" } 239 S { append displaymod "Switched to Branch" } 240 "none" { append displaymod "Missing/Needs Update" } 241 ~ { append displaymod "Dir/File Mismatch" } 242 } 243 #in some cases there might be locks: check now 244 if { $mayhavelock } { 245 switch -exact -- $lockstatus { 246 "" { } 247 "havelock" { append displaymod "/HaveLock" } 248 "locked" { append displaymod "/Locked" } 249 } 250 } 251 set Filelist($filename:wrev) $wrev 252 set Filelist($filename:status) $displaymod 253 set Filelist($filename:stickytag) "$wrev $crev" 254 if {$wrev != "" && $crev != ""} { 255 #set Filelist($filename:stickytag) "working:$wrev committed:$crev" 256 set Filelist($filename:stickytag) "$wrev (committed:$crev)" 257 } 258 set Filelist($filename:option) "" 259 set Filelist($filename:editors) "$cauthor" 260 #gen_log:log D " \ 261 \"$Filelist($filename:status)\" \ 262 \"$wrev (committed:$crev)\" \ 263 \"$Filelist($filename:editors)\" \ 264 \"$filename\" \ 265 " 266 } 267 gen_log:log T "LEAVE" 268} 269 270# does svn add from workdir browser 271proc svn_add {args} { 272 global cvscfg 273 274 gen_log:log T "ENTER ($args)" 275 set filelist [join $args] 276 if {$filelist == ""} { 277 set mess "This will add all new files" 278 } else { 279 set mess "This will add these files:\n\n" 280 foreach file $filelist { 281 append mess " $file\n" 282 } 283 } 284 285 if {$filelist == ""} { 286 append filelist [glob -nocomplain $cvscfg(aster) .??*] 287 } 288 set addcmd [exec::new "svn add $filelist"] 289 auto_setup_dir $addcmd 290 291 gen_log:log T "LEAVE" 292} 293 294# does svn remove from workdir browser 295proc svn_remove {args} { 296 global cvscfg 297 298 gen_log:log T "ENTER ($args)" 299 set filelist [join $args] 300 301 set command [exec::new "svn remove $filelist"] 302 auto_setup_dir $command 303 304 gen_log:log T "LEAVE" 305} 306 307# called from the workdir browser checkmark button 308proc svn_check {directory} { 309 global cvscfg 310 311 gen_log:log T "ENTER ($directory)" 312 313 busy_start .workdir.main 314 315 # Always show updates 316 set flags "-u" 317 # Only recurse if flag is set 318 if {! $cvscfg(recurse)} { 319 append flags "N" 320 } 321 # unknown files are removed by the filter but we might as well minimize 322 # the work the filter has to do 323 if {$cvscfg(status_filter)} { 324 append flags "q" 325 } 326 set command "svn status $flags $directory" 327 set check_cmd [viewer::new "SVN Status Check"] 328 $check_cmd\::do "$command" 0 status_colortags 329 330 busy_done .workdir.main 331 gen_log:log T "LEAVE" 332} 333 334# svn update - called from workdir browser 335proc svn_update {args} { 336 global cvscfg 337 338 gen_log:log T "ENTER ($args)" 339 340 set filelist [join $args] 341 342 if {$filelist == ""} { 343 append mess "\nThis will download from" 344 append mess " the repository to your local" 345 append mess " filespace ** ALL ** files which" 346 append mess " have changed in it." 347 } else { 348 append mess "\nThis will download from" 349 append mess " the repository to your local" 350 append mess " filespace these files which" 351 append mess " have changed:\n" 352 } 353 foreach file $filelist { 354 append mess "\n\t$file" 355 } 356 append mess "\n\nAre you sure?" 357 358 #set command "svn update --accept postpone" 359 set command "svn update" 360 361 if {[cvsconfirm $mess .workdir] == "ok"} { 362 foreach file $filelist { 363 append command " \"$file\"" 364 } 365 } else { 366 return; 367 } 368 369 set co_cmd [viewer::new "SVN Update"] 370 $co_cmd\::do "$command" 0 status_colortags 371 auto_setup_dir $co_cmd 372 373 gen_log:log T "LEAVE" 374} 375 376# Called from "update with options" dialog of workdir browser 377proc svn_opt_update {} { 378 global cvscfg 379 global cvsglb 380 381 switch -exact -- $cvsglb(tagmode_selection) { 382 "Keep" { 383 set command "svn update" 384 } 385 "Trunk" { 386 set command "svn switch $cvscfg(svnroot)/$cvscfg(svn_trunkdir)" 387 } 388 "Branch" { 389 set command "svn switch $cvscfg(svnroot)/$cvscfg(svn_branchdir)/$cvsglb(branchname)" 390 } 391 "Revision" { 392 # Let them get away with saying r3 instead of 3 393 set rev [string trimleft $cvsglb(revnumber) {r}] 394 set command "svn update -r $rev" 395 } 396 } 397 set upd_cmd [viewer::new "SVN Update/Switch"] 398 $upd_cmd\::do "$command" 0 status_colortags 399 400 auto_setup_dir $upd_cmd 401} 402 403# dialog for svn commit - called from workdir browser 404proc svn_commit_dialog {} { 405 global cvsglb 406 global cvscfg 407 408 # If marked files, commit these. If no marked files, then 409 # commit any files selected via listbox selection mechanism. 410 # The cvsglb(commit_list) list remembers the list of files 411 # to be committed. 412 set cvsglb(commit_list) [workdir_list_files] 413 # If we want to use an external editor, just do it 414 if {$cvscfg(use_cvseditor)} { 415 svn_commit "" "" $cvsglb(commit_list) 416 return 417 } 418 419 if {[winfo exists .commit]} { 420 destroy .commit 421 } 422 423 toplevel .commit 424 #grab set .commit 425 426 frame .commit.top -border 8 427 frame .commit.down -relief groove -border 2 428 429 pack .commit.top -side top -fill x 430 pack .commit.down -side bottom -fill x 431 frame .commit.comment 432 pack .commit.comment -side top -fill both -expand 1 433 label .commit.comment.lcomment -text "Your log message" -anchor w 434 button .commit.comment.history -text "Log History" \ 435 -command history_browser 436 text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ 437 -bg $cvsglb(textbg) -exportselection 1 \ 438 -wrap word -border 2 -setgrid yes 439 440 441 # Explain what it means to "commit" files 442 message .commit.message -justify left -aspect 800 \ 443 -text "This will commit changes from your \ 444 local, working directory into the repository, recursively." 445 446 pack .commit.message -in .commit.top -padx 2 -pady 5 447 448 button .commit.ok -text "OK" \ 449 -command { 450 #grab release .commit 451 wm withdraw .commit 452 set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] 453 svn_commit $cvsglb(commit_comment) $cvsglb(commit_list) 454 commit_history $cvsglb(commit_comment) 455 } 456 button .commit.apply -text "Apply" \ 457 -command { 458 set cvsglb(commit_comment) [.commit.comment.tcomment get 1.0 end] 459 svn_commit $cvsglb(commit_comment) $cvsglb(commit_list) 460 commit_history $cvsglb(commit_comment) 461 } 462 button .commit.clear -text "ClearAll" \ 463 -command { 464 set version "" 465 .commit.comment.tcomment delete 1.0 end 466 } 467 button .commit.quit \ 468 -command { 469 #grab release .commit 470 wm withdraw .commit 471 } 472 473 .commit.ok configure -text "OK" 474 .commit.quit configure -text "Close" 475 476 grid columnconf .commit.comment 1 -weight 1 477 grid rowconf .commit.comment 1 -weight 1 478 grid .commit.comment.lcomment -column 0 -row 0 479 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew 480 grid .commit.comment.history -column 0 -row 1 481 482 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ 483 -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 484 485 # Fill in the most recent commit message 486 .commit.comment.tcomment insert end $cvsglb(commit_comment) 487 488 wm title .commit "Commit Changes" 489 wm minsize .commit 1 1 490 491 gen_log:log T "LEAVE" 492} 493 494# svn commit - called from commit dialog 495proc svn_commit {comment args} { 496 global cvscfg 497 498 gen_log:log T "ENTER ($comment $args)" 499 500 set filelist [join $args] 501 502 set commit_output "" 503 if {$filelist == ""} { 504 set mess "This will commit your changes to ** ALL ** files in" 505 append mess " and under this directory." 506 } else { 507 foreach file $filelist { 508 append commit_output "\n$file" 509 } 510 set mess "This will commit your changes to:$commit_output" 511 } 512 append mess "\n\nAre you sure?" 513 set commit_output "" 514 515 if {[cvsconfirm $mess .workdir] != "ok"} { 516 return 1 517 } 518 519 if {$cvscfg(use_cvseditor)} { 520 # Starts text editor of your choice to enter the log message. 521 update idletasks 522 set command \ 523 "$cvscfg(terminal) svn commit $filelist" 524 gen_log:log C "$command" 525 set ret [catch {eval "exec $command"} view_this] 526 if {$ret} { 527 cvsfail $view_this .workdir 528 gen_log:log T "LEAVE ERROR ($view_this)" 529 return 530 } 531 } else { 532 if {$comment == ""} { 533 cvsfail "You must enter a comment!" .commit 534 return 1 535 } 536 set v [viewer::new "SVN Commit"] 537 regsub -all "\"" $comment "\\\"" comment 538 $v\::do "svn commit -m \"$comment\" $filelist" 1 539 $v\::wait 540 } 541 542 if {$cvscfg(auto_status)} { 543 setup_dir 544 } 545 gen_log:log T "LEAVE" 546} 547 548# Called from workdir browser annotate button 549proc svn_annotate {revision args} { 550 global cvscfg 551 552 gen_log:log T "ENTER ($revision $args)" 553 if {$revision != ""} { 554 # We were given a revision 555 set revflag "-r$revision" 556 } else { 557 set revflag "" 558 } 559 560 set filelist [join $args] 561 if {$filelist == ""} { 562 cvsfail "Annotate:\nPlease select one or more files !" .workdir 563 gen_log:log T "LEAVE (Unselected files)" 564 return 565 } 566 foreach file $filelist { 567 annotate::new $revflag $file "svn" 568 } 569 gen_log:log T "LEAVE" 570} 571 572# Called from branch browser annotate button 573proc svn_annotate_r {revision filepath} { 574 global cvscfg 575 576 gen_log:log T "ENTER ($revision $filepath)" 577 if {$revision != ""} { 578 # We were given a revision 579 set revflag "-r$revision" 580 } else { 581 set revflag "" 582 } 583 584 annotate::new $revflag $filepath "svn_r" 585 gen_log:log T "LEAVE" 586} 587 588proc svn_patch { pathA pathB revA dateA revB dateB outmode outfile } { 589# 590# This creates a patch file between two revisions of a module. If the 591# second revision is null, it creates a patch to the head revision. 592# If both are null the top two revisions of the file are diffed. 593# 594 global cvscfg 595 596 gen_log:log T "ENTER ($pathA $pathB $revA $dateA $revB $dateB $outmode $outfile)" 597 global cvs 598 599 foreach {rev1 rev2} {{} {}} { break } 600 if {$revA != {}} { 601 set rev1 $revA 602 } elseif {$dateA != {}} { 603 set rev1 "\{\"$dateA\"\}" 604 } 605 if {$revB != {}} { 606 set rev2 "$revB" 607 } elseif {$dateA != {}} { 608 set rev2 "\{\"$dateB\"\}" 609 } 610 set pathA [safe_url $pathA] 611 set pathB [safe_url $pathB] 612 if {$pathA != {} && $pathB != {}} { 613 set command "svn diff $pathA $pathB" 614 } elseif {$rev1 != {} && $rev2 != {}} { 615 set command "svn diff $pathA@$rev1 $pathA@$rev2" 616 } else { 617 cvsfail "Specify either two paths OR one path and two revisions" 618 return 619 } 620 621 if {$outmode == 0} { 622 set v [viewer::new "SVN Diff"] 623 $v\::do "$command" 624 } else { 625 set e [exec::new "$command"] 626 set patch [$e\::output] 627 gen_log:log F "OPEN $outfile" 628 if {[catch {set fo [open $outfile w]}]} { 629 cvsfail "Cannot open $outfile for writing" .modbrowse 630 return 631 } 632 puts $fo $patch 633 close $fo 634 $e\::destroy 635 gen_log:log F "CLOSE $outfile" 636 } 637 gen_log:log T "LEAVE" 638 return 639} 640 641# Called from module browser filebrowse button 642proc svn_list {module} { 643 global cvscfg 644 645 gen_log:log T "ENTER ($module)" 646 set v [viewer::new "SVN list -R"] 647 $v\::do "svn list -Rv \"$cvscfg(svnroot)/$module\"" 648 gen_log:log T "LEAVE" 649} 650 651# Called from the module browser 652proc svn_delete {root path} { 653 654 gen_log:log T "ENTER ($root $path)" 655 656 set mess "Really delete $path from the SVN repository?" 657 if {[cvsconfirm $mess .modbrowse] != "ok"} { 658 return 659 } 660 set url [safe_url $root/$path] 661 set v [viewer::new "SVN delete"] 662 set command "svn delete \"$url\" -m\"Removed_using_TkSVN\"" 663 $v\::do "$command" 664 modbrowse_run 665 gen_log:log T "LEAVE" 666} 667 668# This is the callback for the folder-opener in ModTree 669proc svn_jit_listdir { tf into } { 670 global cvscfg 671 global cvsglb 672 673 gen_log:log T "ENTER ($tf $into)" 674 set cvscfg(svnroot) $cvsglb(root) 675 #puts "\nEntering svn_jit_listdir ($into)" 676 set dir [string trimleft $into / ] 677 set command "svn list -v \"$cvscfg(svnroot)/$dir\"" 678 #puts "$command" 679 set cmd(svnlist) [exec::new "$command"] 680 if {[info exists cmd(svnlist)]} { 681 set contents [split [$cmd(svnlist)\::output] "\n"] 682 $cmd(svnlist)\::destroy 683 catch {unset cmd(svnlist)} 684 } 685 set dirs {} 686 set fils {} 687 foreach logline $contents { 688 if {$logline == "" } continue 689 gen_log:log D "$logline" 690 if [string match {*/} $logline] { 691 set item [lrange $logline 5 end] 692 set item [string trimright $item "/"] 693 if {$item ne "."} { 694 lappend dirs "$item" 695 set info($item) [lrange $logline 0 4] 696 } 697 } else { 698 set item [lrange $logline 6 end] 699 lappend fils "$item" 700 set info($item) [lrange $logline 0 5] 701 } 702 } 703 704 busy_start $tf 705 ModTree:close $tf /$dir 706 ModTree:delitem $tf /$dir/_jit_placeholder 707 foreach f $fils { 708 set command "ModTree:newitem $tf \"/$dir/$f\" \"$f\" \"$info($f)\" -image Fileview" 709 set r [catch "$command" err] 710 } 711 foreach d $dirs { 712 svn_jit_dircmd $tf $dir/$d 713 } 714 gen_log:log D "ModTree:open $tf /$dir" 715 ModTree:open $tf /$dir 716 717 #puts "\nLeaving svn_jit_listdir" 718 busy_done $tf 719 gen_log:log T "LEAVE" 720} 721 722proc svn_jit_dircmd { tf dir } { 723 global cvscfg 724 global Tree 725 726 #gen_log:log T "ENTER ($tf $dir)" 727 728 # Here we are just figuring out if the top level directory is empty or not. 729 # We don't have to collect any other information, so no -v flag 730 set command "svn list \"$cvscfg(svnroot)/$dir\"" 731 #puts "$command" 732 set cmd(svnlist) [exec::new "$command"] 733 if {[info exists cmd(svnlist)]} { 734 set contents [$cmd(svnlist)\::output] 735 $cmd(svnlist)\::destroy 736 catch {unset cmd(svnlist)} 737 } 738 set lbl "[file tail $dir]/" 739 set exp "([llength $contents] items)" 740 set parent "[file root $dir]" 741 742 set dirs {} 743 set fils {} 744 foreach logline [split $contents "\n"] { 745 if {$logline == ""} continue 746 #gen_log:log D "$logline" 747 if [string match {*/} $logline] { 748 set item [string trimright $logline "/"] 749 lappend dirs $item 750 } else { 751 lappend fils $logline 752 } 753 } 754 755 # To avoid having to look ahead and build the whole tree at once, we put 756 # a "marker" item in non-empty directories so it will look non-empty 757 # and be openable 758 if {$dirs == {} && $fils == {}} { 759 catch "ModTree:newitem $tf \"/$dir\" \"$lbl\" \"$exp\" -image Folder" 760 } else { 761 # Newitem returns nothing if the item already exists, or an "after" from 762 # buildwhenidle if the item had to be inserted 763 set r [catch "ModTree:newitem $tf \"/$dir\" \"$lbl\" \"$exp\" -image Folder" err] 764 if {! $r} { 765 if {! $Tree($tf:/$dir:open)} { 766 # If the node is already open, we don't need a placeholder 767 catch "ModTree:newitem $tf \"/$dir/_jit_placeholder\" \"\" \"\" -image {}" 768 } 769 } 770 } 771 772 #gen_log:log T "LEAVE" 773} 774 775# called from module browser - list branches & tags 776proc parse_svnmodules {tf svnroot} { 777 global cvscfg 778 global modval 779 780 gen_log:log T "ENTER ($tf $svnroot)" 781 782 if {[catch "image type fileview"]} { 783 workdir_images 784 } 785 786 set cvscfg(svnroot) $svnroot 787 set command "svn list -v $svnroot" 788 #puts "$command" 789 set cmd(svnlist) [exec::new "$command"] 790 if {[info exists cmd(svnlist)]} { 791 set contents [$cmd(svnlist)\::output] 792 $cmd(svnlist)\::destroy 793 catch {unset cmd(svnlist)} 794 } 795 set dirs {} 796 set fils {} 797 798 foreach logline [split $contents "\n"] { 799 if {$logline == "" } continue 800 gen_log:log D "$logline" 801 if [string match {*/} $logline] { 802 set item [lrange $logline 5 end] 803 if {$item ne "./"} { 804 lappend dirs [string trimright $item "/"] 805 } 806 } else { 807 set item [lrange $logline 6 end] 808 lappend fils $item 809 set info($item) [lrange $logline 0 5] 810 } 811 } 812 813 foreach f $fils { 814 catch "ModTree:newitem $tf \"/$f\" \"$f\" \"$info($f)\" -image Fileview" 815 } 816 foreach d $dirs { 817 svn_jit_dircmd $tf $d 818 } 819 820 gen_log:log T "LEAVE" 821} 822 823# called from workdir Reports menu 824proc svn_log {args} { 825 global cvscfg 826 global cvsglb 827 828 gen_log:log T "ENTER ($args)" 829 830 set svncommand "svn log " 831 # svn -g (mergeinfo) appeared in 1.5. It depends on the server 832 # as well as the client, so we can't go by version number. we 833 # just have to see if it works. 834 # Do we want to do -g for all detail levels? Probably not for summary. 835 if {$cvsglb(svn_mergeinfo_works)} { 836 if {$cvscfg(ldetail) ne "summary"} { 837 append svncommand "-g " 838 } 839 } 840 set filelist [join $args] 841 foreach file $filelist { 842 set command $svncommand 843 if {$cvscfg(ldetail) == "latest"} { 844 append command "-r COMMITTED " 845 } 846 if {$cvscfg(ldetail) == "summary"} { 847 append command "-q " 848 } 849 append command "\"$file\"" 850 851 set logcmd [viewer::new "SVN Log $file ($cvscfg(ldetail))"] 852 $logcmd\::do "$command" 853 } 854 gen_log:log T "LEAVE" 855} 856 857# called from branch browser 858proc svn_log_rev {filepath} { 859 global cvscfg 860 global cvsglb 861 862 gen_log:log T "ENTER ($filepath)" 863 864 set svncommand "svn log " 865 # svn -g (mergeinfo) appeared in 1.5. It depends on the server 866 # as well as the client, so we can't go by version number. we 867 # just have to see if it works. 868 if {$cvsglb(svn_mergeinfo_works)} { 869 append svncommand "-g " 870 } 871 if {[regexp {/} $filepath]} { 872 append svncommand "--stop-on-copy " 873 } 874 append svncommand "\"$filepath\"" 875 set logcmd [viewer::new "SVN log $filepath"] 876 $logcmd\::do "$svncommand" 877 gen_log:log T "LEAVE" 878} 879 880proc svn_info {args} { 881 global cvscfg 882 gen_log:log T "ENTER ($args)" 883 884 set filelist [join $args] 885 set urllist "" 886 foreach file $filelist { 887 append urllist $cvscfg(url)/$file 888 append urllist " " 889 } 890 set command "svn info " 891 append command $urllist 892 893 set logcmd [viewer::new "SVN Info ($cvscfg(ldetail))"] 894 $logcmd\::do "$command" 895 gen_log:log T "LEAVE" 896} 897 898proc svn_merge_conflict {args} { 899 global cvscfg 900 901 gen_log:log T "ENTER ($args)" 902 903 if {[llength $args] != 1} { 904 cvsfail "Please select one file." 905 return 906 } 907 set filelist [join $args] 908 909 # See if it's really a conflict file 910 foreach file $filelist { 911 gen_log:log F "OPEN $file" 912 set f [open $file] 913 set match 0 914 while { [eof $f] == 0 } { 915 gets $f line 916 if { [string match "<<<<<<< *" $line] } { 917 set match 1 918 break 919 } 920 } 921 gen_log:log F "CLOSE $file" 922 close $f 923 924 if { $match != 1 } { 925 cvsfail "$file does not appear to have a conflict." .workdir 926 continue 927 } 928 # FIXME: we don't want to tie up the whole UI with tkdiff, but 929 # if we don't wait, we have no way to know if we can mark resolved 930 # Invoke tkdiff with the proper option for a conflict file 931 # and have it write to the original file 932 set command "$cvscfg(tkdiff) -conflict -o \"$file\" \"$file\"" 933 gen_log:log C "$command" 934 set ret [catch {eval "exec $command"} view_this] 935 if {$ret == 0} { 936 set mess "Mark $file resolved?" 937 if {[cvsconfirm $mess .workdir] != "ok"} { 938 continue 939 } 940 set command "svn resolved \"$file\"" 941 exec::new $command 942 } else { 943 cvsfail "$view_this" .workdir 944 } 945 } 946 947 if {$cvscfg(auto_status)} { 948 setup_dir 949 } 950 gen_log:log T "LEAVE" 951} 952 953proc svn_resolve {args} { 954 global cvscfg 955 956 gen_log:log T "ENTER ($args)" 957 set filelist [join $args] 958 959 # See if it still has a conflict 960 foreach file $filelist { 961 gen_log:log F "OPEN $file" 962 set f [open $file] 963 set match 0 964 while { [eof $f] == 0 } { 965 gets $f line 966 if { [string match "<<<<<<< *" $line] } { 967 set match 1 968 break 969 } 970 } 971 gen_log:log F "CLOSE $file" 972 close $f 973 974 if {$match} { 975 set mess "$file still contains \"<<<<<<< \" - \nUnmark anyway?" 976 if {[cvsalwaysconfirm $mess .workdir] != "ok"} { 977 continue 978 } 979 } 980 gen_log:log D "Marking $file as resolved" 981 set command [exec::new "svn resolved $file"] 982 } 983 if {$cvscfg(auto_status)} { 984 setup_dir 985 } 986 987 gen_log:log T "LEAVE" 988} 989 990proc svn_revert {args} { 991 global cvscfg 992 993 gen_log:log T "ENTER ($args)" 994 set filelist [join $args] 995 if {$filelist == ""} { 996 set filelist "-R ." 997 } 998 gen_log:log D "Reverting $filelist" 999 set command [exec::new "svn revert $filelist"] 1000 auto_setup_dir $command 1001 1002 gen_log:log T "LEAVE" 1003} 1004 1005proc svn_tag {tagname b_or_t update args} { 1006# 1007# This tags a file or directory in the current sandbox. 1008# 1009 global cvscfg 1010 global cvsglb 1011 1012 gen_log:log T "ENTER ($tagname $b_or_t $update $args)" 1013 1014 if {$tagname == ""} { 1015 cvsfail "You must enter a tag name!" .workdir 1016 return 1 1017 } 1018 set filelist [join $args] 1019 gen_log:log D "relpath: $cvsglb(relpath) filelist \"$filelist\"" 1020 1021 if {$b_or_t == "tag" || $b_or_t == "tags"} {set pathelem "$cvscfg(svn_tagdir)"} 1022 if {$b_or_t == "branch"} {set pathelem "$cvscfg(svn_branchdir)"} 1023 1024 set comment "${b_or_t}_copy_by_TkSVN" 1025 set v [viewer::new "SVN Copy $tagname"] 1026 set to_url "$cvscfg(svnroot)/$pathelem/$tagname/$cvsglb(relpath)" 1027 if { $filelist == {} } { 1028 set command "svn copy -m\"$comment\" $cvscfg(url) $to_url" 1029 $v\::log "$command" 1030 $v\::do "$command" 1031 } else { 1032 foreach f $filelist { 1033 if {$f == "."} { 1034 set command "svn copy -m\"comment\" $cvscfg(url) $to_url" 1035 } else { 1036 svn_pathforcopy $tagname $pathelem $v 1037 set from_url [safe_url $cvscfg(url)/$f] 1038 set command "svn copy -m\"$comment\" $from_url $to_url" 1039 } 1040 $v\::log "$command" 1041 $v\::do "$command" 1042 } 1043 } 1044 1045 if {$update == "yes"} { 1046 # update so we're on the branch 1047 set command "svn switch $to_path" 1048 $v\::do "$command" 0 status_colortags 1049 $v\::wait 1050 } 1051 1052 if {$cvscfg(auto_status)} { 1053 setup_dir 1054 } 1055 gen_log:log T "LEAVE" 1056} 1057 1058proc svn_rcopy {from_path b_or_t newtag} { 1059# 1060# makes a tag or branch. Called from the module browser 1061# 1062 global cvscfg 1063 global cvsglb 1064 1065 gen_log:log T "ENTER ($from_path $b_or_t $newtag)" 1066 1067 # We're going to do some dangerous second-guessing here. If "trunk", or 1068 # something just below the "branches" or "tags" path, is selected, we guess 1069 # they want to copy its contents. 1070 # Otherwise, we'll copy exactly what they have selected. 1071 set need_list 0 1072 set idx [string length $cvscfg(svnroot)] 1073 incr idx ;# advance past / 1074 set from_path_remainder [string range $from_path $idx end] 1075 set pathelements [file split $from_path_remainder] 1076 if {$from_path_remainder == "$cvscfg(svn_trunkdir)"} { 1077 set need_list 1 1078 } elseif {[llength $pathelements] == 2} { 1079 set from_type [lindex $pathelements 0] 1080 switch -- $from_type { 1081 "$cvscfg(svn_tagdir)" - 1082 "$cvscfg(svn_branchdir)" { 1083 set need_list 1 1084 } 1085 } 1086 } 1087 set comment "${b_or_t}_copy_by_TkSVN" 1088 1089 set v [viewer::new "SVN Copy $newtag"] 1090 set comment "Copied_using_TkSVN" 1091 set to_path [svn_pathforcopy $newtag $b_or_t $v] 1092 1093 if {! $need_list } { 1094 # Copy the selected path 1095 set command "svn copy -m\"$comment\" [safe_url $from_path] $to_path" 1096 $v\::do "$command" 1097 $v\::wait 1098 } else { 1099 # Copy the contents of the selected path 1100 set command "svn list [safe_url $from_path]" 1101 set cmd(svnlist) [exec::new "$command"] 1102 if {[info exists cmd(svnlist)]} { 1103 set contents [split [$cmd(svnlist)\::output] "\n"] 1104 $cmd(svnlist)\::destroy 1105 catch {unset cmd(svnlist)} 1106 } 1107 foreach f $contents { 1108 if {$f == ""} {continue} 1109 set file_from_path [safe_url "$from_path/$f"] 1110 set command "svn copy -m\"$comment\" $file_from_path $to_path" 1111 $v\::log "$command\n" 1112 $v\::do "$command" 1113 $v\::wait 1114 } 1115 } 1116 # Update with what we've done 1117 modbrowse_run svn 1118 gen_log:log T "LEAVE" 1119} 1120 1121proc svn_pathforcopy {tagname b_or_t viewer} { 1122# For svn copy, the destination path in the repository must already 1123# exist. If we're tagging somewhere other than the top level, it may 1124# not exist yet. This proc creates the path if necessary and returns 1125# it to the calling proc, which will do the copy. 1126 global cvscfg 1127 global cvsglb 1128 1129 gen_log:log T "ENTER (\"$tagname\" \"$b_or_t\" \"$viewer\")" 1130 # Can't use file join or it will mess up the URL 1131 set to_path [safe_url "$cvscfg(svnroot)/$b_or_t/$tagname"] 1132 set comment "${b_or_t}_directory_path_by_TkSVN" 1133 1134 # If no file yet has this tag/branch name, create it 1135 set ret [catch "eval exec svn list $to_path" err] 1136 if {$ret} { 1137 set command "svn mkdir -m\"$comment\" $to_path" 1138 $viewer\::log "$command\n" 1139 $viewer\::do "$command" 1140 $viewer\::wait 1141 } 1142 # We may need to construct a path to copy the file to 1143 set cum_path "" 1144 set pathelements [file split $cvsglb(relpath)] 1145 set depth [llength $pathelements] 1146 for {set i 0} {$i < $depth} {incr i} { 1147 set cum_path [file join $cum_path [lindex $pathelements $i]] 1148 gen_log:log D " $i $cum_path" 1149 set ret [catch "eval exec svn list $to_path/$cum_path" err] 1150 if {$ret} { 1151 set command "svn mkdir -m\"$comment\" $to_path/$cum_path" 1152 $viewer\::do "$command" 1153 $viewer\::wait 1154 } 1155 } 1156 if {$cum_path != ""} { 1157 set to_path "$to_path/$cum_path" 1158 } 1159 gen_log:log T "LEAVE (\"$to_path\")" 1160 return $to_path 1161} 1162 1163proc svn_merge {parent frompath since currentpath frombranch args} { 1164# 1165# This does a join (merge) of a chosen revision of localfile to the 1166# current revision. 1167# 1168 global cvscfg 1169 global cvsglb 1170 1171 gen_log:log T "ENTER( \"$frompath\" \"$since\" \"$currentpath\" \"$frombranch\" $args)" 1172 1173 set mergetags [assemble_mergetags $frombranch] 1174 set curr_tag [lindex $mergetags 0] 1175 set fromtag [lindex $mergetags 1] 1176 set totag [lindex $mergetags 2] 1177 1178 regsub {^.*@} $frompath {r} from 1179 if {$since == {}} { 1180 set mess "Merge revision $from\n" 1181 } else { 1182 set mess "Merge the changes between revision\n $since and $from" 1183 append mess " (if $since > $from the changes are removed)\n" 1184 } 1185 append mess " to the current revision ($curr_tag)" 1186 if {[cvsalwaysconfirm $mess $parent] != "ok"} { 1187 return 1188 } 1189 1190 # Do the update here, and defer the tagging until later 1191 #set commandline "svn merge --accept postpone \"$currentpath\" \"$frompath\"" 1192 set commandline "svn merge \"$currentpath\" \"$frompath\"" 1193 set v [viewer::new "SVN Merge"] 1194 $v\::do "$commandline" 1 status_colortags 1195 $v\::wait 1196 1197 if [winfo exists .workdir] { 1198 if {$cvscfg(auto_status)} { 1199 setup_dir 1200 } 1201 } else { 1202 workdir_setup 1203 } 1204 1205 dialog_merge_notice svn $from $frombranch $fromtag $totag $args 1206 1207 gen_log:log T "LEAVE" 1208} 1209 1210proc svn_merge_tag_seq {from frombranch totag fromtag args} { 1211 global cvscfg 1212 global cvsglb 1213 1214 gen_log:log T "ENTER (\"$from\" \"$totag\" \"$fromtag\" $args)" 1215 1216 set filelist "" 1217 foreach f $args { 1218 append filelist "\"$f\" " 1219 } 1220 1221 # It's muy importante to make sure everything is OK at this point 1222 set commandline "svn status -uq $filelist" 1223 gen_log:log C "$commandline" 1224 set ret [catch {eval "exec $commandline"} view_this] 1225 set logmode [expr {$ret ? {E} : {D}}] 1226 view_output::new "SVN Check" $view_this 1227 gen_log:log $logmode $view_this 1228 if {$ret} { 1229 set mess "SVN Check shows errors which would prevent a successful\ 1230 commit. Please resolve them before continuing." 1231 if {[cvsalwaysconfirm $mess .workdir] != "ok"} { 1232 return 1233 } 1234 } 1235 1236 # Do the commit 1237 set v [viewer::new "SVN Commit a Merge"] 1238 $v\::log "svn commit -m \"Merge from $from\" $filelist\n" 1239 $v\::do "svn commit -m \"Merge from $from\" $filelist" 1 1240 $v\::wait 1241 1242 # Tag if desired (no means not a branch 1243 if {$cvscfg(auto_tag) && $fromtag != ""} { 1244 if {$frombranch == "trunk"} { 1245 set from_path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$cvsglb(relpath)" 1246 } else { 1247 set from_path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$frombranch/$cvsglb(relpath)" 1248 } 1249 # tag the current (mergedto) branch 1250 svn_tag $fromtag tags false $args ;# opens its own viewer 1251 # Tag the mergedfrom branch 1252 set filelist [join $args] 1253 foreach file $filelist { 1254 if {$file == "."} { 1255 svn_rcopy [safe_url $from_path] "tags" $totag ;# opens its own viewer 1256 } else { 1257 svn_rcopy [safe_url $from_path/$f] "tags" $totag ;# opens its own viewer 1258 } 1259 } 1260 } 1261 1262 if {$cvscfg(auto_status)} { 1263 setup_dir 1264 } 1265 gen_log:log T "LEAVE" 1266} 1267 1268# SVN Checkout or Export. Called from Repository Browser 1269proc svn_checkout {dir url path rev target cmd} { 1270 gen_log:log T "ENTER ($dir $url $path $rev $target $cmd)" 1271 1272 foreach {incvs insvn inrcs} [cvsroot_check $dir] { break } 1273 if {$insvn} { 1274 set mess "This is already a SVN controlled directory. Are you\ 1275 sure that you want to export into this directory?" 1276 if {[cvsconfirm $mess .modbrowse] != "ok"} { 1277 return 1278 } 1279 } 1280 1281 set command "svn $cmd" 1282 if {$rev != {} } { 1283 # Let them get away with saying r3 instead of 3 1284 set rev [string trimleft $rev {r}] 1285 append command " -r$rev" 1286 } 1287 set path [safe_url $path] 1288 append command " $url/$path" 1289 if {$target != {} } { 1290 append command " $target" 1291 } 1292 gen_log:log C "$command" 1293 1294 set v [viewer::new "SVN $cmd"] 1295 $v\::do "$command" 1296 $v\::wait 1297 gen_log:log T "LEAVE" 1298} 1299 1300# SVN cat or ls. Called from module browser 1301proc svn_filecat {root path title} { 1302 gen_log:log T "ENTER ($root $path $title)" 1303 1304 set url [safe_url $root/$path] 1305 # Should do cat if it's a file and ls if it's a path 1306 if {[string match {*/} $title]} { 1307 set command "svn ls \"$url\"" 1308 set wintitle "SVN ls" 1309 } else { 1310 set command "svn cat \"$url\"" 1311 set wintitle "SVN cat" 1312 } 1313 1314 set v [viewer::new "$wintitle $url"] 1315 $v\::do "$command" 1316} 1317 1318# SVN log. Called from module browser 1319proc svn_filelog {root path title} { 1320 global cvsglb 1321 1322 gen_log:log T "ENTER ($root $path $title)" 1323 1324 set command "svn log " 1325 # svn -g (mergeinfo) appeared in 1.5. It depends on the server 1326 # as well as the client, so we can't go by version number. we 1327 # just have to see if it works. 1328 if {$cvsglb(svn_mergeinfo_works)} { 1329 append command "-g " 1330 } 1331 1332 set url [safe_url $root/$path] 1333 append command "\"$url\"" 1334 set wintitle "SVN Log" 1335 1336 set v [viewer::new "$wintitle $url"] 1337 $v\::do "$command" 1338} 1339 1340proc svn_fileview {revision filename kind} { 1341# This views a specific revision of a file in the repository. 1342# For files checked out in the current sandbox. 1343 global cvscfg 1344 1345 gen_log:log T "ENTER ($revision $filename $kind)" 1346 set command "cat" 1347 if {$kind == "directory"} { 1348 set command "ls" 1349 } 1350 if {$revision == {}} { 1351 set command "svn $command \"$filename\"" 1352 set v [viewer::new "$filename"] 1353 $v\::do "$command" 1354 } else { 1355 set command "svn $command -$revision \"$filename\"" 1356 set v [viewer::new "$filename Revision $revision"] 1357 $v\::do "$command" 1358 } 1359 gen_log:log T "LEAVE" 1360} 1361 1362# Sends directory "." to the directory-merge tool 1363proc svn_directory_merge {} { 1364 global cvscfg 1365 global cvsglb 1366 1367 gen_log:log T "ENTER" 1368 1369 gen_log:log D "Relative Path: $cvsglb(relpath)" 1370 ::svn_branchlog::new $cvsglb(relpath) . 1 1371 1372 gen_log:log T "LEAVE" 1373} 1374 1375# Sends files to the SVN branch browser one at a time 1376proc svn_branches {files} { 1377 global cvscfg 1378 global cvsglb 1379 1380 gen_log:log T "ENTER ($files)" 1381 set filelist [join $files] 1382 1383 if {$files == {}} { 1384 cvsfail "Please select one or more files!" .workdir 1385 return 1386 } 1387 1388 gen_log:log D "Relative Path: $cvsglb(relpath)" 1389 1390 foreach file $files { 1391 ::svn_branchlog::new $cvsglb(relpath) $file 1392 } 1393 1394 gen_log:log T "LEAVE" 1395} 1396 1397proc safe_url { url } { 1398 # Replacement is done in an ordered manner, so the key appearing 1399 # first in the list will be checked first, and so on. string is 1400 # only iterated over once. 1401 set url [string map { 1402 "%20" "%20" 1403 "%25" "%25" 1404 "%26" "%26" 1405 "%" "%25" 1406 "&" "%26" 1407 " " "%20" 1408 } $url] 1409 #regsub -all {%} $url {%25} url 1410 #regsub -all {&} $url {%26} url 1411 #regsub -all { } $url {%20} url 1412 # These don't seem to be necessary 1413 #regsub -all {\+} $url {%2B} url 1414 #regsub -all {\-} $url {%2D} url 1415 return $url 1416} 1417 1418namespace eval ::svn_branchlog { 1419 variable instance 0 1420 1421 proc new {relpath filename {directory_merge {0}} } { 1422 variable instance 1423 set my_idx $instance 1424 incr instance 1425 1426 namespace eval $my_idx { 1427 set my_idx [uplevel {concat $my_idx}] 1428 set filename [uplevel {concat $filename}] 1429 set relpath [uplevel {concat $relpath}] 1430 set directory_merge [uplevel {concat $directory_merge}] 1431 variable cmd_log 1432 variable lc 1433 variable revwho 1434 variable revdate 1435 variable revtime 1436 variable revlines 1437 variable revstate 1438 variable revcomment 1439 variable tags 1440 variable revbranches 1441 variable branchrevs 1442 variable logstate 1443 variable show_tags 1444 variable show_merges 1445 1446 gen_log:log T "ENTER [namespace current]" 1447 if {$directory_merge} { 1448 set newlc [logcanvas::new . "SVN,loc" [namespace current]] 1449 set ln [lindex $newlc 0] 1450 set lc [lindex $newlc 1] 1451 set show_tags 0 1452 } else { 1453 set newlc [logcanvas::new $filename "SVN,loc" [namespace current]] 1454 set ln [lindex $newlc 0] 1455 set lc [lindex $newlc 1] 1456 set show_tags [set $ln\::opt(show_tags)] 1457 } 1458 1459 # Implementation of Perl-like "grep {/re/} in_list" 1460 proc grep_filter { re in_list } { 1461 set res "" 1462 foreach x $in_list { 1463 if {[regexp $re $x]} { 1464 lappend res $x 1465 } 1466 } 1467 return $res 1468 } 1469 1470 proc abortLog { } { 1471 global cvscfg 1472 variable cmd_log 1473 variable lc 1474 1475 gen_log:log D " $cmd_log\::abort" 1476 catch {$cmd_log\::abort} 1477 busy_done $lc 1478 pack forget $lc.stop 1479 pack $lc.close -in $lc.down.closefm -side right 1480 $lc.close configure -state normal 1481 } 1482 1483 proc reloadLog { } { 1484 global cvscfg 1485 global cvsglb 1486 variable filename 1487 variable cmd_log 1488 variable lc 1489 variable ln 1490 variable revwho 1491 variable revdate 1492 variable revtime 1493 variable revcomment 1494 variable revkind 1495 variable revpath 1496 variable revname 1497 variable revtags 1498 variable revbtags 1499 variable revmergefrom 1500 variable branchrevs 1501 variable allrevs 1502 variable revbranches 1503 variable logstate 1504 variable relpath 1505 variable filename 1506 variable show_tags 1507 variable show_merges 1508 1509 gen_log:log T "ENTER" 1510 catch { $lc.canvas delete all } 1511 catch { unset revwho } 1512 catch { unset revdate } 1513 catch { unset revtime } 1514 catch { unset revcomment } 1515 catch { unset revtags } 1516 catch { unset revbtags } 1517 catch { unset revmergefrom } 1518 catch { unset branchrevs } 1519 catch { unset revbranches } 1520 catch { unset revkind } 1521 catch { unset revpath } 1522 catch { unset revname } 1523 1524 pack forget $lc.close 1525 pack $lc.stop -in $lc.down.closefm -side right 1526 $lc.stop configure -state normal 1527 1528 # Can't use file join or it will mess up the URL 1529 set safe_filename [safe_url $filename] 1530 set path "$cvscfg(url)/$safe_filename" 1531 $ln\::ConfigureButtons $filename 1532 1533 set show_merges [set $ln\::opt(show_merges)] 1534 set show_tags [set $ln\::opt(show_tags)] 1535 1536 # Find out where to put the working revision icon (if anywhere) 1537 set revnum_current [set $ln\::revnum_current] 1538 set revnum_current r$revnum_current 1539 1540 if { $relpath == {} } { 1541 set path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$safe_filename" 1542 } else { 1543 set path "$cvscfg(svnroot)/$cvscfg(svn_trunkdir)/$relpath/$safe_filename" 1544 } 1545 if {! $cvsglb(svnconform)} { 1546 set path "$cvscfg(svnroot)/$safe_filename" 1547 } 1548 # We need to go to the repository to find the highest revision. Doing 1549 # info on local files may not have it. Let's start with what we've got 1550 # though in case it fails. 1551 set highest_revision [string trimleft $revnum_current "r"] 1552 set command "svn info $path" 1553 gen_log:log C "$command" 1554 set ret [catch {eval "exec $command"} output] 1555 if {$ret} { 1556 gen_log:log D "This file $path must not be in the trunk" 1557 ## cvsfail $output 1558 } 1559 foreach infoline [split $output "\n"] { 1560 if {[string match "Revision*" $infoline]} { 1561 set highest_revision [lrange $infoline 1 end] 1562 gen_log:log D "$highest_revision" 1563 } 1564 } 1565 1566 # The trunk 1567 set branchrevs(trunk) {} 1568 # There's nothing especially privileged about the trunk except that one 1569 # branch must not stop-on-copy. Maybe the file was added on a branch, 1570 # or maybe it isn't on the trunk anymore but it once was. We'll have 1571 # to use a range from r1 that case, to find it 1572 set range "${highest_revision}:1" 1573 set command "svn log -r $range $path" 1574 set cmd_log [exec::new $command {} 0 {} 1] 1575 set log_output [$cmd_log\::output] 1576 $cmd_log\::destroy 1577 set trunk_lines [split $log_output "\n"] 1578 set rr [parse_svnlog $trunk_lines trunk] 1579 # See if the current revision is on the trunk 1580 set curr 0 1581 set brevs $branchrevs(trunk) 1582 set tip [lindex $brevs 0] 1583 set revpath($tip) $path 1584 set revkind($tip) "revision" 1585 set brevs [lreplace $brevs 0 0] 1586 if {$tip == $revnum_current} { 1587 # If current is at end of trunk do this. 1588 set branchrevs(trunk) [linsert $branchrevs(trunk) 0 {current}] 1589 set curr 1 1590 } 1591 foreach r $brevs { 1592 if {$r == $revnum_current} { 1593 # We need to make a new artificial branch off of $r 1594 lappend revbranches($r) {current} 1595 } 1596 gen_log:log D " $r $revdate($r) ($revcomment($r))" 1597 set revkind($r) "revision" 1598 set revpath($r) $path 1599 } 1600 set branchrevs($rr) $branchrevs(trunk) 1601 set revkind($rr) "root" 1602 set revname($rr) "trunk" 1603 set revbtags($rr) "trunk" 1604 set revpath($rr) $path 1605 1606 # if root is not empty added it to the branchlist 1607 if { $rr ne "" } { 1608 lappend branchlist $rr 1609 } 1610 # Branches 1611 # Get a list of the branches from the repository 1612 set command "svn list $cvscfg(svnroot)/$cvscfg(svn_branchdir)" 1613 set cmd_log [exec::new $command {} 0 {} 1] 1614 set branches [$cmd_log\::output] 1615 $cmd_log\::destroy 1616 # There can be files such as "README" here that aren't branches 1617 set branches [grep_filter {/$} $branches] 1618 1619 foreach branch $branches { 1620 gen_log:log D "$branch" 1621 set branch [string trimright $branch "/"] 1622 # Can't use file join or it will mess up the URL 1623 gen_log:log D "BRANCHES: RELPATH \"$relpath\"" 1624 if { $relpath == {} } { 1625 set path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$branch/$safe_filename" 1626 } else { 1627 set path "$cvscfg(svnroot)/$cvscfg(svn_branchdir)/$branch/$relpath/$safe_filename" 1628 } 1629 # Do stop-on-copy to find the base of the branch 1630 set command "svn log --stop-on-copy $path" 1631 set cmd_log [exec::new $command {} 0 {} 1] 1632 set log_output [$cmd_log\::output] 1633 $cmd_log\::destroy 1634 if {$log_output == ""} { 1635 continue 1636 } 1637 set loglines [split $log_output "\n"] 1638 set rb [parse_svnlog $loglines $branch] 1639 # See if the current revision is on this branch 1640 set curr 0 1641 set brevs $branchrevs($branch) 1642 set tip [lindex $brevs 0] 1643 set revpath($tip) $path 1644 set revkind($tip) "revision" 1645 set brevs [lreplace $brevs 0 0] 1646 if {$tip == $revnum_current} { 1647 # If current is at end of the branch do this. 1648 set branchrevs($branch) [linsert $branchrevs($branch) 0 {current}] 1649 set curr 1 1650 } 1651 foreach r $brevs { 1652 if {$r == $revnum_current} { 1653 # We need to make a new artificial branch off of $r 1654 lappend revbranches($r) {current} 1655 } 1656 gen_log:log D " $r $revdate($r) ($revcomment($r))" 1657 set revkind($r) "revision" 1658 set revpath($r) $path 1659 } 1660 set branchrevs($rb) $branchrevs($branch) 1661 set revkind($rb) "branch" 1662 # build a list of all branches so we can make sure each branch is on 1663 # a revbranch list so there will be a full set of branches on diagram 1664 lappend branchlist $rb 1665 set revname($rb) $branch 1666 lappend revbtags($rb) $branch 1667 set revpath($rb) $path 1668 1669 set command "svn log -q $path" 1670 set cmd_log [exec::new $command {} 0 {} 1] 1671 set log_output [$cmd_log\::output] 1672 $cmd_log\::destroy 1673 if {$log_output == ""} { 1674 cvsfail "$command returned no output" 1675 return 1676 } 1677 set loglines [split $log_output "\n"] 1678 parse_q $loglines $branch 1679 1680 # If current is HEAD of branch, the count is one too high because of the 1681 # You Are Here box, so the branchpoint would be too low 1682 set idx [llength $branchrevs($branch)] 1683 if {$curr} { 1684 gen_log:log E "Currently at Top" 1685 incr idx -1 1686 } 1687 set bp [lindex $allrevs($branch) $idx] 1688 if {$bp == ""} { 1689 gen_log:log E "allrevs same as branchrevs: decrementing branchpoint" 1690 set bp [lindex $branchrevs($branch) end] 1691 set bpn [string trimleft $bp "r"] 1692 incr bpn -1 1693 set bp "r${bpn}" 1694 } 1695 lappend revbranches($bp) $rb 1696 } 1697 # Tags 1698 # Get a list of the tags from the repository 1699 if {$show_tags} { 1700 set command "svn list $cvscfg(svnroot)/$cvscfg(svn_tagdir)" 1701 set cmd_log [exec::new $command {} 0 {} 1] 1702 set tags [$cmd_log\::output] 1703 $cmd_log\::destroy 1704 set n_tags [llength $tags] 1705 if {$n_tags > $cvscfg(toomany_tags)} { 1706 # If confirm is on, give them a chance to say yes or no to tags 1707 if {$cvscfg(confirm_prompt)} { 1708 set mess "There are $n_tags tags. It could take a long time " 1709 append mess "to process them. If you're willing to wait, " 1710 append mess " press OK and get a cup of coffee.\n" 1711 append mess "Otherwise, press Cancel and I will draw the " 1712 append mess "diagram now without showing tags. " 1713 append mess "You may wish to turn off\n" 1714 append mess "View -> Revision Layout -> Show Tags\n" 1715 append mess " and\n" 1716 append mess "View -> Save Options" 1717 if {[cvsconfirm $mess $lc] != "ok"} { 1718 set tags "" 1719 } 1720 } else { 1721 # Otherwise, just don't process tags 1722 set tags "" 1723 gen_log:log E "Skipping tags: $n_tags > cvscfg(toomany_tags) ($cvscfg(toomany_tags))" 1724 } 1725 } 1726 foreach tag $tags { 1727 gen_log:log D "$tag" 1728 # There can be files such as "README" here that aren't tags 1729 if {![string match {*/} $tag]} {continue} 1730 set tag [string trimright $tag "/"] 1731 # Can't use file join or it will mess up the URL 1732 gen_log:log D "TAGS: RELPATH \"$relpath\"" 1733 if { $relpath == {} } { 1734 set path "$cvscfg(svnroot)/$cvscfg(svn_tagdir)/$tag/$safe_filename" 1735 } else { 1736 set path "$cvscfg(svnroot)/$cvscfg(svn_tagdir)/$tag/$relpath/$safe_filename" 1737 } 1738 # Do log with stop-on-copy to find the actual revision that was tagged. 1739 # The tag itself created a rev which may be much higher. 1740 set command "svn log --stop-on-copy $path" 1741 set cmd_log [exec::new $command {} 0 {} 1] 1742 set log_output [$cmd_log\::output] 1743 $cmd_log\::destroy 1744 if {$log_output == ""} { 1745 continue 1746 } 1747 set loglines [split $log_output "\n"] 1748 set rb [parse_svnlog $loglines $tag] 1749 foreach r $branchrevs($tag) { 1750 gen_log:log D " $r $revdate($r) ($revcomment($r))" 1751 set revkind($r) "revision" 1752 set revpath($r) $path 1753 } 1754 set revkind($rb) "tag" 1755 set revname($rb) "$tag" 1756 set revpath($rb) $path 1757 1758 # Now do log -q to find the previous rev, which is down 1759 # the list. For tags, it's only one down, so we can limit 1760 # the log to 2. It only speeds it up a little though. 1761 set command "svn log -q --limit 2 $path" 1762 set cmd_log [exec::new $command {} 0 {} 1] 1763 set log_output [$cmd_log\::output] 1764 $cmd_log\::destroy 1765 if {$log_output == ""} { 1766 cvsfail "$command returned no output" 1767 return 1768 } 1769 set loglines [split $log_output "\n"] 1770 parse_q $loglines $tag 1771 set bp [lindex $allrevs($tag) [llength $branchrevs($tag)]] 1772 lappend revtags($bp) $tag 1773 gen_log:log D " revtags($bp) $revtags($bp)" 1774 update idletasks 1775 } 1776 } 1777 1778 # This is better than it used to be but there are still more propgets than there 1779 # could be, I think. We could match all the properties from one query instead of 1780 # just the one we're looking for 1781 if {$cvsglb(svn_mergeinfo_works) && $show_merges} { 1782 gen_log:log D "Finding all mergeprops" 1783 set bdirs {} 1784 lappend bdirs $cvscfg(svn_trunkdir) 1785 foreach b $branches { 1786 set b [string trimright $b "/"] 1787 lappend bdirs $cvscfg(svn_branchdir)/$b 1788 } 1789 gen_log:log D $bdirs 1790 set mergeprops {} 1791 foreach b $bdirs { 1792 gen_log:log D "$b" 1793 set cmd "svn propget svn:mergeinfo -r HEAD $cvscfg(svnroot)/$b/$relpath/$safe_filename" 1794 set cmd_prop [exec::new $cmd {} 0 {} 1] 1795 set propget_out [string trim [$cmd_prop\::output] "\n"] 1796 $cmd_prop\::destroy 1797 foreach mp $propget_out { 1798 if {[lsearch -exact $mergeprops $mp] < 0} { 1799 lappend mergeprops $mp 1800 } 1801 } 1802 } 1803 gen_log:log D "All merge properties: $mergeprops" 1804 #puts "All merge properties: $mergeprops\n" 1805 #puts "$bdirs" 1806 # Figure out where each property first appeared 1807 foreach mp $mergeprops { 1808 gen_log:log D "----------------" 1809 #puts "looking for $mp" 1810 gen_log:log D "looking for $mp" 1811 set found($mp) 0 1812 foreach b $bdirs { 1813 #puts "looking for $mp in $b" 1814 set bt [file tail $b] 1815 # We don't need to look for merges from BranchB in BranchB do we? 1816 #puts "Searching /$b for $mp" 1817 if {[string match "/$b*" $mp]} { 1818 #puts " don't need to look in $b for $mp" 1819 continue 1820 } 1821 foreach br [lsort -dictionary $branchrevs($bt)] { 1822 regsub {^r} $br {} br 1823 if {$br eq "current" || $br == 1} continue 1824 set cmd "svn propget svn:mergeinfo -r $br $cvscfg(svnroot)/$b/$relpath/$safe_filename" 1825 set cmd_prop [exec::new $cmd {} 0 {} 1] 1826 set propget_out [string trim [$cmd_prop\::output] "\n"] 1827 $cmd_prop\::destroy 1828 if {$propget_out != ""} { 1829 #puts " $propget_out found in $br" 1830 foreach mr $propget_out { 1831 if {$mr eq $mp} { 1832 gen_log:log D " $mp found on rev $br of $b" 1833 #puts " == $mp found" 1834 set found($mp) 1 1835 set spl [split $mp ":"] 1836 set fromrevs [lindex $spl 1] 1837 gen_log:log D " to r$br fromrevs $fromrevs" 1838 regsub {^.*-} $fromrevs {} lastfromrev 1839 # I don't understand something like /trunk/File1:3-10 when those revs aren't 1840 # on the trunk 1841 if {[lsearch -exact $branchrevs($bt) "r$lastfromrev"] > -1} continue 1842 set revmergefrom(r$br) "r$lastfromrev" 1843 gen_log:log D " revmergefrom(r$br) $revmergefrom(r$br)" 1844 } 1845 } 1846 } 1847 if {$found($mp)} break 1848 } 1849 if {$found($mp)} break 1850 } 1851 } 1852 } 1853 1854 # sort the list in rev number order 1855 set brlist [lsort -dictionary $branchlist] 1856 gen_log:log D "init branches $brlist" 1857 # rebuild the list 1858 set branchlist {} 1859 foreach br $brlist { 1860 lappend branchlist $br 1861 # add to the list any revs that are in the branch revs 1862 # that also have revbranches 1863 if {[info exists branchrevs($br)]} { 1864 foreach r $branchrevs($br) { 1865 if {[info exists revbranches($r)] } { 1866 lappend branchlist $r 1867 } 1868 } 1869 } 1870 } 1871 set branchlist [lsort -dictionary $branchlist] 1872 gen_log:log D "branches $branchlist" 1873 1874 # add any branches that are not on a revbranches list to the one closest 1875 # in numeric value 1876 1877 # counter of branches in the list 1878 set brn 0 1879 # get the length of the list so we can tell when we are done 1880 set brlistlen [llength $branchlist] 1881 while {$brn<$brlistlen} { 1882 # get the branch name 1883 set br [lindex $branchlist $brn] 1884 gen_log:log D " branch $brn is $br" 1885 # look at all the branches up to branch $br 1886 set subbrn 0 1887 set subbrwithrevs r0 1888 set subbrwithrevsnum 0 1889 set foundinrevbr 0 1890 while {$subbrn<$brn} { 1891 set subbr [lindex $branchlist $subbrn] 1892 # check each revbranch for this branch 1893 if {[info exists revbranches($subbr)]} { 1894 # remember the highest number rev with revbranches 1895 set subbrnum [string trimleft $subbr "r"] 1896 if { $subbrwithrevsnum < $subbrnum } { 1897 set subbrwithrevs $subbr 1898 set subbrwithrevsnum $subbrnum 1899 } 1900 foreach r $revbranches($subbr) { 1901 if {$r==$br} { 1902 # we found it in a revbranches 1903 incr foundinrevbr 1904 break 1905 } 1906 } 1907 } 1908 if {$foundinrevbr>0} { 1909 gen_log:log D " found $br in revbranch of $subbr" 1910 break 1911 } 1912 incr subbrn 1913 } 1914 if {$foundinrevbr<=0 && $subbrwithrevsnum!=0} { 1915 # we only want to attach a branch & not a rev that a branch is attached 1916 if { $revkind($br) eq "branch" } { 1917 gen_log:log D " put $br in revbranches of $subbrwithrevs" 1918 lappend revbranches($subbrwithrevs) $br 1919 } else { 1920 gen_log:log D " branch $br not attached because not a real branch" 1921 } 1922 } 1923 incr brn 1924 } 1925 pack forget $lc.stop 1926 pack $lc.close -in $lc.down.closefm -side right 1927 $lc.close configure -state normal 1928 1929 set branchrevs(current) {} 1930 [namespace current]::svn_sort_it_all_out 1931 gen_log:log T "LEAVE" 1932 return 1933 } 1934 1935 # Parses a --stop-on-copy log, getting information for each revision 1936 proc parse_svnlog {lines r} { 1937 variable revwho 1938 variable revdate 1939 variable revtime 1940 variable revcomment 1941 variable branchrevs 1942 1943 gen_log:log T "ENTER (<...> $r)" 1944 set revnum "" 1945 set i 0 1946 set l [llength $lines] 1947 while {$i < $l} { 1948 if { $i > 0 } { incr i -1 } 1949 set last [lindex $lines $i] 1950 incr i 1 1951 set line [lindex $lines $i] 1952 gen_log:log D "$i of $l: $line" 1953 if { [ regexp {^[-]+$} $last ] && [ regexp {^r[0-9]+ \| .*line[s]?$} $line] } { 1954 if {[expr {$l - $i}] <= 1} {break} 1955 set line [lindex $lines $i] 1956 set splitline [split $line "|"] 1957 set revnum [string trim [lindex $splitline 0]] 1958 lappend branchrevs($r) $revnum 1959 set revwho($revnum) [string trim [lindex $splitline 1]] 1960 set date_and_time [string trim [lindex $splitline 2]] 1961 set revdate($revnum) [lindex $date_and_time 0] 1962 set revtime($revnum) [lindex $date_and_time 1] 1963 set notelen [lindex [string trim [lindex $splitline 3]] 0] 1964 gen_log:log D "revnum $revnum" 1965 gen_log:log D "revwho($revnum) $revwho($revnum)" 1966 gen_log:log D "revdate($revnum) $revdate($revnum)" 1967 gen_log:log D "revtime($revnum) $revtime($revnum)" 1968 gen_log:log D "notelen $notelen" 1969 1970 incr i 2 1971 set revcomment($revnum) "" 1972 set c 0 1973 while {$c < $notelen} { 1974 append revcomment($revnum) "[lindex $lines [expr {$c + $i}]]\n" 1975 incr c 1976 } 1977 set revcomment($revnum) [string trimright $revcomment($revnum)] 1978 gen_log:log D "revcomment($revnum) $revcomment($revnum)" 1979 } 1980 incr i 1981 } 1982 gen_log:log T "LEAVE \"$revnum\"" 1983 return $revnum 1984 } 1985 1986 # Parses a summary (-q) log to find what revisions are on it 1987 proc parse_q {lines r} { 1988 variable allrevs 1989 1990 set allrevs($r) "" 1991 foreach line $lines { 1992 if [regexp {^r} $line] { 1993 gen_log:log D "$line" 1994 set splitline [split $line "|"] 1995 set revnum [string trim [lindex $splitline 0]] 1996 lappend allrevs($r) $revnum 1997 } 1998 } 1999 } 2000 2001 proc svn_sort_it_all_out {} { 2002 global cvscfg 2003 global current_tagname 2004 variable filename 2005 variable lc 2006 variable ln 2007 variable revwho 2008 variable revdate 2009 variable revtime 2010 variable revcomment 2011 variable revkind 2012 variable revpath 2013 variable revname 2014 variable revtags 2015 variable revbtags 2016 variable branchrevs 2017 variable revbranches 2018 variable revmergefrom 2019 variable logstate 2020 variable revnum 2021 variable rootbranch 2022 variable revbranch 2023 2024 gen_log:log T "ENTER" 2025 2026 # Sort the revision and branch lists and remove duplicates 2027 foreach r [lsort -dictionary [array names revkind]] { 2028 gen_log:log D "revkind($r) $revkind($r)" 2029 #if {![info exists revbranches($r)]} {set revbranches($r) {} } 2030 } 2031 foreach r [lsort -dictionary [array names revpath]] { 2032 gen_log:log D "revpath($r) $revpath($r)" 2033 #if {![info exists revbranches($r)]} {set revbranches($r) {} } 2034 } 2035 gen_log:log D "" 2036 foreach a [lsort -dictionary [array names branchrevs]] { 2037 gen_log:log D "branchrevs($a) $branchrevs($a)" 2038 } 2039 gen_log:log D "" 2040 foreach a [lsort -dictionary [array names revbranches]] { 2041 # sort the rev branches to they will be displayed in increasing order 2042 set revbranches($a) [lsort -dictionary $revbranches($a)] 2043 gen_log:log D "revbranches($a) $revbranches($a)" 2044 } 2045 gen_log:log D "" 2046 foreach a [lsort -dictionary [array names revbtags]] { 2047 gen_log:log D "revbtags($a) $revbtags($a)" 2048 } 2049 gen_log:log D "" 2050 foreach a [lsort -dictionary [array names revtags]] { 2051 gen_log:log D "revtags($a) $revtags($a)" 2052 } 2053 gen_log:log D "" 2054 foreach a [lsort -dictionary [array names revmergefrom]] { 2055 gen_log:log D "revmergefrom($a) $revmergefrom($a)" 2056 } 2057 # We only needed these to place the you-are-here box. 2058 catch {unset rootbranch revbranch} 2059 $ln\::DrawTree now 2060 gen_log:log T "LEAVE" 2061 } 2062 2063 [namespace current]::reloadLog 2064 return [namespace current] 2065 } 2066 } 2067} 2068