lisp/desktop.el (desktop-clear): Fix previous change.
[bpt/emacs.git] / lisp / vc / vc-cvs.el
index 2d8d132..17b278d 100644 (file)
@@ -1,6 +1,6 @@
-;;; vc-cvs.el --- non-resident support for CVS version-control
+;;; vc-cvs.el --- non-resident support for CVS version-control  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1995, 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2013 Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
@@ -25,7 +25,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl) (require 'vc))
+(eval-when-compile (require 'vc))
 
 ;; Clear up the cache to force vc-call to check again and discover
 ;; new functions when we reload this file.
@@ -115,7 +115,7 @@ This is only meaningful if you don't use the implicit checkout model
 This avoids slow queries over the network and instead uses heuristics
 and past information to determine the current status of a file.
 
-If value is the symbol `only-file' `vc-dir' will connect to the
+If value is the symbol `only-file', `vc-dir' will connect to the
 server, but heuristics will be used to determine the status for
 all other VC operations.
 
@@ -198,7 +198,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
 ;;;###autoload   "Return non-nil if file F is registered with CVS."
 ;;;###autoload   (when (file-readable-p (expand-file-name
 ;;;###autoload                           "CVS/Entries" (file-name-directory f)))
-;;;###autoload       (load "vc-cvs")
+;;;###autoload       (load "vc-cvs" nil t)
 ;;;###autoload       (vc-cvs-registered f)))
 
 (defun vc-cvs-registered (file)
@@ -256,7 +256,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
   (vc-file-getprop file 'vc-working-revision))
 
 (defun vc-cvs-mode-line-string (file)
-  "Return string for placement into the modeline for FILE.
+  "Return a string for `vc-mode-line' to put in the mode line for FILE.
 Compared to the default implementation, this function does two things:
 Handle the special case of a CVS file that is added but not yet
 committed and support display of sticky tags."
@@ -280,7 +280,9 @@ committed and support display of sticky tags."
 ;;; State-changing functions
 ;;;
 
-(defun vc-cvs-register (files &optional rev comment)
+(autoload 'vc-switches "vc")
+
+(defun vc-cvs-register (files &optional _rev 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'
@@ -394,7 +396,7 @@ REV is the revision to check out."
              (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))))
+               (if (equal file buffer-file-name) (read-only-mode -1))))
       ;; Check out a particular revision (or recreate the file).
       (vc-file-setprop file 'vc-working-revision nil)
       (apply 'vc-cvs-command nil 0 file
@@ -415,6 +417,8 @@ REV is the revision to check out."
 (defun vc-cvs-delete-file (file)
   (vc-cvs-command nil 0 file "remove" "-f"))
 
+(autoload 'vc-default-revert "vc")
+
 (defun vc-cvs-revert (file &optional contents-done)
   "Revert FILE to the working revision on which it was based."
   (vc-default-revert 'CVS file contents-done)
@@ -501,9 +505,12 @@ Will fail unless you have administrative privileges on the repo."
 ;;;
 
 (declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
+;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
+(declare-function vc-exec-after "vc-dispatcher" (code))
 
-(defun vc-cvs-print-log (files buffer &optional shortlog start-revision-ignored limit)
-  "Get change logs associated with FILES."
+(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
+  "Print commit log associated with FILES into specified BUFFER.
+Remaining arguments are ignored."
   (require 'vc-rcs)
   ;; It's just the catenation of the individual logs.
   (vc-cvs-command
@@ -518,6 +525,9 @@ Will fail unless you have administrative privileges on the repo."
   "Get comment history of a file."
   (vc-call-backend 'RCS 'comment-history file))
 
+(autoload 'vc-version-backup-file "vc")
+(declare-function vc-coding-system-for-diff "vc" (file))
+
 (defun vc-cvs-diff (files &optional oldvers newvers buffer)
   "Get a difference report using CVS between two revisions of FILE."
   (let* (process-file-side-effects
@@ -562,14 +572,13 @@ Will fail unless you have administrative privileges on the repo."
 
 (defconst vc-cvs-annotate-first-line-re "^[0-9]")
 
-(defun vc-cvs-annotate-process-filter (process string)
+(defun vc-cvs-annotate-process-filter (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))))))
+    (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
+    (funcall filter process (substring string (match-beginning 0)))))
 
 (defun vc-cvs-annotate-command (file buffer &optional revision)
   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
@@ -583,9 +592,8 @@ Optional arg REVISION is a revision to annotate from."
   (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))
+        (add-function :around (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)
@@ -666,6 +674,10 @@ workspace is immediately moved to that new branch)."
   (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name)
   (when branchp (vc-cvs-command nil 0 dir "update" "-r" name)))
 
+;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
+(declare-function vc-resynch-buffer "vc-dispatcher"
+                  (file &optional keep noquery reset-vc-info))
+
 (defun vc-cvs-retrieve-tag (dir name update)
   "Retrieve a tag at and below DIR.
 NAME is the name of the tag; if it is empty, do a `cvs update'.
@@ -790,7 +802,7 @@ For an empty string, nil is returned (invalid CVS root)."
            ((= len 3)
             ;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
             (cons (cadr root-list)
-                  (vc-cvs-parse-uhp (caddr root-list))))
+                  (vc-cvs-parse-uhp (nth 2 root-list))))
            (t
             ;; :METHOD:[USER@]HOST:PATH
             (cdr root-list)))))
@@ -1006,7 +1018,7 @@ state."
       (vc-exec-after
        `(vc-cvs-after-dir-status (quote ,update-function))))))
 
-(defun vc-cvs-dir-status-files (dir files default-state 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
@@ -1021,7 +1033,7 @@ state."
        (buffer-substring (point) (point-max)))
     (file-error nil)))
 
-(defun vc-cvs-dir-extra-headers (dir)
+(defun vc-cvs-dir-extra-headers (_dir)
   "Extract and represent per-directory properties of a CVS working copy."
   (let ((repo
         (condition-case nil
@@ -1178,7 +1190,11 @@ is non-nil."
                                (parse-time-string (concat time " +0000")))))
       (cond ((and (not (string-match "\\+" time))
                   (car parsed-time)
-                  (equal mtime (apply 'encode-time parsed-time)))
+                  ;; Compare just the seconds part of the file time,
+                  ;; since CVS file time stamp resolution is just 1 second.
+                  (let ((ptime (apply 'encode-time parsed-time)))
+                    (and (eq (car mtime) (car ptime))
+                         (eq (cadr mtime) (cadr ptime)))))
              (vc-file-setprop file 'vc-checkout-time mtime)
              (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
             (t
@@ -1206,10 +1222,8 @@ is non-nil."
       res)))
 
 (defun vc-cvs-revision-completion-table (files)
-  (lexical-let ((files files)
-                table)
-    (setq table (lazy-completion-table
-                 table (lambda () (vc-cvs-revision-table (car files)))))
+  (letrec ((table (lazy-completion-table
+                   table (lambda () (vc-cvs-revision-table (car files))))))
     table))