-;;; 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-2011 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>
;;; 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.
;;; Customization options
;;;
+(defgroup vc-cvs nil
+ "VC CVS backend."
+ :version "24.1"
+ :group 'vc)
+
(defcustom vc-cvs-global-switches nil
"Global switches to pass to any CVS command."
:type '(choice (const :tag "None" nil)
:value ("")
string))
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-register-switches nil
"Switches for registering a file into CVS.
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-diff-switches nil
"String or list of strings specifying switches for CVS diff under VC.
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "21.1"
- :group 'vc)
+ :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)
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-use-edit t
"Non-nil means to use `cvs edit' to \"check out\" a file.
\(i.e. if you have $CVSREAD set)."
:type 'boolean
:version "21.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-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.
-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.
:tag "if it matches")
(repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
:version "23.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-sticky-date-format-string "%c"
"Format string for mode-line display of sticky date.
`vc-cvs-sticky-tag-display' is t."
:type '(string)
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
(defcustom vc-cvs-sticky-tag-display t
"Specify the mode-line display of sticky tags.
See also variable `vc-cvs-sticky-date-format-string'."
:type '(choice boolean function)
:version "22.1"
- :group 'vc)
+ :group 'vc-cvs)
;;;
;;; Internal variables
;;;###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)
(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."
;;; 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'
(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 revison is a valid symbolic tag name, we create it
+ ;; 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))
(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
(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)
;;;
(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
"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
(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.
(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)
(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'.
((= 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)))))
(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
(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
(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
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))
HCoop / bpt / emacs.git / blobdiff