;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps
-;; Copyright (C) 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: XML, regexp
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
+;; This file is part of GNU Emacs.
-;; This program is distributed in the hope that it will be
-;; useful, but WITHOUT ANY WARRANTY; without even the implied
-;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-;; PURPOSE. See the GNU General Public License for more details.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; You should have received a copy of the GNU General Public
-;; License along with this program; if not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-;; MA 02111-1307 USA
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defun xsdre-translate (regexp)
"Translate a W3C XML Schema Datatypes regexp to an Emacs regexp.
-Returns a string. REGEXP is a string. If REGEXP is not a valid XSD
+Returns a string. REGEXP is a string. If REGEXP is not a valid XSD
regexp, signal an `xsdre-invalid-regexp' condition."
(xsdre-from-symbolic
(xsdre-to-symbolic regexp)))
canonical form, in which ranges are in increasing order, and adjacent
ranges are merged wherever possible."
(when list
- (setq list
+ (setq list
(sort list 'xsdre-range-less-than))
(let* ((next (cdr list))
(tail list)
(setcar tail (xsdre-make-range first last))
(setcdr tail nil)
list)))
-
+
(defun xsdre-range-list-union (range-lists)
- "Return a range-list the union of a list of range-lists."
+ "Return a range-list, the union of a list of range-lists."
(xsdre-make-range-list (apply 'append range-lists)))
(defun xsdre-range-list-difference (orig subtract)
(<= (xsdre-range-first (car subtract)) last))
(when (< first (xsdre-range-first (car subtract)))
(setq new
- (cons (xsdre-make-range
+ (cons (xsdre-make-range
first
(1- (xsdre-range-first (car subtract))))
new)))
(< (xsdre-range-last r1) (xsdre-range-last r2)))))
(defun xsdre-check-range-list (range-list)
- "Check that range-list is a range-list.
+ "Check that RANGE-LIST is a range-list.
Signal an error if it is not."
(let ((last nil))
(while range-list
(setq last (xsdre-range-last head)))
(setq range-list (cdr range-list))))
t)
-
+
;;; Compiling symbolic regexps to Emacs regexps
(defun xsdre-from-symbolic (re)
(xsdre-range-first (car ranges))))
(t (xsdre-range-list-to-char-alternative ranges)))))
accum))
-
+
(defun xsdre-compile-single-char (ch)
(if (memq ch '(?. ?* ?+ ?? ?\[ ?\] ?^ ?$ ?\\))
(string ?\\ ch)
(string (decode-char 'ucs ch))))
-
+
(defun xsdre-char-class-to-range-list (cc)
- "Return a range-list for a symbolic char-class."
+ "Return a range-list for a symbolic char-class CC."
(cond ((integerp cc) (list cc))
((symbolp cc)
(or (get cc 'xsdre-ranges)
(setq chars '(?- ?^ ?\])))
(setq chars (cons ?\[ chars))
(apply 'string chars)))
-
+
;;; Parsing
(defvar xsdre-current-regexp nil
- "List of characters remaining to be parsed. Dynamically bound.")
+ "List of characters remaining to be parsed. Dynamically bound.")
(defun xsdre-to-symbolic (str)
"Convert a W3C XML Schema datatypes regexp to a symbolic form.
(cons lower upper)))))
(t (xsdre-parse-error "Expected , or }")))))
(t nil))))
-
+
(defun xsdre-parse-bound ()
(let ((n 0))
(while (progn
(xsdre-advance)
(not (memq (car xsdre-current-regexp) '(?} ?,)))))
n))
-
+
(defun xsdre-try-parse-atom ()
(let ((ch (car xsdre-current-regexp)))
(t (if ch
(xsdre-parse-error "Missing char after \\")
(xsdre-parse-error "Bad escape %c" ch))))))
-
+
(defun xsdre-parse-prop ()
(xsdre-expect ?{)
(let ((name nil))
(if (eq (car xsdre-current-regexp) ch)
(xsdre-advance)
(xsdre-parse-error "Expected %c" ch)))
-
+
(defun xsdre-advance ()
(setq xsdre-current-regexp
(cdr xsdre-current-regexp)))
(put 'xsdre-parse-error
'error-message
"Internal error in parsing XSD regexp")
-
+
;;; Character class data
(put 'dot 'xsdre-char-class '(difference any (union #xA #xD)))
"Use a UnicodeData file to generate code to initialize Unicode categories.
Code is inserted into the current buffer."
(interactive "fUnicodeData file: ")
- (save-excursion
- (set-buffer (find-file-noselect file))
+ (with-current-buffer (find-file-noselect file)
(goto-char (point-min))
- (mapcar (lambda (x) (put x 'xsdre-ranges nil)) xsdre-gen-categories)
+ (mapc (lambda (x) (put x 'xsdre-ranges nil)) xsdre-gen-categories)
(while (re-search-forward "^\\([0-9A-Fa-f]*\\);[^;]*;\\([A-Z][a-z]\\);"
nil
t)
(cdr ranges))))
(t
(put sym 'xsdre-ranges (cons code ranges))))))
- (mapcar (lambda (x)
- (put x
- 'xsdre-ranges
- (nreverse (get x 'xsdre-ranges)))
- nil)
- xsdre-gen-categories))
- (mapcar (lambda (x)
- (let ((start (point)))
- (pp (list 'xsdre-def-primitive-category
- (list 'quote x)
- (list 'quote (get x 'xsdre-ranges)))
- (current-buffer))
- (save-excursion
- (goto-char start)
- (down-list 2)
- (while (condition-case err
- (progn
- (forward-sexp)
- t)
- (error nil))
- (when (and (< 70 (current-column))
- (not (looking-at ")")))
- (insert "\n")
- (lisp-indent-line))))))
- xsdre-gen-categories))
+ (mapc (lambda (x)
+ (put x
+ 'xsdre-ranges
+ (nreverse (get x 'xsdre-ranges)))
+ nil)
+ xsdre-gen-categories))
+ (mapc (lambda (x)
+ (let ((start (point)))
+ (pp (list 'xsdre-def-primitive-category
+ (list 'quote x)
+ (list 'quote (get x 'xsdre-ranges)))
+ (current-buffer))
+ (save-excursion
+ (goto-char start)
+ (down-list 2)
+ (while (condition-case err
+ (progn
+ (forward-sexp)
+ t)
+ (error nil))
+ (when (and (< 70 (current-column))
+ (not (looking-at ")")))
+ (insert "\n")
+ (lisp-indent-line))))))
+ xsdre-gen-categories))
(defun xsdre-def-primitive-category (sym ranges)
(put sym 'xsdre-ranges ranges)
(xsdre-def-derived-category 'name-continue '(union name-initial
name-continue-not-initial))
-
-(xsdre-def-primitive-category
+
+(xsdre-def-primitive-category
'name-continue-not-initial
'((#x002d . #x002e)
(#x0030 . #x0039)
(976 . 977)
(981 . 983)
987 989 991 993 995 997 999 1001 1003 1005
-
+
(1007 . 1011)
1013
(1072 . 1119)
7877 7879 7881 7883 7885 7887 7889 7891 7893
7895 7897 7899 7901 7903 7905 7907 7909 7911
7913 7915 7917 7919 7921 7923 7925 7927 7929
-
+
(7936 . 7943)
(7952 . 7957)
(7968 . 7975)