diff lisp/vc.el @ 90988:492971a3f31f unicode-xft-base

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 816-823) - Update from CVS - Merge from emacs--rel--22 * emacs--rel--22 (patch 59-69) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 237-238) - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-235

--- a/lisp/vc.el	Mon Jul 23 05:39:31 2007 +0000
+++ b/lisp/vc.el	Tue Jul 24 01:23:55 2007 +0000
@@ -46,8 +46,9 @@
 
 ;; This mode is fully documented in the Emacs user's manual.
 ;;
-;; Supported version-control systems presently include CVS, RCS, GNU Arch,
-;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC).
+;; Supported version-control systems presently include CVS, RCS, GNU
+;; Arch, Subversion, Bzr, Mercurial, Meta-CVS, and SCCS (or its free
+;; replacement, CSSC).
 ;;
 ;; Some features will not work with old RCS versions.  Where
 ;; appropriate, VC finds out which version you have, and allows or
@@ -101,13 +102,23 @@
 ;; with `vc-sys-'.  Some of the functions are mandatory (marked with a
 ;; `*'), others are optional (`-').
 ;;
+;; BACKEND PROPERTIES
+;;
+;; * revision-granularity
+;;
+;;   Takes no arguments.  Returns either 'file or 'repository.
+;;
 ;; STATE-QUERYING FUNCTIONS
 ;;
 ;; * registered (file)
 ;;
 ;;   Return non-nil if FILE is registered in this backend.  Both this
-;;   function as well as `state' should be careful to fail gracefully in the
-;;   event that the backend executable is absent.
+;;   function as well as `state' should be careful to fail gracefully
+;;   in the event that the backend executable is absent.  It is
+;;   preferable that this function's body is autoloaded, that way only
+;;   calling vc-registered does not cause the backend to be loaded
+;;   (all the vc-FOO-registered functions are called to try to find
+;;   the controlling backend for FILE.
 ;;
 ;; * state (file)
 ;;
@@ -159,9 +170,12 @@
 ;;
 ;; - mode-line-string (file)
 ;;
-;;   If provided, this function should return the VC-specific mode line
-;;   string for FILE.  The default implementation deals well with all
-;;   states that `vc-state' can return.
+;;   If provided, this function should return the VC-specific mode
+;;   line string for FILE. The returned string should have a
+;;   `help-echo' property which is the text to be displayed as a
+;;   tooltip when the mouse hovers over the VC entry on the mode-line.
+;;   The default implementation deals well with all states that
+;;   `vc-state' can return.
 ;;
 ;; - dired-state-info (file)
 ;;
@@ -171,12 +185,20 @@
 ;;
 ;; STATE-CHANGING FUNCTIONS
 ;;
-;; * register (file &optional rev comment)
+;; * create-repo ()
+;;
+;;   Create an empty repository in the current directory and initialize 
+;;   it so VC mode can add files to it.  For file-oriented systems, this 
+;;   need do no more than create a subdirectory with the right name.
 ;;
-;;   Register FILE in this backend.  Optionally, an initial revision REV
-;;   and an initial description of the file, COMMENT, may be specified.
+;; * register (files &optional rev comment)
+;;
+;;   Register FILES in this backend.  Optionally, an initial revision REV
+;;   and an initial description of the file, COMMENT, may be specified,
+;;   but it is not guaranteed that the backend will do anything with this.
 ;;   The implementation should pass the value of vc-register-switches
-;;   to the backend command.
+;;   to the backend command.  (Note: in older versions of VC, this 
+;;   command took a single file argument and not a list.)
 ;;
 ;; - init-version (file)
 ;;
@@ -210,12 +232,14 @@
 ;;   Unregister FILE from this backend.  This is only needed if this
 ;;   backend may be used as a "more local" backend for temporary editing.
 ;;
-;; * checkin (file rev comment)
+;; * checkin (files rev comment)
 ;;
-;;   Commit changes in FILE to this backend.  If REV is non-nil, that
-;;   should become the new revision number.  COMMENT is used as a
-;;   check-in comment.  The implementation should pass the value of
-;;   vc-checkin-switches to the backend command.
+;;   Commit changes in FILES to this backend.  If REV is non-nil, that
+;;   should become the new revision number (not all backends do
+;;   anything with it).  COMMENT is used as a check-in comment.  The
+;;   implementation should pass the value of vc-checkin-switches to
+;;   the backend command. (Note: in older versions of VC, this 
+;;   command took a single file argument and not a list.)
 ;;
 ;; * find-version (file rev buffer)
 ;;
@@ -242,13 +266,14 @@
 ;;   already been reverted from a version backup, and this function
 ;;   only needs to update the status of FILE within the backend.
 ;;
-;; - cancel-version (file editable)
+;; - rollback (files)
 ;;
-;;   Cancel the current workfile version of FILE, i.e. remove it from the
-;;   master.  EDITABLE non-nil means that FILE should be writable
-;;   afterwards, and if locking is used for FILE, then a lock should also
-;;   be set.  If this function is not provided, trying to cancel a
-;;   version is caught as an error.
+;;   Remove the tip version of each of FILES from the repository.  If
+;;   this function is not provided, trying to cancel a version is
+;;   caught as an error.  (Most backends don't provide it.)  (Also
+;;   note that older versions of this backend command were called
+;;   'cancel-version' and took a single file arg, not a list of
+;;   files.)
 ;;
 ;; - merge (file rev1 rev2)
 ;;
@@ -267,10 +292,11 @@
 ;;
 ;; HISTORY FUNCTIONS
 ;;
-;; * print-log (file &optional buffer)
+;; * print-log (files &optional buffer)
 ;;
-;;   Insert the revision log of FILE into BUFFER, or the *vc* buffer
-;;   if BUFFER is nil.
+;;   Insert the revision log for FILES into BUFFER, or the *vc* buffer
+;;   if BUFFER is nil.  (Note: older versions of this function expected
+;;   only a single file argument.)
 ;;
 ;; - log-view-mode ()
 ;;
@@ -560,7 +586,8 @@
   :group 'vc
   :version "20.3")
 
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}")
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" 
+					 ".hg" ".bzr" "{arch}")
   "List of directory names to be ignored when walking directory trees."
   :type '(repeat string)
   :group 'vc)
@@ -588,7 +615,7 @@
   :group 'vc)
 
 (defcustom vc-allow-async-revert nil
-  "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
+  "Specifies whether the diff during \\[vc-revert] may be asynchronous.
 Enabling this option means that you can confirm a revert operation even
 if the local changes in the file have not been found and displayed yet."
   :type '(choice (const :tag "No" nil)
@@ -976,9 +1003,13 @@
 Each function is called inside the buffer in which the command was run
 and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
 
+(defun vc-delistify (filelist)
+  "Smash a FILELIST into a file list string suitable for info messages."
+  (if (not filelist) "."  (mapconcat 'identity filelist " ")))
+
 (defvar w32-quote-process-args)
 ;;;###autoload
-(defun vc-do-command (buffer okstatus command file &rest flags)
+(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
   "Execute a VC command, notifying user and checking for errors.
 Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
 current buffer if BUFFER is t.  If the destination buffer is not
@@ -986,65 +1017,69 @@
 considered successful if its exit status does not exceed OKSTATUS (if
 OKSTATUS is nil, that means to ignore error status, if it is `async', that
 means not to wait for termination of the subprocess; if it is t it means to
-ignore all execution errors).  FILE is the
-name of the working file (may also be nil, to execute commands that
-don't expect a file name).  If an optional list of FLAGS is present,
+ignore all execution errors).  FILE-OR-LIST is the name of a working file;
+it may be a list of files or be nil (to execute commands that don't expect 
+a file name or set of files).  If an optional list of FLAGS is present,
 that is inserted into the command line before the filename."
-  (and file (setq file (expand-file-name file)))
-  (if vc-command-messages
-      (message "Running %s on %s..." command file))
-  (save-current-buffer
-    (unless (or (eq buffer t)
-                (and (stringp buffer)
-                     (string= (buffer-name) buffer))
-                (eq buffer (current-buffer)))
-      (vc-setup-buffer buffer))
-    (let ((squeezed (remq nil flags))
-	  (inhibit-read-only t)
-	  (status 0))
-      (when file
-	;; FIXME: file-relative-name can return a bogus result because
-	;; it doesn't look at the actual file-system to see if symlinks
-	;; come into play.
-	(setq squeezed (append squeezed (list (file-relative-name file)))))
-      (let ((exec-path (append vc-path exec-path))
-	    ;; Add vc-path to PATH for the execution of this command.
-	    (process-environment
-	     (cons (concat "PATH=" (getenv "PATH")
-			   path-separator
-			   (mapconcat 'identity vc-path path-separator))
-		   process-environment))
-	    (w32-quote-process-args t))
-	(if (and (eq okstatus 'async) (file-remote-p default-directory))
-	    ;; start-process does not support remote execution
-	    (setq okstatus nil))
-	(if (eq okstatus 'async)
-	    (let ((proc
-		   (let ((process-connection-type nil))
-		     (apply 'start-process command (current-buffer) command
-			    squeezed))))
-              (unless (active-minibuffer-window)
-                (message "Running %s in the background..." command))
-	      ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
-	      (set-process-filter proc 'vc-process-filter)
-	      (vc-exec-after
-	       `(unless (active-minibuffer-window)
-                  (message "Running %s in the background... done" ',command))))
-	  (let ((buffer-undo-list t))
-            (setq status (apply 'process-file command nil t nil squeezed)))
-	  (when (and (not (eq t okstatus))
-                     (or (not (integerp status))
-                         (and okstatus (< okstatus status))))
-	    (pop-to-buffer (current-buffer))
-	    (goto-char (point-min))
-	    (shrink-window-if-larger-than-buffer)
-	    (error "Running %s...FAILED (%s)" command
-		   (if (integerp status) (format "status %d" status) status))))
-	(if vc-command-messages
-	    (message "Running %s...OK" command)))
-      (vc-exec-after
-       `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags))
-      status)))
+  ;; FIXME: file-relative-name can return a bogus result because
+  ;; it doesn't look at the actual file-system to see if symlinks
+  ;; come into play.
+  (let* ((files
+	  (mapcar (lambda (f) (file-relative-name (expand-file-name f)))
+		  (if (listp file-or-list) file-or-list (list file-or-list))))
+         (full-command
+	  (concat command " " (vc-delistify flags) " " (vc-delistify files))))
+    (if vc-command-messages
+	(message "Running %s..." full-command))
+    (save-current-buffer
+      (unless (or (eq buffer t)
+		  (and (stringp buffer)
+		       (string= (buffer-name) buffer))
+		  (eq buffer (current-buffer)))
+	(vc-setup-buffer buffer))
+      (let ((squeezed (remq nil flags))
+	    (inhibit-read-only t)
+	    (status 0))
+	(when files
+	  (setq squeezed (nconc squeezed files)))
+	(let ((exec-path (append vc-path exec-path))
+	      ;; Add vc-path to PATH for the execution of this command.
+	      (process-environment
+	       (cons (concat "PATH=" (getenv "PATH")
+			     path-separator
+			     (mapconcat 'identity vc-path path-separator))
+		     process-environment))
+	      (w32-quote-process-args t))
+	  (if (and (eq okstatus 'async) (file-remote-p default-directory))
+	      ;; start-process does not support remote execution
+	      (setq okstatus nil))
+	  (if (eq okstatus 'async)
+	      (let ((proc
+		     (let ((process-connection-type nil))
+		       (apply 'start-process command (current-buffer) command
+			      squeezed))))
+		(unless (active-minibuffer-window)
+		  (message "Running %s in the background..." full-command))
+		;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
+		(set-process-filter proc 'vc-process-filter)
+		(vc-exec-after
+		 `(unless (active-minibuffer-window)
+		    (message "Running %s in the background... done" ',full-command))))
+	    (let ((buffer-undo-list t))
+	      (setq status (apply 'process-file command nil t nil squeezed)))
+	    (when (and (not (eq t okstatus))
+		       (or (not (integerp status))
+			   (and okstatus (< okstatus status))))
+	      (pop-to-buffer (current-buffer))
+	      (goto-char (point-min))
+	      (shrink-window-if-larger-than-buffer)
+	      (error "Running %s...FAILED (%s)" full-command
+		     (if (integerp status) (format "status %d" status) status))))
+	  (if vc-command-messages
+	      (message "Running %s...OK" full-command)))
+	(vc-exec-after
+	 `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags))
+	status))))
 
 (defun vc-position-context (posn)
   "Save a bit of the text around POSN in the current buffer.
@@ -1274,7 +1309,7 @@
 	  ;; DO NOT revert the file without asking the user!
 	  (if (not visited) (find-file-other-window file))
 	  (if (yes-or-no-p "Revert to master version? ")
-	      (vc-revert-buffer)))
+	      (vc-revert)))
 	 (t ;; normal action
 	  (if (not verbose)
 	      (vc-checkin file nil comment)
@@ -1464,7 +1499,7 @@
 		    (message "Registering %s... " file)
 		    (let ((backend (vc-responsible-backend file t)))
 		      (vc-file-clearprops file)
-		      (vc-call-backend backend 'register file rev comment)
+		      (vc-call-backend backend 'register (list file) rev comment)
 		      (vc-file-setprop file 'vc-backend backend)
 		      (unless vc-make-backup-files
 			(make-local-variable 'backup-inhibited)
@@ -1520,6 +1555,16 @@
 The default implementation returns t for all files."
   t)
 
+(defun vc-expand-dirs (file-or-dir-list)
+  "Expands directories in a file list specification.
+Only files already under version control are noticed."
+  ;; FIXME: Kill this function.
+  (let ((flattened '()))
+    (dolist (node file-or-dir-list)
+      (vc-file-tree-walk
+       node (lambda (f) (if (vc-backend f) (push f flattened)))))
+    (nreverse flattened)))
+
 (defun vc-resynch-window (file &optional keep noquery)
   "If FILE is in the current buffer, either revert or unvisit it.
 The choice between revert (to see expanded keywords) and unvisit depends on
@@ -1676,7 +1721,7 @@
       ;; Change buffers to get local value of vc-checkin-switches.
       (with-current-buffer (or (get-file-buffer file) (current-buffer))
 	(progn
-	  (vc-call checkin file rev comment)
+	  (vc-call checkin (list file) rev comment)
 	  (vc-delete-automatic-version-backups file)))
       `((vc-state . up-to-date)
 	(vc-checkout-time . ,(nth 5 (file-attributes file)))
@@ -1896,7 +1941,7 @@
                 (error "diff failed"))
             (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes)))
           status)
-      (vc-call diff file rev1 rev2))))
+      (vc-call diff (list file) rev1 rev2 "*vc-diff*"))))
 
 (defun vc-switches (backend op)
   (let ((switches
@@ -2467,7 +2512,7 @@
     ;; buffer can be accessed by the command.
     (condition-case err
         (progn
-          (vc-call print-log file "*vc-change-log*")
+          (vc-call print-log (list file) "*vc-change-log*")
           (set-buffer "*vc-change-log*"))
       (wrong-number-of-arguments
        ;; If this error came from the above call to print-log, try again
@@ -2480,7 +2525,7 @@
                (not (eq (caddr err) 2)))
            (signal (car err) (cdr err))
          ;; for backward compatibility
-         (vc-call print-log file)
+         (vc-call print-log (list file))
          (set-buffer "*vc*"))))
     (pop-to-buffer (current-buffer))
     (vc-exec-after
@@ -2509,7 +2554,7 @@
   "Return a string with all log entries stored in BACKEND for FILE."
   (if (vc-find-backend-function backend 'print-log)
       (with-current-buffer "*vc*"
-	(vc-call print-log file)
+	(vc-call print-log (list file))
 	(vc-call wash-log file)
 	(buffer-string))))
 
@@ -2534,7 +2579,7 @@
       (delete-region (match-beginning 0) (match-end 0)))))
 
 ;;;###autoload
-(defun vc-revert-buffer ()
+(defun vc-revert ()
   "Revert the current buffer's file to the version it was based on.
 This asks for confirmation if the buffer contents are not identical
 to that version.  This function does not automatically pick up newer
@@ -2593,7 +2638,7 @@
           (if (eq (vc-state file) 'edited)
               (error
                (substitute-command-keys
-           "File is locked--type \\[vc-revert-buffer] to discard changes"))
+           "File is locked--type \\[vc-revert] to discard changes"))
             (error
              (substitute-command-keys
            "Unexpected file state (%s)--type \\[vc-next-action] to correct")
@@ -2659,21 +2704,20 @@
   (vc-resynch-buffer file t t))
 
 ;;;###autoload
-(defun vc-cancel-version (norevert)
-  "Get rid of most recently checked in version of this file.
-A prefix argument NOREVERT means do not revert the buffer afterwards."
+(defun vc-rollback ()
+  "Get rid of most recently checked in version of this file."
   (interactive "P")
   (vc-ensure-vc-buffer)
   (let* ((file buffer-file-name)
 	 (backend (vc-backend file))
          (target (vc-workfile-version file)))
     (cond
-     ((not (vc-find-backend-function backend 'cancel-version))
+     ((not (vc-find-backend-function backend 'rollback))
       (error "Sorry, canceling versions is not supported under %s" backend))
      ((not (vc-call latest-on-branch-p file))
       (error "This is not the latest version; VC cannot cancel it"))
      ((not (vc-up-to-date-p file))
-      (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
+      (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert] to discard changes"))))
     (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
 	(error "Aborted")
       (setq norevert (or norevert (not
@@ -2682,7 +2726,7 @@
       (message "Removing last change from %s..." file)
       (with-vc-properties
        file
-       (vc-call cancel-version file norevert)
+       (vc-call rollback (list file))
        `((vc-state . ,(if norevert 'edited 'up-to-date))
 	 (vc-checkout-time . ,(if norevert
 				0
@@ -3453,6 +3497,7 @@
 (defun vc-file-tree-walk (dirname func &rest args)
   "Walk recursively through DIRNAME.
 Invoke FUNC f ARGS on each VC-managed file f underneath it."
+  ;; FIXME: Kill this function.
   (vc-file-tree-walk-internal (expand-file-name dirname) func args)
   (message "Traversing directory %s...done" dirname))
 
@@ -3463,13 +3508,13 @@
     (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)