Mercurial > emacs

--- 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  <dann@ics.uci.edu>
+
+	* 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  <dann@ics.uci.edu>

 	* emacs-lisp/elp.el (elp-output-insert-symname): Add a link face
--- 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")
--- 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 ()
--- 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
--- 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
--- 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."
--- 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