/[emacs]/emacs/lisp/xml.el
ViewVC logotype

Diff of /emacs/lisp/xml.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10.2.2 by miles, Tue Oct 14 23:51:29 2003 UTC revision 1.10.2.3 by miles, Fri Nov 21 00:36:07 2003 UTC
# Line 208  If PARSE-NS is non-nil, then QNAMES are Line 208  If PARSE-NS is non-nil, then QNAMES are
208              (if (search-forward "<" nil t)              (if (search-forward "<" nil t)
209                  (progn                  (progn
210                    (forward-char -1)                    (forward-char -1)
211                    (if xml                    (setq result (xml-parse-tag parse-dtd parse-ns))
212                      (if (and xml result)
213                        ;;  translation of rule [1] of XML specifications                        ;;  translation of rule [1] of XML specifications
214                        (error "XML files can have only one toplevel tag")                        (error "XML files can have only one toplevel tag")
                     (setq result (xml-parse-tag parse-dtd parse-ns))  
215                      (cond                      (cond
216                       ((null result))                       ((null result))
217                       ((listp (car result))                       ((and (listp (car result))
218                               parse-dtd)
219                        (setq dtd (car result))                        (setq dtd (car result))
220                        (if (cdr result)  ; possible leading comment                        (if (cdr result)  ; possible leading comment
221                            (add-to-list 'xml (cdr result))))                            (add-to-list 'xml (cdr result))))
# Line 225  If PARSE-NS is non-nil, then QNAMES are Line 226  If PARSE-NS is non-nil, then QNAMES are
226                (cons dtd (nreverse xml))                (cons dtd (nreverse xml))
227              (nreverse xml)))))))              (nreverse xml)))))))
228    
229    (defun xml-ns-parse-ns-attrs (attr-list &optional xml-ns)
230      "Parse the namespace attributes and return a list of cons in the form:
231    \(namespace . prefix)"
232    
233      (mapcar
234       (lambda (attr)
235         (let* ((splitup (split-string (car attr) ":"))
236                (prefix (nth 0 splitup))
237                (lname (nth 1 splitup)))
238           (when (string= "xmlns" prefix)
239             (push (cons (if lname
240                             lname
241                           "")
242                         (cdr attr))
243                   xml-ns)))) attr-list)
244      xml-ns)
245    
246    ;; expand element names
247    (defun xml-ns-expand-el (el xml-ns)
248      "Expand the XML elements from \"prefix:local-name\" to a cons in the form
249    \"(namespace . local-name)\"."
250    
251      (let* ((splitup (split-string el ":"))
252             (lname (or (nth 1 splitup)
253                        (nth 0 splitup)))
254             (prefix (if (nth 1 splitup)
255                         (nth 0 splitup)
256                       (if (string= lname "xmlns")
257                           "xmlns"
258                         "")))
259             (ns (cdr (assoc-string prefix xml-ns))))
260        (if (string= "" ns)
261            lname
262          (cons (intern (concat ":" ns))
263                lname))))
264    
265    ;; expand attribute names
266    (defun xml-ns-expand-attr (attr-list xml-ns)
267      "Expand the attribute list for a particular element from the form
268    \"prefix:local-name\" to the form \"{namespace}:local-name\"."
269    
270      (mapcar
271       (lambda (attr)
272         (let* ((splitup (split-string (car attr) ":"))
273                (lname (or (nth 1 splitup)
274                           (nth 0 splitup)))
275                (prefix (if (nth 1 splitup)
276                            (nth 0 splitup)
277                          (if (string= (car attr) "xmlns")
278                              "xmlns"
279                            "")))
280                (ns (cdr (assoc-string prefix xml-ns))))
281           (setcar attr
282                   (if (string= "" ns)
283                       lname
284                     (cons (intern (concat ":" ns))
285                           lname)))))
286       attr-list)
287      attr-list)
288    
289    
290    (defun xml-intern-attrlist (attr-list)
291      "Convert attribute names to symbols for backward compatibility."
292      (mapcar (lambda (attr)
293                (setcar attr (intern (car attr))))
294              attr-list)
295      attr-list)
296    
297  (defun xml-parse-tag (&optional parse-dtd parse-ns)  (defun xml-parse-tag (&optional parse-dtd parse-ns)
298    "Parse the tag at point.    "Parse the tag at point.
# Line 276  Returns one of: Line 344  Returns one of:
344       ;;  opening tag       ;;  opening tag
345       ((looking-at "<\\([^/>[:space:]]+\\)")       ((looking-at "<\\([^/>[:space:]]+\\)")
346        (goto-char (match-end 1))        (goto-char (match-end 1))
347    
348          ;; Parse this node
349        (let* ((node-name (match-string 1))        (let* ((node-name (match-string 1))
350               ;; Parse the attribute list.               (attr-list (xml-parse-attlist))
351               (children (list (xml-parse-attlist) (intern node-name)))               (children (if  (consp xml-ns) ;; take care of namespace parsing
352                                (progn
353                                  (setq xml-ns (xml-ns-parse-ns-attrs
354                                                attr-list xml-ns))
355                                  (list (xml-ns-expand-attr
356                                         attr-list xml-ns)
357                                        (xml-ns-expand-el
358                                         node-name xml-ns)))
359                                (list (xml-intern-attrlist attr-list)
360                                      (intern node-name))))
361               pos)               pos)
362    
         ;; 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)))  
   
363          ;; is this an empty element ?          ;; is this an empty element ?
364          (if (looking-at "/>")          (if (looking-at "/>")
365          (progn          (progn
# Line 377  Returns one of: Line 414  Returns one of:
414        (error "XML: Invalid character")))))        (error "XML: Invalid character")))))
415    
416  (defun xml-parse-attlist ()  (defun xml-parse-attlist ()
417    "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
418    first non-blank character after the tag."
419    (let ((attlist ())    (let ((attlist ())
420          start-pos name)          end-pos name)
421      (skip-syntax-forward " ")      (skip-syntax-forward " ")
422      (while (looking-at (eval-when-compile      (while (looking-at (eval-when-compile
423                           (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))                           (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))
424        (setq name (intern (match-string 1)))        (setq name (match-string 1))
425        (goto-char (match-end 0))        (goto-char (match-end 0))
426    
427        ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize        ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
# Line 391  Returns one of: Line 429  Returns one of:
429        ;; Do we have a string between quotes (or double-quotes),        ;; Do we have a string between quotes (or double-quotes),
430        ;;  or a simple word ?        ;;  or a simple word ?
431        (if (looking-at "\"\\([^\"]*\\)\"")        (if (looking-at "\"\\([^\"]*\\)\"")
432            (setq start-pos (match-beginning 0))            (setq end-pos (match-end 0))
433          (if (looking-at "'\\([^']*\\)'")          (if (looking-at "'\\([^']*\\)'")
434              (setq start-pos (match-beginning 0))              (setq end-pos (match-end 0))
435            (error "XML: Attribute values must be given between quotes")))            (error "XML: Attribute values must be given between quotes")))
436    
437        ;; Each attribute must be unique within a given element        ;; Each attribute must be unique within a given element
# Line 407  Returns one of: Line 445  Returns one of:
445          (replace-regexp-in-string "\\s-\\{2,\\}" " " string)          (replace-regexp-in-string "\\s-\\{2,\\}" " " string)
446          (push (cons name (xml-substitute-special string)) attlist))          (push (cons name (xml-substitute-special string)) attlist))
447    
448        (goto-char start-pos)        (goto-char end-pos)
       (forward-sexp)                    ; we have string syntax  
   
449        (skip-syntax-forward " "))        (skip-syntax-forward " "))
450      (nreverse attlist)))      (nreverse attlist)))
451    
# Line 490  This follows the rule [28] in the XML sp Line 526  This follows the rule [28] in the XML sp
526             ((looking-at             ((looking-at
527               "<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")               "<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")
528    
529              (setq element (intern (match-string 1))              (setq element (match-string 1)
530                    type    (match-string-no-properties 2))                    type    (match-string-no-properties 2))
531              (setq end-pos (match-end 0))              (setq end-pos (match-end 0))
532    
# Line 510  This follows the rule [28] in the XML sp Line 546  This follows the rule [28] in the XML sp
546              ;;  rule [45]: the element declaration must be unique              ;;  rule [45]: the element declaration must be unique
547              (if (assoc element dtd)              (if (assoc element dtd)
548                  (error "XML: element declarations must be unique in a DTD (<%s>)"                  (error "XML: element declarations must be unique in a DTD (<%s>)"
549                         (symbol-name element)))                         element))
550    
551              ;;  Store the element in the DTD              ;;  Store the element in the DTD
552              (push (list element type) dtd)              (push (list element type) dtd)
# Line 525  This follows the rule [28] in the XML sp Line 561  This follows the rule [28] in the XML sp
561            (search-forward ">"))))            (search-forward ">"))))
562      (nreverse dtd)))      (nreverse dtd)))
563    
   
564  (defun xml-parse-elem-type (string)  (defun xml-parse-elem-type (string)
565    "Convert element type STRING into a Lisp structure."    "Convert element type STRING into a Lisp structure."
566    

Legend:
Removed from v.1.10.2.2  
changed lines
  Added in v.1.10.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26