Fix problem with linking runemacs reported by Dani Moncayo.

[bpt/emacs.git] / lisp / vc / vc.el

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 87e4e1c..a0ef6f9 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1,6 +1,6 @@
 ;;; vc.el --- drive a version-control system from within Emacs  -*- lexical-binding: t -*-
 
 ;;; vc.el --- drive a version-control system from within Emacs  -*- lexical-binding: t -*-
 

-;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2013 Free Software Foundation, Inc.

 
 ;; Author:     FSF (see below for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
 ;; Author:     FSF (see below for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>


@@ -653,14 +653,16 @@
 
 (require 'vc-hooks)
 (require 'vc-dispatcher)
 
 (require 'vc-hooks)
 (require 'vc-dispatcher)

-(require 'ediff)

 
 (declare-function diff-setup-whitespace "diff-mode" ())
 
 (eval-when-compile
 
 (declare-function diff-setup-whitespace "diff-mode" ())
 
 (eval-when-compile

-  (require 'cl)

   (require 'dired))
 
   (require 'dired))
 

+(declare-function dired-get-filename "dired" (&optional localp noerror))
+(declare-function dired-move-to-filename "dired" (&optional err eol))
+(declare-function dired-marker-regexp "dired" ())
+

 (unless (assoc 'vc-parent-buffer minor-mode-alist)
   (setq minor-mode-alist
        (cons '(vc-parent-buffer vc-parent-buffer-name)
 (unless (assoc 'vc-parent-buffer minor-mode-alist)
   (setq minor-mode-alist
        (cons '(vc-parent-buffer vc-parent-buffer-name)


@@ -810,16 +812,6 @@ is sensitive to blank lines."
                       (string :tag "Comment End")))
   :group 'vc)
 
                       (string :tag "Comment End")))
   :group 'vc)
 

-(defcustom vc-checkout-carefully (= (user-uid) 0)
-  "Non-nil means be extra-careful in checkout.
-Verify that the file really is not locked
-and that its contents match what the repository version says."
-  :type 'boolean
-  :group 'vc)
-(make-obsolete-variable 'vc-checkout-carefully
-                        "the corresponding checks are always done now."
-                        "21.1")
-

 \f
 ;; Variables users don't need to see
 
 \f
 ;; Variables users don't need to see
 


@@ -936,11 +928,13 @@ Within directories, only files already under version control are noticed."
 
 (defvar vc-dir-backend)
 (defvar log-view-vc-backend)
 
 (defvar vc-dir-backend)
 (defvar log-view-vc-backend)

+(defvar log-edit-vc-backend)

 (defvar diff-vc-backend)
 
 (defun vc-deduce-backend ()
   (cond ((derived-mode-p 'vc-dir-mode)   vc-dir-backend)
        ((derived-mode-p 'log-view-mode) log-view-vc-backend)
 (defvar diff-vc-backend)
 
 (defun vc-deduce-backend ()
   (cond ((derived-mode-p 'vc-dir-mode)   vc-dir-backend)
        ((derived-mode-p 'log-view-mode) log-view-vc-backend)

+       ((derived-mode-p 'log-edit-mode) log-edit-vc-backend)

        ((derived-mode-p 'diff-mode)     diff-vc-backend)
         ;; Maybe we could even use comint-mode rather than shell-mode?
        ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
        ((derived-mode-p 'diff-mode)     diff-vc-backend)
         ;; Maybe we could even use comint-mode rather than shell-mode?
        ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)


@@ -1082,7 +1076,16 @@ For old-style locking-based version control systems, like RCS:
          ;; among all the `files'.
         (model (nth 4 vc-fileset)))
 
          ;; among all the `files'.
         (model (nth 4 vc-fileset)))
 

-    ;; Do the right thing
+    ;; If a buffer has unsaved changes, a checkout would discard those
+    ;; changes, so treat the buffer as having unlocked changes.
+    (when (and (not (eq model 'implicit)) (eq state 'up-to-date))
+      (dolist (file files)
+        (let ((buffer (get-file-buffer file)))
+          (and buffer
+               (buffer-modified-p buffer)
+               (setq state 'unlocked-changes)))))
+
+    ;; Do the right thing.

     (cond
      ((eq state 'missing)
       (error "Fileset files are missing, so cannot be operated on"))
     (cond
      ((eq state 'missing)
       (error "Fileset files are missing, so cannot be operated on"))


@@ -1115,24 +1118,27 @@ For old-style locking-based version control systems, like RCS:
      ;; Files have local changes
      ((vc-compatible-state state 'edited)
       (let ((ready-for-commit files))
      ;; Files have local changes
      ((vc-compatible-state state 'edited)
       (let ((ready-for-commit files))

-       ;; If files are edited but read-only, give user a chance to correct.
-       (dolist (file files)
-         ;; If committing a mix of removed and edited files, the
-         ;; fileset has state = 'edited.  Rather than checking the
-         ;; state of each individual file in the fileset, it seems
-         ;; simplest to just check if the file exists.  Bug#9781.
-         (when (and (file-exists-p file) (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"))
-            ;; Maybe we somehow lost permissions on the directory.
-            (condition-case nil
-                (set-file-modes file (logior (file-modes file) 128))
-              (error (error "Unable to make file writable")))
-           (let ((visited (get-file-buffer file)))
-             (when visited
-               (with-current-buffer visited
-                 (toggle-read-only -1))))))
+       ;; CVS, SVN and bzr don't care about read-only (bug#9781).
+       ;; RCS does, SCCS might (someone should check...).
+       (when (memq backend '(RCS SCCS))
+         ;; If files are edited but read-only, give user a chance to correct.
+         (dolist (file files)
+           ;; If committing a mix of removed and edited files, the
+           ;; fileset has state = 'edited.  Rather than checking the
+           ;; state of each individual file in the fileset, it seems
+           ;; simplest to just check if the file exists.        Bug#9781.
+           (when (and (file-exists-p file) (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"))
+             ;; Maybe we somehow lost permissions on the directory.
+             (condition-case nil
+                 (set-file-modes file (logior (file-modes file) 128))
+               (error (error "Unable to make file writable")))
+             (let ((visited (get-file-buffer file)))
+               (when visited
+                 (with-current-buffer visited
+                   (read-only-mode -1)))))))

        ;; Allow user to revert files with no changes
        (save-excursion
           (dolist (file files)
        ;; Allow user to revert files with no changes
        (save-excursion
           (dolist (file files)


@@ -1278,12 +1284,10 @@ first backend that could register the file is used."
     ;; many VCS allow that as well.
     (dolist (fname files)
       (let ((bname (get-file-buffer fname)))
     ;; many VCS allow that as well.
     (dolist (fname files)
       (let ((bname (get-file-buffer fname)))

-       (unless fname (setq fname buffer-file-name))
-       (when (vc-backend fname)
-         (if (vc-registered fname)
-             (error "This file is already registered")
-           (unless (y-or-n-p "Previous master file has vanished.  Make a new one? ")
-             (error "Aborted"))))
+       (unless fname
+         (setq fname buffer-file-name))
+       (when (vc-call-backend backend 'registered fname)
+         (error "This file is already registered"))

        ;; Watch out for new buffers of size 0: the corresponding file
        ;; does not exist yet, even though buffer-modified-p is nil.
        (when bname
        ;; Watch out for new buffers of size 0: the corresponding file
        ;; does not exist yet, even though buffer-modified-p is nil.
        (when bname


@@ -1343,7 +1347,7 @@ After check-out, runs the normal hook `vc-checkout-hook'."
          ;; Maybe the backend is not installed ;-(
          (when writable
            (let ((buf (get-file-buffer file)))
          ;; Maybe the backend is not installed ;-(
          (when writable
            (let ((buf (get-file-buffer file)))

-             (when buf (with-current-buffer buf (toggle-read-only -1)))))
+             (when buf (with-current-buffer buf (read-only-mode -1)))))

          (signal (car err) (cdr err))))
       `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
                              (not writable))
          (signal (car err) (cdr err))))
       `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
                              (not writable))


@@ -1434,7 +1438,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
          (vc-checkout-time . ,(nth 5 (file-attributes file)))
          (vc-working-revision . nil)))
      (message "Checking in %s...done" (vc-delistify files)))
          (vc-checkout-time . ,(nth 5 (file-attributes file)))
          (vc-working-revision . nil)))
      (message "Checking in %s...done" (vc-delistify files)))

-   'vc-checkin-hook))
+   'vc-checkin-hook
+   backend))

 
 ;;; Additional entry points for examining version histories
 
 
 ;;; Additional entry points for examining version histories
 


@@ -1515,8 +1520,9 @@ to override the value of `vc-diff-switches' and `diff-switches'."
       (when (listp switches) switches))))
 
 ;; Old def for compatibility with Emacs-21.[123].
       (when (listp switches) switches))))
 
 ;; Old def for compatibility with Emacs-21.[123].

-(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
-(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
+(defmacro vc-diff-switches-list (backend)
+  (declare (obsolete vc-switches "22.1"))
+  `(vc-switches ',backend 'diff))

 
 (defun vc-diff-finish (buffer messages)
   ;; The empty sync output case has already been handled, so the only
 
 (defun vc-diff-finish (buffer messages)
   ;; The empty sync output case has already been handled, so the only


@@ -1589,21 +1595,21 @@ Return t if the buffer had changes, nil otherwise."
     (let ((vc-disable-async-diff (not async)))
       (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
     (set-buffer buffer)
     (let ((vc-disable-async-diff (not async)))
       (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
     (set-buffer buffer)

+    (diff-mode)
+    (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
+    (set (make-local-variable 'revert-buffer-function)
+        `(lambda (ignore-auto noconfirm)
+           (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
+    ;; Make the *vc-diff* buffer read only, the diff-mode key
+    ;; bindings are nicer for read only buffers. pcl-cvs does the
+    ;; same thing.
+    (setq buffer-read-only t)

     (if (and (zerop (buffer-size))
              (not (get-buffer-process (current-buffer))))
         ;; Treat this case specially so as not to pop the buffer.
         (progn
           (message "%s" (cdr messages))
           nil)
     (if (and (zerop (buffer-size))
              (not (get-buffer-process (current-buffer))))
         ;; Treat this case specially so as not to pop the buffer.
         (progn
           (message "%s" (cdr messages))
           nil)

-      (diff-mode)
-      (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
-      (set (make-local-variable 'revert-buffer-function)
-          `(lambda (ignore-auto noconfirm)
-             (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
-      ;; Make the *vc-diff* buffer read only, the diff-mode key
-      ;; bindings are nicer for read only buffers. pcl-cvs does the
-      ;; same thing.
-      (setq buffer-read-only t)

       ;; Display the buffer, but at the end because it can change point.
       (pop-to-buffer (current-buffer))
       ;; The diff process may finish early, so call `vc-diff-finish'
       ;; Display the buffer, but at the end because it can change point.
       (pop-to-buffer (current-buffer))
       ;; The diff process may finish early, so call `vc-diff-finish'


@@ -1650,8 +1656,9 @@ Return t if the buffer had changes, nil otherwise."
       (setq rev1-default (vc-working-revision first)))
      ;; if the file is not locked, use last and previous revisions as defaults
      (t
       (setq rev1-default (vc-working-revision first)))
      ;; if the file is not locked, use last and previous revisions as defaults
      (t

-      (setq rev1-default (vc-call-backend backend 'previous-revision first
-                                          (vc-working-revision first)))
+      (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work.
+                           (vc-call-backend backend 'previous-revision first
+                                            (vc-working-revision first))))

       (when (string= rev1-default "") (setq rev1-default nil))
       (setq rev2-default (vc-working-revision first))))
     ;; construct argument list
       (when (string= rev1-default "") (setq rev1-default nil))
       (setq rev2-default (vc-working-revision first))))
     ;; construct argument list


@@ -1680,7 +1687,7 @@ Return t if the buffer had changes, nil otherwise."
                    (called-interactively-p 'interactive)))
 
 ;;;###autoload
                    (called-interactively-p 'interactive)))
 
 ;;;###autoload

-(defun vc-diff (historic &optional not-urgent)
+(defun vc-diff (&optional historic 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
   "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


@@ -1695,7 +1702,9 @@ saving the buffer."
     (vc-diff-internal t (vc-deduce-fileset t) nil nil
                      (called-interactively-p 'interactive))))
 
     (vc-diff-internal t (vc-deduce-fileset t) nil nil
                      (called-interactively-p 'interactive))))
 

-(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks))
+(declare-function ediff-load-version-control "ediff" (&optional silent))
+(declare-function ediff-vc-internal "ediff-vers"
+                  (rev1 rev2 &optional startup-hooks))

 
 ;;;###autoload
 (defun vc-version-ediff (files rev1 rev2)
 
 ;;;###autoload
 (defun vc-version-ediff (files rev1 rev2)


@@ -1716,7 +1725,8 @@ repository history using ediff."
    ;; FIXME We only support running ediff on one file for now.
    ;; We could spin off an ediff session per file in the file set.
    ((= (length files) 1)
    ;; FIXME We only support running ediff on one file for now.
    ;; We could spin off an ediff session per file in the file set.
    ((= (length files) 1)

-    (ediff-load-version-control)
+    (require 'ediff)
+    (ediff-load-version-control)  ; loads ediff-vers

     (find-file (car files))             ;FIXME: find-file from Elisp is bad.
     (ediff-vc-internal rev1 rev2 nil))
    (t
     (find-file (car files))             ;FIXME: find-file from Elisp is bad.
     (ediff-vc-internal rev1 rev2 nil))
    (t


@@ -1755,10 +1765,15 @@ saving the buffer."
       (call-interactively 'vc-version-diff)
     (when buffer-file-name (vc-buffer-sync not-urgent))
     (let ((backend (vc-deduce-backend))
       (call-interactively 'vc-version-diff)
     (when buffer-file-name (vc-buffer-sync not-urgent))
     (let ((backend (vc-deduce-backend))

+         (default-directory default-directory)

          rootdir working-revision)
          rootdir working-revision)

-      (unless backend
-       (error "Buffer is not version controlled"))
-      (setq rootdir (vc-call-backend backend 'root default-directory))
+      (if backend
+         (setq rootdir (vc-call-backend backend 'root default-directory))
+       (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+       (setq backend (vc-responsible-backend rootdir))
+       (if backend
+           (setq default-directory rootdir)
+         (error "Directory is not version controlled")))

       (setq working-revision (vc-working-revision rootdir))
       ;; VC diff for the root directory produces output that is
       ;; relative to it.  Bind default-directory to the root directory
       (setq working-revision (vc-working-revision rootdir))
       ;; VC diff for the root directory produces output that is
       ;; relative to it.  Bind default-directory to the root directory


@@ -2211,10 +2226,15 @@ When called interactively with a prefix argument, prompt for LIMIT."
     (t
      (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
   (let ((backend (vc-deduce-backend))
     (t
      (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
   (let ((backend (vc-deduce-backend))

+       (default-directory default-directory)

        rootdir working-revision)
        rootdir working-revision)

-    (unless backend
-      (error "Buffer is not version controlled"))
-    (setq rootdir (vc-call-backend backend 'root default-directory))
+    (if backend
+       (setq rootdir (vc-call-backend backend 'root default-directory))
+      (setq rootdir (read-directory-name "Directory for VC root-log: "))
+      (setq backend (vc-responsible-backend rootdir))
+      (if backend
+         (setq default-directory rootdir)
+       (error "Directory is not version controlled")))

     (setq working-revision (vc-working-revision rootdir))
     (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
 
     (setq working-revision (vc-working-revision rootdir))
     (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
 


@@ -2547,8 +2567,12 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
 
 ;;;###autoload
 (defun vc-delete-file (file)
 
 ;;;###autoload
 (defun vc-delete-file (file)

-  "Delete file and mark it as such in the version control system."
-  (interactive "fVC delete file: ")
+  "Delete file and mark it as such in the version control system.
+If called interactively, read FILE, defaulting to the current
+buffer's file name if it's under version control."
+  (interactive (list (read-file-name "VC delete file: " nil
+                                     (when (vc-backend buffer-file-name)
+                                       buffer-file-name) t)))

   (setq file (expand-file-name file))
   (let ((buf (get-file-buffer file))
         (backend (vc-backend file)))
   (setq file (expand-file-name file))
   (let ((buf (get-file-buffer file))
         (backend (vc-backend file)))


@@ -2586,8 +2610,13 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
 
 ;;;###autoload
 (defun vc-rename-file (old new)
 
 ;;;###autoload
 (defun vc-rename-file (old new)

-  "Rename file OLD to NEW in both work area and repository."
-  (interactive "fVC rename file: \nFRename to: ")
+  "Rename file OLD to NEW in both work area and repository.
+If called interactively, read OLD and NEW, defaulting OLD to the
+current buffer's file name if it's under version control."
+  (interactive (list (read-file-name "VC rename file: " nil
+                                     (when (vc-backend buffer-file-name)
+                                       buffer-file-name) t)
+                     (read-file-name "Rename to: ")))

   ;; in CL I would have said (setq new (merge-pathnames new old))
   (let ((old-base (file-name-nondirectory old)))
     (when (and (not (string= "" old-base))
   ;; in CL I would have said (setq new (merge-pathnames new old))
   (let ((old-base (file-name-nondirectory old)))
     (when (and (not (string= "" old-base))


@@ -2636,14 +2665,11 @@ log entries should be gathered."
    (cond ((consp current-prefix-arg)   ;C-u
          (list buffer-file-name))
         (current-prefix-arg            ;Numeric argument.
    (cond ((consp current-prefix-arg)   ;C-u
          (list buffer-file-name))
         (current-prefix-arg            ;Numeric argument.

-         (let ((files nil)
-               (buffers (buffer-list))
-               file)
-           (while buffers
-             (setq file (buffer-file-name (car buffers)))
-             (and file (vc-backend file)
-                  (setq files (cons file files)))
-             (setq buffers (cdr buffers)))
+         (let ((files nil))
+            (dolist (buffer (buffer-list))
+             (let ((file (buffer-file-name buffer)))
+                (and file (vc-backend file)
+                     (setq files (cons file files)))))

            files))
         (t
           ;; Don't supply any filenames to backend; this means
            files))
         (t
           ;; Don't supply any filenames to backend; this means


@@ -2791,7 +2817,7 @@ to provide the `find-revision' operation instead."
 \f
 
 ;; These things should probably be generally available
 \f
 
 ;; These things should probably be generally available

-(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.2")
+(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3")

 
 (defun vc-file-tree-walk (dirname func &rest args)
   "Walk recursively through DIRNAME.
 
 (defun vc-file-tree-walk (dirname func &rest args)
   "Walk recursively through DIRNAME.