| 1 | ;;; rng-parse.el --- parse an XML file and validate it against a schema |
| 2 | |
| 3 | ;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 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 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 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 |
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 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." |
| 43 | (with-current-buffer (nxml-parse-find-file file) |
| 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 | |
| 103 | ;;; rng-parse.el ends here |