X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c64c05511ba5619898078fda33a7d61c44ed89f9..fca8b94cf0138be6a92b24b039c10e3680227d5d:/lisp/pcvs-parse.el diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index 34caaec13d..66c791db51 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -1,10 +1,10 @@ -;;; pcvs-parse.el --- The CVS output parser +;;; pcvs-parse.el --- the CVS output parser -;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 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 -;; Revision: $Id: pcvs-parse.el,v 1.4 2000/12/06 19:52:39 fx Exp $ ;; This file is part of GNU Emacs. @@ -20,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: @@ -76,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 "") @@ -153,7 +159,8 @@ Match RE and if successful, execute MATCHES." (and (cvs-match ".*$") (cvs-create-fileinfo 'MESSAGE cvs-current-dir " " - (concat " Unknown msg: '" (cvs-parse-msg) "'") + ;; (concat " Unknown msg: '" + (cvs-parse-msg) ;; "'") :subtype 'ERROR))))) @@ -192,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) @@ -203,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)) @@ -244,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 @@ -257,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 @@ -277,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)) @@ -298,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: ") @@ -320,7 +346,7 @@ 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)) @@ -338,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.*$") @@ -364,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: .*$") @@ -408,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)))))) @@ -424,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)) @@ -442,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) @@ -456,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.]*\\)$" @@ -472,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