emacs: lisp/vc.el comparison

comparison lisp/vc.el @ 91058:4b09bb044f38

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 899-900) - Update from CVS - Merge from emacs--rel--22 * emacs--rel--22 (patch 129-130) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 259-260) - Merge from emacs--rel--22 - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-272

author	Miles Bader <miles@gnu.org>
date	Sat, 20 Oct 2007 02:22:59 +0000
parents	1251cabc40b7 be5bf5efd2ed
children	4bc33ffdda1a

comparison

equal deleted inserted replaced

-:5e056bb0109f
+:4b09bb044f38
 ;; with modern version-control systems that do commits by fileset
 ;; rather than per individual file.
 ;;
 ;; Features in the new version:
 ;; * Key commands (vc-next-action = C-x v v, vc-print-log = C-x v l, vc-revert
 ;;   = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
 ;;   now operate on filesets rather than individual files.
 ;; * The fileset for a command is either (a) all marked files in VC-dired
 ;;   mode, (b) the currently visited file if it's under version control,
 ;;   or (c) the current directory if the visited buffer is not under
 ;;   version control and a wildcarding-enable flag has been set.
 ;;
 ;; If you maintain a client of the mode or customize it in your .emacs,
 ;; note that some backend functions which formerly took single file arguments
 ;; now take a list of files.  These include: register, checkin, print-log,
 ;; rollback, and diff.
 ;;; Commentary:
 ;;
 ;;   Takes no arguments.  Returns either 'file or 'repository.  Backends
 ;;   that return 'file have per-file revision numbering; backends
 ;;   that return 'repository have per-repository revision numbering,
 ;;   so a revision level implicitly identifies a changeset
 ;;
 ;; STATE-QUERYING FUNCTIONS
 ;;
 ;; * registered (file)
 ;;
 ;;   Return non-nil if FILE is registered in this backend.  Both this
 ;;
 ;; * working-revision (file)
 ;;
 ;;   Return the working revision of FILE.  This is the revision fetched
 ;;   by the last checkout or upate, not necessarily the same thing as the
-;;   head or tip revision. Should return "0" for a file added but not yet
+;;   head or tip revision.  Should return "0" for a file added but not yet
 ;;   committed.
 ;;
 ;; - latest-on-branch-p (file)
 ;;
 ;;   Return non-nil if the working revision of FILE is the latest revision
 ;;   `vc-disable-async-diff'.)
 ;;
 ;; - mode-line-string (file)
 ;;
 ;;   If provided, this function should return the VC-specific mode
-;;   line string for FILE. The returned string should have a
+;;   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.
 ;;
 ;;
 ;; STATE-CHANGING FUNCTIONS
 ;;
 ;; * create-repo (backend)
 ;;
 ;;   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 (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.  (Note: in older versions of VC, this
 ;;   command took a single file argument and not a list.)
 ;;
 ;; - init-revision (file)
 ;;
 ;;   The initial revision to use when registering FILE if one is not
 ;;
 ;;   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
+;;   the backend command.  (Note: in older versions of VC, this
 ;;   command took a single file argument and not a list.)
 ;;
 ;; * find-revision (file rev buffer)
 ;;
 ;;   Fetch revision REV of file FILE and put it into BUFFER.
 ;;   function should pass the value of (vc-switches BACKEND 'diff) to
 ;;   the backend command.  It should return a status of either 0 (no
 ;;   differences found), or 1 (either non-empty diff or the diff is
 ;;   run asynchronously).
 ;;
-;; - revision-completion-table (file)
+;; - revision-completion-table (files)
 ;;
-;;   Return a completion table for existing revisions of FILE.
+;;   Return a completion table for existing revisions of FILES.
 ;;   The default is to not use any completion table.
-;;
-;; - diff-tree (dir &optional rev1 rev2)
-;;
-;;   Insert the diff for all files at and below DIR into the *vc-diff*
-;;   buffer.  The meaning of REV1 and REV2 is the same as for
-;;   vc-BACKEND-diff.  The default implementation does an explicit tree
-;;   walk, calling vc-BACKEND-diff for each individual file.
 ;;
 ;; - annotate-command (file buf &optional rev)
 ;;
 ;;   If this function is provided, it should produce an annotated display
 ;;   of FILE in BUF, relative to revision REV.  Annotation means each line
 "If non-nil, show only locked or locally modified files in VC Dired."
 :type 'boolean
 :group 'vc
 :version "20.3")
 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn"
 					 ".git" ".hg" ".bzr" "{arch}")
 "List of directory names to be ignored when walking directory trees."
 :type '(repeat string)
 :group 'vc)
 been updated to their corresponding values."
 (declare (debug t))
 `(let ((vc-touched-properties (list t)))
 ,form
 (dolist (file ,files)
-(mapc (lambda (setting)
+(dolist (setting ,settings)
-	       (let ((property (car setting)))
+(let ((property (car setting)))
-		 (unless (memq property vc-touched-properties)
+(unless (memq property vc-touched-properties)
-		   (put (intern file vc-file-prop-obarray)
+(put (intern file vc-file-prop-obarray)
-			property (cdr setting)))))
+property (cdr setting))))))))
-	     ,settings))))
 ;; Two macros for elisp programming
 ;;;###autoload
 (defmacro with-vc-file (file comment &rest body)
 "Check out a writable copy of FILE if necessary, then execute BODY.
 Check in FILE with COMMENT (a string) after BODY has been executed.
 FILE is passed through `expand-file-name'; BODY executed within
 `save-excursion'.  If FILE is not under version control, or you are
 using a locking version-control system and the file is locked by
 somebody else, signal error."
 (declare (debug t) (indent 2))
 (let ((filevar (make-symbol "file")))
 `(let ((,filevar (expand-file-name ,file)))
 (or (vc-backend ,filevar)
 already current, set it up properly and erase it.  The command is
 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-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."
 ;; 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
 	  ;; What we're doing here is preparing a version of the command
 	  ;; for display in a debug-progess message.  If it's fewer than
 	  ;; 20 characters display the entire command (without trailing
 	  ;; newline).  Otherwise display the first 20 followed by an ellipsis.
 	  (concat (if (string= (substring command -1) "\n")
 		      (substring command 0 -1)
 		    command)
 		  " "
 		  (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...")  s)) flags))
 		  " " (vc-delistify files))))
 (save-current-buffer
 (unless (or (eq buffer t)
 		  (and (stringp buffer)
 		       (string= (buffer-name) buffer))
 		     (if (integerp status) (format "status %d" status) status))))
 	  ;; We're done
 	  (if vc-command-messages
 	      (message "Running %s...OK = %d" full-command status)))
 	(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.
 (defun vc-restore-buffer-context (context)
 "Restore point/mark, and reparse any affected compilation buffers.
 CONTEXT is that which `vc-buffer-context' returns."
 (let ((point-context (nth 0 context))
 	(mark-context (nth 1 context))
-	(reparse (nth 2 context)))
+	;; (reparse (nth 2 context))
+)
 ;; The new compilation code does not use compilation-error-list any
 ;; more, so the code below is now ineffective and might as well
 ;; be disabled.  -- Stef
 ;; ;; Reparse affected compilation buffers.
 ;; (while reparse
 (vc-file-tree-walk
 node (lambda (f) (if (vc-backend f) (push f flattened)))))
 (nreverse flattened)))
 (defun vc-deduce-fileset (&optional allow-directory-wildcard)
-"Deduce a set of files and a backend to apply an operation to.
+"Deduce a set of files and a backend to which to apply an operation.
-If we're in VC-dired-mode, the fileset is the list of marked
+If we're in VC-dired mode, the fileset is the list of marked files.
-files.  Otherwise, if we're looking at a buffer visiting a
+Otherwise, if we're looking at a buffer visiting a version-controlled file,
-version-controlled file. the fileset is a singleton containing
+the fileset is a singleton containing this file.
-the relative filename, throw an error.
+If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
+and we're in a dired buffer, select the current directory.
-If neither of these things is true, but allow-directory-wildcard is on,
+Otherwise, throw an error."
-select all files under version control at and below the current
+(cond (vc-dired-mode
-directory.
+	 (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
-Otherwise, throw an error.
-"
-(cond (vc-dired-mode
-	 (let ((regexp (dired-marker-regexp))
-	       (marked (dired-map-over-marks (dired-get-filename) nil)))
 	   (unless marked
 	     (error "No files have been selected."))
 	   ;; All members of the fileset must have the same backend
 	   (let ((firstbackend (vc-backend (car marked))))
-		 (mapc (lambda (f) (unless (eq (vc-backend f) firstbackend)
+(dolist (f (cdr marked))
-				     (error "All members of a fileset must be under the same version-control system.")))
+(unless (eq (vc-backend f) firstbackend)
-		       (cdr marked)))
+(error "All members of a fileset must be under the same version-control system."))))
 	   marked))
 	((vc-backend buffer-file-name)
 	 (list buffer-file-name))
 	((and vc-parent-buffer (buffer-file-name vc-parent-buffer))
 	 (progn
 	   (set-buffer vc-parent-buffer)
 	   (vc-deduce-fileset)))
 	;; This is guarded by an enabling arg so users won't potentially
 	;; shoot themselves in the foot by modifying a fileset they can't
 	;; verify by eyeball.  Allow it for nondestructive commands like
 	;; making diffs, or possibly for destructive ones that have
 	;; confirmation prompts.
-	(allow-directory-wildcard
+	((and allow-directory-wildcard
+;; I think this is a misfeature.  For now, I'll leave it in, but
+;; I'll disable it anywhere else than in dired buffers.  --Stef
+(and (derived-mode-p 'dired-mode)
+(equal buffer-file-name nil)
+(equal list-buffers-directory default-directory)))
 	 (progn
 	   (message "All version-controlled files below %s selected."
 		    default-directory)
 	   (list default-directory)))
 	(t (error "No fileset is available here."))))
 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* ((files (vc-deduce-fileset))
-	 (backend (vc-backend (car files)))
 	 (state (vc-state (car files)))
 	 (model (vc-checkout-model (car files)))
 	 revision)
 ;; Verify that the fileset is homogenous
 (dolist (file (cdr files))
 	    (vc-buffer-sync t)
 	    (if (buffer-modified-p)
 		(or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
 		    (error "Aborted")))))))
 ;; Do the right thing
 (cond
 ;; Files aren't registered
 ((not state)
 (mapc 'vc-register files))
 ;; 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-patch)))
 (verbose
 	;; go to a different revision
 	(setq revision (read-string "Branch, revision, or backend to move to: "))
 	(let ((vsym (intern-soft (upcase revision))))
 	  (if (member vsym vc-handled-backends)
-	      (mapc (lambda (file) (vc-transfer-file file vsym)) files)
+	      (dolist (file files) (vc-transfer-file file vsym))
-	    (mapc (lambda (file)
+	    (dolist (file files)
-		    (vc-checkout file (eq model 'implicit) revision))))))
+(vc-checkout file (eq model 'implicit) revision)))))
 ((not (eq model 'implicit))
 	;; check the files out
-	(mapc (lambda (file) (vc-checkout file t)) files))
+	(dolist (file files) (vc-checkout file t)))
 (t
-	 ;; do nothing
+;; do nothing
-	 (message "Fileset is up-to-date"))))
+(message "Fileset is up-to-date"))))
 ;; Files have local changes
 ((eq state 'edited)
 (let ((ready-for-commit files))
 	;; If files are edited but read-only, give user a chance to correct
 	(dolist (file files)
 	  (if (not (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)))
 		  (if visited
-		      (save-excursion
+		      (with-current-buffer visited
-			(set-buffer visited)
 			(toggle-read-only -1)))))))
 	;; Allow user to revert files with no changes
 	(save-excursion
-	  (let ((revertlist '()))
+(dolist (file files)
-	    (dolist (file files)
+(let ((visited (get-file-buffer file)))
-	      (let ((visited (get-file-buffer file)))
+;; For files with locking, if the file does not contain
-		;; For files with locking, if the file does not contain
+;; any changes, just let go of the lock, i.e. revert.
-		;; any changes, just let go of the lock, i.e. revert.
+(if (and (not (eq model 'implicit))
-		(if (and (not (eq model 'implicit))
+(vc-workfile-unchanged-p file)
-			 (vc-workfile-unchanged-p file)
+;; If buffer is modified, that means the user just
-			 ;; If buffer is modified, that means the user just
+;; said no to saving it; in that case, don't revert,
-			 ;; said no to saving it; in that case, don't revert,
+;; because the user might intend to save after
-			 ;; because the user might intend to save after
+;; finishing the log entry and committing.
-			 ;; finishing the log entry and committing.
+(not (and visited (buffer-modified-p))))
-			 (not (and visited (buffer-modified-p))))
+(progn
-		    (progn
+(vc-revert-file file)
-		      (vc-revert-file file)
+(delete file 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)
 		(if (member vsym vc-handled-backends)
 		    (vc-transfer-file file vsym)
 		  (vc-checkin ready-for-commit revision))))))))
 ;; locked by somebody else (locking VCSes only)
 ((stringp state)
 (let ((revision
 	     (if verbose
 		 (read-string "Revision to steal: ")
 	       (vc-working-revision file))))
-	(mapc (lambda (file) (vc-steal-lock file revision state) files))))
+	(dolist (file files) (vc-steal-lock file revision state))))
-	;; needs-patch
+;; needs-patch
 ((eq state 'needs-patch)
 (dolist (file files)
 	(if (yes-or-no-p (format
 			  "%s is not up-to-date.  Get latest revision? "
 			  (file-name-nondirectory file)))
 	    (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
 ;; unlocked-changes
 ((eq state 'unlocked-changes)
 (dolist (file files)
 	(if (not (equal buffer-file-name file))
 	    (find-file-other-window file))
 	(if (save-window-excursion
-	      (vc-diff-internal
+	      (vc-diff-internal nil (list file) (vc-working-revision file) nil)
-	       (vc-backend file) nil (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))
 INITIAL-CONTENTS is nil, do action immediately as if the user had
 entered COMMENT.  If COMMENT is t, also do action immediately with an
 empty comment.  Remember the file's buffer in `vc-parent-buffer'
 \(current one if no file).  AFTER-HOOK specifies the local value
 for vc-log-operation-hook."
 (let ((parent
 	 (if (and files (equal (length files) 1))
 	     (get-file-buffer (car files))
 	   (current-buffer))))
 (if vc-before-checkin-hook
 (if files
 (with-current-buffer parent
 (run-hooks 'vc-before-checkin-hook))
 the buffer contents as a comment."
 (interactive)
 ;; Check and record the comment, if any.
 (unless nocomment
 ;; Comment too long?
-(vc-call-backend (or (and vc-log-fileset (vc-backend (car vc-log-fileset)))
+(vc-call-backend (or (if vc-log-fileset (vc-backend vc-log-fileset))
 			 (vc-responsible-backend default-directory))
 		     'logentry-check)
 (run-hooks 'vc-logentry-check-hook))
 ;; Sync parent buffer in case the user modified it while editing the comment.
 ;; But not if it is a vc-dired buffer.
 	    (logbuf (pop-to-buffer "*VC-log*")
 		    (bury-buffer)
 		    (pop-to-buffer tmp-vc-parent-buffer))))
 ;; Now make sure we see the expanded headers
 (if log-fileset
 	(mapc
 	 (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
 	 log-fileset))
 (if vc-dired-mode
 (dired-move-to-filename))
 (run-hooks after-hook 'vc-finish-logentry-hook)))
 ;;; Additional entry points for examining version histories
-(defun vc-default-diff-tree (backend dir rev1 rev2)
+;; (defun vc-default-diff-tree (backend dir rev1 rev2)
-"List differences for all registered files at and below DIR.
+;;   "List differences for all registered files at and below DIR.
-The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
+;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
-;; This implementation does an explicit tree walk, and calls
+;;   ;; This implementation does an explicit tree walk, and calls
-;; vc-BACKEND-diff directly for each file.  An optimization
+;;   ;; vc-BACKEND-diff directly for each file.  An optimization
-;; would be to use `vc-diff-internal', so that diffs can be local,
+;;   ;; would be to use `vc-diff-internal', so that diffs can be local,
-;; and to call it only for files that are actually changed.
+;;   ;; and to call it only for files that are actually changed.
-;; However, this is expensive for some backends, and so it is left
+;;   ;; However, this is expensive for some backends, and so it is left
-;; to backend-specific implementations.
+;;   ;; to backend-specific implementations.
-(setq default-directory dir)
+;;   (setq default-directory dir)
-(vc-file-tree-walk
+;;   (vc-file-tree-walk
-default-directory
+;;    default-directory
-(lambda (f)
+;;    (lambda (f)
-(vc-exec-after
+;;      (vc-exec-after
-`(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
+;;       `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
-(message "Looking at %s" ',f)
+;;          (message "Looking at %s" ',f)
-(vc-call-backend ',(vc-backend f)
+;;          (vc-call-backend ',(vc-backend f)
-'diff (list ',f) ',rev1 ',rev2))))))
+;;                           'diff (list ',f) ',rev1 ',rev2))))))
 (defun vc-coding-system-for-diff (file)
 "Return the coding system for reading diff output for FILE."
 (or coding-system-for-read
 ;; if we already have this file open,
 (insert "No differences found.\n")
 (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name)))))
 (goto-char (point-min))
 (shrink-window-if-larger-than-buffer))
-(defun vc-diff-internal (backend async files rev1 rev2 &optional verbose)
+(defvar vc-diff-added-files nil
+"If non-nil, diff added files by comparing them to /dev/null.")
+(defun vc-diff-internal (async files rev1 rev2 &optional verbose)
 "Report diffs between two revisions of a fileset.
 Diff output goes to the *vc-diff* buffer.  The function
 returns t if the buffer had changes, nil otherwise."
 (let* ((filenames (vc-delistify files))
 	 (rev1-name (or rev1 "working revision"))
 	 (rev2-name (or rev2 "workfile"))
 	 ;; Set coding system based on the first file.  It's a kluge,
 	 ;; but the only way to set it for each file included would
 	 ;; be to call the back end separately for each file.
 	 (coding-system-for-read
 	  (if files (vc-coding-system-for-diff (car files)) 'undecided)))
 (vc-setup-buffer "*vc-diff*")
 (message "Finding changes in %s..." filenames)
 ;; Many backends don't handle well the case of a file that has been
 ;; added but not yet committed to the repo (notably CVS and Subversion).
-;; Do that work here so the backends don't have to futz with it.
+;; Do that work here so the backends don't have to futz with it.  --ESR
-(let ((filtered '()))
+;;
-(dolist (file files)
+;; Actually most backends (including CVS) have options to control the
-	(cond ((and (not (file-directory-p file)) (string= (vc-working-revision file) "0"))
+;; behavior since which one is better depends on the user and on the
-	       (progn
+;; situation).  Worse yet: this code does not handle the case where
-		 ;; This file is added but not yet committed;
+;; `file' is a directory which contains added files.
-		 ;; there is no master file to diff against.
+;; I made it conditional on vc-diff-added-files but it should probably
-		 (if (or rev1 rev2)
+;; just be removed (or copied/moved to specific backends).  --Stef.
-		     (error "No revisions of %s exist" file)
+(when vc-diff-added-files
-		   ;; We regard this as "changed".
+(let ((filtered '()))
-		   ;; Diff it against /dev/null.
+(dolist (file files)
-		   (apply 'vc-do-command "*vc-diff*"
+(if (or (file-directory-p file)
-			  1 "diff" file
+(not (string= (vc-working-revision file) "0")))
-			  (append (vc-switches nil 'diff) '("/dev/null"))))))
+(push file filtered)
-	      (t
+;; This file is added but not yet committed;
-	       (add-to-list 'filtered file t))))
+;; there is no master file to diff against.
-(let ((vc-disable-async-diff (not async)))
+(if (or rev1 rev2)
-	(vc-call-backend backend 'diff filtered rev1 rev2 "*vc-diff*")))
+(error "No revisions of %s exist" file)
+;; We regard this as "changed".
+;; Diff it against /dev/null.
+(apply 'vc-do-command "*vc-diff*"
+1 "diff" file
+(append (vc-switches nil 'diff) '("/dev/null"))))))
+(setq files (nreverse filtered))))
+(let ((vc-disable-async-diff (not async)))
+(vc-call diff files rev1 rev2 "*vc-diff*"))
 (set-buffer "*vc-diff*")
 (if (and (zerop (buffer-size))
 (not (get-buffer-process (current-buffer))))
 ;; Treat this case specially so as not to pop the buffer.
 (progn
 ;; In the async case, we return t even if there are no differences
 ;; because we don't know that yet.
 t)))
 ;;;###autoload
-(defun vc-history-diff (backend files rev1 rev2)
+(defun vc-version-diff (files rev1 rev2)
 "Report diffs between revisions of the fileset in the repository history."
 (interactive
 (let* ((files (vc-deduce-fileset t))
 	  (first (car files))
-	  (backend (vc-backend first))
 	  (completion-table
-	   (vc-call-backend backend 'revision-completion-table first))
+	   (vc-call revision-completion-table files))
 	  (rev1-default nil)
 	  (rev2-default nil))
 (cond
 ;; someday we may be able to do revision completion on non-singleton
 ;; filesets, but not yet.
 		      (completing-read rev2-prompt completion-table
 				       nil nil nil nil rev2-default)
 		    (read-string rev2-prompt nil nil rev2-default))))
 (if (string= rev1 "") (setq rev1 nil))
 (if (string= rev2 "") (setq rev2 nil))
-(list backend files rev1 rev2))))
+(list files rev1 rev2))))
 (if (and (not rev1) rev2)
 (error "Not a valid revision range."))
-(vc-diff-internal backend t files rev1 rev2 (interactive-p)))
+(vc-diff-internal t files rev1 rev2 (interactive-p)))
-(defun vc-contains-version-controlled-file (dir)
+;; (defun vc-contains-version-controlled-file (dir)
-"Return t if DIR contains a version-controlled file, nil otherwise."
+;;   "Return t if DIR contains a version-controlled file, nil otherwise."
-(catch 'found
+;;   (catch 'found
-(mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
+;;     (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
-nil))
+;;     nil))
 ;;;###autoload
-(defun vc-diff (historic)
+(defun vc-diff (historic &optional not-urgent)
 "Display diffs between file revisions.
 Normally this compares the currently selected fileset with their
-working revisions. With a prefix argument HISTORIC, it reads two revision
+working revisions.  With a prefix argument HISTORIC, it reads two revision
 designators specifying which revisions to compare.
 If no current fileset is available (that is, we are not in
 VC-Dired mode and the visited file of the current buffer is not
-under version control) behave specially; if there are
+under version control) and we're in a Dired buffer, use
-version-controlled files in the current directory, treat all
+the current directory.
-version-controlled files recursively beneath the current
+The optional argument NOT-URGENT non-nil means it is ok to say no to
-directory as the selected fileset.
+saving the buffer."
-"
+(interactive (list current-prefix-arg t))
+(if historic
-(interactive "P")
+(call-interactively 'vc-version-diff)
-(cond
+(let* ((files (vc-deduce-fileset t)))
-;;((not (vc-contains-version-controlled-file default-directory))
+(if buffer-file-name (vc-buffer-sync not-urgent))
-;;(error "No version-controlled files directly beneath default directory"))
+(vc-diff-internal t files nil nil (interactive-p)))))
-(historic
-(call-interactively 'vc-history-diff))
-(t
-(let* ((files (vc-deduce-fileset t))
-	   (first (car files))
-	   (backend
-	    (cond ((file-directory-p first)
-		   (vc-responsible-backend first))
-		  (t
-		   (vc-backend first)))))
-(vc-diff-internal backend t files nil nil (interactive-p))))))
 ;;;###autoload
 (defun vc-revision-other-window (rev)
 "Visit revision REV of the current file in another window.
 If the current file is named `F', the revision is named `F.~REV~'.
 (let ((backend-name (symbol-name (vc-responsible-backend
 				    default-directory))))
 (setq mode-name (concat mode-name backend-name))
 ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
 (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
 (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
 	(cons backend-name vc-dire-menu-map) 'subdir)))
 (setq vc-dired-mode t))
 (defun vc-dired-toggle-terse-mode ()
 "Toggle terse display in VC Dired."
 (defun vc-dired-buffers-for-dir (dir)
 "Return a list of all vc-dired buffers that currently display DIR."
 (let (result)
 ;; Check whether dired is loaded.
 (when (fboundp 'dired-buffers-for-dir)
-(mapc (lambda (buffer)
+(dolist (buffer (dired-buffers-for-dir dir))
-		(with-current-buffer buffer
+(with-current-buffer buffer
-		  (if vc-dired-mode
+(if vc-dired-mode
-		      (setq result (append result (list buffer))))))
+(push buffer result)))))
-	      (dired-buffers-for-dir dir)))
+(nreverse result)))
-result))
 (defun vc-dired-resynch-file (file)
 "Update the entries for FILE in any VC Dired buffers that list it."
 (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
 (when buffers
 (defun vc-print-log (&optional working-revision)
 "List the change log of the current fileset in a window.
 If WORKING-REVISION is non-nil, leave the point at that revision."
 (interactive)
 (let* ((files (vc-deduce-fileset))
-	 (backend (vc-backend (car files)))
+	 (backend (vc-backend files))
 	 (working-revision (or working-revision (vc-working-revision (car files)))))
 ;; Don't switch to the output buffer before running the command,
 ;; so that any buffer-local settings in the vc-controlled
 ;; buffer can be accessed by the command.
 (vc-call-backend backend 'print-log files "*vc-change-log*")
 (defun vc-revert ()
 "Revert working copies of the selected fileset to their repository contents.
 This asks for confirmation if the buffer contents are not identical
 to the working revision (except for keyword expansion)."
 (interactive)
-(let* ((files (vc-deduce-fileset))
+(let* ((files (vc-deduce-fileset)))
-	 (backend (vc-backend (car files))))
 ;; If any of the files is visited by the current buffer, make
 ;; sure buffer is saved.  If the user says `no', abort since
 ;; we cannot show the changes and ask for confirmation to
 ;; discard them.
 (if (or (not files) (memq (buffer-file-name) files))
 	(vc-buffer-sync nil))
 (dolist (file files)
-(let (buf (get-file-buffer file))
+(let ((buf (get-file-buffer file)))
 	(if (and buf (buffer-modified-p buf))
 	  (error "Please kill or save all modified buffers before reverting.")))
 (if (vc-up-to-date-p file)
 	  (unless (yes-or-no-p (format "%s seems up-to-date.  Revert anyway? " file))
 	    (error "Revert canceled"))))
-(if (vc-diff-internal backend vc-allow-async-revert files nil nil)
+(if (vc-diff-internal vc-allow-async-revert files nil nil)
 	(progn
 	  (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
 	    (error "Revert canceled"))
 	  (delete-windows-on "*vc-diff*")
 	  (kill-buffer "*vc-diff*")))
 "Roll back (remove) the most recent changeset committed to the repository.
 This may be either a file-level or a repository-level operation,
 depending on the underlying version-control system."
 (interactive)
 (let* ((files (vc-deduce-fileset))
-	 (backend (vc-backend (car files)))
+	 (backend (vc-backend files))
 	 (granularity (vc-call-backend backend 'revision-granularity)))
 (unless (vc-find-backend-function backend 'rollback)
 (error "Rollback is not supported in %s" backend))
 (if (and (not (eq granularity 'repository)) (/= (length files) 1))
 	(error "Rollback requires a singleton fileset or repository versioning"))
 (vc-setup-buffer "*vc-diff*")
 (not-modified)
 (message "Finding changes...")
 (let* ((tip (vc-working-revision (car files)))
 	   (previous (vc-call previous-revision (car files) tip)))
-(vc-diff-internal backend nil files previous tip))
+(vc-diff-internal nil files previous tip))
 ;; Display changes
 (unless (yes-or-no-p "Discard these revisions? ")
 (error "Rollback canceled"))
 (delete-windows-on "*vc-diff*")
 (kill-buffer"*vc-diff*")
 ;; Do the actual reversions
 files
 (vc-call-backend backend 'rollback files)
 `((vc-state . ,'up-to-date)
 (vc-checkout-time . , (nth 5 (file-attributes file)))
 (vc-working-revision . nil)))
-(mapc (lambda (f) (vc-resynch-buffer f t t)) files)
+(dolist (f files) (vc-resynch-buffer f t t))
 (message "Rolling back %s...done" (vc-delistify files))))
 ;;;###autoload
 (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
 ;;;###autoload
 (defun vc-update ()
 "Update the current fileset's files to their tip revisions.
 For each one that contains no changes, and is not locked, then this simply
 replaces the work file with the latest revision on its branch.  If the file
 contains changes, and the backend supports merging news, then any recent
 changes from the current branch are merged into the working file."
 (interactive)
 (dolist (file (vc-deduce-fileset))
 (if (buffer-modified-p (get-file-buffer file))
 	(error "Please kill or save all modified buffers before updating."))
 	  (vc-resynch-buffer file t t))))))
 (defun vc-version-backup-file (file &optional rev)
 "Return name of backup file for revision REV of FILE.
 If version backups should be used for FILE, and there exists
 such a backup for REV or the working revision of file, return
 its name; otherwise return nil."
 (when (vc-call make-version-backups-p file)
 (let ((backup-file (vc-version-backup-file-name file rev)))
 (if (file-exists-p backup-file)
 backup-file
 (with-current-buffer "*vc*"
 	(vc-call print-log (list file))
 	(vc-call-backend backend 'wash-log)
 	(buffer-string))))
-(defun vc-default-unregister (backend file)
-"Default implementation of `vc-unregister', signals an error."
-(error "Unregistering files is not supported for %s" backend))
 (defun vc-default-receive-file (backend file rev)
 "Let BACKEND receive FILE from another version control system."
 (vc-call-backend backend 'register file rev ""))
 (defun vc-default-create-snapshot (backend dir name branchp)
 age, and everything that is older than that is shown in blue.
 Customization variables:
 `vc-annotate-menu-elements' customizes the menu elements of the
-mode-specific menu. `vc-annotate-color-map' and
+mode-specific menu.  `vc-annotate-color-map' and
-`vc-annotate-very-old-color' defines the mapping of time to
+`vc-annotate-very-old-color' define the mapping of time to colors.
-colors. `vc-annotate-background' specifies the background color."
+`vc-annotate-background' specifies the background color."
 (interactive
 (save-current-buffer
 (vc-ensure-vc-buffer)
 (list buffer-file-name
 	   (let ((def (vc-working-revision buffer-file-name)))
 	(setq prev-rev
 	      (vc-call previous-revision vc-annotate-parent-file rev-at-line))
 	(if (not prev-rev)
 	    (message "Cannot diff from any revision prior to %s" rev-at-line)
 	  (save-window-excursion
-	    (vc-diff-internal
+	    (vc-diff-internal nil (list vc-annotate-parent-file)
-	     (vc-backend vc-annotate-parent-file)
+prev-rev rev-at-line))
-	     nil
-	     (list vc-annotate-parent-file)
-	     prev-rev rev-at-line))
 	  (switch-to-buffer "*vc-diff*"))))))
 (defun vc-annotate-warp-revision (revspec)
 "Annotate the revision described by REVSPEC.

Mercurial > emacs

comparison lisp/vc.el @ 91058:4b09bb044f38