# HG changeset patch # User Dan Nicolaescu # Date 1245738940 0 # Node ID af4ee0cb7fb7d3ebca529dc0647832639963d408 # Parent 0d7c31bf0a29a95ebe10f7e98ed4c850d35c7cd2 * vc-hooks.el (vc-stay-local-p, vc-state, vc-working-revision): Add an optional argument for the backend, use it instead of calling vc-backend. (vc-mode-line): Add an optional argument for the backend. Pass the backend to vc-state and vc-working-revision. Move code for special handling for vc-state being a buffer to ... * vc-rcs.el (vc-rcs-find-file-hook): * vc-sccs.el (vc-sccs-find-file-hook): ... here. New functions. * vc-svn.el (vc-svn-state, vc-svn-dir-status, vc-svn-checkout) (vc-svn-print-log, vc-svn-diff): Pass 'SVN to vc-state, vc-stay-local-p and vc-mode-line calls. * vc-cvs.el (vc-cvs-state, vc-cvs-checkout, vc-cvs-print-log) (vc-cvs-diff, vc-cvs-annotate-command) (vc-cvs-make-version-backups-p, vc-cvs-stay-local-p) (vc-cvs-dir-status): Pass 'CVS to vc-state, vc-stay-local-p and vc-mode-line calls. * vc.el (vc-deduce-fileset): Use vc-deduce-fileset instead of direct comparison. (vc-next-action, vc-transfer-file, vc-rename-file): Also pass the backend when calling vc-mode-line. (vc-register): Do not create a closure for calling the vc register function, call it directly. diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/ChangeLog --- a/lisp/ChangeLog Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/ChangeLog Tue Jun 23 06:35:40 2009 +0000 @@ -1,3 +1,32 @@ +2009-06-22 Dan Nicolaescu + + * vc-hooks.el (vc-stay-local-p, vc-state, vc-working-revision): + Add an optional argument for the backend, use it instead of + calling vc-backend. + (vc-mode-line): Add an optional argument for the backend. Pass + the backend to vc-state and vc-working-revision. Move code for + special handling for vc-state being a buffer to ... + + * vc-rcs.el (vc-rcs-find-file-hook): + * vc-sccs.el (vc-sccs-find-file-hook): ... here. New functions. + + * vc-svn.el (vc-svn-state, vc-svn-dir-status, vc-svn-checkout) + (vc-svn-print-log, vc-svn-diff): Pass 'SVN to vc-state, + vc-stay-local-p and vc-mode-line calls. + + * vc-cvs.el (vc-cvs-state, vc-cvs-checkout, vc-cvs-print-log) + (vc-cvs-diff, vc-cvs-annotate-command) + (vc-cvs-make-version-backups-p, vc-cvs-stay-local-p) + (vc-cvs-dir-status): Pass 'CVS to vc-state, vc-stay-local-p and + vc-mode-line calls. + + * vc.el (vc-deduce-fileset): Use vc-deduce-fileset instead of + direct comparison. + (vc-next-action, vc-transfer-file, vc-rename-file): Also pass the + backend when calling vc-mode-line. + (vc-register): Do not create a closure for calling the vc register + function, call it directly. + 2009-06-23 Dan Nicolaescu * emacs-lisp/elp.el (elp-output-insert-symname): Add a link face diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc-cvs.el --- a/lisp/vc-cvs.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc-cvs.el Tue Jun 23 06:35:40 2009 +0000 @@ -216,7 +216,7 @@ (defun vc-cvs-state (file) "CVS-specific version of `vc-state'." - (if (vc-stay-local-p file) + (if (vc-stay-local-p file 'CVS) (let ((state (vc-file-getprop file 'vc-state))) ;; If we should stay local, use the heuristic but only if ;; we don't have a more precise state already available. @@ -402,7 +402,7 @@ "-A" (concat "-r" rev)))) (vc-switches 'CVS 'checkout))) - (vc-mode-line file)) + (vc-mode-line file 'CVS)) (message "Checking out %s...done" file)) (defun vc-cvs-delete-file (file) @@ -496,7 +496,7 @@ ;; It's just the catenation of the individual logs. (vc-cvs-command buffer - (if (vc-stay-local-p files) 'async 0) + (if (vc-stay-local-p files 'CVS) 'async 0) files "log")) (defun vc-cvs-comment-history (file) @@ -506,7 +506,7 @@ (defun vc-cvs-diff (files &optional oldvers newvers buffer) "Get a difference report using CVS between two revisions of FILE." (let* ((async (and (not vc-disable-async-diff) - (vc-stay-local-p files))) + (vc-stay-local-p files 'CVS))) (invoke-cvs-diff-list nil) status) ;; Look through the file list and see if any files have backups @@ -559,7 +559,7 @@ "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." (vc-cvs-command buffer - (if (vc-stay-local-p file) + (if (vc-stay-local-p file 'CVS) 'async 0) file "annotate" (if revision (concat "-r" revision))) @@ -681,8 +681,9 @@ ;;; Miscellaneous ;;; -(defalias 'vc-cvs-make-version-backups-p 'vc-stay-local-p - "Return non-nil if version backups should be made for FILE.") +(defun vc-cvs-make-version-backups-p (file) + "Return non-nil if version backups should be made for FILE." + (vc-stay-local-p file 'CVS)) (defun vc-cvs-check-headers () "Check if the current file has any headers in it." @@ -706,7 +707,8 @@ (append vc-cvs-global-switches flags)))) -(defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility. +(defun vc-cvs-stay-local-p (file) ;Back-compatibility. + (vc-stay-local-p file 'CVS)) (defun vc-cvs-repository-hostname (dirname) "Hostname of the CVS server associated to workarea DIRNAME." @@ -965,7 +967,7 @@ (defun vc-cvs-dir-status (dir update-function) "Create a list of conses (file . state) for DIR." ;; FIXME check all files in DIR instead? - (let ((local (vc-stay-local-p dir))) + (let ((local (vc-stay-local-p dir 'CVS))) (if (and local (not (eq local 'only-file))) (vc-cvs-dir-status-heuristic dir update-function) (vc-cvs-command (current-buffer) 'async dir "-f" "status") diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc-hooks.el --- a/lisp/vc-hooks.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc-hooks.el Tue Jun 23 06:35:40 2009 +0000 @@ -168,15 +168,15 @@ :version "23.1" :group 'vc) -(defun vc-stay-local-p (file) +(defun vc-stay-local-p (file &optional backend) "Return non-nil if VC should stay local when handling FILE. This uses the `repository-hostname' backend operation. If FILE is a list of files, return non-nil if any of them individually should stay local." (if (listp file) - (delq nil (mapcar 'vc-stay-local-p file)) - (let* ((backend (vc-backend file)) - (sym (vc-make-backend-sym backend 'stay-local)) + (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file)) + (setq backend (or backend (vc-backend file))) + (let* ((sym (vc-make-backend-sym backend 'stay-local)) (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local))) (if (symbolp stay-local) stay-local (let ((dirname (if (file-directory-p file) @@ -449,7 +449,7 @@ ;; if user-login-name is nil, return the UID as a string (number-to-string (user-uid)))) -(defun vc-state (file) +(defun vc-state (file &optional backend) "Return the version control state of FILE. If FILE is not registered, this function always returns nil. @@ -514,11 +514,11 @@ ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) (when (> (length file) 0) - (let ((backend (vc-backend file))) - (when backend - (vc-file-setprop - file 'vc-state - (vc-call-backend backend 'state-heuristic file))))))) + (setq backend (or backend (vc-backend file))) + (when backend + (vc-file-setprop + file 'vc-state + (vc-call-backend backend 'state-heuristic file)))))) (defsubst vc-up-to-date-p (file) "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." @@ -563,14 +563,15 @@ (signal (car err) (cdr err)) (vc-call-backend backend 'diff (list file))))))) -(defun vc-working-revision (file) +(defun vc-working-revision (file &optional backend) "Return the repository version from which FILE was checked out. If FILE is not registered, this function always returns nil." (or (vc-file-getprop file 'vc-working-revision) - (let ((backend (vc-backend file))) - (when backend - (vc-file-setprop file 'vc-working-revision - (vc-call-backend backend 'working-revision file)))))) + (progn + (setq backend (or backend (vc-backend file))) + (when backend + (vc-file-setprop file 'vc-working-revision + (vc-call-backend backend 'working-revision file)))))) ;; Backward compatibility. (define-obsolete-function-alias @@ -741,9 +742,9 @@ (vc-up-to-date-p file) (eq (vc-checkout-model backend (list file)) 'implicit) (vc-file-setprop file 'vc-state 'edited) - (vc-mode-line file) - ;; Try to avoid unnecessary work, a *vc-dir* buffer is only - ;; present if this is true. + (vc-mode-line file backend) + ;; Try to avoid unnecessary work, a *vc-dir* buffer is + ;; present if and only if this is true. (when (memq 'vc-dir-resynch-file after-save-hook) (vc-dir-resynch-file file))))) @@ -787,12 +788,6 @@ backend)) "\nmouse-1: Version Control menu") 'local-map vc-mode-line-map))))) - ;; If the file is locked by some other user, make - ;; the buffer read-only. Like this, even root - ;; cannot modify a file that someone else has locked. - (and (equal file buffer-file-name) - (stringp (vc-state file)) - (setq buffer-read-only t)) ;; If the user is root, and the file is not owner-writable, ;; then pretend that we can't write it ;; even though we can (because root can write anything). @@ -814,37 +809,37 @@ \"BACKEND:LOCKER:REV\" if the file is locked by somebody else This function assumes that the file is registered." - (setq backend (symbol-name backend)) - (let ((state (vc-state file)) - (state-echo nil) - (rev (vc-working-revision file))) + (let* ((backend-name (symbol-name backend)) + (state (vc-state file backend)) + (state-echo nil) + (rev (vc-working-revision file backend))) (propertize (cond ((or (eq state 'up-to-date) (eq state 'needs-update)) (setq state-echo "Up to date file") - (concat backend "-" rev)) + (concat backend-name "-" rev)) ((stringp state) (setq state-echo (concat "File locked by" state)) - (concat backend ":" state ":" rev)) + (concat backend-name ":" state ":" rev)) ((eq state 'added) (setq state-echo "Locally added file") - (concat backend "@" rev)) + (concat backend-name "@" rev)) ((eq state 'conflict) (setq state-echo "File contains conflicts after the last merge") - (concat backend "!" rev)) + (concat backend-name "!" rev)) ((eq state 'removed) (setq state-echo "File removed from the VC system") - (concat backend "!" rev)) + (concat backend-name "!" rev)) ((eq state 'missing) (setq state-echo "File tracked by the VC system, but missing from the file system") - (concat backend "?" rev)) + (concat backend-name "?" rev)) (t ;; Not just for the 'edited state, but also a fallback ;; for all other states. Think about different symbols ;; for 'needs-update and 'needs-merge. (setq state-echo "Locally modified file") - (concat backend ":" rev))) - 'help-echo (concat state-echo " under the " backend + (concat backend-name ":" rev))) + 'help-echo (concat state-echo " under the " backend-name " version control system")))) (defun vc-follow-link () diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc-rcs.el --- a/lisp/vc-rcs.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc-rcs.el Tue Jun 23 06:35:40 2009 +0000 @@ -828,6 +828,13 @@ ;; Just move the master file (using vc-rcs-master-templates). (vc-rename-master (vc-name old) new vc-rcs-master-templates)) +(defun vc-rcs-find-file-hook () + ;; If the file is locked by some other user, make + ;; the buffer read-only. Like this, even root + ;; cannot modify a file that someone else has locked. + (stringp (vc-state buffer-file-name 'RCS)) + (setq buffer-read-only t)) + ;;; ;;; Internal functions diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc-sccs.el --- a/lisp/vc-sccs.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc-sccs.el Tue Jun 23 06:35:40 2009 +0000 @@ -391,6 +391,13 @@ (basic-save-buffer) (kill-buffer (current-buffer)))) +(defun vc-sccs-find-file-hook () + ;; If the file is locked by some other user, make + ;; the buffer read-only. Like this, even root + ;; cannot modify a file that someone else has locked. + (stringp (vc-state buffer-file-name 'SCCS)) + (setq buffer-read-only t)) + ;;; ;;; Internal functions diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc-svn.el --- a/lisp/vc-svn.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc-svn.el Tue Jun 23 06:35:40 2009 +0000 @@ -142,7 +142,7 @@ (defun vc-svn-state (file &optional localp) "SVN-specific version of `vc-state'." - (setq localp (or localp (vc-stay-local-p file))) + (setq localp (or localp (vc-stay-local-p file 'SVN))) (with-temp-buffer (cd (file-name-directory file)) (vc-svn-command t 0 file "status" (if localp "-v" "-u")) @@ -189,7 +189,7 @@ ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR ;; which is VERY SLOW for big trees and it makes emacs ;; completely unresponsive during that time. - (let* ((local (and nil (vc-stay-local-p dir))) + (let* ((local (and nil (vc-stay-local-p dir 'SVN))) (remote (or t (not local) (eq local 'only-file)))) (vc-svn-command (current-buffer) 'async nil "status" (if remote "-u")) @@ -316,7 +316,7 @@ (message "Checking out %s..." file) (with-current-buffer (or (get-file-buffer file) (current-buffer)) (vc-svn-update file editable rev (vc-switches 'SVN 'checkout))) - (vc-mode-line file) + (vc-mode-line file 'SVN) (message "Checking out %s...done" file)) (defun vc-svn-update (file editable rev switches) @@ -470,7 +470,7 @@ (vc-svn-command buffer 'async - ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0) + ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0) (list file) "log" ;; By default Subversion only shows the log up to the @@ -502,7 +502,7 @@ (list "--diff-cmd=diff" "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) (async (and (not vc-disable-async-diff) - (vc-stay-local-p files) + (vc-stay-local-p files 'SVN) (or oldvers newvers)))) ; Svn diffs those locally. (apply 'vc-svn-command buffer (if async 'async 0) @@ -543,8 +543,9 @@ ;;; ;; Subversion makes backups for us, so don't bother. -;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p -;; "Return non-nil if version backups should be made for FILE.") +;; (defun vc-svn-make-version-backups-p (file) +;; "Return non-nil if version backups should be made for FILE." +;; (vc-stay-local-p file 'SVN)) (defun vc-svn-check-headers () "Check if the current file has any headers in it." diff -r 0d7c31bf0a29 -r af4ee0cb7fb7 lisp/vc.el --- a/lisp/vc.el Tue Jun 23 05:54:33 2009 +0000 +++ b/lisp/vc.el Tue Jun 23 06:35:40 2009 +0000 @@ -600,11 +600,6 @@ ;; the two branches. Or you locally add file FOO and then pull a ;; change that also adds a new file FOO, ... ;; -;; - The use of vc-start-logentry in vc-register should be removed. -;; It's a remnant from old times when vc-register had an opportunity -;; to provide a message linked to the file's addition, but nowadays -;; it's just extra baggage that makes the code less readable. -;; ;; - make it easier to write logs. Maybe C-x 4 a should add to the log ;; buffer, if one is present, instead of adding to the ChangeLog. ;; @@ -934,7 +929,7 @@ ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer - (eq major-mode 'vc-dir-mode)))) + (derived-mode-p 'vc-dir-mode)))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset observer allow-unregistered state-model-only-files))) @@ -1172,7 +1167,7 @@ ;; show that the file is locked now. (vc-clear-headers file) (write-file buffer-file-name) - (vc-mode-line file)) + (vc-mode-line file backend)) (if (not (yes-or-no-p "Revert to checked-in revision, instead? ")) (error "Checkout aborted") @@ -1232,31 +1227,28 @@ (not (file-exists-p buffer-file-name))) (set-buffer-modified-p t)) (vc-buffer-sync))))) - (lexical-let ((backend backend) - (files files)) - (vc-start-logentry - files - (if set-revision - (read-string (format "Initial revision level for %s: " files)) - (vc-call-backend backend 'init-revision)) - (or comment (not vc-initial-comment)) - nil - "Enter initial comment." - "*VC-log*" - (lambda (files rev comment) - (message "Registering %s... " files) - (mapc 'vc-file-clearprops files) - (vc-call-backend backend 'register files rev comment) - (dolist (file files) - (vc-file-setprop file 'vc-backend backend) - ;; FIXME: This is wrong: it should set `backup-inhibited' in all - ;; the buffers visiting files affected by this `vc-register', not - ;; in the current-buffer. - ;; (unless vc-make-backup-files - ;; (make-local-variable 'backup-inhibited) - ;; (setq backup-inhibited t)) - ) - (message "Registering %s... done" files)))))) + (message "Registering %s... " files) + (mapc 'vc-file-clearprops files) + (vc-call-backend backend 'register files + (if set-revision + (read-string (format "Initial revision level for %s: " files)) + (vc-call-backend backend 'init-revision)) + comment) + (mapc + (lambda (file) + (vc-file-setprop file 'vc-backend backend) + ;; FIXME: This is wrong: it should set `backup-inhibited' in all + ;; the buffers visiting files affected by this `vc-register', not + ;; in the current-buffer. + ;; (unless vc-make-backup-files + ;; (make-local-variable 'backup-inhibited) + ;; (setq backup-inhibited t)) + + (vc-resynch-buffer file vc-keep-workfiles t)) + files) + (when (derived-mode-p 'vc-dir-mode) + (vc-dir-move-to-goal-column)) + (message "Registering %s... done" files))) (defun vc-register-with (backend) "Register the current file with a specified back end." @@ -2108,7 +2100,7 @@ (vc-switch-backend file new-backend) (when (or move edited) (vc-file-setprop file 'vc-state 'edited) - (vc-mode-line file) + (vc-mode-line file new-backend) (vc-checkin file new-backend nil comment (stringp comment))))) (defun vc-rename-master (oldmaster newfile templates) @@ -2208,8 +2200,7 @@ (with-current-buffer oldbuf (let ((buffer-read-only buffer-read-only)) (set-visited-file-name new)) - (vc-backend new) - (vc-mode-line new) + (vc-mode-line new (vc-backend new)) (set-buffer-modified-p nil))))) ;;;###autoload