1 |
;;; vc-cvs.el --- non-resident support for CVS version-control |
;;; vc-cvs.el --- non-resident support for CVS version-control |
2 |
|
|
3 |
;; Copyright (C) 1995,98,99,2000,2001,2002 Free Software Foundation, Inc. |
;; Copyright (C) 1995,98,99,2000,2001,02,2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: FSF (see vc.el for full credits) |
;; Author: FSF (see vc.el for full credits) |
6 |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
191 |
|
|
192 |
(defun vc-cvs-state (file) |
(defun vc-cvs-state (file) |
193 |
"CVS-specific version of `vc-state'." |
"CVS-specific version of `vc-state'." |
194 |
(if (vc-cvs-stay-local-p file) |
(if (vc-stay-local-p file) |
195 |
(let ((state (vc-file-getprop file 'vc-state))) |
(let ((state (vc-file-getprop file 'vc-state))) |
196 |
;; If we should stay local, use the heuristic but only if |
;; If we should stay local, use the heuristic but only if |
197 |
;; we don't have a more precise state already available. |
;; we don't have a more precise state already available. |
217 |
"Find the CVS state of all files in DIR." |
"Find the CVS state of all files in DIR." |
218 |
;; if DIR is not under CVS control, don't do anything. |
;; if DIR is not under CVS control, don't do anything. |
219 |
(when (file-readable-p (expand-file-name "CVS/Entries" dir)) |
(when (file-readable-p (expand-file-name "CVS/Entries" dir)) |
220 |
(if (vc-cvs-stay-local-p dir) |
(if (vc-stay-local-p dir) |
221 |
(vc-cvs-dir-state-heuristic dir) |
(vc-cvs-dir-state-heuristic dir) |
222 |
(let ((default-directory dir)) |
(let ((default-directory dir)) |
223 |
;; Don't specify DIR in this command, the default-directory is |
;; Don't specify DIR in this command, the default-directory is |
286 |
|
|
287 |
`vc-register-switches' and `vc-cvs-register-switches' are passed to |
`vc-register-switches' and `vc-cvs-register-switches' are passed to |
288 |
the CVS command (in that order)." |
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)))) |
293 |
(apply 'vc-cvs-command nil 0 file |
(apply 'vc-cvs-command nil 0 file |
294 |
"add" |
"add" |
295 |
(and comment (string-match "[^\t\n ]" comment) |
(and comment (string-match "[^\t\n ]" comment) |
303 |
file |
file |
304 |
(file-name-directory file))))) |
(file-name-directory file))))) |
305 |
|
|
306 |
(defalias 'vc-cvs-could-register 'vc-cvs-responsible-p |
(defun vc-cvs-could-register (file) |
307 |
"Return non-nil if FILE could be registered in CVS. |
"Return non-nil if FILE could be registered in CVS. |
308 |
This is only possible if CVS is responsible for FILE's directory.") |
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))) |
318 |
|
|
319 |
(defun vc-cvs-checkin (file rev comment) |
(defun vc-cvs-checkin (file rev comment) |
320 |
"CVS-specific version of `vc-backend-checkin'." |
"CVS-specific version of `vc-backend-checkin'." |
456 |
(defun vc-cvs-delete-file (file) |
(defun vc-cvs-delete-file (file) |
457 |
(vc-cvs-command nil 0 file "remove" "-f")) |
(vc-cvs-command nil 0 file "remove" "-f")) |
458 |
|
|
|
(defun vc-cvs-rename-file (old new) |
|
|
;; CVS doesn't know how to move files, so we just remove&add. |
|
|
(condition-case nil |
|
|
(add-name-to-file old new) |
|
|
(error (rename-file old new))) |
|
|
(vc-cvs-delete-file old) |
|
|
(with-current-buffer (find-file-noselect new) |
|
|
(vc-register))) |
|
|
|
|
459 |
(defun vc-cvs-revert (file &optional contents-done) |
(defun vc-cvs-revert (file &optional contents-done) |
460 |
"Revert FILE to the version it was based on." |
"Revert FILE to the version it was based on." |
461 |
(unless contents-done |
(unless contents-done |
537 |
"Get change log associated with FILE." |
"Get change log associated with FILE." |
538 |
(vc-cvs-command |
(vc-cvs-command |
539 |
nil |
nil |
540 |
(if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0) |
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) |
541 |
file "log")) |
file "log")) |
542 |
|
|
543 |
(defun vc-cvs-diff (file &optional oldvers newvers) |
(defun vc-cvs-diff (file &optional oldvers newvers) |
554 |
(append (vc-switches nil 'diff) '("/dev/null"))) |
(append (vc-switches nil 'diff) '("/dev/null"))) |
555 |
;; Even if it's empty, it's locally modified. |
;; Even if it's empty, it's locally modified. |
556 |
1) |
1) |
557 |
(let* ((async (and (vc-cvs-stay-local-p file) (fboundp 'start-process))) |
(let* ((async (and (vc-stay-local-p file) (fboundp 'start-process))) |
558 |
(status (apply 'vc-cvs-command "*vc-diff*" |
(status (apply 'vc-cvs-command "*vc-diff*" |
559 |
(if async 'async 1) |
(if async 'async 1) |
560 |
file "diff" |
file "diff" |
567 |
"Diff all files at and below DIR." |
"Diff all files at and below DIR." |
568 |
(with-current-buffer "*vc-diff*" |
(with-current-buffer "*vc-diff*" |
569 |
(setq default-directory dir) |
(setq default-directory dir) |
570 |
(if (vc-cvs-stay-local-p dir) |
(if (vc-stay-local-p dir) |
571 |
;; local diff: do it filewise, and only for files that are modified |
;; local diff: do it filewise, and only for files that are modified |
572 |
(vc-file-tree-walk |
(vc-file-tree-walk |
573 |
dir |
dir |
677 |
;;; Miscellaneous |
;;; Miscellaneous |
678 |
;;; |
;;; |
679 |
|
|
680 |
(defalias 'vc-cvs-make-version-backups-p 'vc-cvs-stay-local-p |
(defalias 'vc-cvs-make-version-backups-p 'vc-stay-local-p |
681 |
"Return non-nil if version backups should be made for FILE.") |
"Return non-nil if version backups should be made for FILE.") |
682 |
|
|
683 |
(defun vc-cvs-check-headers () |
(defun vc-cvs-check-headers () |
702 |
(append vc-cvs-global-switches |
(append vc-cvs-global-switches |
703 |
flags)))) |
flags)))) |
704 |
|
|
705 |
(defun vc-cvs-stay-local-p (file) |
(defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility. |
706 |
"Return non-nil if VC should stay local when handling FILE. |
|
707 |
See `vc-cvs-stay-local'." |
(defun vc-cvs-repository-hostname (dirname) |
708 |
(when vc-cvs-stay-local |
"Hostname of the CVS server associated to workarea DIRNAME." |
709 |
(let* ((dirname (if (file-directory-p file) |
(let ((rootname (expand-file-name "CVS/Root" dirname))) |
710 |
(directory-file-name file) |
(when (file-readable-p rootname) |
711 |
(file-name-directory file))) |
(with-temp-buffer |
712 |
(prop |
(let ((coding-system-for-read |
713 |
(or (vc-file-getprop dirname 'vc-cvs-stay-local-p) |
(or file-name-coding-system |
714 |
(vc-file-setprop |
default-file-name-coding-system))) |
715 |
dirname 'vc-cvs-stay-local-p |
(vc-insert-file rootname)) |
716 |
(let ((rootname (expand-file-name "CVS/Root" dirname))) |
(goto-char (point-min)) |
717 |
(when (file-readable-p rootname) |
(nth 2 (vc-cvs-parse-root |
718 |
(with-temp-buffer |
(buffer-substring (point) |
719 |
(let ((coding-system-for-read |
(line-end-position)))))))) |
|
(or file-name-coding-system |
|
|
default-file-name-coding-system))) |
|
|
(vc-insert-file rootname)) |
|
|
(goto-char (point-min)) |
|
|
(let* ((cvs-root-members |
|
|
(vc-cvs-parse-root |
|
|
(buffer-substring (point) |
|
|
(line-end-position)))) |
|
|
(hostname (nth 2 cvs-root-members))) |
|
|
(if (not hostname) |
|
|
'no |
|
|
(let* ((stay-local t) |
|
|
(rx |
|
|
(cond |
|
|
;; vc-cvs-stay-local: rx |
|
|
((stringp vc-cvs-stay-local) |
|
|
vc-cvs-stay-local) |
|
|
;; vc-cvs-stay-local: '( [except] rx ... ) |
|
|
((consp vc-cvs-stay-local) |
|
|
(mapconcat |
|
|
'identity |
|
|
(if (not (eq (car vc-cvs-stay-local) |
|
|
'except)) |
|
|
vc-cvs-stay-local |
|
|
(setq stay-local nil) |
|
|
(cdr vc-cvs-stay-local)) |
|
|
"\\|"))))) |
|
|
(if (not rx) |
|
|
'yes |
|
|
(if (not (string-match rx hostname)) |
|
|
(setq stay-local (not stay-local))) |
|
|
(if stay-local |
|
|
'yes |
|
|
'no)))))))))))) |
|
|
(if (eq prop 'yes) t nil)))) |
|
720 |
|
|
721 |
(defun vc-cvs-parse-root (root) |
(defun vc-cvs-parse-root (root) |
722 |
"Split CVS ROOT specification string into a list of fields. |
"Split CVS ROOT specification string into a list of fields. |