merge from trunk

1 files changed, 123 insertions, 58 deletions

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 48d83d4f408..5f5807fb3c6 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1,6 +1,6 @@
 ;;; vc-cvs.el --- non-resident support for CVS version-control  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1995, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2015 Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
@@ -48,9 +48,9 @@
                     ;; If the file is not writable (despite CVSREAD being
                     ;; undefined), this is probably because the file is being
                     ;; "watched" by other developers.
-                    ;; (If vc-mistrust-permissions was t, we actually shouldn't
-                    ;; trust this, but there is no other way to learn this from
-                    ;; CVS at the moment (version 1.9).)
+                    ;; (We actually shouldn't trust this, but there is
+                    ;; no other way to learn this from CVS at the
+                    ;; moment (version 1.9).)
                     (string-match "r-..-..-." (nth 8 attrib)))
                'announce
              'implicit))))))
@@ -96,7 +96,18 @@ If nil, use the value of `vc-diff-switches'.  If t, use no switches."
   :version "21.1"
   :group 'vc-cvs)
 
-(defcustom vc-cvs-header '("\$Id\$")
+(defcustom vc-cvs-annotate-switches nil
+  "String or list of strings specifying switches for cvs annotate under VC.
+If nil, use the value of `vc-annotate-switches'.  If t, use no
+switches."
+  :type '(choice (const :tag "Unspecified" nil)
+		 (const :tag "None" t)
+		 (string :tag "Argument String")
+		 (repeat :tag "Argument List" :value ("") string))
+  :version "25.1"
+  :group 'vc-cvs)
+
+(defcustom vc-cvs-header '("$Id\ $")
   "Header keywords to be inserted by `vc-insert-headers'."
   :version "24.1"     ; no longer consult the obsolete vc-header-alist
   :type '(repeat string)
@@ -110,7 +121,7 @@ This is only meaningful if you don't use the implicit checkout model
   :version "21.1"
   :group 'vc-cvs)
 
-(defcustom vc-cvs-stay-local 'only-file
+(defcustom vc-stay-local 'only-file
   "Non-nil means use local operations when possible for remote repositories.
 This avoids slow queries over the network and instead uses heuristics
 and past information to determine the current status of a file.
@@ -222,7 +233,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
 
 (defun vc-cvs-state (file)
   "CVS-specific version of `vc-state'."
-  (if (vc-stay-local-p file 'CVS)
+  (if (vc-cvs-stay-local-p file)
       (let ((state (vc-file-getprop file 'vc-state)))
         ;; If we should stay local, use the heuristic but only if
         ;; we don't have a more precise state already available.
@@ -270,8 +281,8 @@ committed and support display of sticky tags."
     (propertize
      (if (zerop (length sticky-tag))
 	 string
-       (setq help-echo (format "%s on the '%s' branch"
-			       help-echo sticky-tag))
+       (setq help-echo (format-message "%s on the `%s' branch"
+                                       help-echo sticky-tag))
        (concat string "[" sticky-tag "]"))
      'help-echo help-echo)))
 
@@ -282,7 +293,7 @@ committed and support display of sticky tags."
 
 (autoload 'vc-switches "vc")
 
-(defun vc-cvs-register (files &optional _rev comment)
+(defun vc-cvs-register (files &optional comment)
   "Register FILES into the CVS version-control system.
 COMMENT can be used to provide an initial description of FILES.
 Passes either `vc-cvs-register-switches' or `vc-register-switches'
@@ -321,20 +332,20 @@ its parents."
                   (directory-file-name dir))))
     (eq dir t)))
 
-(defun vc-cvs-checkin (files rev comment)
+(defun vc-cvs-checkin (files comment &optional rev)
   "CVS-specific version of `vc-backend-checkin'."
-  (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
-    (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
+ (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
+   (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
 	(error "%s is not a valid symbolic tag name" rev)
-      ;; If the input revision is a valid symbolic tag name, we create it
-      ;; as a branch, commit and switch to it.
-      (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
-      (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
-      (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
+     ;; If the input revision is a valid symbolic tag name, we create it
+     ;; as a branch, commit and switch to it.
+     (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
+     (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
+     (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
 	    files)))
   (let ((status (apply 'vc-cvs-command nil 1 files
 		       "ci" (if rev (concat "-r" rev))
-		       (concat "-m" comment)
+                       (concat "-m" comment)
 		       (vc-switches 'CVS 'checkin))))
     (set-buffer "*vc*")
     (goto-char (point-min))
@@ -366,7 +377,6 @@ its parents."
     ;; vc-cvs-checkout-model).
     (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
 	  files)
-
     ;; if this was an explicit check-in (does not include creation of
     ;; a branch), remove the sticky tag.
     (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
@@ -382,9 +392,8 @@ its parents."
 	 "-p"
 	 (vc-switches 'CVS 'checkout)))
 
-(defun vc-cvs-checkout (file &optional editable rev)
+(defun vc-cvs-checkout (file &optional rev)
   "Checkout a revision of FILE into the working area.
-EDITABLE non-nil means that the file should be writable.
 REV is the revision to check out."
   (message "Checking out %s..." file)
   ;; Change buffers to get local value of vc-checkout-switches.
@@ -392,7 +401,7 @@ REV is the revision to check out."
     (if (and (file-exists-p file) (not rev))
         ;; If no revision was specified, just make the file writable
         ;; if necessary (using `cvs-edit' if requested).
-        (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
+        (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
              (if vc-cvs-use-edit
                  (vc-cvs-command nil 0 file "edit")
                (set-file-modes file (logior (file-modes file) 128))
@@ -400,7 +409,7 @@ REV is the revision to check out."
       ;; Check out a particular revision (or recreate the file).
       (vc-file-setprop file 'vc-working-revision nil)
       (apply 'vc-cvs-command nil 0 file
-             (and editable "-w")
+             "-w"
              "update"
              (when rev
                (unless (eq rev t)
@@ -428,6 +437,35 @@ REV is the revision to check out."
       ;; Make the file read-only by switching off all w-bits
       (set-file-modes file (logand (file-modes file) 3950)))))
 
+(defun vc-cvs-merge-file (file)
+  "Accept a file merge request, prompting for revisions."
+  (let* ((first-revision
+        (vc-read-revision
+         (concat "Merge " file
+                 " from branch or revision "
+                 "(default news on current branch): ")
+         (list file)
+         'CVS))
+        second-revision
+        status)
+    (cond
+     ((string= first-revision "")
+      (setq status (vc-cvs-merge-news file)))
+     (t
+      (if (not (vc-branch-p first-revision))
+         (setq second-revision
+               (vc-read-revision
+                "Second revision: "
+                (list file) 'CVS nil
+                (concat (vc-branch-part first-revision) ".")))
+       ;; We want to merge an entire branch.  Set revisions
+       ;; accordingly, so that vc-cvs-merge understands us.
+       (setq second-revision first-revision)
+       ;; first-revision must be the starting point of the branch
+       (setq first-revision (vc-branch-part first-revision)))
+      (setq status (vc-cvs-merge file first-revision second-revision))))
+    status))
+
 (defun vc-cvs-merge (file first-revision &optional second-revision)
   "Merge changes into current working copy of FILE.
 The changes are between FIRST-REVISION and SECOND-REVISION."
@@ -515,10 +553,10 @@ Remaining arguments are ignored."
   ;; It's just the catenation of the individual logs.
   (vc-cvs-command
    buffer
-   (if (vc-stay-local-p files 'CVS) 'async 0)
+   (if (vc-cvs-stay-local-p files) 'async 0)
    files "log")
   (with-current-buffer buffer
-    (vc-exec-after (vc-rcs-print-log-cleanup)))
+    (vc-run-delayed (vc-rcs-print-log-cleanup)))
   (when limit 'limit-unsupported))
 
 (defun vc-cvs-comment-history (file)
@@ -528,11 +566,10 @@ Remaining arguments are ignored."
 (autoload 'vc-version-backup-file "vc")
 (declare-function vc-coding-system-for-diff "vc" (file))
 
-(defun vc-cvs-diff (files &optional oldvers newvers buffer)
+(defun vc-cvs-diff (files &optional oldvers newvers buffer async)
   "Get a difference report using CVS between two revisions of FILE."
   (let* (process-file-side-effects
-	 (async (and (not vc-disable-async-diff)
-		     (vc-stay-local-p files 'CVS)))
+	 (async (and async (vc-cvs-stay-local-p files)))
 	 (invoke-cvs-diff-list nil)
 	 status)
     ;; Look through the file list and see if any files have backups
@@ -583,11 +620,12 @@ Remaining arguments are ignored."
 (defun vc-cvs-annotate-command (file buffer &optional revision)
   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
 Optional arg REVISION is a revision to annotate from."
-  (vc-cvs-command buffer
-                  (if (vc-stay-local-p file 'CVS)
-		      'async 0)
-                  file "annotate"
-                  (if revision (concat "-r" revision)))
+  (apply #'vc-cvs-command buffer
+	 (if (vc-cvs-stay-local-p file)
+	     'async 0)
+	 file "annotate"
+	 (append (vc-switches 'cvs 'annotate)
+		 (if revision (list (concat "-r" revision)))))
   ;; Strip the leading few lines.
   (let ((proc (get-buffer-process buffer)))
     (if proc
@@ -599,13 +637,13 @@ Optional arg REVISION is a revision to annotate from."
         (re-search-forward vc-cvs-annotate-first-line-re)
         (delete-region (point-min) (1- (point)))))))
 
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
 
 (defun vc-cvs-annotate-current-time ()
   "Return the current time, based at midnight of the current day, and
 encoded as fractional days."
   (vc-annotate-convert-time
-   (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+   (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
 
 (defun vc-cvs-annotate-time ()
   "Return the time of the next annotation (as fraction of days)
@@ -721,7 +759,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
 
 (defun vc-cvs-make-version-backups-p (file)
   "Return non-nil if version backups should be made for FILE."
-  (vc-stay-local-p file 'CVS))
+  (vc-cvs-stay-local-p file))
 
 (defun vc-cvs-check-headers ()
   "Check if the current file has any headers in it."
@@ -745,8 +783,34 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS."
            (append vc-cvs-global-switches
                    flags))))
 
-(defun vc-cvs-stay-local-p (file)  ;Back-compatibility.
-  (vc-stay-local-p file 'CVS))
+(defun vc-cvs-stay-local-p (file)
+  "Return non-nil if VC should stay local when handling FILE.
+If FILE is a list of files, return non-nil if any of them
+individually should stay local."
+  (if (listp file)
+      (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file))
+    (let* ((sym (vc-make-backend-sym 'CVS 'stay-local))
+          (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
+      (if (symbolp stay-local) stay-local
+       (let ((dirname (if (file-directory-p file)
+                          (directory-file-name file)
+                        (file-name-directory file))))
+         (eq 'yes
+             (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
+                 (vc-file-setprop
+                  dirname 'vc-cvs-stay-local-p
+                  (let ((hostname (vc-cvs-repository-hostname dirname)))
+                    (if (not hostname)
+                        'no
+                      (let ((default t))
+                        (if (eq (car-safe stay-local) 'except)
+                            (setq default nil stay-local (cdr stay-local)))
+                        (when (consp stay-local)
+                          (setq stay-local
+                                (mapconcat 'identity stay-local "\\|")))
+                        (if (if (string-match stay-local hostname)
+                                default (not default))
+                            'yes 'no))))))))))))
 
 (defun vc-cvs-repository-hostname (dirname)
   "Hostname of the CVS server associated to workarea DIRNAME."
@@ -854,7 +918,7 @@ state."
 	(when (and full
 		   (re-search-forward
 		    "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
-\[\t ]+\\([0-9.]+\\)"
+[\t ]+\\([0-9.]+\\)"
 		    nil t))
 	    (vc-file-setprop file 'vc-latest-revision (match-string 2)))
 	(vc-file-setprop
@@ -1003,26 +1067,21 @@ state."
     (if basedir result
       (funcall update-function result))))
 
-(defun vc-cvs-dir-status (dir update-function)
-  "Create a list of conses (file . state) for DIR."
-  ;; FIXME check all files in DIR instead?
-  (let ((local (vc-stay-local-p dir 'CVS)))
-    (if (and local (not (eq local 'only-file)))
+(defun vc-cvs-dir-status-files (dir files update-function)
+  "Create a list of conses (file . state) for FILES in DIR.
+Query all files in DIR if files is nil."
+  (let ((local (vc-cvs-stay-local-p dir)))
+    (if (and (not files) local (not (eq local 'only-file)))
 	(vc-cvs-dir-status-heuristic dir update-function)
-      (vc-cvs-command (current-buffer) 'async dir "-f" "status")
+      (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
+      (vc-cvs-command (current-buffer) 'async files "-f" "status")
       ;; Alternative implementation: use the "update" command instead of
       ;; the "status" command.
       ;; (vc-cvs-command (current-buffer) 'async
       ;; 		  (file-relative-name dir)
       ;; 		  "-f" "-n" "update" "-d" "-P")
-      (vc-exec-after
-       `(vc-cvs-after-dir-status (quote ,update-function))))))
-
-(defun vc-cvs-dir-status-files (dir files _default-state update-function)
-  "Create a list of conses (file . state) for DIR."
-  (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
-  (vc-exec-after
-   `(vc-cvs-after-dir-status (quote ,update-function))))
+      (vc-run-delayed
+       (vc-cvs-after-dir-status update-function)))))
 
 (defun vc-cvs-file-to-string (file)
   "Read the content of FILE and return it as a string."
@@ -1226,11 +1285,15 @@ is non-nil."
                    table (lambda () (vc-cvs-revision-table (car files))))))
     table))
 
-(defun vc-cvs-ignore (file)
+(defun vc-cvs-find-admin-dir (file)
+  "Return the administrative directory of FILE."
+  (vc-find-root file "CVS"))
+
+(defun vc-cvs-ignore (file &optional _directory _remove)
   "Ignore FILE under CVS."
-  (cvs-append-to-ignore (file-name-directory file) file))
+  (vc-cvs-append-to-ignore (file-name-directory file) file))
 
-(defun cvs-append-to-ignore (dir str &optional old-dir)
+(defun vc-cvs-append-to-ignore (dir str &optional old-dir)
   "In DIR, add STR to the .cvsignore file.
 If OLD-DIR is non-nil, then this is a directory that we don't want
 to hear about anymore."
@@ -1245,7 +1308,9 @@ to hear about anymore."
     (goto-char (point-max))
     (unless (bolp) (insert "\n"))
     (insert str (if old-dir "/\n" "\n"))
-    (if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max)))
+    ;; FIXME this is a pcvs variable.
+    (if (bound-and-true-p cvs-sort-ignore-file)
+        (sort-lines nil (point-min) (point-max)))
     (save-buffer)))
 
 (provide 'vc-cvs)