emacs: lisp/xml.el comparison

comparison lisp/xml.el @ 52975:6958c2be0aa9

Allow comments following the top-level element. Separate out namespace parsing into special functions. Change namespace parsing to return ('ns-uri . "local-name") instead of '{ns-uri}local-name.

author	Eli Zaretskii <eliz@gnu.org>
date	Sat, 01 Nov 2003 17:56:08 +0000
parents	695cf19ef79e
children	45bd3ad34572

comparison

equal deleted inserted replaced

-:f45cf0ff5cb3
+:6958c2be0aa9
 	  (goto-char (point-min))
 	  (while (not (eobp))
 	    (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 parse-ns))
 		    (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))))
 		     (t
 		      (add-to-list 'xml result)))))
 	      (goto-char (point-max))))
 	  (if parse-dtd
 	      (cons dtd (nreverse xml))
 	    (nreverse xml)))))))
+(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.
 ((looking-at "</")
 '())
 ;;  opening tag
 ((looking-at "<\\([^/>[:space:]]+\\)")
 (goto-char (match-end 1))
+;; Parse this node
 (let* ((node-name (match-string 1))
-	     ;; Parse the attribute list.
+	     (attr-list (xml-parse-attlist))
-	     (children (list (xml-parse-attlist) (intern node-name)))
+	     (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)
-	;; add the xmlns:* attrs to our cache
-	(when (consp xml-ns)
-	  (mapcar
-	   (lambda (attr)
-	     (let* ((splitup (split-string (symbol-name (car attr)) ":"))
-		    (prefix (nth 0 splitup))
-		    (lname (nth 1 splitup)))
-	       (when (string= "xmlns" prefix)
-		 (setq xml-ns (append (list (cons (if lname
-						      lname
-						    "")
-						  (cdr attr)))
-				      xml-ns)))))
-	   (car children))
-	  ;; expand element names
-	  (let* ((splitup (split-string (symbol-name (cadr children)) ":"))
-		 (lname (or (nth 1 splitup)
-			    (nth 0 splitup)))
-		 (prefix (if (nth 1 splitup)
-			     (nth 0 splitup)
-			   "")))
-	    (setcdr children (list
-			      (intern (concat "{"
-					     (cdr (assoc-string prefix xml-ns))
-					     "}" lname)))))
-	  ;; expand attribute names
-	  (mapcar
-	   (lambda (attr)
-	     (let* ((splitup (split-string (symbol-name (car attr)) ":"))
-		    (lname (or (nth 1 splitup)
-			       (nth 0 splitup)))
-		    (prefix (if (nth 1 splitup)
-				(nth 0 splitup)
-			      (caar xml-ns))))
-	       (setcar attr (intern (concat "{"
-					    (cdr (assoc-string prefix xml-ns))
-					    "}" lname)))))
-	   (car children)))
 	;; is this an empty element ?
 	(if (looking-at "/>")
 	(progn
 	  (forward-char 2)
 	  (error "XML: Invalid attribute list")))))
 (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
 (if (assoc name attlist)
 	  (error "XML: each attribute must be unique within an element"))
 (let ((string (match-string 1))
 	    (pos 0))
 	(replace-regexp-in-string "\\s-\\{2,\\}" " " string)
 	(push (cons name (xml-substitute-special string)) attlist))
-(goto-char start-pos)
+(goto-char end-pos)
-(forward-sexp)			; we have string syntax
 (skip-syntax-forward " "))
 (nreverse attlist)))
 ;;*******************************************************************
 ;;**
 	   ;;  Translation of rule [45] of XML specifications
 	   ((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))
 	    ;;  Translation of rule [46] of XML specifications
 	    (cond
 	      (error "XML: Invalid element type in the DTD")))
 	    ;;  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)
 	    (goto-char end-pos))
 	   ((looking-at "<!--")
 	   (t
 	    (error "XML: Invalid DTD item")))
 	  ;;  Skip the end of the DTD
 	  (search-forward ">"))))
-(nreverse dtd)))
+(nreverse dtd))))
 (defun xml-parse-elem-type (string)
 "Convert element type STRING into a Lisp structure."
 (let (elem modifier)

Mercurial > emacs

comparison lisp/xml.el @ 52975:6958c2be0aa9