1 ;;; rng-parse.el --- parse an XML file and validate it against a schema
3 ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
6 ;; Keywords: XML, RelaxNG
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; This combines the validation machinery in rng-match.el with the
28 ;; parser in nxml-parse.el by using the `nxml-validate-function' hook.
36 (defvar rng-parse-prev-was-start-tag nil
)
38 (defun rng-parse-validate-file (schema file
)
39 "Parse and validate the XML document in FILE and return it as a list.
40 The returned list has the same form as that returned by
41 `nxml-parse-file'. SCHEMA is a list representing the schema to use
42 for validation, such as returned by the function `rng-c-load-schema'.
43 If the XML document is invalid with respect to schema, an error will
44 be signaled in the same way as when it is not well-formed."
46 (set-buffer (nxml-parse-find-file file
))
48 (let ((nxml-parse-file-name file
)
49 (nxml-validate-function 'rng-parse-do-validate
)
50 (rng-dt-namespace-context-getter '(nxml-ns-get-context))
51 rng-parse-prev-was-start-tag
)
52 ;; We don't simply call nxml-parse-file, because
53 ;; we want to do rng-match-with-schema in the same
54 ;; buffer in which we will call the other rng-match-* functions.
55 (rng-match-with-schema schema
56 (nxml-parse-instance)))
59 (defun rng-parse-do-validate (text start-tag
)
60 (cond ((and (let ((tem rng-parse-prev-was-start-tag
))
61 (setq rng-parse-prev-was-start-tag
(and start-tag t
))
64 (rng-match-text-typed-p))
65 (unless (rng-match-element-value (or text
""))
66 (cons "Invalid data" (and text
'text
))))
68 (not (rng-blank-p text
))
69 (not (rng-match-mixed-text)))
70 (cons "Text not allowed" 'text
))
72 (unless (rng-match-end-tag)
73 (cons "Missing elements" nil
)))
74 ((not (rng-match-start-tag-open
75 (rng-parse-to-match-name (car start-tag
))))
76 (cons "Element not allowed" nil
))
78 (let ((atts (cadr start-tag
))
81 (while (and atts
(not err
))
83 (when (not (and (consp (car att
))
84 (eq (caar att
) nxml-xmlns-namespace-uri
)))
86 (cond ((not (rng-match-attribute-name
87 (rng-parse-to-match-name (car att
))))
88 (cons "Attribute not allowed"
89 (cons 'attribute-name i
)))
90 ((not (rng-match-attribute-value (cdr att
)))
91 (cons "Invalid attribute value"
92 (cons 'attribute-value i
))))))
93 (setq atts
(cdr atts
))
96 (unless (rng-match-start-tag-close)
97 (cons "Missing attributes" 'tag-close
)))))))
99 (defun rng-parse-to-match-name (name)
106 ;; arch-tag: 8f14f533-b687-4dc0-9cd7-617ead856981
107 ;;; rng-parse.el ends here