X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5b467bf4e2787e3290280cadbae9e915df88dacd..ae48944514a529eb78caff789171393fa6c82287:/lisp/pcvs-parse.el diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index b65f8d2eb6..66c791db51 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -1,11 +1,10 @@ -;;; pcvs-parse.el --- The CVS output parser +;;; pcvs-parse.el --- the CVS output parser -;; Copyright (C) 1991-2000 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs -;; Version: $Name: $ -;; Revision: $Id: pcl-cvs-parse.el,v 1.41 2000/03/05 21:32:21 monnier Exp $ ;; This file is part of GNU Emacs. @@ -21,11 +20,17 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: +;;; Bugs: + +;; - when merging a modified file, if the merge says that the file already +;; contained in the changes, it marks the file as `up-to-date' although +;; it might still contain further changes. +;; Example: merging a zero-change commit. ;;; Code: @@ -77,11 +82,11 @@ PARSE-SPEC is a function of no argument advancing the point and returning either a fileinfo or t (if the matched text should be ignored) or nil if it didn't match anything. DONT-CHANGE-DISC just indicates whether the command was changing the disc - or not (useful to tell the difference btween `cvs-examine' and `cvs-update' - ouytput. + or not (useful to tell the difference between `cvs-examine' and `cvs-update' + output. The path names should be interpreted as relative to SUBDIR (defaults to the `default-directory'). -Return a list of collected entries, or t if an error occured." +Return a list of collected entries, or t if an error occurred." (goto-char (point-min)) (let ((fileinfos ()) (cvs-current-dir "") @@ -154,7 +159,8 @@ Match RE and if successful, execute MATCHES." (and (cvs-match ".*$") (cvs-create-fileinfo 'MESSAGE cvs-current-dir " " - (concat " Parser Error: '" (cvs-parse-msg) "'") + ;; (concat " Unknown msg: '" + (cvs-parse-msg) ;; "'") :subtype 'ERROR))))) @@ -185,7 +191,6 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (apply 'cvs-create-fileinfo type (concat cvs-current-subdir (or dir cvs-current-dir)) file (cvs-parse-msg) :subtype subtype keys)))) - ;;;; CVS Process Parser Tables: ;;;; @@ -194,9 +199,9 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (defun cvs-parse-table () "Table of message objects for `cvs-parse-process'." - (let (c file dir path type base-rev subtype) + (let (c file dir path base-rev subtype) (cvs-or - + (cvs-parse-status) (cvs-parse-merge) (cvs-parse-commit) @@ -205,7 +210,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; such duplicate info and luckily the second info is the one we want. ;; (and (cvs-match "M \\(.*\\)$" (path 1)) ;; (cvs-parse-merge path)) - + ;; Normal file state indicator. (and (cvs-match "\\([MARCUPNJ?]\\) \\(.*\\)$" (c 1) (path 2)) @@ -217,19 +222,28 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; P: The file was patched from the repository. ;; ?: Unknown file. (let ((code (aref c 0))) - (cvs-parsed-fileinfo (case code - (?M 'MODIFIED) - (?A 'ADDED) - (?R 'REMOVED) - (?? 'UNKNOWN) - (?C 'CONFLICT) ;(if dont-change-disc 'NEED-MERGE - (?J 'NEED-MERGE) ;not supported by standard CVS - ((?U ?P) - (if dont-change-disc - 'NEED-UPDATE - (cons 'UP-TO-DATE - (if (eq code ?U) 'UPDATED 'PATCHED))))) - path 'trust))) + (cvs-parsed-fileinfo + (case code + (?M 'MODIFIED) + (?A 'ADDED) + (?R 'REMOVED) + (?? 'UNKNOWN) + (?C + (if (not dont-change-disc) 'CONFLICT + ;; This is ambiguous. We should look for conflict markers in the + ;; file to decide between CONFLICT and NEED-MERGE. With CVS-1.10 + ;; servers, this should not be necessary, because they return + ;; a complete merge output. + (with-temp-buffer + (insert-file-contents path) + (goto-char (point-min)) + (if (re-search-forward "^<<<<<<< " nil t) + 'CONFLICT 'NEED-MERGE)))) + (?J 'NEED-MERGE) ;not supported by standard CVS + ((?U ?P) + (if dont-change-disc 'NEED-UPDATE + (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED))))) + path 'trust))) (and (cvs-match "pcl-cvs: descending directory \\(.*\\)$" (dir 1)) @@ -237,7 +251,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; A special cvs message (and - (cvs-match "cvs[.ex]* [a-z]+: ") + (let ((case-fold-search t)) + (cvs-match "cvs[.a-z]* [a-z]+: ")) (cvs-or ;; CVS is descending a subdirectory @@ -250,14 +265,29 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; [-n update] A new (or pruned) directory appeared but isn't traversed (and (cvs-match "New directory `\\(.*\\)' -- ignored$" (dir 1)) - (cvs-parsed-fileinfo 'MESSAGE " " (file-name-as-directory dir))) + ;; (cvs-parsed-fileinfo 'MESSAGE " " (file-name-as-directory dir)) + ;; These messages either correspond to a true new directory + ;; that an update will bring in, or to a directory that's empty + ;; on the current branch (either because it only exists in other + ;; branches, or because it's been removed). + (if (ignore-errors + (with-current-buffer + (find-file-noselect (expand-file-name + ".cvsignore" (file-name-directory dir))) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote (file-name-nondirectory dir)) "/$") + nil t))) + t ;The user requested to ignore those messages. + (cvs-parsed-fileinfo '(NEED-UPDATE . NEW-DIR) dir t))) ;; File removed, since it is removed (by third party) in repository. (and (cvs-or (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) - (cvs-parsed-fileinfo 'DEAD file)) + (cvs-parsed-fileinfo + (if dont-change-disc '(NEED-UPDATE . REMOVED) 'DEAD) file)) ;; [add] (and @@ -270,6 +300,9 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (and (cvs-match "\\(.*\\), version \\(.*\\), resurrected$" (path 1) (base-rev 2)) + ;; FIXME: resurrection only brings back the original version, + ;; not the latest on the branch, so `up-to-date' is not always + ;; what we want. (cvs-parsed-fileinfo '(UP-TO-DATE . RESURRECTED) path nil :base-rev base-rev)) @@ -291,7 +324,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." 'MISSING '(UP-TO-DATE . UPDATED)) path)) - + ;; Mode conflicts (rather than contents) (and (cvs-match "conflict: ") @@ -313,11 +346,15 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (cvs-match "sticky tag .* for file `\\(.*\\)' is not a branch$" (file 1))) (cvs-parsed-fileinfo 'MESSAGE file)) - + ;; File unknown. (and (cvs-match "use `.+ add' to create an entry for \\(.*\\)$" (path 1)) (cvs-parsed-fileinfo 'UNKNOWN path)) + ;; [commit] + (and (cvs-match "Up-to-date check failed for `\\(.+\\)'$" (file 1)) + (cvs-parsed-fileinfo 'NEED-MERGE file)) + ;; We use cvs-execute-multi-dir but cvs can't handle it ;; Probably because the cvs-client can but the cvs-server can't (and (cvs-match ".* files with '?/'? in their name.*$") @@ -327,21 +364,24 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." 'MESSAGE "" " " "*** Add (setq cvs-execute-single-dir t) to your .emacs *** See the FAQ file or the variable's documentation for more info.")) - + ;; Cvs waits for a lock. Ignored: already handled by the process filter (cvs-match "\\[..:..:..\\] \\(waiting for\\|obtained\\) .*lock in .*$") ;; File you removed still exists. Ignore (will be noted as removed). (cvs-match ".* should be removed and is still there$") ;; just a note - (cvs-match "use '.+ commit' to \\sw+ th\\sw+ files? permanently$") + (cvs-match "use ['`].+ commit' to \\sw+ th\\sw+ files? permanently$") ;; [add,status] followed by a more complete status description anyway - (cvs-match "nothing known about .*$") + (and (cvs-match "nothing known about \\(.*\\)$" (path 1)) + (cvs-parsed-fileinfo 'DEAD path 'trust)) ;; [update] problem with patch (cvs-match "checksum failure after patch to .*; will refetch$") (cvs-match "refetching unpatchable files$") ;; [commit] (cvs-match "Rebuilding administrative file database$") - + ;; ??? + (cvs-match "--> Using per-directory sticky tag `.*'") + ;; CVS is running a *info program. (and (cvs-match "Executing.*$") @@ -353,14 +393,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (and (cvs-match "cvs[.ex]* \\[[a-z]+ aborted\\]:.*$") (cvs-parsed-fileinfo 'MESSAGE "")) - + ;; sadly you can't do much with these since the path is in the repository (cvs-match "Directory .* added to the repository$") ))) (defun cvs-parse-merge () - (let (path base-rev head-rev handled type) + (let (path base-rev head-rev type) ;; A merge (maybe with a conflict). (and (cvs-match "RCS file: .*$") @@ -397,6 +437,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." "\\) already contains the differences between .*$") (path 1) (type '(UP-TO-DATE . MERGED))) t) + ;; FIXME: PATH might not be set yet. Sometimes the only path + ;; information is in `RCS file: ...' (yuck!!). (cvs-parsed-fileinfo (if dont-change-disc 'NEED-MERGE (or type '(MODIFIED . MERGED))) path nil :merge (cons base-rev head-rev)))))) @@ -413,12 +455,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (type (if nofile 'MISSING 'NEED-UPDATE))) (cvs-match "Up-to-date$" (type (if nofile '(UP-TO-DATE . REMOVED) 'UP-TO-DATE))) + (cvs-match "File had conflicts on merge$" (type 'MODIFIED)) (cvs-match ".*[Cc]onflict.*$" (type 'CONFLICT)) - (cvs-match "Locally Added$" (type 'ADDED)) + (cvs-match "Locally Added$" (type 'ADDED)) (cvs-match "Locally Removed$" (type 'REMOVED)) (cvs-match "Locally Modified$" (type 'MODIFIED)) (cvs-match "Needs Merge$" (type 'NEED-MERGE)) - (cvs-match "Unknown$" (type 'UNKNOWN))) + (cvs-match "Entry Invalid" (type '(NEED-MERGE . REMOVED))) + (cvs-match ".*$" (type 'UNKNOWN))) (cvs-match "$") (cvs-or (cvs-match " *Version:[ \t]*\\([0-9.]+\\).*$" (base-rev 1)) @@ -431,12 +475,15 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$" (head-rev 1)) (cvs-match " *Repository revision:.*")) + (cvs-or (cvs-match " *Expansion option:.*") t) ;Optional CVSNT thingie. + (cvs-or (cvs-match " *Commit Identifier:.*") t) ;Optional CVSNT thingie. (cvs-or - (and;;sometimes those fields are missing - (cvs-match " *Sticky Tag:[ \t]*\\(.*\\)$") ; FIXME: use it - (cvs-match " *Sticky Date:[ \t]*\\(.*\\)$") ; FIXME: use it - (cvs-match " *Sticky Options:[ \t]*\\(.*\\)$")) ; FIXME: use it + (and ;; Sometimes those fields are missing. + (cvs-match " *Sticky Tag:[ \t]*\\(.*\\)$") ; FIXME: use it. + (cvs-match " *Sticky Date:[ \t]*\\(.*\\)$") ; FIXME: use it. + (cvs-match " *Sticky Options:[ \t]*\\(.*\\)$")) ; FIXME: use it. t) + (cvs-or (cvs-match " *Merge From:.*") t) ;Optional CVSNT thingie. (cvs-match "$") ;; ignore the tags-listing in the case of `status -v' (cvs-or (cvs-match " *Existing Tags:\n\\(\t.*\n\\)*$") t) @@ -445,12 +492,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." :head-rev head-rev)))) (defun cvs-parse-commit () - (let (path base-rev subtype) + (let (path file base-rev subtype) (cvs-or (and - (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) - (cvs-match ".*,v <-- .*$") + (cvs-or + (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) + t) + (cvs-match ".*,v <-- \\(.*\\)$" (file 1)) (cvs-or ;; deletion (cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$" @@ -461,18 +510,27 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; update (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$" (subtype 'COMMITTED) (base-rev 1))) - (cvs-match "done$") - ;; it's important here not to rely on the default directory management - ;; because `cvs commit' might begin by a series of Examining messages - ;; so the processing of the actual checkin messages might begin with - ;; a `current-dir' set to something different from "" - (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) path 'trust - :base-rev base-rev)) - + (cvs-or (cvs-match "done$") t) + ;; In cvs-1.12.9 commit messages have been changed and became + ;; ambiguous. More specifically, the `path' above is not given. + ;; We assume here that in future releases the corresponding info will + ;; be put into `file'. + (progn + ;; Try to remove the temp files used by VC. + (vc-delete-automatic-version-backups (expand-file-name (or path file))) + ;; it's important here not to rely on the default directory management + ;; because `cvs commit' might begin by a series of Examining messages + ;; so the processing of the actual checkin messages might begin with + ;; a `current-dir' set to something different from "" + (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) + (or path file) 'trust + :base-rev base-rev))) + ;; useless message added before the actual addition: ignored (cvs-match "RCS file: .*\ndone$")))) (provide 'pcvs-parse) -;;; pcl-cvs-parse.el ends here +;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6 +;;; pcvs-parse.el ends here