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