mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-10 13:40:36 -08:00
This makes the code easier to read and the executable a bit smaller. Do not replace all calls to Fcons that happen to create lists, just calls that are intended to create lists. For example, when creating an alist that maps FOO to nil, use list1 (Fcons (FOO, Qnil)) rather than list1 (list1 (FOO)) or Fcons (Fcons (FOO, Qnil), Qnil). Similarly for list2 through list5. * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): * bytecode.c (exec_byte_code): * callint.c (quotify_arg, Fcall_interactively): * callproc.c (Fcall_process, create_temp_file): * charset.c (load_charset_map_from_file) (Fdefine_charset_internal, init_charset): * coding.c (get_translation_table, detect_coding_system) (Fcheck_coding_systems_region) (Fset_terminal_coding_system_internal) (Fdefine_coding_system_internal, Fdefine_coding_system_alias): * composite.c (update_compositions, Ffind_composition_internal): * dired.c (directory_files_internal, file_name_completion) (Fsystem_users): * dispnew.c (Fopen_termscript, bitch_at_user, init_display): * doc.c (Fsnarf_documentation): * editfns.c (Fmessage_box): * emacs.c (main): * eval.c (do_debug_on_call, signal_error, maybe_call_debugger) (Feval, eval_sub, Ffuncall, apply_lambda): * fileio.c (make_temp_name, Fcopy_file, Faccess_file) (Fset_file_selinux_context, Fset_file_acl, Fset_file_modes) (Fset_file_times, Finsert_file_contents) (Fchoose_write_coding_system, Fwrite_region): * fns.c (Flax_plist_put, Fyes_or_no_p, syms_of_fns): * font.c (font_registry_charsets, font_parse_fcname) (font_prepare_cache, font_update_drivers, Flist_fonts): * fontset.c (Fset_fontset_font, Ffontset_info, syms_of_fontset): * frame.c (make_frame, Fmake_terminal_frame) (x_set_frame_parameters, x_report_frame_params) (x_default_parameter, Fx_parse_geometry): * ftfont.c (syms_of_ftfont): * image.c (gif_load): * keyboard.c (command_loop_1): * keymap.c (Fmake_keymap, Fmake_sparse_keymap, access_keymap_1) (Fcopy_keymap, append_key, Fcurrent_active_maps) (Fminor_mode_key_binding, accessible_keymaps_1) (Faccessible_keymaps, Fwhere_is_internal): * lread.c (read_emacs_mule_char): * menu.c (find_and_return_menu_selection): * minibuf.c (get_minibuffer): * nsfns.m (Fns_perform_service): * nsfont.m (ns_script_to_charset): * nsmenu.m (ns_popup_dialog): * nsselect.m (ns_get_local_selection, ns_string_from_pasteboard) (Fx_own_selection_internal): * nsterm.m (append2): * print.c (Fredirect_debugging_output) (print_prune_string_charset): * process.c (Fdelete_process, Fprocess_contact) (Fformat_network_address, set_socket_option) (read_and_dispose_of_process_output, write_queue_push) (send_process, exec_sentinel): * sound.c (Fplay_sound_internal): * textprop.c (validate_plist, add_properties) (Fput_text_property, Fadd_face_text_property) (copy_text_properties, text_property_list, syms_of_textprop): * unexaix.c (report_error): * unexcoff.c (report_error): * unexsol.c (unexec): * xdisp.c (redisplay_tool_bar, store_mode_line_string) (Fformat_mode_line, syms_of_xdisp): * xfaces.c (set_font_frame_param) (Finternal_lisp_face_attribute_values) (Finternal_merge_in_global_face, syms_of_xfaces): * xfns.c (x_default_scroll_bar_color_parameter) (x_default_font_parameter, x_create_tip_frame): * xfont.c (xfont_supported_scripts): * xmenu.c (Fx_popup_dialog, xmenu_show, xdialog_show) (menu_help_callback, xmenu_show): * xml.c (make_dom): * xterm.c (set_wm_state): Prefer list1 (FOO) to Fcons (FOO, Qnil) when creating a list, and similarly for list2 through list5.
289 lines
7.3 KiB
C
289 lines
7.3 KiB
C
/* Interface to libxml2.
|
||
Copyright (C) 2010-2013 Free Software Foundation, Inc.
|
||
|
||
This file is part of GNU Emacs.
|
||
|
||
GNU Emacs is free software: you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation, either version 3 of the License, or
|
||
(at your option) any later version.
|
||
|
||
GNU Emacs is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
||
|
||
#include <config.h>
|
||
|
||
#ifdef HAVE_LIBXML2
|
||
|
||
#include <libxml/tree.h>
|
||
#include <libxml/parser.h>
|
||
#include <libxml/HTMLparser.h>
|
||
|
||
#include "lisp.h"
|
||
#include "character.h"
|
||
#include "buffer.h"
|
||
|
||
|
||
static Lisp_Object Qlibxml2_dll;
|
||
|
||
#ifdef WINDOWSNT
|
||
|
||
#include <windows.h>
|
||
#include "w32.h"
|
||
|
||
/* Macro for defining functions that will be loaded from the libxml2 DLL. */
|
||
#define DEF_XML2_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
|
||
|
||
/* Macro for loading libxml2 functions from the library. */
|
||
#define LOAD_XML2_FN(lib,func) { \
|
||
fn_##func = (void *) GetProcAddress (lib, #func); \
|
||
if (!fn_##func) goto bad_library; \
|
||
}
|
||
|
||
DEF_XML2_FN (htmlDocPtr, htmlReadMemory,
|
||
(const char *, int, const char *, const char *, int));
|
||
DEF_XML2_FN (xmlDocPtr, xmlReadMemory,
|
||
(const char *, int, const char *, const char *, int));
|
||
DEF_XML2_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
|
||
DEF_XML2_FN (void, xmlFreeDoc, (xmlDocPtr));
|
||
DEF_XML2_FN (void, xmlCleanupParser, (void));
|
||
DEF_XML2_FN (void, xmlCheckVersion, (int));
|
||
|
||
static int
|
||
libxml2_loaded_p (void)
|
||
{
|
||
Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
|
||
|
||
if (CONSP (found))
|
||
return EQ (XCDR (found), Qt) ? 1 : 0;
|
||
return 0;
|
||
}
|
||
|
||
#else /* !WINDOWSNT */
|
||
|
||
#define fn_htmlReadMemory htmlReadMemory
|
||
#define fn_xmlReadMemory xmlReadMemory
|
||
#define fn_xmlDocGetRootElement xmlDocGetRootElement
|
||
#define fn_xmlFreeDoc xmlFreeDoc
|
||
#define fn_xmlCleanupParser xmlCleanupParser
|
||
#define fn_xmlCheckVersion xmlCheckVersion
|
||
|
||
static int
|
||
libxml2_loaded_p (void)
|
||
{
|
||
return 1;
|
||
}
|
||
|
||
#endif /* !WINDOWSNT */
|
||
|
||
static int
|
||
init_libxml2_functions (void)
|
||
{
|
||
#ifdef WINDOWSNT
|
||
if (libxml2_loaded_p ())
|
||
return 1;
|
||
else
|
||
{
|
||
HMODULE library;
|
||
|
||
if (!(library = w32_delayed_load (Qlibxml2_dll)))
|
||
{
|
||
message1 ("libxml2 library not found");
|
||
return 0;
|
||
}
|
||
|
||
/* LOAD_XML2_FN jumps to bad_library if it fails to find the
|
||
named function. */
|
||
LOAD_XML2_FN (library, htmlReadMemory);
|
||
LOAD_XML2_FN (library, xmlReadMemory);
|
||
LOAD_XML2_FN (library, xmlDocGetRootElement);
|
||
LOAD_XML2_FN (library, xmlFreeDoc);
|
||
LOAD_XML2_FN (library, xmlCleanupParser);
|
||
LOAD_XML2_FN (library, xmlCheckVersion);
|
||
|
||
Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
|
||
return 1;
|
||
}
|
||
|
||
bad_library:
|
||
Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
|
||
|
||
return 0;
|
||
#else /* !WINDOWSNT */
|
||
return 1;
|
||
#endif /* !WINDOWSNT */
|
||
}
|
||
|
||
static Lisp_Object
|
||
make_dom (xmlNode *node)
|
||
{
|
||
if (node->type == XML_ELEMENT_NODE)
|
||
{
|
||
Lisp_Object result = list1 (intern ((char *) node->name));
|
||
xmlNode *child;
|
||
xmlAttr *property;
|
||
Lisp_Object plist = Qnil;
|
||
|
||
/* First add the attributes. */
|
||
property = node->properties;
|
||
while (property != NULL)
|
||
{
|
||
if (property->children &&
|
||
property->children->content)
|
||
{
|
||
char *content = (char *) property->children->content;
|
||
plist = Fcons (Fcons (intern ((char *) property->name),
|
||
build_string (content)),
|
||
plist);
|
||
}
|
||
property = property->next;
|
||
}
|
||
result = Fcons (Fnreverse (plist), result);
|
||
|
||
/* Then add the children of the node. */
|
||
child = node->children;
|
||
while (child != NULL)
|
||
{
|
||
result = Fcons (make_dom (child), result);
|
||
child = child->next;
|
||
}
|
||
|
||
return Fnreverse (result);
|
||
}
|
||
else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE)
|
||
{
|
||
if (node->content)
|
||
return build_string ((char *) node->content);
|
||
else
|
||
return Qnil;
|
||
}
|
||
else if (node->type == XML_COMMENT_NODE)
|
||
{
|
||
if (node->content)
|
||
return list3 (intern ("comment"), Qnil,
|
||
build_string ((char *) node->content));
|
||
else
|
||
return Qnil;
|
||
}
|
||
else
|
||
return Qnil;
|
||
}
|
||
|
||
static Lisp_Object
|
||
parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int htmlp)
|
||
{
|
||
xmlDoc *doc;
|
||
Lisp_Object result = Qnil;
|
||
const char *burl = "";
|
||
ptrdiff_t istart, iend, istart_byte, iend_byte;
|
||
|
||
fn_xmlCheckVersion (LIBXML_VERSION);
|
||
|
||
validate_region (&start, &end);
|
||
|
||
istart = XINT (start);
|
||
iend = XINT (end);
|
||
istart_byte = CHAR_TO_BYTE (istart);
|
||
iend_byte = CHAR_TO_BYTE (iend);
|
||
|
||
if (istart < GPT && GPT < iend)
|
||
move_gap_both (iend, iend_byte);
|
||
|
||
if (! NILP (base_url))
|
||
{
|
||
CHECK_STRING (base_url);
|
||
burl = SSDATA (base_url);
|
||
}
|
||
|
||
if (htmlp)
|
||
doc = fn_htmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
|
||
iend_byte - istart_byte, burl, "utf-8",
|
||
HTML_PARSE_RECOVER|HTML_PARSE_NONET|
|
||
HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
|
||
HTML_PARSE_NOBLANKS);
|
||
else
|
||
doc = fn_xmlReadMemory ((char *) BYTE_POS_ADDR (istart_byte),
|
||
iend_byte - istart_byte, burl, "utf-8",
|
||
XML_PARSE_NONET|XML_PARSE_NOWARNING|
|
||
XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
|
||
|
||
if (doc != NULL)
|
||
{
|
||
/* If the document is just comments, then this should get us the
|
||
nodes anyway. */
|
||
xmlNode *n = doc->children->next;
|
||
Lisp_Object r = Qnil;
|
||
|
||
while (n) {
|
||
if (!NILP (r))
|
||
result = Fcons (r, result);
|
||
r = make_dom (n);
|
||
n = n->next;
|
||
}
|
||
|
||
if (NILP (result)) {
|
||
/* The document isn't just comments, so get the tree the
|
||
proper way. */
|
||
xmlNode *node = fn_xmlDocGetRootElement (doc);
|
||
if (node != NULL)
|
||
result = make_dom (node);
|
||
} else
|
||
result = Fcons (intern ("top"),
|
||
Fcons (Qnil, Fnreverse (Fcons (r, result))));
|
||
|
||
fn_xmlFreeDoc (doc);
|
||
}
|
||
|
||
return result;
|
||
}
|
||
|
||
void
|
||
xml_cleanup_parser (void)
|
||
{
|
||
if (libxml2_loaded_p ())
|
||
fn_xmlCleanupParser ();
|
||
}
|
||
|
||
DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
|
||
Slibxml_parse_html_region,
|
||
2, 3, 0,
|
||
doc: /* Parse the region as an HTML document and return the parse tree.
|
||
If BASE-URL is non-nil, it is used to expand relative URLs. */)
|
||
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
|
||
{
|
||
if (init_libxml2_functions ())
|
||
return parse_region (start, end, base_url, 1);
|
||
return Qnil;
|
||
}
|
||
|
||
DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
|
||
Slibxml_parse_xml_region,
|
||
2, 3, 0,
|
||
doc: /* Parse the region as an XML document and return the parse tree.
|
||
If BASE-URL is non-nil, it is used to expand relative URLs. */)
|
||
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
|
||
{
|
||
if (init_libxml2_functions ())
|
||
return parse_region (start, end, base_url, 0);
|
||
return Qnil;
|
||
}
|
||
|
||
|
||
/***********************************************************************
|
||
Initialization
|
||
***********************************************************************/
|
||
void
|
||
syms_of_xml (void)
|
||
{
|
||
defsubr (&Slibxml_parse_html_region);
|
||
defsubr (&Slibxml_parse_xml_region);
|
||
|
||
DEFSYM (Qlibxml2_dll, "libxml2");
|
||
}
|
||
|
||
#endif /* HAVE_LIBXML2 */
|