Package: emacs;
Reported by: David Engster <deng <at> randomsample.de>
Date: Wed, 11 Jul 2012 21:06:02 UTC
Severity: normal
Found in version 24.1.50
Done: Chong Yidong <cyd <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: David Engster <deng <at> randomsample.de> To: Stefan Monnier <monnier <at> IRO.UMontreal.CA> Cc: 11916 <at> debbugs.gnu.org Subject: bug#11916: 24.1.50; Making url-dav work Date: Wed, 25 Jul 2012 23:04:59 +0200
[Message part 1 (text/plain, inline)]
Stefan Monnier writes: >> Attached. I had to go another route, though; turns out the `parse-ns' >> argument is already overloaded in `xml-parse-tag' (it can be used to >> provide a namespace->URI mapping), but that wasn't mentioned in the >> other parse functions. So I had to introduce an additional argument. > > I'd seen that, indeed, but I think that since this parse-ns arg is > mostly passed around and only finally used in one place, I'd rather not > add an argument but instead pass both values via the single > parse-ns argument. parse-ns could then be: > - nil as before. > - an alist of namespace->URI. > - a cons cell (symbol-qnames . ALIST) which does the same as the > previous one but uses symbols instead of cons cells for qnames. > - the symbol `symbol-qnames' to mean (symbol-qnames . STANDARD-ALIST). > - t to mean STANDARD-ALIST. > The last two are only allowed when entering xml-parse-region but not in > recursive calls (and not in calls to xml-maybe-do-ns). That's... uh... creative. ;-) Anyway, it's a very seldom used feature, so I just implemented what you suggested. Updated ChangeLog: lisp/xml.el: (xml-node-name): Mention `symbol-qnames' in doc-string. (xml-parse-file, xml-parse-region): Explain PARSE-NS argument in the doc-string. (xml-maybe-do-ns): Return expanded name as symbol instead of cons depending on new `simple-qnames' argument. (xml-parse-tag-1): Deal with new PARSE-NS argument definition. Add `symbol-qnames' to other function calls that need it. (xml-parse-attlist): Add `symbol-qnames' argument. url-dav.el: (url-dav-supported-p): Added doc-string and remove check for feature `xml' and function `xml-expand-namespace' which never existed in Emacs proper. (url-dav-process-response): Remove all indentation from XML before parsing. Change call to `xml-parse-region' to do namespace expansion with simple qualified names. (url-dav-request): Add autoload. (url-dav-directory-files): Properly deal with empty directories. Call hexify before generating relative URLs. (url-dav-file-directory-p): Fix bug when checking for 'DAV:collection (resources are returned as a list). -David
[xml-diff.patch (text/x-patch, inline)]
=== modified file 'lisp/xml.el'
--- lisp/xml.el 2012-07-04 16:14:05 +0000
+++ lisp/xml.el 2012-07-25 20:54:52 +0000
@@ -126,7 +126,10 @@
would be represented by
- '(\"\" . \"foo\")."
+ '(\"\" . \"foo\").
+
+If you'd just like a plain symbol instead, use 'symbol-qnames in
+the PARSE-NS argument."
(car node))
@@ -313,7 +316,22 @@
"Parse the well-formed XML file FILE.
Return the top node with all its children.
If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded."
+
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
(with-temp-buffer
(insert-file-contents file)
(xml--parse-buffer parse-dtd parse-ns)))
@@ -329,7 +347,21 @@
If BUFFER is nil, it defaults to the current buffer.
If PARSE-DTD is non-nil, parse the DTD and return it as the first
element of the list.
-If PARSE-NS is non-nil, expand QNAMES."
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
;; Use fixed syntax table to ensure regexp char classes and syntax
;; specs DTRT.
(unless buffer
@@ -377,7 +409,7 @@
(cons dtd (nreverse xml))
(nreverse xml)))))
-(defun xml-maybe-do-ns (name default xml-ns)
+(defun xml-maybe-do-ns (name default xml-ns symbol-qnames)
"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
@@ -386,7 +418,10 @@
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."
+specify that the name shouldn't be given a namespace.
+Expanded names will by default be returned as a cons. If you
+would like to get plain symbols, set SYMBOL-QNAMES to a non-nil
+value."
(if (consp xml-ns)
(let* ((nsp (string-match ":" name))
(lname (if nsp (substring name (match-end 0)) name))
@@ -397,15 +432,18 @@
(ns (or (cdr (assoc (if special "xmlns" prefix)
xml-ns))
"")))
- (cons ns (if special "" lname)))
+ (if (and symbol-qnames
+ (not (string= prefix "xmlns")))
+ (intern (concat ns lname))
+ (cons ns (if special "" lname))))
(intern name)))
(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.
-If PARSE-NS is non-nil, expand QNAMES; if the value of PARSE-NS
-is a list, use it as an alist mapping namespaces to URIs.
+If PARSE-NS is non-nil, expand QNAMES; for further details, see
+`xml-parse-region'.
Return one of:
- a list : the matching node
@@ -425,15 +463,23 @@
(defun xml-parse-tag-1 (&optional parse-dtd parse-ns)
"Like `xml-parse-tag', but possibly modify the buffer while working."
- (let ((xml-validating-parser (or parse-dtd xml-validating-parser))
- (xml-ns (cond ((consp parse-ns) parse-ns)
- (parse-ns xml-default-ns))))
+ (let* ((xml-validating-parser (or parse-dtd xml-validating-parser))
+ (symbol-qnames
+ (when (or (eq parse-ns 'symbol-qnames)
+ (eq (car-safe parse-ns) 'symbol-qnames))
+ 'symbol-qnames))
+ (xml-ns
+ (cond ((symbolp (car-safe parse-ns))
+ (or (cdr-safe parse-ns)
+ xml-default-ns))
+ ((consp parse-ns) parse-ns)
+ (parse-ns xml-default-ns))))
(cond
;; Processing instructions, like <?xml version="1.0"?>.
((looking-at "<\\?")
(search-forward "?>")
(skip-syntax-forward " ")
- (xml-parse-tag-1 parse-dtd xml-ns))
+ (xml-parse-tag-1 parse-dtd (cons symbol-qnames xml-ns)))
;; Character data (CDATA) sections, in which no tag should be interpreted
((looking-at "<!\\[CDATA\\[")
(let ((pos (match-end 0)))
@@ -447,8 +493,8 @@
(let ((dtd (xml-parse-dtd parse-ns)))
(skip-syntax-forward " ")
(if xml-validating-parser
- (cons dtd (xml-parse-tag-1 nil xml-ns))
- (xml-parse-tag-1 nil xml-ns))))
+ (cons dtd (xml-parse-tag-1 nil (cons symbol-qnames xml-ns)))
+ (xml-parse-tag-1 nil (cons symbol-qnames xml-ns)))))
;; skip comments
((looking-at "<!--")
(search-forward "-->")
@@ -456,7 +502,7 @@
(skip-syntax-forward " ")
(unless (eobp)
(let ((xml-sub-parser t))
- (xml-parse-tag-1 parse-dtd xml-ns))))
+ (xml-parse-tag-1 parse-dtd (cons symbol-qnames xml-ns)))))
;; end tag
((looking-at "</")
'())
@@ -466,7 +512,7 @@
;; Parse this node
(let* ((node-name (match-string-no-properties 1))
;; Parse the attribute list.
- (attrs (xml-parse-attlist xml-ns))
+ (attrs (xml-parse-attlist xml-ns symbol-qnames))
children)
;; add the xmlns:* attrs to our cache
(when (consp xml-ns)
@@ -476,7 +522,8 @@
(caar attr)))
(push (cons (cdar attr) (cdr attr))
xml-ns))))
- (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
+ (setq children (list attrs (xml-maybe-do-ns node-name ""
+ xml-ns symbol-qnames)))
(cond
;; is this an empty element ?
((looking-at "/>")
@@ -502,7 +549,7 @@
node-name))
;; Read a sub-element and push it onto CHILDREN.
((= (char-after) ?<)
- (let ((tag (xml-parse-tag-1 nil xml-ns)))
+ (let ((tag (xml-parse-tag-1 nil (cons symbol-qnames xml-ns))))
(when tag
(push tag children))))
;; Read some character data.
@@ -585,7 +632,7 @@
(goto-char end-marker)
(buffer-substring start (point)))))
-(defun xml-parse-attlist (&optional xml-ns)
+(defun xml-parse-attlist (&optional xml-ns symbol-qnames)
"Return the attribute-list after point.
Leave point at the first non-blank character after the tag."
(let ((attlist ())
@@ -594,7 +641,8 @@
(while (looking-at (eval-when-compile
(concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
(setq end-pos (match-end 0))
- (setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
+ (setq name (xml-maybe-do-ns (match-string-no-properties 1)
+ nil xml-ns symbol-qnames))
(goto-char end-pos)
;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
[url-dav-diff.patch (text/x-patch, inline)]
=== modified file 'lisp/url/url-dav.el'
--- lisp/url/url-dav.el 2012-07-11 23:13:41 +0000
+++ lisp/url/url-dav.el 2012-07-25 20:44:16 +0000
@@ -53,10 +53,10 @@
;;;###autoload
(defun url-dav-supported-p (url)
- (and (featurep 'xml)
- (fboundp 'xml-expand-namespace)
- (url-intersection url-dav-supported-protocols
- (plist-get (url-http-options url) 'dav))))
+ "Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported."
+ (url-intersection url-dav-supported-protocols
+ (plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node)
"Return the text data from the XML node NODE."
@@ -385,7 +385,12 @@
(when buffer
(unwind-protect
(with-current-buffer buffer
+ ;; First remove all indentation and line endings
(goto-char url-http-end-of-headers)
+ (indent-rigidly (point) (point-max) -1000)
+ (save-excursion
+ (while (re-search-forward "\r?\n" nil t)
+ (replace-match "")))
(setq overall-status url-http-response-status)
;; XML documents can be transferred as either text/xml or
@@ -395,7 +400,7 @@
url-http-content-type
(string-match "\\`\\(text\\|application\\)/xml"
url-http-content-type))
- (setq tree (xml-parse-region (point) (point-max)))))
+ (setq tree (xml-parse-region (point) (point-max) nil nil 'symbol-qnames))))
;; Clean up after ourselves.
(kill-buffer buffer)))
@@ -411,6 +416,7 @@
;; nobody but us needs to know the difference.
(list (cons url properties))))))
+;;;###autoload
(defun url-dav-request (url method tag body
&optional depth headers namespaces)
"Perform WebDAV operation METHOD on URL. Return the parsed responses.
@@ -768,8 +774,8 @@
(defun url-dav-directory-files (url &optional full match nosort files-only)
"Return a list of names of files in URL.
There are three optional arguments:
-If FULL is non-nil, return absolute file names. Otherwise return names
- that are relative to the specified directory.
+If FULL is non-nil, return absolute URLs. Otherwise return names
+ that are relative to the specified URL.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
NOSORT is useful if you plan to sort the result yourself."
@@ -779,8 +785,9 @@
(files nil)
(parsed-url (url-generic-parse-url url)))
- (if (= (length properties) 1)
- (signal 'file-error (list "Opening directory" "not a directory" url)))
+ (when (and (= (length properties) 1)
+ (not (url-dav-file-directory-p url)))
+ (signal 'file-error (list "Opening directory" "not a directory" url)))
(while properties
(setq child-props (pop properties)
@@ -794,7 +801,9 @@
;; are not supposed to return fully-qualified names.
(setq child-url (url-expand-file-name child-url parsed-url))
(if (not full)
- (setq child-url (substring child-url (length url))))
+ ;; Parts of the URL might be hex'ed.
+ (setq child-url (substring (url-unhex-string child-url)
+ (length url))))
;; We don't want '/' as the last character in filenames...
(if (string-match "/$" child-url)
@@ -814,7 +823,8 @@
(defun url-dav-file-directory-p (url)
"Return t if URL names an existing DAV collection."
(let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
- (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
+ (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
+ t)))
(defun url-dav-make-directory (url &optional parents)
"Create the directory DIR and any nonexistent parent dirs."
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.