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