comparison lisp/xml.el @ 34825:2cad4cde52bd

(top level comment): Updated to reflect the fact that white spaces are relevant in the XML file (xml-parse-file): Do not kill an existing Emacs buffer if the file to parse was already edited. This allows for on-the-fly analysis of XML files (xml-parse-tag): Check that the casing is the same in the start tag and end tag, since XML is case-sensitive. Allows for spaces in the end tag, after the name of the tag. (xml-parse-attlist): Allow for the character '-' in the name of attributes, as in the standard http-equiv attribute Do not save the properties in the XML tree, since they are not relevant

34824:6e2fee176fe7

;;
;; It also knows how to ignore comments, as well as the special ?xml? tag
;; 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>
;; 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
;; below the nodes.
;;

;;**
;;*******************************************************************

(defun xml-parse-file (file &optional parse-dtd)
  "Parse the well-formed XML FILE.
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))

(defun xml-parse-region (beg end &optional buffer parse-dtd)
  "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

    '())
   ;;  opening tag
   ((looking-at "<\\([^/> \t\n]+\\)")
    (let* ((node-name (match-string 1))
	   (children (list (intern node-name)))
	   pos)
      (goto-char (match-end 1))

      ;; parses the attribute list
      (set 'children (append children (list (xml-parse-attlist end))))

	;; is this a valid start tag ?
	(if (= (char-after) ?>)
	    (progn
	      (forward-char 1)
	      (skip-chars-forward " \t\n")
	      (while (not (looking-at (concat "</" node-name ">")))
		(cond
		 ((looking-at "</")
		  (error (concat
			  "XML: invalid syntax -- invalid end tag (expecting "
			  node-name
			  ")")))
		 ((= (char-after) ?<)
		  (set 'children (append children (list (xml-parse-tag end)))))
		 (t
		  (set 'pos (point))
		  (search-forward "<" end)

The search for attributes end at the position END in the current buffer.
Leaves the point on the first non-blank character after the tag."
  (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 (match-string 1)))
      (goto-char (match-end 0))

      ;; Do we have a string between quotes (or double-quotes),
      ;;  or a simple word ?

      ;; Each attribute must be unique within a given element
      (if (assoc name attlist)
	  (error "XML: each attribute must be unique within an element."))
      
      (set 'attlist (append attlist
			    (list (cons name (match-string 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."))
      )

34825:2cad4cde52bd

;;
;; It also knows how to ignore comments, as well as the special ?xml? tag
;; 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>
;; 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
;; below the nodes.
;;

;;**
;;*******************************************************************

(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."
  (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.
If BUFFER is nil, it defaults to the current buffer.
Returns the XML list for the region, or raises an error if the region

    '())
   ;;  opening tag
   ((looking-at "<\\([^/> \t\n]+\\)")
    (let* ((node-name (match-string 1))
	   (children (list (intern node-name)))
	   (case-fold-search nil) ;; XML is case-sensitive
	   pos)
      (goto-char (match-end 1))

      ;; parses the attribute list
      (set 'children (append children (list (xml-parse-attlist end))))

	;; is this a valid start tag ?
	(if (= (char-after) ?>)
	    (progn
	      (forward-char 1)
	      (skip-chars-forward " \t\n")
	      ;;  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
		  (set 'pos (point))
		  (search-forward "<" end)

The search for attributes end at the position END in the current buffer.
Leaves the point on the first non-blank character after the tag."
  (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 (match-string 1)))
      (goto-char (match-end 0))

      ;; Do we have a string between quotes (or double-quotes),
      ;;  or a simple word ?

      ;; Each attribute must be unique within a given element
      (if (assoc name attlist)
	  (error "XML: each attribute must be unique within an element."))
      
      (set 'attlist (append attlist
			    (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."))
      )