X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ae0261106903fdd8e1aefe92549d4d88e521e6e6..139bbb9cc4db48696ce8c48b8dd6ce09c2c07594:/lisp/xml.el diff --git a/lisp/xml.el b/lisp/xml.el index ec048a440b..5fdb6f33b1 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1,6 +1,7 @@ ;;; xml.el --- XML parser -;; Copyright (C) 2000, 01, 03, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Emmanuel Briot ;; Maintainer: Mark A. Hershberger @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -84,6 +85,9 @@ ;;** ;;******************************************************************* +(defconst xml-undefined-entity "?" + "What to substitute for undefined entities") + (defvar xml-entity-alist '(("lt" . "<") ("gt" . ">") @@ -179,7 +183,10 @@ If PARSE-NS is non-nil, then QNAMES are expanded." xml))) -(let* ((start-chars (concat ":[:alpha:]_")) +(defvar xml-name-re) +(defvar xml-entity-value-re) +(defvar xml-att-def-re) +(let* ((start-chars (concat "[:alpha:]:_")) (name-chars (concat "-[:digit:]." start-chars)) ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ (whitespace "[ \t\n\r]")) @@ -206,6 +213,35 @@ If PARSE-NS is non-nil, then QNAMES are expanded." (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) ;;[67] Reference ::= EntityRef | CharRef (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) +;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" + (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|" + "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)")) +;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default] +;; | 'IDREF' [VC: IDREF] +;; | 'IDREFS' [VC: IDREF] +;; | 'ENTITY' [VC: Entity Name] +;; | 'ENTITIES' [VC: Entity Name] +;; | 'NMTOKEN' [VC: Name Token] +;; | 'NMTOKENS' [VC: Name Token] + (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)") +;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re + "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)")) +;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens] + (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re + "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*" + whitespace ")\\)")) +;;[57] EnumeratedType ::= NotationType | Enumeration + (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)")) +;;[54] AttType ::= StringType | TokenizedType | EnumeratedType +;;[55] StringType ::= 'CDATA' + (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)")) +;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) + (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)")) +;;[53] AttDef ::= S Name S AttType S DefaultDecl + (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re + whitespace "*" xml-att-type-re + whitespace "*" xml-default-decl-re "\\)")) ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' ;; | "'" ([^%&'] | PEReference | Reference)* "'" (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re @@ -575,7 +611,7 @@ This follows the rule [28] in the XML specifications." (error "XML: Bad DTD") (forward-char) ;; Parse the rest of the DTD - ;; Fixme: Deal with ATTLIST, NOTATION, PIs. + ;; Fixme: Deal with NOTATION, PIs. (while (not (looking-at "\\s-*\\]")) (skip-syntax-forward " ") (cond @@ -601,7 +637,7 @@ This follows the rule [28] in the XML specifications." (t (if xml-validating-parser (error "XML: (Validity) Invalid element type in the DTD")))) - + ;; rule [45]: the element declaration must be unique (if (and (assoc element dtd) xml-validating-parser) @@ -611,16 +647,24 @@ This follows the rule [28] in the XML specifications." ;; Store the element in the DTD (push (list element type) dtd) (goto-char end-pos)) + + ;; Translation of rule [52] of XML specifications + ((looking-at (concat "")) + + ;; We don't do anything with ATTLIST currently + (goto-char (match-end 0))) + ((looking-at "")) ((looking-at (concat "")) - (let ((name (buffer-substring (nth 2 (match-data)) - (nth 3 (match-data)))) - (value (buffer-substring (+ (nth 4 (match-data)) 1) - (- (nth 5 (match-data)) 1)))) - (goto-char (nth 1 (match-data))) + (let ((name (match-string 1)) + (value (substring (match-string 2) 1 + (- (length (match-string 2)) 1)))) + (goto-char (match-end 0)) (setq xml-entity-alist (append xml-entity-alist (list (cons name @@ -639,11 +683,10 @@ This follows the rule [28] in the XML specifications." "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'" "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)" "[ \t\n\r]*>"))) - (let ((name (buffer-substring (nth 2 (match-data)) - (nth 3 (match-data)))) - (file (buffer-substring (+ (nth 4 (match-data)) 1) - (- (nth 5 (match-data)) 1)))) - (goto-char (nth 1 (match-data))) + (let ((name (match-string 1)) + (file (substring (match-string 2) 1 + (- (length (match-string 2)) 1)))) + (goto-char (match-end 0)) (setq xml-entity-alist (append xml-entity-alist (list (cons name (with-temp-buffer @@ -652,10 +695,27 @@ This follows the rule [28] in the XML specifications." (xml-parse-fragment xml-validating-parser parse-ns)))))))) + ;; skip parameter entity declarations + ((or (looking-at (concat "")) + (looking-at (concat ""))) + (goto-char (match-end 0))) + ;; skip parameter entities + ((looking-at (concat "%" xml-name-re ";")) + (goto-char (match-end 0))) (t - (error "XML: (Validity) Invalid DTD item"))))) + (when xml-validating-parser + (error "XML: (Validity) Invalid DTD item")))))) (if (looking-at "\\s-*]>") - (goto-char (nth 1 (match-data))))) + (goto-char (match-end 0)))) (nreverse dtd))) (defun xml-parse-elem-type (string) @@ -724,11 +784,12 @@ This follows the rule [28] in the XML specifications." (entity (cdr entity)) ((eq (length this-part) 0) - (error "XML: (Validity) No entity given")) + (error "XML: (Not Well-Formed) No entity given")) (t (if xml-validating-parser (error "XML: (Validity) Undefined entity `%s'" - this-part)))))) + this-part) + xml-undefined-entity))))) (cond ((null children) ;; FIXME: If we have an entity that expands into XML, this won't work.