src/xml.c

   1 /* Interface to libxml2.
   2    Copyright (C) 2010-2015 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 <libxml/tree.h>
  24 #include <libxml/parser.h>
  25 #include <libxml/HTMLparser.h>
  26
  27 #include "lisp.h"
  28 #include "character.h"
  29 #include "buffer.h"
  30
  31 \f
  32 #ifdef WINDOWSNT
  33
  34 # include <windows.h>
  35 # include "w32.h"
  36
  37 DEF_DLL_FN (htmlDocPtr, htmlReadMemory,
  38              (const char *, int, const char *, const char *, int));
  39 DEF_DLL_FN (xmlDocPtr, xmlReadMemory,
  40              (const char *, int, const char *, const char *, int));
  41 DEF_DLL_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
  42 DEF_DLL_FN (void, xmlFreeDoc, (xmlDocPtr));
  43 DEF_DLL_FN (void, xmlCleanupParser, (void));
  44 DEF_DLL_FN (void, xmlCheckVersion, (int));
  45
  46 static bool
  47 libxml2_loaded_p (void)
  48 {
  49   Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
  50
  51   return CONSP (found) && EQ (XCDR (found), Qt);
  52 }
  53
  54 # undef htmlReadMemory
  55 # undef xmlCheckVersion
  56 # undef xmlCleanupParser
  57 # undef xmlDocGetRootElement
  58 # undef xmlFreeDoc
  59 # undef xmlReadMemory
  60
  61 # define htmlReadMemory fn_htmlReadMemory
  62 # define xmlCheckVersion fn_xmlCheckVersion
  63 # define xmlCleanupParser fn_xmlCleanupParser
  64 # define xmlDocGetRootElement fn_xmlDocGetRootElement
  65 # define xmlFreeDoc fn_xmlFreeDoc
  66 # define xmlReadMemory fn_xmlReadMemory
  67
  68 static bool
  69 load_dll_functions (HMODULE library)
  70 {
  71   LOAD_DLL_FN (library, htmlReadMemory);
  72   LOAD_DLL_FN (library, xmlReadMemory);
  73   LOAD_DLL_FN (library, xmlDocGetRootElement);
  74   LOAD_DLL_FN (library, xmlFreeDoc);
  75   LOAD_DLL_FN (library, xmlCleanupParser);
  76   LOAD_DLL_FN (library, xmlCheckVersion);
  77   return true;
  78 }
  79
  80 #else  /* !WINDOWSNT */
  81
  82 static bool
  83 libxml2_loaded_p (void)
  84 {
  85   return true;
  86 }
  87
  88 #endif  /* !WINDOWSNT */
  89
  90 static bool
  91 init_libxml2_functions (void)
  92 {
  93 #ifdef WINDOWSNT
  94   if (libxml2_loaded_p ())
  95     return true;
  96   else
  97     {
  98       HMODULE library;
  99
 100       if (!(library = w32_delayed_load (Qlibxml2_dll)))
 101         {
 102           message1 ("libxml2 library not found");
 103           return false;
 104         }
 105
 106       if (! load_dll_functions (library))
 107         goto bad_library;
 108
 109       Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
 110       return true;
 111     }
 112
 113  bad_library:
 114   Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
 115
 116   return false;
 117 #else  /* !WINDOWSNT */
 118   return true;
 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 = list1 (intern ((char *) node->name));
 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,
 179               Lisp_Object discard_comments, bool htmlp)
 180 {
 181   xmlDoc *doc;
 182   Lisp_Object result = Qnil;
 183   const char *burl = "";
 184   ptrdiff_t istart, iend, istart_byte, iend_byte;
 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   if (htmlp)
 205     doc = htmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
 206                           iend_byte - istart_byte, 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 = xmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
 212                          iend_byte - istart_byte, burl, "utf-8",
 213                          XML_PARSE_NONET|XML_PARSE_NOWARNING|
 214                          XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
 215
 216   if (doc != NULL)
 217     {
 218       Lisp_Object r = Qnil;
 219       if (NILP(discard_comments))
 220         {
 221           /* If the document has toplevel comments, then this should
 222              get us the nodes and the comments. */
 223           xmlNode *n = doc->children;
 224
 225           while (n) {
 226             if (!NILP (r))
 227               result = Fcons (r, result);
 228             r = make_dom (n);
 229             n = n->next;
 230           }
 231         }
 232
 233       if (NILP (result)) {
 234         /* The document doesn't have toplevel comments or we discarded
 235            them.  Get the tree the proper way. */
 236         xmlNode *node = xmlDocGetRootElement (doc);
 237         if (node != NULL)
 238           result = make_dom (node);
 239       } else
 240         result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result))));
 241
 242       xmlFreeDoc (doc);
 243     }
 244
 245   return result;
 246 }
 247
 248 void
 249 xml_cleanup_parser (void)
 250 {
 251   if (libxml2_loaded_p ())
 252     xmlCleanupParser ();
 253 }
 254
 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)
 262 {
 263   if (init_libxml2_functions ())
 264     return parse_region (start, end, base_url, discard_comments, true);
 265   return Qnil;
 266 }
 267
 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)
 275 {
 276   if (init_libxml2_functions ())
 277     return parse_region (start, end, base_url, discard_comments, false);
 278   return Qnil;
 279 }
 280
 281 \f
 282 /***********************************************************************
 283                             Initialization
 284  ***********************************************************************/
 285 void
 286 syms_of_xml (void)
 287 {
 288   defsubr (&Slibxml_parse_html_region);
 289   defsubr (&Slibxml_parse_xml_region);
 290 }
 291
 292 #endif /* HAVE_LIBXML2 */