/[emacs]/emacs/lisp/vc-cvs.el
ViewVC logotype

Diff of /emacs/lisp/vc-cvs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.61 by spiegel, Fri May 23 17:57:29 2003 UTC revision 1.62 by monnier, Fri Jul 4 22:40:26 2003 UTC
# Line 1  Line 1 
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>
# Line 191  See also variable `vc-cvs-sticky-date-fo Line 191  See also variable `vc-cvs-sticky-date-fo
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.
# Line 217  See also variable `vc-cvs-sticky-date-fo Line 217  See also variable `vc-cvs-sticky-date-fo
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
# Line 286  COMMENT can be used to provide an initia Line 286  COMMENT can be used to provide an initia
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)
# Line 299  the CVS command (in that order)." Line 303  the CVS command (in that order)."
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'."
# Line 443  REV is the revision to check out into WO Line 456  REV is the revision to check out into WO
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
# Line 533  The changes are between FIRST-VERSION an Line 537  The changes are between FIRST-VERSION an
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)
# Line 550  The changes are between FIRST-VERSION an Line 554  The changes are between FIRST-VERSION an
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"
# Line 563  The changes are between FIRST-VERSION an Line 567  The changes are between FIRST-VERSION an
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
# Line 673  If UPDATE is non-nil, then update (resyn Line 677  If UPDATE is non-nil, then update (resyn
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 ()
# Line 698  and that it passes `vc-cvs-global-switch Line 702  and that it passes `vc-cvs-global-switch
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.
Legend:
Removed from v.1.61  
changed lines
  Added in v.1.62
savannah-hackers-public@gnu.org
 ViewVC Help
Powered by ViewVC 1.1.26