static json_t * lisp_to_json_toplevel_1 (Lisp_Object lisp) { json_t *json; ptrdiff_t count; if (VECTORP (lisp)) { ptrdiff_t size = ASIZE (lisp); json = json_check (json_array ()); count = SPECPDL_INDEX (); record_unwind_protect_ptr (json_release_object, json); for (ptrdiff_t i = 0; i < size; ++i) { int status = json_array_append_new (json, lisp_to_json (AREF (lisp, i))); if (status == -1) json_out_of_memory (); } eassert (json_array_size (json) == size); } else if (HASH_TABLE_P (lisp)) { struct Lisp_Hash_Table *h = XHASH_TABLE (lisp); json = json_check (json_object ()); count = SPECPDL_INDEX (); record_unwind_protect_ptr (json_release_object, json); for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) if (!NILP (HASH_HASH (h, i))) { Lisp_Object key = json_encode (HASH_KEY (h, i)); /* We can't specify the length, so the string must be null-terminated. */ check_string_without_embedded_nulls (key); const char *key_str = SSDATA (key); /* Reject duplicate keys. These are possible if the hash table test is not `equal'. */ if (json_object_get (json, key_str) != NULL) wrong_type_argument (Qjson_value_p, lisp); int status = json_object_set_new (json, key_str, lisp_to_json (HASH_VALUE (h, i))); if (status == -1) { /* A failure can be caused either by an invalid key or by low memory. */ json_check_utf8 (key); json_out_of_memory (); } } } else if (NILP (lisp)) return json_check (json_object ()); else if (CONSP (lisp)) { Lisp_Object tail = lisp; json = json_check (json_object ()); count = SPECPDL_INDEX (); record_unwind_protect_ptr (json_release_object, json); bool is_plist = !CONSP (XCAR (tail)); FOR_EACH_TAIL (tail) { const char *key_str; Lisp_Object value; Lisp_Object key_symbol; if (is_plist) { key_symbol = XCAR (tail); tail = XCDR (tail); CHECK_CONS (tail); value = XCAR (tail); if (EQ (tail, li.tortoise)) circular_list (lisp); } else { Lisp_Object pair = XCAR (tail); CHECK_CONS (pair); key_symbol = XCAR (pair); value = XCDR (pair); } CHECK_SYMBOL (key_symbol); Lisp_Object key = SYMBOL_NAME (key_symbol); /* We can't specify the length, so the string must be null-terminated. */ check_string_without_embedded_nulls (key); key_str = SSDATA (key); /* In plists, ensure leading ":" in keys is stripped. It will be reconstructed later in `json_to_lisp'.*/ if (is_plist && ':' == key_str[0] && key_str[1]) { key_str = &key_str[1]; } /* Only add element if key is not already present. */ if (json_object_get (json, key_str) == NULL) { int status = json_object_set_new (json, key_str, lisp_to_json (value)); if (status == -1) json_out_of_memory (); } } CHECK_LIST_END (tail, lisp); } else
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); }
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; }