-;; @(#) xml.el --- XML parser
+;;; xml.el --- XML parser
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
;; in the XML file.
;;
;; The XML file should have the following format:
-;; <node1 attr1="name1" attr2="name2" ...> value
-;; <node2 attr3="name3" attr4="name4"> value2 </node2>
-;; <node3 attr5="name5" attr6="name6"> value3 </node3>
+;; <node1 attr1="name1" attr2="name2" ...>value
+;; <node2 attr3="name3" attr4="name4">value2</node2>
+;; <node3 attr5="name5" attr6="name6">value3</node3>
;; </node1>
;; Of course, the name of the nodes and attributes can be anything. There can
;; be any number of attributes (or none), as well as any number of children
;; | nil
;; string ::= "..."
;;
-;; Since XML is case insensitive, tag_name is always converted to lower-cases.
-;; tag_name is then converted to a symbol (this is not a string, so that the
-;; list takes less space in memory and is faster to traverse).
-;;
;; Some macros are provided to ease the parsing of this list
;;; Code:
(defun xml-parse-file (file &optional parse-dtd)
"Parse the well-formed XML FILE.
+If FILE is already edited, this will keep the buffer alive.
Returns the top node with all its children.
If PARSE-DTD is non-nil, the DTD is parsed rather than skipped."
- (find-file file)
- (let ((xml (xml-parse-region (point-min)
- (point-max)
- (current-buffer)
- parse-dtd)))
- (kill-buffer (current-buffer))
- xml))
+ (let ((keep))
+ (if (get-file-buffer file)
+ (progn
+ (set-buffer (get-file-buffer file))
+ (setq keep (point)))
+ (find-file file))
+
+ (let ((xml (xml-parse-region (point-min)
+ (point-max)
+ (current-buffer)
+ parse-dtd)))
+ (if keep
+ (goto-char keep)
+ (kill-buffer (current-buffer)))
+ xml)))
(defun xml-parse-region (beg end &optional buffer parse-dtd)
"Parse the region from BEG to END in BUFFER.
(add-to-list 'xml result))))
;; translation of rule [1] of XML specifications
- (error "XML files can have only one toplevel tag.")))
+ (error "XML files can have only one toplevel tag")))
(goto-char end)))
(if parse-dtd
(cons dtd (reverse xml))
((looking-at "</")
'())
;; opening tag
- ((looking-at "<\\([^/> \t]+\\)")
+ ((looking-at "<\\([^/> \t\n]+\\)")
(let* ((node-name (match-string 1))
- (children (list (intern (downcase node-name))))
+ (children (list (intern node-name)))
+ (case-fold-search nil) ;; XML is case-sensitive
pos)
(goto-char (match-end 1))
(append children '("")))
;; is this a valid start tag ?
- (if (= (char-after) ?>)
+ (if (eq (char-after) ?>)
(progn
(forward-char 1)
(skip-chars-forward " \t\n")
- (while (not (looking-at (concat "</" node-name ">")))
+ ;; Now check that we have the right end-tag. Note that this one might
+ ;; contain spaces after the tag name
+ (while (not (looking-at (concat "</" node-name "[ \t\n]*>")))
(cond
((looking-at "</")
(error (concat
"XML: invalid syntax -- invalid end tag (expecting "
node-name
- ")")))
+ ") at pos " (number-to-string (point)))))
((= (char-after) ?<)
(set 'children (append children (list (xml-parse-tag end)))))
(t
(goto-char (match-end 0))
(skip-chars-forward " \t\n")
(if (> (point) end)
- (error "XML: End tag for %s not found before end of region."
+ (error "XML: End tag for %s not found before end of region"
node-name))
children
)
;; This was an invalid start tag
(error "XML: Invalid attribute list")
))))
+ (t ;; This is not a tag.
+ (error "XML: Invalid character"))
))
(defun xml-parse-attlist (end)
(let ((attlist '())
name)
(skip-chars-forward " \t\n")
- (while (looking-at "\\([a-zA-Z_:][a-zA-Z0-9.-_:]*\\)[ \t\n]*=[ \t\n]*")
- (set 'name (intern (downcase (match-string 1))))
+ (while (looking-at "\\([a-zA-Z_:][-a-zA-Z0-9._:]*\\)[ \t\n]*=[ \t\n]*")
+ (set 'name (intern (match-string 1)))
(goto-char (match-end 0))
;; Do we have a string between quotes (or double-quotes),
;; or a simple word ?
(unless (looking-at "\"\\([^\"]+\\)\"")
- (unless (looking-at "'\\([^\"]+\\)'")
- (error "XML: Attribute values must be given between quotes.")))
+ (unless (looking-at "'\\([^']+\\)'")
+ (error "XML: Attribute values must be given between quotes")))
;; Each attribute must be unique within a given element
(if (assoc name attlist)
- (error "XML: each attribute must be unique within an element."))
+ (error "XML: each attribute must be unique within an element"))
(set 'attlist (append attlist
- (list (cons name (match-string 1)))))
+ (list (cons name (match-string-no-properties 1)))))
(goto-char (match-end 0))
(skip-chars-forward " \t\n")
(if (> (point) end)
- (error "XML: end of attribute list not found before end of region."))
+ (error "XML: end of attribute list not found before end of region"))
)
attlist
))
;; External DTDs => don't know how to handle them yet
(if (looking-at "SYSTEM")
- (error "XML: Don't know how to handle external DTDs."))
+ (error "XML: Don't know how to handle external DTDs"))
(if (not (= (char-after) ?\[))
- (error "XML: Unknown declaration in the DTD."))
+ (error "XML: Unknown declaration in the DTD"))
;; Parse the rest of the DTD
(forward-char 1)
((looking-at
"[\t \n]*<!ELEMENT[ \t\n]+\\([a-zA-Z0-9.%;]+\\)[ \t\n]+\\([^>]+\\)>")
- (setq element (intern (downcase (match-string-no-properties 1)))
+ (setq element (intern (match-string-no-properties 1))
type (match-string-no-properties 2))
(set 'end-pos (match-end 0))
;; rule [45]: the element declaration must be unique
(if (assoc element dtd)
- (error "XML: elements declaration must be unique in a DTD (<%s>)."
+ (error "XML: elements declaration must be unique in a DTD (<%s>)"
(symbol-name element)))
;; Store the element in the DTD