Commit | Line | Data |
---|---|---|
8cd39fb3 MH |
1 | ;;; rng-parse.el --- parse an XML file and validate it against a schema |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
8cd39fb3 MH |
4 | |
5 | ;; Author: James Clark | |
6 | ;; Keywords: XML, RelaxNG | |
7 | ||
09aa73e6 | 8 | ;; This file is part of GNU Emacs. |
8cd39fb3 | 9 | |
4936186e | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
09aa73e6 | 11 | ;; it under the terms of the GNU General Public License as published by |
4936186e GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
8cd39fb3 | 14 | |
09aa73e6 GM |
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. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
4936186e | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8cd39fb3 MH |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This combines the validation machinery in rng-match.el with the | |
26 | ;; parser in nxml-parse.el by using the `nxml-validate-function' hook. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (require 'nxml-parse) | |
31 | (require 'rng-match) | |
32 | (require 'rng-dt) | |
33 | ||
34 | (defvar rng-parse-prev-was-start-tag nil) | |
35 | ||
36 | (defun rng-parse-validate-file (schema file) | |
37 | "Parse and validate the XML document in FILE and return it as a list. | |
38 | The returned list has the same form as that returned by | |
39 | `nxml-parse-file'. SCHEMA is a list representing the schema to use | |
40 | for validation, such as returned by the function `rng-c-load-schema'. | |
41 | If the XML document is invalid with respect to schema, an error will | |
42 | be signaled in the same way as when it is not well-formed." | |
2adaf057 | 43 | (with-current-buffer (nxml-parse-find-file file) |
8cd39fb3 MH |
44 | (unwind-protect |
45 | (let ((nxml-parse-file-name file) | |
46 | (nxml-validate-function 'rng-parse-do-validate) | |
47 | (rng-dt-namespace-context-getter '(nxml-ns-get-context)) | |
48 | rng-parse-prev-was-start-tag) | |
49 | ;; We don't simply call nxml-parse-file, because | |
50 | ;; we want to do rng-match-with-schema in the same | |
51 | ;; buffer in which we will call the other rng-match-* functions. | |
52 | (rng-match-with-schema schema | |
53 | (nxml-parse-instance))) | |
54 | (kill-buffer nil)))) | |
55 | ||
56 | (defun rng-parse-do-validate (text start-tag) | |
57 | (cond ((and (let ((tem rng-parse-prev-was-start-tag)) | |
58 | (setq rng-parse-prev-was-start-tag (and start-tag t)) | |
59 | tem) | |
60 | (not start-tag) | |
61 | (rng-match-text-typed-p)) | |
62 | (unless (rng-match-element-value (or text "")) | |
63 | (cons "Invalid data" (and text 'text)))) | |
64 | ((and text | |
65 | (not (rng-blank-p text)) | |
66 | (not (rng-match-mixed-text))) | |
67 | (cons "Text not allowed" 'text)) | |
68 | ((not start-tag) | |
69 | (unless (rng-match-end-tag) | |
70 | (cons "Missing elements" nil))) | |
71 | ((not (rng-match-start-tag-open | |
72 | (rng-parse-to-match-name (car start-tag)))) | |
73 | (cons "Element not allowed" nil)) | |
74 | (t | |
75 | (let ((atts (cadr start-tag)) | |
76 | (i 0) | |
77 | att err) | |
78 | (while (and atts (not err)) | |
79 | (setq att (car atts)) | |
80 | (when (not (and (consp (car att)) | |
81 | (eq (caar att) nxml-xmlns-namespace-uri))) | |
82 | (setq err | |
83 | (cond ((not (rng-match-attribute-name | |
84 | (rng-parse-to-match-name (car att)))) | |
85 | (cons "Attribute not allowed" | |
86 | (cons 'attribute-name i))) | |
87 | ((not (rng-match-attribute-value (cdr att))) | |
88 | (cons "Invalid attribute value" | |
89 | (cons 'attribute-value i)))))) | |
90 | (setq atts (cdr atts)) | |
91 | (setq i (1+ i))) | |
92 | (or err | |
93 | (unless (rng-match-start-tag-close) | |
94 | (cons "Missing attributes" 'tag-close))))))) | |
95 | ||
96 | (defun rng-parse-to-match-name (name) | |
97 | (if (consp name) | |
98 | name | |
99 | (cons nil name))) | |
100 | ||
101 | (provide 'rng-parse) | |
102 | ||
ab4c34c6 | 103 | ;; arch-tag: 8f14f533-b687-4dc0-9cd7-617ead856981 |
8cd39fb3 | 104 | ;;; rng-parse.el ends here |