src/xml.c

   1 /* Interface to libxml2.
   2    Copyright (C) 2010-2017 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 (at
   9 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 <https://www.gnu.org/licenses/>.  */
  18
  19 #include <config.h>
  20
  21 #ifdef HAVE_LIBXML2
  22
  23 #include <libxml/tree.h>
  24 #include <libxml/parser.h>
  25 #include <libxml/HTMLparser.h>
  26
  27 #include "lisp.h"
  28 #include "buffer.h"
  29
  30 \f
  31 #ifdef WINDOWSNT
  32
  33 # include <windows.h>
  34 # include "w32.h"
  35
  36 DEF_DLL_FN (htmlDocPtr, htmlReadMemory,
  37              (const char *, int, const char *, const char *, int));
  38 DEF_DLL_FN (xmlDocPtr, xmlReadMemory,
  39              (const char *, int, const char *, const char *, int));
  40 DEF_DLL_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
  41 DEF_DLL_FN (void, xmlFreeDoc, (xmlDocPtr));
  42 DEF_DLL_FN (void, xmlCleanupParser, (void));
  43 DEF_DLL_FN (void, xmlCheckVersion, (int));
  44
  45 static bool
  46 libxml2_loaded_p (void)
  47 {
  48   Lisp_Object found = Fassq (Qlibxml2, Vlibrary_cache);
  49
  50   return CONSP (found) && EQ (XCDR (found), Qt);
  51 }
  52
  53 # undef htmlReadMemory
  54 # undef xmlCheckVersion
  55 # undef xmlCleanupParser
  56 # undef xmlDocGetRootElement
  57 # undef xmlFreeDoc
  58 # undef xmlReadMemory
  59
  60 # define htmlReadMemory fn_htmlReadMemory
  61 # define xmlCheckVersion fn_xmlCheckVersion
  62 # define xmlCleanupParser fn_xmlCleanupParser
  63 # define xmlDocGetRootElement fn_xmlDocGetRootElement
  64 # define xmlFreeDoc fn_xmlFreeDoc
  65 # define xmlReadMemory fn_xmlReadMemory
  66
  67 static bool
  68 load_dll_functions (HMODULE library)
  69 {
  70   LOAD_DLL_FN (library, htmlReadMemory);
  71   LOAD_DLL_FN (library, xmlReadMemory);
  72   LOAD_DLL_FN (library, xmlDocGetRootElement);
  73   LOAD_DLL_FN (library, xmlFreeDoc);
  74   LOAD_DLL_FN (library, xmlCleanupParser);
  75   LOAD_DLL_FN (library, xmlCheckVersion);
  76   return true;
  77 }
  78
  79 #else  /* !WINDOWSNT */
  80
  81 static bool
  82 libxml2_loaded_p (void)
  83 {
  84   return true;
  85 }
  86
  87 #endif  /* !WINDOWSNT */
  88
  89 static bool
  90 init_libxml2_functions (void)
  91 {
  92 #ifdef WINDOWSNT
  93   if (libxml2_loaded_p ())
  94     return true;
  95   else
  96     {
  97       HMODULE library;
  98
  99       if (!(library = w32_delayed_load (Qlibxml2)))
 100         {
 101           message1 ("libxml2 library not found");
 102           return false;
 103         }
 104
 105       if (! load_dll_functions (library))
 106         goto bad_library;
 107
 108       Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qt), Vlibrary_cache);
 109       return true;
 110     }
 111
 112  bad_library:
 113   Vlibrary_cache = Fcons (Fcons (Qlibxml2, Qnil), Vlibrary_cache);
 114
 115   return false;
 116 #else  /* !WINDOWSNT */
 117   return true;
 118 #endif  /* !WINDOWSNT */
 119 }
 120
 121 static Lisp_Object
 122 make_dom (xmlNode *node)
 123 {
 124   if (node->type == XML_ELEMENT_NODE)
 125     {
 126       Lisp_Object result = list1 (intern ((char *) node->name));
 127       xmlNode *child;
 128       xmlAttr *property;
 129       Lisp_Object plist = Qnil;
 130
 131       /* First add the attributes. */
 132       property = node->properties;
 133       while (property != NULL)
 134         {
 135           if (property->children &&
 136               property->children->content)
 137             {
 138               char *content = (char *) property->children->content;
 139               plist = Fcons (Fcons (intern ((char *) property->name),
 140                                     build_string (content)),
 141                              plist);
 142             }
 143           property = property->next;
 144         }
 145       result = Fcons (Fnreverse (plist), result);
 146
 147       /* Then add the children of the node. */
 148       child = node->children;
 149       while (child != NULL)
 150         {
 151           result = Fcons (make_dom (child), result);
 152           child = child->next;
 153         }
 154
 155       return Fnreverse (result);
 156     }
 157   else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
 158     {
 159       if (node->content)
 160         return build_string ((char *) node->content);
 161       else
 162         return Qnil;
 163     }
 164   else if (node->type == XML_COMMENT_NODE)
 165     {
 166       if (node->content)
 167         return list3 (intern ("comment"), Qnil,
 168                       build_string ((char *) node->content));
 169       else
 170         return Qnil;
 171     }
 172   else
 173     return Qnil;
 174 }
 175
 176 static Lisp_Object
 177 parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url,
 178               Lisp_Object discard_comments, bool htmlp)
 179 {
 180   xmlDoc *doc;
 181   Lisp_Object result = Qnil;
 182   const char *burl = "";
 183   ptrdiff_t istart, iend, istart_byte, iend_byte;
 184   unsigned char *buftext;
 185
 186   xmlCheckVersion (LIBXML_VERSION);
 187
 188   validate_region (&start, &end);
 189
 190   istart = XINT (start);
 191   iend = XINT (end);
 192   istart_byte = CHAR_TO_BYTE (istart);
 193   iend_byte = CHAR_TO_BYTE (iend);
 194
 195   if (istart < GPT && GPT < iend)
 196     move_gap_both (iend, iend_byte);
 197
 198   if (! NILP (base_url))
 199     {
 200       CHECK_STRING (base_url);
 201       burl = SSDATA (base_url);
 202     }
 203
 204   buftext = BYTE_POS_ADDR (istart_byte);
 205 #ifdef REL_ALLOC
 206   /* Prevent ralloc.c from relocating the current buffer while libxml2
 207      functions below read its text.  */
 208   r_alloc_inhibit_buffer_relocation (1);
 209 #endif
 210   if (htmlp)
 211     doc = htmlReadMemory ((char *)buftext,
 212                           iend_byte - istart_byte, burl, "utf-8",
 213                           HTML_PARSE_RECOVER|HTML_PARSE_NONET|
 214                           HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
 215                           HTML_PARSE_NOBLANKS);
 216   else
 217     doc = xmlReadMemory ((char *)buftext,
 218                          iend_byte - istart_byte, burl, "utf-8",
 219                          XML_PARSE_NONET|XML_PARSE_NOWARNING|
 220                          XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
 221
 222 #ifdef REL_ALLOC
 223   r_alloc_inhibit_buffer_relocation (0);
 224 #endif
 225   /* If the assertion below fails, malloc was called inside the above
 226      libxml2 functions, and ralloc.c caused relocation of buffer text,
 227      so we could have read from unrelated memory.  */
 228   eassert (buftext == BYTE_POS_ADDR (istart_byte));
 229
 230   if (doc != NULL)
 231     {
 232       Lisp_Object r = Qnil;
 233       if (NILP(discard_comments))
 234         {
 235           /* If the document has toplevel comments, then this should
 236              get us the nodes and the comments. */
 237           xmlNode *n = doc->children;
 238
 239           while (n) {
 240             if (!NILP (r))
 241               result = Fcons (r, result);
 242             r = make_dom (n);
 243             n = n->next;
 244           }
 245         }
 246
 247       if (NILP (result)) {
 248         /* The document doesn't have toplevel comments or we discarded
 249            them.  Get the tree the proper way. */
 250         xmlNode *node = xmlDocGetRootElement (doc);
 251         if (node != NULL)
 252           result = make_dom (node);
 253       } else
 254         result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result))));
 255
 256       xmlFreeDoc (doc);
 257     }
 258
 259   return result;
 260 }
 261
 262 void
 263 xml_cleanup_parser (void)
 264 {
 265   if (libxml2_loaded_p ())
 266     xmlCleanupParser ();
 267 }
 268
 269 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
 270        Slibxml_parse_html_region,
 271        2, 4, 0,
 272        doc: /* Parse the region as an HTML document and return the parse tree.
 273 If BASE-URL is non-nil, it is used to expand relative URLs.
 274 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
 275   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
 276 {
 277   if (init_libxml2_functions ())
 278     return parse_region (start, end, base_url, discard_comments, true);
 279   return Qnil;
 280 }
 281
 282 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
 283        Slibxml_parse_xml_region,
 284        2, 4, 0,
 285        doc: /* Parse the region as an XML document and return the parse tree.
 286 If BASE-URL is non-nil, it is used to expand relative URLs.
 287 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
 288   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
 289 {
 290   if (init_libxml2_functions ())
 291     return parse_region (start, end, base_url, discard_comments, false);
 292   return Qnil;
 293 }
 294
 295 \f
 296 /***********************************************************************
 297                             Initialization
 298  ***********************************************************************/
 299 void
 300 syms_of_xml (void)
 301 {
 302   defsubr (&Slibxml_parse_html_region);
 303   defsubr (&Slibxml_parse_xml_region);
 304 }
 305
 306 #endif /* HAVE_LIBXML2 */