Sender: johnw@alice.aris
Newsgroups: gnu.emacs.sources
Subject: xml-parse.el 1.1
From: John Wiegley <johnw@gnu.org>
Message-ID: <m3k86paywb.fsf@gnu.org>
Date: 17 Feb 2001 19:35:02 -0700
Organization: mail2news@nym.alias.net


This release fixes some bugs (of course), and also adds several helper
functions to assist dealing with the parsed data.

----------------------------------------------------------------------

;;; xml-parse --- code to efficiently read/write XML data with Elisp

;; Copyright (C) 2001 John Wiegley.

;; Author: John Wiegley <johnw@gnu.org>
;; Version: 1.1
;; Created: Feb 15, 2001
;; Keywords: convenience languages lisp xml parse data

;; This file is NOT (yet) part of GNU Emacs.

;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; 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.

;;; Commentary:
;;
;; XML is yet another way of expressing recursive, attributed data
;; structures -- something which Lisp has had the capacity to do for
;; decades.
;;
;; The approach taken by xml-parse.el is to read XML data into Lisp
;; structures, and allow those same Lisp structures to be written out
;; as XML.  It should facilitate the manipulation and use of XML by
;; Elisp programs.

;; NOTE: This is not a validating parser, and makes no attempt to read
;; DTDs.  See psgml.el if you need that kind of power.  Also, it
;; cannot handle tags that begin with <? or <!.  You must skip over
;; those first before calling `read-xml'.

;; Here is the format of the Lisp data structure used:
;;
;;   (TAG CHILD...)
;;
;; Where TAG is either a string (naming the tag) or a list.  The list
;; form is used to identify attributes, and has the format:
;;
;;   (TAG-NAME (ATTR-NAME . ATTR-VALUE)...)
;;
;; After the TAG, there can be zero or more child structures, which
;; have the same "TAG CHILD..." structure as the parent.  See
;; `insert-xml' for an EBNF grammar of this layout.

;; EXAMPLE: Given the following DocBook XML data:
;;
;;   <book id="compiler">
;;     <bookinfo>
;;       <bookbiblio>
;;         <title>My own book!</title>
;;         <edition>First</edition>
;;         <authorgroup>
;;           <author>
;;             <firstname>John</firstname>
;;             <surname>Wiegley</surname>
;;           </author>
;;         </authorgroup>
;;       </bookbiblio>
;;     </bookinfo>
;;     <chapter>
;;       <title>A very small chapter</title>
;;       <para>Wonder where the content is...</para>
;;     </chapter>
;;   </book>
;;
;; It would be parsed into this Lisp structure:
;;
;;   '(("book" ("id" . "compiler"))
;;     ("bookinfo"
;;      ("bookbiblio"
;;       ("title" "My own book!")
;;       ("edition" "FIrst")
;;       ("authorgroup"
;;        ("author"
;;         ("firstname" "John")
;;         ("surname" "Wiegley")))))
;;     ("chapter"
;;      ("title" "A very small chapter")
;;      ("para" "Wonder where the content is...")))
;;
;; Now it can easily be modified and interpreted using ordinary Lisp
;; code, without the ordeal of manipulating textual XML.  When you're
;; done modifying it, you can write it back out (complete with proper
;; indentation and newlines) using:
;;
;;   (insert-xml <DATA> t)
;;
;; See the documentation for `read-xml' and `insert-xml' for more
;; information.
;;
;; There are also a set of helper functions for accessing parts of a
;; parsed tag:
;;
;;   xml-tag-name       get the name of a tag
;;   xml-tag-attrlist   returns a tag's attribute alist
;;   xml-tag-attr       lookup a specific tag attribute
;;   xml-tag-children   returns a tag's child list
;;   xml-tag-child      lookup a specific child tag by name

(defsubst xml-parse-concat (beg end lst)
  "Add the string from BEG to END to LST, ignoring pure whitespace."
  (let* ((text (buffer-substring-no-properties beg end))
	 (i 0) (l (length text)) non-ws)
    (while (< i l)
      (unless (memq (aref text i) '(?\n ?\t ? ))
	(setq i l non-ws t))
      (setq i (1+ i)))
    (if non-ws
	(nconc lst (list text)))))

;;;###autoload
(defun read-xml (&optional inner-p)
  "Parse XML data at point into a Lisp structure.
See `insert-xml' for a description of the format of this structure.
Point is left at the end of the XML structure read."
  (when (search-forward "<" nil t)
    (let ((beg (point))
	  (term (eq (char-after) ?/))
	  value)
      (unless (re-search-forward "[ >]" nil t)
	(error "Unclosed tag at %d" (point)))
      (setq
       value
       (let ((name (buffer-substring-no-properties beg (1- (point))))
	     attrs tag data-beg data)
	 (if term
	     (substring name 1)
	   (setq tag (list (if (eq (char-before (1- (point))) ?/)
			       (substring name 0 (1- (length name)))
			     name)))
	   (when (eq (char-before) ? )
	     (while (not (memq (char-after) '(?/ ?>)))
	       (unless (re-search-forward
			"\\([^=]+\\)=\"\\([^\"]+\\)\"\\s-*" nil t)
		 (error "Invalid attribute list in tag %s" name))
	       (let ((attr (cons (match-string-no-properties 1)
				 (match-string-no-properties 2))))
		 (if attrs
		     (nconc attrs (list attr))
		   (setq attrs (list attr)))))
	     (nconc tag attrs)
	     (setq tag (list tag))
	     (forward-char 1))
	   (setq data-beg (point))
	   (if (eq (char-before (1- (point))) ?/)
	       tag
	     (while (and (setq data (read-xml t))
			 (not (stringp (cdr data))))
	       (xml-parse-concat data-beg (car data) tag)
	       (setq data-beg (point))
	       (nconc tag (list (cdr data))))
	     (xml-parse-concat data-beg (car data) tag)
	     (assert (stringp (cdr data)))
	     (unless (string= name (cdr data))
	       (error "Tag %s tries to end %s" (cdr data) name))
	     tag))))
      (if inner-p
	  (cons (1- beg) value)
	value))))

;;;###autoload
(defun insert-xml (data &optional add-newlines public system depth)
  "Insert DATA, a recursive Lisp structure, at point as XML.
DATA has the form:

  ENTRY       ::=  (TAG ENTRY*)
  TAG         ::=  TAG_NAME | (TAG_NAME ATTR+)
  ATTR        ::=  (ATTR_NAME . ATTR_VALUE)
  TAG_NAME    ::=  STRING
  ATTR_NAME   ::=  STRING
  ATTR_VALUE  ::=  STRING

If ADD-NEWLINES is non-nil, newlines and indentation will be added to
make the data user-friendly.

If PUBLIC and SYSTEM are non-nil, a !DOCTYPE tag will be added at the
top of the document to identify it as an XML document.

DEPTH is normally for internal use only, and controls the depth of the
indentation."
  (when (and (not depth) public system)
    (insert "<?xml version=\"1.0\"?>\n")
    (insert "<!DOCTYPE " (if (stringp (car data))
			     (car data)
			   (caar data))
	    " PUBLIC \"" public "\"\n  \"" system "\">\n"))
  (if (stringp data)
      (insert data)
    (let ((node (car data)) add-nl)
      (and depth (bolp) (insert (make-string (* depth 2) ? )))
      (if (stringp node)
	  (insert "<" node)
	(setq node (caar data))
	(insert "<" node)
	(let ((attrs (cdar data)))
	  (while attrs
	    (insert " " (caar attrs) "=\"" (cdar attrs) "\"")
	    (setq attrs (cdr attrs)))))
      (if (null (cdr data))
	  (insert "/>")
	(setq data (cdr data))
	(while data
	  (and add-newlines
	       (not (stringp (car data)))
	       (insert ?\n))
	  (setq add-nl (insert-xml (car data) add-newlines
				   nil nil (1+ (or depth 0)))
		data (cdr data)))
	(when add-nl
	  (and add-newlines (insert ?\n))
	  (and depth (insert (make-string (* depth 2) ? ))))
	(insert "</" node ">"))
      t)))

(defsubst xml-tag-name (tag)
  "Return the name of an xml-parse'd XML TAG."
  (if (stringp (car tag))
      (car tag)
    (caar tag)))

(defsubst xml-tag-attrlist (tag)
  "Return the attribute list of an xml-parse'd XML TAG."
  (and (not (stringp (car tag)))
       (cdar tag)))

(defsubst xml-tag-attr (tag attr)
  "Return a specific ATTR of an xml-parse'd XML TAG."
  (cdr (assoc attr (xml-tag-attrlist tag))))

(defsubst xml-tag-children (tag)
  "Return the list of child tags of an xml-parse'd XML TAG."
  (cdr tag))

(defun xml-tag-child (tag name)
  "Return the first child matching NAME, of an xml-parse'd XML TAG."
  (catch 'found
    (let ((children (xml-tag-children tag)))
      (while children
	(if (string= name (xml-tag-name (car children)))
	    (throw 'found (car children)))
	(setq children (cdr children))))))

(provide 'xml-parse)

;;; xml-parse.el ends here