From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.pretest.bugs,gmane.emacs.devel Subject: Re: Refactoring xml.el namespace handling Date: 04 Mar 2004 12:52:49 -0500 Sender: emacs-pretest-bug-bounces+gebp-emacs-pretest-bug=gmane.org@gnu.org Message-ID: References: <87u117ew6g.fsf@weblog.localhost> <878yiimo8x.fsf@weblog.localhost> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1078706003 31237 80.91.224.253 (8 Mar 2004 00:33:23 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 8 Mar 2004 00:33:23 +0000 (UTC) Cc: emacs-pretest-bug@gnu.org, emacs-devel@gnu.org Original-X-From: emacs-pretest-bug-bounces+gebp-emacs-pretest-bug=gmane.org@gnu.org Mon Mar 08 01:33:13 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B08hl-0004Q4-00 for ; Mon, 08 Mar 2004 01:33:13 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B08hk-0007ea-6W for gebp-emacs-pretest-bug@gmane.org; Sun, 07 Mar 2004 19:33:12 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1Ayx6D-0000XO-Tp for emacs-pretest-bug@gnu.org; Thu, 04 Mar 2004 12:57:33 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1Ayx2J-0008F9-4D for emacs-pretest-bug@gnu.org; Thu, 04 Mar 2004 12:54:03 -0500 Original-Received: from [132.204.24.67] (helo=mercure.iro.umontreal.ca) by monty-python.gnu.org with esmtp (Exim 4.30) id 1Ayx1i-00089B-DK; Thu, 04 Mar 2004 12:52:54 -0500 Original-Received: from asado.iro.umontreal.ca (asado.iro.umontreal.ca [132.204.24.84]) by mercure.iro.umontreal.ca (Postfix) with ESMTP id 7C38F20D07; Thu, 4 Mar 2004 12:52:49 -0500 (EST) Original-Received: by asado.iro.umontreal.ca (Postfix, from userid 20848) id 706288C8E4; Thu, 4 Mar 2004 12:52:49 -0500 (EST) Original-To: mah@everybody.org (Mark A. Hershberger) In-Reply-To: Original-Lines: 231 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3.50 X-DIRO-MailScanner-Information: Please contact the ISP for more information X-DIRO-MailScanner: Found to be clean X-DIRO-MailScanner-SpamCheck: n'est pas un polluriel, SpamAssassin (score=-4.9, requis 5, BAYES_00 -4.90) X-BeenThere: emacs-pretest-bug@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-pretest-bug-bounces+gebp-emacs-pretest-bug=gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.pretest.bugs:2338 gmane.emacs.devel:20261 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20261 > Thank you. Here is a counter patch. Of course, the patch was missing, so here it is. Stefan --- xml.el.~1.30.~ Tue Mar 2 22:11:10 2004 +++ xml.el Thu Mar 4 12:40:28 2004 @@ -52,15 +52,15 @@ ;;; LIST FORMAT -;; The functions `xml-parse-file' and `xml-parse-tag' return a list with -;; the following format: +;; The functions `xml-parse-file', `xml-parse-region' and +;; `xml-parse-tag' return a list with the following format: ;; ;; xml-list ::= (node node ...) -;; node ::= (tag_name attribute-list . child_node_list) +;; node ::= (qname attribute-list . child_node_list) ;; child_node_list ::= child_node child_node ... ;; child_node ::= node | string -;; tag_name ::= string -;; attribute_list ::= (("attribute" . "value") ("attribute" . "value") ...) +;; qname ::= (namespace-uri . "name") | "name" +;; attribute_list ::= ((qname . "value") (qname . "value") ...) ;; | nil ;; string ::= "..." ;; @@ -68,6 +68,11 @@ ;; Whitespace is preserved. Fixme: There should be a tree-walker that ;; can remove it. +;; TODO: +;; * xml:base, xml:space support +;; * more complete DOCTYPE parsing +;; * pi support + ;;; Code: ;; Note that {buffer-substring,match-string}-no-properties were @@ -230,72 +235,26 @@ (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-maybe-do-ns (name default xml-ns) + "Perform any namespace expansion. NAME is the name to perform the expansion on. +DEFAULT is the default namespace. XML-NS is a cons of namespace +names to uris. When namespace-aware parsing is off, then XML-NS +is nil. + +During namespace-aware parsing, any name without a namespace is +put into the namespace identified by DEFAULT. nil is used to +specify that the name shouldn't be given a namespace." + (if (consp xml-ns) + (let* ((nsp (string-match ":" name)) + (lname (if nsp (substring name (match-end 0)) name)) + (prefix (if nsp (substring name 0 (match-beginning 0)) default)) + (special (and (string-equal lname "xmlns") (not prefix))) + (ns (cdr (assoc (if special "xmlns" prefix) + xml-ns)))) + (if ns + (cons ns (if special "" lname)) + lname)) + (intern name))) (defun xml-parse-tag (&optional parse-dtd parse-ns) "Parse the tag at point. @@ -310,10 +269,10 @@ parse-ns (if parse-ns (list - ;; Default no namespace - (cons "" "") + ;; "xml" namespace + (cons "xml" 'http://www.w3.org/XML/1998/namespace) ;; We need to seed the xmlns namespace - (cons "xmlns" "http://www.w3.org/2000/xmlns/")))))) + (cons "xmlns" 'http://www.w3.org/2000/xmlns/)))))) (cond ;; Processing instructions (like the tag at the ;; beginning of a document). @@ -350,19 +309,22 @@ ;; Parse this node (let* ((node-name (match-string 1)) - (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)))) + ;; Parse the attribute list. + (children (list (xml-parse-attlist xml-ns) node-name)) pos) + ;; add the xmlns:* attrs to our cache + (when (consp xml-ns) + (dolist (attr (car children)) + (when (and (consp (car attr)) + (eq 'http://www.w3.org/2000/xmlns/ + (caar attr))) + (push (cons (cdar attr) (intern (cdr attr))) + xml-ns)))) + + ;; expand element names + (setcdr children (list (xml-maybe-do-ns (cadr children) "" xml-ns))) + ;; is this an empty element ? (if (looking-at "/>") (progn @@ -416,7 +378,7 @@ (t ;; This is not a tag. (error "XML: Invalid character"))))) -(defun xml-parse-attlist () +(defun xml-parse-attlist (&optional xml-ns) "Return the attribute-list after point. Leave point at the first non-blank character after the tag." (let ((attlist ()) @@ -424,8 +386,9 @@ (skip-syntax-forward " ") (while (looking-at (eval-when-compile (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*"))) - (setq name (match-string 1)) - (goto-char (match-end 0)) + (setq end-pos (match-end 0)) + (setq name (xml-maybe-do-ns (match-string 1) nil xml-ns)) + (goto-char end-pos) ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize @@ -527,7 +490,7 @@ ;; Translation of rule [45] of XML specifications ((looking-at - "]+\\)>") + "]+\\)>") (setq element (match-string 1) type (match-string-no-properties 2)) @@ -556,7 +519,15 @@ (goto-char end-pos)) ((looking-at "")) - + ((looking-at "]+\\)>") + ;; Put the ENTITY in + (goto-char (match-end 0))) + ((looking-at "]+\\)>") + ;; Put in the ATTLIST + (goto-char (match-end 0))) + ((looking-at "]+\\)>") + ;; Put in the NOTATION + (goto-char (match-end 0))) (t (error "XML: Invalid DTD item")))