Sender: jwiegley@morpheus.morpheus
Newsgroups: gnu.emacs.sources
Subject: xml-parse.el
From: John Wiegley <johnw@gnu.org>
Date: 15 Feb 2001 12:54:35 -0800
Message-ID: <86ae7n7jlg.fsf@inprise.com>
Organization: mail2news@nym.alias.net


;;; xml-parse --- code to efficiently read/write XML data within Emacs

;; Copyright (C) 2001 John Wiegley.

;; Author: John Wiegley <johnw@gnu.org>
;; Version: 1.0
;; 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 manipulate and use of XML by
;; Elisp programs.

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

;; Here is the format of 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 the
;; `insert-xml' function 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've
;; 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.

(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)))))

(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
			"\\([^=]+\\)=\"\\([^\"]+\\)\"" 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 attr))))
	     (nconc tag (list 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))))

(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)))

(provide 'xml-parse)

;;; xml-parse.el ends here