comparison lisp/vc-rcs.el @ 94847:5e64dca662f0

Remove assumption about what nil means as a first arument to vc-do-command.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Sat, 10 May 2008 13:27:16 +0000
parents 0f7a18ff94d6
children 4da572dc4992
comparison
equal deleted inserted replaced
94846:1a6e4ea4e517 94847:5e64dca662f0
234 "RCS-specific implementation of `vc-workfile-unchanged-p'." 234 "RCS-specific implementation of `vc-workfile-unchanged-p'."
235 ;; Try to use rcsdiff --brief. If rcsdiff does not understand that, 235 ;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
236 ;; do a double take and remember the fact for the future 236 ;; do a double take and remember the fact for the future
237 (let* ((version (concat "-r" (vc-working-revision file))) 237 (let* ((version (concat "-r" (vc-working-revision file)))
238 (status (if (eq vc-rcsdiff-knows-brief 'no) 238 (status (if (eq vc-rcsdiff-knows-brief 'no)
239 (vc-do-command nil 1 "rcsdiff" file version) 239 (vc-do-command "*vc*" 1 "rcsdiff" file version)
240 (vc-do-command nil 2 "rcsdiff" file "--brief" version)))) 240 (vc-do-command "*vc*" 2 "rcsdiff" file "--brief" version))))
241 (if (eq status 2) 241 (if (eq status 2)
242 (if (not vc-rcsdiff-knows-brief) 242 (if (not vc-rcsdiff-knows-brief)
243 (setq vc-rcsdiff-knows-brief 'no 243 (setq vc-rcsdiff-knows-brief 'no
244 status (vc-do-command nil 1 "rcsdiff" file version)) 244 status (vc-do-command "*vc*" 1 "rcsdiff" file version))
245 (error "rcsdiff failed")) 245 (error "rcsdiff failed"))
246 (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes))) 246 (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)))
247 ;; The workfile is unchanged if rcsdiff found no differences. 247 ;; The workfile is unchanged if rcsdiff found no differences.
248 (zerop status))) 248 (zerop status)))
249 249
282 (file-name-directory file))))) 282 (file-name-directory file)))))
283 (not (directory-files (file-name-directory file) 283 (not (directory-files (file-name-directory file)
284 nil ".*,v$" t)) 284 nil ".*,v$" t))
285 (yes-or-no-p "Create RCS subdirectory? ") 285 (yes-or-no-p "Create RCS subdirectory? ")
286 (make-directory subdir)) 286 (make-directory subdir))
287 (apply 'vc-do-command nil 0 "ci" file 287 (apply 'vc-do-command "*vc*" 0 "ci" file
288 ;; if available, use the secure registering option 288 ;; if available, use the secure registering option
289 (and (vc-rcs-release-p "5.6.4") "-i") 289 (and (vc-rcs-release-p "5.6.4") "-i")
290 (concat (if vc-keep-workfiles "-u" "-r") rev) 290 (concat (if vc-keep-workfiles "-u" "-r") rev)
291 (and comment (concat "-t-" comment)) 291 (and comment (concat "-t-" comment))
292 (vc-switches 'RCS 'register)) 292 (vc-switches 'RCS 'register))
360 default-branch) 360 default-branch)
361 (setq rev default-branch) 361 (setq rev default-branch)
362 (setq switches (cons "-f" switches))) 362 (setq switches (cons "-f" switches)))
363 (if (and (not rev) old-version) 363 (if (and (not rev) old-version)
364 (setq rev (vc-branch-part old-version))) 364 (setq rev (vc-branch-part old-version)))
365 (apply 'vc-do-command nil 0 "ci" (vc-name file) 365 (apply 'vc-do-command "*vc*" 0 "ci" (vc-name file)
366 ;; if available, use the secure check-in option 366 ;; if available, use the secure check-in option
367 (and (vc-rcs-release-p "5.6.4") "-j") 367 (and (vc-rcs-release-p "5.6.4") "-j")
368 (concat (if vc-keep-workfiles "-u" "-r") rev) 368 (concat (if vc-keep-workfiles "-u" "-r") rev)
369 (concat "-m" comment) 369 (concat "-m" comment)
370 switches) 370 switches)
392 ;; If this is an old RCS release, we might have 392 ;; If this is an old RCS release, we might have
393 ;; to remove a remaining lock. 393 ;; to remove a remaining lock.
394 (if (not (vc-rcs-release-p "5.6.2")) 394 (if (not (vc-rcs-release-p "5.6.2"))
395 ;; exit status of 1 is also accepted. 395 ;; exit status of 1 is also accepted.
396 ;; It means that the lock was removed before. 396 ;; It means that the lock was removed before.
397 (vc-do-command nil 1 "rcs" (vc-name file) 397 (vc-do-command "*vc*" 1 "rcs" (vc-name file)
398 (concat "-u" old-version))))))))) 398 (concat "-u" old-version)))))))))
399 399
400 (defun vc-rcs-find-revision (file rev buffer) 400 (defun vc-rcs-find-revision (file rev buffer)
401 (apply 'vc-do-command 401 (apply 'vc-do-command
402 buffer 0 "co" (vc-name file) 402 (or buffer "*vc*") 0 "co" (vc-name file)
403 "-q" ;; suppress diagnostic output 403 "-q" ;; suppress diagnostic output
404 (concat "-p" rev) 404 (concat "-p" rev)
405 (vc-switches 'RCS 'checkout))) 405 (vc-switches 'RCS 'checkout)))
406 406
407 (defun vc-rcs-checkout (file &optional editable rev) 407 (defun vc-rcs-checkout (file &optional editable rev)
429 ;; clear the default branch first 429 ;; clear the default branch first
430 (and rev (string= rev "") 430 (and rev (string= rev "")
431 (vc-rcs-set-default-branch file nil)) 431 (vc-rcs-set-default-branch file nil))
432 ;; now do the checkout 432 ;; now do the checkout
433 (apply 'vc-do-command 433 (apply 'vc-do-command
434 nil 0 "co" (vc-name file) 434 "*vc*" 0 "co" (vc-name file)
435 ;; If locking is not strict, force to overwrite 435 ;; If locking is not strict, force to overwrite
436 ;; the writable workfile. 436 ;; the writable workfile.
437 (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f") 437 (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
438 (if editable "-l") 438 (if editable "-l")
439 (if (stringp rev) 439 (if (stringp rev)
482 (done nil)) 482 (done nil))
483 (if (null (yes-or-no-p (format "Remove version %s from %s history? " 483 (if (null (yes-or-no-p (format "Remove version %s from %s history? "
484 discard file))) 484 discard file)))
485 (error "Aborted")) 485 (error "Aborted"))
486 (message "Removing revision %s from %s." discard file) 486 (message "Removing revision %s from %s." discard file)
487 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard)) 487 (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-o" discard))
488 ;; Check out the most recent remaining version. If it 488 ;; Check out the most recent remaining version. If it
489 ;; fails, because the whole branch got deleted, do a 489 ;; fails, because the whole branch got deleted, do a
490 ;; double-take and check out the version where the branch 490 ;; double-take and check out the version where the branch
491 ;; started. 491 ;; started.
492 (while (not done) 492 (while (not done)
493 (condition-case err 493 (condition-case err
494 (progn 494 (progn
495 (vc-do-command nil 0 "co" (vc-name file) "-f" 495 (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
496 (concat "-u" previous)) 496 (concat "-u" previous))
497 (setq done t)) 497 (setq done t))
498 (error (set-buffer "*vc*") 498 (error (set-buffer "*vc*")
499 (goto-char (point-min)) 499 (goto-char (point-min))
500 (if (search-forward "no side branches present for" nil t) 500 (if (search-forward "no side branches present for" nil t)
510 (defun vc-rcs-revert (file &optional contents-done) 510 (defun vc-rcs-revert (file &optional contents-done)
511 "Revert FILE to the version it was based on. If FILE is a directory, 511 "Revert FILE to the version it was based on. If FILE is a directory,
512 revert all registered files beneath it." 512 revert all registered files beneath it."
513 (if (file-directory-p file) 513 (if (file-directory-p file)
514 (mapc 'vc-rcs-revert (vc-expand-dirs (list file))) 514 (mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
515 (vc-do-command nil 0 "co" (vc-name file) "-f" 515 (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
516 (concat (if (eq (vc-state file) 'edited) "-u" "-r") 516 (concat (if (eq (vc-state file) 'edited) "-u" "-r")
517 (vc-working-revision file))))) 517 (vc-working-revision file)))))
518 518
519 (defun vc-rcs-merge (file first-version &optional second-version) 519 (defun vc-rcs-merge (file first-version &optional second-version)
520 "Merge changes into current working copy of FILE. 520 "Merge changes into current working copy of FILE.
521 The changes are between FIRST-VERSION and SECOND-VERSION." 521 The changes are between FIRST-VERSION and SECOND-VERSION."
522 (vc-do-command nil 1 "rcsmerge" (vc-name file) 522 (vc-do-command "*vc*" 1 "rcsmerge" (vc-name file)
523 "-kk" ; ignore keyword conflicts 523 "-kk" ; ignore keyword conflicts
524 (concat "-r" first-version) 524 (concat "-r" first-version)
525 (if second-version (concat "-r" second-version)))) 525 (if second-version (concat "-r" second-version))))
526 526
527 (defun vc-rcs-steal-lock (file &optional rev) 527 (defun vc-rcs-steal-lock (file &optional rev)
528 "Steal the lock on the current workfile for FILE and revision REV. 528 "Steal the lock on the current workfile for FILE and revision REV.
529 If FUILEis a directory, steal the lock on all registered files beneath it. 529 If FUILEis a directory, steal the lock on all registered files beneath it.
530 Needs RCS 5.6.2 or later for -M." 530 Needs RCS 5.6.2 or later for -M."
531 (if (file-directory-p file) 531 (if (file-directory-p file)
532 (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file))) 532 (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
533 (vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) 533 (vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
534 ;; Do a real checkout after stealing the lock, so that we see 534 ;; Do a real checkout after stealing the lock, so that we see
535 ;; expanded headers. 535 ;; expanded headers.
536 (vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))) 536 (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev))))
537 537
538 (defun vc-rcs-modify-change-comment (files rev comment) 538 (defun vc-rcs-modify-change-comment (files rev comment)
539 "Modify the change comments change on FILES on a specified REV. If FILE is a 539 "Modify the change comments change on FILES on a specified REV. If FILE is a
540 directory the operation is applied to all registered files beneath it." 540 directory the operation is applied to all registered files beneath it."
541 (dolist (file (vc-expand-dirs files)) 541 (dolist (file (vc-expand-dirs files))
542 (vc-do-command nil 0 "rcs" (vc-name file) 542 (vc-do-command "*vc*" 0 "rcs" (vc-name file)
543 (concat "-m" rev ":" comment)))) 543 (concat "-m" rev ":" comment))))
544 544
545 545
546 ;;; 546 ;;;
547 ;;; History functions 547 ;;; History functions
548 ;;; 548 ;;;
549 549
550 (defun vc-rcs-print-log (files &optional buffer) 550 (defun vc-rcs-print-log (files &optional buffer)
551 "Get change log associated with FILE. If FILE is a 551 "Get change log associated with FILE. If FILE is a
552 directory the operation is applied to all registered files beneath it." 552 directory the operation is applied to all registered files beneath it."
553 (vc-do-command buffer 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files)))) 553 (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))))
554 554
555 (defun vc-rcs-diff (files &optional oldvers newvers buffer) 555 (defun vc-rcs-diff (files &optional oldvers newvers buffer)
556 "Get a difference report using RCS between two sets of files." 556 "Get a difference report using RCS between two sets of files."
557 (apply 'vc-do-command (or buffer "*vc-diff*") 557 (apply 'vc-do-command (or buffer "*vc-diff*")
558 1 ;; Always go synchronous, the repo is local 558 1 ;; Always go synchronous, the repo is local
790 ;;; Snapshot system 790 ;;; Snapshot system
791 ;;; 791 ;;;
792 792
793 (defun vc-rcs-assign-name (file name) 793 (defun vc-rcs-assign-name (file name)
794 "Assign to FILE's latest version a given NAME." 794 "Assign to FILE's latest version a given NAME."
795 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-n" name ":"))) 795 (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-n" name ":")))
796 796
797 797
798 ;;; 798 ;;;
799 ;;; Miscellaneous 799 ;;; Miscellaneous
800 ;;; 800 ;;;
1061 1061
1062 If the user has not set variable `vc-rcs-release' and it is nil, 1062 If the user has not set variable `vc-rcs-release' and it is nil,
1063 variable `vc-rcs-release' is set to the returned value." 1063 variable `vc-rcs-release' is set to the returned value."
1064 (or vc-rcs-release 1064 (or vc-rcs-release
1065 (setq vc-rcs-release 1065 (setq vc-rcs-release
1066 (or (and (zerop (vc-do-command nil nil "rcs" nil "-V")) 1066 (or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V"))
1067 (with-current-buffer (get-buffer "*vc*") 1067 (with-current-buffer (get-buffer "*vc*")
1068 (vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1))) 1068 (vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1)))
1069 'unknown)))) 1069 'unknown))))
1070 1070
1071 (defun vc-rcs-set-non-strict-locking (file) 1071 (defun vc-rcs-set-non-strict-locking (file)
1072 (vc-do-command nil 0 "rcs" file "-U") 1072 (vc-do-command "*vc*" 0 "rcs" file "-U")
1073 (vc-file-setprop file 'vc-checkout-model 'implicit) 1073 (vc-file-setprop file 'vc-checkout-model 'implicit)
1074 (set-file-modes file (logior (file-modes file) 128))) 1074 (set-file-modes file (logior (file-modes file) 128)))
1075 1075
1076 (defun vc-rcs-set-default-branch (file branch) 1076 (defun vc-rcs-set-default-branch (file branch)
1077 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch)) 1077 (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch))
1078 (vc-file-setprop file 'vc-rcs-default-branch branch)) 1078 (vc-file-setprop file 'vc-rcs-default-branch branch))
1079 1079
1080 (defun vc-rcs-parse (&optional buffer) 1080 (defun vc-rcs-parse (&optional buffer)
1081 "Parse current buffer, presumed to be in RCS-style masterfile format. 1081 "Parse current buffer, presumed to be in RCS-style masterfile format.
1082 Optional arg BUFFER specifies another buffer to parse. Return an alist 1082 Optional arg BUFFER specifies another buffer to parse. Return an alist