Mercurial > emacs

comparison lisp/vc-cvs.el @ 51733:2b72fd42f02e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(vc-cvs-repository-hostname): New operation. (vc-cvs-stay-local-p): Use vc-stay-local-p. (vc-cvs-rename-file): Remove (use the default). (vc-cvs-register): Register parent dir if needed. (vc-cvs-could-register): Return non-nil if parent can be registered. (vc-cvs-state, vc-cvs-dir-state, vc-cvs-print-log, vc-cvs-diff) (vc-cvs-diff-tree, vc-cvs-make-version-backups-p): Use vc-stay-local-p.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 04 Jul 2003 22:40:26 +0000
parents 0b871f4efb59
children 695cf19ef79e
comparison
equal deleted inserted replaced
51732:f43bd5204ab4 51733:2b72fd42f02e
1 ;;; vc-cvs.el --- non-resident support for CVS version-control 1 ;;; vc-cvs.el --- non-resident support for CVS version-control
2 2
3 ;; Copyright (C) 1995,98,99,2000,2001,2002 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,98,99,2000,2001,02,2003 Free Software Foundation, Inc.
4 4
5 ;; Author: FSF (see vc.el for full credits) 5 ;; Author: FSF (see vc.el for full credits)
6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8 ;; $Id: vc-cvs.el,v 1.60 2003/05/09 14:32:01 monnier Exp $ 8 ;; $Id: vc-cvs.el,v 1.61 2003/05/23 17:57:29 spiegel Exp $
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by 13 ;; it under the terms of the GNU General Public License as published by
189 (t nil))) 189 (t nil)))
190 nil))) 190 nil)))
191 191
192 (defun vc-cvs-state (file) 192 (defun vc-cvs-state (file)
193 "CVS-specific version of `vc-state'." 193 "CVS-specific version of `vc-state'."
194 (if (vc-cvs-stay-local-p file) 194 (if (vc-stay-local-p file)
195 (let ((state (vc-file-getprop file 'vc-state))) 195 (let ((state (vc-file-getprop file 'vc-state)))
196 ;; If we should stay local, use the heuristic but only if 196 ;; If we should stay local, use the heuristic but only if
197 ;; we don't have a more precise state already available. 197 ;; we don't have a more precise state already available.
198 (if (memq state '(up-to-date edited)) 198 (if (memq state '(up-to-date edited))
199 (vc-cvs-state-heuristic file) 199 (vc-cvs-state-heuristic file)
215 215
216 (defun vc-cvs-dir-state (dir) 216 (defun vc-cvs-dir-state (dir)
217 "Find the CVS state of all files in DIR." 217 "Find the CVS state of all files in DIR."
218 ;; if DIR is not under CVS control, don't do anything. 218 ;; if DIR is not under CVS control, don't do anything.
219 (when (file-readable-p (expand-file-name "CVS/Entries" dir)) 219 (when (file-readable-p (expand-file-name "CVS/Entries" dir))
220 (if (vc-cvs-stay-local-p dir) 220 (if (vc-stay-local-p dir)
221 (vc-cvs-dir-state-heuristic dir) 221 (vc-cvs-dir-state-heuristic dir)
222 (let ((default-directory dir)) 222 (let ((default-directory dir))
223 ;; Don't specify DIR in this command, the default-directory is 223 ;; Don't specify DIR in this command, the default-directory is
224 ;; enough. Otherwise it might fail with remote repositories. 224 ;; enough. Otherwise it might fail with remote repositories.
225 (with-temp-buffer 225 (with-temp-buffer
284 "Register FILE into the CVS version-control system. 284 "Register FILE into the CVS version-control system.
285 COMMENT can be used to provide an initial description of FILE. 285 COMMENT can be used to provide an initial description of FILE.
286 286
287 `vc-register-switches' and `vc-cvs-register-switches' are passed to 287 `vc-register-switches' and `vc-cvs-register-switches' are passed to
288 the CVS command (in that order)." 288 the CVS command (in that order)."
289 (when (and (not (vc-cvs-responsible-p file))
290 (vc-cvs-could-register file))
291 ;; Register the directory if needed.
292 (vc-cvs-register (directory-file-name (file-name-directory file))))
289 (apply 'vc-cvs-command nil 0 file 293 (apply 'vc-cvs-command nil 0 file
290 "add" 294 "add"
291 (and comment (string-match "[^\t\n ]" comment) 295 (and comment (string-match "[^\t\n ]" comment)
292 (concat "-m" comment)) 296 (concat "-m" comment))
293 (vc-switches 'CVS 'register))) 297 (vc-switches 'CVS 'register)))
297 (file-directory-p (expand-file-name "CVS" 301 (file-directory-p (expand-file-name "CVS"
298 (if (file-directory-p file) 302 (if (file-directory-p file)
299 file 303 file
300 (file-name-directory file))))) 304 (file-name-directory file)))))
301 305
302 (defalias 'vc-cvs-could-register 'vc-cvs-responsible-p 306 (defun vc-cvs-could-register (file)
303 "Return non-nil if FILE could be registered in CVS. 307 "Return non-nil if FILE could be registered in CVS.
304 This is only possible if CVS is responsible for FILE's directory.") 308 This is only possible if CVS is managing FILE's directory or one of
309 its parents."
310 (let ((dir file))
311 (while (and (stringp dir)
312 (not (equal dir (setq dir (file-name-directory dir))))
313 dir)
314 (setq dir (if (file-directory-p
315 (expand-file-name "CVS/Entries" dir))
316 t (directory-file-name dir))))
317 (eq dir t)))
305 318
306 (defun vc-cvs-checkin (file rev comment) 319 (defun vc-cvs-checkin (file rev comment)
307 "CVS-specific version of `vc-backend-checkin'." 320 "CVS-specific version of `vc-backend-checkin'."
308 (unless (or (not rev) (vc-cvs-valid-version-number-p rev)) 321 (unless (or (not rev) (vc-cvs-valid-version-number-p rev))
309 (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) 322 (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
441 (message "Checking out %s...done" filename))))) 454 (message "Checking out %s...done" filename)))))
442 455
443 (defun vc-cvs-delete-file (file) 456 (defun vc-cvs-delete-file (file)
444 (vc-cvs-command nil 0 file "remove" "-f")) 457 (vc-cvs-command nil 0 file "remove" "-f"))
445 458
446 (defun vc-cvs-rename-file (old new)
447 ;; CVS doesn't know how to move files, so we just remove&add.
448 (condition-case nil
449 (add-name-to-file old new)
450 (error (rename-file old new)))
451 (vc-cvs-delete-file old)
452 (with-current-buffer (find-file-noselect new)
453 (vc-register)))
454
455 (defun vc-cvs-revert (file &optional contents-done) 459 (defun vc-cvs-revert (file &optional contents-done)
456 "Revert FILE to the version it was based on." 460 "Revert FILE to the version it was based on."
457 (unless contents-done 461 (unless contents-done
458 ;; Check out via standard output (caused by the final argument 462 ;; Check out via standard output (caused by the final argument
459 ;; FILE below), so that no sticky tag is set. 463 ;; FILE below), so that no sticky tag is set.
531 535
532 (defun vc-cvs-print-log (file) 536 (defun vc-cvs-print-log (file)
533 "Get change log associated with FILE." 537 "Get change log associated with FILE."
534 (vc-cvs-command 538 (vc-cvs-command
535 nil 539 nil
536 (if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0) 540 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
537 file "log")) 541 file "log"))
538 542
539 (defun vc-cvs-diff (file &optional oldvers newvers) 543 (defun vc-cvs-diff (file &optional oldvers newvers)
540 "Get a difference report using CVS between two versions of FILE." 544 "Get a difference report using CVS between two versions of FILE."
541 (if (string= (vc-workfile-version file) "0") 545 (if (string= (vc-workfile-version file) "0")
548 (apply 'vc-do-command "*vc-diff*" 552 (apply 'vc-do-command "*vc-diff*"
549 1 "diff" file 553 1 "diff" file
550 (append (vc-switches nil 'diff) '("/dev/null"))) 554 (append (vc-switches nil 'diff) '("/dev/null")))
551 ;; Even if it's empty, it's locally modified. 555 ;; Even if it's empty, it's locally modified.
552 1) 556 1)
553 (let* ((async (and (vc-cvs-stay-local-p file) (fboundp 'start-process))) 557 (let* ((async (and (vc-stay-local-p file) (fboundp 'start-process)))
554 (status (apply 'vc-cvs-command "*vc-diff*" 558 (status (apply 'vc-cvs-command "*vc-diff*"
555 (if async 'async 1) 559 (if async 'async 1)
556 file "diff" 560 file "diff"
557 (and oldvers (concat "-r" oldvers)) 561 (and oldvers (concat "-r" oldvers))
558 (and newvers (concat "-r" newvers)) 562 (and newvers (concat "-r" newvers))
561 565
562 (defun vc-cvs-diff-tree (dir &optional rev1 rev2) 566 (defun vc-cvs-diff-tree (dir &optional rev1 rev2)
563 "Diff all files at and below DIR." 567 "Diff all files at and below DIR."
564 (with-current-buffer "*vc-diff*" 568 (with-current-buffer "*vc-diff*"
565 (setq default-directory dir) 569 (setq default-directory dir)
566 (if (vc-cvs-stay-local-p dir) 570 (if (vc-stay-local-p dir)
567 ;; local diff: do it filewise, and only for files that are modified 571 ;; local diff: do it filewise, and only for files that are modified
568 (vc-file-tree-walk 572 (vc-file-tree-walk
569 dir 573 dir
570 (lambda (f) 574 (lambda (f)
571 (vc-exec-after 575 (vc-exec-after
671 675
672 ;;; 676 ;;;
673 ;;; Miscellaneous 677 ;;; Miscellaneous
674 ;;; 678 ;;;
675 679
676 (defalias 'vc-cvs-make-version-backups-p 'vc-cvs-stay-local-p 680 (defalias 'vc-cvs-make-version-backups-p 'vc-stay-local-p
677 "Return non-nil if version backups should be made for FILE.") 681 "Return non-nil if version backups should be made for FILE.")
678 682
679 (defun vc-cvs-check-headers () 683 (defun vc-cvs-check-headers ()
680 "Check if the current file has any headers in it." 684 "Check if the current file has any headers in it."
681 (save-excursion 685 (save-excursion
696 (if (stringp vc-cvs-global-switches) 700 (if (stringp vc-cvs-global-switches)
697 (cons vc-cvs-global-switches flags) 701 (cons vc-cvs-global-switches flags)
698 (append vc-cvs-global-switches 702 (append vc-cvs-global-switches
699 flags)))) 703 flags))))
700 704
701 (defun vc-cvs-stay-local-p (file) 705 (defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility.
702 "Return non-nil if VC should stay local when handling FILE. 706
703 See `vc-cvs-stay-local'." 707 (defun vc-cvs-repository-hostname (dirname)
704 (when vc-cvs-stay-local 708 "Hostname of the CVS server associated to workarea DIRNAME."
705 (let* ((dirname (if (file-directory-p file) 709 (let ((rootname (expand-file-name "CVS/Root" dirname)))
706 (directory-file-name file) 710 (when (file-readable-p rootname)
707 (file-name-directory file))) 711 (with-temp-buffer
708 (prop 712 (let ((coding-system-for-read
709 (or (vc-file-getprop dirname 'vc-cvs-stay-local-p) 713 (or file-name-coding-system
710 (vc-file-setprop 714 default-file-name-coding-system)))
711 dirname 'vc-cvs-stay-local-p 715 (vc-insert-file rootname))
712 (let ((rootname (expand-file-name "CVS/Root" dirname))) 716 (goto-char (point-min))
713 (when (file-readable-p rootname) 717 (nth 2 (vc-cvs-parse-root
714 (with-temp-buffer 718 (buffer-substring (point)
715 (let ((coding-system-for-read 719 (line-end-position))))))))
716 (or file-name-coding-system
717 default-file-name-coding-system)))
718 (vc-insert-file rootname))
719 (goto-char (point-min))
720 (let* ((cvs-root-members
721 (vc-cvs-parse-root
722 (buffer-substring (point)
723 (line-end-position))))
724 (hostname (nth 2 cvs-root-members)))
725 (if (not hostname)
726 'no
727 (let* ((stay-local t)
728 (rx
729 (cond
730 ;; vc-cvs-stay-local: rx
731 ((stringp vc-cvs-stay-local)
732 vc-cvs-stay-local)
733 ;; vc-cvs-stay-local: '( [except] rx ... )
734 ((consp vc-cvs-stay-local)
735 (mapconcat
736 'identity
737 (if (not (eq (car vc-cvs-stay-local)
738 'except))
739 vc-cvs-stay-local
740 (setq stay-local nil)
741 (cdr vc-cvs-stay-local))
742 "\\|")))))
743 (if (not rx)
744 'yes
745 (if (not (string-match rx hostname))
746 (setq stay-local (not stay-local)))
747 (if stay-local
748 'yes
749 'no))))))))))))
750 (if (eq prop 'yes) t nil))))
751 720
752 (defun vc-cvs-parse-root (root) 721 (defun vc-cvs-parse-root (root)
753 "Split CVS ROOT specification string into a list of fields. 722 "Split CVS ROOT specification string into a list of fields.
754 A CVS root specification of the form 723 A CVS root specification of the form
755 [:METHOD:][[USER@]HOSTNAME:]/path/to/repository 724 [:METHOD:][[USER@]HOSTNAME:]/path/to/repository