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

   1 /* Interface to libxml2.
   2    Copyright (C) 2010-2011 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 <setjmp.h>
  24 #include <libxml/tree.h>
  25 #include <libxml/parser.h>
  26 #include <libxml/HTMLparser.h>
  27
  28 #include "lisp.h"
  29 #include "buffer.h"
  30
  31 Lisp_Object make_dom (xmlNode *node)
  32 {
  33   if (node->type == XML_ELEMENT_NODE)
  34     {
  35       Lisp_Object result = Fcons (intern (node->name), Qnil);
  36       xmlNode *child;
  37       xmlAttr *property;
  38       Lisp_Object plist = Qnil;
  39
  40       /* First add the attributes. */
  41       property = node->properties;
  42       while (property != NULL)
  43         {
  44           if (property->children &&
  45               property->children->content)
  46             {
  47               plist = Fcons (Fcons (intern (property->name),
  48                                     build_string (property->children->content)),
  49                              plist);
  50             }
  51           property = property->next;
  52         }
  53       result = Fcons (Fnreverse (plist), result);
  54
  55       /* Then add the children of the node. */
  56       child = node->children;
  57       while (child != NULL)
  58         {
  59           result = Fcons (make_dom (child), result);
  60           child = child->next;
  61         }
  62
  63       return Fnreverse (result);
  64     }
  65   else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
  66     {
  67       if (node->content)
  68         return build_string (node->content);
  69       else
  70         return Qnil;
  71     }
  72   else
  73     return Qnil;
  74 }
  75
  76 static Lisp_Object
  77 parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int htmlp)
  78 {
  79   xmlDoc *doc;
  80   xmlNode *node;
  81   Lisp_Object result = Qnil;
  82   const char *burl = "";
  83   EMACS_INT bytes;
  84   EMACS_INT istart, iend;
  85
  86   LIBXML_TEST_VERSION;
  87
  88   validate_region (&start, &end);
  89
  90   istart = XINT (start);
  91   iend = XINT (end);
  92
  93   if (istart < GPT && GPT < iend)
  94     move_gap (iend);
  95
  96   if (! NILP (base_url))
  97     {
  98       CHECK_STRING (base_url);
  99       burl = SDATA (base_url);
 100     }
 101
 102   bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
 103
 104   if (htmlp)
 105     doc = htmlReadMemory (BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
 106                           bytes, burl, "utf-8",
 107                           HTML_PARSE_RECOVER|HTML_PARSE_NONET|
 108                           HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
 109                           HTML_PARSE_NOBLANKS);
 110   else
 111     doc = xmlReadMemory (BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
 112                          bytes, burl, "utf-8",
 113                          XML_PARSE_NONET|XML_PARSE_NOWARNING|
 114                          XML_PARSE_NOERROR);
 115
 116   if (doc != NULL)
 117     {
 118       node = xmlDocGetRootElement (doc);
 119       if (node != NULL)
 120         result = make_dom (node);
 121       xmlFreeDoc (doc);
 122       xmlCleanupParser ();
 123     }
 124
 125   return result;
 126 }
 127
 128 DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
 129        Slibxml_parse_html_region,
 130        2, 3, 0,
 131        doc: /* Parse the region as an HTML document and return the parse tree.
 132 If BASE-URL is non-nil, it is used to expand relative URLs.  */)
 133   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
 134 {
 135   return parse_region (start, end, base_url, 1);
 136 }
 137
 138 DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
 139        Slibxml_parse_xml_region,
 140        2, 3, 0,
 141        doc: /* Parse the region as an XML document and return the parse tree.
 142 If BASE-URL is non-nil, it is used to expand relative URLs.  */)
 143   (Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
 144 {
 145   return parse_region (start, end, base_url, 0);
 146 }
 147
 148 \f
 149 /***********************************************************************
 150                             Initialization
 151  ***********************************************************************/
 152 void
 153 syms_of_xml (void)
 154 {
 155   defsubr (&Slibxml_parse_html_region);
 156   defsubr (&Slibxml_parse_xml_region);
 157 }
 158
 159 #endif /* HAVE_LIBXML2 */