;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
-;; Maintainer: FSF
+;; Maintainer: Mark A. Hershberger <mah@everybody.org>
;; Keywords: xml, data
;; This file is part of GNU Emacs.
(push child match))))
(nreverse match)))
-(defun xml-get-attribute (node attribute)
+(defun xml-get-attribute-or-nil (node attribute)
"Get from NODE the value of ATTRIBUTE.
-An empty string is returned if the attribute was not found."
- (if (xml-node-attributes node)
- (let ((value (assoc attribute (xml-node-attributes node))))
- (if value
- (cdr value)
- ""))
- ""))
+Return `nil' if the attribute was not found.
+
+See also `xml-get-attribute'."
+ (when (xml-node-attributes node)
+ (let ((value (assoc attribute (xml-node-attributes node))))
+ (when value
+ (cdr value)))))
+
+(defsubst xml-get-attribute (node attribute)
+ "Get from NODE the value of ATTRIBUTE.
+An empty string is returned if the attribute was not found.
+
+See also `xml-get-attribute-or-nil'."
+ (or (xml-get-attribute-or-nil node attribute) ""))
;;*******************************************************************
;;**
;;*******************************************************************
;;;###autoload
-(defun xml-parse-file (file &optional parse-dtd)
+(defun xml-parse-file (file &optional parse-dtd parse-ns)
"Parse the well-formed XML file FILE.
If FILE is already visited, use its buffer and don't kill it.
Returns the top node with all its children.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped."
+If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
+If PARSE-NS is non-nil, then QNAMES are expanded."
(let ((keep))
(if (get-file-buffer file)
(progn
(let ((xml (xml-parse-region (point-min)
(point-max)
(current-buffer)
- parse-dtd)))
+ parse-dtd parse-ns)))
(if keep
(goto-char keep)
(kill-buffer (current-buffer)))
;; XML [5]
;; Note that [:alpha:] matches all multibyte chars with word syntax.
-(defconst xml-name-regexp "[[:alpha:]_:][[:alnum:]._:-]*")
+(eval-and-compile
+ (defconst xml-name-regexp "[[:alpha:]_:][[:alnum:]._:-]*"))
;; Fixme: This needs re-writing to deal with the XML grammar properly, i.e.
;; document ::= prolog element Misc*
;; prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
;;;###autoload
-(defun xml-parse-region (beg end &optional buffer parse-dtd)
+(defun xml-parse-region (beg end &optional buffer parse-dtd parse-ns)
"Parse the region from BEG to END in BUFFER.
If BUFFER is nil, it defaults to the current buffer.
Returns the XML list for the region, or raises an error if the region
-is not a well-formed XML file.
+is not well-formed XML.
If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list."
+and returned as the first element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded."
(save-restriction
(narrow-to-region beg end)
;; Use fixed syntax table to ensure regexp char classes and syntax
(if (search-forward "<" nil t)
(progn
(forward-char -1)
- (if xml
+ (setq result (xml-parse-tag parse-dtd parse-ns))
+ (if (and xml result)
;; translation of rule [1] of XML specifications
(error "XML files can have only one toplevel tag")
- (setq result (xml-parse-tag parse-dtd))
(cond
((null result))
- ((listp (car result))
+ ((and (listp (car result))
+ parse-dtd)
(setq dtd (car result))
(if (cdr result) ; possible leading comment
(add-to-list 'xml (cdr result))))
(cons dtd (nreverse xml))
(nreverse xml)))))))
-
-(defun xml-parse-tag (&optional parse-dtd)
+(defun xml-ns-parse-ns-attrs (attr-list &optional xml-ns)
+ "Parse the namespace attributes and return a list of cons in the form:
+\(namespace . prefix)"
+
+ (mapcar
+ (lambda (attr)
+ (let* ((splitup (split-string (car attr) ":"))
+ (prefix (nth 0 splitup))
+ (lname (nth 1 splitup)))
+ (when (string= "xmlns" prefix)
+ (push (cons (if lname
+ lname
+ "")
+ (cdr attr))
+ xml-ns)))) attr-list)
+ xml-ns)
+
+;; expand element names
+(defun xml-ns-expand-el (el xml-ns)
+ "Expand the XML elements from \"prefix:local-name\" to a cons in the form
+\"(namespace . local-name)\"."
+
+ (let* ((splitup (split-string el ":"))
+ (lname (or (nth 1 splitup)
+ (nth 0 splitup)))
+ (prefix (if (nth 1 splitup)
+ (nth 0 splitup)
+ (if (string= lname "xmlns")
+ "xmlns"
+ "")))
+ (ns (cdr (assoc-string prefix xml-ns))))
+ (if (string= "" ns)
+ lname
+ (cons (intern (concat ":" ns))
+ lname))))
+
+;; expand attribute names
+(defun xml-ns-expand-attr (attr-list xml-ns)
+ "Expand the attribute list for a particular element from the form
+\"prefix:local-name\" to the form \"{namespace}:local-name\"."
+
+ (mapcar
+ (lambda (attr)
+ (let* ((splitup (split-string (car attr) ":"))
+ (lname (or (nth 1 splitup)
+ (nth 0 splitup)))
+ (prefix (if (nth 1 splitup)
+ (nth 0 splitup)
+ (if (string= (car attr) "xmlns")
+ "xmlns"
+ "")))
+ (ns (cdr (assoc-string prefix xml-ns))))
+ (setcar attr
+ (if (string= "" ns)
+ lname
+ (cons (intern (concat ":" ns))
+ lname)))))
+ attr-list)
+ attr-list)
+
+(defun xml-intern-attrlist (attr-list)
+ "Convert attribute names to symbols for backward compatibility."
+ (mapcar (lambda (attr)
+ (setcar attr (intern (car attr))))
+ attr-list)
+ attr-list)
+
+(defun xml-parse-tag (&optional parse-dtd parse-ns)
"Parse the tag at point.
If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
returned as the first element in the list.
+If PARSE-NS is non-nil, then QNAMES are expanded.
Returns one of:
- a list : the matching node
- nil : the point is not looking at a tag.
- a pair : the first element is the DTD, the second is the node."
- (cond
- ;; Processing instructions (like the <?xml version="1.0"?> tag at the
- ;; beginning of a document).
- ((looking-at "<\\?")
- (search-forward "?>")
- (skip-syntax-forward " ")
- (xml-parse-tag parse-dtd))
- ;; Character data (CDATA) sections, in which no tag should be interpreted
- ((looking-at "<!\\[CDATA\\[")
- (let ((pos (match-end 0)))
- (unless (search-forward "]]>" nil t)
- (error "CDATA section does not end anywhere in the document"))
- (buffer-substring pos (match-beginning 0))))
- ;; DTD for the document
- ((looking-at "<!DOCTYPE")
- (let (dtd)
- (if parse-dtd
- (setq dtd (xml-parse-dtd))
- (xml-skip-dtd))
+ (let ((xml-ns (if (consp parse-ns)
+ parse-ns
+ (if parse-ns
+ (list
+ ;; Default no namespace
+ (cons "" "")
+ ;; We need to seed the xmlns namespace
+ (cons "xmlns" "http://www.w3.org/2000/xmlns/"))))))
+ (cond
+ ;; Processing instructions (like the <?xml version="1.0"?> tag at the
+ ;; beginning of a document).
+ ((looking-at "<\\?")
+ (search-forward "?>")
+ (skip-syntax-forward " ")
+ (xml-parse-tag parse-dtd xml-ns))
+ ;; Character data (CDATA) sections, in which no tag should be interpreted
+ ((looking-at "<!\\[CDATA\\[")
+ (let ((pos (match-end 0)))
+ (unless (search-forward "]]>" nil t)
+ (error "CDATA section does not end anywhere in the document"))
+ (buffer-substring pos (match-beginning 0))))
+ ;; DTD for the document
+ ((looking-at "<!DOCTYPE")
+ (let (dtd)
+ (if parse-dtd
+ (setq dtd (xml-parse-dtd))
+ (xml-skip-dtd))
(skip-syntax-forward " ")
(if dtd
- (cons dtd (xml-parse-tag))
- (xml-parse-tag))))
- ;; skip comments
- ((looking-at "<!--")
- (search-forward "-->")
- nil)
- ;; end tag
- ((looking-at "</")
- '())
- ;; opening tag
- ((looking-at "<\\([^/>[:space:]]+\\)")
- (goto-char (match-end 1))
- (let* ((node-name (match-string 1))
- ;; Parse the attribute list.
- (children (list (xml-parse-attlist) (intern node-name)))
- pos)
-
- ;; is this an empty element ?
- (if (looking-at "/>")
- (progn
- (forward-char 2)
- ;; Fixme: Inconsistent with the nil content returned from
- ;; `<tag></tag>'.
- (nreverse (cons '("") children)))
+ (cons dtd (xml-parse-tag nil xml-ns))
+ (xml-parse-tag nil xml-ns))))
+ ;; skip comments
+ ((looking-at "<!--")
+ (search-forward "-->")
+ nil)
+ ;; end tag
+ ((looking-at "</")
+ '())
+ ;; opening tag
+ ((looking-at "<\\([^/>[:space:]]+\\)")
+ (goto-char (match-end 1))
+
+ ;; Parse this node
+ (let* ((node-name (match-string 1))
+ (attr-list (xml-parse-attlist))
+ (children (if (consp xml-ns) ;; take care of namespace parsing
+ (progn
+ (setq xml-ns (xml-ns-parse-ns-attrs
+ attr-list xml-ns))
+ (list (xml-ns-expand-attr
+ attr-list xml-ns)
+ (xml-ns-expand-el
+ node-name xml-ns)))
+ (list (xml-intern-attrlist attr-list)
+ (intern node-name))))
+ pos)
+
+ ;; is this an empty element ?
+ (if (looking-at "/>")
+ (progn
+ (forward-char 2)
+ (nreverse children))
;; is this a valid start tag ?
(if (eq (char-after) ?>)
(error "XML: Invalid end tag (expecting %s) at pos %d"
node-name (point)))
((= (char-after) ?<)
- (let ((tag (xml-parse-tag)))
+ (let ((tag (xml-parse-tag nil xml-ns)))
(when tag
(push tag children))))
(t
(nreverse children))
;; This was an invalid start tag
(error "XML: Invalid attribute list")))))
- (t ;; This is not a tag.
- (error "XML: Invalid character"))))
+ (t ;; This is not a tag.
+ (error "XML: Invalid character")))))
(defun xml-parse-attlist ()
- "Return the attribute-list after point.
-Leave point at the first non-blank character after the tag."
+ "Return the attribute-list after point. Leave point at the
+first non-blank character after the tag."
(let ((attlist ())
- start-pos name)
+ end-pos name)
(skip-syntax-forward " ")
(while (looking-at (eval-when-compile
(concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))
- (setq name (intern (match-string 1)))
+ (setq name (match-string 1))
(goto-char (match-end 0))
;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
;; Do we have a string between quotes (or double-quotes),
;; or a simple word ?
(if (looking-at "\"\\([^\"]*\\)\"")
- (setq start-pos (match-beginning 0))
+ (setq end-pos (match-end 0))
(if (looking-at "'\\([^']*\\)'")
- (setq start-pos (match-beginning 0))
+ (setq end-pos (match-end 0))
(error "XML: Attribute values must be given between quotes")))
;; Each attribute must be unique within a given element
(replace-regexp-in-string "\\s-\\{2,\\}" " " string)
(push (cons name (xml-substitute-special string)) attlist))
- (goto-char start-pos)
- (forward-sexp) ; we have string syntax
-
+ (goto-char end-pos)
(skip-syntax-forward " "))
(nreverse attlist)))
((looking-at
"<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")
- (setq element (intern (match-string 1))
+ (setq element (match-string 1)
type (match-string-no-properties 2))
(setq end-pos (match-end 0))
;; rule [45]: the element declaration must be unique
(if (assoc element dtd)
(error "XML: element declarations must be unique in a DTD (<%s>)"
- (symbol-name element)))
+ element))
;; Store the element in the DTD
(push (list element type) dtd)
(search-forward ">"))))
(nreverse dtd)))
-
(defun xml-parse-elem-type (string)
"Convert element type STRING into a Lisp structure."
(provide 'xml)
+;;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b
;;; xml.el ends here