Merge from pending; try to fix-up suboptimal ses ChangeLog.
[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 \f
32 static Lisp_Object Qlibxml2_dll;
33
34 #ifdef WINDOWSNT
35
36 #include <windows.h>
37 #include "w32.h"
38
39 /* Macro for defining functions that will be loaded from the libxml2 DLL. */
40 #define DEF_XML2_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
41
42 /* Macro for loading libxml2 functions from the library. */
43 #define LOAD_XML2_FN(lib,func) { \
44 fn_##func = (void *) GetProcAddress (lib, #func); \
45 if (!fn_##func) goto bad_library; \
46 }
47
48 DEF_XML2_FN (htmlDocPtr, htmlReadMemory,
49 (const char *, int, const char *, const char *, int));
50 DEF_XML2_FN (xmlDocPtr, xmlReadMemory,
51 (const char *, int, const char *, const char *, int));
52 DEF_XML2_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
53 DEF_XML2_FN (void, xmlFreeDoc, (xmlDocPtr));
54 DEF_XML2_FN (void, xmlCleanupParser, (void));
55 DEF_XML2_FN (void, xmlCheckVersion, (int));
56
57 static int
58 libxml2_loaded_p (void)
59 {
60 Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
61
62 if (CONSP (found))
63 return EQ (XCDR (found), Qt) ? 1 : 0;
64 return 0;
65 }
66
67 #else /* !WINDOWSNT */
68
69 #define fn_htmlReadMemory htmlReadMemory
70 #define fn_xmlReadMemory xmlReadMemory
71 #define fn_xmlDocGetRootElement xmlDocGetRootElement
72 #define fn_xmlFreeDoc xmlFreeDoc
73 #define fn_xmlCleanupParser xmlCleanupParser
74 #define fn_xmlCheckVersion xmlCheckVersion
75
76 static inline int
77 libxml2_loaded_p (void)
78 {
79 return 1;
80 }
81
82 #endif /* !WINDOWSNT */
83
84 static int
85 init_libxml2_functions (Lisp_Object libraries)
86 {
87 #ifdef WINDOWSNT
88 if (libxml2_loaded_p ())
89 return 1;
90 else
91 {
92 HMODULE library;
93
94 if (!(library = w32_delayed_load (libraries, Qlibxml2_dll)))
95 {
96 message ("%s", "libxml2 library not found");
97 return 0;
98 }
99
100 /* LOAD_XML2_FN jumps to bad_library if it fails to find the
101 named function. */
102 LOAD_XML2_FN (library, htmlReadMemory);
103 LOAD_XML2_FN (library, xmlReadMemory);
104 LOAD_XML2_FN (library, xmlDocGetRootElement);
105 LOAD_XML2_FN (library, xmlFreeDoc);
106 LOAD_XML2_FN (library, xmlCleanupParser);
107 LOAD_XML2_FN (library, xmlCheckVersion);
108
109 Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
110 return 1;
111 }
112
113 bad_library:
114 Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
115
116 return 0;
117 #else /* !WINDOWSNT */
118 return 1;
119 #endif /* !WINDOWSNT */
120 }
121
122 static Lisp_Object
123 make_dom (xmlNode *node)
124 {
125 if (node->type == XML_ELEMENT_NODE)
126 {
127 Lisp_Object result = Fcons (intern ((char *) node->name), Qnil);
128 xmlNode *child;
129 xmlAttr *property;
130 Lisp_Object plist = Qnil;
131
132 /* First add the attributes. */
133 property = node->properties;
134 while (property != NULL)
135 {
136 if (property->children &&
137 property->children->content)
138 {
139 char *content = (char *) property->children->content;
140 plist = Fcons (Fcons (intern ((char *) property->name),
141 build_string (content)),
142 plist);
143 }
144 property = property->next;
145 }
146 result = Fcons (Fnreverse (plist), result);
147
148 /* Then add the children of the node. */
149 child = node->children;
150 while (child != NULL)
151 {
152 result = Fcons (make_dom (child), result);
153 child = child->next;
154 }
155
156 return Fnreverse (result);
157 }
158 else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
159 {
160 if (node->content)
161 return build_string ((char *) node->content);
162 else
163 return Qnil;
164 }
165 else if (node->type == XML_COMMENT_NODE)
166 {
167 if (node->content)
168 return list3 (intern ("comment"), Qnil,
169 build_string ((char *) node->content));
170 else
171 return Qnil;
172 }
173 else
174 return Qnil;
175 }
176
177 static Lisp_Object
178 parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int htmlp)
179 {
180 xmlDoc *doc;
181 Lisp_Object result = Qnil;
182 const char *burl = "";
183 EMACS_INT bytes;
184 EMACS_INT istart, iend;
185
186 fn_xmlCheckVersion (LIBXML_VERSION);
187
188 validate_region (&start, &end);
189
190 istart = XINT (start);
191 iend = XINT (end);
192
193 if (istart < GPT && GPT < iend)
194 move_gap (iend);
195
196 if (! NILP (base_url))
197 {
198 CHECK_STRING (base_url);
199 burl = SSDATA (base_url);
200 }
201
202 bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
203
204 if (htmlp)
205 doc = fn_htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
206 bytes, burl, "utf-8",
207 HTML_PARSE_RECOVER|HTML_PARSE_NONET|
208 HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
209 HTML_PARSE_NOBLANKS);
210 else
211 doc = fn_xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
212 bytes, burl, "utf-8",
213 XML_PARSE_NONET|XML_PARSE_NOWARNING|
214 XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
215
216 if (doc != NULL)
217 {
218 /* If the document is just comments, then this should get us the
219 nodes anyway. */
220 xmlNode *n = doc->children->next;
221 Lisp_Object r = Qnil;
222
223 while (n) {
224 if (!NILP (r))
225 result = Fcons (r, result);
226 r = make_dom (n);
227 n = n->next;
228 }
229
230 if (NILP (result)) {
231 /* The document isn't just comments, so get the tree the
232 proper way. */
233 xmlNode *node = fn_xmlDocGetRootElement (doc);
234 if (node != NULL)
235 result = make_dom (node);
236 } else
237 result = Fcons (intern ("top"),
238 Fcons (Qnil, Fnreverse (Fcons (r, result))));
239
240 fn_xmlFreeDoc (doc);
241 }
242
243 return result;
244 }
245
246 void
247 xml_cleanup_parser (void)
248 {
249 if (libxml2_loaded_p ())
250 fn_xmlCleanupParser ();
251 }
252
253 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
254 Slibxml_parse_html_region,
255 2, 3, 0,
256 doc: /* Parse the region as an HTML document and return the parse tree.
257 If BASE-URL is non-nil, it is used to expand relative URLs. */)
258 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
259 {
260 if (init_libxml2_functions (Vdynamic_library_alist))
261 return parse_region (start, end, base_url, 1);
262 return Qnil;
263 }
264
265 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
266 Slibxml_parse_xml_region,
267 2, 3, 0,
268 doc: /* Parse the region as an XML document and return the parse tree.
269 If BASE-URL is non-nil, it is used to expand relative URLs. */)
270 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
271 {
272 if (init_libxml2_functions (Vdynamic_library_alist))
273 return parse_region (start, end, base_url, 0);
274 return Qnil;
275 }
276
277 \f
278 /***********************************************************************
279 Initialization
280 ***********************************************************************/
281 void
282 syms_of_xml (void)
283 {
284 defsubr (&Slibxml_parse_html_region);
285 defsubr (&Slibxml_parse_xml_region);
286
287 DEFSYM (Qlibxml2_dll, "libxml2");
288 }
289
290 #endif /* HAVE_LIBXML2 */