HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
lisp/desktop.el (desktop-clear): Fix previous change.
[bpt/emacs.git]
/
lisp
/
vc
/
vc-cvs.el
diff --git
a/lisp/vc/vc-cvs.el
b/lisp/vc/vc-cvs.el
index
7d6c3ca
..
17b278d
100644
(file)
--- 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-201
1
Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-201
3
Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@
-25,7
+25,7
@@
;;; Code:
;;; 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.
;; 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
;;;
;;; 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)
(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"
:value ("")
string))
:version "22.1"
- :group 'vc)
+ :group 'vc
-cvs
)
(defcustom vc-cvs-register-switches nil
"Switches for registering a file into 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"
(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.
(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"
(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)
(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.
(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"
\(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.
(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.
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"
: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.
(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"
`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.
(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"
See also variable `vc-cvs-sticky-date-format-string'."
:type '(choice boolean function)
:version "22.1"
- :group 'vc)
+ :group 'vc
-cvs
)
;;;
;;; Internal variables
;;;
;;; 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 "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)
;;;###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)
(vc-file-getprop file 'vc-working-revision))
(defun vc-cvs-mode-line-string (file)
- "Return
string for placement into the mode
line 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."
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
;;;
;;; 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'
"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)
(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 revis
i
on 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))
;; 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 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
;; 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"))
(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)
(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" ())
;;;
(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
(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))
"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
(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]")
(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)
(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.
(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.
(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)
(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)))
(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'.
(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)
((= 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)))))
(t
;; :METHOD:[USER@]HOST:PATH
(cdr root-list)))))
@@
-1001,7
+1018,7
@@
state."
(vc-exec-after
`(vc-cvs-after-dir-status (quote ,update-function))))))
(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
"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)))
(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
"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)
(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
(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)
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))
table))
HCoop / bpt / emacs.git / blobdiff