Changeset 4037 for trunk/lisp/xml.el
- Timestamp:
- 02/16/06 06:55:11 (3 years ago)
- Files:
-
- trunk/lisp/xml.el (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/lisp/xml.el
r3990 r4037 2 2 3 3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 4 ;; 2005 Free Software Foundation, Inc.4 ;; 2005, 2006 Free Software Foundation, Inc. 5 5 6 6 ;; Author: Emmanuel Briot <briot@gnat.com> … … 189 189 (let* ((start-chars (concat "[:alpha:]:_")) 190 190 (name-chars (concat "-[:digit:]." start-chars)) 191 ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+191 ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ 192 192 (whitespace "[ \t\n\r]")) 193 ;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6]194 ;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]195 ;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF]196 ;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]193 ;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] 194 ;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] 195 ;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] 196 ;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] 197 197 (defvar xml-name-start-char-re (concat "[" start-chars "]")) 198 ;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]198 ;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040] 199 199 (defvar xml-name-char-re (concat "[" name-chars "]")) 200 ;;[5] Name ::= NameStartChar (NameChar)*200 ;;[5] Name ::= NameStartChar (NameChar)* 201 201 (defvar xml-name-re (concat xml-name-start-char-re xml-name-char-re "*")) 202 ;;[6] Names ::= Name (#x20 Name)*202 ;;[6] Names ::= Name (#x20 Name)* 203 203 (defvar xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*")) 204 ;;[7] Nmtoken ::= (NameChar)+204 ;;[7] Nmtoken ::= (NameChar)+ 205 205 (defvar xml-nmtoken-re (concat xml-name-char-re "+")) 206 ;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*206 ;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)* 207 207 (defvar xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*")) 208 ;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'208 ;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';' 209 209 (defvar xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)") 210 ;;[68] EntityRef ::= '&' Name ';'210 ;;[68] EntityRef ::= '&' Name ';' 211 211 (defvar xml-entity-ref (concat "&" xml-name-re ";")) 212 ;;[69] PEReference ::= '%' Name ';'212 ;;[69] PEReference ::= '%' Name ';' 213 213 (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) 214 ;;[67] Reference ::= EntityRef | CharRef214 ;;[67] Reference ::= EntityRef | CharRef 215 215 (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) 216 ;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"216 ;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" 217 217 (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|" 218 218 "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)")) 219 ;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default]220 ;; | 'IDREF' [VC: IDREF]221 ;; | 'IDREFS' [VC: IDREF]222 ;; | 'ENTITY' [VC: Entity Name]223 ;; | 'ENTITIES' [VC: Entity Name]224 ;; | 'NMTOKEN' [VC: Name Token]225 ;; | 'NMTOKENS' [VC: Name Token]219 ;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default] 220 ;; | 'IDREF' [VC: IDREF] 221 ;; | 'IDREFS' [VC: IDREF] 222 ;; | 'ENTITY' [VC: Entity Name] 223 ;; | 'ENTITIES' [VC: Entity Name] 224 ;; | 'NMTOKEN' [VC: Name Token] 225 ;; | 'NMTOKENS' [VC: Name Token] 226 226 (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)") 227 ;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'227 ;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' 228 228 (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re 229 229 "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)")) 230 ;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens]230 ;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens] 231 231 (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re 232 232 "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*" 233 233 whitespace ")\\)")) 234 ;;[57] EnumeratedType ::= NotationType | Enumeration234 ;;[57] EnumeratedType ::= NotationType | Enumeration 235 235 (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)")) 236 ;;[54] AttType ::= StringType | TokenizedType | EnumeratedType237 ;;[55] StringType ::= 'CDATA'236 ;;[54] AttType ::= StringType | TokenizedType | EnumeratedType 237 ;;[55] StringType ::= 'CDATA' 238 238 (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)")) 239 ;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)239 ;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) 240 240 (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)")) 241 ;;[53] AttDef ::= S Name S AttType S DefaultDecl241 ;;[53] AttDef ::= S Name S AttType S DefaultDecl 242 242 (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re 243 243 whitespace "*" xml-att-type-re 244 244 whitespace "*" xml-default-decl-re "\\)")) 245 ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'246 ;; | "'" ([^%&'] | PEReference | Reference)* "'"245 ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' 246 ;; | "'" ([^%&'] | PEReference | Reference)* "'" 247 247 (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re 248 248 "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|" … … 270 270 (dotimes (c 31) 271 271 (modify-syntax-entry c "." table)) ; all are space in standard table 272 (dolist (c '(?\t ?\n ?\r)) ; these should be space272 (dolist (c '(?\t ?\n ?\r)) ; these should be space 273 273 (modify-syntax-entry c " " table)) 274 274 ;; For skipping attributes. … … 307 307 and returned as the first element of the list. 308 308 If PARSE-NS is non-nil, then QNAMES are expanded." 309 (save-restriction310 (narrow-to-region beg end)311 ;; Use fixed syntax table to ensure regexp char classes and syntax312 ;; specs DTRT.313 (with-syntax-table (standard-syntax-table)314 ( let ((case-fold-search nil) ; XML is case-sensitive.315 xml result dtd) 316 (save-excursion 317 (if buffer 318 (set-buffer buffer))309 ;; Use fixed syntax table to ensure regexp char classes and syntax 310 ;; specs DTRT. 311 (with-syntax-table (standard-syntax-table) 312 (let ((case-fold-search nil) ; XML is case-sensitive. 313 xml result dtd) 314 (save-excursion 315 (if buffer 316 (set-buffer buffer)) 317 (save-restriction 318 (narrow-to-region beg end) 319 319 (goto-char (point-min)) 320 320 (while (not (eobp)) … … 391 391 (if parse-ns 392 392 (list 393 393 ;; Default for empty prefix is no namespace 394 394 (cons "" "") 395 395 ;; "xml" namespace … … 432 432 ;; Parse this node 433 433 (let* ((node-name (match-string 1)) 434 435 436 437 438 439 434 ;; Parse the attribute list. 435 (attrs (xml-parse-attlist xml-ns)) 436 children pos) 437 438 ;; add the xmlns:* attrs to our cache 439 (when (consp xml-ns) 440 440 (dolist (attr attrs) 441 441 (when (and (consp (car attr)) … … 445 445 xml-ns)))) 446 446 447 447 (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns))) 448 448 449 449 ;; is this an empty element ? … … 495 495 (defun xml-parse-string () 496 496 "Parse the next whatever. Could be a string, or an element." 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 497 (let* ((pos (point)) 498 (string (progn (if (search-forward "<" nil t) 499 (forward-char -1) 500 (goto-char (point-max))) 501 (buffer-substring pos (point))))) 502 ;; Clean up the string. As per XML specifications, the XML 503 ;; processor should always pass the whole string to the 504 ;; application. But \r's should be replaced: 505 ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends 506 (setq pos 0) 507 (while (string-match "\r\n?" string pos) 508 (setq string (replace-match "\n" t t string)) 509 (setq pos (1+ (match-beginning 0)))) 510 511 (xml-substitute-special string))) 512 512 513 513 (defun xml-parse-attlist (&optional xml-ns) … … 544 544 (let ((expansion (xml-substitute-special string))) 545 545 (unless (stringp expansion) 546 547 546 ; We say this is the constraint. It is acctually that 547 ; external entities nor "<" can be in an attribute value. 548 548 (error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements")) 549 549 (push (cons name expansion) attlist)))
