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.
This commit is contained in:
Michael Albinus
parent
bb13183c1b
commit
7f9b037245
5 changed files with 110 additions and 94 deletions
|
|
@ -1,3 +1,16 @@
|
|||
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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue