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