code.delx.au - gnu-emacs/blob - lisp/nxml/rng-pttrn.el

   1 ;;; rng-pttrn.el --- RELAX NG patterns
   2
   3 ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: James Clark
   6 ;; Keywords: XML, RelaxNG
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; pattern ::=
  28 ;;   (ref <pattern> <local-name>)
  29 ;;   | (choice <pattern> <pattern> ...)
  30 ;;   | (group <pattern> <pattern> ...)
  31 ;;   | (interleave <pattern> <pattern> ...)
  32 ;;   | (zero-or-more <pattern>)
  33 ;;   | (one-or-more <pattern>)
  34 ;;   | (optional <pattern>)
  35 ;;   | (mixed <pattern>)
  36 ;;   | (value <datatype> <string> <context>)
  37 ;;   | (data <datatype> <params>)
  38 ;;   | (data-except <datatype> <params> <pattern>)
  39 ;;   | (list <pattern>)
  40 ;;   | (element <name-class> <pattern>)
  41 ;;   | (attribute <name-class> <pattern>)
  42 ;;   | (text)
  43 ;;   | (empty)
  44 ;;   | (not-allowed)
  45 ;;
  46 ;; params ::=
  47 ;;   ((<param-name> . <param-value> ) ...)
  48 ;; param-name ::= <symbol>
  49 ;; param-value ::= <string>
  50 ;;
  51 ;; name-class ::=
  52 ;;   (name <name>)
  53 ;;   | (any-name)
  54 ;;   | (any-name-except <name-class>)
  55 ;;   | (ns-name <ns>)
  56 ;;   | (ns-name-except <ns> <name-class>)
  57 ;;   | (choice <name-class> <name-class> ...)
  58 ;;
  59 ;; name ::= (<ns> . <local-name>)
  60 ;; ns ::= nil | <symbol>
  61 ;; local-name ::= <string>
  62 ;; datatype ::= (<datatype-uri> . <datatype-local-name>)
  63 ;; datatype-uri ::= nil | <symbol>
  64 ;; datatype-local-name ::= <symbol>
  65
  66 ;;; Code:
  67
  68 (defvar rng-schema-change-hook nil
  69   "Hook to be run after `rng-current-schema' changes.")
  70
  71 (defvar rng-current-schema nil
  72   "Pattern to be used as schema for the current buffer.")
  73 (make-variable-buffer-local 'rng-current-schema)
  74
  75 (defun rng-make-ref (name)
  76   (list 'ref nil name))
  77
  78 (defun rng-ref-set (ref pattern)
  79   (setcar (cdr ref) pattern))
  80
  81 (defun rng-ref-get (ref) (cadr ref))
  82
  83 (defun rng-make-choice (patterns)
  84   (cons 'choice patterns))
  85
  86 (defun rng-make-group (patterns)
  87   (cons 'group patterns))
  88
  89 (defun rng-make-interleave (patterns)
  90   (cons 'interleave patterns))
  91
  92 (defun rng-make-zero-or-more (pattern)
  93   (list 'zero-or-more pattern))
  94
  95 (defun rng-make-one-or-more (pattern)
  96   (list 'one-or-more pattern))
  97
  98 (defun rng-make-optional (pattern)
  99   (list 'optional pattern))
 100
 101 (defun rng-make-mixed (pattern)
 102   (list 'mixed pattern))
 103
 104 (defun rng-make-value (datatype str context)
 105   (list 'value datatype str context))
 106
 107 (defun rng-make-data (name params)
 108   (list 'data name params))
 109
 110 (defun rng-make-data-except (name params pattern)
 111   (list 'data-except name params pattern))
 112
 113 (defun rng-make-list (pattern)
 114   (list 'list pattern))
 115
 116 (defun rng-make-element (name-class pattern)
 117   (list 'element name-class pattern))
 118
 119 (defun rng-make-attribute (name-class pattern)
 120   (list 'attribute name-class pattern))
 121
 122 (defun rng-make-text ()
 123   '(text))
 124
 125 (defun rng-make-empty ()
 126   '(empty))
 127
 128 (defun rng-make-not-allowed ()
 129   '(not-allowed))
 130
 131 (defun rng-make-any-name-name-class ()
 132   '(any-name))
 133
 134 (defun rng-make-any-name-except-name-class (name-class)
 135   (list 'any-name-except name-class))
 136
 137 (defun rng-make-ns-name-name-class (ns)
 138   (list 'ns-name ns))
 139
 140 (defun rng-make-ns-name-except-name-class (ns name-class)
 141   (list 'ns-name-except ns name-class))
 142
 143 (defun rng-make-name-name-class (name)
 144   (list 'name name))
 145
 146 (defun rng-make-choice-name-class (name-classes)
 147   (cons 'choice name-classes))
 148
 149 (defconst rng-any-content
 150   (let* ((ref (rng-make-ref "any-content"))
 151          (pattern (rng-make-zero-or-more
 152                     (rng-make-choice
 153                      (list
 154                       (rng-make-text)
 155                       (rng-make-attribute (rng-make-any-name-name-class)
 156                                           (rng-make-text))
 157                       (rng-make-element (rng-make-any-name-name-class)
 158                                         ref))))))
 159     (rng-ref-set ref pattern)
 160     pattern)
 161   "A pattern that matches the attributes and content of any element.")
 162
 163 (defconst rng-any-element
 164   (let* ((ref (rng-make-ref "any-element"))
 165          (pattern
 166           (rng-make-element
 167            (rng-make-any-name-name-class)
 168            (rng-make-zero-or-more
 169             (rng-make-choice
 170              (list
 171               (rng-make-text)
 172               (rng-make-attribute (rng-make-any-name-name-class)
 173                                   (rng-make-text))
 174               ref))))))
 175     (rng-ref-set ref pattern)
 176     pattern)
 177   "A pattern that matches any element.")
 178
 179 ;;; Names
 180
 181 (defun rng-make-name (ns local-name)
 182   (cons ns local-name))
 183
 184 ;;; Datatypes
 185
 186 (defun rng-make-datatype (uri local-name)
 187   (cons uri (intern local-name)))
 188
 189 (provide 'rng-pttrn)
 190
 191 ;; arch-tag: 9418e269-ddd4-4037-861f-ff903f48f008
 192 ;;; rng-pttrn.el ends here