Mercurial > emacs
annotate lisp/nxml/rng-xsd.el @ 105755:cc6727b235b0
* nxml/nxml-mode.el (nxml-balanced-close-start-tag): Use the value
of xmltok-start before the end tag was inserted (Bug#2840).
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 24 Oct 2009 21:32:19 +0000 |
parents | a9dc0e7c3f2b |
children | 1d1d5d9bd884 |
rev | line source |
---|---|
86361 | 1 ;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG |
2 | |
100908 | 3 ;; Copyright (C) 2003, 2007, 2008, 2009 Free Software Foundation, Inc. |
86361 | 4 |
5 ;; Author: James Clark | |
6 ;; Keywords: XML, RelaxNG | |
7 | |
86556 | 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 |
86556 | 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 |
86556 | 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 |
86556 | 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 ;; The main entry point is `rng-xsd-compile'. The validator | |
26 ;; knows to use this for the datatype library with URI | |
27 ;; http://www.w3.org/2001/XMLSchema-datatypes because it | |
28 ;; is the value of the rng-dt-compile property on that URI | |
29 ;; as a symbol. | |
30 ;; | |
31 ;; W3C XML Schema Datatypes are specified by | |
32 ;; http://www.w3.org/TR/xmlschema-2/ | |
33 ;; Guidelines for using them with RELAX NG are described in | |
34 ;; http://relaxng.org/xsd.html | |
35 | |
36 ;;; Code: | |
37 | |
38 (require 'rng-dt) | |
39 (require 'rng-util) | |
40 (require 'xsd-regexp) | |
41 | |
42 ;;;###autoload | |
43 (put 'http://www.w3.org/2001/XMLSchema-datatypes | |
44 'rng-dt-compile | |
45 'rng-xsd-compile) | |
46 | |
47 ;;;###autoload | |
48 (defun rng-xsd-compile (name params) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
49 "Provides W3C XML Schema as a RELAX NG datatypes library. |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
50 NAME is a symbol giving the local name of the datatype. PARAMS is a |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
51 list of pairs (PARAM-NAME . PARAM-VALUE) where PARAM-NAME is a symbol |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
52 giving the name of the parameter and PARAM-VALUE is a string giving |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
53 its value. If NAME or PARAMS are invalid, it calls rng-dt-error |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
54 passing it arguments in the same style as format; the value from |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
55 rng-dt-error will be returned. Otherwise, it returns a list. The |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
56 first member of the list is t if any string is a legal value for the |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
57 datatype and nil otherwise. The second argument is a symbol; this |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
58 symbol will be called as a function passing it a string followed by |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
59 the remaining members of the list. The function must return an object |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
60 representing the value of the datatype that was represented by the |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
61 string, or nil if the string is not a representation of any value. |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
62 The object returned can be any convenient non-nil value, provided |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
63 that, if two strings represent the same value, the returned objects |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
64 must be equal." |
86361 | 65 (let ((convert (get name 'rng-xsd-convert))) |
66 (if (not convert) | |
67 (rng-dt-error "There is no XSD datatype named %s" name) | |
68 (rng-xsd-compile1 name params convert)))) | |
69 | |
70 ;;; Parameters | |
71 | |
72 (defun rng-xsd-compile1 (name params convert) | |
73 (if (null params) | |
74 (cons (equal convert '(identity)) | |
75 (cond ((eq name 'string) convert) | |
76 ((eq name 'normalizedString) | |
77 (cons 'rng-xsd-replace-space convert)) | |
78 ((and (not (eq name 'string)) | |
79 (or (memq 'identity convert) | |
80 (memq 'rng-xsd-convert-any-uri convert) | |
81 (memq 'rng-xsd-check-pattern convert))) | |
82 (cons 'rng-xsd-collapse-space convert)) | |
83 (t convert))) | |
84 (let* ((param (car params)) | |
85 (param-name (car param)) | |
86 (param-value (cdr param))) | |
87 (cond ((memq param-name | |
88 '(minExclusive maxExclusive minInclusive maxInclusive)) | |
89 (let ((limit (apply (car convert) | |
90 (cons param-value | |
91 (cdr convert)))) | |
92 (less-than-fun (get name 'rng-xsd-less-than))) | |
93 (cond ((not limit) | |
94 (rng-dt-error "Minimum value %s is not valid" | |
95 param-value)) | |
96 ((not less-than-fun) | |
97 (rng-dt-error "Values of type %s are not ordered" | |
98 param-name)) | |
99 (t | |
100 (rng-xsd-compile1 name | |
101 (cdr params) | |
102 (cons (get param-name | |
103 'rng-xsd-check) | |
104 (cons less-than-fun | |
105 (cons limit convert)))))))) | |
106 ((memq param-name '(length minLength maxLength)) | |
107 (let ((limit (rng-xsd-string-to-non-negative-integer param-value)) | |
108 (length-fun (get name 'rng-xsd-length))) | |
109 (cond ((not limit) | |
110 (rng-dt-error "Length %s is not valid" param-value)) | |
111 ((not length-fun) | |
112 (rng-dt-error "Values of type %s do not have a length" | |
113 param-name)) | |
114 (t | |
115 (rng-xsd-compile1 name | |
116 (cdr params) | |
117 (cons (get param-name | |
118 'rng-xsd-check) | |
119 (cons length-fun | |
120 (cons limit convert)))))))) | |
121 ((memq param-name '(fractionDigits totalDigits)) | |
122 (let ((n (rng-xsd-string-to-non-negative-integer param-value))) | |
123 (cond ((not n) | |
124 (rng-dt-error "Number of digits %s is not valid" | |
125 param-value)) | |
126 (t | |
127 (rng-xsd-compile1 name | |
128 (cdr params) | |
129 (cons (get param-name | |
130 'rng-xsd-check) | |
131 (cons n convert))))))) | |
132 ((eq param-name 'pattern) | |
133 (condition-case err | |
134 (rng-xsd-compile1 name | |
135 (cdr params) | |
136 (cons 'rng-xsd-check-pattern | |
137 (cons (concat | |
138 "\\`" | |
139 (xsdre-translate param-value) | |
140 "\\'") | |
141 convert))) | |
142 (xsdre-invalid-regexp | |
143 (rng-dt-error "Invalid regular expression (%s)" | |
144 (nth 1 err))))) | |
145 ((memq param-name '(enumeration whiteSpace)) | |
146 (rng-dt-error "Facet %s cannot be used in RELAX NG" param-name)) | |
147 (t (rng-dt-error "Unknown facet %s" param-name)))))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
148 |
86361 | 149 (defun rng-xsd-string-to-non-negative-integer (str) |
150 (and (rng-xsd-convert-integer str) | |
151 (let ((n (string-to-number str))) | |
152 (and (integerp n) | |
153 (>= n 0) | |
154 n)))) | |
155 | |
156 (defun rng-xsd-collapse-space (str convert &rest args) | |
157 (apply convert (cons (mapconcat 'identity (split-string str "[ \t\n\r]+") | |
158 " ") | |
159 args))) | |
160 | |
161 (defun rng-xsd-replace-space (str convert &rest args) | |
162 (apply convert | |
163 (cons (let ((i 0) | |
164 copied) | |
165 (while (and (setq i (string-match "[\r\n\t]" str i)) | |
166 (or copied (setq copied (copy-sequence str))) | |
167 (aset copied i 32) | |
168 (setq i (1+ i)))) | |
169 (or copied str)) | |
170 args))) | |
171 | |
172 (put 'minExclusive 'rng-xsd-check 'rng-xsd-check-min-exclusive) | |
173 (put 'minInclusive 'rng-xsd-check 'rng-xsd-check-min-inclusive) | |
174 (put 'maxExclusive 'rng-xsd-check 'rng-xsd-check-max-exclusive) | |
175 (put 'maxInclusive 'rng-xsd-check 'rng-xsd-check-max-inclusive) | |
176 (put 'length 'rng-xsd-check 'rng-xsd-check-length) | |
177 (put 'minLength 'rng-xsd-check 'rng-xsd-check-min-length) | |
178 (put 'maxLength 'rng-xsd-check 'rng-xsd-check-max-length) | |
179 (put 'fractionDigits 'rng-xsd-check 'rng-xsd-check-fraction-digits) | |
180 (put 'totalDigits 'rng-xsd-check 'rng-xsd-check-total-digits) | |
181 | |
182 (defun rng-xsd-check-min-exclusive (str less-than-fun limit convert &rest args) | |
183 (let ((obj (apply convert (cons str args)))) | |
184 (and obj | |
185 (funcall less-than-fun limit obj) | |
186 obj))) | |
187 | |
188 (defun rng-xsd-check-min-inclusive (str less-than-fun limit convert &rest args) | |
189 (let ((obj (apply convert (cons str args)))) | |
190 (and obj | |
191 (or (funcall less-than-fun limit obj) | |
192 (equal limit obj)) | |
193 obj))) | |
194 | |
195 (defun rng-xsd-check-max-exclusive (str less-than-fun limit convert &rest args) | |
196 (let ((obj (apply convert (cons str args)))) | |
197 (and obj | |
198 (funcall less-than-fun obj limit) | |
199 obj))) | |
200 | |
201 (defun rng-xsd-check-max-inclusive (str less-than-fun limit convert &rest args) | |
202 (let ((obj (apply convert (cons str args)))) | |
203 (and obj | |
204 (or (funcall less-than-fun obj limit) | |
205 (equal obj limit)) | |
206 obj))) | |
207 | |
208 (defun rng-xsd-check-min-length (str length-fun limit convert &rest args) | |
209 (let ((obj (apply convert (cons str args)))) | |
210 (and obj | |
211 (>= (funcall length-fun obj) limit) | |
212 obj))) | |
213 | |
214 (defun rng-xsd-check-max-length (str length-fun limit convert &rest args) | |
215 (let ((obj (apply convert (cons str args)))) | |
216 (and obj | |
217 (<= (funcall length-fun obj) limit) | |
218 obj))) | |
219 | |
220 (defun rng-xsd-check-length (str length-fun len convert &rest args) | |
221 (let ((obj (apply convert (cons str args)))) | |
222 (and obj | |
223 (= (funcall length-fun obj) len) | |
224 obj))) | |
225 | |
226 (defun rng-xsd-check-fraction-digits (str n convert &rest args) | |
227 (let ((obj (apply convert (cons str args)))) | |
228 (and obj | |
229 (<= (length (aref obj 2)) n) | |
230 obj))) | |
231 | |
232 (defun rng-xsd-check-total-digits (str n convert &rest args) | |
233 (let ((obj (apply convert (cons str args)))) | |
234 (and obj | |
235 (<= (+ (length (aref obj 1)) | |
236 (length (aref obj 2))) | |
237 n) | |
238 obj))) | |
239 | |
240 (defun rng-xsd-check-pattern (str regexp convert &rest args) | |
241 (and (string-match regexp str) | |
242 (apply convert (cons str args)))) | |
243 | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
244 |
86361 | 245 (defun rng-xsd-convert-boolean (string) |
246 (and (string-match "\\`[ \t\n\r]*\\(?:\\(true\\|1\\)\\|false\\|0\\)[ \t\n\r]*\\'" string) | |
247 (if (match-beginning 1) 'true 'false))) | |
248 | |
249 (defun rng-xsd-convert-decimal (string) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
250 "Convert a string representing a decimal to an object representing it values. |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
251 A decimal value is represented by a vector [SIGN INTEGER-DIGITS |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
252 FRACTION-DIGITS] where SIGN is 1 or -1, INTEGER-DIGITS is a string |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
253 containing zero or more digits, with no leading zero, and |
86361 | 254 FRACTION-DIGITS is a string containing zero or more digits with no |
255 trailing digits. For example, -0021.0430 would be represented by [-1 | |
256 \"21\" \"043\"]." | |
257 (and (string-match "\\`[ \t\n\r]*\\([-+]\\)?\\(0*\\([1-9][0-9]*\\)?\\(\\.\\([0-9]*[1-9]\\)?0*\\)?\\)[ \t\n\r]*\\'" string) | |
258 (let ((digits (match-string 2 string))) | |
259 (and (not (string= digits ".")) | |
260 (not (string= digits "")))) | |
261 (let ((integer-digits (match-string 3 string))) | |
262 (vector (if (and (equal (match-string 1 string) "-") | |
263 ;; Normalize -0 to 0 | |
264 integer-digits) | |
265 -1 | |
266 1) | |
267 (or integer-digits "") | |
268 (or (match-string 5 string) ""))))) | |
269 | |
270 (defun rng-xsd-convert-integer (string) | |
271 (and (string-match "\\`[ \t\n\r]*\\([-+]\\)?\\(?:0*\\([1-9][0-9]*\\)\\|0+\\)[ \t\n\r]*\\'" string) | |
272 (let ((integer-digits (match-string 2 string))) | |
273 (vector (if (and (equal (match-string 1 string) "-") | |
274 ;; Normalize -0 to 0 | |
275 integer-digits) | |
276 -1 | |
277 1) | |
278 (or integer-digits "") | |
279 "")))) | |
280 | |
281 (defun rng-xsd-decimal< (n1 n2) | |
282 (< (rng-xsd-compare-decimal n1 n2) 0)) | |
283 | |
284 (defun rng-xsd-compare-decimal (n1 n2) | |
285 "Return a < 0, 0, > 0 according as n1 < n2, n1 = n2 or n1 > n2." | |
286 (let* ((sign1 (aref n1 0)) | |
287 (sign2 (aref n2 0)) | |
288 (sign (- sign1 sign2))) | |
289 (if (= sign 0) | |
290 (* sign1 | |
291 (let* ((int1 (aref n1 1)) | |
292 (int2 (aref n2 1)) | |
293 (len1 (length int1)) | |
294 (len2 (length int2)) | |
295 (lencmp (- len1 len2))) | |
296 (if (eq lencmp 0) | |
297 (if (string= int1 int2) | |
298 (rng-xsd-strcmp (aref n1 2) (aref n2 2)) | |
299 (rng-xsd-strcmp int1 int2)) | |
300 lencmp))) | |
301 sign))) | |
302 | |
303 (defconst rng-xsd-float-regexp | |
304 (concat "\\`[ \r\n\t]*\\(?:" | |
305 "\\(" | |
306 "[-+]?\\(?:[0-9]+\\(?:\\.[0-9]*\\)?\\|\\.[0-9]+\\)" | |
307 "\\(?:[eE][-+]?[0-9]+\\)?" | |
308 "\\)" | |
309 "\\|\\(INF\\)" | |
310 "\\|\\(-INF\\)" | |
311 "\\|\\(NaN\\)" | |
312 "\\)[ \r\n\t]*\\'")) | |
313 | |
314 (defun rng-xsd-convert-float (string) | |
315 (cond ((not (string-match rng-xsd-float-regexp string)) nil) | |
316 ((match-beginning 1) | |
317 (float (string-to-number (match-string 1 string)))) | |
318 ((match-beginning 2) 1.0e+INF) | |
319 ((match-beginning 3) -1.0e+INF) | |
320 ;; Don't use a NaN float because we want NaN to be equal to NaN | |
321 ((match-beginning 4) 'NaN))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
322 |
86361 | 323 (defun rng-xsd-float< (f1 f2) |
324 (and (not (eq f1 'NaN)) | |
325 (not (eq f2 'NaN)) | |
326 (< f1 f2))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
327 |
86361 | 328 (defun rng-xsd-convert-token (string regexp) |
329 (and (string-match regexp string) | |
330 (match-string 1 string))) | |
331 | |
332 (defun rng-xsd-convert-hex-binary (string) | |
333 (and (string-match "\\`[ \r\n\t]*\\(\\(?:[0-9A-Fa-f][0-9A-Fa-f]\\)*\\)[ \r\n\t]*\\'" | |
334 string) | |
335 (downcase (match-string 1 string)))) | |
336 | |
337 (defun rng-xsd-hex-binary-length (obj) | |
338 (/ (length obj) 2)) | |
339 | |
340 (defconst rng-xsd-base64-binary-regexp | |
341 (let ((S "[ \t\r\n]*") | |
342 (B04 "[AQgw]") | |
343 (B16 "[AEIMQUYcgkosw048]") | |
344 (B64 "[A-Za-z0-9+/]")) | |
345 (concat "\\`" S "\\(?:\\(?:" B64 S "\\)\\{4\\}\\)*" | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
346 "\\(?:" B64 S B64 S B16 S "=" S |
86361 | 347 "\\|" B64 S B04 S "=" S "=" S "\\)?\\'"))) |
348 | |
349 (defun rng-xsd-convert-base64-binary (string) | |
350 (and (string-match rng-xsd-base64-binary-regexp string) | |
351 (replace-regexp-in-string "[ \t\r\n]+" "" string t t))) | |
352 | |
353 (defun rng-xsd-base64-binary-length (obj) | |
354 (let ((n (* (/ (length obj) 4) 3))) | |
355 (if (and (> n 0) | |
356 (string= (substring obj -1) "=")) | |
357 (- n (if (string= (substring obj -2) "==") | |
358 2 | |
359 1)) | |
360 n))) | |
361 | |
362 (defun rng-xsd-convert-any-uri (string) | |
363 (and (string-match "\\`\\(?:[^%]\\|%[0-9a-fA-F][0-9a-fA-F]\\)?*\\'" string) | |
364 (string-match "\\`[^#]*\\(?:#[^#]*\\)?\\'" string) | |
365 (string-match "\\`\\(?:[a-zA-Z][-+.A-Za-z0-9]*:.+\\|[^:]*\\(?:[#/?].*\\)?\\)\\'" string) | |
366 string)) | |
367 | |
368 (defun rng-xsd-make-date-time-regexp (template) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
369 "Returns a regular expression matching a ISO 8601 date/time. |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
370 The template is a string with Y standing for years field, M standing |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
371 for months, D standing for day of month, T standing for a literal T, t |
86361 | 372 standing for time and - standing for a literal hyphen. A time zone is |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
373 always allowed at the end. Regardless of the fields appearing in the |
86361 | 374 template, the regular expression will have twelve groups matching the |
375 year sign, year, month, day of month, hours, minutes, integer seconds, | |
376 fractional seconds (including leading period), time zone, time zone | |
377 sign, time zone hours, time zone minutes." | |
378 (let ((i 0) | |
379 (len (length template)) | |
380 (parts nil) | |
381 first last c) | |
382 (while (< i len) | |
383 (setq c (aref template i)) | |
384 (setq parts | |
385 (cons (cond ((eq c ?Y) | |
386 (setq first 0) | |
387 (setq last 1) | |
388 "\\(-\\)?\\(\\(?:[1-9][0-9]*\\)?[0-9]\\{4\\}\\)") | |
389 ((eq c ?M) | |
390 (or first | |
391 (setq first 2)) | |
392 (setq last 2) | |
393 "\\([0-9][0-9]\\)") | |
394 ((eq c ?D) | |
395 (or first | |
396 (setq first 3)) | |
397 (setq last 3) | |
398 "\\([0-9][0-9]\\)") | |
399 ((eq c ?t) | |
400 (or first | |
401 (setq first 4)) | |
402 (setq last 7) | |
403 "\\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)\\(\\.[0-9]*\\)?") | |
404 (t (string c))) | |
405 parts)) | |
406 (setq i (1+ i))) | |
407 (while (< last 7) | |
408 (setq last (1+ last)) | |
409 ;; Add dummy fields that can never much but keep the group | |
410 ;; numbers uniform. | |
411 (setq parts (cons "\\(\\'X\\)?" parts))) | |
412 (setq parts (cons "\\(Z\\|\\([-+]\\)\\([0-9][0-9]\\):\\([0-5][0-9]\\)\\)?[ \t\n\r]*\\'" | |
413 parts)) | |
414 (setq parts (cons "\\`[ \t\n\r]*" (nreverse parts))) | |
415 (while (> first 0) | |
416 (setq first (1- first)) | |
417 (setq parts (cons "\\(X\\)?" parts))) | |
418 (apply 'concat parts))) | |
419 | |
420 (defconst rng-xsd-seconds-per-day (* 24 60 60)) | |
421 (defconst rng-xsd-days-in-month [31 28 31 30 31 30 31 31 30 31 30 31]) | |
422 | |
423 (defun rng-xsd-days-in-month (year month) | |
424 (if (and (= month 2) (rng-xsd-leap-year-p year)) | |
425 29 | |
426 (aref rng-xsd-days-in-month (1- month)))) | |
427 | |
428 (defconst rng-xsd-months-to-days | |
429 (let ((v (make-vector 12 nil)) | |
430 (total 0) | |
431 (i 0)) | |
432 (while (< i 12) | |
433 (setq total (+ total (aref rng-xsd-days-in-month i))) | |
434 (aset v i total) | |
435 (setq i (1+ i))) | |
436 v)) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
437 |
86361 | 438 (defun rng-xsd-convert-date-time (string regexp) |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
439 "Converts an XML Schema date/time to a list. |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
440 Returns nil if invalid. REGEXP is a regexp for parsing the date time |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
441 as returned by `rng-xsd-make-date-time-regexp'. The list has 4 members |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
442 \(HAS-TIME-ZONE DAY SECOND SECOND-FRACTION), where HAS-TIME-ZONE is t |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
443 or nil depending on whether a time zone was specified, DAY is an |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
444 integer giving a day number (with Jan 1 1AD being day 1), SECOND is the |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
445 second within that day, and SECOND-FRACTION is a float giving the |
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
446 fractional part of the second." |
86361 | 447 (and (string-match regexp string) |
448 (let ((year-sign (match-string 1 string)) | |
449 (year (match-string 2 string)) | |
450 (month (match-string 3 string)) | |
451 (day (match-string 4 string)) | |
452 (hour (match-string 5 string)) | |
453 (minute (match-string 6 string)) | |
454 (second (match-string 7 string)) | |
455 (second-fraction (match-string 8 string)) | |
456 (has-time-zone (match-string 9 string)) | |
457 (time-zone-sign (match-string 10 string)) | |
458 (time-zone-hour (match-string 11 string)) | |
459 (time-zone-minute (match-string 12 string))) | |
460 (setq year-sign (if year-sign -1 1)) | |
461 (setq year | |
462 (if year | |
463 (* year-sign | |
464 (string-to-number year)) | |
465 2000)) | |
466 (setq month | |
467 (if month (string-to-number month) 1)) | |
468 (setq day | |
469 (if day (string-to-number day) 1)) | |
470 (setq hour | |
471 (if hour (string-to-number hour) 0)) | |
472 (setq minute | |
473 (if minute (string-to-number minute) 0)) | |
474 (setq second | |
475 (if second (string-to-number second) 0)) | |
476 (setq second-fraction | |
477 (if second-fraction | |
478 (float (string-to-number second-fraction)) | |
479 0.0)) | |
480 (setq has-time-zone (and has-time-zone t)) | |
481 (setq time-zone-sign | |
482 (if (equal time-zone-sign "-") -1 1)) | |
483 (setq time-zone-hour | |
484 (if time-zone-hour (string-to-number time-zone-hour) 0)) | |
485 (setq time-zone-minute | |
486 (if time-zone-minute (string-to-number time-zone-minute) 0)) | |
487 (and (>= month 1) | |
488 (<= month 12) | |
489 (>= day 1) | |
490 (<= day (rng-xsd-days-in-month year month)) | |
491 (<= hour 23) | |
492 (<= minute 59) | |
493 (<= second 60) ; leap second | |
494 (<= time-zone-hour 23) | |
495 (<= time-zone-minute 59) | |
496 (cons has-time-zone | |
497 (rng-xsd-add-seconds | |
498 (list (rng-xsd-date-to-days year month day) | |
499 (rng-xsd-time-to-seconds hour minute second) | |
500 second-fraction) | |
501 (* (rng-xsd-time-to-seconds time-zone-hour | |
502 time-zone-minute | |
503 0) | |
504 (- time-zone-sign)))))))) | |
505 | |
506 (defun rng-xsd-leap-year-p (year) | |
507 (and (= (% year 4) 0) | |
508 (or (/= (% year 100) 0) | |
509 (= (% year 400) 0)))) | |
510 | |
511 (defun rng-xsd-time-to-seconds (hour minute second) | |
512 (+ (* (+ (* hour 60) | |
513 minute) | |
514 60) | |
515 second)) | |
516 | |
517 (defconst rng-xsd-max-tz (rng-xsd-time-to-seconds 14 0 0)) | |
518 | |
519 (defun rng-xsd-date-time< (dt1 dt2) | |
520 (cond ((eq (car dt1) (car dt2)) | |
521 (rng-xsd-number-list< (cdr dt1) (cdr dt2))) | |
522 ((car dt1) | |
523 (rng-xsd-number-list< (cdr dt1) | |
524 (rng-xsd-add-seconds (cdr dt2) | |
525 (- rng-xsd-max-tz)))) | |
526 (t | |
527 (rng-xsd-number-list< (rng-xsd-add-seconds (cdr dt1) | |
528 rng-xsd-max-tz) | |
529 (cdr dt2))))) | |
530 | |
531 (defun rng-xsd-add-seconds (date offset) | |
532 (let ((day (nth 0 date)) | |
533 (second (+ (nth 1 date) offset)) | |
534 (fraction (nth 2 date))) | |
535 (cond ((< second 0) | |
536 (list (1- day) | |
537 (+ second rng-xsd-seconds-per-day) | |
538 fraction)) | |
539 ((>= second rng-xsd-seconds-per-day) | |
540 (list (1+ day) | |
541 (- second rng-xsd-seconds-per-day) | |
542 fraction)) | |
543 (t (list day second fraction))))) | |
544 | |
545 (defun rng-xsd-number-list< (numbers1 numbers2) | |
546 (while (and numbers1 (= (car numbers1) (car numbers2))) | |
547 (setq numbers1 (cdr numbers1)) | |
548 (setq numbers2 (cdr numbers2))) | |
549 (and numbers1 | |
550 (< (car numbers1) (car numbers2)))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
551 |
86361 | 552 (defun rng-xsd-date-to-days (year month day) |
553 "Return a unique day number where Jan 1 1 AD is day 1" | |
554 (if (> year 0) ; AD | |
555 (+ (rng-xsd-days-in-years (- year 1)) | |
556 (rng-xsd-day-number-in-year year month day)) | |
557 (- (+ (- (rng-xsd-days-in-years (- 3 year)) | |
558 (rng-xsd-days-in-years 3)) | |
559 (- (if (rng-xsd-leap-year-p year) 366 365) | |
560 (rng-xsd-day-number-in-year year month day)))))) | |
561 | |
562 (defun rng-xsd-days-in-years (years) | |
563 "The number of days in YEARS years where the first year is 1AD." | |
564 (+ (* 365 years) | |
565 (/ years 4) | |
566 (- (/ years 100)) | |
567 (/ years 400))) | |
568 | |
569 (defun rng-xsd-day-number-in-year (year month day) | |
570 (+ (if (= month 1) | |
571 0 | |
572 (aref rng-xsd-months-to-days (- month 2))) | |
573 day | |
574 (if (and (> month 2) | |
575 (rng-xsd-leap-year-p year)) | |
576 1 | |
577 0))) | |
578 | |
579 (defconst rng-xsd-duration-regexp | |
580 "\\`[ \t\r\n]*\\(-\\)?P\ | |
581 \\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\ | |
582 \\(?:T\\([0-9]+H\\)?\\([0-9]+M\\)?\ | |
583 \\(\\([0-9]+\\(?:\\.[0-9]*\\)?\\|\\.[0-9]+\\)S\\)?\\)?\ | |
584 [ \t\r\n]*\\'") | |
585 | |
586 | |
587 (defun rng-xsd-convert-duration (string) | |
588 (and (string-match rng-xsd-duration-regexp string) | |
589 (let ((last (substring string -1))) | |
590 (not (or (string= last "P") | |
591 (string= last "T")))) | |
592 ;; years months days hours minutes seconds | |
593 (let ((v (make-vector 6 0)) | |
594 (sign (if (match-beginning 1) -1 1)) | |
595 (i 0)) | |
596 (while (< i 6) | |
597 (let ((start (match-beginning (+ i 2)))) | |
598 (when start | |
599 (aset v i (* sign | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
600 (string-to-number |
86361 | 601 (substring string |
602 start | |
603 (1- (match-end (+ i 2))))))))) | |
604 (setq i (1+ i))) | |
605 ;; Force seconds to be float so that equal works properly. | |
606 (aset v 5 (float (aref v 5))) | |
607 v))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
608 |
86361 | 609 (defconst rng-xsd-min-seconds-per-month (* 28 rng-xsd-seconds-per-day)) |
610 | |
611 (defun rng-xsd-duration< (d1 d2) | |
612 (let* ((months1 (rng-xsd-duration-months d1)) | |
613 (months2 (rng-xsd-duration-months d2)) | |
614 (seconds1 (rng-xsd-duration-seconds d1)) | |
615 (seconds2 (rng-xsd-duration-seconds d2))) | |
616 (cond ((< months1 months2) | |
617 (if (< (- seconds1 seconds2) rng-xsd-min-seconds-per-month) | |
618 t | |
619 (rng-xsd-months-seconds< months1 seconds1 months2 seconds2))) | |
620 ((> months1 months2) | |
621 (if (< (- seconds2 seconds1) rng-xsd-min-seconds-per-month) | |
622 nil | |
623 (rng-xsd-months-seconds< months1 seconds1 months2 seconds2))) | |
624 (t (< seconds1 seconds2))))) | |
625 | |
626 (defconst xsd-duration-reference-dates | |
627 '((1696 . 9) (1697 . 2) (1903 . 3) (1903 . 7))) | |
628 | |
629 (defun rng-xsd-months-seconds< (months1 seconds1 months2 seconds2) | |
630 (let ((ret t) | |
631 (ref-dates xsd-duration-reference-dates)) | |
632 (while (let* ((ref-date (car ref-dates)) | |
633 (ref-year (car ref-date)) | |
634 (ref-month (cdr ref-date))) | |
635 (unless (< (+ (rng-xsd-month-seconds months1 | |
636 ref-year | |
637 ref-month) | |
638 seconds1) | |
639 (+ (rng-xsd-month-seconds months2 | |
640 ref-year | |
641 ref-month) | |
642 seconds2)) | |
643 (setq ret nil)) | |
644 (and ret | |
645 (setq ref-dates (cdr ref-dates))))) | |
646 ret)) | |
647 | |
648 | |
649 (defun rng-xsd-month-seconds (months ref-year ref-month) | |
650 "Return the seconds in a number of months starting on a reference date. | |
651 Returns a floating point number." | |
652 (* (rng-xsd-month-days (abs months) ref-year ref-month) | |
653 (float rng-xsd-seconds-per-day) | |
654 (if (< months 0) -1.0 1.0))) | |
655 | |
656 (defconst rng-xsd-years-per-gregorian-cycle 400) | |
657 (defconst rng-xsd-months-per-gregorian-cycle | |
658 (* rng-xsd-years-per-gregorian-cycle 12)) | |
659 (defconst rng-xsd-leap-years-per-gregorian-cycle (- 100 (- 4 1))) | |
660 (defconst rng-xsd-days-per-gregorian-cycle | |
661 (+ (* 365 rng-xsd-years-per-gregorian-cycle) | |
662 rng-xsd-leap-years-per-gregorian-cycle)) | |
663 | |
664 (defun rng-xsd-month-days (months ref-year ref-month) | |
665 "Return the days in a number of months starting on a reference date. | |
666 MONTHS must be an integer >= 0." | |
667 (let ((days 0)) | |
668 (setq months (mod months rng-xsd-months-per-gregorian-cycle)) | |
669 ;; This may be rather slow, but it is highly unlikely | |
670 ;; ever to be used in real life. | |
671 (while (> months 0) | |
672 (setq days | |
673 (+ (rng-xsd-days-in-month ref-year ref-month) | |
674 days)) | |
675 (setq ref-month | |
676 (if (eq ref-month 12) | |
677 (progn | |
678 (setq ref-year (1+ ref-year)) | |
679 1) | |
680 (1+ ref-month))) | |
681 (setq months (1- months))) | |
682 (+ (* (/ months rng-xsd-months-per-gregorian-cycle) | |
683 rng-xsd-days-per-gregorian-cycle) | |
684 days))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
685 |
86361 | 686 (defun rng-xsd-duration-months (d) |
687 (+ (* (aref d 0) 12) | |
688 (aref d 1))) | |
689 | |
690 (defun rng-xsd-duration-seconds (d) | |
691 (+ (* (+ (* (+ (* (aref d 2) | |
692 24.0) | |
693 (aref d 3)) | |
694 60.0) | |
695 (aref d 4)) | |
696 60.0) | |
697 (aref d 5))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
698 |
86361 | 699 (defun rng-xsd-convert-qname (string) |
700 (and (string-match "\\`[ \r\n\t]*\\([_[:alpha:]][-._[:alnum:]]*\\(:[_[:alpha:]][-._[:alnum:]]*\\)?\\)[ \r\n\t]*\\'" string) | |
701 (let ((colon (match-beginning 2)) | |
702 (context (apply (car rng-dt-namespace-context-getter) | |
703 (cdr rng-dt-namespace-context-getter)))) | |
704 (if colon | |
705 (let* ((prefix (substring string | |
706 (match-beginning 1) | |
707 colon)) | |
708 (binding (assoc prefix (cdr context)))) | |
709 (and binding | |
710 (cons (cdr binding) | |
711 (substring string | |
712 (1+ colon) | |
713 (match-end 1))))) | |
714 (cons (car context) | |
715 (match-string 1 string)))))) | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
716 |
86361 | 717 (defun rng-xsd-convert-list (string convert &rest args) |
718 (let* ((tokens (split-string string "[ \t\n\r]+")) | |
719 (tem tokens)) | |
720 (while tem | |
721 (let ((obj (apply convert | |
722 (cons (car tem) args)))) | |
723 (cond (obj | |
724 (setcar tem obj) | |
725 (setq tem (cdr tem))) | |
726 (t | |
727 (setq tokens nil) | |
728 (setq tem nil))))) | |
729 ;; Fortuitously this returns nil if the list is empty | |
730 ;; which is what we want since the list types | |
731 ;; have to have one or more members. | |
732 tokens)) | |
733 | |
734 (defun rng-xsd-strcmp (s1 s2) | |
735 (cond ((string= s1 s2) 0) | |
736 ((string< s1 s2) -1) | |
737 (t 1))) | |
738 | |
739 (put 'string 'rng-xsd-convert '(identity)) | |
740 (put 'string 'rng-xsd-length 'length) | |
741 (put 'string 'rng-xsd-matches-anything t) | |
742 | |
743 (put 'normalizedString 'rng-xsd-convert '(identity)) | |
744 (put 'normalizedString 'rng-xsd-length 'length) | |
745 (put 'normalizedString 'rng-xsd-matches-anything t) | |
746 | |
747 (put 'token 'rng-xsd-convert '(identity)) | |
748 (put 'token 'rng-xsd-length 'length) | |
749 (put 'token 'rng-xsd-matches-anything t) | |
750 | |
751 (put 'hexBinary 'rng-xsd-convert '(rng-xsd-convert-hex-binary)) | |
752 (put 'hexBinary 'rng-xsd-length 'rng-xsd-hex-binary-length) | |
753 | |
754 (put 'base64Binary 'rng-xsd-convert '(rng-xsd-convert-base64-binary)) | |
755 (put 'base64Binary 'rng-xsd-length 'rng-xsd-base64-binary-length) | |
756 | |
757 (put 'boolean 'rng-xsd-convert '(rng-xsd-convert-boolean)) | |
758 | |
759 (put 'float 'rng-xsd-convert '(rng-xsd-convert-float)) | |
760 (put 'float 'rng-xsd-less-than 'rng-xsd-float<) | |
761 | |
762 (put 'double 'rng-xsd-convert '(rng-xsd-convert-float)) | |
763 (put 'double 'rng-xsd-less-than 'rng-xsd-float<) | |
764 | |
765 (put 'decimal 'rng-xsd-convert '(rng-xsd-convert-decimal)) | |
766 (put 'decimal 'rng-xsd-less-than 'rng-xsd-decimal<) | |
767 | |
768 (put 'integer 'rng-xsd-convert '(rng-xsd-convert-integer)) | |
769 (put 'integer 'rng-xsd-less-than 'rng-xsd-decimal<) | |
770 | |
771 (defun rng-xsd-def-integer-type (name min max) | |
772 (put name 'rng-xsd-less-than 'rng-xsd-decimal<) | |
773 (put name | |
96496
e374c747704b
Fix typos, and general docstring cleanup.
Juanma Barranquero <lekktu@gmail.com>
parents:
94666
diff
changeset
|
774 'rng-xsd-convert |
86361 | 775 (cdr (rng-xsd-compile 'integer |
776 (append (and min `((minInclusive . ,min))) | |
777 (and max `((maxInclusive . ,max)))))))) | |
778 | |
779 (defun rng-xsd-def-token-type (name regexp) | |
780 (put name 'rng-xsd-convert (list 'rng-xsd-convert-token | |
781 (concat "\\`[\r\n\t ]*\\(" | |
782 regexp | |
783 "\\)[\r\n\t ]*\\'"))) | |
784 (put name 'rng-xsd-length 'length)) | |
785 | |
786 (rng-xsd-def-token-type 'NMTOKEN "[-.:_[:alnum:]]+") | |
787 (rng-xsd-def-token-type 'Name "[:_[:alpha:]][-.:_[:alnum:]]*") | |
788 (rng-xsd-def-token-type 'NCName "[_[:alpha:]][-._[:alnum:]]*") | |
789 (rng-xsd-def-token-type 'language | |
790 "[a-zA-Z]\\{1,8\\}\\(?:-[a-zA-Z0-9]\\{1,8\\}\\)*") | |
791 | |
792 (put 'ENTITY 'rng-xsd-convert (get 'NCName 'rng-xsd-convert)) | |
793 (put 'ENTITY 'rng-xsd-length 'length) | |
794 (put 'ID 'rng-xsd-convert (get 'NCName 'rng-xsd-convert)) | |
795 (put 'ID 'rng-xsd-length 'length) | |
796 (put 'IDREF 'rng-xsd-convert (get 'NCName 'rng-xsd-convert)) | |
797 (put 'IDREF 'rng-xsd-length 'length) | |
798 | |
799 (defun rng-xsd-def-list-type (name member-name) | |
800 (put name 'rng-xsd-convert (cons 'rng-xsd-convert-list | |
801 (get member-name 'rng-xsd-convert))) | |
802 (put name 'rng-xsd-length 'length)) | |
803 | |
804 (rng-xsd-def-list-type 'NMTOKENS 'NMTOKEN) | |
805 (rng-xsd-def-list-type 'IDREFS 'IDREF) | |
806 (rng-xsd-def-list-type 'ENTITIES 'ENTITY) | |
807 | |
808 (put 'anyURI 'rng-xsd-convert '(rng-xsd-convert-any-uri)) | |
809 (put 'anyURI 'rng-xsd-length 'length) | |
810 | |
811 (put 'QName 'rng-xsd-convert '(rng-xsd-convert-qname)) | |
812 (put 'NOTATION 'rng-xsd-convert '(rng-xsd-convert-qname)) | |
813 | |
814 (defconst rng-xsd-long-max "9223372036854775807") | |
815 (defconst rng-xsd-long-min "-9223372036854775808") | |
816 (defconst rng-xsd-int-max "2147483647") | |
817 (defconst rng-xsd-int-min "-2147483648") | |
818 (defconst rng-xsd-short-max "32767") | |
819 (defconst rng-xsd-short-min "-32768") | |
820 (defconst rng-xsd-byte-max "127") | |
821 (defconst rng-xsd-byte-min "-128") | |
822 (defconst rng-xsd-unsigned-long-max "18446744073709551615") | |
823 (defconst rng-xsd-unsigned-int-max "4294967295") | |
824 (defconst rng-xsd-unsigned-short-max "65535") | |
825 (defconst rng-xsd-unsigned-byte-max "255") | |
826 | |
827 (rng-xsd-def-integer-type 'nonNegativeInteger "0" nil) | |
828 (rng-xsd-def-integer-type 'positiveInteger "1" nil) | |
829 (rng-xsd-def-integer-type 'nonPositiveInteger nil "0") | |
830 (rng-xsd-def-integer-type 'negativeInteger nil "-1") | |
831 (rng-xsd-def-integer-type 'long rng-xsd-long-min rng-xsd-long-max) | |
832 (rng-xsd-def-integer-type 'int rng-xsd-int-min rng-xsd-int-max) | |
833 (rng-xsd-def-integer-type 'short rng-xsd-short-min rng-xsd-short-max) | |
834 (rng-xsd-def-integer-type 'byte rng-xsd-byte-min rng-xsd-byte-max) | |
835 (rng-xsd-def-integer-type 'unsignedLong "0" rng-xsd-unsigned-long-max) | |
836 (rng-xsd-def-integer-type 'unsignedInt "0" rng-xsd-unsigned-int-max) | |
837 (rng-xsd-def-integer-type 'unsignedShort "0" rng-xsd-unsigned-short-max) | |
838 (rng-xsd-def-integer-type 'unsignedByte "0" rng-xsd-unsigned-byte-max) | |
839 | |
840 (defun rng-xsd-def-date-time-type (name template) | |
841 (put name 'rng-xsd-convert (list 'rng-xsd-convert-date-time | |
842 (rng-xsd-make-date-time-regexp template))) | |
843 (put name 'rng-xsd-less-than 'rng-xsd-date-time<)) | |
844 | |
845 (rng-xsd-def-date-time-type 'dateTime "Y-M-DTt") | |
846 (rng-xsd-def-date-time-type 'time "t") | |
847 (rng-xsd-def-date-time-type 'date "Y-M-D") | |
848 (rng-xsd-def-date-time-type 'gYearMonth "Y-M") | |
849 (rng-xsd-def-date-time-type 'gYear "Y") | |
850 (rng-xsd-def-date-time-type 'gMonthDay "--M-D") | |
851 (rng-xsd-def-date-time-type 'gDay "---D") | |
852 (rng-xsd-def-date-time-type 'gMonth "--M") | |
853 | |
854 (put 'duration 'rng-xsd-convert '(rng-xsd-convert-duration)) | |
855 (put 'duration 'rng-xsd-less-than 'rng-xsd-duration<) | |
856 | |
857 (provide 'rng-xsd) | |
858 | |
86379 | 859 ;; arch-tag: 6b05510e-a5bb-4b99-8618-4660d00d0abb |
86361 | 860 ;;; rng-xsd.el ends here |