;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas
-;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
;;; Error handling
-(put 'rng-c-incorrect-schema
- 'error-conditions
- '(error rng-error nxml-file-parse-error rng-c-incorrect-schema))
-
-(put 'rng-c-incorrect-schema
- 'error-message
- "Incorrect schema")
+(define-error 'rng-c-incorrect-schema
+ "Incorrect schema" '(rng-error nxml-file-parse-error))
(defun rng-c-signal-incorrect-schema (filename pos message)
(nxml-signal-file-parse-error filename
(defconst rng-c-about-combine-slot 1)
(defun rng-c-lookup-create (name grammar)
- "Return a def object for NAME. A def object is a pair
-\(ABOUT . REF) where REF is returned by `rng-make-ref'. ABOUT is a
-two-element vector [OVERRIDE COMBINE]. COMBINE is either nil, choice
-or interleave. OVERRIDE is either nil, require or t."
+ "Return a def object for NAME.
+A def object is a pair \(ABOUT . REF) where REF is returned by
+`rng-make-ref'.
+ABOUT is a two-element vector [OVERRIDE COMBINE].
+COMBINE is either nil, choice or interleave.
+OVERRIDE is either nil, require or t."
(let ((def (gethash name grammar)))
(if def
def
- (progn
+ (progn
(setq def (cons (vector nil nil) (rng-make-ref name)))
(puthash name def grammar)
def))))
(defvar rng-c-file-index nil)
(defun rng-c-parse-file (filename &optional context)
- (save-excursion
- (set-buffer (get-buffer-create (rng-c-buffer-name context)))
+ (with-current-buffer (get-buffer-create (rng-c-buffer-name context))
(erase-buffer)
(rng-c-init-buffer)
(setq rng-c-file-name
"*")))
(defun rng-c-process-escapes ()
- ;; Check for any nuls, since we will use nul chars
+ ;; Check for any NULs, since we will use NUL chars
;; for internal purposes.
(let ((pos (search-forward "\C-@" nil t)))
(and pos
(cons (cons prefix
(rng-make-datatypes-uri (rng-c-parse-literal)))
rng-c-datatype-decls))))
-
+
(defun rng-c-parse-namespace ()
(rng-c-declare-namespace nil
(rng-c-parse-identifier-or-keyword)))
(defun rng-c-parse-default ()
(rng-c-expect "namespace")
- (rng-c-declare-namespace t
+ (rng-c-declare-namespace t
(if (string-equal rng-c-current-token "=")
nil
(rng-c-parse-identifier-or-keyword))))
p)))
(defun rng-c-parse-primary ()
- "Parse a primary expression. The current token must be the first
-token of the expression. After parsing the current token should be
-token following the primary expression."
+ "Parse a primary expression.
+The current token must be the first token of the expression.
+After parsing the current token should be the token following
+the primary expression."
(cond ((rng-c-current-token-keyword-p)
(let ((parse-function (get (intern rng-c-current-token)
'rng-c-pattern)))
((rng-c-current-token-quoted-identifier-p)
(rng-c-advance-with (substring rng-c-current-token 1)))
(t (rng-c-error "Expected identifier or keyword"))))
-
+
(put 'string 'rng-c-pattern 'rng-c-parse-string)
(put 'token 'rng-c-pattern 'rng-c-parse-token)
(put 'element 'rng-c-pattern 'rng-c-parse-element)
(string-equal rng-c-current-token "|")))
(rng-make-choice-name-class name-classes))
name-class)))
-
+
(defun rng-c-parse-primary-name-class (attribute)
(cond ((rng-c-current-token-ncname-p)
(rng-c-advance-with
;; XXX don't allow attributes after text
(defun rng-c-parse-annotation-body (&optional allow-text)
- "Current token is [. Parse up to matching ]. Current token after
-parse is token following ]."
+ "Current token is [. Parse up to matching ].
+Current token after parse is token following ]."
(or (string-equal rng-c-current-token "[")
(rng-c-error "Expected ["))
(rng-c-advance)
(rng-c-parse-literal))
(t (rng-c-error "Expected = or ["))))))
(rng-c-advance))
-
+
(defun rng-c-advance-with (pattern)
(rng-c-advance)
pattern)
(provide 'rng-cmpct)
;;; rng-cmpct.el
-
-;; arch-tag: 90395eb1-283b-4146-bbc1-6d6ef1704e57