* lisp/subr.el (filter): Remove. Use `cl-remove-if-not' or `seq-filter'.
[emacs.git] / src / xml.c
blobd418202182b9c7d1b6e60e25c7c33a1d146a87e0
1 /* Interface to libxml2.
2 Copyright (C) 2010-2014 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 <libxml/tree.h>
24 #include <libxml/parser.h>
25 #include <libxml/HTMLparser.h>
27 #include "lisp.h"
28 #include "character.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 int
77 libxml2_loaded_p (void)
79 return 1;
82 #endif /* !WINDOWSNT */
84 static int
85 init_libxml2_functions (void)
87 #ifdef WINDOWSNT
88 if (libxml2_loaded_p ())
89 return 1;
90 else
92 HMODULE library;
94 if (!(library = w32_delayed_load (Qlibxml2_dll)))
96 message1 ("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 = list1 (intern ((char *) node->name));
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, Lisp_Object discard_comments, int htmlp)
180 xmlDoc *doc;
181 Lisp_Object result = Qnil;
182 const char *burl = "";
183 ptrdiff_t istart, iend, istart_byte, iend_byte;
185 fn_xmlCheckVersion (LIBXML_VERSION);
187 validate_region (&start, &end);
189 istart = XINT (start);
190 iend = XINT (end);
191 istart_byte = CHAR_TO_BYTE (istart);
192 iend_byte = CHAR_TO_BYTE (iend);
194 if (istart < GPT && GPT < iend)
195 move_gap_both (iend, iend_byte);
197 if (! NILP (base_url))
199 CHECK_STRING (base_url);
200 burl = SSDATA (base_url);
203 if (htmlp)
204 doc = fn_htmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
205 iend_byte - istart_byte, burl, "utf-8",
206 HTML_PARSE_RECOVER|HTML_PARSE_NONET|
207 HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
208 HTML_PARSE_NOBLANKS);
209 else
210 doc = fn_xmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
211 iend_byte - istart_byte, burl, "utf-8",
212 XML_PARSE_NONET|XML_PARSE_NOWARNING|
213 XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
215 if (doc != NULL)
217 Lisp_Object r = Qnil;
218 if (NILP(discard_comments))
220 /* If the document has toplevel comments, then this should
221 get us the nodes and the comments. */
222 xmlNode *n = doc->children;
224 while (n) {
225 if (!NILP (r))
226 result = Fcons (r, result);
227 r = make_dom (n);
228 n = n->next;
232 if (NILP (result)) {
233 /* The document doesn't have toplevel comments or we discarded
234 them. Get the tree the proper way. */
235 xmlNode *node = fn_xmlDocGetRootElement (doc);
236 if (node != NULL)
237 result = make_dom (node);
238 } else
239 result = Fcons (intern ("top"),
240 Fcons (Qnil, Fnreverse (Fcons (r, result))));
242 fn_xmlFreeDoc (doc);
245 return result;
248 void
249 xml_cleanup_parser (void)
251 if (libxml2_loaded_p ())
252 fn_xmlCleanupParser ();
255 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
256 Slibxml_parse_html_region,
257 2, 4, 0,
258 doc: /* Parse the region as an HTML document and return the parse tree.
259 If BASE-URL is non-nil, it is used to expand relative URLs.
260 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
261 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
263 if (init_libxml2_functions ())
264 return parse_region (start, end, base_url, discard_comments, 1);
265 return Qnil;
268 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
269 Slibxml_parse_xml_region,
270 2, 4, 0,
271 doc: /* Parse the region as an XML document and return the parse tree.
272 If BASE-URL is non-nil, it is used to expand relative URLs.
273 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
274 (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
276 if (init_libxml2_functions ())
277 return parse_region (start, end, base_url, discard_comments, 0);
278 return Qnil;
282 /***********************************************************************
283 Initialization
284 ***********************************************************************/
285 void
286 syms_of_xml (void)
288 defsubr (&Slibxml_parse_html_region);
289 defsubr (&Slibxml_parse_xml_region);
291 DEFSYM (Qlibxml2_dll, "libxml2");
294 #endif /* HAVE_LIBXML2 */