bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Update namespace parsing in xml.el


From: Mark A. Hershberger
Subject: Update namespace parsing in xml.el
Date: Wed, 22 Oct 2003 00:36:07 -0500
User-agent: Gnus/5.1003 (Gnus v5.10.3) Emacs/21.3.50 (gnu/linux)

2003-10-22  Mark A. Hershberger  <mah@everybody.org>

        * xml.el: 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.

diff -u -w -r1.24 xml.el
--- xml.el      1 Sep 2003 15:45:18 -0000       1.24
+++ xml.el      22 Oct 2003 04:13:11 -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."





reply via email to

[Prev in Thread] Current Thread [Next in Thread]