comparison lisp/vc-rcs.el @ 81966:cedd5b77aae4

Put the lower half (the back-end) of NewVC in place. This commit makes only the minimum changes needed to get the old vc.el logic working with the new back ends.

81965:88498b7a5bb5

				 function)))
  :version "21.1"
  :group 'vc)


;;;
;;; State-querying functions
;;;

;;; The autoload cookie below places vc-rcs-registered directly into


;;;
;;; State-changing functions
;;;

(defun vc-rcs-register (file &optional rev comment)
  "Register FILE into the RCS version-control system.
REV is the optional revision number for the file.  COMMENT can be used
to provide an initial description of FILE.

`vc-register-switches' and `vc-rcs-register-switches' are passed to
the RCS command (in that order).

Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
    (let ((subdir (expand-file-name "RCS" (file-name-directory file))))
      (and (not (file-exists-p subdir))
	   (not (directory-files (file-name-directory file)
				 nil ".*,v$" t))
	   (yes-or-no-p "Create RCS subdirectory? ")
	   (make-directory subdir))

                                (file-name-directory file))))))
        (vc-file-setprop file 'vc-workfile-version
                         (if (re-search-forward
                              "^initial revision: \\([0-9.]+\\).*\n"
                              nil t)
                             (match-string 1))))))

(defun vc-rcs-responsible-p (file)
  "Return non-nil if RCS thinks it would be responsible for registering FILE."
  ;; TODO: check for all the patterns in vc-rcs-master-templates
  (file-directory-p (expand-file-name "RCS" (file-name-directory file))))

	 (not (directory-files dir nil
			       "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
	 (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
	 (delete-directory dir))))

(defun vc-rcs-checkin (file rev comment)
  "RCS-specific version of `vc-backend-checkin'."
  (let ((switches (vc-switches 'RCS 'checkin)))
    (let ((old-version (vc-workfile-version file)) new-version
	  (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
      ;; Force branch creation if an appropriate
      ;; default branch has been set.
      (and (not rev)
	   default-branch
	   (string-match (concat "^" (regexp-quote old-version) "\\.")
			 default-branch)
	   (setq rev default-branch)
	   (setq switches (cons "-f" switches)))
      (if (and (not rev) old-version)
          (setq rev (vc-branch-part old-version)))
      (apply 'vc-do-command nil 0 "ci" (vc-name file)
	     ;; if available, use the secure check-in option
	     (and (vc-rcs-release-p "5.6.4") "-j")
	     (concat (if vc-keep-workfiles "-u" "-r") rev)
	     (concat "-m" comment)
	     switches)
      (vc-file-setprop file 'vc-workfile-version nil)

      ;; determine the new workfile version
      (set-buffer "*vc*")
      (goto-char (point-min))
      (when (or (re-search-forward
		 "new revision: \\([0-9.]+\\);" nil t)
		(re-search-forward
		 "reverting to previous revision \\([0-9.]+\\)" nil t))
	(setq new-version (match-string 1))
	(vc-file-setprop file 'vc-workfile-version new-version))

      ;; if we got to a different branch, adjust the default
      ;; branch accordingly
      (cond
       ((and old-version new-version
	     (not (string= (vc-branch-part old-version)
			   (vc-branch-part new-version))))
	(vc-rcs-set-default-branch file
				   (if (vc-trunk-p new-version) nil
				     (vc-branch-part new-version)))
	;; If this is an old RCS release, we might have
	;; to remove a remaining lock.
	(if (not (vc-rcs-release-p "5.6.2"))
	    ;; exit status of 1 is also accepted.
	    ;; It means that the lock was removed before.
	    (vc-do-command nil 1 "rcs" (vc-name file)
			   (concat "-u" old-version))))))))

(defun vc-rcs-find-version (file rev buffer)
  (apply 'vc-do-command
	 buffer 0 "co" (vc-name file)
	 "-q" ;; suppress diagnostic output

		      (if (vc-trunk-p new-version) nil
			(vc-branch-part new-version))
		    new-version)))))
	(message "Checking out %s...done" file)))))

(defun vc-rcs-revert (file &optional contents-done)
  "Revert FILE to the version it was based on."
  (vc-do-command nil 0 "co" (vc-name file) "-f"
                 (concat (if (eq (vc-state file) 'edited) "-u" "-r")
                         (vc-workfile-version file))))

(defun vc-rcs-cancel-version (file editable)
  "Undo the most recent checkin of FILE.
EDITABLE non-nil means previous version should be locked."
  (let* ((target (vc-workfile-version file))
	 (previous (if (vc-trunk-p target) "" (vc-branch-part target)))
	 (config (current-window-configuration))
	 (done nil))
    (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
    ;; Check out the most recent remaining version.  If it fails, because
    ;; the whole branch got deleted, do a double-take and check out the
    ;; version where the branch started.
    (while (not done)
      (condition-case err
	  (progn
	    (vc-do-command nil 0 "co" (vc-name file) "-f"
			   (concat (if editable "-l" "-u") previous))
	    (setq done t))
	(error (set-buffer "*vc*")
	       (goto-char (point-min))
	       (if (search-forward "no side branches present for" nil t)
		   (progn (setq previous (vc-branch-part previous))
			  (vc-rcs-set-default-branch file previous)
			  ;; vc-do-command popped up a window with
			  ;; the error message.  Get rid of it, by
			  ;; restoring the old window configuration.
			  (set-window-configuration config))
		 ;; No, it was some other error: re-signal it.
		 (signal (car err) (cdr err))))))))

(defun vc-rcs-merge (file first-version &optional second-version)
  "Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
  (vc-do-command nil 1 "rcsmerge" (vc-name file)


;;;
;;; History functions
;;;

(defun vc-rcs-print-log (file &optional buffer)
  "Get change log associated with FILE."
  (vc-do-command buffer 0 "rlog" (vc-name file)))

(defun vc-rcs-diff (file &optional oldvers newvers buffer)
  "Get a difference report using RCS between two versions of FILE."
  (if (not oldvers) (setq oldvers (vc-workfile-version file)))
  (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file
         (append (list "-q"
                       (concat "-r" oldvers)
                       (and newvers (concat "-r" newvers)))
                 (vc-switches 'RCS 'diff))))

(defun vc-rcs-annotate-command (file buffer &optional revision)
  "Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from."
  (vc-setup-buffer buffer)

                      (apply 'concat
                             (format-time-string "%Y-%m-%d" (aref rda 1))
                             "  "
                             (aref rda 0)
                             ls)
                      :vc-annotate-prefix t
                      :vc-rcs-r/d/a rda)))
        (maphash
         (if all-me
             (lambda (rda w)
               (puthash rda (render rda (pad w) ": ") ht))

81966:cedd5b77aae4

				 function)))
  :version "21.1"
  :group 'vc)


;;; Properties of the backend

(defun vc-rcs-revision-granularity ()
     'file)

;;;
;;; State-querying functions
;;;

;;; The autoload cookie below places vc-rcs-registered directly into


;;;
;;; State-changing functions
;;;

(defun vc-rcs-create-repo ()
  "Create a new RCS repository."
  ;; RCS is totally file-oriented, so all we have to do is make the directory
  (make-directory "RCS"))

(defun vc-rcs-register (files &optional rev comment)
  "Register FILES into the RCS version-control system.
REV is the optional revision number for the files.  COMMENT can be used
to provide an initial description for each FILES.

`vc-register-switches' and `vc-rcs-register-switches' are passed to
the RCS command (in that order).

Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
  (let ((subdir (expand-file-name "RCS" (file-name-directory file))))
    (dolist (file files)
      (and (not (file-exists-p subdir))
	   (not (directory-files (file-name-directory file)
				 nil ".*,v$" t))
	   (yes-or-no-p "Create RCS subdirectory? ")
	   (make-directory subdir))

                                (file-name-directory file))))))
        (vc-file-setprop file 'vc-workfile-version
                         (if (re-search-forward
                              "^initial revision: \\([0-9.]+\\).*\n"
                              nil t)
                             (match-string 1)))))))

(defun vc-rcs-responsible-p (file)
  "Return non-nil if RCS thinks it would be responsible for registering FILE."
  ;; TODO: check for all the patterns in vc-rcs-master-templates
  (file-directory-p (expand-file-name "RCS" (file-name-directory file))))

	 (not (directory-files dir nil
			       "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
	 (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
	 (delete-directory dir))))

(defun vc-rcs-checkin (files rev comment)
  "RCS-specific version of `vc-backend-checkin'."
  (let ((switches (vc-switches 'RCS 'checkin)))
    ;; Now operate on the files
    (dolist (file files)
      (let ((old-version (vc-workfile-version file)) new-version
	    (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
	;; Force branch creation if an appropriate
	;; default branch has been set.
	(and (not rev)
	     default-branch
	     (string-match (concat "^" (regexp-quote old-version) "\\.")
			   default-branch)
	     (setq rev default-branch)
	     (setq switches (cons "-f" switches)))
	(if (and (not rev) old-version)
	    (setq rev (vc-branch-part old-version)))
	(apply 'vc-do-command nil 0 "ci" (vc-name file)
	       ;; if available, use the secure check-in option
	       (and (vc-rcs-release-p "5.6.4") "-j")
	       (concat (if vc-keep-workfiles "-u" "-r") rev)
	       (concat "-m" comment)
	       switches)
	(vc-file-setprop file 'vc-workfile-version nil)

	;; determine the new workfile version
	(set-buffer "*vc*")
	(goto-char (point-min))
	(when (or (re-search-forward
		   "new revision: \\([0-9.]+\\);" nil t)
		  (re-search-forward
		   "reverting to previous revision \\([0-9.]+\\)" nil t))
	  (setq new-version (match-string 1))
	  (vc-file-setprop file 'vc-workfile-version new-version))

	;; if we got to a different branch, adjust the default
	;; branch accordingly
	(cond
	 ((and old-version new-version
	       (not (string= (vc-branch-part old-version)
			     (vc-branch-part new-version))))
	  (vc-rcs-set-default-branch file
				     (if (vc-trunk-p new-version) nil
				       (vc-branch-part new-version)))
	  ;; If this is an old RCS release, we might have
	  ;; to remove a remaining lock.
	  (if (not (vc-rcs-release-p "5.6.2"))
	      ;; exit status of 1 is also accepted.
	      ;; It means that the lock was removed before.
	      (vc-do-command nil 1 "rcs" (vc-name file)
			     (concat "-u" old-version)))))))))

(defun vc-rcs-find-version (file rev buffer)
  (apply 'vc-do-command
	 buffer 0 "co" (vc-name file)
	 "-q" ;; suppress diagnostic output

		      (if (vc-trunk-p new-version) nil
			(vc-branch-part new-version))
		    new-version)))))
	(message "Checking out %s...done" file)))))

(defun vc-rcs-rollback (files)
  "Roll back, undoing the most recent checkins of FILES."
  (if (not files)
      (error "RCS backend doesn't support directory-level rollback."))
  (dolist (file files)
	  (let* ((discard (vc-workfile-version file))
		 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
		 (config (current-window-configuration))
		 (done nil))
	    (if (null (yes-or-no-p (format "Remove version %s from %s history? " 
					   discard file)))
		(error "Aborted"))
	    (message "Removing revision %s from %s." discard file)
	    (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard))
	    ;; Check out the most recent remaining version.  If it
	    ;; fails, because the whole branch got deleted, do a
	    ;; double-take and check out the version where the branch
	    ;; started.
	    (while (not done)
	      (condition-case err
		  (progn
		    (vc-do-command nil 0 "co" (vc-name file) "-f"
				   (concat "-u" previous))
		    (setq done t))
		(error (set-buffer "*vc*")
		       (goto-char (point-min))
		       (if (search-forward "no side branches present for" nil t)
			   (progn (setq previous (vc-branch-part previous))
				  (vc-rcs-set-default-branch file previous)
				  ;; vc-do-command popped up a window with
				  ;; the error message.  Get rid of it, by
				  ;; restoring the old window configuration.
				  (set-window-configuration config))
			 ;; No, it was some other error: re-signal it.
			 (signal (car err) (cdr err)))))))))

(defun vc-rcs-revert (file &optional contents-done)
  "Revert FILE to the version it was based on."
  (vc-do-command nil 0 "co" (vc-name file) "-f"
                 (concat (if (eq (vc-state file) 'edited) "-u" "-r")
                         (vc-workfile-version file))))

(defun vc-rcs-merge (file first-version &optional second-version)
  "Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
  (vc-do-command nil 1 "rcsmerge" (vc-name file)


;;;
;;; History functions
;;;

(defun vc-rcs-print-log (files &optional buffer)
  "Get change log associated with FILE."
  (vc-do-command buffer 0 "rlog" (mapcar 'vc-name files)))

(defun vc-rcs-diff (files &optional oldvers newvers buffer)
  "Get a difference report using RCS between two sets of files."
  (apply 'vc-do-command (or buffer "*vc-diff*") 
	 1		;; Always go synchronous, the repo is local
	 "rcsdiff" (vc-expand-dirs files)
         (append (list "-q"
                       (and oldvers (concat "-r" oldvers))
                       (and newvers (concat "-r" newvers)))
                 (vc-switches 'RCS 'diff))))

(defun vc-rcs-wash-log ()
  "Remove all non-comment information from log output."
  (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
			   "\\(branches: .*;\n\\)?"
			   "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
    (goto-char (point-max)) (forward-line -1)
    (while (looking-at "=*\n")
      (delete-char (- (match-end 0) (match-beginning 0)))
      (forward-line -1))
    (goto-char (point-min))
    (if (looking-at "[\b\t\n\v\f\r ]+")
	(delete-char (- (match-end 0) (match-beginning 0))))
    (goto-char (point-min))
    (re-search-forward separator nil t)
    (delete-region (point-min) (point))
    (while (re-search-forward separator nil t)
      (delete-region (match-beginning 0) (match-end 0)))))

(defun vc-rcs-annotate-command (file buffer &optional revision)
  "Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from."
  (vc-setup-buffer buffer)

                      (apply 'concat
                             (format-time-string "%Y-%m-%d" (aref rda 1))
                             "  "
                             (aref rda 0)
                             ls)
                      :vc-rcs-r/d/a rda)))
        (maphash
         (if all-me
             (lambda (rda w)
               (puthash rda (render rda (pad w) ": ") ht))