359 lines
9.2 KiB
C
359 lines
9.2 KiB
C
/* Interface to libxml2.
|
||
Copyright (C) 2010-2024 Free Software Foundation, Inc.
|
||
|
||
This file is part of GNU Emacs.
|
||
|
||
GNU Emacs is free software: you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation, either version 3 of the License, or (at
|
||
your option) any later version.
|
||
|
||
GNU Emacs is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
||
|
||
#include <config.h>
|
||
|
||
#include "lisp.h"
|
||
#include "buffer.h"
|
||
|
||
#ifdef HAVE_LIBXML2
|
||
|
||
#include <libxml/tree.h>
|
||
#include <libxml/parser.h>
|
||
#include <libxml/HTMLparser.h>
|
||
|
||
|
||
#ifdef WINDOWSNT
|
||
|
||
# include <windows.h>
|
||
# include "w32common.h"
|
||
# include "w32.h"
|
||
|
||
DEF_DLL_FN (htmlDocPtr, htmlReadMemory,
|
||
(const char *, int, const char *, const char *, int));
|
||
DEF_DLL_FN (xmlDocPtr, xmlReadMemory,
|
||
(const char *, int, const char *, const char *, int));
|
||
DEF_DLL_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
|
||
DEF_DLL_FN (void, xmlFreeDoc, (xmlDocPtr));
|
||
DEF_DLL_FN (void, xmlCleanupParser, (void));
|
||
DEF_DLL_FN (void, xmlCheckVersion, (int));
|
||
|
||
static bool
|
||
libxml2_loaded_p (void)
|
||
{
|
||
Lisp_Object found = Fassq (Qlibxml2, Vlibrary_cache);
|
||
|
||
return CONSP (found) && EQ (XCDR (found), Qt);
|
||
}
|
||
|
||
# undef htmlReadMemory
|
||
# undef xmlCheckVersion
|
||
# undef xmlCleanupParser
|
||
# undef xmlDocGetRootElement
|
||
# undef xmlFreeDoc
|
||
# undef xmlReadMemory
|
||
|
||
# define htmlReadMemory fn_htmlReadMemory
|
||
# define xmlCheckVersion fn_xmlCheckVersion
|
||
# define xmlCleanupParser fn_xmlCleanupParser
|
||
# define xmlDocGetRootElement fn_xmlDocGetRootElement
|
||
# define xmlFreeDoc fn_xmlFreeDoc
|
||
# define xmlReadMemory fn_xmlReadMemory
|
||
|
||
static bool
|
||
load_dll_functions (HMODULE library)
|
||
{
|
||
LOAD_DLL_FN (library, htmlReadMemory);
|
||
LOAD_DLL_FN (library, xmlReadMemory);
|
||
LOAD_DLL_FN (library, xmlDocGetRootElement);
|
||
LOAD_DLL_FN (library, xmlFreeDoc);
|
||
LOAD_DLL_FN (library, xmlCleanupParser);
|
||
LOAD_DLL_FN (library, xmlCheckVersion);
|
||
return true;
|
||
}
|
||
|
||
#else /* !WINDOWSNT */
|
||
|
||
static bool
|
||
libxml2_loaded_p (void)
|
||
{
|
||
return true;
|
||
}
|
||
|
||
#endif /* !WINDOWSNT */
|
||
|
||
static bool
|
||
init_libxml2_functions (void)
|
||
{
|
||
#ifdef WINDOWSNT
|
||
if (libxml2_loaded_p ())
|
||
return true;
|
||
else
|
||
{
|
||
HMODULE library;
|
||
|
||
if (!(library = w32_delayed_load (Qlibxml2)))
|
||
{
|
||
message1 ("libxml2 library not found");
|
||
return false;
|
||
}
|
||
|
||
if (! load_dll_functions (library))
|
||
goto bad_library;
|
||
|
||
Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qt), Vlibrary_cache);
|
||
return true;
|
||
}
|
||
|
||
bad_library:
|
||
Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qnil), Vlibrary_cache);
|
||
|
||
return false;
|
||
#else /* !WINDOWSNT */
|
||
return true;
|
||
#endif /* !WINDOWSNT */
|
||
}
|
||
|
||
static Lisp_Object
|
||
make_dom (xmlNode *node)
|
||
{
|
||
if (node->type == XML_ELEMENT_NODE)
|
||
{
|
||
Lisp_Object result = list1 (intern ((char *) node->name));
|
||
xmlNode *child;
|
||
xmlAttr *property;
|
||
Lisp_Object plist = Qnil;
|
||
|
||
/* First add the attributes. */
|
||
property = node->properties;
|
||
while (property != NULL)
|
||
{
|
||
if (property->children &&
|
||
property->children->content)
|
||
{
|
||
char *content = (char *) property->children->content;
|
||
plist = Fcons (Fcons (intern ((char *) property->name),
|
||
build_string (content)),
|
||
plist);
|
||
}
|
||
property = property->next;
|
||
}
|
||
result = Fcons (Fnreverse (plist), result);
|
||
|
||
/* Then add the children of the node. */
|
||
child = node->children;
|
||
while (child != NULL)
|
||
{
|
||
result = Fcons (make_dom (child), result);
|
||
child = child->next;
|
||
}
|
||
|
||
return Fnreverse (result);
|
||
}
|
||
else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
|
||
{
|
||
if (node->content)
|
||
return build_string ((char *) node->content);
|
||
else
|
||
return Qnil;
|
||
}
|
||
else if (node->type == XML_COMMENT_NODE)
|
||
{
|
||
if (node->content)
|
||
return list3 (Qcomment, Qnil,
|
||
build_string ((char *) node->content));
|
||
else
|
||
return Qnil;
|
||
}
|
||
else
|
||
return Qnil;
|
||
}
|
||
|
||
static Lisp_Object
|
||
parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url,
|
||
Lisp_Object discard_comments, bool htmlp)
|
||
{
|
||
xmlDoc *doc;
|
||
Lisp_Object result = Qnil;
|
||
const char *burl = "";
|
||
ptrdiff_t istart, iend, istart_byte, iend_byte;
|
||
unsigned char *buftext;
|
||
|
||
xmlCheckVersion (LIBXML_VERSION);
|
||
|
||
if (NILP (start))
|
||
start = Fpoint_min ();
|
||
|
||
if (NILP (end))
|
||
end = Fpoint_max ();
|
||
|
||
validate_region (&start, &end);
|
||
|
||
istart = XFIXNUM (start);
|
||
iend = XFIXNUM (end);
|
||
istart_byte = CHAR_TO_BYTE (istart);
|
||
iend_byte = CHAR_TO_BYTE (iend);
|
||
|
||
if (istart < GPT && GPT < iend)
|
||
move_gap_both (iend, iend_byte);
|
||
|
||
if (! NILP (base_url))
|
||
{
|
||
CHECK_STRING (base_url);
|
||
burl = SSDATA (base_url);
|
||
}
|
||
|
||
buftext = BYTE_POS_ADDR (istart_byte);
|
||
#ifdef REL_ALLOC
|
||
/* Prevent ralloc.c from relocating the current buffer while libxml2
|
||
functions below read its text. */
|
||
r_alloc_inhibit_buffer_relocation (1);
|
||
#endif
|
||
if (htmlp)
|
||
doc = htmlReadMemory ((char *)buftext,
|
||
iend_byte - istart_byte, burl, "utf-8",
|
||
HTML_PARSE_RECOVER|HTML_PARSE_NONET|
|
||
HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
|
||
HTML_PARSE_NOBLANKS);
|
||
else
|
||
doc = xmlReadMemory ((char *)buftext,
|
||
iend_byte - istart_byte, burl, "utf-8",
|
||
XML_PARSE_NONET|XML_PARSE_NOWARNING|
|
||
XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
|
||
|
||
#ifdef REL_ALLOC
|
||
r_alloc_inhibit_buffer_relocation (0);
|
||
#endif
|
||
/* If the assertion below fails, malloc was called inside the above
|
||
libxml2 functions, and ralloc.c caused relocation of buffer text,
|
||
so we could have read from unrelated memory. */
|
||
eassert (buftext == BYTE_POS_ADDR (istart_byte));
|
||
|
||
if (doc != NULL)
|
||
{
|
||
Lisp_Object r = Qnil;
|
||
if (NILP(discard_comments))
|
||
{
|
||
/* If the document has toplevel comments, then this should
|
||
get us the nodes and the comments. */
|
||
xmlNode *n = doc->children;
|
||
|
||
while (n) {
|
||
if (!NILP (r))
|
||
result = Fcons (r, result);
|
||
r = make_dom (n);
|
||
n = n->next;
|
||
}
|
||
}
|
||
|
||
if (NILP (result)) {
|
||
/* The document doesn't have toplevel comments or we discarded
|
||
them. Get the tree the proper way. */
|
||
xmlNode *node = xmlDocGetRootElement (doc);
|
||
if (node != NULL)
|
||
result = make_dom (node);
|
||
} else
|
||
result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result))));
|
||
|
||
xmlFreeDoc (doc);
|
||
}
|
||
|
||
return result;
|
||
}
|
||
|
||
void
|
||
xml_cleanup_parser (void)
|
||
{
|
||
if (libxml2_loaded_p ())
|
||
xmlCleanupParser ();
|
||
}
|
||
|
||
DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
|
||
Slibxml_parse_html_region,
|
||
0, 4, 0,
|
||
doc: /* Parse the region as an HTML document and return the parse tree.
|
||
If START is nil, it defaults to `point-min'. If END is nil, it
|
||
defaults to `point-max'.
|
||
|
||
If BASE-URL is non-nil, it is used if and when reporting errors and
|
||
warnings from the underlying libxml2 library. Currently, errors and
|
||
warnings from the library are suppressed, so this argument is largely
|
||
ignored.
|
||
|
||
If you want comments to be stripped, use the `xml-remove-comments'
|
||
function to strip comments before calling this function. */)
|
||
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
|
||
{
|
||
if (init_libxml2_functions ())
|
||
return parse_region (start, end, base_url, discard_comments, true);
|
||
return Qnil;
|
||
}
|
||
|
||
DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
|
||
Slibxml_parse_xml_region,
|
||
0, 4, 0,
|
||
doc: /* Parse the region as an XML document and return the parse tree.
|
||
If START is nil, it defaults to `point-min'. If END is nil, it
|
||
defaults to `point-max'.
|
||
|
||
If BASE-URL is non-nil, it is used if and when reporting errors and
|
||
warnings from the underlying libxml2 library. Currently, errors and
|
||
warnings from the library are suppressed, so this argument is largely
|
||
ignored.
|
||
|
||
If you want comments to be stripped, use the `xml-remove-comments'
|
||
function to strip comments before calling this function. */)
|
||
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
|
||
{
|
||
if (init_libxml2_functions ())
|
||
return parse_region (start, end, base_url, discard_comments, false);
|
||
return Qnil;
|
||
}
|
||
#endif /* HAVE_LIBXML2 */
|
||
|
||
|
||
|
||
DEFUN ("libxml-available-p", Flibxml_available_p, Slibxml_available_p, 0, 0, 0,
|
||
doc: /* Return t if libxml2 support is available in this instance of Emacs.*/)
|
||
(void)
|
||
{
|
||
#ifdef HAVE_LIBXML2
|
||
# ifdef WINDOWSNT
|
||
Lisp_Object found = Fassq (Qlibxml2, Vlibrary_cache);
|
||
if (CONSP (found))
|
||
return XCDR (found);
|
||
else
|
||
{
|
||
Lisp_Object status;
|
||
status = init_libxml2_functions () ? Qt : Qnil;
|
||
Vlibrary_cache = Fcons (Fcons (Qlibxml2, status), Vlibrary_cache);
|
||
return status;
|
||
}
|
||
# else
|
||
return Qt;
|
||
# endif /* WINDOWSNT */
|
||
#else
|
||
return Qnil;
|
||
#endif /* HAVE_LIBXML2 */
|
||
}
|
||
|
||
/***********************************************************************
|
||
Initialization
|
||
***********************************************************************/
|
||
void
|
||
syms_of_xml (void)
|
||
{
|
||
#ifdef HAVE_LIBXML2
|
||
defsubr (&Slibxml_parse_html_region);
|
||
defsubr (&Slibxml_parse_xml_region);
|
||
#endif
|
||
defsubr (&Slibxml_available_p);
|
||
|
||
DEFSYM (Qcomment, "comment");
|
||
}
|