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