Merge from trunk.
[bpt/emacs.git] / src / xml.c
1 /* Interface to libxml2.
2 Copyright (C) 2010-2012 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20
21 #ifdef HAVE_LIBXML2
22
23 #include <setjmp.h>
24 #include <libxml/tree.h>
25 #include <libxml/parser.h>
26 #include <libxml/HTMLparser.h>
27
28 #include "lisp.h"
29 #include "buffer.h"
30
31 static Lisp_Object
32 make_dom (xmlNode *node)
33 {
34 if (node->type == XML_ELEMENT_NODE)
35 {
36 Lisp_Object result = Fcons (intern ((char *) node->name), Qnil);
37 xmlNode *child;
38 xmlAttr *property;
39 Lisp_Object plist = Qnil;
40
41 /* First add the attributes. */
42 property = node->properties;
43 while (property != NULL)
44 {
45 if (property->children &&
46 property->children->content)
47 {
48 char *content = (char *) property->children->content;
49 plist = Fcons (Fcons (intern ((char *) property->name),
50 build_string (content)),
51 plist);
52 }
53 property = property->next;
54 }
55 result = Fcons (Fnreverse (plist), result);
56
57 /* Then add the children of the node. */
58 child = node->children;
59 while (child != NULL)
60 {
61 result = Fcons (make_dom (child), result);
62 child = child->next;
63 }
64
65 return Fnreverse (result);
66 }
67 else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
68 {
69 if (node->content)
70 return build_string ((char *) node->content);
71 else
72 return Qnil;
73 }
74 else if (node->type == XML_COMMENT_NODE)
75 {
76 if (node->content)
77 return list3 (intern ("comment"), Qnil,
78 build_string ((char *) node->content));
79 else
80 return Qnil;
81 }
82 else
83 return Qnil;
84 }
85
86 static Lisp_Object
87 parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int htmlp)
88 {
89 xmlDoc *doc;
90 Lisp_Object result = Qnil;
91 const char *burl = "";
92 ptrdiff_t bytes;
93 ptrdiff_t istart, iend;
94
95 LIBXML_TEST_VERSION;
96
97 validate_region (&start, &end);
98
99 istart = XINT (start);
100 iend = XINT (end);
101
102 if (istart < GPT && GPT < iend)
103 move_gap (iend);
104
105 if (! NILP (base_url))
106 {
107 CHECK_STRING (base_url);
108 burl = SSDATA (base_url);
109 }
110
111 bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
112
113 if (htmlp)
114 doc = htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
115 bytes, burl, "utf-8",
116 HTML_PARSE_RECOVER|HTML_PARSE_NONET|
117 HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
118 HTML_PARSE_NOBLANKS);
119 else
120 doc = xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
121 bytes, burl, "utf-8",
122 XML_PARSE_NONET|XML_PARSE_NOWARNING|
123 XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
124
125 if (doc != NULL)
126 {
127 /* If the document is just comments, then this should get us the
128 nodes anyway. */
129 xmlNode *n = doc->children->next;
130 Lisp_Object r = Qnil;
131
132 while (n) {
133 if (!NILP (r))
134 result = Fcons (r, result);
135 r = make_dom (n);
136 n = n->next;
137 }
138
139 if (NILP (result)) {
140 /* The document isn't just comments, so get the tree the
141 proper way. */
142 xmlNode *node = xmlDocGetRootElement (doc);
143 if (node != NULL)
144 result = make_dom (node);
145 } else
146 result = Fcons (intern ("top"),
147 Fcons (Qnil, Fnreverse (Fcons (r, result))));
148
149 xmlFreeDoc (doc);
150 }
151
152 return result;
153 }
154
155 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
156 Slibxml_parse_html_region,
157 2, 3, 0,
158 doc: /* Parse the region as an HTML document and return the parse tree.
159 If BASE-URL is non-nil, it is used to expand relative URLs. */)
160 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
161 {
162 return parse_region (start, end, base_url, 1);
163 }
164
165 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
166 Slibxml_parse_xml_region,
167 2, 3, 0,
168 doc: /* Parse the region as an XML document and return the parse tree.
169 If BASE-URL is non-nil, it is used to expand relative URLs. */)
170 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
171 {
172 return parse_region (start, end, base_url, 0);
173 }
174
175 \f
176 /***********************************************************************
177 Initialization
178 ***********************************************************************/
179 void
180 syms_of_xml (void)
181 {
182 defsubr (&Slibxml_parse_html_region);
183 defsubr (&Slibxml_parse_xml_region);
184 }
185
186 #endif /* HAVE_LIBXML2 */