From: Michael Albinus Date: Sun, 1 Mar 2015 16:51:31 +0000 (+0100) Subject: Fix problems found by vc-tests.el X-Git-Tag: emacs-25.0.90~2564^2~266 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7f9b037245ddb662ad98685e429a2498ae6b7c62;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1bcc4f11912..3a8cfb98e8f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2015-03-01 Michael Albinus + + * 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 * net/shr.el (shr-insert): Remove soft hyphens. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 7801f4f8ed9..251fecb49c0 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 d575530c98b..8aedc00269d 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 1b959e22e23..8d8d9e844ed 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 f497f951005..d9aa1b13e88 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