Commit 7f9b0372 authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent bb13183c
2015-03-01 Michael Albinus <michael.albinus@gmx.de>
* 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 <larsi@gnus.org>
 
* net/shr.el (shr-insert): Remove soft hyphens.
......
......@@ -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))))))
......
......@@ -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.
......
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment