Mercurial > emacs
annotate lisp/nxml/rng-parse.el @ 96849:d049ef97c446
* print.c (print_object): Check print_depth before searching for
circularities.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 21 Jul 2008 05:02:31 +0000 |
parents | d495d4d5452f |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
86361 | 1 ;;; rng-parse.el --- parse an XML file and validate it against a schema |
2 | |
87665 | 3 ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
86361 | 4 |
5 ;; Author: James Clark | |
6 ;; Keywords: XML, RelaxNG | |
7 | |
86551 | 8 ;; This file is part of GNU Emacs. |
9 | |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
86551 | 11 ;; it under the terms of the GNU General Public License as published by |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
13 ;; (at your option) any later version. |
86361 | 14 |
86551 | 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. | |
86361 | 19 |
86551 | 20 ;; You should have received a copy of the GNU General Public License |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
86361 | 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 (save-excursion | |
44 (set-buffer (nxml-parse-find-file file)) | |
45 (unwind-protect | |
46 (let ((nxml-parse-file-name file) | |
47 (nxml-validate-function 'rng-parse-do-validate) | |
48 (rng-dt-namespace-context-getter '(nxml-ns-get-context)) | |
49 rng-parse-prev-was-start-tag) | |
50 ;; We don't simply call nxml-parse-file, because | |
51 ;; we want to do rng-match-with-schema in the same | |
52 ;; buffer in which we will call the other rng-match-* functions. | |
53 (rng-match-with-schema schema | |
54 (nxml-parse-instance))) | |
55 (kill-buffer nil)))) | |
56 | |
57 (defun rng-parse-do-validate (text start-tag) | |
58 (cond ((and (let ((tem rng-parse-prev-was-start-tag)) | |
59 (setq rng-parse-prev-was-start-tag (and start-tag t)) | |
60 tem) | |
61 (not start-tag) | |
62 (rng-match-text-typed-p)) | |
63 (unless (rng-match-element-value (or text "")) | |
64 (cons "Invalid data" (and text 'text)))) | |
65 ((and text | |
66 (not (rng-blank-p text)) | |
67 (not (rng-match-mixed-text))) | |
68 (cons "Text not allowed" 'text)) | |
69 ((not start-tag) | |
70 (unless (rng-match-end-tag) | |
71 (cons "Missing elements" nil))) | |
72 ((not (rng-match-start-tag-open | |
73 (rng-parse-to-match-name (car start-tag)))) | |
74 (cons "Element not allowed" nil)) | |
75 (t | |
76 (let ((atts (cadr start-tag)) | |
77 (i 0) | |
78 att err) | |
79 (while (and atts (not err)) | |
80 (setq att (car atts)) | |
81 (when (not (and (consp (car att)) | |
82 (eq (caar att) nxml-xmlns-namespace-uri))) | |
83 (setq err | |
84 (cond ((not (rng-match-attribute-name | |
85 (rng-parse-to-match-name (car att)))) | |
86 (cons "Attribute not allowed" | |
87 (cons 'attribute-name i))) | |
88 ((not (rng-match-attribute-value (cdr att))) | |
89 (cons "Invalid attribute value" | |
90 (cons 'attribute-value i)))))) | |
91 (setq atts (cdr atts)) | |
92 (setq i (1+ i))) | |
93 (or err | |
94 (unless (rng-match-start-tag-close) | |
95 (cons "Missing attributes" 'tag-close))))))) | |
96 | |
97 (defun rng-parse-to-match-name (name) | |
98 (if (consp name) | |
99 name | |
100 (cons nil name))) | |
101 | |
102 (provide 'rng-parse) | |
103 | |
86379 | 104 ;; arch-tag: 8f14f533-b687-4dc0-9cd7-617ead856981 |
86361 | 105 ;;; rng-parse.el ends here |