diff options
Diffstat (limited to 'src/fileio.c')
| -rw-r--r-- | src/fileio.c | 146 |
1 files changed, 131 insertions, 15 deletions
diff --git a/src/fileio.c b/src/fileio.c index 741e297d29c..13c99bee109 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -749,6 +749,114 @@ For that reason, you should normally use `make-temp-file' instead. */) empty_unibyte_string, Qnil); } +DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0, + doc: /* Append COMPONENTS to DIRECTORY and return the resulting string. +Elements in COMPONENTS must be a string or nil. +DIRECTORY or the non-final elements in COMPONENTS may or may not end +with a slash -- if they don't end with a slash, a slash will be +inserted before contatenating. +usage: (record DIRECTORY &rest COMPONENTS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0; + Lisp_Object *elements = args; + Lisp_Object result; + ptrdiff_t i; + + /* First go through the list to check the types and see whether + they're all of the same multibytedness. */ + for (i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + /* Skip empty and nil elements. */ + if (NILP (arg)) + continue; + CHECK_STRING (arg); + if (SCHARS (arg) == 0) + continue; + eargs++; + /* Multibyte and non-ASCII. */ + if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg)) + multibytes++; + /* We're not adding a slash to the final part. */ + if (i == nargs - 1 + || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1))) + { + bytes += SBYTES (arg); + chars += SCHARS (arg); + } + else + { + bytes += SBYTES (arg) + 1; + chars += SCHARS (arg) + 1; + } + } + + /* Convert if needed. */ + if ((multibytes != 0 && multibytes != nargs) + || eargs != nargs) + { + int j = 0; + elements = xmalloc (eargs * sizeof *elements); + bytes = 0; + chars = 0; + + /* Filter out nil/"". */ + for (i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (!NILP (arg) && SCHARS (arg) != 0) + elements[j++] = arg; + } + + for (i = 0; i < eargs; i++) + { + Lisp_Object arg = elements[i]; + /* Use multibyte or all-ASCII strings as is. */ + if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg)) + elements[i] = Fstring_to_multibyte (arg); + arg = elements[i]; + /* We have to recompute the number of bytes. */ + if (i == eargs - 1 + || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1))) + { + bytes += SBYTES (arg); + chars += SCHARS (arg); + } + else + { + bytes += SBYTES (arg) + 1; + chars += SCHARS (arg) + 1; + } + } + } + + /* Allocate an empty string. */ + if (multibytes == 0) + result = make_uninit_string (chars); + else + result = make_uninit_multibyte_string (chars, bytes); + /* Null-terminate the string. */ + *(SSDATA (result) + SBYTES (result)) = 0; + + /* Copy over the data. */ + char *p = SSDATA (result); + for (i = 0; i < eargs; i++) + { + Lisp_Object arg = elements[i]; + memcpy (p, SSDATA (arg), SBYTES (arg)); + p += SBYTES (arg); + /* The last element shouldn't have a slash added at the end. */ + if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1))) + *p++ = DIRECTORY_SEP; + } + + if (elements != args) + xfree (elements); + + return result; +} + /* NAME must be a string. */ static bool file_name_absolute_no_tilde_p (Lisp_Object name) @@ -1830,6 +1938,9 @@ the value of that variable. The variable name should be terminated with a character not a letter, digit or underscore; otherwise, enclose the entire variable name in braces. +If FOO is not defined in the environment, `$FOO' is left unchanged in +the value of this function. + If `/~' appears, all of FILENAME through that `/' is discarded. If `//' appears, everything up to and including the first of those `/' is discarded. */) @@ -2987,12 +3098,16 @@ file_directory_p (Lisp_Object file) DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, doc: /* Return t if FILENAME names a directory you can open. -For the value to be t, FILENAME must specify the name of a directory -as a file, and the directory must allow you to open files in it. In -order to use a directory as a buffer's current directory, this -predicate must return true. A directory name spec may be given -instead; then the value is t if the directory so specified exists and -really is a readable and searchable directory. */) +This means that FILENAME must specify the name of a directory, and the +directory must allow you to open files in it. If this isn't the case, +return nil. + +FILENAME can either be a directory name (eg. \"/tmp/foo/\") or the +file name of a file which is a directory (eg. \"/tmp/foo\", without +the final slash). + +In order to use a directory as a buffer's current directory, this +predicate must return true. */) (Lisp_Object filename) { Lisp_Object absname; @@ -4537,7 +4652,7 @@ by calling `format-decode', which see. */) if (inserted == 0) { if (we_locked_file) - unlock_file (BVAR (current_buffer, file_truename)); + Funlock_file (BVAR (current_buffer, file_truename)); Vdeactivate_mark = old_Vdeactivate_mark; } else @@ -4699,8 +4814,8 @@ by calling `format-decode', which see. */) if (NILP (handler)) { if (!NILP (BVAR (current_buffer, file_truename))) - unlock_file (BVAR (current_buffer, file_truename)); - unlock_file (filename); + Funlock_file (BVAR (current_buffer, file_truename)); + Funlock_file (filename); } if (not_regular) xsignal2 (Qfile_error, @@ -5161,7 +5276,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (open_and_close_file && !auto_saving) { - lock_file (lockname); + Flock_file (lockname); file_locked = 1; } @@ -5186,7 +5301,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { int open_errno = errno; if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); report_file_errno ("Opening output file", filename, open_errno); } @@ -5201,7 +5316,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { int lseek_errno = errno; if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); report_file_errno ("Lseek error", filename, lseek_errno); } } @@ -5338,7 +5453,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, unbind_to (count, Qnil); if (file_locked) - unlock_file (lockname); + Funlock_file (lockname); /* Do this before reporting IO error to avoid a "file has changed on disk" warning on @@ -5363,14 +5478,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, bset_filename (current_buffer, visit_file); update_mode_lines = 14; if (auto_saving_into_visited_file) - unlock_file (lockname); + Funlock_file (lockname); } else if (quietly) { if (auto_saving_into_visited_file) { SAVE_MODIFF = MODIFF; - unlock_file (lockname); + Funlock_file (lockname); } return Qnil; @@ -6481,6 +6596,7 @@ This includes interactive calls to `delete-file' and defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_file_internal); defsubr (&Smake_temp_name); + defsubr (&Sfile_name_concat); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); |