code.delx.au - gnu-emacs/blob - src/xml.c

   1 /* Interface to libxml2.
   2    Copyright (C) 2010-2016 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 <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 "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
 185   xmlCheckVersion (LIBXML_VERSION);
 186
 187   validate_region (&start, &end);
 188
 189   istart = XINT (start);
 190   iend = XINT (end);
 191   istart_byte = CHAR_TO_BYTE (istart);
 192   iend_byte = CHAR_TO_BYTE (iend);
 193
 194   if (istart < GPT && GPT < iend)
 195     move_gap_both (iend, iend_byte);
 196
 197   if (! NILP (base_url))
 198     {
 199       CHECK_STRING (base_url);
 200       burl = SSDATA (base_url);
 201     }
 202
 203   if (htmlp)
 204     doc = 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 = 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);
 214
 215   if (doc != NULL)
 216     {
 217       Lisp_Object r = Qnil;
 218       if (NILP(discard_comments))
 219         {
 220           /* If the document has toplevel comments, then this should
 221              get us the nodes and the comments. */
 222           xmlNode *n = doc->children;
 223
 224           while (n) {
 225             if (!NILP (r))
 226               result = Fcons (r, result);
 227             r = make_dom (n);
 228             n = n->next;
 229           }
 230         }
 231
 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 = xmlDocGetRootElement (doc);
 236         if (node != NULL)
 237           result = make_dom (node);
 238       } else
 239         result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result))));
 240
 241       xmlFreeDoc (doc);
 242     }
 243
 244   return result;
 245 }
 246
 247 void
 248 xml_cleanup_parser (void)
 249 {
 250   if (libxml2_loaded_p ())
 251     xmlCleanupParser ();
 252 }
 253
 254 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
 255        Slibxml_parse_html_region,
 256        2, 4, 0,
 257        doc: /* Parse the region as an HTML document and return the parse tree.
 258 If BASE-URL is non-nil, it is used to expand relative URLs.
 259 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
 260   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
 261 {
 262   if (init_libxml2_functions ())
 263     return parse_region (start, end, base_url, discard_comments, true);
 264   return Qnil;
 265 }
 266
 267 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
 268        Slibxml_parse_xml_region,
 269        2, 4, 0,
 270        doc: /* Parse the region as an XML document and return the parse tree.
 271 If BASE-URL is non-nil, it is used to expand relative URLs.
 272 If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
 273   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments)
 274 {
 275   if (init_libxml2_functions ())
 276     return parse_region (start, end, base_url, discard_comments, false);
 277   return Qnil;
 278 }
 279
 280 \f
 281 /***********************************************************************
 282                             Initialization
 283  ***********************************************************************/
 284 void
 285 syms_of_xml (void)
 286 {
 287   defsubr (&Slibxml_parse_html_region);
 288   defsubr (&Slibxml_parse_xml_region);
 289 }
 290
 291 #endif /* HAVE_LIBXML2 */