diff --git a/lisp/vc.el b/lisp/vc.el index 9a71286..9b3be27 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -1012,166 +1012,168 @@ with the logmessage as change commentary. A writable file is retained. If the repository file is changed, you are asked if you want to merge in the changes into your working copy." (interactive "P") - (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) - (backend (car vc-fileset)) - (files (nth 1 vc-fileset)) - (fileset-only-files (nth 2 vc-fileset)) - ;; FIXME: We used to call `vc-recompute-state' here. - (state (nth 3 vc-fileset)) - ;; The backend should check that the checkout-model is consistent - ;; among all the `files'. - (model (nth 4 vc-fileset)) - revision) - - ;; Do the right thing - (cond - ((eq state 'missing) - (error "Fileset files are missing, so cannot be operated on")) - ((eq state 'ignored) - (error "Fileset files are ignored by the version-control system")) - ((or (null state) (eq state 'unregistered)) - (vc-register nil vc-fileset)) - ;; Files are up-to-date, or need a merge and user specified a revision - ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) - (cond - (verbose - ;; go to a different revision - (setq revision (read-string "Branch, revision, or backend to move to: ")) - (let ((revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends)) - (let ((vsym (intern-soft revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (dolist (file files) - (vc-checkout file (eq model 'implicit) revision))))) - ((not (eq model 'implicit)) - ;; check the files out - (dolist (file files) (vc-checkout file t))) - (t - ;; do nothing - (message "Fileset is up-to-date")))) - ;; Files have local changes - ((vc-compatible-state state 'edited) - (let ((ready-for-commit files)) - ;; If files are edited but read-only, give user a chance to correct - (dolist (file files) - (unless (file-writable-p file) - ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) - (error "Aborted")) - (set-file-modes file (logior (file-modes file) 128)) - (let ((visited (get-file-buffer file))) - (when visited - (with-current-buffer visited - (toggle-read-only -1)))))) - ;; Allow user to revert files with no changes - (save-excursion + (save-excursion + (save-window-excursion + (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) + (backend (car vc-fileset)) + (files (nth 1 vc-fileset)) + (fileset-only-files (nth 2 vc-fileset)) + ;; FIXME: We used to call `vc-recompute-state' here. + (state (nth 3 vc-fileset)) + ;; The backend should check that the checkout-model is consistent + ;; among all the `files'. + (model (nth 4 vc-fileset)) + revision) + + ;; Do the right thing + (cond + ((eq state 'missing) + (error "Fileset files are missing, so cannot be operated on")) + ((eq state 'ignored) + (error "Fileset files are ignored by the version-control system")) + ((or (null state) (eq state 'unregistered)) + (vc-register nil vc-fileset)) + ;; Files are up-to-date, or need a merge and user specified a revision + ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) + (cond + (verbose + ;; go to a different revision + (setq revision (read-string "Branch, revision, or backend to move to: ")) + (let ((revision-downcase (downcase revision))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends)) + (let ((vsym (intern-soft revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) + (dolist (file files) + (vc-checkout file (eq model 'implicit) revision))))) + ((not (eq model 'implicit)) + ;; check the files out + (dolist (file files) (vc-checkout file t))) + (t + ;; do nothing + (message "Fileset is up-to-date")))) + ;; Files have local changes + ((vc-compatible-state state 'edited) + (let ((ready-for-commit files)) + ;; If files are edited but read-only, give user a chance to correct + (dolist (file files) + (unless (file-writable-p file) + ;; Make the file+buffer read-write. + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) + (error "Aborted")) + (set-file-modes file (logior (file-modes file) 128)) + (let ((visited (get-file-buffer file))) + (when visited + (with-current-buffer visited + (toggle-read-only -1)))))) + ;; Allow user to revert files with no changes + (save-excursion + (dolist (file files) + (let ((visited (get-file-buffer file))) + ;; For files with locking, if the file does not contain + ;; any changes, just let go of the lock, i.e. revert. + (when (and (not (eq model 'implicit)) + (vc-workfile-unchanged-p file) + ;; If buffer is modified, that means the user just + ;; said no to saving it; in that case, don't revert, + ;; because the user might intend to save after + ;; finishing the log entry and committing. + (not (and visited (buffer-modified-p)))) + (vc-revert-file file) + (setq ready-for-commit (delete file ready-for-commit)))))) + ;; Remaining files need to be committed + (if (not ready-for-commit) + (message "No files remain to be committed") + (if (not verbose) + (vc-checkin ready-for-commit backend) + (setq revision (read-string "New revision or backend: ")) + (let ((revision-downcase (downcase revision))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) + (let ((vsym (intern revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) + (vc-checkin ready-for-commit backend revision))))))) + ;; locked by somebody else (locking VCSes only) + ((stringp state) + ;; In the old days, we computed the revision once and used it on + ;; the single file. Then, for the 2007-2008 fileset rewrite, we + ;; computed the revision once (incorrectly, using a free var) and + ;; used it on all files. To fix the free var bug, we can either + ;; use `(car files)' or do what we do here: distribute the + ;; revision computation among `files'. Although this may be + ;; tedious for those backends where a "revision" is a trans-file + ;; concept, it is nonetheless correct for both those and (more + ;; importantly) for those where "revision" is a per-file concept. + ;; If the intersection of the former group and "locking VCSes" is + ;; non-empty [I vaguely doubt it --ttn], we can reinstate the + ;; pre-computation approach of yore. + (dolist (file files) + (vc-steal-lock + file (if verbose + (read-string (format "%s revision to steal: " file)) + (vc-working-revision file)) + state))) + ;; conflict + ((eq state 'conflict) + ;; FIXME: Is it really the UI we want to provide? + ;; In my experience, the conflicted files should be marked as resolved + ;; one-by-one when saving the file after resolving the conflicts. + ;; I.e. stating explicitly that the conflicts are resolved is done + ;; very rarely. + (vc-mark-resolved backend files)) + ;; needs-update + ((eq state 'needs-update) (dolist (file files) - (let ((visited (get-file-buffer file))) - ;; For files with locking, if the file does not contain - ;; any changes, just let go of the lock, i.e. revert. + (if (yes-or-no-p (format + "%s is not up-to-date. Get latest revision? " + (file-name-nondirectory file))) + (vc-checkout file (eq model 'implicit) t) (when (and (not (eq model 'implicit)) - (vc-workfile-unchanged-p file) - ;; If buffer is modified, that means the user just - ;; said no to saving it; in that case, don't revert, - ;; because the user might intend to save after - ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p)))) - (vc-revert-file file) - (setq ready-for-commit (delete file ready-for-commit)))))) - ;; Remaining files need to be committed - (if (not ready-for-commit) - (message "No files remain to be committed") - (if (not verbose) - (vc-checkin ready-for-commit backend) - (setq revision (read-string "New revision or backend: ")) - (let ((revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) - (let ((vsym (intern revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (vc-checkin ready-for-commit backend revision))))))) - ;; locked by somebody else (locking VCSes only) - ((stringp state) - ;; In the old days, we computed the revision once and used it on - ;; the single file. Then, for the 2007-2008 fileset rewrite, we - ;; computed the revision once (incorrectly, using a free var) and - ;; used it on all files. To fix the free var bug, we can either - ;; use `(car files)' or do what we do here: distribute the - ;; revision computation among `files'. Although this may be - ;; tedious for those backends where a "revision" is a trans-file - ;; concept, it is nonetheless correct for both those and (more - ;; importantly) for those where "revision" is a per-file concept. - ;; If the intersection of the former group and "locking VCSes" is - ;; non-empty [I vaguely doubt it --ttn], we can reinstate the - ;; pre-computation approach of yore. - (dolist (file files) - (vc-steal-lock - file (if verbose - (read-string (format "%s revision to steal: " file)) - (vc-working-revision file)) - state))) - ;; conflict - ((eq state 'conflict) - ;; FIXME: Is it really the UI we want to provide? - ;; In my experience, the conflicted files should be marked as resolved - ;; one-by-one when saving the file after resolving the conflicts. - ;; I.e. stating explicitly that the conflicts are resolved is done - ;; very rarely. - (vc-mark-resolved backend files)) - ;; needs-update - ((eq state 'needs-update) - (dolist (file files) - (if (yes-or-no-p (format - "%s is not up-to-date. Get latest revision? " - (file-name-nondirectory file))) - (vc-checkout file (eq model 'implicit) t) - (when (and (not (eq model 'implicit)) - (yes-or-no-p "Lock this revision? ")) - (vc-checkout file t))))) - ;; needs-merge - ((eq state 'needs-merge) - (dolist (file files) - (when (yes-or-no-p (format - "%s is not up-to-date. Merge in changes now? " - (file-name-nondirectory file))) - (vc-maybe-resolve-conflicts - file (vc-call-backend backend 'merge-news file))))) - - ;; unlocked-changes - ((eq state 'unlocked-changes) - (dolist (file files) - (when (not (equal buffer-file-name file)) - (find-file-other-window file)) - (if (save-window-excursion - (vc-diff-internal nil - (cons (car vc-fileset) (cons (cadr vc-fileset) (list file))) - (vc-working-revision file) nil) - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (insert - (format "Changes to %s since last lock:\n\n" file))) - (not (beep)) - (yes-or-no-p (concat "File has unlocked changes. " - "Claim lock retaining changes? "))) - (progn (vc-call-backend backend 'steal-lock file) - (clear-visited-file-modtime) - ;; Must clear any headers here because they wouldn't - ;; show that the file is locked now. - (vc-clear-headers file) - (write-file buffer-file-name) - (vc-mode-line file backend)) - (if (not (yes-or-no-p - "Revert to checked-in revision, instead? ")) - (error "Checkout aborted") - (vc-revert-buffer-internal t t) - (vc-checkout file t))))) - ;; Unknown fileset state - (t - (error "Fileset is in an unknown state %s" state))))) + (yes-or-no-p "Lock this revision? ")) + (vc-checkout file t))))) + ;; needs-merge + ((eq state 'needs-merge) + (dolist (file files) + (when (yes-or-no-p (format + "%s is not up-to-date. Merge in changes now? " + (file-name-nondirectory file))) + (vc-maybe-resolve-conflicts + file (vc-call-backend backend 'merge-news file))))) + + ;; unlocked-changes + ((eq state 'unlocked-changes) + (dolist (file files) + (when (not (equal buffer-file-name file)) + (find-file-other-window file)) + (if (save-window-excursion + (vc-diff-internal nil + (cons (car vc-fileset) (cons (cadr vc-fileset) (list file))) + (vc-working-revision file) nil) + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (insert + (format "Changes to %s since last lock:\n\n" file))) + (not (beep)) + (yes-or-no-p (concat "File has unlocked changes. " + "Claim lock retaining changes? "))) + (progn (vc-call-backend backend 'steal-lock file) + (clear-visited-file-modtime) + ;; Must clear any headers here because they wouldn't + ;; show that the file is locked now. + (vc-clear-headers file) + (write-file buffer-file-name) + (vc-mode-line file backend)) + (if (not (yes-or-no-p + "Revert to checked-in revision, instead? ")) + (error "Checkout aborted") + (vc-revert-buffer-internal t t) + (vc-checkout file t))))) + ;; Unknown fileset state + (t + (error "Fileset is in an unknown state %s" state))))))) (defun vc-create-repo (backend) "Create an empty repository in the current directory." @@ -1269,21 +1271,21 @@ After check-out, runs the normal hook `vc-checkout-hook'." (vc-make-version-backup file)) (let ((backend (vc-backend file))) (with-vc-properties (list file) - (condition-case err - (vc-call-backend backend 'checkout file writable rev) - (file-error - ;; Maybe the backend is not installed ;-( - (when writable - (let ((buf (get-file-buffer file))) - (when buf (with-current-buffer buf (toggle-read-only -1))))) - (signal (car err) (cdr err)))) - `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) - (not writable)) - (if (vc-call-backend backend 'latest-on-branch-p file) - 'up-to-date - 'needs-update) - 'edited)) - (vc-checkout-time . ,(nth 5 (file-attributes file)))))) + (condition-case err + (vc-call-backend backend 'checkout file writable rev) + (file-error + ;; Maybe the backend is not installed ;-( + (when writable + (let ((buf (get-file-buffer file))) + (when buf (with-current-buffer buf (toggle-read-only -1))))) + (signal (car err) (cdr err)))) + `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) + (not writable)) + (if (vc-call-backend backend 'latest-on-branch-p file) + 'up-to-date + 'needs-update) + 'edited)) + (vc-checkout-time . ,(nth 5 (file-attributes file)))))) (vc-resynch-buffer file t t) (run-hooks 'vc-checkout-hook)) @@ -1343,29 +1345,29 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (when vc-before-checkin-hook (run-hooks 'vc-before-checkin-hook)) (lexical-let - ((backend backend)) - (vc-start-logentry - files rev comment initial-contents - "Enter a change comment." - "*VC-log*" - (lambda (files rev comment) - (message "Checking in %s..." (vc-delistify files)) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (with-vc-properties - files - ;; We used to change buffers to get local value of vc-checkin-switches, - ;; but 'the' local buffer is not a well-defined concept for filesets. - (progn - (vc-call-backend backend 'checkin files rev comment) - (mapc 'vc-delete-automatic-version-backups files)) - `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))) - 'vc-checkin-hook))) + ((backend backend)) + (vc-start-logentry + files rev comment initial-contents + "Enter a change comment." + "*VC-log*" + (lambda (files rev comment) + (message "Checking in %s..." (vc-delistify files)) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about white-space-only comments too. + (or (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (with-vc-properties + files + ;; We used to change buffers to get local value of vc-checkin-switches, + ;; but 'the' local buffer is not a well-defined concept for filesets. + (progn + (vc-call-backend backend 'checkin files rev comment) + (mapc 'vc-delete-automatic-version-backups files)) + `((vc-state . up-to-date) + (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files))) + 'vc-checkin-hook))) ;;; Additional entry points for examining version histories @@ -1419,7 +1421,7 @@ to override the value of `vc-diff-switches' and `diff-switches'." (let ((sym (vc-make-backend-sym backend (intern (concat (symbol-name op) "-switches"))))) - (when (boundp sym) (symbol-value sym)))) + (when (boundp sym) (symbol-value sym)))) (let ((sym (intern (format "vc-%s-switches" (symbol-name op))))) (when (boundp sym) (symbol-value sym))) (cond @@ -1640,8 +1642,8 @@ If `F.~REV~' already exists, use it instead of checking it out again." (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (revision (if (string-equal rev "") - (vc-working-revision file) - rev))) + (vc-working-revision file) + rev))) (switch-to-buffer-other-window (vc-find-revision file revision)))) (defun vc-find-revision (file revision) @@ -1711,17 +1713,17 @@ The headers are reset to their non-expanded form." (visited (find-buffer-visiting filename)) (backend (vc-backend filename))) (when (vc-find-backend-function backend 'clear-headers) - (if visited - (let ((context (vc-buffer-context))) - ;; save-excursion may be able to relocate point and mark - ;; properly. If it fails, vc-restore-buffer-context - ;; will give it a second try. - (save-excursion - (vc-call-backend backend 'clear-headers)) - (vc-restore-buffer-context context)) - (set-buffer (find-file-noselect filename)) - (vc-call-backend backend 'clear-headers) - (kill-buffer filename))))) + (if visited + (let ((context (vc-buffer-context))) + ;; save-excursion may be able to relocate point and mark + ;; properly. If it fails, vc-restore-buffer-context + ;; will give it a second try. + (save-excursion + (vc-call-backend backend 'clear-headers)) + (vc-restore-buffer-context context)) + (set-buffer (find-file-noselect filename)) + (vc-call-backend backend 'clear-headers) + (kill-buffer filename))))) (defun vc-modify-change-comment (files rev oldcomment) "Edit the comment associated with the given files and revision." @@ -2418,7 +2420,7 @@ to provide the `find-revision' operation instead." (defun vc-default-show-log-entry (backend rev) (with-no-warnings - (log-view-goto-rev rev))) + (log-view-goto-rev rev))) (defun vc-default-comment-history (backend file) "Return a string with all log entries stored in BACKEND for FILE." @@ -2437,10 +2439,10 @@ to provide the `find-revision' operation instead." (vc-file-tree-walk dir (lambda (f) (and - (vc-up-to-date-p f) - (vc-error-occurred - (vc-call-backend backend 'checkout f nil "") - (when update (vc-resynch-buffer f t t))))))) + (vc-up-to-date-p f) + (vc-error-occurred + (vc-call-backend backend 'checkout f nil "") + (when update (vc-resynch-buffer f t t))))))) (let ((result (vc-tag-precondition dir))) (if (stringp result) (error "File %s is locked" result) @@ -2448,8 +2450,8 @@ to provide the `find-revision' operation instead." (vc-file-tree-walk dir (lambda (f) (vc-error-occurred - (vc-call-backend backend 'checkout f nil name) - (when update (vc-resynch-buffer f t t))))))))) + (vc-call-backend backend 'checkout f nil name) + (when update (vc-resynch-buffer f t t))))))))) (defun vc-default-revert (backend file contents-done) (unless contents-done @@ -2513,13 +2515,13 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it." (let ((dir (file-name-as-directory file))) (mapcar (lambda (f) (or - (string-equal f ".") - (string-equal f "..") - (member f vc-directory-exclusion-list) - (let ((dirf (expand-file-name f dir))) - (or - (file-symlink-p dirf) ;; Avoid possible loops. - (vc-file-tree-walk-internal dirf func args))))) + (string-equal f ".") + (string-equal f "..") + (member f vc-directory-exclusion-list) + (let ((dirf (expand-file-name f dir))) + (or + (file-symlink-p dirf) ;; Avoid possible loops. + (vc-file-tree-walk-internal dirf func args))))) (directory-files dir))))) (provide 'vc)