static Lisp_Object make_dom (xmlNode *node) { if (node->type == XML_ELEMENT_NODE) { Lisp_Object result = Fcons (intern ((char *) node->name), Qnil); 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; }
repv gh_list(repv elt, ...) { repv lst = Qnil; va_list args; va_start (args, elt); while (elt != rep_undefined_value) { lst = Fcons (elt, lst); elt = va_arg (args, repv); } va_end (args); return Fnreverse (lst); }
Lisp_Object directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, bool attrs, Lisp_Object id_format) { DIR *d; int fd; ptrdiff_t directory_nbytes; Lisp_Object list, dirfilename, encoded_directory; struct re_pattern_buffer *bufp = NULL; bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct dirent *dp; #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif /* Don't let the compiler optimize away all copies of DIRECTORY, which would break GC; see Bug#16986. Although this is required only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, it shouldn't break anything in the other cases. */ Lisp_Object volatile directory_volatile = directory; /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ list = encoded_directory = dirfilename = Qnil; GCPRO5 (match, directory, list, dirfilename, encoded_directory); dirfilename = Fdirectory_file_name (directory); if (!NILP (match)) { CHECK_STRING (match); /* MATCH might be a flawed regular expression. Rather than catching and signaling our own errors, we just call compile_pattern to do the work for us. */ /* Pass 1 for the MULTIBYTE arg because we do make multibyte strings if the contents warrant. */ # ifdef WINDOWSNT /* Windows users want case-insensitive wildcards. */ bufp = compile_pattern (match, 0, BVAR (&buffer_defaults, case_canon_table), 0, 1); # else /* !WINDOWSNT */ bufp = compile_pattern (match, 0, Qnil, 0, 1); # endif /* !WINDOWSNT */ } /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ if (STRING_MULTIBYTE (dirfilename)) dirfilename = ENCODE_FILE (dirfilename); encoded_directory = (STRING_MULTIBYTE (directory) ? ENCODE_FILE (directory) : directory); /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ d = open_directory (SSDATA (dirfilename), &fd); if (d == NULL) report_file_error ("Opening directory", directory); /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT if (attrs) { extern int is_slow_fs (const char *); /* Do this only once to avoid doing it (in w32.c:stat) for each file in the directory, when we call Ffile_attributes below. */ record_unwind_protect (directory_files_internal_w32_unwind, Vw32_get_true_file_attributes); w32_save = Vw32_get_true_file_attributes; if (EQ (Vw32_get_true_file_attributes, Qlocal)) { /* w32.c:stat will notice these bindings and avoid calling GetDriveType for each file. */ if (is_slow_fs (SDATA (dirfilename))) Vw32_get_true_file_attributes = Qnil; else Vw32_get_true_file_attributes = Qt; } } #endif directory_nbytes = SBYTES (directory); re_match_object = Qt; /* Decide whether we need to add a directory separator. */ if (directory_nbytes == 0 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) needsep = 1; /* Loop reading blocks until EOF or error. */ for (;;) { ptrdiff_t len; bool wanted = 0; Lisp_Object name, finalname; struct gcpro gcpro1, gcpro2; errno = 0; dp = readdir (d); if (!dp) { if (errno == EAGAIN || errno == EINTR) { QUIT; continue; } break; } len = dirent_namelen (dp); name = finalname = make_unibyte_string (dp->d_name, len); GCPRO2 (finalname, name); /* Note: DECODE_FILE can GC; it should protect its argument, though. */ name = DECODE_FILE (name); len = SBYTES (name); /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ immediate_quit = 1; QUIT; if (NILP (match) || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0) wanted = 1; immediate_quit = 0; if (wanted) { if (!NILP (full)) { Lisp_Object fullname; ptrdiff_t nbytes = len + directory_nbytes + needsep; ptrdiff_t nchars; fullname = make_uninit_multibyte_string (nbytes, nbytes); memcpy (SDATA (fullname), SDATA (directory), directory_nbytes); if (needsep) SSET (fullname, directory_nbytes, DIRECTORY_SEP); memcpy (SDATA (fullname) + directory_nbytes + needsep, SDATA (name), len); nchars = multibyte_chars_in_text (SDATA (fullname), nbytes); /* Some bug somewhere. */ if (nchars > nbytes) emacs_abort (); STRING_SET_CHARS (fullname, nchars); if (nchars == nbytes) STRING_SET_UNIBYTE (fullname); finalname = fullname; } else finalname = name; if (attrs) { Lisp_Object fileattrs = file_attributes (fd, dp->d_name, id_format); list = Fcons (Fcons (finalname, fileattrs), list); } else list = Fcons (finalname, list); } UNGCPRO; } block_input (); closedir (d); unblock_input (); #ifdef WINDOWSNT if (attrs) Vw32_get_true_file_attributes = w32_save; #endif /* Discard the unwind protect. */ specpdl_ptr = specpdl + count; if (NILP (nosort)) list = Fsort (Fnreverse (list), attrs ? Qfile_attributes_lessp : Qstring_lessp); (void) directory_volatile; RETURN_UNGCPRO (list); }
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; }
static Lisp_Object parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments, bool htmlp) { xmlDoc *doc; Lisp_Object result = Qnil; const char *burl = ""; ptrdiff_t istart, iend, istart_byte, iend_byte; unsigned char *buftext; 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); } buftext = BYTE_POS_ADDR (istart_byte); #ifdef REL_ALLOC /* Prevent ralloc.c from relocating the current buffer while libxml2 functions below read its text. */ r_alloc_inhibit_buffer_relocation (1); #endif if (htmlp) doc = htmlReadMemory ((char *)buftext, iend_byte - istart_byte, burl, "utf-8", HTML_PARSE_RECOVER|HTML_PARSE_NONET| HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR| HTML_PARSE_NOBLANKS); else doc = xmlReadMemory ((char *)buftext, iend_byte - istart_byte, burl, "utf-8", XML_PARSE_NONET|XML_PARSE_NOWARNING| XML_PARSE_NOBLANKS |XML_PARSE_NOERROR); #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif /* If the assertion below fails, malloc was called inside the above libxml2 functions, and ralloc.c caused relocation of buffer text, so we could have read from unrelated memory. */ eassert (buftext == BYTE_POS_ADDR (istart_byte)); if (doc != NULL) { Lisp_Object r = Qnil; if (NILP(discard_comments)) { /* If the document has toplevel comments, then this should get us the nodes and the comments. */ xmlNode *n = doc->children; while (n) { if (!NILP (r)) result = Fcons (r, result); r = make_dom (n); n = n->next; } } if (NILP (result)) { /* The document doesn't have toplevel comments or we discarded them. Get the tree the proper way. */ xmlNode *node = xmlDocGetRootElement (doc); if (node != NULL) result = make_dom (node); } else result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result)))); xmlFreeDoc (doc); } return result; }
Lisp_Object directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format) { DIR *d; int directory_nbytes; Lisp_Object list, dirfilename, encoded_directory; struct re_pattern_buffer *bufp = NULL; int needsep = 0; int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; DIRENTRY *dp; #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ list = encoded_directory = dirfilename = Qnil; GCPRO5 (match, directory, list, dirfilename, encoded_directory); dirfilename = Fdirectory_file_name (directory); if (!NILP (match)) { CHECK_STRING (match); /* MATCH might be a flawed regular expression. Rather than catching and signaling our own errors, we just call compile_pattern to do the work for us. */ /* Pass 1 for the MULTIBYTE arg because we do make multibyte strings if the contents warrant. */ # ifdef WINDOWSNT /* Windows users want case-insensitive wildcards. */ bufp = compile_pattern (match, 0, buffer_defaults.case_canon_table, 0, 1); # else /* !WINDOWSNT */ bufp = compile_pattern (match, 0, Qnil, 0, 1); # endif /* !WINDOWSNT */ } /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ if (STRING_MULTIBYTE (dirfilename)) dirfilename = ENCODE_FILE (dirfilename); encoded_directory = (STRING_MULTIBYTE (directory) ? ENCODE_FILE (directory) : directory); /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ BLOCK_INPUT; d = opendir (SDATA (dirfilename)); UNBLOCK_INPUT; if (d == NULL) report_file_error ("Opening directory", Fcons (directory, Qnil)); /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ record_unwind_protect (directory_files_internal_unwind, make_save_value (d, 0)); #ifdef WINDOWSNT if (attrs) { extern int is_slow_fs (const char *); /* Do this only once to avoid doing it (in w32.c:stat) for each file in the directory, when we call Ffile_attributes below. */ record_unwind_protect (directory_files_internal_w32_unwind, Vw32_get_true_file_attributes); w32_save = Vw32_get_true_file_attributes; if (EQ (Vw32_get_true_file_attributes, Qlocal)) { /* w32.c:stat will notice these bindings and avoid calling GetDriveType for each file. */ if (is_slow_fs (SDATA (dirfilename))) Vw32_get_true_file_attributes = Qnil; else Vw32_get_true_file_attributes = Qt; } } #endif directory_nbytes = SBYTES (directory); re_match_object = Qt; /* Decide whether we need to add a directory separator. */ if (directory_nbytes == 0 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) needsep = 1; /* Loop reading blocks until EOF or error. */ for (;;) { errno = 0; dp = readdir (d); if (dp == NULL && (0 #ifdef EAGAIN || errno == EAGAIN #endif #ifdef EINTR || errno == EINTR #endif )) { QUIT; continue; } if (dp == NULL) break; if (DIRENTRY_NONEMPTY (dp)) { int len; int wanted = 0; Lisp_Object name, finalname; struct gcpro gcpro1, gcpro2; len = NAMLEN (dp); name = finalname = make_unibyte_string (dp->d_name, len); GCPRO2 (finalname, name); /* Note: DECODE_FILE can GC; it should protect its argument, though. */ name = DECODE_FILE (name); len = SBYTES (name); /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ immediate_quit = 1; QUIT; if (NILP (match) || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0))) wanted = 1; immediate_quit = 0; if (wanted) { if (!NILP (full)) { Lisp_Object fullname; int nbytes = len + directory_nbytes + needsep; int nchars; fullname = make_uninit_multibyte_string (nbytes, nbytes); memcpy (SDATA (fullname), SDATA (directory), directory_nbytes); if (needsep) SSET (fullname, directory_nbytes, DIRECTORY_SEP); memcpy (SDATA (fullname) + directory_nbytes + needsep, SDATA (name), len); nchars = chars_in_text (SDATA (fullname), nbytes); /* Some bug somewhere. */ if (nchars > nbytes) abort (); STRING_SET_CHARS (fullname, nchars); if (nchars == nbytes) STRING_SET_UNIBYTE (fullname); finalname = fullname; } else finalname = name; if (attrs) { /* Construct an expanded filename for the directory entry. Use the decoded names for input to Ffile_attributes. */ Lisp_Object decoded_fullname, fileattrs; struct gcpro gcpro1, gcpro2; decoded_fullname = fileattrs = Qnil; GCPRO2 (decoded_fullname, fileattrs); /* Both Fexpand_file_name and Ffile_attributes can GC. */ decoded_fullname = Fexpand_file_name (name, directory); fileattrs = Ffile_attributes (decoded_fullname, id_format); list = Fcons (Fcons (finalname, fileattrs), list); UNGCPRO; } else list = Fcons (finalname, list); } UNGCPRO; } } BLOCK_INPUT; closedir (d); UNBLOCK_INPUT; #ifdef WINDOWSNT if (attrs) Vw32_get_true_file_attributes = w32_save; #endif /* Discard the unwind protect. */ specpdl_ptr = specpdl + count; if (NILP (nosort)) list = Fsort (Fnreverse (list), attrs ? Qfile_attributes_lessp : Qstring_lessp); RETURN_UNGCPRO (list); }
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 = ""; EMACS_INT bytes; EMACS_INT istart, iend; LIBXML_TEST_VERSION; validate_region (&start, &end); istart = XINT (start); iend = XINT (end); if (istart < GPT && GPT < iend) move_gap (iend); if (! NILP (base_url)) { CHECK_STRING (base_url); burl = SSDATA (base_url); } bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart); if (htmlp) doc = htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)), bytes, burl, "utf-8", HTML_PARSE_RECOVER|HTML_PARSE_NONET| HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR| HTML_PARSE_NOBLANKS); else doc = xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)), bytes, burl, "utf-8", XML_PARSE_NONET|XML_PARSE_NOWARNING| XML_PARSE_NOBLANKS |XML_PARSE_NOERROR); if (doc != NULL) { 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)) result = r; else result = Fcons (intern ("top"), Fcons (Qnil, Fnreverse (Fcons (r, result)))); xmlFreeDoc (doc); xmlCleanupParser (); } return result; }
Lisp_Object directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, bool attrs, Lisp_Object id_format) { ptrdiff_t directory_nbytes; Lisp_Object list, dirfilename, encoded_directory; bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif /* Don't let the compiler optimize away all copies of DIRECTORY, which would break GC; see Bug#16986. */ Lisp_Object volatile directory_volatile = directory; /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ list = encoded_directory = dirfilename = Qnil; dirfilename = Fdirectory_file_name (directory); /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ dirfilename = ENCODE_FILE (dirfilename); encoded_directory = ENCODE_FILE (directory); int fd; DIR *d = open_directory (dirfilename, &fd); /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT if (attrs) { /* Do this only once to avoid doing it (in w32.c:stat) for each file in the directory, when we call file_attributes below. */ record_unwind_protect (directory_files_internal_w32_unwind, Vw32_get_true_file_attributes); w32_save = Vw32_get_true_file_attributes; if (EQ (Vw32_get_true_file_attributes, Qlocal)) { /* w32.c:stat will notice these bindings and avoid calling GetDriveType for each file. */ if (is_slow_fs (SSDATA (dirfilename))) Vw32_get_true_file_attributes = Qnil; else Vw32_get_true_file_attributes = Qt; } } #endif directory_nbytes = SBYTES (directory); re_match_object = Qt; /* Decide whether we need to add a directory separator. */ if (directory_nbytes == 0 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) needsep = 1; /* Windows users want case-insensitive wildcards. */ Lisp_Object case_table = #ifdef WINDOWSNT BVAR (&buffer_defaults, case_canon_table) #else Qnil #endif ; if (!NILP (match)) CHECK_STRING (match); /* Loop reading directory entries. */ for (struct dirent *dp; (dp = read_dirent (d, directory)); ) { ptrdiff_t len = dirent_namelen (dp); Lisp_Object name = make_unibyte_string (dp->d_name, len); Lisp_Object finalname = name; /* Note: DECODE_FILE can GC; it should protect its argument, though. */ name = DECODE_FILE (name); len = SBYTES (name); /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ maybe_quit (); bool wanted = (NILP (match) || fast_string_match_internal ( match, name, case_table) >= 0); if (wanted) { if (!NILP (full)) { Lisp_Object fullname; ptrdiff_t nbytes = len + directory_nbytes + needsep; ptrdiff_t nchars; fullname = make_uninit_multibyte_string (nbytes, nbytes); memcpy (SDATA (fullname), SDATA (directory), directory_nbytes); if (needsep) SSET (fullname, directory_nbytes, DIRECTORY_SEP); memcpy (SDATA (fullname) + directory_nbytes + needsep, SDATA (name), len); nchars = multibyte_chars_in_text (SDATA (fullname), nbytes); /* Some bug somewhere. */ if (nchars > nbytes) emacs_abort (); STRING_SET_CHARS (fullname, nchars); if (nchars == nbytes) STRING_SET_UNIBYTE (fullname); finalname = fullname; } else finalname = name; if (attrs) { Lisp_Object fileattrs = file_attributes (fd, dp->d_name, directory, name, id_format); list = Fcons (Fcons (finalname, fileattrs), list); } else list = Fcons (finalname, list); } } closedir (d); #ifdef WINDOWSNT if (attrs) Vw32_get_true_file_attributes = w32_save; #endif /* Discard the unwind protect. */ specpdl_ptr = specpdl + count; if (NILP (nosort)) list = Fsort (Fnreverse (list), attrs ? Qfile_attributes_lessp : Qstring_lessp); (void) directory_volatile; return list; }