[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 7f9b037: Fix problems found by vc-tests.el
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 7f9b037: Fix problems found by vc-tests.el |
|
Date: |
Sun, 01 Mar 2015 16:52:06 +0000 |
branch: master
commit 7f9b037245ddb662ad98685e429a2498ae6b7c62
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Fix problems found by vc-tests.el
* vc/vc-hooks.el (vc-state, vc-working-revision):
Use `vc-responsible-backend' in order to support unregistered files.
* vc/vc-rcs.el (vc-rcs-fetch-master-state):
* vc/vc-sccs.el (vc-sccs-working-revision): Handle undefined
master name.
* vc/vc-rcs.el (vc-rcs-unregister): Support unregistered files.
* vc/vc-src.el (vc-src-working-revision): Do not return an empty string.
---
lisp/ChangeLog | 13 ++++
lisp/vc/vc-hooks.el | 4 +-
lisp/vc/vc-rcs.el | 164 ++++++++++++++++++++++++++-------------------------
lisp/vc/vc-sccs.el | 15 +++--
lisp/vc/vc-src.el | 8 +-
5 files changed, 110 insertions(+), 94 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1bcc4f1..3a8cfb9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2015-03-01 Michael Albinus <address@hidden>
+
+ * vc/vc-hooks.el (vc-state, vc-working-revision):
+ Use `vc-responsible-backend' in order to support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-unregister): Support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-fetch-master-state):
+ * vc/vc-sccs.el (vc-sccs-working-revision): Handle undefined
+ master name.
+
+ * vc/vc-src.el (vc-src-working-revision): Do not return an empty string.
+
2015-03-01 Lars Magne Ingebrigtsen <address@hidden>
* net/shr.el (shr-insert): Remove soft hyphens.
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 7801f4f..251fecb 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -476,7 +476,7 @@ status of this file. Otherwise, the value returned is one
of:
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
(when (> (length file) 0) ;Why?? --Stef
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-state-refresh file backend)))))
@@ -495,7 +495,7 @@ status of this file. Otherwise, the value returned is one
of:
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
(progn
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend backend 'working-revision file))))))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index d575530..8aedc00 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -288,20 +288,21 @@ to the RCS command."
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-master-name file))
- (dir (file-name-directory master))
- (backup-info (find-backup-file-name master)))
- (if (not backup-info)
- (delete-file master)
- (rename-file master (car backup-info) 'ok-if-already-exists)
- (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
- (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
- ;; check whether RCS dir is empty, i.e. it does not
- ;; contain any files except "." and ".."
- (not (directory-files dir nil
- "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
- (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
- (delete-directory dir))))
+ (unless (memq (vc-state file) '(nil unregistered))
+ (let* ((master (vc-master-name file))
+ (dir (file-name-directory master))
+ (backup-info (find-backup-file-name master)))
+ (if (not backup-info)
+ (delete-file master)
+ (rename-file master (car backup-info) 'ok-if-already-exists)
+ (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
+ (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
+ ;; check whether RCS dir is empty, i.e. it does not
+ ;; contain any files except "." and ".."
+ (not (directory-files dir nil
+ "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
+ (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
+ (delete-directory dir)))))
;; It used to be possible to pass in a value for the variable rev, but
;; nothing in the rest of VC used this capability. Removing it makes the
@@ -971,74 +972,75 @@ otherwise determine the workfile version based on the
master file.
This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
- (with-temp-buffer
- (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
- (progn (goto-char (point-min))
- (not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-master-name file)))
- (let ((workfile-is-latest nil)
- (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
- (vc-file-setprop file 'vc-rcs-default-branch default-branch)
- (unless working-revision
- ;; Workfile version not known yet. Determine that first. It
- ;; is either the head of the trunk, the head of the default
- ;; branch, or the "default branch" itself, if that is a full
- ;; revision number.
- (cond
- ;; no default branch
- ((or (not default-branch) (string= "" default-branch))
- (setq working-revision
- (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
- (setq workfile-is-latest t))
- ;; default branch is actually a revision
- ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
- default-branch)
- (setq working-revision default-branch))
- ;; else, search for the head of the default branch
- (t (vc-insert-file (vc-master-name file) "^desc")
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
+ (progn (goto-char (point-min))
+ (not (looking-at "^head[ \t\n]+[^;]+;$"))))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
+ (let ((workfile-is-latest nil)
+ (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
+ (vc-file-setprop file 'vc-rcs-default-branch default-branch)
+ (unless working-revision
+ ;; Workfile version not known yet. Determine that first. It
+ ;; is either the head of the trunk, the head of the default
+ ;; branch, or the "default branch" itself, if that is a full
+ ;; revision number.
+ (cond
+ ;; no default branch
+ ((or (not default-branch) (string= "" default-branch))
(setq working-revision
- (vc-rcs-find-most-recent-rev default-branch))
- (setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-working-revision working-revision))
- ;; Check strict locking
- (goto-char (point-min))
- (vc-file-setprop file 'vc-checkout-model
- (if (re-search-forward ";[ \t\n]*strict;" nil t)
- 'locking 'implicit))
- ;; Compute state of workfile version
- (goto-char (point-min))
- (let ((locking-user
- (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
- (regexp-quote working-revision)
- "[^0-9.]")
- 1)))
- (cond
- ;; not locked
- ((not locking-user)
- (if (or workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- ;; workfile version is latest on branch
- 'up-to-date
- ;; workfile version is not latest on branch
- 'needs-update))
- ;; locked by the calling user
- ((and (stringp locking-user)
- (string= locking-user (vc-user-login-name file)))
- ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
- (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
- workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- 'edited
- ;; Locking is not used for the file, but the owner does
- ;; have a lock, and there is a higher version on the current
- ;; branch. Not sure if this can occur, and if it is right
- ;; to use `needs-merge' in this case.
- 'needs-merge))
- ;; locked by somebody else
- ((stringp locking-user)
- locking-user)
- (t
- (error "Error getting state of RCS file")))))))
+ (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
+ (setq workfile-is-latest t))
+ ;; default branch is actually a revision
+ ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
+ default-branch)
+ (setq working-revision default-branch))
+ ;; else, search for the head of the default branch
+ (t (vc-insert-file (vc-master-name file) "^desc")
+ (setq working-revision
+ (vc-rcs-find-most-recent-rev default-branch))
+ (setq workfile-is-latest t)))
+ (vc-file-setprop file 'vc-working-revision working-revision))
+ ;; Check strict locking
+ (goto-char (point-min))
+ (vc-file-setprop file 'vc-checkout-model
+ (if (re-search-forward ";[ \t\n]*strict;" nil t)
+ 'locking 'implicit))
+ ;; Compute state of workfile version
+ (goto-char (point-min))
+ (let ((locking-user
+ (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[
\t\n]+\\([^:]+\\):"
+ (regexp-quote working-revision)
+ "[^0-9.]")
+ 1)))
+ (cond
+ ;; not locked
+ ((not locking-user)
+ (if (or workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ ;; workfile version is latest on branch
+ 'up-to-date
+ ;; workfile version is not latest on branch
+ 'needs-update))
+ ;; locked by the calling user
+ ((and (stringp locking-user)
+ (string= locking-user (vc-user-login-name file)))
+ ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
+ (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
+ workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ 'edited
+ ;; Locking is not used for the file, but the owner does
+ ;; have a lock, and there is a higher version on the current
+ ;; branch. Not sure if this can occur, and if it is right
+ ;; to use `needs-merge' in this case.
+ 'needs-merge))
+ ;; locked by somebody else
+ ((stringp locking-user)
+ locking-user)
+ (t
+ (error "Error getting state of RCS file"))))))))
(defun vc-rcs-consult-headers (file)
"Search for RCS headers in FILE, and set properties accordingly.
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 1b959e2..8d8d9e8 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -149,13 +149,14 @@ For a description of possible values, see
`vc-check-master-templates'."
(defun vc-sccs-working-revision (file)
"SCCS-specific version of `vc-working-revision'."
- (with-temp-buffer
- ;; The working revision is always the latest revision number.
- ;; To find this number, search the entire delta table,
- ;; rather than just the first entry, because the
- ;; first entry might be a deleted ("R") revision.
- (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]")
- (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ ;; The working revision is always the latest revision number.
+ ;; To find this number, search the entire delta table,
+ ;; rather than just the first entry, because the
+ ;; first entry might be a deleted ("R") revision.
+ (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]")
+ (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))))
;; Cf vc-sccs-find-revision.
(defun vc-sccs-write-revision (file outfile &optional rev)
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index f497f95..d9aa1b1 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -200,10 +200,10 @@ This function differs from vc-do-command in that it
invokes `vc-src-program'."
(defun vc-src-working-revision (file)
"SRC-specific version of `vc-working-revision'."
- (or (ignore-errors
- (with-output-to-string
- (vc-src-command standard-output file "list" "-f{1}" "@")))
- "0"))
+ (let ((result (ignore-errors
+ (with-output-to-string
+ (vc-src-command standard-output file "list" "-f{1}" "@")))))
+ (if (zerop (length result)) "0" result)))
;;;
;;; State-changing functions
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 7f9b037: Fix problems found by vc-tests.el,
Michael Albinus <=