Merge from emacs--devo--0

Patches applied:

 * emacs--devo--0  (patch 803-813)

   - Update from CVS
   - Merge from emacs--rel--22

 * emacs--rel--22  (patch 51-58)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 233-236)

   - Merge from emacs--devo--0
   - Update from CVS

Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-25

1 files changed, 92 insertions, 94 deletions

diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 583e02efd5d..22ed10d1286 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -29,8 +29,11 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'vc))
+(eval-when-compile (require 'cl) (require 'vc))
+
+;; Clear up the cache to force vc-call to check again and discover
+;; new functions when we reload this file.
+(put 'CVS 'vc-functions nil)
 
 ;;;
 ;;; Customization options
@@ -368,99 +371,45 @@ its parents."
 	 "-p"
 	 (vc-switches 'CVS 'checkout)))
 
-(defun vc-cvs-checkout (file &optional editable rev workfile)
-  "Retrieve a revision of FILE into a WORKFILE.
+(defun vc-cvs-checkout (file &optional editable 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 into WORKFILE."
-  (let ((filename (or workfile file))
-	(file-buffer (get-file-buffer file))
-	switches)
-    (message "Checking out %s..." filename)
-    (save-excursion
-      ;; Change buffers to get local value of vc-checkout-switches.
-      (if file-buffer (set-buffer file-buffer))
-      (setq switches (vc-switches 'CVS 'checkout))
-      ;; Save this buffer's default-directory
-      ;; and use save-excursion to make sure it is restored
-      ;; in the same buffer it was saved in.
-      (let ((default-directory default-directory))
-	(save-excursion
-	  ;; Adjust the default-directory so that the check-out creates
-	  ;; the file in the right place.
-	  (setq default-directory (file-name-directory filename))
-	  (if workfile
-	      (let ((failed t)
-                    (backup-name (if (string= file workfile)
-                                     (car (find-backup-file-name filename)))))
-                (when backup-name
-                  (copy-file filename backup-name
-                             'ok-if-already-exists 'keep-date)
-                  (unless (file-writable-p filename)
-                    (set-file-modes filename
-                                    (logior (file-modes filename) 128))))
-		(unwind-protect
-		    (progn
-                      (let ((coding-system-for-read 'no-conversion)
-                            (coding-system-for-write 'no-conversion))
-                        (with-temp-file filename
-                          (apply 'vc-cvs-command
-                                 (current-buffer) 0 file
-                                 "-Q"	; suppress diagnostic output
-                                 "update"
-                                 (and (stringp rev)
-                                      (not (string= rev ""))
-                                      (concat "-r" rev))
-                                 "-p"
-                                 switches)))
-		      (setq failed nil))
-		  (if failed
-                      (if backup-name
-                          (rename-file backup-name filename
-                                       'ok-if-already-exists)
-                        (if (file-exists-p filename)
-                            (delete-file filename)))
-                    (and backup-name
-                         (not vc-make-backup-files)
-                         (delete-file backup-name)))))
-	    (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 file) 'implicit))
-                     (if vc-cvs-use-edit
-                         (vc-cvs-command nil 0 file "edit")
-                       (set-file-modes file (logior (file-modes file) 128))
-                       (if file-buffer (toggle-read-only -1))))
-              ;; Check out a particular version (or recreate the file).
-              (vc-file-setprop file 'vc-workfile-version nil)
-              (apply 'vc-cvs-command nil 0 file
-                     (and editable
-                          (or (not (file-exists-p file))
-                              (not (eq (vc-cvs-checkout-model file)
-                                       'implicit)))
-                          "-w")
-                     "update"
-                     (when rev
-                       (unless (eq rev t)
-                         ;; default for verbose checkout: clear the
-                         ;; sticky tag so that the actual update will
-                         ;; get the head of the trunk
-                         (if (string= rev "")
-                             "-A"
-                           (concat "-r" rev))))
-                     switches))))
-	(vc-mode-line file)
-	(message "Checking out %s...done" filename)))))
+REV is the revision to check out."
+  (message "Checking out %s..." file)
+  ;; Change buffers to get local value of vc-checkout-switches.
+  (with-current-buffer (or (get-file-buffer file) (current-buffer))
+    (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 file) 'implicit))
+             (if vc-cvs-use-edit
+                 (vc-cvs-command nil 0 file "edit")
+               (set-file-modes file (logior (file-modes file) 128))
+               (if (equal file buffer-file-name) (toggle-read-only -1))))
+      ;; Check out a particular version (or recreate the file).
+      (vc-file-setprop file 'vc-workfile-version nil)
+      (apply 'vc-cvs-command nil 0 file
+             (and editable "-w")
+             "update"
+             (when rev
+               (unless (eq rev t)
+                 ;; default for verbose checkout: clear the
+                 ;; sticky tag so that the actual update will
+                 ;; get the head of the trunk
+                 (if (string= rev "")
+                     "-A"
+                   (concat "-r" rev))))
+             (vc-switches 'CVS 'checkout)))
+    (vc-mode-line file))
+  (message "Checking out %s...done" file))
 
 (defun vc-cvs-delete-file (file)
   (vc-cvs-command nil 0 file "remove" "-f")
   (vc-cvs-command nil 0 file "commit" "-mRemoved."))
 
 (defun vc-cvs-revert (file &optional contents-done)
-  "Revert FILE to the version it was based on."
-  (unless contents-done
-    ;; Check out via standard output (caused by the final argument
-    ;; FILE below), so that no sticky tag is set.
-    (vc-cvs-checkout file nil (vc-workfile-version file) file))
+  "Revert FILE to the version on which it was based."
+  (vc-default-revert 'CVS file contents-done)
   (unless (eq (vc-checkout-model file) 'implicit)
     (if vc-cvs-use-edit
         (vc-cvs-command nil 0 file "unedit")
@@ -588,14 +537,36 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
                (and rev2 (concat "-r" rev2))
                (vc-switches 'CVS 'diff))))))
 
+(defconst vc-cvs-annotate-first-line-re "^[0-9]")
+
+(defun vc-cvs-annotate-process-filter (process string)
+  (setq string (concat (process-get process 'output) string))
+  (if (not (string-match vc-cvs-annotate-first-line-re string))
+      ;; Still waiting for the first real line.
+      (process-put process 'output string)
+    (let ((vc-filter (process-get process 'vc-filter)))
+      (set-process-filter process vc-filter)
+      (funcall vc-filter process (substring string (match-beginning 0))))))
+
 (defun vc-cvs-annotate-command (file buffer &optional version)
   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
 Optional arg VERSION is a version to annotate from."
-  (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))
-  (with-current-buffer buffer
-    (goto-char (point-min))
-    (re-search-forward "^[0-9]")
-    (delete-region (point-min) (1- (point)))))
+  (vc-cvs-command buffer
+                  (if (and (vc-stay-local-p file) (fboundp 'start-process))
+		      'async 0)
+                  file "annotate"
+                  (if version (concat "-r" version)))
+  ;; Strip the leading few lines.
+  (let ((proc (get-buffer-process buffer)))
+    (if proc
+        ;; If running asynchronously, use a process filter.
+        (progn
+          (process-put proc 'vc-filter (process-filter proc))
+          (set-process-filter proc 'vc-cvs-annotate-process-filter))
+      (with-current-buffer buffer
+        (goto-char (point-min))
+        (re-search-forward vc-cvs-annotate-first-line-re)
+        (delete-region (point-min) (1- (point)))))))
 
 (defun vc-cvs-annotate-current-time ()
   "Return the current time, based at midnight of the current day, and
@@ -960,7 +931,34 @@ is non-nil."
 	       (vc-file-setprop file 'vc-checkout-time 0)
 	       (if set-state (vc-file-setprop file 'vc-state 'edited)))))))))
 
+;; Completion of revision names.
+;; Just so I don't feel like I'm duplicating code from pcl-cvs, I'll use
+;; `cvs log' so I can list all the revision numbers rather than only
+;; tag names.
+
+(defun vc-cvs-revision-table (file)
+  (let ((default-directory (file-name-directory file))
+        (res nil))
+    (with-temp-buffer
+      (vc-cvs-command t nil file "log")
+      (goto-char (point-min))
+      (when (re-search-forward "^symbolic names:\n" nil t)
+        (while (looking-at "^	\\(.*\\): \\(.*\\)")
+          (push (cons (match-string 1) (match-string 2)) res)
+          (forward-line 1)))
+      (while (re-search-forward "^revision \\([0-9.]+\\)" nil t)
+        (push (match-string 1) res))
+      res)))
+
+(defun vc-cvs-revision-completion-table (file)
+  (lexical-let ((file file)
+                table)
+    (setq table (lazy-completion-table
+                 table (lambda () (vc-cvs-revision-table file))))
+    table))
+                                           
+
 (provide 'vc-cvs)
 
-;;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432
+;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432
 ;;; vc-cvs.el ends here