Mercurial > emacs
comparison lisp/vc-cvs.el @ 94563:a0bb8ca25a33
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 |