[Emacs-diffs] Changes to emacs/lisp/vc.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        07/10/19 20:59:50

Index: vc.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/vc.el,v
retrieving revision 1.472
retrieving revision 1.473
diff -u -b -r1.472 -r1.473
--- vc.el       17 Oct 2007 16:22:27 -0000      1.472
+++ vc.el       19 Oct 2007 20:59:49 -0000      1.473
@@ -374,18 +374,11 @@
 ;;   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
@@ -859,12 +852,11 @@
   `(let ((vc-touched-properties (list t)))
      ,form
      (dolist (file ,files)
-       (mapc (lambda (setting)
+       (dolist (setting ,settings)
               (let ((property (car setting)))
                 (unless (memq property vc-touched-properties)
                   (put (intern file vc-file-prop-obarray)
-                       property (cdr setting)))))
-            ,settings))))
+                  property (cdr setting))))))))
 
 ;; Two macros for elisp programming
 
@@ -1168,7 +1160,8 @@
 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
@@ -1251,29 +1244,23 @@
     (nreverse flattened)))
 
 (defun vc-deduce-fileset (&optional allow-directory-wildcard)
-  "Deduce a set of files and a backend to apply an operation to.
-
-If we're in VC-dired-mode, the fileset is the list of marked
-files.  Otherwise, if we're looking at a buffer visiting a
-version-controlled file. the fileset is a singleton containing
-the relative filename, throw an error.
+  "Deduce a set of files and a backend to which to apply an operation.
 
-If neither of these things is true, but allow-directory-wildcard is on, 
-select all files under version control at and below the current 
-directory.
-
-Otherwise, throw an error.
-"
+If we're in VC-dired mode, the fileset is the list of marked files.
+Otherwise, if we're looking at a buffer visiting a version-controlled file,
+the fileset is a singleton containing this file.
+If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
+and we're in a dired buffer, select the current directory.
+Otherwise, throw an error."
   (cond (vc-dired-mode 
-        (let ((regexp (dired-marker-regexp))
-              (marked (dired-map-over-marks (dired-get-filename) nil)))
+        (let ((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)
-                                    (error "All members of a fileset must be 
under the same version-control system.")))
-                      (cdr marked)))
+             (dolist (f (cdr marked))
+               (unless (eq (vc-backend f) firstbackend)
+                 (error "All members of a fileset must be under the same 
version-control system."))))
           marked))
        ((vc-backend buffer-file-name)
         (list buffer-file-name))
@@ -1286,7 +1273,12 @@
        ;; 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)
@@ -1377,7 +1369,6 @@
 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)
@@ -1423,12 +1414,12 @@
        (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)
-           (mapc (lambda (file) 
-                   (vc-checkout file (eq model 'implicit) revision))))))
+             (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
-       (mapc (lambda (file) (vc-checkout file t)) files))
+       (dolist (file files) (vc-checkout file t)))
        (t
         ;; do nothing
         (message "Fileset is up-to-date"))))
@@ -1445,12 +1436,10 @@
                (set-file-modes file (logior (file-modes file) 128))
                (let ((visited (get-file-buffer file)))
                  (if visited 
-                     (save-excursion 
-                       (set-buffer visited) 
+                     (with-current-buffer visited
                        (toggle-read-only -1)))))))
        ;; Allow user to revert files with no changes
        (save-excursion
-         (let ((revertlist '()))
            (dolist (file files)
              (let ((visited (get-file-buffer file)))
                ;; For files with locking, if the file does not contain
@@ -1464,7 +1453,7 @@
                         (not (and visited (buffer-modified-p))))
                    (progn
                      (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")
@@ -1482,7 +1471,7 @@
             (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
      ((eq state 'needs-patch)
       (dolist (file files)
@@ -1507,9 +1496,7 @@
        (if (not (equal buffer-file-name file)) 
            (find-file-other-window file))
        (if (save-window-excursion
-             (vc-diff-internal 
-              (vc-backend file) nil (list file)
-              (vc-working-revision file) nil)
+             (vc-diff-internal nil (list file) (vc-working-revision file) nil)
              (goto-char (point-min))
              (let ((inhibit-read-only t))
                (insert
@@ -1774,7 +1761,7 @@
   ;; 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))
@@ -1819,24 +1806,24 @@
 
 ;;; Additional entry points for examining version histories
 
-(defun vc-default-diff-tree (backend dir rev1 rev2)
-  "List differences for all registered files at and below DIR.
-The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
-  ;; This implementation does an explicit tree walk, and calls
-  ;; vc-BACKEND-diff directly for each file.  An optimization
-  ;; would be to use `vc-diff-internal', so that diffs can be local,
-  ;; and to call it only for files that are actually changed.
-  ;; However, this is expensive for some backends, and so it is left
-  ;; to backend-specific implementations.
-  (setq default-directory dir)
-  (vc-file-tree-walk
-   default-directory
-   (lambda (f)
-     (vc-exec-after
-      `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
-         (message "Looking at %s" ',f)
-         (vc-call-backend ',(vc-backend f)
-                          'diff (list ',f) ',rev1 ',rev2))))))
+;; (defun vc-default-diff-tree (backend dir rev1 rev2)
+;;   "List differences for all registered files at and below DIR.
+;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
+;;   ;; This implementation does an explicit tree walk, and calls
+;;   ;; vc-BACKEND-diff directly for each file.  An optimization
+;;   ;; would be to use `vc-diff-internal', so that diffs can be local,
+;;   ;; and to call it only for files that are actually changed.
+;;   ;; However, this is expensive for some backends, and so it is left
+;;   ;; to backend-specific implementations.
+;;   (setq default-directory dir)
+;;   (vc-file-tree-walk
+;;    default-directory
+;;    (lambda (f)
+;;      (vc-exec-after
+;;       `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
+;;          (message "Looking at %s" ',f)
+;;          (vc-call-backend ',(vc-backend f)
+;;                           'diff (list ',f) ',rev1 ',rev2))))))
 
 (defun vc-coding-system-for-diff (file)
   "Return the coding system for reading diff output for FILE."
@@ -1885,7 +1872,10 @@
   (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."
@@ -1901,11 +1891,20 @@
     (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
+    ;;
+    ;; Actually most backends (including CVS) have options to control the
+    ;; behavior since which one is better depends on the user and on the
+    ;; situation).  Worse yet: this code does not handle the case where
+    ;; `file' is a directory which contains added files.
+    ;; I made it conditional on vc-diff-added-files but it should probably
+    ;; just be removed (or copied/moved to specific backends).  --Stef.
+    (when vc-diff-added-files
     (let ((filtered '()))
       (dolist (file files)
-       (cond ((and (not (file-directory-p file)) (string= (vc-working-revision 
file) "0"))
-              (progn
+          (if (or (file-directory-p file)
+                  (not (string= (vc-working-revision file) "0")))
+              (push file filtered)
                 ;; This file is added but not yet committed; 
                 ;; there is no master file to diff against.
                 (if (or rev1 rev2)
@@ -1915,10 +1914,9 @@
                   (apply 'vc-do-command "*vc-diff*"
                          1 "diff" file
                          (append (vc-switches nil 'diff) '("/dev/null"))))))
-             (t
-              (add-to-list 'filtered file t))))
+        (setq files (nreverse filtered))))
       (let ((vc-disable-async-diff (not async)))
-       (vc-call-backend backend 'diff filtered rev1 rev2 "*vc-diff*")))
+      (vc-call diff files rev1 rev2 "*vc-diff*"))
     (set-buffer "*vc-diff*")
     (if (and (zerop (buffer-size))
              (not (get-buffer-process (current-buffer))))
@@ -1936,14 +1934,13 @@
       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
@@ -1980,19 +1977,19 @@
                    (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)
-  "Return t if DIR contains a version-controlled file, nil otherwise."
-  (catch 'found
-    (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 
'found 't))) (directory-files dir))
-    nil))
+;; (defun vc-contains-version-controlled-file (dir)
+;;   "Return t if DIR contains a version-controlled file, nil otherwise."
+;;   (catch 'found
+;;     (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 
'found 't))) (directory-files dir))
+;;     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
@@ -2000,27 +1997,17 @@
 
 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
-version-controlled files in the current directory, treat all
-version-controlled files recursively beneath the current
-directory as the selected fileset.
-"
+under version control) and we're in a Dired buffer, use
+the current directory.
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+  (interactive (list current-prefix-arg t))
+  (if historic
+      (call-interactively 'vc-version-diff)
+    (let* ((files (vc-deduce-fileset t)))
+      (if buffer-file-name (vc-buffer-sync not-urgent))
+      (vc-diff-internal t files nil nil (interactive-p)))))
 
-  (interactive "P")
-  (cond 
-   ;;((not (vc-contains-version-controlled-file default-directory))
-   ;;(error "No version-controlled files directly beneath default directory"))
-   (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)
@@ -2377,12 +2364,11 @@
   (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
                  (if vc-dired-mode
-                     (setq result (append result (list buffer))))))
-             (dired-buffers-for-dir dir)))
-    result))
+              (push buffer result)))))
+    (nreverse result)))
 
 (defun vc-dired-resynch-file (file)
   "Update the entries for FILE in any VC Dired buffers that list it."
@@ -2484,7 +2470,7 @@
 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
@@ -2513,8 +2499,7 @@
 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))
-        (backend (vc-backend (car files))))
+  (let* ((files (vc-deduce-fileset)))
     ;; 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
@@ -2522,13 +2507,13 @@
     (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"))
@@ -2547,7 +2532,7 @@
 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))
@@ -2572,7 +2557,7 @@
     (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"))
@@ -2586,7 +2571,7 @@
      `((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
@@ -3048,10 +3033,6 @@
        (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 ""))
@@ -3284,8 +3265,8 @@
 
 `vc-annotate-menu-elements' customizes the menu elements of the
 mode-specific menu. `vc-annotate-color-map' and
-`vc-annotate-very-old-color' defines the mapping of time to
-colors. `vc-annotate-background' specifies the background color."
+`vc-annotate-very-old-color' define the mapping of time to colors.
+`vc-annotate-background' specifies the background color."
   (interactive
    (save-current-buffer
      (vc-ensure-vc-buffer)
@@ -3422,10 +3403,7 @@
        (if (not prev-rev)
            (message "Cannot diff from any revision prior to %s" rev-at-line)
          (save-window-excursion
-           (vc-diff-internal 
-            (vc-backend vc-annotate-parent-file)
-            nil
-            (list vc-annotate-parent-file) 
+           (vc-diff-internal nil (list vc-annotate-parent-file)
             prev-rev rev-at-line))
          (switch-to-buffer "*vc-diff*"))))))