Mercurial > emacs

comparison lisp/vc-cvs.el @ 94563:a0bb8ca25a33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Clean up vc*-revision-granularity and vc*-checkout-model.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Fri, 02 May 2008 17:47:25 +0000
parents 16651da1e3ed
children ee5932bf781d
comparison
equal deleted inserted replaced
94562:46f178f2b009 94563:a0bb8ca25a33
33 33
34 ;; Clear up the cache to force vc-call to check again and discover 34 ;; Clear up the cache to force vc-call to check again and discover
35 ;; new functions when we reload this file. 35 ;; new functions when we reload this file.
36 (put 'CVS 'vc-functions nil) 36 (put 'CVS 'vc-functions nil)
37 37
38 ;;; 38 ;;; Properties of the backend.
39 ;;; Customization options 39
40 ;;; 40 (defun vc-cvs-revision-granularity () 'file)
41
42 (defcustom vc-cvs-global-switches nil
43 "*Global switches to pass to any CVS command."
44 :type '(choice (const :tag "None" nil)
45 (string :tag "Argument String")
46 (repeat :tag "Argument List"
47 :value ("")
48 string))
49 :version "22.1"
50 :group 'vc)
51
52 (defcustom vc-cvs-register-switches nil
53 "*Extra switches for registering a file into CVS.
54 A string or list of strings passed to the checkin program by
55 \\[vc-register]."
56 :type '(choice (const :tag "None" nil)
57 (string :tag "Argument String")
58 (repeat :tag "Argument List"
59 :value ("")
60 string))
61 :version "21.1"
62 :group 'vc)
63
64 (defcustom vc-cvs-diff-switches nil
65 "*A string or list of strings specifying extra switches for cvs diff under VC."
66 :type '(choice (const :tag "None" nil)
67 (string :tag "Argument String")
68 (repeat :tag "Argument List"
69 :value ("")
70 string))
71 :version "21.1"
72 :group 'vc)
73
74 (defcustom vc-cvs-header (or (cdr (assoc 'CVS vc-header-alist)) '("\$Id\$"))
75 "*Header keywords to be inserted by `vc-insert-headers'."
76 :version "21.1"
77 :type '(repeat string)
78 :group 'vc)
79
80 (defcustom vc-cvs-use-edit t
81 "*Non-nil means to use `cvs edit' to \"check out\" a file.
82 This is only meaningful if you don't use the implicit checkout model
83 \(i.e. if you have $CVSREAD set)."
84 :type 'boolean
85 :version "21.1"
86 :group 'vc)
87
88 (defcustom vc-cvs-stay-local t
89 "*Non-nil means use local operations when possible for remote repositories.
90 This avoids slow queries over the network and instead uses heuristics
91 and past information to determine the current status of a file.
92
93 The value can also be a regular expression or list of regular
94 expressions to match against the host name of a repository; then VC
95 only stays local for hosts that match it. Alternatively, the value
96 can be a list of regular expressions where the first element is the
97 symbol `except'; then VC always stays local except for hosts matched
98 by these regular expressions."
99 :type '(choice (const :tag "Always stay local" t)
100 (const :tag "Don't stay local" nil)
101 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
102 (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
103 (regexp :format " stay local,\n%t: %v" :tag "if it matches")
104 (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
105 :version "21.1"
106 :group 'vc)
107
108 (defcustom vc-cvs-sticky-date-format-string "%c"
109 "*Format string for mode-line display of sticky date.
110 Format is according to `format-time-string'. Only used if
111 `vc-cvs-sticky-tag-display' is t."
112 :type '(string)
113 :version "22.1"
114 :group 'vc)
115
116 (defcustom vc-cvs-sticky-tag-display t
117 "*Specify the mode-line display of sticky tags.
118 Value t means default display, nil means no display at all. If the
119 value is a function or macro, it is called with the sticky tag and
120 its' type as parameters, in that order. TYPE can have three different
121 values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
122 string) and `date' (TAG is a date as returned by `encode-time'). The
123 return value of the function or macro will be displayed as a string.
124
125 Here's an example that will display the formatted date for sticky
126 dates and the word \"Sticky\" for sticky tag names and revisions.
127
128 (lambda (tag type)
129 (cond ((eq type 'date) (format-time-string
130 vc-cvs-sticky-date-format-string tag))
131 ((eq type 'revision-number) \"Sticky\")
132 ((eq type 'symbolic-name) \"Sticky\")))
133
134 Here's an example that will abbreviate to the first character only,
135 any text before the first occurrence of `-' for sticky symbolic tags.
136 If the sticky tag is a revision number, the word \"Sticky\" is
137 displayed. Date and time is displayed for sticky dates.
138
139 (lambda (tag type)
140 (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
141 ((eq type 'revision-number) \"Sticky\")
142 ((eq type 'symbolic-name)
143 (condition-case nil
144 (progn
145 (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
146 (concat (substring (match-string 1 tag) 0 1) \":\"
147 (substring (match-string 2 tag) 1 nil)))
148 (error tag))))) ; Fall-back to given tag name.
149
150 See also variable `vc-cvs-sticky-date-format-string'."
151 :type '(choice boolean function)
152 :version "22.1"
153 :group 'vc)
154
155 ;;;
156 ;;; Internal variables
157 ;;;
158
159
160 ;;;
161 ;;; State-querying functions
162 ;;;
163
164 ;;;###autoload (defun vc-cvs-registered (f)
165 ;;;###autoload (when (file-readable-p (expand-file-name
166 ;;;###autoload "CVS/Entries" (file-name-directory f)))
167 ;;;###autoload (load "vc-cvs")
168 ;;;###autoload (vc-cvs-registered f)))
169
170 (defun vc-cvs-registered (file)
171 "Check if FILE is CVS registered."
172 (let ((dirname (or (file-name-directory file) ""))
173 (basename (file-name-nondirectory file))
174 ;; make sure that the file name is searched case-sensitively
175 (case-fold-search nil))
176 (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
177 (with-temp-buffer
178 (vc-cvs-get-entries dirname)
179 (goto-char (point-min))
180 (cond
181 ((re-search-forward
182 (concat "^/" (regexp-quote basename) "/[^/]") nil t)
183 (beginning-of-line)
184 (vc-cvs-parse-entry file)
185 t)
186 (t nil)))
187 nil)))
188
189 (defun vc-cvs-state (file)
190 "CVS-specific version of `vc-state'."
191 (if (vc-stay-local-p file)
192 (let ((state (vc-file-getprop file 'vc-state)))
193 ;; If we should stay local, use the heuristic but only if
194 ;; we don't have a more precise state already available.
195 (if (memq state '(up-to-date edited nil))
196 (vc-cvs-state-heuristic file)
197 state))
198 (with-temp-buffer
199 (cd (file-name-directory file))
200 (vc-cvs-command t 0 file "status")
201 (vc-cvs-parse-status t))))
202
203 (defun vc-cvs-state-heuristic (file)
204 "CVS-specific state heuristic."
205 ;; If the file has not changed since checkout, consider it `up-to-date'.
206 ;; Otherwise consider it `edited'.
207 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
208 (lastmod (nth 5 (file-attributes file))))
209 (cond
210 ((equal checkout-time lastmod) 'up-to-date)
211 ((string= (vc-working-revision file) "0") 'added)
212 (t 'edited))))
213
214 (defun vc-cvs-dir-state (dir)
215 "Find the CVS state of all files in DIR and subdirectories."
216 ;; if DIR is not under CVS control, don't do anything.
217 (when (file-readable-p (expand-file-name "CVS/Entries" dir))
218 (if (vc-stay-local-p dir)
219 (vc-cvs-dir-state-heuristic dir)
220 (let ((default-directory dir))
221 ;; Don't specify DIR in this command, the default-directory is
222 ;; enough. Otherwise it might fail with remote repositories.
223 (with-temp-buffer
224 (buffer-disable-undo) ;; Because these buffers can get huge
225 (vc-cvs-command t 0 nil "status")
226 (goto-char (point-min))
227 (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
228 (narrow-to-region (match-beginning 0) (match-end 0))
229 (vc-cvs-parse-status)
230 (goto-char (point-max))
231 (widen)))))))
232
233 (defun vc-cvs-working-revision (file)
234 "CVS-specific version of `vc-working-revision'."
235 ;; There is no need to consult RCS headers under CVS, because we
236 ;; get the workfile version for free when we recognize that a file
237 ;; is registered in CVS.
238 (vc-cvs-registered file)
239 (vc-file-getprop file 'vc-working-revision))
240 41
241 (defun vc-cvs-checkout-model (files) 42 (defun vc-cvs-checkout-model (files)
242 "CVS-specific version of `vc-checkout-model'." 43 "CVS-specific version of `vc-checkout-model'."
243 (if (getenv "CVSREAD") 44 (if (getenv "CVSREAD")
244 'announce 45 'announce
255 ;; trust this, but there is no other way to learn this from 56 ;; trust this, but there is no other way to learn this from
256 ;; CVS at the moment (version 1.9).) 57 ;; CVS at the moment (version 1.9).)
257 (string-match "r-..-..-." (nth 8 attrib))) 58 (string-match "r-..-..-." (nth 8 attrib)))
258 'announce 59 'announce
259 'implicit)))))) 60 'implicit))))))
61
62 ;;;
63 ;;; Customization options
64 ;;;
65
66 (defcustom vc-cvs-global-switches nil
67 "*Global switches to pass to any CVS command."
68 :type '(choice (const :tag "None" nil)
69 (string :tag "Argument String")
70 (repeat :tag "Argument List"
71 :value ("")
72 string))
73 :version "22.1"
74 :group 'vc)
75
76 (defcustom vc-cvs-register-switches nil
77 "*Extra switches for registering a file into CVS.
78 A string or list of strings passed to the checkin program by
79 \\[vc-register]."
80 :type '(choice (const :tag "None" nil)
81 (string :tag "Argument String")
82 (repeat :tag "Argument List"
83 :value ("")
84 string))
85 :version "21.1"
86 :group 'vc)
87
88 (defcustom vc-cvs-diff-switches nil
89 "*A string or list of strings specifying extra switches for cvs diff under VC."
90 :type '(choice (const :tag "None" nil)
91 (string :tag "Argument String")
92 (repeat :tag "Argument List"
93 :value ("")
94 string))
95 :version "21.1"
96 :group 'vc)
97
98 (defcustom vc-cvs-header (or (cdr (assoc 'CVS vc-header-alist)) '("\$Id\$"))
99 "*Header keywords to be inserted by `vc-insert-headers'."
100 :version "21.1"
101 :type '(repeat string)
102 :group 'vc)
103
104 (defcustom vc-cvs-use-edit t
105 "*Non-nil means to use `cvs edit' to \"check out\" a file.
106 This is only meaningful if you don't use the implicit checkout model
107 \(i.e. if you have $CVSREAD set)."
108 :type 'boolean
109 :version "21.1"
110 :group 'vc)
111
112 (defcustom vc-cvs-stay-local t
113 "*Non-nil means use local operations when possible for remote repositories.
114 This avoids slow queries over the network and instead uses heuristics
115 and past information to determine the current status of a file.
116
117 The value can also be a regular expression or list of regular
118 expressions to match against the host name of a repository; then VC
119 only stays local for hosts that match it. Alternatively, the value
120 can be a list of regular expressions where the first element is the
121 symbol `except'; then VC always stays local except for hosts matched
122 by these regular expressions."
123 :type '(choice (const :tag "Always stay local" t)
124 (const :tag "Don't stay local" nil)
125 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
126 (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
127 (regexp :format " stay local,\n%t: %v" :tag "if it matches")
128 (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
129 :version "21.1"
130 :group 'vc)
131
132 (defcustom vc-cvs-sticky-date-format-string "%c"
133 "*Format string for mode-line display of sticky date.
134 Format is according to `format-time-string'. Only used if
135 `vc-cvs-sticky-tag-display' is t."
136 :type '(string)
137 :version "22.1"
138 :group 'vc)
139
140 (defcustom vc-cvs-sticky-tag-display t
141 "*Specify the mode-line display of sticky tags.
142 Value t means default display, nil means no display at all. If the
143 value is a function or macro, it is called with the sticky tag and
144 its' type as parameters, in that order. TYPE can have three different
145 values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
146 string) and `date' (TAG is a date as returned by `encode-time'). The
147 return value of the function or macro will be displayed as a string.
148
149 Here's an example that will display the formatted date for sticky
150 dates and the word \"Sticky\" for sticky tag names and revisions.
151
152 (lambda (tag type)
153 (cond ((eq type 'date) (format-time-string
154 vc-cvs-sticky-date-format-string tag))
155 ((eq type 'revision-number) \"Sticky\")
156 ((eq type 'symbolic-name) \"Sticky\")))
157
158 Here's an example that will abbreviate to the first character only,
159 any text before the first occurrence of `-' for sticky symbolic tags.
160 If the sticky tag is a revision number, the word \"Sticky\" is
161 displayed. Date and time is displayed for sticky dates.
162
163 (lambda (tag type)
164 (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
165 ((eq type 'revision-number) \"Sticky\")
166 ((eq type 'symbolic-name)
167 (condition-case nil
168 (progn
169 (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
170 (concat (substring (match-string 1 tag) 0 1) \":\"
171 (substring (match-string 2 tag) 1 nil)))
172 (error tag))))) ; Fall-back to given tag name.
173
174 See also variable `vc-cvs-sticky-date-format-string'."
175 :type '(choice boolean function)
176 :version "22.1"
177 :group 'vc)
178
179 ;;;
180 ;;; Internal variables
181 ;;;
182
183
184 ;;;
185 ;;; State-querying functions
186 ;;;
187
188 ;;;###autoload (defun vc-cvs-registered (f)
189 ;;;###autoload (when (file-readable-p (expand-file-name
190 ;;;###autoload "CVS/Entries" (file-name-directory f)))
191 ;;;###autoload (load "vc-cvs")
192 ;;;###autoload (vc-cvs-registered f)))
193
194 (defun vc-cvs-registered (file)
195 "Check if FILE is CVS registered."
196 (let ((dirname (or (file-name-directory file) ""))
197 (basename (file-name-nondirectory file))
198 ;; make sure that the file name is searched case-sensitively
199 (case-fold-search nil))
200 (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
201 (with-temp-buffer
202 (vc-cvs-get-entries dirname)
203 (goto-char (point-min))
204 (cond
205 ((re-search-forward
206 (concat "^/" (regexp-quote basename) "/[^/]") nil t)
207 (beginning-of-line)
208 (vc-cvs-parse-entry file)
209 t)
210 (t nil)))
211 nil)))
212
213 (defun vc-cvs-state (file)
214 "CVS-specific version of `vc-state'."
215 (if (vc-stay-local-p file)
216 (let ((state (vc-file-getprop file 'vc-state)))
217 ;; If we should stay local, use the heuristic but only if
218 ;; we don't have a more precise state already available.
219 (if (memq state '(up-to-date edited nil))
220 (vc-cvs-state-heuristic file)
221 state))
222 (with-temp-buffer
223 (cd (file-name-directory file))
224 (vc-cvs-command t 0 file "status")
225 (vc-cvs-parse-status t))))
226
227 (defun vc-cvs-state-heuristic (file)
228 "CVS-specific state heuristic."
229 ;; If the file has not changed since checkout, consider it `up-to-date'.
230 ;; Otherwise consider it `edited'.
231 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
232 (lastmod (nth 5 (file-attributes file))))
233 (cond
234 ((equal checkout-time lastmod) 'up-to-date)
235 ((string= (vc-working-revision file) "0") 'added)
236 (t 'edited))))
237
238 (defun vc-cvs-dir-state (dir)
239 "Find the CVS state of all files in DIR and subdirectories."
240 ;; if DIR is not under CVS control, don't do anything.
241 (when (file-readable-p (expand-file-name "CVS/Entries" dir))
242 (if (vc-stay-local-p dir)
243 (vc-cvs-dir-state-heuristic dir)
244 (let ((default-directory dir))
245 ;; Don't specify DIR in this command, the default-directory is
246 ;; enough. Otherwise it might fail with remote repositories.
247 (with-temp-buffer
248 (buffer-disable-undo) ;; Because these buffers can get huge
249 (vc-cvs-command t 0 nil "status")
250 (goto-char (point-min))
251 (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
252 (narrow-to-region (match-beginning 0) (match-end 0))
253 (vc-cvs-parse-status)
254 (goto-char (point-max))
255 (widen)))))))
256
257 (defun vc-cvs-working-revision (file)
258 "CVS-specific version of `vc-working-revision'."
259 ;; There is no need to consult RCS headers under CVS, because we
260 ;; get the workfile version for free when we recognize that a file
261 ;; is registered in CVS.
262 (vc-cvs-registered file)
263 (vc-file-getprop file 'vc-working-revision))
260 264
261 (defun vc-cvs-mode-line-string (file) 265 (defun vc-cvs-mode-line-string (file)
262 "Return string for placement into the modeline for FILE. 266 "Return string for placement into the modeline for FILE.
263 Compared to the default implementation, this function does two things: 267 Compared to the default implementation, this function does two things:
264 Handle the special case of a CVS file that is added but not yet 268 Handle the special case of a CVS file that is added but not yet
391 ;; Change buffers to get local value of vc-checkout-switches. 395 ;; Change buffers to get local value of vc-checkout-switches.
392 (with-current-buffer (or (get-file-buffer file) (current-buffer)) 396 (with-current-buffer (or (get-file-buffer file) (current-buffer))
393 (if (and (file-exists-p file) (not rev)) 397 (if (and (file-exists-p file) (not rev))
394 ;; If no revision was specified, just make the file writable 398 ;; If no revision was specified, just make the file writable
395 ;; if necessary (using `cvs-edit' if requested). 399 ;; if necessary (using `cvs-edit' if requested).
396 (and editable (not (eq (vc-cvs-checkout-model file) 'implicit)) 400 (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
397 (if vc-cvs-use-edit 401 (if vc-cvs-use-edit
398 (vc-cvs-command nil 0 file "edit") 402 (vc-cvs-command nil 0 file "edit")
399 (set-file-modes file (logior (file-modes file) 128)) 403 (set-file-modes file (logior (file-modes file) 128))
400 (if (equal file buffer-file-name) (toggle-read-only -1)))) 404 (if (equal file buffer-file-name) (toggle-read-only -1))))
401 ;; Check out a particular revision (or recreate the file). 405 ;; Check out a particular revision (or recreate the file).
419 (vc-cvs-command nil 0 file "remove" "-f")) 423 (vc-cvs-command nil 0 file "remove" "-f"))
420 424
421 (defun vc-cvs-revert (file &optional contents-done) 425 (defun vc-cvs-revert (file &optional contents-done)
422 "Revert FILE to the working revision on which it was based." 426 "Revert FILE to the working revision on which it was based."
423 (vc-default-revert 'CVS file contents-done) 427 (vc-default-revert 'CVS file contents-done)
424 (unless (eq (vc-cvs-checkout-model file) 'implicit) 428 (unless (eq (vc-cvs-checkout-model (list file)) 'implicit)
425 (if vc-cvs-use-edit 429 (if vc-cvs-use-edit
426 (vc-cvs-command nil 0 file "unedit") 430 (vc-cvs-command nil 0 file "unedit")
427 ;; Make the file read-only by switching off all w-bits 431 ;; Make the file read-only by switching off all w-bits
428 (set-file-modes file (logand (file-modes file) 3950))))) 432 (set-file-modes file (logand (file-modes file) 3950)))))
429 433