Mercurial > emacs

changeset 52975:6958c2be0aa9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 f45cf0ff5cb3
children d6492eca15c8
files lisp/xml.el
diffstat 1 files changed, 94 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/xml.el	Sat Nov 01 17:48:54 2003 +0000
+++ b/lisp/xml.el	Sat Nov 01 17:56:08 2003 +0000
@@ -208,13 +208,14 @@
 	    (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))))
@@ -225,6 +226,73 @@
 	      (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.
@@ -276,53 +344,22 @@
      ;;  opening tag
      ((looking-at "<\\([^/>[:space:]]+\\)")
       (goto-char (match-end 1))
+
+      ;; Parse this node
       (let* ((node-name (match-string 1))
-	     ;; Parse the attribute list.
-	     (children (list (xml-parse-attlist) (intern node-name)))
+	     (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)
 
-	;; 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
@@ -377,13 +414,14 @@
       (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
@@ -391,9 +429,9 @@
       ;; 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
@@ -407,9 +445,7 @@
 	(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)))
 
@@ -490,7 +526,7 @@
 	   ((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))
 
@@ -510,7 +546,7 @@
 	    ;;  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)
@@ -523,8 +559,7 @@
 
 	  ;;  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."