Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
[emacs.git] / src / xml.c
blobe462a1adf573bcc93f281daf6fe53136d9a8fbd7
1 /* Interface to libxml2.
2 Copyright (C) 2010-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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/>. */
19 #include <config.h>
21 #ifdef HAVE_LIBXML2
23 #include <setjmp.h>
24 #include <libxml/tree.h>
25 #include <libxml/parser.h>
26 #include <libxml/HTMLparser.h>
28 #include "lisp.h"
29 #include "buffer.h"
32 static Lisp_Object Qlibxml2_dll;
34 #ifdef WINDOWSNT
36 #include <windows.h>
37 #include "w32.h"
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
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; \
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));
57 static int
58 libxml2_loaded_p (void)
60 Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
62 if (CONSP (found))
63 return EQ (XCDR (found), Qt) ? 1 : 0;
64 return 0;
67 #else /* !WINDOWSNT */
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
76 static inline int
77 libxml2_loaded_p (void)
79 return 1;
82 #endif /* !WINDOWSNT */
84 static int
85 init_libxml2_functions (Lisp_Object libraries)
87 #ifdef WINDOWSNT
88 if (libxml2_loaded_p ())
89 return 1;
90 else
92 HMODULE library;
94 if (!(library = w32_delayed_load (libraries, Qlibxml2_dll)))
96 message ("%s", "libxml2 library not found");
97 return 0;
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);
109 Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
110 return 1;
113 bad_library:
114 Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
116 return 0;
117 #else /* !WINDOWSNT */
118 return 1;
119 #endif /* !WINDOWSNT */
122 static Lisp_Object
123 make_dom (xmlNode *node)
125 if (node->type == XML_ELEMENT_NODE)
127 Lisp_Object result = Fcons (intern ((char *) node->name), Qnil);
128 xmlNode *child;
129 xmlAttr *property;
130 Lisp_Object plist = Qnil;
132 /* First add the attributes. */
133 property = node->properties;
134 while (property != NULL)
136 if (property->children &&
137 property->children->content)
139 char *content = (char *) property->children->content;
140 plist = Fcons (Fcons (intern ((char *) property->name),
141 build_string (content)),
142 plist);
144 property = property->next;
146 result = Fcons (Fnreverse (plist), result);
148 /* Then add the children of the node. */
149 child = node->children;
150 while (child != NULL)
152 result = Fcons (make_dom (child), result);
153 child = child->next;
156 return Fnreverse (result);
158 else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
160 if (node->content)
161 return build_string ((char *) node->content);
162 else
163 return Qnil;
165 else if (node->type == XML_COMMENT_NODE)
167 if (node->content)
168 return list3 (intern ("comment"), Qnil,
169 build_string ((char *) node->content));
170 else
171 return Qnil;
173 else
174 return Qnil;
177 static Lisp_Object
178 parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int htmlp)
180 xmlDoc *doc;
181 Lisp_Object result = Qnil;
182 const char *burl = "";
183 ptrdiff_t bytes;
184 ptrdiff_t istart, iend;
186 fn_xmlCheckVersion (LIBXML_VERSION);
188 validate_region (&start, &end);
190 istart = XINT (start);
191 iend = XINT (end);
193 if (istart < GPT && GPT < iend)
194 move_gap (iend);
196 if (! NILP (base_url))
198 CHECK_STRING (base_url);
199 burl = SSDATA (base_url);
202 bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
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);
216 if (doc != NULL)
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;
223 while (n) {
224 if (!NILP (r))
225 result = Fcons (r, result);
226 r = make_dom (n);
227 n = n->next;
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))));
240 fn_xmlFreeDoc (doc);
243 return result;
246 void
247 xml_cleanup_parser (void)
249 if (libxml2_loaded_p ())
250 fn_xmlCleanupParser ();
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)
260 if (init_libxml2_functions (Vdynamic_library_alist))
261 return parse_region (start, end, base_url, 1);
262 return Qnil;
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)
272 if (init_libxml2_functions (Vdynamic_library_alist))
273 return parse_region (start, end, base_url, 0);
274 return Qnil;
278 /***********************************************************************
279 Initialization
280 ***********************************************************************/
281 void
282 syms_of_xml (void)
284 defsubr (&Slibxml_parse_html_region);
285 defsubr (&Slibxml_parse_xml_region);
287 DEFSYM (Qlibxml2_dll, "libxml2");
290 #endif /* HAVE_LIBXML2 */