1# 2# Tcl Library for TkCVS 3# 4 5# 6# Contains procedures used in interaction with CVS. 7# 8 9proc cvs_notincvs {} { 10 cvsfail "This directory is not in CVS." .workdir 11} 12 13proc cvs_incvs {} { 14 cvsfail "You can\'t do that here because this directory is already in CVS." .workdir 15} 16 17# 18# Create a temporary directory 19# cd to that directory 20# run the CVS command in that directory 21# 22# returns: the current wd (ERROR) or the sandbox directory (OK) 23# 24proc cvs_sandbox_runcmd {command output_var} { 25 global cvscfg 26 global cwd 27 28 upvar $output_var view_this 29 30 # Big note: the temp directory fed to a remote servers's command line 31 # needs to be seen by the server. It can't cd to an absolute path. 32 # In addition it's fussy about where you are when you do a checkout -d. 33 # Best avoid that altogether. 34 gen_log:log T "ENTER ($command $output_var)" 35 set pid [pid] 36 37 if {! [file isdirectory $cvscfg(tmpdir)]} { 38 gen_log:log F "MKDIR $cvscfg(tmpdir)" 39 file mkdir $cvscfg(tmpdir) 40 } 41 cd $cvscfg(tmpdir) 42 gen_log:log F "CD [pwd]" 43 if {! [file isdirectory cvstmpdir.$pid]} { 44 gen_log:log F "MKDIR cvstmpdir.$pid" 45 file mkdir cvstmpdir.$pid 46 } 47 cd cvstmpdir.$pid 48 gen_log:log F "CD [pwd]" 49 50 gen_log:log C "$command" 51 set ret [catch {eval "exec $command"} view_this] 52 gen_log:log T "RETURN $cvscfg(tmpdir)/cvstmpdir.$pid" 53 return $cvscfg(tmpdir)/cvstmpdir.$pid 54} 55 56# 57# cvs_sandbox_filetags 58# assume that the sandbox contains the checked out files 59# return a list of all the tags in the files 60# 61proc cvs_sandbox_filetags {mcode filenames} { 62 global cvscfg 63 global cvs 64 65 set pid [pid] 66 set cwd [pwd] 67 gen_log:log T "ENTER ($mcode $filenames)" 68 69 cd [file join $cvscfg(tmpdir) cvstmpdir.$pid $mcode] 70 set commandline "$cvs log $filenames" 71 gen_log:log C "$commandline" 72 set ret [catch {eval "exec $commandline"} view_this] 73 if {$ret} { 74 cd $cwd 75 cvsfail $view_this .merge 76 gen_log:log T "LEAVE ERROR" 77 return $keepers 78 } 79 set view_lines [split $view_this "\n"] 80 foreach line $view_lines { 81 if {[string index $line 0] == "\t" } { 82 regsub -all {[\t ]*} $line "" tag 83 append keepers "$tag " 84 } 85 } 86 cd $cwd 87 gen_log:log T "LEAVE" 88 return $keepers 89} 90 91proc cvs_workdir_status {} { 92 global cvscfg 93 global cvs 94 global Filelist 95 96 gen_log:log T "ENTER" 97 98 set cmd(cvs_status) [exec::new "$cvs -n -q status -l"] 99 set status_lines [split [$cmd(cvs_status)\::output] "\n"] 100 if {$cvscfg(showeditcol)} { 101 set cmd(cvs_editors) [exec::new "$cvs -n -q editors -l"] 102 set editors_lines [split [$cmd(cvs_editors)\::output] "\n"] 103 } 104 if {$cvscfg(cvslock)} { 105 set cmd(cvs_lockers) [exec::new "$cvs log"] 106 set lockers_lines [split [$cmd(cvs_lockers)\::output] "\n"] 107 } 108 if {[info exists cmd(cvs_status)]} { 109 # gets cvs status in current directory only, pulling out lines that include 110 # Status: or Sticky Tag:, putting each file's info (name, status, and tag) 111 # into an array. 112 113 set datestatus_seen 0 114 $cmd(cvs_status)\::destroy 115 catch {unset cmd(cvs_status)} 116 foreach logline $status_lines { 117 if {[string match "File:*" $logline]} { 118 regsub -all {\t+} $logline "\t" logline 119 set line [split [string trim $logline] "\t"] 120 gen_log:log D "$line" 121 # Should be able to do these regsubs in one expression 122 regsub {File: } [lindex $line 0] "" filename 123 regsub {\s*$} $filename "" filename 124 regsub {Status: } [lindex $line 1] "" status 125 set Filelist($filename:status) $status 126 # Don't set editors to null because we'll use its presence 127 # or absence to see if we need to re-read the repository when 128 # we ask to map the editors column 129 } elseif {[string match "*Working revision:*" $logline]} { 130 regsub -all {\t+} $logline "\t" logline 131 set line [split [string trim $logline] "\t"] 132 gen_log:log D "$line" 133 set revision [lindex $line 1] 134 regsub {New .*} $revision "New" revision 135 set date [lindex $line 2] 136 #puts "from Working Revision: $date" 137 # The date field is not supplied to remote clients. 138 if {$date == "" } { 139 if {! ([string match "New *" $date ] || [string match "Result *" $date])} { 140 catch {set date [clock format [file mtime $filename] -format $cvscfg(dateformat)]} 141 if {! $datestatus_seen} { 142 # We only need to see this message once per directory 143 set datestatus_seen 1 144 gen_log:log E "No date supplied by remote CVS server. Using \[file mtime\]" 145 } 146 } 147 } else { 148 # CVS outputs time strings tcl can't handle, such as 149 # ones with +0100. Let's discard them rather than 150 # trying to convert them. 151 set ret [catch {clock scan $date -gmt yes} ans] 152 if {$ret == 0} { 153 set juliandate $ans 154 set date [clock format $juliandate -format $cvscfg(dateformat)] 155 #puts "Clock Scan on $ans: $date" 156 } else { 157 gen_log:log E "$ans" 158 } 159 } 160 set Filelist($filename:date) $date 161 set Filelist($filename:wrev) $revision 162 set Filelist($filename:status) $status 163 } elseif {[string match "*Sticky Tag:*" $logline]} { 164 regsub -all {\t+} $logline "\t" logline 165 set line [split [string trim $logline] "\t"] 166 gen_log:log D "$line" 167 set tagline [lindex $line 1] 168 set t0 [lindex $tagline 0] 169 set t1 [lrange $tagline 1 end] 170 set stickytag "" 171 if { $t0 == "(none)" } { 172 set stickytag " on trunk" 173 } elseif {[string match "(branch:*" $t1 ]} { 174 regsub {\(branch: (.*)\)} $t1 {\1} t1 175 set stickytag " on $t0 branch" 176 } elseif {[string match "(revision:*" $t1 ]} { 177 set stickytag " $t0" 178 } 179 set Filelist($filename:stickytag) "$revision $stickytag" 180 } elseif {[string match "*Sticky Options:*" $logline]} { 181 regsub -all {\t+} $logline "\t" logline 182 set line [split [string trim $logline] "\t"] 183 gen_log:log D "$line" 184 set option [lindex $line 1] 185 set Filelist($filename:option) $option 186 } 187 } 188 } 189 190 if {[info exists cmd(cvs_editors)]} { 191 set filename {} 192 $cmd(cvs_editors)\::destroy 193 catch {unset cmd(cvs_editors)} 194 foreach logline $editors_lines { 195 set line [split $logline "\t"] 196 gen_log:log D "$line" 197 set ell [llength $line] 198 # ? files will show up in cvs editors output under certain conditions 199 if {$ell < 5} { 200 continue 201 } 202 #if there is no filename, then this is a continuation line 203 set f [lindex $line 0] 204 if {$f == {}} { 205 append editors ",[lindex $line 1]" 206 } else { 207 if {$filename != {}} { 208 set Filelist($filename:editors) $editors 209 } 210 set filename $f 211 set editors [lindex $line 1] 212 } 213 gen_log:log D " $filename $editors" 214 } 215 if {$filename != {}} { 216 set Filelist($filename:editors) $editors 217 } 218 } 219 220 if {[info exists cmd(cvs_lockers)]} { 221 set filename {} 222 set lockers {} 223 $cmd(cvs_lockers)\::destroy 224 catch {unset cmd(cvs_lockers)} 225 foreach line $lockers_lines { 226 if {[string match "Working file: *" $line]} { 227 gen_log:log D "$line" 228 regsub "Working file: " $line "" filename 229 } 230 if {[string match "*locked by:*" $line]} { 231 gen_log:log D "$line" 232 if {$filename != {}} { 233 set p [lindex $line 4] 234 set r [lindex $line 1] 235 set p [string trimright $p {;}] 236 gen_log:log D " $filename $p\($r\)" 237 append Filelist($filename:editors) $p\($r\) 238 } 239 } 240 } 241 } 242 gen_log:log T "LEAVE" 243} 244 245proc cvs_remove {args} { 246# 247# This deletes a file from the directory and the repository, 248# asking for confirmation first. 249# 250 global cvs 251 global incvs 252 global cvscfg 253 254 gen_log:log T "ENTER ($args)" 255 if {! $incvs} { 256 cvs_notincvs 257 return 1 258 } 259 set filelist [join $args] 260 261 set success 1 262 set faillist "" 263 foreach file $filelist { 264 file delete -force -- $file 265 gen_log:log F "DELETE $file" 266 if {[file exists $file]} { 267 set success 0 268 append faillist $file 269 } 270 } 271 if {$success == 0} { 272 cvsfail "Remove $file failed" .workdir 273 return 274 } 275 276 set cmd(cvscmd) [exec::new "$cvs remove $filelist"] 277 auto_setup_dir $cmd(cvscmd) 278 279 gen_log:log T "LEAVE" 280} 281 282proc cvs_remove_dir {args} { 283# This removes files recursively. 284 global cvs 285 global incvs 286 global cvscfg 287 288 gen_log:log T "ENTER ($args)" 289 if {! $incvs} { 290 cvs_notincvs 291 return 1 292 } 293 set filelist [join $args] 294 if {$filelist == ""} { 295 cvsfail "Please select a directory!" .workdir 296 return 297 } else { 298 set mess "This will remove the contents of these directories:\n\n" 299 foreach file $filelist { 300 append mess " $file\n" 301 } 302 } 303 304 set v [viewer::new "CVS Remove directory"] 305 306 set awd [pwd] 307 foreach file $filelist { 308 if {[file isdirectory $file]} { 309 set awd [pwd] 310 cd $file 311 gen_log:log F "CD [pwd]" 312 rem_subdirs $v 313 cd $awd 314 gen_log:log F "CD [pwd]" 315 316 set commandline "$cvs remove \"$file\"" 317 $v\::do "$commandline" 1 status_colortags 318 $v\::wait 319 $v\::clean_exec 320 } 321 } 322 323 if {$cvscfg(auto_status)} { 324 setup_dir 325 } 326 gen_log:log T "LEAVE" 327} 328 329proc cvs_edit {args} { 330# 331# This sets the edit flag for a file 332# asking for confirmation first. 333# 334 global cvs 335 global incvs 336 global cvscfg 337 338 gen_log:log T "ENTER ($args)" 339 340 if {! $incvs} { 341 cvs_notincvs 342 return 1 343 } 344 345 foreach file [join $args] { 346 regsub -all {\$} $file {\$} file 347 set commandline "$cvs edit \"$file\"" 348 gen_log:log C "$commandline" 349 set ret [catch {eval "exec $commandline"} view_this] 350 if {$ret != 0} { 351 view_output::new "CVS Edit" $view_this 352 } 353 } 354 if {$cvscfg(auto_status)} { 355 setup_dir 356 } 357 gen_log:log T "LEAVE" 358} 359 360proc cvs_unedit {args} { 361# 362# This resets the edit flag for a file. 363# Needs stdin as there is sometimes a dialog if file is modified 364# (defaults to no) 365# 366 global cvs 367 global incvs 368 global cvscfg 369 370 gen_log:log T "ENTER ($args)" 371 372 if {! $incvs} { 373 cvs_notincvs 374 return 1 375 } 376 377 foreach file [join $args] { 378 # Unedit may hang asking for confirmation if file is not up-to-date 379 regsub -all {\$} $file {\$} file 380 set commandline "$cvs -n update \"$file\"" 381 gen_log:log C "$commandline" 382 catch {eval "exec $commandline"} view_this 383 # Its OK if its locally added 384 if {([llength $view_this] > 0) && ![string match "A*" $view_this] } { 385 gen_log:log D "$view_this" 386 cvsfail "File $file is not up-to-date" .workdir 387 gen_log:log T "LEAVE -- cvs unedit failed" 388 return 389 } 390 391 set commandline "$cvs unedit \"$file\"" 392 gen_log:log C "$commandline" 393 set ret [catch {eval "exec $commandline"} view_this] 394 if {$ret != 0} { 395 view_output::new "CVS Edit" $view_this 396 } 397 } 398 if {$cvscfg(auto_status)} { 399 setup_dir 400 } 401 gen_log:log T "LEAVE" 402} 403 404proc cvs_history {allflag mcode} { 405 global cvs 406 global cvscfg 407 408 set all "" 409 gen_log:log T "ENTER ($allflag $mcode)" 410 if {$allflag == "all"} { 411 set all "-a" 412 } 413 if {$mcode == ""} { 414 set commandline "$cvs -d $cvscfg(cvsroot) history $all" 415 } else { 416 set commandline "$cvs -d $cvscfg(cvsroot) history $all -n $mcode" 417 } 418 # FIXME: If $all, it would be nice to process the output 419 set v [viewer::new "CVS History"] 420 $v\::do "$commandline" 421 gen_log:log T "LEAVE" 422} 423 424proc cvs_add {binflag args} { 425# 426# This adds a file to the repository. 427# 428 global cvs 429 global cvscfg 430 global incvs 431 432 gen_log:log T "ENTER ($binflag $args)" 433 if {! $incvs} { 434 cvs_notincvs 435 return 1 436 } 437 set filelist [join $args] 438 if {$filelist == ""} { 439 set mess "This will add all new files" 440 } else { 441 set mess "This will add these files:\n\n" 442 foreach file $filelist { 443 append mess " $file\n" 444 } 445 } 446 447 if {$filelist == ""} { 448 append filelist [glob -nocomplain $cvscfg(aster) .??*] 449 } 450 set cmd(cvscmd) [exec::new "$cvs add $binflag $filelist"] 451 auto_setup_dir $cmd(cvscmd) 452 453 gen_log:log T "LEAVE" 454} 455 456proc cvs_add_dir {binflag args} { 457# This starts adding recursively at the directory level 458 global cvs 459 global cvscfg 460 global incvs 461 462 gen_log:log T "ENTER ($binflag $args)" 463 if {! $incvs} { 464 cvs_notincvs 465 return 1 466 } 467 set filelist [join $args] 468 if {$filelist == ""} { 469 cvsfail "Please select a directory!" .workdir 470 return 1 471 } else { 472 set mess "This will recursively add these directories:\n\n" 473 foreach file $filelist { 474 append mess " $file\n" 475 } 476 } 477 478 set v [viewer::new "CVS Add directory"] 479 480 set awd [pwd] 481 foreach file $filelist { 482 if {[file isdirectory $file]} { 483 set commandline "$cvs add \"$file\"" 484 $v\::do "$commandline" 485 $v\::wait 486 $v\::clean_exec 487 488 cd $file 489 gen_log:log F "CD [pwd]" 490 add_subdirs $binflag $v 491 } 492 } 493 494 cd $awd 495 gen_log:log F "[pwd]" 496 if {$cvscfg(auto_status)} { 497 setup_dir 498 } 499 gen_log:log T "LEAVE" 500} 501 502proc add_subdirs {binflag v} { 503 global cvs 504 global cvsglb 505 global cvscfg 506 507 gen_log:log T "ENTER ($binflag $v)" 508 set plainfiles {} 509 foreach child [glob -nocomplain $cvscfg(aster) .??*] { 510 if [file isdirectory $child] { 511 if {[regexp -nocase {^CVS$} [file tail $child]]} { 512 gen_log:log D "Skipping $child" 513 continue 514 } 515 set commandline "$cvs add \"$child\"" 516 $v\::do "$commandline" 517 $v\::wait 518 $v\::clean_exec 519 520 set awd [pwd] 521 cd $child 522 gen_log:log F "CD [pwd]" 523 add_subdirs $binflag $v 524 cd $awd 525 gen_log:log F "CD [pwd]" 526 } else { 527 lappend plainfiles $child 528 } 529 } 530 if {[llength $plainfiles] > 0} { 531 # LJZ: get local ignore file filter list 532 set ignore_file_filter $cvsglb(default_ignore_filter) 533 if { [ file exists ".cvsignore" ] } { 534 set fileId [ open ".cvsignore" "r" ] 535 while { [ eof $fileId ] == 0 } { 536 gets $fileId line 537 append ignore_file_filter " $line" 538 } 539 close $fileId 540 } 541 542 # LJZ: ignore files if requested in recursive add 543 if { $ignore_file_filter != "" } { 544 foreach item $ignore_file_filter { 545 # for each pattern 546 if { $item != "*" } { 547 # if not "*" 548 while { [set idx [lsearch $plainfiles $item]] != -1 } { 549 # for each occurence, delete 550 catch { set plainfiles [ lreplace $plainfiles $idx $idx ] } 551 } 552 } 553 } 554 } 555 556 # LJZ: any files left after filtering? 557 if {[llength $plainfiles] > 0} { 558 set commandline "$cvs add $binflag $plainfiles" 559 $v\::do "$commandline" 560 $v\::wait 561 } 562 } 563 564 gen_log:log T "LEAVE" 565} 566 567proc rem_subdirs { v } { 568 global cvs 569 global incvs 570 global cvscfg 571 572 gen_log:log T "ENTER ($v)" 573 set plainfiles {} 574 foreach child [glob -nocomplain $cvscfg(aster) .??*] { 575 if [file isdirectory $child] { 576 if {[regexp -nocase {^CVS$} [file tail $child]]} { 577 gen_log:log D "Skipping $child" 578 continue 579 } 580 set awd [pwd] 581 cd $child 582 gen_log:log F "CD [pwd]" 583 rem_subdirs $v 584 cd $awd 585 gen_log:log F "CD [pwd]" 586 } else { 587 lappend plainfiles $child 588 } 589 } 590 if {[llength $plainfiles] > 0} { 591 foreach file $plainfiles { 592 gen_log:log F "DELETE $file" 593 file delete -force -- $file 594 if {[file exists $file]} {cvsfail "Remove $file failed" .workdir} 595 } 596 } 597 598 gen_log:log T "LEAVE" 599} 600 601proc cvs_fileview_update {revision filename} { 602# 603# This views a specific revision of a file in the repository. 604# For files checked out in the current sandbox. 605# 606 global cvs 607 global cvscfg 608 609 gen_log:log T "ENTER ($revision $filename)" 610 if {$revision == {}} { 611 set commandline "$cvs -d $cvscfg(cvsroot) update -p \"$filename\"" 612 set v [viewer::new "$filename"] 613 $v\::do "$commandline" 0 614 } else { 615 set commandline "$cvs -d $cvscfg(cvsroot) update -p -r $revision \"$filename\"" 616 set v [viewer::new "$filename Revision $revision"] 617 $v\::do "$commandline" 0 618 } 619 gen_log:log T "LEAVE" 620} 621 622proc cvs_fileview_checkout {revision filename} { 623# 624# This looks at a revision of a file from the repository. 625# Called from Repository Browser -> File Browse -> View 626# For files not currently checked out 627# 628 global cvs 629 global cvscfg 630 631 gen_log:log T "ENTER ($revision)" 632 if {$revision == {}} { 633 set commandline "$cvs -d $cvscfg(cvsroot) checkout -p \"$filename\"" 634 set v [viewer::new "$filename"] 635 $v\::do "$commandline" 636 } else { 637 set commandline "$cvs -d $cvscfg(cvsroot) checkout -p -r $revision \"$filename\"" 638 set v [viewer::new "$filename Revision $revision"] 639 $v\::do "$commandline" 640 } 641 gen_log:log T "LEAVE" 642} 643 644proc cvs_log {args} { 645# 646# This looks at a log from the repository. 647# Called by Workdir menu Reports->"CVS log ..." 648# 649 global cvs 650 global cvscfg 651 652 gen_log:log T "ENTER ($args)" 653 654 set filelist [join $args] 655 656 # Don't recurse 657 set commandline "$cvs log -l " 658 switch -- $cvscfg(ldetail) { 659 latest { 660 # -N means don't list tags 661 append commandline "-Nr " 662 } 663 summary { 664 append commandline "-Nt " 665 } 666 } 667 append commandline "$filelist" 668 669 set logcmd [viewer::new "CVS log ($cvscfg(ldetail))"] 670 $logcmd\::do "$commandline" 0 hilight_rcslog 671 672 gen_log:log T "LEAVE" 673} 674 675# called from the branch browser 676proc cvs_log_rev {rev file} { 677 global cvs 678 679 gen_log:log T "ENTER ($rev $file)" 680 681 set title "CVS log" 682 set commandline "$cvs log -N" 683 if {$rev ne ""} { 684 append commandline " -r$rev" 685 append title " -r$rev" 686 } 687 append commandline " $file" 688 append title " $file" 689 690 set logcmd [viewer::new "$title"] 691 $logcmd\::do "$commandline" 0 hilight_rcslog 692 693 gen_log:log T "LEAVE" 694} 695 696proc cvs_annotate {revision args} { 697# 698# This looks at a log from the repository. 699# Called by Workdir menu Reports->"CVS log ..." 700# 701 global cvs 702 global cvscfg 703 704 gen_log:log T "ENTER ($revision $args)" 705 706 if {$revision == "trunk"} { 707 set revision "" 708 } 709 if {$revision != ""} { 710 # We were given a revision 711 set revflag "-r$revision" 712 } else { 713 set revflag "" 714 } 715 716 set filelist [join $args] 717 if {$filelist == ""} { 718 cvsfail "Annotate:\nPlease select one or more files !" .workdir 719 gen_log:log T "LEAVE (Unselected files)" 720 return 721 } 722 foreach file $filelist { 723 annotate::new $revflag $file "cvs" 724 } 725 gen_log:log T "LEAVE" 726} 727 728proc cvs_annotate_r {revision file} { 729# 730# This looks at a log from the repository. 731# Called by Logcanvas when not in a CVS directory 732# 733 global cvs 734 global cvscfg 735 736 gen_log:log T "ENTER ($revision $file)" 737 738 if {$revision != ""} { 739 # We were given a revision 740 set revflag "-r$revision" 741 } else { 742 set revflag "" 743 } 744 745 annotate::new $revflag $file "cvs_r" 746 gen_log:log T "LEAVE" 747} 748 749proc cvs_commit {revision comment args} { 750# 751# This commits changes to the repository. 752# 753# The parameters work differently here -- args is a list. The first 754# element of args is a list of file names. This is because I can't 755# use eval on the parameters, because comment contains spaces. 756# 757 global cvs 758 global cvscfg 759 global incvs 760 761 gen_log:log T "ENTER ($revision $comment $args)" 762 if {! $incvs} { 763 cvs_notincvs 764 return 1 765 } 766 767 set filelist [lindex $args 0] 768 769 # changed the message to be a little more explicit. -sj 770 set commit_output "" 771 if {$filelist == ""} { 772 set mess "This will commit your changes to ** ALL ** files in" 773 append mess " and under this directory." 774 } else { 775 foreach file $filelist { 776 append commit_output "\n$file" 777 } 778 set mess "This will commit your changes to:$commit_output" 779 } 780 append mess "\n\nAre you sure?" 781 set commit_output "" 782 783 if {[cvsconfirm $mess .workdir] != "ok"} { 784 return 1 785 } 786 787 set revflag "" 788 if {$revision != ""} { 789 set revflag "-r $revision" 790 } 791 792 if {$cvscfg(use_cvseditor)} { 793 # Starts text editor of your choice to enter the log message. 794 # This way a template in CVSROOT can be used. 795 update idletasks 796 set commandline \ 797 "$cvscfg(terminal) $cvs commit -R $revflag $filelist" 798 gen_log:log C "$commandline" 799 set ret [catch {eval "exec $commandline"} view_this] 800 if {$ret} { 801 cvsfail $view_this .workdir 802 gen_log:log T "LEAVE ERROR ($view_this)" 803 return 804 } 805 } else { 806 if {$comment == ""} { 807 cvsfail "You must enter a comment!" .commit 808 return 1 809 } 810 set v [viewer::new "CVS Commit"] 811 regsub -all "\"" $comment "\\\"" comment 812 # Lets not show stderr as it does a lot of "examining" 813 $v\::do "$cvs commit -R $revflag -m \"$comment\" $filelist" 0 814 $v\::wait 815 } 816 817 if {$cvscfg(auto_status)} { 818 setup_dir 819 } 820 gen_log:log T "LEAVE" 821} 822 823proc cvs_tag {tagname force b_or_t update args} { 824# 825# This tags a file in a directory. 826# 827 global cvs 828 global cvscfg 829 global cvsglb 830 global incvs 831 832 gen_log:log T "ENTER ($tagname $force $b_or_t $update $args)" 833 834 if {! $incvs} { 835 cvs_notincvs 836 return 1 837 } 838 839 if {$tagname == ""} { 840 cvsfail "Please enter a tag name!" .workdir 841 return 1 842 } 843 844 set filelist [join $args] 845 846 set command "$cvs tag" 847 if {$b_or_t == "branch"} { 848 append command " -b" 849 } 850 if {$force == "yes"} { 851 append command " -F" 852 } 853 append command " $tagname $filelist" 854 855 if {$b_or_t == "branch" && $force == "yes"} { 856 set too_new 0 857 # As of 1.11.2, -F won't move branch tags without the -B option 858 set versionsplit [split $cvsglb(cvs_version) {.}] 859 set major [lindex $versionsplit 1] 860 set minor [lindex $versionsplit 2] 861 if {$major > 11} { 862 set too_new 1 863 } elseif {($major == 11) && ($minor >= 2)} { 864 set too_new 1 865 } 866 if {$too_new} { 867 cvsfail "In CVS version >= 1.11.2, you're not allowed to move a branch tag" .workdir 868 } 869 return 870 } 871 872 # If it refuses to tag, it can exit with 0 but still put out some stderr 873 set v [viewer::new "CVS Tag"] 874 $v\::do "$command" 1 875 $v\::wait 876 877 if {$update == "yes"} { 878 # update so we're on the branch 879 set command "$cvs update -r $tagname $filelist" 880 $v\::do "$command" 0 status_colortags 881 $v\::wait 882 } 883 884 if {$cvscfg(auto_status)} { 885 setup_dir 886 } 887 gen_log:log T "LEAVE" 888} 889 890proc cvs_update {tagname k no_tag recurse prune d dir args} { 891# 892# This updates the files in the current directory. 893# 894 global cvs 895 global cvscfg 896 global incvs 897 898 gen_log:log T "ENTER (tagname=$tagname k=$k no_tag=$no_tag recurse=$recurse prune=$prune d=$d dir=$dir args=$args)" 899 900 set filelist [join $args] 901 902 # 903 # cvs update [-APCdflRp] [-k kopt] [-r rev] [-D date] [-j rev] 904 # 905 set commandline "$cvs update" 906 907 if { $k == "Normal" } { 908 set kmsg "\nUsing normal (text) mode." 909 } elseif { $k == "Binary" } { 910 set kmsg "\nUsing binary mode (-kb)." 911 append commandline " -kb" 912 } 913 914 if { $tagname == "HEAD" } { 915 append mess "\nYour local files will be updated to the" 916 append mess " latest main trunk (head) revision (-A)." 917 append commandline " -A" 918 } 919 920 if {$recurse == "local"} { 921 append commandline " -l" 922 } else { 923 append mess "\nIf there is a local sub-directory which has" 924 append mess " become empty through deletion of its contents," 925 if { $prune == "prune" } { 926 append mess " it will be deleted (-P).\n" 927 append commandline " -P" 928 } else { 929 append mess " it will remain.\n" 930 } 931 append mess "\nIf there is a sub-directory in the repository" 932 append mess " that is not here in your local directory," 933 if { $d == "Yes" } { 934 append mess " it will be checked out at this time (-d).\n" 935 if {$dir != " "} { 936 append mess "($dir only)\n" 937 } 938 append commandline " -d $dir" 939 } else { 940 append mess " it will not be checked out.\n" 941 } 942 } 943 944 if { $tagname != "BASE" && $tagname != "HEAD" } { 945 append mess "\nYour local files will be updated to the" 946 append mess " tagged revision (-r $tagname)." 947 append mess " If a file does not have the tag," 948 if { $no_tag == "Remove" } { 949 append mess " it will be removed from your local directory.\n" 950 append commandline " -r $tagname" 951 } elseif { $no_tag == "Get_head" } { 952 append mess " the head revision will be retrieved.\n" 953 append commandline " -f -r $tagname" 954 } 955 } 956 957 if {$filelist == ""} { 958 set filemsg "\nYou are about to download from" 959 append filemsg " the repository to your local" 960 append filemsg " filespace the files which" 961 append filemsg " are different in the repository," 962 if {$recurse == "local"} { 963 append filemsg " in this directory only.\n" 964 } else { 965 append filemsg " recursing the sub-directories.\n" 966 } 967 } else { 968 append filemsg "\nYou are about to download from" 969 append filemsg " the repository to your local" 970 append filemsg " filespace these files if they" 971 append filemsg " have changed:\n" 972 973 foreach file $filelist { 974 append filemsg "\n\t$file" 975 append commandline " \"$file\"" 976 } 977 } 978 append filemsg "\nIf you have made local changes, they will" 979 append filemsg " be merged into the new local copy.\n" 980 set mess "$filemsg $mess $kmsg" 981 append mess "\n\nAre you sure?" 982 983 if {[cvsconfirm $mess .workdir] == "ok"} { 984 985 set co_cmd [viewer::new "CVS Update"] 986 $co_cmd\::do $commandline 0 status_colortags 987 auto_setup_dir $co_cmd 988 } 989 gen_log:log T "LEAVE" 990} 991 992proc cvs_merge {parent from since frombranch args} { 993# 994# This does a join (merge) of a chosen revision of localfile to the 995# current revision. 996# 997 global cvs 998 global cvscfg 999 global cvsglb 1000 1001 gen_log:log T "ENTER (\"$from\" \"$since\" \"$frombranch\" \"$args\")" 1002 gen_log:log D "mergetrunkname $cvscfg(mergetrunkname)" 1003 1004 # Bug # 3434817 1005 # there's an annoying bug in merging: the ending revision is ignored. 1006 # Example: there are revisions 1.1, 1.2, 1.3, 1.4 and 1.5 (HEAD). You are on 1007 # a branch made from rev 1.1 and want to merge revisions 1.2 to 1.4. When you 1008 # click in the merge diagram left mouse on 1.4, right mouse on 1.2 and click 1009 # Diff it will correctly use the following command: 1010 # /usr/bin/tkdiff -r "1.4" -r "1.2" "Filename.ext" 1011 # However, when you leave the revision selection as-is and click the Merge 1012 # the following command is used: 1013 # cvs update -d -j1.2 -jHEAD Filename.ext 1014 # Obviously the second "-j" parameter is wrong, there should have been "-j1.4". 1015 1016 #set realfrom "$frombranch" 1017 #if {$frombranch eq $cvscfg(mergetrunkname)} { 1018 #set realfrom "HEAD" 1019 #} 1020 1021 set filelist [join $args] 1022 1023 set mergetags [assemble_mergetags $frombranch] 1024 set curr_tag [lindex $mergetags 0] 1025 set fromtag [lindex $mergetags 1] 1026 set totag [lindex $mergetags 2] 1027 1028 if {$since == {}} { 1029 set mess "Merge revision $from\n" 1030 } else { 1031 set mess "Merge the changes between revision\n $since and $from" 1032 append mess " (if $since > $from the changes are removed)\n" 1033 } 1034 append mess " to the current revision ($curr_tag)" 1035 if {[cvsalwaysconfirm $mess $parent] != "ok"} { 1036 return 1037 } 1038 1039 # Do the update here, and defer the tagging until later 1040 if {$since == {}} { 1041 set commandline "$cvs update -d -j$from $filelist" 1042 } else { 1043 set commandline "$cvs update -d -j$since -j$from $filelist" 1044 } 1045 set v [viewer::new "CVS Join"] 1046 $v\::do "$commandline" 1 status_colortags 1047 $v\::wait 1048 1049 if [winfo exists .workdir] { 1050 if {$cvscfg(auto_status)} { 1051 setup_dir 1052 } 1053 } else { 1054 workdir_setup 1055 } 1056 1057 dialog_merge_notice cvs $from $frombranch $fromtag $totag $filelist 1058 1059 gen_log:log T "LEAVE" 1060} 1061 1062proc cvs_merge_tag_seq {from frombranch totag fromtag args} { 1063 global cvs 1064 global cvscfg 1065 1066 gen_log:log T "ENTER (\"$from\" \"$totag\" \"$fromtag\" $args)" 1067 1068 set filelist "" 1069 foreach f $args { 1070 append filelist "\"$f\" " 1071 } 1072 set realfrom "$frombranch" 1073 if {$frombranch eq $cvscfg(mergetrunkname)} { 1074 set realfrom "HEAD" 1075 } 1076 1077 # It's muy importante to make sure everything is OK at this point 1078 set commandline "$cvs -n -q update $filelist" 1079 gen_log:log C "$commandline" 1080 set ret [catch {eval "exec $commandline"} view_this] 1081 set logmode [expr {$ret ? {E} : {D}}] 1082 view_output::new "CVS Check" $view_this 1083 gen_log:log $logmode $view_this 1084 if {$ret} { 1085 set mess "CVS Check shows errors which would prevent a successful\ 1086 commit. Please resolve them before continuing." 1087 if {[cvsalwaysconfirm $mess .workdir] != "ok"} { 1088 return 1089 } 1090 } 1091 # Do the commit 1092 set v [viewer::new "CVS Commit and Tag a Merge"] 1093 $v\::log "$cvs commit -m \"Merge from $from\" $filelist\n" 1094 $v\::do "$cvs commit -m \"Merge from $from\" $filelist" 1 1095 $v\::wait 1096 # Tag if desired 1097 if {$cvscfg(auto_tag) && $totag != ""} { 1098 # First, the "from" file that's not in this branch (needs -r) 1099 set commandline "$cvs tag -F -r$realfrom $totag $filelist" 1100 $v\::log "$commandline\n" 1101 $v\::do "$commandline" 1 1102 $v\::wait 1103 } 1104 if {$cvscfg(auto_tag) && $fromtag != ""} { 1105 # Now, the version that's in the current branch 1106 set commandline "$cvs tag -F $fromtag $filelist" 1107 $v\::log "$commandline\n" 1108 $v\::do "$commandline" 1 1109 $v\::wait 1110 } 1111 catch {destroy .reminder} 1112 1113 if {$cvscfg(auto_status)} { 1114 setup_dir 1115 } 1116} 1117 1118proc cvs_status {args} { 1119# 1120# This does a status report on the files in the current directory. 1121# 1122 global cvs 1123 global cvscfg 1124 1125 gen_log:log T "ENTER ($args)" 1126 1127 if {$args == "."} { 1128 set args "" 1129 } 1130 # if there are selected files, I want verbose output for those files 1131 # so I'm going to save the current setting here 1132 # - added by Jo 1133 set verbosity_setting "" 1134 1135 busy_start .workdir.main 1136 set filelist [join $args] 1137 # if recurse option is true or there are no selected files, recurse 1138 set flags "" 1139 if {! $cvscfg(recurse)} { 1140 set flags "-l" 1141 } 1142 # if there are selected files, use verbose output 1143 # but save the current setting so it can be reset 1144 # - added by Jo 1145 if {[llength $filelist] > 0 || \ 1146 ([llength $filelist] == 1 && ! [file isdir $filelist])} { 1147 set verbosity_setting $cvscfg(rdetail) 1148 set cvscfg(rdetail) "verbose" 1149 } 1150 1151 # support verious levels of verboseness. Ideas derived from GIC 1152 set statcmd [exec::new "$cvs -Q status $flags $filelist"] 1153 set raw_status [$statcmd\::output] 1154 $statcmd\::destroy 1155 1156 if {$cvscfg(rdetail) == "verbose"} { 1157 view_output::new "CVS Status ($cvscfg(rdetail))" $raw_status 1158 } else { 1159 set cooked_status "" 1160 set stat_lines [split $raw_status "\n"] 1161 foreach statline $stat_lines { 1162 if {[string match "*Status:*" $statline]} { 1163 gen_log:log D "$statline" 1164 if {$cvscfg(rdetail) == "terse" &&\ 1165 [string match "*Up-to-date*" $statline]} { 1166 continue 1167 } else { 1168 regsub {^File: } $statline {} statline 1169 regsub {Status:} $statline " " line 1170 append cooked_status $line 1171 append cooked_status "\n" 1172 } 1173 } 1174 } 1175 view_output::new "CVS Status ($cvscfg(rdetail))" $cooked_status 1176 } 1177 1178 # reset the verbosity setting if necessary 1179 if { $verbosity_setting != "" } { 1180 set cvscfg(rdetail) $verbosity_setting 1181 } 1182 busy_done .workdir.main 1183 gen_log:log T "LEAVE" 1184} 1185 1186proc cvs_check {directory} { 1187# 1188# This does a cvscheck on the files in the current directory. 1189# 1190 global cvs 1191 global cvscfg 1192 1193 gen_log:log T "ENTER ($directory)" 1194 1195 busy_start .workdir.main 1196 1197 # The current directory doesn't have to be in CVS for cvs update to work. 1198 1199 # Sometimes, cvs update doesn't work with ".", only with "" or an argument 1200 if {$directory == "."} { 1201 set directory "" 1202 } 1203 1204 if $cvscfg(recurse) { 1205 set checkrecursive "" 1206 } else { 1207 set checkrecursive "-l" 1208 } 1209 set commandline "$cvs -n -q update $checkrecursive $directory" 1210 set check_cmd [viewer::new "CVS Directory Status Check"] 1211 $check_cmd\::do $commandline 1 status_colortags 1212 1213 busy_done .workdir.main 1214 gen_log:log T "LEAVE" 1215} 1216 1217proc cvs_checkout { dir cvsroot prune kflag revtag date target mtag1 mtag2 module } { 1218 # 1219 # This checks out a new module into the current directory. 1220 # 1221 global cvs 1222 global cvscfg 1223 1224 gen_log:log T "ENTER ($dir $cvsroot $prune $kflag $revtag $date $target $mtag1 $mtag2 $module)" 1225 1226 foreach {incvs insvn inrcs} [cvsroot_check $dir] { break } 1227 if {$incvs} { 1228 set mess "This is already a CVS controlled directory. Are you\ 1229 sure that you want to check out another module in\ 1230 to this directory?" 1231 if {[cvsconfirm $mess .modbrowse] != "ok"} { 1232 return 1233 } 1234 } 1235 1236 set mess "This will check out $module from CVS.\nAre you sure?" 1237 if {[cvsconfirm $mess .modbrowse] == "ok"} { 1238 if {$revtag != {}} { 1239 set revtag "-r \"$revtag\"" 1240 } 1241 if {$date != {}} { 1242 set date "-D \"$date\"" 1243 } 1244 if {$target != {}} { 1245 set target "-d \"$target\"" 1246 } 1247 if {$mtag1 != {}} { 1248 set mtag1 "-j \"$mtag1\"" 1249 } 1250 if {$mtag2 != {}} { 1251 set mtag2 "-j \"$mtag2\"" 1252 } 1253 set v [::viewer::new "CVS Checkout"] 1254 set cwd [pwd] 1255 cd $dir 1256 $v\::do "$cvs -d \"$cvsroot\" checkout $prune\ 1257 $revtag $date $target\ 1258 $mtag1 $mtag2\ 1259 $kflag \"$module\"" 1260 cd $cwd 1261 } 1262 gen_log:log T "LEAVE" 1263 return 1264} 1265 1266proc cvs_filelog {filename parent {graphic {0}} } { 1267# 1268# This looks at the revision log of a file. It's called from filebrowse.tcl, 1269# so we can't do operations such as merges. 1270# 1271 global cvs 1272 global cvscfg 1273 global cwd 1274 1275 gen_log:log T "ENTER ($filename $parent $graphic)" 1276 set pid [pid] 1277 set filetail [file tail $filename] 1278 1279 set commandline "$cvs -d $cvscfg(cvsroot) checkout \"$filename\"" 1280 gen_log:log C "$commandline" 1281 set ret [cvs_sandbox_runcmd "$commandline" cmd_output] 1282 if {$ret == $cwd} { 1283 cvsfail $cmd_output $parent 1284 cd $cwd 1285 gen_log:log T "LEAVE -- cvs checkout failed" 1286 return 1287 } 1288 1289 if {$graphic} { 1290 # Log canvas viewer 1291 ::cvs_branchlog::new "CVS,rep" $filename 1292 } else { 1293 set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\"" 1294 set logcmd [viewer::new "CVS log $filename"] 1295 $logcmd\::do "$commandline" 0 hilight_rcslog 1296 $logcmd\::wait 1297 } 1298 cd $cwd 1299 gen_log:log T "LEAVE" 1300} 1301 1302proc cvs_export { dir cvsroot kflag revtag date target module } { 1303# 1304# This exports a new module (see man cvs and read about export) into 1305# the current directory. 1306# 1307 global cvs 1308 global cvscfg 1309 1310 gen_log:log T "ENTER ($dir $cvsroot $kflag $revtag $date $target $module)" 1311 1312 foreach {incvs insvn inrcs} [cvsroot_check $dir] { break } 1313 if {$incvs} { 1314 set mess "This is already a CVS controlled directory. Are you\ 1315 sure that you want to export a module in to this directory?" 1316 if {[cvsconfirm $mess .modbrowse] != "ok"} { 1317 return 1318 } 1319 } 1320 1321 set mess "This will export $module from CVS.\nAre you sure?" 1322 if {[cvsconfirm $mess .modbrowse] == "ok"} { 1323 if {$revtag != {}} { 1324 set revtag "-r \"$revtag\"" 1325 } 1326 if {$date != {}} { 1327 set date "-D \"$date\"" 1328 } 1329 if {$target != {}} { 1330 set target "-d \"$target\"" 1331 } 1332 1333 set v [::viewer::new "CVS Export"] 1334 set cwd [pwd] 1335 cd $dir 1336 $v\::do "$cvs -d \"$cvsroot\" export\ 1337 $revtag $date $target $kflag \"$module\"" 1338 cd $cwd 1339 } 1340 gen_log:log T "LEAVE" 1341 return 1342} 1343 1344proc cvs_patch { cvsroot module difffmt revtagA dateA revtagB dateB outmode outfile } { 1345# 1346# This creates a patch file between two revisions of a module. If the 1347# second revision is null, it creates a patch to the head revision. 1348# If both are null the top two revisions of the file are diffed. 1349# 1350 global cvs 1351 global cvscfg 1352 1353 gen_log:log T "ENTER ($cvsroot $module $difffmt $revtagA $dateA $revtagB $dateB $outmode $outfile)" 1354 1355 foreach {rev1 rev2} {{} {}} { break } 1356 if {$revtagA != {}} { 1357 set rev1 "-r \"$revtagA\"" 1358 } elseif {$dateA != {}} { 1359 set rev1 "-D \"$dateA\"" 1360 } 1361 if {$revtagB != {}} { 1362 set rev2 "-r \"$revtagB\"" 1363 } elseif {$dateA != {}} { 1364 set rev2 "-D \"$dateB\"" 1365 } 1366 if {$rev1 == {} && $rev2 == {}} { 1367 set rev1 "-t" 1368 } 1369 1370 set commandline "$cvs -d \"$cvsroot\" patch $difffmt $rev1 $rev2 \"$module\"" 1371 1372 if {$outmode == 0} { 1373 set v [viewer::new "CVS Patch"] 1374 $v\::do "$commandline" 0 patch_colortags 1375 } else { 1376 set e [exec::new "$commandline"] 1377 set patch [$e\::output] 1378 gen_log:log F "OPEN $outfile" 1379 if {[catch {set fo [open $outfile w]}]} { 1380 cvsfail "Cannot open $outfile for writing" .modbrowse 1381 return 1382 } 1383 puts $fo $patch 1384 close $fo 1385 gen_log:log F "CLOSE $outfile" 1386 } 1387 gen_log:log T "LEAVE" 1388 return 1389} 1390 1391proc cvs_version {} { 1392# 1393# This finds the current CVS version number. 1394# 1395 global cvs 1396 global cvscfg 1397 global cvsglb 1398 1399 gen_log:log T "ENTER" 1400 set cvsglb(cvs_version) "" 1401 1402 set commandline "$cvs -v" 1403 gen_log:log C "$commandline" 1404 set ret [catch {eval "exec $commandline"} output] 1405 if {$ret} { 1406 cvsfail $output 1407 return 1408 } 1409 foreach infoline [split $output "\n"] { 1410 if {[string match "Concurrent*" $infoline]} { 1411 set lr [split $infoline] 1412 set species [lindex $lr 3] 1413 regsub -all {[()]} $species {} species 1414 set version [lindex $lr 4] 1415 gen_log:log D "species $species version $version" 1416 } 1417 } 1418 gen_log:log D "Split: $species $version" 1419 regsub -all {\s*} $version {} version 1420 gen_log:log D "De-whitespaced: $species $version" 1421 set cvsglb(cvs_type) $species 1422 set cvsglb(cvs_version) $version 1423 1424 gen_log:log T "LEAVE" 1425} 1426 1427proc cvs_merge_conflict {args} { 1428 global cvscfg 1429 global cvs 1430 1431 gen_log:log T "ENTER ($args)" 1432 1433 set filelist [join $args] 1434 if {$filelist == ""} { 1435 cvsfail "Please select some files to merge first!" 1436 return 1437 } 1438 1439 foreach file $filelist { 1440 # Make sure its really a conflict - tkdiff will bomb otherwise 1441 regsub -all {\$} $file {\$} filename 1442 set commandline "$cvs -n -q update \"$filename\"" 1443 gen_log:log C "$commandline" 1444 set ret [catch {eval "exec $commandline"} status] 1445 set logmode [expr {$ret ? {E} : {D}}] 1446 gen_log:log $logmode "$status" 1447 1448 gen_log:log F "OPEN $file" 1449 set f [open $file] 1450 set match 0 1451 while { [eof $f] == 0 } { 1452 gets $f line 1453 if { [string match "<<<<<<< *" $line] } { 1454 set match 1 1455 break 1456 } 1457 } 1458 gen_log:log F "CLOSE $file" 1459 close $f 1460 1461 if { [string match "C *" $status] } { 1462 # If its marked "Needs Merge", we have to update before 1463 # we can resolve the conflict 1464 gen_log:log C "$commandline" 1465 set commandline "$cvs update \"$file\"" 1466 set ret [catch {eval "exec $commandline"} status] 1467 set logmode [expr {$ret ? {E} : {D}}] 1468 gen_log:log $logmode "$status" 1469 } elseif { $match == 1 } { 1470 # There are conflict markers already, dont update 1471 ; 1472 } else { 1473 cvsfail "$file does not appear to have a conflict." .workdir 1474 continue 1475 } 1476 # Invoke tkdiff with the proper option for a conflict file 1477 # and have it write to the original file 1478 set commandline "$cvscfg(tkdiff) -conflict -o \"$filename\" \"$filename\"" 1479 gen_log:log C "$commandline" 1480 catch {eval "exec $commandline"} view_this 1481 } 1482 1483 if {$cvscfg(auto_status)} { 1484 setup_dir 1485 } 1486 gen_log:log T "LEAVE" 1487} 1488 1489proc cvs_gettaglist {filename parent} { 1490 global cvs 1491 global cvscfg 1492 global cwd 1493 1494 set keepers "" 1495 set pid [pid] 1496 gen_log:log T "ENTER ($filename)" 1497 set filetail [file tail $filename] 1498 1499 set commandline "$cvs -d $cvscfg(cvsroot) checkout \"$filename\"" 1500 # run a command, possibly creating the sandbox to play in 1501 set ret [cvs_sandbox_runcmd $commandline cmd_output] 1502 if {$cwd == $ret} { 1503 cvsfail $cmd_output $parent 1504 cd $cwd 1505 gen_log:log T "LEAVE ERROR ($cmd_output)" 1506 return $keepers 1507 } 1508 1509 set commandline "$cvs -d $cvscfg(cvsroot) log \"$filename\"" 1510 gen_log:log C "$commandline" 1511 set ret [catch {eval "exec $commandline"} view_this] 1512 if {$ret} { 1513 cvsfail $view_this $parent 1514 cd $cwd 1515 gen_log:log T "LEAVE ERROR" 1516 return $keepers 1517 } 1518 set view_lines [split $view_this "\n"] 1519 set c 0 1520 set l [llength $view_lines] 1521 foreach line $view_lines { 1522 if {[string match "symbolic names:" $line]} { 1523 gen_log:log D "line $c $line" 1524 for {set b [expr {$c + 1}]} {$b <= $l} {incr b} { 1525 set nextline [lindex $view_lines $b] 1526 if {[string index $nextline 0] == "\t" } { 1527 set nextline [string trimleft $nextline] 1528 gen_log:log D "$nextline" 1529 append keepers "$nextline\n" 1530 } else { 1531 gen_log:log D "$nextline - quitting" 1532 break 1533 } 1534 } 1535 } 1536 incr c 1537 } 1538 if {$keepers == ""} { 1539 set keepers "No Tags" 1540 } 1541 1542 cd $cwd 1543 gen_log:log T "LEAVE" 1544 return "$keepers" 1545} 1546 1547proc cvs_release {delflag args} { 1548 global cvs 1549 global cvscfg 1550 1551 gen_log:log T "ENTER ($args)" 1552 set filelist [join $args] 1553 1554 foreach directory $filelist { 1555 if {! [file isdirectory $directory]} { 1556 cvsfail "$directory is not a directory" .workdir 1557 return 1558 } 1559 1560 set commandline "$cvs -n -q update \"$directory\"" 1561 gen_log:log C "$commandline" 1562 set ret [catch {eval "exec $commandline"} view_this] 1563 if {$view_this != ""} { 1564 view_output::new "CVS Check" $view_this 1565 set mess "\"$directory\" is not up-to-date." 1566 append mess "\nRelease anyway?" 1567 if {[cvsconfirm $mess .workdir] != "ok"} { 1568 return 1569 } 1570 } 1571 set commandline "$cvs -Q release $delflag \"$directory\"" 1572 set ret [catch {eval "exec $commandline"} view_this] 1573 gen_log:log C "$commandline" 1574 if {$ret != 0} { 1575 view_output::new "CVS Release" $view_this 1576 } 1577 } 1578 1579 if {$cvscfg(auto_status)} { 1580 setup_dir 1581 } 1582 gen_log:log T "LEAVE" 1583} 1584 1585proc cvs_rtag { cvsroot mcode b_or_t force oldtag newtag } { 1586# 1587# This tags a module in the repository. 1588# Called by the tag commands in the Repository Browser 1589# 1590 global cvs 1591 global cvscfg 1592 1593 gen_log:log T "ENTER ($cvsroot $mcode $b_or_t $force $oldtag $newtag)" 1594 1595 set command "$cvs -d \"$cvsroot\" rtag" 1596 if {$force == "remove"} { 1597 if {$oldtag == ""} { 1598 cvsfail "Please enter an Old tag name!" .modbrowse 1599 return 1 1600 } 1601 append command " -d \"$oldtag\" \"$mcode\"" 1602 } else { 1603 if {$newtag == ""} { 1604 cvsfail "Please enter a New tag name!" .modbrowse 1605 return 1 1606 } 1607 if {$b_or_t == "branch"} { 1608 append command " -b" 1609 } 1610 if {$force == "yes"} { 1611 append command " -F" 1612 } 1613 if {$oldtag != ""} { 1614 append command " -r \"$oldtag\"" 1615 } 1616 append command " \"$newtag\" \"$mcode\"" 1617 } 1618 1619 set v [::viewer::new "CVS Rtag"] 1620 $v\::do "$command" 1621 1622 gen_log:log T "LEAVE" 1623} 1624 1625# dialog for cvs commit - called from workdir browser 1626proc cvs_commit_dialog {} { 1627 global incvs 1628 global cvsglb 1629 global cvscfg 1630 1631 gen_log:log T "ENTER" 1632 1633 if {! $incvs} { 1634 cvs_notincvs 1635 gen_log:log T "LEAVE" 1636 return 1637 } 1638 1639 # If marked files, commit these. If no marked files, then 1640 # commit any files selected via listbox selection mechanism. 1641 # The cvsglb(commit_list) list remembers the list of files 1642 # to be committed. 1643 set cvsglb(commit_list) [workdir_list_files] 1644 1645 # If we want to use an external editor, just do it 1646 if {$cvscfg(use_cvseditor)} { 1647 cvs_commit "" "" $cvsglb(commit_list) 1648 return 1649 } 1650 1651 if {[winfo exists .commit]} { 1652 destroy .commit 1653 } 1654 1655 toplevel .commit 1656 #grab set .commit 1657 1658 frame .commit.top -border 8 1659 frame .commit.vers 1660 frame .commit.down -relief groove -border 2 1661 1662 pack .commit.top -side top -fill x 1663 pack .commit.down -side bottom -fill x 1664 pack .commit.vers -side top -fill y 1665 1666 label .commit.lvers -text "Specify Revision (-r) (usually ignore)" \ 1667 -anchor w 1668 entry .commit.tvers -relief sunken -textvariable version 1669 1670 pack .commit.lvers .commit.tvers -in .commit.vers \ 1671 -side left -fill x -pady 3 1672 1673 frame .commit.comment 1674 pack .commit.comment -side top -fill both -expand 1 1675 label .commit.comment.lcomment -text "Your log message" -anchor w 1676 button .commit.comment.history -text "Log History" \ 1677 -command history_browser 1678 text .commit.comment.tcomment -relief sunken -width 70 -height 10 \ 1679 -bg $cvsglb(textbg) -exportselection 1 \ 1680 -wrap word -border 2 -setgrid yes 1681 1682 1683 # Explain what it means to "commit" files 1684 message .commit.message -justify left -aspect 500 -relief groove -bd 2 \ 1685 -text "This will commit changes from your \ 1686 local, working directory into the repository, recursively. 1687 1688\ 1689 For any local (sub)directories or files that are on a branch, \ 1690 your changes will be added to the end of that branch. \ 1691 This includes new or deleted files as well as modifications. 1692 1693\ 1694 For any local (sub)directories or files that have \ 1695 a non-branch tag, a branch will be created, and \ 1696 your changes will be placed on that branch. (CVS bug.) \ 1697 1698\ 1699 For all other (sub)directories, your changes will be \ 1700 added to the end of the main trunk." 1701 1702 pack .commit.message -in .commit.top -padx 2 -pady 5 1703 1704 button .commit.ok -text "OK" \ 1705 -command { 1706 #grab release .commit 1707 wm withdraw .commit 1708 set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] 1709 cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list) 1710 commit_history $cvsglb(commit_comment) 1711 } 1712 button .commit.apply -text "Apply" \ 1713 -command { 1714 set cvsglb(commit_comment) [string trimright [.commit.comment.tcomment get 1.0 end]] 1715 cvs_commit $version $cvsglb(commit_comment) $cvsglb(commit_list) 1716 commit_history $cvsglb(commit_comment) 1717 } 1718 button .commit.clear -text "ClearAll" \ 1719 -command { 1720 set version ""e 1721 .commit.comment.tcomment delete 1.0 end 1722 } 1723 button .commit.quit \ 1724 -command { 1725 #grab release .commit 1726 wm withdraw .commit 1727 } 1728 1729 .commit.ok configure -text "OK" 1730 .commit.quit configure -text "Close" 1731 1732 grid columnconf .commit.comment 1 -weight 1 1733 grid rowconf .commit.comment 1 -weight 1 1734 grid .commit.comment.lcomment -column 0 -row 0 1735 grid .commit.comment.tcomment -column 1 -row 0 -rowspan 2 -padx 4 -pady 4 -sticky nsew 1736 grid .commit.comment.history -column 0 -row 1 1737 1738 pack .commit.ok .commit.apply .commit.clear .commit.quit -in .commit.down \ 1739 -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1 1740 1741 # Fill in the most recent commit message 1742 .commit.comment.tcomment insert end [string trimright $cvsglb(commit_comment)] 1743 1744 wm title .commit "Commit Changes" 1745 wm minsize .commit 1 1 1746 1747 gen_log:log T "LEAVE" 1748} 1749 1750proc cvs_ascii { args } { 1751# This converts a binary file to ASCII 1752 global cvs 1753 global cvscfg 1754 global incvs 1755 global cvsglb 1756 1757 gen_log:log T "ENTER ($args)" 1758 if {! $incvs} { 1759 cvs_notincvs 1760 return 1 1761 } 1762 set filelist [join $args] 1763 1764 gen_log:log D "Changing sticky flag" 1765 gen_log:log D "$cvs admin -kkv $filelist" 1766 set cmd(cvscmd) [exec::new "$cvs admin -kkv $filelist"] 1767 auto_setup_dir $cmd(cvscmd) 1768 1769 gen_log:log T "LEAVE" 1770} 1771 1772proc cvs_binary { args } { 1773# This converts an ASCII file to binary 1774 global cvs 1775 global cvscfg 1776 global incvs 1777 global cvsglb 1778 1779 gen_log:log T "ENTER ($args)" 1780 if {! $incvs} { 1781 cvs_notincvs 1782 return 1 1783 } 1784 set filelist [join $args] 1785 1786 gen_log:log D "Changing sticky flag" 1787 gen_log:log D "$cvs admin -kb $filelist" 1788 set cmd(cvscmd) [exec::new "$cvs admin -kb $filelist"] 1789 auto_setup_dir $cmd(cvscmd) 1790 1791 gen_log:log T "LEAVE" 1792} 1793 1794# Revert a file to checked-in version by removing the local 1795# copy and updating it 1796proc cvs_revert {args} { 1797 global incvs 1798 global cvscfg 1799 global cvsglb 1800 global cvs 1801 1802 gen_log:log T "ENTER ($args)" 1803 set filelist [join $args] 1804 1805 if {$filelist == ""} { 1806 set mess "This will revert (discard) your changes to ** ALL ** files in this directory" 1807 } else { 1808 foreach file $filelist { 1809 append revert_output "\n$file" 1810 } 1811 set mess "This will revert (discard) your changes to:$revert_output" 1812 } 1813 append mess "\n\nAre you sure?" 1814 1815 if {[cvsconfirm $mess .workdir] != "ok"} { 1816 return 1 1817 } 1818 1819 gen_log:log D "Reverting $filelist" 1820 # update -C option appeared in 1.11 1821 set versionsplit [split $cvsglb(cvs_version) {.}] 1822 set major [lindex $versionsplit 1] 1823 if {$major < 11} { 1824 gen_log:log F "DELETE $filelist" 1825 file delete $filelist 1826 set cmd(cvscmd) [exec::new "$cvs update $filelist"] 1827 } else { 1828 set cmd(cvscmd) [exec::new "$cvs update -C $filelist"] 1829 } 1830 1831 auto_setup_dir $cmd(cvscmd) 1832 1833 gen_log:log T "LEAVE" 1834} 1835 1836proc read_cvs_dir {dirname} { 1837# 1838# Reads a CVS "bookkeeping" directory 1839# 1840 global module_dir 1841 global cvscfg 1842 global cvsglb 1843 global cvs 1844 global current_tagname 1845 1846 gen_log:log T "ENTER ($dirname)" 1847 if {$cvsglb(cvs_version) == ""} { 1848 cvs_version 1849 } 1850 set current_tagname "trunk" 1851 if {[file isdirectory $dirname]} { 1852 if {[file isfile [file join $dirname Repository]]} { 1853 gen_log:log F "OPEN CVS/Repository" 1854 set f [open [file join $dirname Repository] r] 1855 gets $f module_dir 1856 close $f 1857 gen_log:log D " MODULE $module_dir" 1858 if {[file isfile [file join $dirname Root]]} { 1859 gen_log:log F "OPEN CVS/Root" 1860 set f [open [file join $dirname Root] r] 1861 gets $f cvscfg(cvsroot) 1862 close $f 1863 # On a PC, the cvsroot can be like C:\DosRepository. 1864 # This makes that workable. 1865 regsub -all {\\} $cvscfg(cvsroot) {\\\\} cvscfg(cvsroot) 1866 gen_log:log D " cvsroot: $cvscfg(cvsroot)" 1867 } 1868 if {[file isfile [file join $dirname Tag]]} { 1869 gen_log:log F "OPEN CVS/Tag" 1870 set f [open [file join $dirname Tag] r] 1871 gets $f current_tagname 1872 close $f 1873 # T = branch tag, N = non-branch, D = sticky date 1874 set current_tagname [string range $current_tagname 1 end] 1875 gen_log:log D " BRANCH TAG $current_tagname" 1876 } 1877 } else { 1878 cvsfail "Repository file not found in $dirname" .workdir 1879 return 0 1880 } 1881 } else { 1882 cvsfail "$dirname is not a directory" .workdir 1883 return 0 1884 } 1885 set cvsglb(root) $cvscfg(cvsroot) 1886 1887 gen_log:log T "LEAVE (1)" 1888 return 1 1889} 1890 1891proc parse_cvsmodules {modules_file} { 1892 global cvs 1893 global modval 1894 global modtitle 1895 global cvsglb 1896 global cvscfg 1897 1898 gen_log:log T "ENTER" 1899 1900 # Clear the arrays 1901 catch {unset modval} 1902 catch {unset modtitle} 1903 1904 # Unescape newlines, compress repeated whitespace, and remove blank lines 1905 regsub -all {(\\\n|[ \t])+} $modules_file " " modules_file 1906 regsub -all {\n\s*\n+} $modules_file "\n" modules_file 1907 1908 foreach line [split $modules_file "\n"] { 1909 if {[string index $line 0] == {#}} { 1910# gen_log:log D "Comment: $line" 1911 if {[string index $line 1] == {D} || [string index $line 1] == {M}} { 1912 set text [split $line] 1913 set dname [lindex $text 1] 1914 set modtitle($dname) [lrange $text 2 end] 1915# gen_log:log D "Directory: {$dname} {$modtitle($dname)}" 1916 } 1917 } else { 1918# gen_log:log D "Data: $line" 1919 set text [split $line] 1920 set modname [lindex $text 0] 1921 set modstring [string trim [join [lrange $text 1 end]]] 1922 # A "#D ..." or "#M ..." entry _always_ overrides this default 1923 if {! [info exists modtitle($modname)]} { 1924 set modtitle($modname) $modstring 1925 } 1926 # Remove flags except for -a. Luckily alias modules can't have 1927 # any other options. 1928# gen_log:log D "{$modname} {$modstring}" 1929 regsub -- {^((-l\s*)|(-[ioestud]\s+((\\\s)|\S)+\s*))+} \ 1930 $modstring {} modstring 1931 if {$modname != ""} { 1932 set modval($modname) $modstring 1933 gen_log:log D "{$modname} {$modstring}" 1934 } 1935 } 1936 } 1937 1938 gen_log:log T "LEAVE" 1939} 1940 1941proc cvs_lock {do files} { 1942 global cvscfg 1943 global cvscfg 1944 1945 if {$files == {}} { 1946 cvsfail "Please select one or more files!" .workdir 1947 return 1948 } 1949 switch -- $do { 1950 lock { set commandline "$cvs admin -l $files"} 1951 unlock { set commandline "$cvs admin -u $files"} 1952 } 1953 set lock_cmd [::exec::new "$commandline"] 1954 auto_setup_dir $lock_cmd 1955} 1956 1957# Sends directory "." to the directory-merge tool 1958# Find the bushiest file in the directory and diagram it 1959proc cvs_directory_merge {} { 1960 global cvscfg 1961 global cvsglb 1962 global cvs 1963 global incvs 1964 1965 gen_log:log T "ENTER" 1966 if {! $incvs} { 1967 cvs_notincvs 1968 return 1 1969 } 1970 set files [glob -nocomplain -types f -- .??* *] 1971 1972 regsub -all {\$} $files {\$} files 1973 set commandline "$cvs -d $cvscfg(cvsroot) log $files" 1974 gen_log:log C "$commandline" 1975 catch {eval "exec $commandline"} raw_log 1976 set log_lines [split $raw_log "\n"] 1977 1978 foreach logline $log_lines { 1979 if {[string match "Working file:*" $logline]} { 1980 set filename [lrange [split $logline] 2 end] 1981 set nbranches($filename) 0 1982 continue 1983 } 1984 if {[string match "total revisions:*" $logline]} { 1985 set nrevs($filename) [lindex [split $logline] end] 1986 continue 1987 } 1988 if { [regexp {^\t[-\w]+: .*\.0\.\d+$} $logline] } { 1989 incr nbranches($filename) 1990 } 1991 } 1992 set bushiestfile "" 1993 set mostrevisedfile "" 1994 set nbrmax 0 1995 foreach br [array names nbranches] { 1996 if {$nbranches($br) > $nbrmax} { 1997 set bushiestfile $br 1998 set nbrmax $nbranches($br) 1999 } 2000 } 2001 set nrevmax 0 2002 foreach br [array names nrevs] { 2003 if {$nrevs($br) > $nrevmax} { 2004 set mostrevisedfile $br 2005 set nrevmax $nrevs($br) 2006 } 2007 } 2008 gen_log:log F "Bushiest file \"$bushiestfile\" has $nbrmax branches" 2009 gen_log:log F "Most Revised file \"$mostrevisedfile\" has $nrevmax revisions" 2010 2011 # Sometimes we don't find a file with any branches at all, so bushiest 2012 # is empty. Fall back to mostrevised. All files have at least one rev. 2013 if {[string length $bushiestfile] > 0} { 2014 set filename $bushiestfile 2015 } else { 2016 set filename $mostrevisedfile 2017 } 2018 2019 ::cvs_branchlog::new "CVS,dir" "$filename" 2020 2021 gen_log:log T "LEAVE" 2022} 2023 2024# Sends files to the CVS branch browser one at a time. Called from 2025# workdir browser 2026proc cvs_branches {files} { 2027 global cvs 2028 global cvscfg 2029 2030 gen_log:log T "ENTER ($files)" 2031 2032 if {$files == {}} { 2033 cvsfail "Please select one or more files!" .workdir 2034 return 2035 } 2036 2037 foreach file $files { 2038 ::cvs_branchlog::new "CVS,loc" "$file" 2039 } 2040 gen_log:log T "LEAVE" 2041} 2042 2043namespace eval ::cvs_branchlog { 2044 variable instance 0 2045 2046 proc new {how filename} { 2047 variable instance 2048 set my_idx $instance 2049 incr instance 2050 2051 namespace eval $my_idx { 2052 set my_idx [uplevel {concat $my_idx}] 2053 set filename [uplevel {concat $filename}] 2054 set how [uplevel {concat $how}] 2055 variable command 2056 variable cmd_log 2057 variable lc 2058 variable revwho 2059 variable revdate 2060 variable revtime 2061 variable revlines 2062 variable revstate 2063 variable revcomment 2064 variable revmergefrom 2065 variable tags 2066 variable revbranches 2067 variable branchrevs 2068 variable logstate 2069 variable cwd 2070 2071 gen_log:log T "ENTER [namespace current]" 2072 set sys_loc [split $how {,}] 2073 set sys [lindex $sys_loc 0] 2074 set loc [lindex $sys_loc 1] 2075 2076 switch -- $sys { 2077 CVS { 2078 set command "cvs log \"$filename\"" 2079 if {$loc == "dir"} { 2080 set newlc [mergecanvas::new $filename $how [namespace current]] 2081 # ln is the namespace, lc is the canvas 2082 set ln [lindex $newlc 0] 2083 set lc [lindex $newlc 1] 2084 set show_tags 0 2085 } else { 2086 set newlc [logcanvas::new $filename $how [namespace current]] 2087 set ln [lindex $newlc 0] 2088 set lc [lindex $newlc 1] 2089 set show_tags [set $ln\::opt(show_tags)] 2090 } 2091 } 2092 RCS { 2093 set command "rlog \"$filename\"" 2094 set newlc [logcanvas::new $filename "RCS,loc" [namespace current]] 2095 set ln [lindex $newlc 0] 2096 set lc [lindex $newlc 1] 2097 set show_tags [set $ln\::opt(show_tags)] 2098 } 2099 } 2100 2101 proc abortLog { } { 2102 global cvscfg 2103 variable cmd_log 2104 variable lc 2105 2106 gen_log:log D " $cmd_log\::abort" 2107 catch {$cmd_log\::abort} 2108 busy_done $lc 2109 pack forget $lc.stop 2110 pack $lc.close -in $lc.down.closefm -side right 2111 $lc.close configure -state normal 2112 } 2113 2114 proc reloadLog { } { 2115 variable command 2116 variable cmd_log 2117 variable lc 2118 variable revwho 2119 variable revdate 2120 variable revtime 2121 variable revlines 2122 variable revstate 2123 variable revcomment 2124 variable revmergefrom 2125 variable revtags 2126 variable revbtags 2127 variable revbranches 2128 variable branchrevs 2129 variable logstate 2130 2131 gen_log:log T "ENTER" 2132 catch { $lc.canvas delete all } 2133 catch { unset revwho } 2134 catch { unset revdate } 2135 catch { unset revtime } 2136 catch { unset revlines } 2137 catch { unset revstate } 2138 catch { unset revcomment } 2139 catch { unset revmergefrom } 2140 catch { unset revtags } 2141 catch { unset revbtags } 2142 catch { unset revbranches } 2143 catch { unset branchrevs } 2144 set cwd [pwd] 2145 2146 pack forget $lc.close 2147 pack $lc.stop -in $lc.down.closefm -side right 2148 $lc.stop configure -state normal 2149 2150 set logstate {R} 2151 2152 set cmd_log [::exec::new $command {} 0 [namespace current]::parse_cvslog] 2153 # wait for it to finish so our arrays are all populated 2154 $cmd_log\::wait 2155 $cmd_log\::destroy 2156 2157 pack forget $lc.stop 2158 pack $lc.close -in $lc.down.closefm -side right 2159 $lc.close configure -state normal 2160 2161 [namespace current]::cvs_sort_it_all_out 2162 gen_log:log T "LEAVE" 2163 return 2164 } 2165 2166 proc parse_cvslog { exec logline } { 2167 # 2168 # Splits the rcs file up and parses it using a simple state machine. 2169 # 2170 global module_dir 2171 global inrcs 2172 global cvsglb 2173 variable filename 2174 variable lc 2175 variable ln 2176 variable revwho 2177 variable revdate 2178 variable revtime 2179 variable revlines 2180 variable revstate 2181 variable revcomment 2182 variable revmergefrom 2183 variable revtags 2184 variable revbtags 2185 variable revbranches 2186 variable branchrevs 2187 variable logstate 2188 variable revkind 2189 variable rnum 2190 variable rootbranch 2191 variable revbranch 2192 gen_log:log T "ENTER ($exec $logline)" 2193 2194 #gen_log:log D "$logline" 2195 if {$logline != {}} { 2196 switch -exact -- $logstate { 2197 {R} { 2198 # Look for the first text line which should give the file name. 2199 if {[string match {RCS file: *} $logline]} { 2200 # I think the whole path to the "RCS file" from the log isn't 2201 # really what we want here. More like module_dir, so we know 2202 # what to feed to cvs rdiff and rannotate. 2203 set fname [string range $logline 10 end] 2204 set fname [file tail $fname] 2205 if {[string range $fname end-1 end] == {,v}} { 2206 set fname [string range $fname 0 end-2] 2207 } 2208 set fname [file join $module_dir $fname] 2209 if {$inrcs && [file isdir RCS]} { 2210 set fname [file join RCS $fname] 2211 } 2212 $ln\::ConfigureButtons $fname 2213 } elseif {[string match {Working file: *} $logline]} { 2214 # If we care about a working copy we need to look 2215 # at the name of the working file here. It may be 2216 # different from what we were given if we were invoked 2217 # on a directory. 2218 #if {$localfile != "no file"} { 2219 set localfile [string range $logline 14 end] 2220 #} 2221 } elseif {$logline == "symbolic names:"} { 2222 # FIXME: old RCS can have a tag on this line 2223 set logstate {T} 2224 } 2225 } 2226 {T} { 2227 # Any line with a tab leader is a tag 2228 if { [string index $logline 0] == "\t" } { 2229 set parts [split $logline {:}] 2230 set tagstring [string trim [lindex $parts 0]] 2231 set rnum [string trim [lindex $parts 1]] 2232 2233 set parts [split $rnum {.}] 2234 if {[expr {[llength $parts] & 1}] == 1} { 2235 set parts [linsert $parts end-1 {0}] 2236 set rnum [join $parts {.}] 2237 } 2238 if {[lindex $parts end-1] == 0} { 2239 # Branch tag 2240 set rnum [join [lreplace $parts end-1 end-1] {.}] 2241 set revkind($rnum) "branch" 2242 set revbranch($tagstring) $rnum 2243 set rbranch [join [lrange $parts 0 end-2] {.}] 2244 set rootbranch($tagstring) $rbranch 2245 lappend revbtags($rnum) $tagstring 2246 lappend revbranches($rbranch) $rnum 2247 } else { 2248 # Ordinary symbolic tag 2249 lappend revtags($rnum) $tagstring 2250 # Is it possible that this tag is the only surviving 2251 # record that this revision ever existed? 2252 if {[llength $parts] == 2} { 2253 # A trunk revision but not necessarily 1.x because CVS allows 2254 # the first part of the revision number to be changed. We have 2255 # to assume that people always increase it if they change it 2256 # at all. 2257 lappend branchrevs(trunk) $rnum 2258 } else { 2259 set rbranch [join [lrange $parts 0 end-1] {.}] 2260 lappend branchrevs($rbranch) $rnum 2261 } 2262 # Branches for this revision may have already been created 2263 # during tag parsing 2264 foreach "revwho($rnum) revdate($rnum) revtime($rnum) 2265 revlines($rnum) revstate($rnum) revcomment($rnum)" \ 2266 {{} {} {} {} {dead} {}} \ 2267 { break } 2268 } 2269 } else { 2270 if {$logline == "description:"} { 2271 set logstate {S} 2272 } 2273 } 2274 } 2275 {S} { 2276 # Look for the line that starts a revision message. 2277 if {$logline == "----------------------------"} { 2278 set logstate {V} 2279 } 2280 } 2281 {V} { 2282 if {! [string match "revision *" $logline] } { 2283 # Did they put just the right number of dashes in the comment 2284 # to fool us? 2285 set logstate {L} 2286 } else { 2287 # Look for a revision number line 2288 set rnum [lindex [split $logline] 1] 2289 set parts [split $rnum {.}] 2290 set revkind($rnum) "revision" 2291 if {[llength $parts] == 2} { 2292 # A trunk revision but not necessarily 1.x because CVS allows 2293 # the first part of the revision number to be changed. We have 2294 # to assume that people always increase it if they change it 2295 # at all. 2296 lappend branchrevs(trunk) $rnum 2297 } else { 2298 lappend branchrevs([join [lrange $parts 0 end-1] {.}]) $rnum 2299 } 2300 # Branches for this revision may have already been created 2301 # during tag parsing 2302 foreach "revwho($rnum) revdate($rnum) revtime($rnum) 2303 revlines($rnum) revstate($rnum) revcomment($rnum)" \ 2304 {{} {} {} {} {} {}} \ 2305 { break } 2306 set logstate {D} 2307 } 2308 } 2309 {D} { 2310 # Look for a date line. This also has the name of the author. 2311 set parts [split $logline ";"] 2312 foreach p $parts { 2313 set eqn [split $p ":"]; 2314 set eqname [string trim [lindex $eqn 0]] 2315 set eqval [string trim [join [lrange $eqn 1 end] ":"]] 2316 switch -exact -- $eqname { 2317 {date} { 2318 set revdate($rnum) [lindex $eqval 0] 2319 set revtime($rnum) [lindex $eqval 1] 2320 gen_log:log D "date $revdate($rnum)" 2321 gen_log:log D "time $revtime($rnum)" 2322 } 2323 {author} { 2324 set revwho($rnum) $eqval 2325 } 2326 {lines} { 2327 set revlines($rnum) $eqval 2328 } 2329 {state} { 2330 set revstate($rnum) $eqval 2331 } 2332 {mergepoint} { 2333 set revmergefrom($rnum) $eqval 2334 gen_log:log D "mergefrom $revmergefrom($rnum)" 2335 } 2336 } 2337 } 2338 set logstate {L} 2339 } 2340 {L} { 2341 # See if there are branches off this revision 2342 if {[string match "branches:*" $logline]} { 2343 foreach br [lrange $logline 1 end] { 2344 set br [string trimright $br {;}] 2345 lappend revbranches($rnum) $br 2346 } 2347 } elseif {$logline == {----------------------------}} { 2348 set logstate {V} 2349 } elseif {$logline ==\ 2350 {=============================================================================}} { 2351 set logstate {X} 2352 } else { 2353 append revcomment($rnum) $logline "\n" 2354 } 2355 } 2356 {X} { 2357 # ignore any further lines 2358 } 2359 } 2360 } 2361 2362 if {$logstate == {X}} { 2363 gen_log:log D "********* Done parsing *********" 2364 } 2365 return [list {} $logline] 2366 } 2367 2368 proc cvs_sort_it_all_out {} { 2369 global cvscfg 2370 global module_dir 2371 variable filename 2372 variable sys 2373 variable lc 2374 variable ln 2375 variable revwho 2376 variable revdate 2377 variable revtime 2378 variable revlines 2379 variable revstate 2380 variable revcomment 2381 variable revmergefrom 2382 variable revtags 2383 variable revbtags 2384 variable revbranches 2385 variable branchrevs 2386 variable logstate 2387 variable rnum 2388 variable rootbranch 2389 variable revbranch 2390 variable revkind 2391 2392 gen_log:log T "ENTER" 2393 2394 if {[llength [array names revkind]] < 1} { 2395 cvsfail "Log empty. Check error status of cvs log comand" 2396 $lc close invoke 2397 return 2398 } 2399 2400 set revkind(1) "root" 2401 2402 foreach r [lsort -command sortrevs [array names revkind]] { 2403 gen_log:log D "revkind($r) $revkind($r)" 2404 } 2405 # Sort the revision and branch lists and remove duplicates 2406 foreach r [array names branchrevs] { 2407 set branchrevs($r) \ 2408 [lsort -unique -decreasing -command sortrevs $branchrevs($r)] 2409 #gen_log:log D "branchrevs($r) $branchrevs($r)" 2410 } 2411 2412 # Create a fake revision to be the trunk branchtag 2413 set revbtags(1) "trunk" 2414 set branchrevs(1) $branchrevs(trunk) 2415 2416 foreach r [array names revbranches] { 2417 set revbranches($r) \ 2418 [lsort -unique -command sortrevs $revbranches($r)] 2419 #gen_log:log D "revbranches($r) $revbranches($r)" 2420 } 2421 # Find out where to put the working revision icon (if anywhere) 2422 # FIXME: we don't know that the log parsed was derived from the 2423 # file in this directory. Maybe we should check CVS/{Root,Repository}? 2424 # Maybe this check should be done elsewhere? 2425 if {$sys != "rcs" && $filename != "no file"} { 2426 gen_log:log F "Reading CVS/Entries" 2427 set basename [file tail $filename] 2428 if {![catch {open [file join \ 2429 [file dirname $filename] {CVS}\ 2430 {Entries}] \ 2431 {r}} entries]} \ 2432 { 2433 foreach line [split [read $entries] "\n"] { 2434 # What does the entry for an added/deleted file look like? 2435 set parts [split $line {/}] 2436 if {[lindex $parts 1] == $basename} { 2437 set rnum [lindex $parts 2] 2438 if {[string index $rnum 0] == {-}} { 2439 # File has been locally removed and cvs removed but not 2440 # committed. 2441 set revstate(current) {dead} 2442 set rnum [string range $rnum 1 end] 2443 } else { 2444 set revstate(current) {Exp} 2445 } 2446 2447 set root [join [lrange [split $rnum {.}] 0 end-1] {.}] 2448 gen_log:log D "root $root" 2449 set tag [string range [lindex $parts 5] 1 end] 2450 if {$rnum == {0}} { 2451 # A locally added file has a revision of 0. Presumably 2452 # there is no log and no revisions to show. 2453 # FIXME: what if this is a resurrection? 2454 lappend branchrevs(trunk) {current} 2455 } elseif {[info exists rootbranch($tag)] && \ 2456 $rootbranch($tag) == $rnum} { 2457 # The sticky tag specifies a branch and the branch's 2458 # root is the same as the source revision. Place the 2459 # you-are-here box at the start of the branch. 2460 lappend branchrevs($revbranch($tag)) {current} 2461 } else { 2462 if {[catch {info exists $branchrevs($root)}] == 0} { 2463 if {$rnum == [lindex $branchrevs($root) 0]} { 2464 # The revision we are working on is the latest on its 2465 # branch. Place the you-are-here box on the end of the 2466 # branch. 2467 set branchrevs($root) [linsert $branchrevs($root) 0\ 2468 {current}] 2469 } else { 2470 # Otherwise we will place it as a branch off the 2471 # revision. 2472 if {![info exists revbranches($rnum)]} { 2473 set revbranches($rnum) {current} 2474 } else { 2475 set revbranches($rnum) [linsert $revbranches($rnum)\ 2476 0 {current}] 2477 } 2478 } 2479 } 2480 } 2481 foreach {revwho(current) revdate(current) revtime(current) 2482 revlines(current) revcomment(current) 2483 branchrevs(current)} \ 2484 {{} {} {} {} {} {}} \ 2485 { break } 2486 break 2487 } 2488 } 2489 close $entries 2490 } 2491 } 2492 gen_log:log D "" 2493 foreach a [array names branchrevs] { 2494 gen_log:log D "branchrevs($a) $branchrevs($a)" 2495 } 2496 gen_log:log D "" 2497 foreach a [array names revbranches] { 2498 gen_log:log D "revbranches($a) $revbranches($a)" 2499 } 2500 gen_log:log D "" 2501 foreach a [array names revbtags] { 2502 gen_log:log D "revbtags($a) $revbtags($a)" 2503 } 2504 gen_log:log D "" 2505 foreach a [array names revtags] { 2506 gen_log:log D "revtags($a) $revtags($a)" 2507 } 2508 2509 # We only needed these to place the you-are-here box. 2510 catch {unset rootbranch revbranch} 2511 $ln\::DrawTree now 2512 } 2513 [namespace current]::reloadLog 2514 return [namespace current] 2515 } 2516 } 2517} 2518 2519proc sortrevs {a b} { 2520 # Proc for lsort -command, to sort revision numbers 2521 # Return -1 if a<b, 0 if a=b, and 1 if a>b 2522 foreach ax [split $a {.}] bx [split $b {.}] { 2523 if {$ax < $bx} { 2524 return -1 2525 }\ 2526 elseif {$ax > $bx} { 2527 return 1 2528 } 2529 } 2530 return 0 2531} 2532