annotate lisp/nxml/rng-xsd.el @ 91833:d5012338a2ef

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