Mercurial > emacs
comparison lisp/vc/pcvs-parse.el @ 109404:e93288477c43
Merge from mainline.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sun, 13 Jun 2010 22:57:55 +0000 |
parents | lisp/pcvs-parse.el@1d1d5d9bd884 lisp/pcvs-parse.el@6ff48295959a |
children | 1b626601d32d |
comparison
equal
deleted
inserted
replaced
109403:681cd08dc0f7 | 109404:e93288477c43 |
---|---|
1 ;;; pcvs-parse.el --- the CVS output parser | |
2 | |
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, | |
4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
7 ;; Keywords: pcl-cvs | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation, either version 3 of the License, or | |
14 ;; (at your option) any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;;; Bugs: | |
27 | |
28 ;; - when merging a modified file, if the merge says that the file already | |
29 ;; contained in the changes, it marks the file as `up-to-date' although | |
30 ;; it might still contain further changes. | |
31 ;; Example: merging a zero-change commit. | |
32 | |
33 ;;; Code: | |
34 | |
35 (eval-when-compile (require 'cl)) | |
36 | |
37 (require 'pcvs-util) | |
38 (require 'pcvs-info) | |
39 | |
40 ;; imported from pcvs.el | |
41 (defvar cvs-execute-single-dir) | |
42 | |
43 ;; parse vars | |
44 | |
45 (defcustom cvs-update-prog-output-skip-regexp "$" | |
46 "A regexp that matches the end of the output from all cvs update programs. | |
47 That is, output from any programs that are run by CVS (by the flag -u | |
48 in the `modules' file - see cvs(5)) when `cvs update' is performed should | |
49 terminate with a line that this regexp matches. It is enough that | |
50 some part of the line is matched. | |
51 | |
52 The default (a single $) fits programs without output." | |
53 :group 'pcl-cvs | |
54 :type '(regexp :value "$")) | |
55 | |
56 (defcustom cvs-parse-ignored-messages | |
57 '("Executing ssh-askpass to query the password.*$" | |
58 ".*Remote host denied X11 forwarding.*$") | |
59 "A list of regexps matching messages that should be ignored by the parser. | |
60 Each regexp should match a whole set of lines and should hence be terminated | |
61 by `$'." | |
62 :group 'pcl-cvs | |
63 :type '(repeat regexp)) | |
64 | |
65 ;; a few more defvars just to shut up the compiler | |
66 (defvar cvs-start) | |
67 (defvar cvs-current-dir) | |
68 (defvar cvs-current-subdir) | |
69 (defvar dont-change-disc) | |
70 | |
71 ;;;; The parser | |
72 | |
73 (defconst cvs-parse-known-commands | |
74 '("status" "add" "commit" "update" "remove" "checkout" "ci") | |
75 "List of CVS commands whose output is understood by the parser.") | |
76 | |
77 (defun cvs-parse-buffer (parse-spec dont-change-disc &optional subdir) | |
78 "Parse current buffer according to PARSE-SPEC. | |
79 PARSE-SPEC is a function of no argument advancing the point and returning | |
80 either a fileinfo or t (if the matched text should be ignored) or | |
81 nil if it didn't match anything. | |
82 DONT-CHANGE-DISC just indicates whether the command was changing the disc | |
83 or not (useful to tell the difference between `cvs-examine' and `cvs-update' | |
84 output. | |
85 The path names should be interpreted as relative to SUBDIR (defaults | |
86 to the `default-directory'). | |
87 Return a list of collected entries, or t if an error occurred." | |
88 (goto-char (point-min)) | |
89 (let ((fileinfos ()) | |
90 (cvs-current-dir "") | |
91 (case-fold-search nil) | |
92 (cvs-current-subdir (or subdir ""))) | |
93 (while (not (or (eobp) (eq fileinfos t))) | |
94 (let ((ret (cvs-parse-run-table parse-spec))) | |
95 (cond | |
96 ;; it matched a known information message | |
97 ((cvs-fileinfo-p ret) (push ret fileinfos)) | |
98 ;; it didn't match anything at all (impossible) | |
99 ((and (consp ret) (cvs-fileinfo-p (car ret))) | |
100 (setq fileinfos (append ret fileinfos))) | |
101 ((null ret) (setq fileinfos t)) | |
102 ;; it matched something that should be ignored | |
103 (t nil)))) | |
104 (nreverse fileinfos))) | |
105 | |
106 | |
107 ;; All those parsing macros/functions should return a success indicator | |
108 (defsubst cvs-parse-msg () (buffer-substring cvs-start (1- (point)))) | |
109 | |
110 ;;(defsubst COLLECT (exp) (push exp *result*)) | |
111 ;;(defsubst PROG (e) t) | |
112 ;;(defmacro SEQ (&rest seqs) (cons 'and seqs)) | |
113 | |
114 (defmacro cvs-match (re &rest matches) | |
115 "Try to match RE and extract submatches. | |
116 If RE matches, advance the point until the line after the match and | |
117 then assign the variables as specified in MATCHES (via `setq')." | |
118 (cons 'cvs-do-match | |
119 (cons re (mapcar (lambda (match) | |
120 `(cons ',(first match) ,(second match))) | |
121 matches)))) | |
122 | |
123 (defun cvs-do-match (re &rest matches) | |
124 "Internal function for the `cvs-match' macro. | |
125 Match RE and if successful, execute MATCHES." | |
126 ;; Is it a match? | |
127 (when (looking-at re) | |
128 (goto-char (match-end 0)) | |
129 ;; Skip the newline (unless we already are at the end of the buffer). | |
130 (when (and (eolp) (< (point) (point-max))) (forward-char)) | |
131 ;; assign the matches | |
132 (dolist (match matches t) | |
133 (let ((val (cdr match))) | |
134 (set (car match) (if (integerp val) (match-string val) val)))))) | |
135 | |
136 (defmacro cvs-or (&rest alts) | |
137 "Try each one of the ALTS alternatives until one matches." | |
138 `(let ((-cvs-parse-point (point))) | |
139 ,(cons 'or | |
140 (mapcar (lambda (es) | |
141 `(or ,es (ignore (goto-char -cvs-parse-point)))) | |
142 alts)))) | |
143 (def-edebug-spec cvs-or t) | |
144 | |
145 ;; This is how parser tables should be executed | |
146 (defun cvs-parse-run-table (parse-spec) | |
147 "Run PARSE-SPEC and provide sensible default behavior." | |
148 (unless (bolp) (forward-line 1)) ;this should never be needed | |
149 (let ((cvs-start (point))) | |
150 (cvs-or | |
151 (funcall parse-spec) | |
152 | |
153 (dolist (re cvs-parse-ignored-messages) | |
154 (when (cvs-match re) (return t))) | |
155 | |
156 ;; This is a parse error. Create a message-type fileinfo. | |
157 (and | |
158 (cvs-match ".*$") | |
159 (cvs-create-fileinfo 'MESSAGE cvs-current-dir " " | |
160 ;; (concat " Unknown msg: '" | |
161 (cvs-parse-msg) ;; "'") | |
162 :subtype 'ERROR))))) | |
163 | |
164 | |
165 (defun cvs-parsed-fileinfo (type path &optional directory &rest keys) | |
166 "Create a fileinfo. | |
167 TYPE can either be a type symbol or a cons of the form (TYPE . SUBTYPE). | |
168 PATH is the filename. | |
169 DIRECTORY influences the way PATH is interpreted: | |
170 - if it's a string, it denotes the directory in which PATH (which should then be | |
171 a plain file name with no directory component) resides. | |
172 - if it's nil, the PATH should not be trusted: if it has a directory | |
173 component, use it, else, assume it is relative to the current directory. | |
174 - else, the PATH should be trusted to be relative to the root | |
175 directory (i.e. if there is no directory component, it means the file | |
176 is inside the main directory). | |
177 The remaining KEYS are passed directly to `cvs-create-fileinfo'." | |
178 (let ((dir directory) | |
179 (file path)) | |
180 ;; only trust the directory if it's a string | |
181 (unless (stringp directory) | |
182 ;; else, if the directory is true, the path should be trusted | |
183 (setq dir (or (file-name-directory path) (if directory ""))) | |
184 (setq file (file-name-nondirectory path))) | |
185 | |
186 (let ((type (if (consp type) (car type) type)) | |
187 (subtype (if (consp type) (cdr type)))) | |
188 (when dir (setq cvs-current-dir dir)) | |
189 (apply 'cvs-create-fileinfo type | |
190 (concat cvs-current-subdir (or dir cvs-current-dir)) | |
191 file (cvs-parse-msg) :subtype subtype keys)))) | |
192 | |
193 ;;;; CVS Process Parser Tables: | |
194 ;;;; | |
195 ;;;; The table for status and update could actually be merged since they | |
196 ;;;; don't conflict. But they don't overlap much either. | |
197 | |
198 (defun cvs-parse-table () | |
199 "Table of message objects for `cvs-parse-process'." | |
200 (let (c file dir path base-rev subtype) | |
201 (cvs-or | |
202 | |
203 (cvs-parse-status) | |
204 (cvs-parse-merge) | |
205 (cvs-parse-commit) | |
206 | |
207 ;; this is not necessary because the fileinfo merging will remove | |
208 ;; such duplicate info and luckily the second info is the one we want. | |
209 ;; (and (cvs-match "M \\(.*\\)$" (path 1)) | |
210 ;; (cvs-parse-merge path)) | |
211 | |
212 ;; Normal file state indicator. | |
213 (and | |
214 (cvs-match "\\([MARCUPNJ?]\\) \\(.*\\)$" (c 1) (path 2)) | |
215 ;; M: The file is modified by the user, and untouched in the repository. | |
216 ;; A: The file is "cvs add"ed, but not "cvs ci"ed. | |
217 ;; R: The file is "cvs remove"ed, but not "cvs ci"ed. | |
218 ;; C: Conflict | |
219 ;; U: The file is copied from the repository. | |
220 ;; P: The file was patched from the repository. | |
221 ;; ?: Unknown file. | |
222 (let ((code (aref c 0))) | |
223 (cvs-parsed-fileinfo | |
224 (case code | |
225 (?M 'MODIFIED) | |
226 (?A 'ADDED) | |
227 (?R 'REMOVED) | |
228 (?? 'UNKNOWN) | |
229 (?C | |
230 (if (not dont-change-disc) 'CONFLICT | |
231 ;; This is ambiguous. We should look for conflict markers in the | |
232 ;; file to decide between CONFLICT and NEED-MERGE. With CVS-1.10 | |
233 ;; servers, this should not be necessary, because they return | |
234 ;; a complete merge output. | |
235 (with-temp-buffer | |
236 (ignore-errors (insert-file-contents path)) | |
237 (goto-char (point-min)) | |
238 (if (re-search-forward "^<<<<<<< " nil t) | |
239 'CONFLICT 'NEED-MERGE)))) | |
240 (?J 'NEED-MERGE) ;not supported by standard CVS | |
241 ((?U ?P) | |
242 (if dont-change-disc 'NEED-UPDATE | |
243 (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED))))) | |
244 path 'trust))) | |
245 | |
246 (and | |
247 (cvs-match "pcl-cvs: descending directory \\(.*\\)$" (dir 1)) | |
248 (setq cvs-current-subdir dir)) | |
249 | |
250 ;; A special cvs message | |
251 (and | |
252 (let ((case-fold-search t)) | |
253 (cvs-match "cvs[.a-z]* [a-z]+: ")) | |
254 (cvs-or | |
255 | |
256 ;; CVS is descending a subdirectory | |
257 ;; (status says `examining' while update says `updating') | |
258 (and | |
259 (cvs-match "\\(Examining\\|Updating\\) \\(.*\\)$" (dir 2)) | |
260 (let ((dir (if (string= "." dir) "" (file-name-as-directory dir)))) | |
261 (cvs-parsed-fileinfo 'DIRCHANGE "." dir))) | |
262 | |
263 ;; [-n update] A new (or pruned) directory appeared but isn't traversed | |
264 (and | |
265 (cvs-match "New directory `\\(.*\\)' -- ignored$" (dir 1)) | |
266 ;; (cvs-parsed-fileinfo 'MESSAGE " " (file-name-as-directory dir)) | |
267 ;; These messages either correspond to a true new directory | |
268 ;; that an update will bring in, or to a directory that's empty | |
269 ;; on the current branch (either because it only exists in other | |
270 ;; branches, or because it's been removed). | |
271 (if (ignore-errors | |
272 (with-temp-buffer | |
273 (ignore-errors | |
274 (insert-file-contents | |
275 (expand-file-name ".cvsignore" (file-name-directory dir)))) | |
276 (goto-char (point-min)) | |
277 (re-search-forward | |
278 (concat "^" (regexp-quote (file-name-nondirectory dir)) "/$") | |
279 nil t))) | |
280 t ;The user requested to ignore those messages. | |
281 (cvs-parsed-fileinfo '(NEED-UPDATE . NEW-DIR) dir t))) | |
282 | |
283 ;; File removed, since it is removed (by third party) in repository. | |
284 (and | |
285 (cvs-or | |
286 ;; some cvs versions output quotes around these files | |
287 (cvs-match "warning: `\\(.*\\)' is not (any longer) pertinent$" (file 1)) | |
288 (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) | |
289 (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1)) | |
290 (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) | |
291 (cvs-parsed-fileinfo | |
292 (if dont-change-disc '(NEED-UPDATE . REMOVED) 'DEAD) file)) | |
293 | |
294 ;; [add] | |
295 (and | |
296 (cvs-or | |
297 (cvs-match "scheduling file `\\(.*\\)' for addition.*$" (path 1)) | |
298 (cvs-match "re-adding file \\(.*\\) (in place of .*)$" (path 1))) | |
299 (cvs-parsed-fileinfo 'ADDED path)) | |
300 | |
301 ;; [add] this will also show up as a `U <file>' | |
302 (and | |
303 (cvs-match "`?\\(.*?\\)'?, version \\(.*\\), resurrected$" | |
304 (path 1) (base-rev 2)) | |
305 ;; FIXME: resurrection only brings back the original version, | |
306 ;; not the latest on the branch, so `up-to-date' is not always | |
307 ;; what we want. | |
308 (cvs-parsed-fileinfo '(UP-TO-DATE . RESURRECTED) path nil | |
309 :base-rev base-rev)) | |
310 | |
311 ;; [remove] | |
312 (and | |
313 (cvs-match "removed `\\(.*\\)'$" (path 1)) | |
314 (cvs-parsed-fileinfo 'DEAD path)) | |
315 | |
316 ;; [remove,merge] | |
317 (and | |
318 (cvs-match "scheduling `\\(.*\\)' for removal$" (file 1)) | |
319 (cvs-parsed-fileinfo 'REMOVED file)) | |
320 | |
321 ;; [update] File removed by you, but not cvs rm'd | |
322 (and | |
323 (cvs-match "warning: \\(.*\\) was lost$" (path 1)) | |
324 (cvs-match (concat "U " (regexp-quote path) "$")) | |
325 (cvs-parsed-fileinfo (if dont-change-disc | |
326 'MISSING | |
327 '(UP-TO-DATE . UPDATED)) | |
328 path)) | |
329 | |
330 ;; Mode conflicts (rather than contents) | |
331 (and | |
332 (cvs-match "conflict: ") | |
333 (cvs-or | |
334 (cvs-match "removed \\(.*\\) was modified by second party$" | |
335 (path 1) (subtype 'REMOVED)) | |
336 (cvs-match "\\(.*\\) created independently by second party$" | |
337 (path 1) (subtype 'ADDED)) | |
338 (cvs-match "\\(.*\\) is modified but no longer in the repository$" | |
339 (path 1) (subtype 'MODIFIED))) | |
340 (cvs-match (concat "C " (regexp-quote path))) | |
341 (cvs-parsed-fileinfo (cons 'CONFLICT subtype) path)) | |
342 | |
343 ;; Messages that should be shown to the user | |
344 (and | |
345 (cvs-or | |
346 (cvs-match "move away \\(.*\\); it is in the way$" (file 1)) | |
347 (cvs-match "warning: new-born \\(.*\\) has disappeared$" (file 1)) | |
348 (cvs-match "sticky tag .* for file `\\(.*\\)' is not a branch$" | |
349 (file 1))) | |
350 (cvs-parsed-fileinfo 'MESSAGE file)) | |
351 | |
352 ;; File unknown. | |
353 (and (cvs-match "use `.+ add' to create an entry for \\(.*\\)$" (path 1)) | |
354 (cvs-parsed-fileinfo 'UNKNOWN path)) | |
355 | |
356 ;; [commit] | |
357 (and (cvs-match "Up-to-date check failed for `\\(.+\\)'$" (file 1)) | |
358 (cvs-parsed-fileinfo 'NEED-MERGE file)) | |
359 | |
360 ;; We use cvs-execute-multi-dir but cvs can't handle it | |
361 ;; Probably because the cvs-client can but the cvs-server can't | |
362 (and (cvs-match ".* files with '?/'? in their name.*$") | |
363 (not cvs-execute-single-dir) | |
364 (setq cvs-execute-single-dir t) | |
365 (cvs-create-fileinfo | |
366 'MESSAGE "" " " | |
367 "*** Add (setq cvs-execute-single-dir t) to your .emacs *** | |
368 See the FAQ file or the variable's documentation for more info.")) | |
369 | |
370 ;; Cvs waits for a lock. Ignored: already handled by the process filter | |
371 (cvs-match "\\[..:..:..\\] \\(waiting for\\|obtained\\) .*lock in .*$") | |
372 ;; File you removed still exists. Ignore (will be noted as removed). | |
373 (cvs-match ".* should be removed and is still there$") | |
374 ;; just a note | |
375 (cvs-match "use ['`].+ commit' to \\sw+ th\\sw+ files? permanently$") | |
376 ;; [add,status] followed by a more complete status description anyway | |
377 (and (cvs-match "nothing known about \\(.*\\)$" (path 1)) | |
378 (cvs-parsed-fileinfo 'DEAD path 'trust)) | |
379 ;; [update] problem with patch | |
380 (cvs-match "checksum failure after patch to .*; will refetch$") | |
381 (cvs-match "refetching unpatchable files$") | |
382 ;; [commit] | |
383 (cvs-match "Rebuilding administrative file database$") | |
384 ;; ??? | |
385 (cvs-match "--> Using per-directory sticky tag `.*'") | |
386 | |
387 ;; CVS is running a *info program. | |
388 (and | |
389 (cvs-match "Executing.*$") | |
390 ;; Skip by any output the program may generate to stdout. | |
391 ;; Note that pcl-cvs will get seriously confused if the | |
392 ;; program prints anything to stderr. | |
393 (re-search-forward cvs-update-prog-output-skip-regexp)))) | |
394 | |
395 (and | |
396 (cvs-match "cvs[.ex]* \\[[a-z]+ aborted\\]:.*$") | |
397 (cvs-parsed-fileinfo 'MESSAGE "")) | |
398 | |
399 ;; sadly you can't do much with these since the path is in the repository | |
400 (cvs-match "Directory .* added to the repository$") | |
401 ))) | |
402 | |
403 | |
404 (defun cvs-parse-merge () | |
405 (let (path base-rev head-rev type) | |
406 ;; A merge (maybe with a conflict). | |
407 (and | |
408 (cvs-match "RCS file: .*$") | |
409 ;; Squirrel away info about the files that were retrieved for merging | |
410 (cvs-match "retrieving revision \\([0-9.]+\\)$" (base-rev 1)) | |
411 (cvs-match "retrieving revision \\([0-9.]+\\)$" (head-rev 1)) | |
412 (cvs-match "Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$" | |
413 (path 1)) | |
414 | |
415 ;; eat up potential conflict warnings | |
416 (cvs-or (cvs-match "\\(rcs\\)?merge:?\\( warning\\)?: \\(overlaps\\|conflicts\\) \\(or other problems \\)?during merge$" (type 'CONFLICT)) t) | |
417 (cvs-or | |
418 (and | |
419 (cvs-match "cvs[.ex]* [a-z]+: ") | |
420 (cvs-or | |
421 (cvs-match "conflicts found in \\(.*\\)$" (path 1) (type 'CONFLICT)) | |
422 (cvs-match "could not merge .*$") | |
423 (cvs-match "restoring \\(.*\\) from backup file .*$" (path 1)))) | |
424 t) | |
425 | |
426 ;; Is it a succesful merge? | |
427 ;; Figure out result of merging (ie, was there a conflict?) | |
428 (let ((qfile (regexp-quote path))) | |
429 (cvs-or | |
430 ;; Conflict | |
431 (and | |
432 (cvs-match (concat "C \\(.*" qfile "\\)$") (path 1) (type 'CONFLICT)) | |
433 ;; C might be followed by a "suprious" U for non-mergeable files | |
434 (cvs-or (cvs-match (concat "U \\(.*" qfile "\\)$")) t)) | |
435 ;; Successful merge | |
436 (cvs-match (concat "M \\(.*" qfile "\\)$") (path 1)) | |
437 ;; The file already contained the modifications | |
438 (cvs-match (concat "^\\(.*" qfile | |
439 "\\) already contains the differences between .*$") | |
440 (path 1) (type '(UP-TO-DATE . MERGED))) | |
441 t) | |
442 ;; FIXME: PATH might not be set yet. Sometimes the only path | |
443 ;; information is in `RCS file: ...' (yuck!!). | |
444 (cvs-parsed-fileinfo (if dont-change-disc 'NEED-MERGE | |
445 (or type '(MODIFIED . MERGED))) path nil | |
446 :merge (cons base-rev head-rev)))))) | |
447 | |
448 (defun cvs-parse-status () | |
449 (let (nofile path base-rev head-rev type) | |
450 (and | |
451 (cvs-match | |
452 "===================================================================$") | |
453 (cvs-match "File: \\(no file \\)?\\(.*[^ \t]\\)[ \t]+Status: " | |
454 (nofile 1) (path 2)) | |
455 (cvs-or | |
456 (cvs-match "Needs \\(Checkout\\|Patch\\)$" | |
457 (type (if nofile 'MISSING 'NEED-UPDATE))) | |
458 (cvs-match "Up-to-date$" | |
459 (type (if nofile '(UP-TO-DATE . REMOVED) 'UP-TO-DATE))) | |
460 (cvs-match "File had conflicts on merge$" (type 'MODIFIED)) | |
461 (cvs-match ".*[Cc]onflict.*$" (type 'CONFLICT)) | |
462 (cvs-match "Locally Added$" (type 'ADDED)) | |
463 (cvs-match "Locally Removed$" (type 'REMOVED)) | |
464 (cvs-match "Locally Modified$" (type 'MODIFIED)) | |
465 (cvs-match "Needs Merge$" (type 'NEED-MERGE)) | |
466 (cvs-match "Entry Invalid" (type '(NEED-MERGE . REMOVED))) | |
467 (cvs-match ".*$" (type 'UNKNOWN))) | |
468 (cvs-match "$") | |
469 (cvs-or | |
470 (cvs-match " *Version:[ \t]*\\([0-9.]+\\).*$" (base-rev 1)) | |
471 ;; NOTE: there's no date on the end of the following for server mode... | |
472 (cvs-match " *Working revision:[ \t]*-?\\([0-9.]+\\).*$" (base-rev 1)) | |
473 ;; Let's not get all worked up if the format changes a bit | |
474 (cvs-match " *Working revision:.*$")) | |
475 (cvs-or | |
476 (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1)) | |
477 (cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$" | |
478 (head-rev 1)) | |
479 (cvs-match " *Repository revision:.*")) | |
480 (cvs-or (cvs-match " *Expansion option:.*") t) ;Optional CVSNT thingie. | |
481 (cvs-or (cvs-match " *Commit Identifier:.*") t) ;Optional CVSNT thingie. | |
482 (cvs-or | |
483 (and ;; Sometimes those fields are missing. | |
484 (cvs-match " *Sticky Tag:[ \t]*\\(.*\\)$") ; FIXME: use it. | |
485 (cvs-match " *Sticky Date:[ \t]*\\(.*\\)$") ; FIXME: use it. | |
486 (cvs-match " *Sticky Options:[ \t]*\\(.*\\)$")) ; FIXME: use it. | |
487 t) | |
488 (cvs-or (cvs-match " *Merge From:.*") t) ;Optional CVSNT thingie. | |
489 (cvs-match "$") | |
490 ;; ignore the tags-listing in the case of `status -v' | |
491 (cvs-or (cvs-match " *Existing Tags:\n\\(\t.*\n\\)*$") t) | |
492 (cvs-parsed-fileinfo type path nil | |
493 :base-rev base-rev | |
494 :head-rev head-rev)))) | |
495 | |
496 (defun cvs-parse-commit () | |
497 (let (path file base-rev subtype) | |
498 (cvs-or | |
499 | |
500 (and | |
501 (cvs-or | |
502 (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) | |
503 t) | |
504 (cvs-match ".*,v <-- \\(.*\\)$" (file 1)) | |
505 (cvs-or | |
506 ;; deletion | |
507 (cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$" | |
508 (subtype 'REMOVED) (base-rev 1)) | |
509 ;; addition | |
510 (cvs-match "initial revision: \\([0-9.]*\\)$" | |
511 (subtype 'ADDED) (base-rev 1)) | |
512 ;; update | |
513 (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$" | |
514 (subtype 'COMMITTED) (base-rev 1))) | |
515 (cvs-or (cvs-match "done$") t) | |
516 ;; In cvs-1.12.9 commit messages have been changed and became | |
517 ;; ambiguous. More specifically, the `path' above is not given. | |
518 ;; We assume here that in future releases the corresponding info will | |
519 ;; be put into `file'. | |
520 (progn | |
521 ;; Try to remove the temp files used by VC. | |
522 (vc-delete-automatic-version-backups (expand-file-name (or path file))) | |
523 ;; it's important here not to rely on the default directory management | |
524 ;; because `cvs commit' might begin by a series of Examining messages | |
525 ;; so the processing of the actual checkin messages might begin with | |
526 ;; a `current-dir' set to something different from "" | |
527 (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) | |
528 (or path file) 'trust | |
529 :base-rev base-rev))) | |
530 | |
531 ;; useless message added before the actual addition: ignored | |
532 (cvs-match "RCS file: .*\ndone$")))) | |
533 | |
534 | |
535 (provide 'pcvs-parse) | |
536 | |
537 ;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6 | |
538 ;;; pcvs-parse.el ends here |