X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8f50130c565eaf0ad7c49e4ad044c3291ecdfa71..da77a2e2ebfd09f70d6b91d868ae9195a9981206:/lisp/vc/vc-cvs.el diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 7d6c3caf7f..17b278d1ce 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 +;;; 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 @@ -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. @@ -59,6 +59,11 @@ ;;; 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) @@ -67,7 +72,7 @@ :value ("") string)) :version "22.1" - :group 'vc) + :group 'vc-cvs) (defcustom vc-cvs-register-switches nil "Switches for registering a file into CVS. @@ -79,7 +84,7 @@ If t, use no switches." (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. @@ -89,13 +94,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (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. @@ -103,14 +108,14 @@ This is only meaningful if you don't use the implicit checkout model \(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. @@ -131,7 +136,7 @@ by these regular expressions." :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. @@ -139,7 +144,7 @@ Format is according to `format-time-string'. Only used if `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. @@ -178,7 +183,7 @@ displayed. Date and time is displayed for sticky dates. See also variable `vc-cvs-sticky-date-format-string'." :type '(choice boolean function) :version "22.1" - :group 'vc) + :group 'vc-cvs) ;;; ;;; Internal variables @@ -193,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) @@ -251,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." @@ -275,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' @@ -319,7 +326,7 @@ its parents." (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)) @@ -389,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 @@ -410,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) @@ -496,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 @@ -513,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 @@ -557,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. @@ -578,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) @@ -661,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'. @@ -785,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))))) @@ -1001,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 @@ -1016,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 @@ -1173,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 @@ -1201,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))