/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
+ Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* for euidaccess */
-
#include <config.h>
-#if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
+#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include <sys/time.h>
#endif
-#ifndef USG
-#ifndef VMS
-#ifndef BSD4_1
-#ifndef WINDOWSNT
-#define HAVE_FSYNC
-#endif
-#endif
-#endif
-#endif
-
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "commands.h"
extern int use_dialog_box;
+extern int use_file_dialog;
#ifndef O_WRONLY
#define O_WRONLY 1
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* The symbol bound to coding-system-for-read when
+ insert-file-contents is called for recovering a file. This is not
+ an actual coding system name, but just an indicator to tell
+ insert-file-contents to use `emacs-mule' with a special flag for
+ auto saving and recovering a file. */
+Lisp_Object Qauto_save_coding;
+
/* Coding system for file names, or nil if none. */
Lisp_Object Vfile_name_coding_system;
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
+/* Lisp function for setting buffer-file-coding-system and the
+ multibyteness of the current buffer after inserting a file. */
+Lisp_Object Qafter_insert_file_set_coding;
+
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
+Lisp_Object Qwrite_region_annotate_functions;
/* During build_annotations, each time an annotation function is called,
this holds the annotations made by the previous functions. */
/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
+/* Function to call to read a file name. */
+Lisp_Object Vread_file_name_function;
+
+/* Current predicate used by read_file_name_internal. */
+Lisp_Object Vread_file_name_predicate;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
\f
void
report_file_error (string, data)
- char *string;
+ const char *string;
Lisp_Object data;
{
Lisp_Object errstring;
default:
/* System error messages are capitalized. Downcase the initial
unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ if (SREF (errstring, 1) != '/')
+ SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
Fsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
Lisp_Object Qset_visited_file_modtime;
DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
- "Return FILENAME's handler function for OPERATION, if it has one.\n\
-Otherwise, return nil.\n\
-A file name is handled if one of the regular expressions in\n\
-`file-name-handler-alist' matches it.\n\n\
-If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
-any handlers that are members of `inhibit-file-name-handlers',\n\
-but we still do run any other handlers. This lets handlers\n\
-use the standard functions without calling themselves recursively.")
- (filename, operation)
- Lisp_Object filename, operation;
+ doc: /* Return FILENAME's handler function for OPERATION, if it has one.
+Otherwise, return nil.
+A file name is handled if one of the regular expressions in
+`file-name-handler-alist' matches it.
+
+If OPERATION equals `inhibit-file-name-operation', then we ignore
+any handlers that are members of `inhibit-file-name-handlers',
+but we still do run any other handlers. This lets handlers
+use the standard functions without calling themselves recursively. */)
+ (filename, operation)
+ Lisp_Object filename, operation;
{
/* This function must not munge the match data. */
- Lisp_Object chain, inhibited_handlers;
+ Lisp_Object chain, inhibited_handlers, result;
+ int pos = -1;
- CHECK_STRING (filename, 0);
+ result = Qnil;
+ CHECK_STRING (filename);
if (EQ (operation, Vinhibit_file_name_operation))
inhibited_handlers = Vinhibit_file_name_handlers;
if (CONSP (elt))
{
Lisp_Object string;
+ int match_pos;
string = XCAR (elt);
- if (STRINGP (string) && fast_string_match (string, filename) >= 0)
+ if (STRINGP (string)
+ && (match_pos = fast_string_match (string, filename)) > pos)
{
Lisp_Object handler, tem;
handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
- return handler;
+ {
+ result = handler;
+ pos = match_pos;
+ }
}
}
QUIT;
}
- return Qnil;
+ return result;
}
\f
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
- 1, 1, 0,
- "Return the directory component in file name FILENAME.\n\
-Return nil if FILENAME does not include a directory.\n\
-Otherwise return a directory spec.\n\
-Given a Unix syntax file name, returns a string ending in slash;\n\
-on VMS, perhaps instead a string ending in `:', `]' or `>'.")
- (filename)
+ 1, 1, 0,
+ doc: /* Return the directory component in file name FILENAME.
+Return nil if FILENAME does not include a directory.
+Otherwise return a directory spec.
+Given a Unix syntax file name, returns a string ending in slash;
+on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
+ (filename)
Lisp_Object filename;
{
+#ifndef DOS_NT
+ register const unsigned char *beg;
+#else
register unsigned char *beg;
- register unsigned char *p;
+#endif
+ register const unsigned char *p;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
#ifdef FILE_SYSTEM_CASE
filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING (filename)->data;
+ beg = SDATA (filename);
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
- p = beg + STRING_BYTES (XSTRING (filename));
+ p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
CORRECT_DIR_SEPS (beg);
#endif /* DOS_NT */
- if (STRING_MULTIBYTE (filename))
- return make_string (beg, p - beg);
- return make_unibyte_string (beg, p - beg);
+ return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
Sfile_name_nondirectory, 1, 1, 0,
- "Return file name FILENAME sans its directory.\n\
-For example, in a Unix-syntax file name,\n\
-this is everything after the last slash,\n\
-or the entire name if it contains no slash.")
- (filename)
+ doc: /* Return file name FILENAME sans its directory.
+For example, in a Unix-syntax file name,
+this is everything after the last slash,
+or the entire name if it contains no slash. */)
+ (filename)
Lisp_Object filename;
{
- register unsigned char *beg, *p, *end;
+ register const unsigned char *beg, *p, *end;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING (filename)->data;
- end = p = beg + STRING_BYTES (XSTRING (filename));
+ beg = SDATA (filename);
+ end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
)
p--;
- if (STRING_MULTIBYTE (filename))
- return make_string (p, end - p);
- return make_unibyte_string (p, end - p);
+ return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
}
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
Sunhandled_file_name_directory, 1, 1, 0,
- "Return a directly usable directory name somehow associated with FILENAME.\n\
-A `directly usable' directory name is one that may be used without the\n\
-intervention of any file handler.\n\
-If FILENAME is a directly usable file itself, return\n\
-\(file-name-directory FILENAME).\n\
-The `call-process' and `start-process' functions use this function to\n\
-get a current directory to run processes in.")
- (filename)
- Lisp_Object filename;
+ doc: /* Return a directly usable directory name somehow associated with FILENAME.
+A `directly usable' directory name is one that may be used without the
+intervention of any file handler.
+If FILENAME is a directly usable file itself, return
+\(file-name-directory FILENAME).
+The `call-process' and `start-process' functions use this function to
+get a current directory to run processes in. */)
+ (filename)
+ Lisp_Object filename;
{
Lisp_Object handler;
/* For Unix syntax, Append a slash if necessary */
if (!IS_DIRECTORY_SEP (out[size]))
{
- out[size + 1] = DIRECTORY_SEP;
+ /* Cannot use DIRECTORY_SEP, which could have any value */
+ out[size + 1] = '/';
out[size + 2] = '\0';
}
#ifdef DOS_NT
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Sfile_name_as_directory, 1, 1, 0,
- "Return a string representing file FILENAME interpreted as a directory.\n\
-This operation exists because a directory is also a file, but its name as\n\
-a directory is different from its name as a file.\n\
-The result can be used as the value of `default-directory'\n\
-or passed as second argument to `expand-file-name'.\n\
-For a Unix-syntax file name, just appends a slash.\n\
-On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
- (file)
+ doc: /* Return a string representing the file name FILE interpreted as a directory.
+This operation exists because a directory is also a file, but its name as
+a directory is different from its name as a file.
+The result can be used as the value of `default-directory'
+or passed as second argument to `expand-file-name'.
+For a Unix-syntax file name, just appends a slash.
+On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
+ (file)
Lisp_Object file;
{
char *buf;
Lisp_Object handler;
- CHECK_STRING (file, 0);
+ CHECK_STRING (file);
if (NILP (file))
return Qnil;
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
- buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10);
- return build_string (file_name_as_directory (buf, XSTRING (file)->data));
+ buf = (char *) alloca (SBYTES (file) + 10);
+ file_name_as_directory (buf, SDATA (file));
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (file));
}
\f
/*
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
- 1, 1, 0,
- "Returns the file name of the directory named DIRECTORY.\n\
-This is the name of the file that holds the data for the directory DIRECTORY.\n\
-This operation exists because a directory is also a file, but its name as\n\
-a directory is different from its name as a file.\n\
-In Unix-syntax, this function just removes the final slash.\n\
-On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
-it returns a file name such as \"[X]Y.DIR.1\".")
- (directory)
+ 1, 1, 0,
+ doc: /* Returns the file name of the directory named DIRECTORY.
+This is the name of the file that holds the data for the directory DIRECTORY.
+This operation exists because a directory is also a file, but its name as
+a directory is different from its name as a file.
+In Unix-syntax, this function just removes the final slash.
+On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
+it returns a file name such as \"[X]Y.DIR.1\". */)
+ (directory)
Lisp_Object directory;
{
char *buf;
Lisp_Object handler;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
if (NILP (directory))
return Qnil;
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);
+ buf = (char *) alloca (SBYTES (directory) + 20 + 255);
#else
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
+ buf = (char *) alloca (SBYTES (directory) + 20);
#endif
- directory_file_name (XSTRING (directory)->data, buf);
- return build_string (buf);
+ directory_file_name (SDATA (directory), buf);
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (directory));
}
static char make_temp_name_tbl[64] =
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
/* Value is a temporary file name starting with PREFIX, a string.
-
+
The Emacs process number forms part of the result, so there is
no danger of generating a name being used by another process.
In addition, this function makes an attempt to choose a name
which has no existing file. To make this work, PREFIX should be
an absolute file name.
-
+
BASE64_P non-zero means add the pid as 3 characters in base64
encoding. In this case, 6 characters will be added to PREFIX to
form the file name. Otherwise, if Emacs is running on a system
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
-
- CHECK_STRING (prefix, 0);
+
+ CHECK_STRING (prefix);
/* VAL is created by adding 6 characters to PREFIX. The first
three are the PID of this process, in base 64, and the second
pidlen = 3;
#endif
}
-
- len = XSTRING (prefix)->size;
+
+ len = SCHARS (prefix);
val = make_uninit_string (len + 3 + pidlen);
- data = XSTRING (val)->data;
- bcopy(XSTRING (prefix)->data, data, len);
+ data = SDATA (val);
+ bcopy(SDATA (prefix), data, len);
p = data + len;
bcopy (pidbuf, p, pidlen);
}
error ("Cannot create temporary name for prefix `%s'",
- XSTRING (prefix)->data);
+ SDATA (prefix));
return Qnil;
}
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
- "Generate temporary file name (string) starting with PREFIX (a string).\n\
-The Emacs process number forms part of the result,\n\
-so there is no danger of generating a name being used by another process.\n\
-\n\
-In addition, this function makes an attempt to choose a name\n\
-which has no existing file. To make this work,\n\
-PREFIX should be an absolute file name.\n\
-\n\
-There is a race condition between calling `make-temp-name' and creating the\n\
-file which opens all kinds of security holes. For that reason, you should\n\
-probably use `make-temp-file' instead.")
- (prefix)
+ doc: /* Generate temporary file name (string) starting with PREFIX (a string).
+The Emacs process number forms part of the result,
+so there is no danger of generating a name being used by another process.
+
+In addition, this function makes an attempt to choose a name
+which has no existing file. To make this work,
+PREFIX should be an absolute file name.
+
+There is a race condition between calling `make-temp-name' and creating the
+file which opens all kinds of security holes. For that reason, you should
+probably use `make-temp-file' instead, except in three circumstances:
+
+* If you are creating the file in the user's home directory.
+* If you are creating a directory rather than an ordinary file.
+* If you are taking special precautions as `make-temp-file' does. */)
+ (prefix)
Lisp_Object prefix;
{
return make_temp_name (prefix, 0);
\f
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
- "Convert filename NAME to absolute, and canonicalize it.\n\
-Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
- (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
-the current buffer's value of default-directory is used.\n\
-File name components that are `.' are removed, and \n\
-so are file name components followed by `..', along with the `..' itself;\n\
-note that these simplifications are done without checking the resulting\n\
-file names in the file system.\n\
-An initial `~/' expands to your home directory.\n\
-An initial `~USER/' expands to USER's home directory.\n\
-See also the function `substitute-in-file-name'.")
- (name, default_directory)
+ doc: /* Convert filename NAME to absolute, and canonicalize it.
+Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
+ (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
+the current buffer's value of default-directory is used.
+File name components that are `.' are removed, and
+so are file name components followed by `..', along with the `..' itself;
+note that these simplifications are done without checking the resulting
+file names in the file system.
+An initial `~/' expands to your home directory.
+An initial `~USER/' expands to USER's home directory.
+See also the function `substitute-in-file-name'. */)
+ (name, default_directory)
Lisp_Object name, default_directory;
{
unsigned char *nm;
int is_escaped = 0;
#endif /* DOS_NT */
int length;
- Lisp_Object handler;
+ Lisp_Object handler, result;
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (NILP (default_directory))
default_directory = current_buffer->directory;
if (! STRINGP (default_directory))
- default_directory = build_string ("/");
+ {
+#ifdef DOS_NT
+ /* "/" is not considered a root directory on DOS_NT, so using "/"
+ here causes an infinite recursion in, e.g., the following:
+
+ (let (default-directory)
+ (expand-file-name "a"))
+
+ To avoid this, we set default_directory to the root of the
+ current drive. */
+ extern char *emacs_root_dir (void);
+
+ default_directory = build_string (emacs_root_dir ());
+#else
+ default_directory = build_string ("/");
+#endif
+ }
if (!NILP (default_directory))
{
return call3 (handler, Qexpand_file_name, name, default_directory);
}
- o = XSTRING (default_directory)->data;
+ o = SDATA (default_directory);
/* Make sure DEFAULT_DIRECTORY is properly expanded.
It would be better to do this down below where we actually use
name = FILE_SYSTEM_CASE (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
&& IS_DIRECTORY_SEP (p[0])
&& IS_DIRECTORY_SEP (p[1]))
lose = 1;
-
+
#ifdef VMS
if (p[0] == '\\')
lose = 1;
{
#ifdef VMS
if (index (nm, '/'))
- return build_string (sys_translate_unix (nm));
+ {
+ nm = sys_translate_unix (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
+ }
#endif /* VMS */
#ifdef DOS_NT
/* Make sure directories are all separated with / or \ as
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
- if (strcmp (nm, XSTRING (name)->data) != 0)
- name = build_string (nm);
+ if (strcmp (nm, SDATA (name)) != 0)
+ name = make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
}
else
#endif
/* drive must be set, so this is okay */
- if (strcmp (nm - 2, XSTRING (name)->data) != 0)
+ if (strcmp (nm - 2, SDATA (name)) != 0)
{
- name = make_string (nm - 2, p - nm + 2);
- XSTRING (name)->data[0] = DRIVE_LETTER (drive);
- XSTRING (name)->data[1] = ':';
+ char temp[] = " :";
+
+ name = make_specified_string (nm, -1, p - nm,
+ STRING_MULTIBYTE (name));
+ temp[0] = DRIVE_LETTER (drive);
+ name = concat2 (build_string (temp), name);
}
return name;
#else /* not DOS_NT */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
#endif /* not DOS_NT */
}
}
#endif
&& !newdir)
{
- newdir = XSTRING (default_directory)->data;
+ newdir = SDATA (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
absolute directory in nm produces "//", which will then be
incorrectly treated as a network share. Ignore newdir in
this case (keeping the drive letter). */
- if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
+ if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
&& newdir[1] == '\0'))
#endif
strcpy (target, newdir);
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
- return make_string (target, o - target);
+ result = make_specified_string (target, -1, o - target,
+ STRING_MULTIBYTE (name));
+
+ /* Again look to see if the file name has special constructs in it
+ and perhaps call the corresponding file handler. This is needed
+ for filenames such as "/foo/../user@host:/bar/../baz". Expanding
+ the ".." component gives us "/user@host:/bar/../baz" which needs
+ to be expanded again. */
+ handler = Ffind_file_name_handler (result, Qexpand_file_name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, result, default_directory);
+
+ return result;
}
#if 0
+/* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
+ This is the old version of expand-file-name, before it was thoroughly
+ rewritten for Emacs 10.31. We leave this version here commented-out,
+ because the code is very complex and likely to have subtle bugs. If
+ bugs _are_ found, it might be of interest to look at the old code and
+ see what did it do in the relevant situation.
+
+ Don't remove this code: it's true that it will be accessible via CVS,
+ but a few years from deletion, people will forget it is there. */
+
/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert FILENAME to absolute, and canonicalize it.\n\
int dots = 0;
#endif /* VMS */
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif /* VMS */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
return build_string (nm);
}
{
if (NILP (defalt))
defalt = current_buffer->directory;
- CHECK_STRING (defalt, 1);
- newdir = XSTRING (defalt)->data;
+ CHECK_STRING (defalt);
+ newdir = SDATA (defalt);
}
/* Now concatenate the directory and name to new space in the stack frame */
#endif
\f
DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
- Ssubstitute_in_file_name, 1, 1, 0,
- "Substitute environment variables referred to in FILENAME.\n\
-`$FOO' where FOO is an environment variable name means to substitute\n\
-the value of that variable. The variable name should be terminated\n\
-with a character not a letter, digit or underscore; otherwise, enclose\n\
-the entire variable name in braces.\n\
-If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
-On VMS, `$' substitution is not done; this function does little and only\n\
-duplicates what `expand-file-name' does.")
- (filename)
+ Ssubstitute_in_file_name, 1, 1, 0,
+ doc: /* Substitute environment variables referred to in FILENAME.
+`$FOO' where FOO is an environment variable name means to substitute
+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 `/~' appears, all of FILENAME through that `/' is discarded.
+
+On VMS, `$' substitution is not done; this function does little and only
+duplicates what `expand-file-name' does. */)
+ (filename)
Lisp_Object filename;
{
unsigned char *nm;
int total = 0;
int substituted = 0;
unsigned char *xnm;
+ struct passwd *pw;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call2 (handler, Qsubstitute_in_file_name, filename);
- nm = XSTRING (filename)->data;
+ nm = SDATA (filename);
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
CORRECT_DIR_SEPS (nm);
- substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
+ substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
- endp = nm + STRING_BYTES (XSTRING (filename));
+ endp = nm + SBYTES (filename);
/* If /~ or // appears, discard everything through first slash. */
for (p = nm; p != endp; p++)
{
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
- /* // at start of file name is meaningful in Apollo and
- WindowsNT systems. */
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
+ /* // at start of file name is meaningful in Apollo,
+ WindowsNT and Cygwin systems. */
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != nm
&& (0
#endif /* VMS */
|| IS_DIRECTORY_SEP (p[-1])))
{
- nm = p;
- substituted = 1;
+ for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
+#ifdef VMS
+ && *s != ':'
+#endif /* VMS */
+ ); s++);
+ if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ {
+ o = (unsigned char *) alloca (s - p + 1);
+ bcopy ((char *) p, o, s - p);
+ o [s - p] = 0;
+
+ pw = (struct passwd *) getpwnam (o + 1);
+ }
+ /* If we have ~/ or ~user and `user' exists, discard
+ everything up to ~. But if `user' does not exist, leave
+ ~user alone, it might be a literal file name. */
+ if (IS_DIRECTORY_SEP (p[0]) || s == p + 1 || pw)
+ {
+ nm = p;
+ substituted = 1;
+ }
}
#ifdef DOS_NT
/* see comment in expand-file-name about drive specifiers */
}
#ifdef VMS
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (filename));
#else
/* See if any variables are substituted into the string
/* Get variable value */
o = (unsigned char *) egetenv (target);
- if (!o) goto badvar;
- total += strlen (o);
- substituted = 1;
+ if (o)
+ {
+ total += strlen (o);
+ substituted = 1;
+ }
+ else if (*p == '}')
+ goto badvar;
}
if (!substituted)
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);
+ xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
/* Get variable value */
o = (unsigned char *) egetenv (target);
if (!o)
- goto badvar;
-
- if (STRING_MULTIBYTE (filename))
+ {
+ *x++ = '$';
+ strcpy (x, target); x+= strlen (target);
+ }
+ else if (STRING_MULTIBYTE (filename))
{
/* If the original string is multibyte,
convert what we substitute into multibyte. */
for (p = xnm; p != x; p++)
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
xnm = p;
#endif
- if (STRING_MULTIBYTE (filename))
- return make_string (xnm, x - xnm);
- return make_unibyte_string (xnm, x - xnm);
+ return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
badsubst:
error ("Bad format environment-variable substitution");
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
- register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
+ register int c = SREF (absname, SBYTES (absname) - 1);
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
#else
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
- if (XSTRING (absname)->size > 1
- && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])
- && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2]))
+ if (SCHARS (absname) > 1
+ && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
#endif
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
+ if (stat (SDATA (encoded_filename), &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
GCPRO1 (absname);
- tem = format1 ("File %s already exists; %s anyway? ",
- XSTRING (absname)->data, querystring);
+ tem = format2 ("File %s already exists; %s anyway? ",
+ absname, build_string (querystring));
if (quick)
tem = Fy_or_n_p (tem);
else
}
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
- "fCopy file: \nFCopy %s to file: \np\nP",
- "Copy FILE to NEWNAME. Both args must be strings.\n\
-If NEWNAME names a directory, copy FILE there.\n\
-Signals a `file-already-exists' error if file NEWNAME already exists,\n\
-unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
-A number as third arg means request confirmation if NEWNAME already exists.\n\
-This is what happens in interactive use with M-x.\n\
-Fourth arg KEEP-TIME non-nil means give the new file the same\n\
-last-modified time as the old one. (This works on only some systems.)\n\
-A prefix arg makes KEEP-TIME non-nil.")
- (file, newname, ok_if_already_exists, keep_time)
+ "fCopy file: \nFCopy %s to file: \np\nP",
+ doc: /* Copy FILE to NEWNAME. Both args must be strings.
+If NEWNAME names a directory, copy FILE there.
+Signals a `file-already-exists' error if file NEWNAME already exists,
+unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
+A number as third arg means request confirmation if NEWNAME already exists.
+This is what happens in interactive use with M-x.
+Fourth arg KEEP-TIME non-nil means give the new file the same
+last-modified time as the old one. (This works on only some systems.)
+A prefix arg makes KEEP-TIME non-nil.
+Also set the file modes of the target file to match the source file. */)
+ (file, newname, ok_if_already_exists, keep_time)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
int ifd, ofd, n;
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
if (!NILP (Ffile_directory_p (newname)))
newname = Fexpand_file_name (file, newname);
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
- else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
+ else if (stat (SDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
- if (!CopyFile (XSTRING (encoded_file)->data,
- XSTRING (encoded_newname)->data,
+ if (!CopyFile (SDATA (encoded_file),
+ SDATA (encoded_newname),
FALSE))
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
+ /* CopyFile retains the timestamp by default. */
else if (NILP (keep_time))
{
EMACS_TIME now;
+ DWORD attributes;
+ char * filename;
+
EMACS_GET_TIME (now);
- if (set_file_times (XSTRING (encoded_newname)->data,
- now, now))
- Fsignal (Qfile_date_error,
- Fcons (build_string ("Cannot set file date"),
- Fcons (newname, Qnil)));
+ filename = SDATA (encoded_newname);
+
+ /* Ensure file is writable while its modified time is set. */
+ attributes = GetFileAttributes (filename);
+ SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
+ if (set_file_times (filename, now, now))
+ {
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
+ }
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
}
#else /* not WINDOWSNT */
- ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
+ immediate_quit = 1;
+ ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
+ immediate_quit = 0;
+
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
#ifdef VMS
/* Create the copy file with the same record format as the input file */
- ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd);
+ ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
#else
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);
+ ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
#else /* not MSDOS */
- ofd = creat (XSTRING (encoded_newname)->data, 0666);
+ ofd = creat (SDATA (encoded_newname), 0666);
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (XSTRING (encoded_newname)->data,
+ if (set_file_times (SDATA (encoded_newname),
atime, mtime))
Fsignal (Qfile_date_error,
Fcons (build_string ("Cannot set file date"),
Fcons (newname, Qnil)));
}
#ifndef MSDOS
- chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#else /* MSDOS */
#if defined (__DJGPP__) && __DJGPP__ > 1
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
get only the READ bit, which will make the copied file read-only,
so it's better not to chmod at all. */
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
- chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#endif /* DJGPP version 2 or newer */
#endif /* MSDOS */
}
\f
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
- "Create a new directory named DIRECTORY.")
- (directory)
+ doc: /* Create a new directory named DIRECTORY. */)
+ (directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
directory = Fexpand_file_name (directory, Qnil);
handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
- "Delete the directory named DIRECTORY.")
- (directory)
+ doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
+ (directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
handler = Ffind_file_name_handler (directory, Qdelete_directory);
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &directory));
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
- "Delete file named FILENAME.\n\
-If file has multiple names, it continues to exist with the other names.")
- (filename)
+ doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
+If file has multiple names, it continues to exist with the other names. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object handler;
Lisp_Object encoded_file;
+ struct gcpro gcpro1;
- CHECK_STRING (filename, 0);
+ GCPRO1 (filename);
+ if (!NILP (Ffile_directory_p (filename))
+ && NILP (Ffile_symlink_p (filename)))
+ Fsignal (Qfile_error,
+ Fcons (build_string ("Removing old name: is a directory"),
+ Fcons (filename, Qnil)));
+ UNGCPRO;
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qdelete_file);
encoded_file = ENCODE_FILE (filename);
- if (0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > unlink (SDATA (encoded_file)))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
}
}
\f
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
- "fRename file: \nFRename %s to file: \np",
- "Rename FILE as NEWNAME. Both args strings.\n\
-If file has names other than FILE, it continues to have those names.\n\
-Signals a `file-already-exists' error if a file NEWNAME already exists\n\
-unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
-A number as third arg means request confirmation if NEWNAME already exists.\n\
-This is what happens in interactive use with M-x.")
- (file, newname, ok_if_already_exists)
+ "fRename file: \nFRename %s to file: \np",
+ doc: /* Rename FILE as NEWNAME. Both args strings.
+If file has names other than FILE, it continues to have those names.
+Signals a `file-already-exists' error if a file NEWNAME already exists
+unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
+A number as third arg means request confirmation if NEWNAME already exists.
+This is what happens in interactive use with M-x. */)
+ (file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
barf_or_query_if_file_exists (encoded_newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
- if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
+ if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
#else
- if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)
- || 0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
+ || 0 > unlink (SDATA (encoded_file)))
#endif
{
if (errno == EXDEV)
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
- "fAdd name to file: \nFName to add to %s: \np",
- "Give FILE additional name NEWNAME. Both args strings.\n\
-Signals a `file-already-exists' error if a file NEWNAME already exists\n\
-unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
-A number as third arg means request confirmation if NEWNAME already exists.\n\
-This is what happens in interactive use with M-x.")
- (file, newname, ok_if_already_exists)
+ "fAdd name to file: \nFName to add to %s: \np",
+ doc: /* Give FILE additional name NEWNAME. Both args strings.
+Signals a `file-already-exists' error if a file NEWNAME already exists
+unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
+A number as third arg means request confirmation if NEWNAME already exists.
+This is what happens in interactive use with M-x. */)
+ (file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
GCPRO4 (file, newname, encoded_file, encoded_newname);
encoded_file = encoded_newname = Qnil;
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
barf_or_query_if_file_exists (encoded_newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
- unlink (XSTRING (newname)->data);
- if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
+ unlink (SDATA (newname));
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
{
#ifdef NO_ARG_ARRAY
args[0] = file;
#ifdef S_IFLNK
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
- "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
- "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
-Signals a `file-already-exists' error if a file LINKNAME already exists\n\
-unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
-A number as third arg means request confirmation if LINKNAME already exists.\n\
-This happens for interactive use with M-x.")
- (filename, linkname, ok_if_already_exists)
+ "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
+ doc: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
+Signals a `file-already-exists' error if a file LINKNAME already exists
+unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
+A number as third arg means request confirmation if LINKNAME already exists.
+This happens for interactive use with M-x. */)
+ (filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
encoded_filename = encoded_linkname = Qnil;
- CHECK_STRING (filename, 0);
- CHECK_STRING (linkname, 1);
+ CHECK_STRING (filename);
+ CHECK_STRING (linkname);
/* If the link target has a ~, we must expand it to get
a truly valid file name. Otherwise, do not expand;
we want to permit links to relative file names. */
- if (XSTRING (filename)->data[0] == '~')
+ if (SREF (filename, 0) == '~')
filename = Fexpand_file_name (filename, Qnil);
linkname = Fexpand_file_name (linkname, Qnil);
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > symlink (XSTRING (encoded_filename)->data,
- XSTRING (encoded_linkname)->data))
+ if (0 > symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (encoded_linkname)->data);
- if (0 <= symlink (XSTRING (encoded_filename)->data,
- XSTRING (encoded_linkname)->data))
+ unlink (SDATA (encoded_linkname));
+ if (0 <= symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
UNGCPRO;
return Qnil;
DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
- "Define the job-wide logical name NAME to have the value STRING.\n\
-If STRING is nil or a null string, the logical name NAME is deleted.")
- (name, string)
+ doc: /* Define the job-wide logical name NAME to have the value STRING.
+If STRING is nil or a null string, the logical name NAME is deleted. */)
+ (name, string)
Lisp_Object name;
Lisp_Object string;
{
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
if (NILP (string))
- delete_logical_name (XSTRING (name)->data);
+ delete_logical_name (SDATA (name));
else
{
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
- if (XSTRING (string)->size == 0)
- delete_logical_name (XSTRING (name)->data);
+ if (SCHARS (string) == 0)
+ delete_logical_name (SDATA (name));
else
- define_logical_name (XSTRING (name)->data, XSTRING (string)->data);
+ define_logical_name (SDATA (name), SDATA (string));
}
return string;
#ifdef HPUX_NET
DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
- "Open a network connection to PATH using LOGIN as the login string.")
+ doc: /* Open a network connection to PATH using LOGIN as the login string. */)
(path, login)
Lisp_Object path, login;
{
int netresult;
- CHECK_STRING (path, 0);
- CHECK_STRING (login, 0);
+ CHECK_STRING (path);
+ CHECK_STRING (login);
- netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
+ netresult = netunam (SDATA (path), SDATA (login));
if (netresult == -1)
return Qnil;
\f
DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1, 1, 0,
- "Return t if file FILENAME specifies an absolute file name.\n\
-On Unix, this is a name starting with a `/' or a `~'.")
+ doc: /* Return t if file FILENAME specifies an absolute file name.
+On Unix, this is a name starting with a `/' or a `~'. */)
(filename)
Lisp_Object filename;
{
- unsigned char *ptr;
+ const unsigned char *ptr;
- CHECK_STRING (filename, 0);
- ptr = XSTRING (filename)->data;
+ CHECK_STRING (filename);
+ ptr = SDATA (filename);
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
#ifdef VMS
/* ??? This criterion is probably wrong for '<'. */
}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
- "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
-See also `file-readable-p' and `file-attributes'.")
- (filename)
+ doc: /* Return t if file FILENAME exists. (This does not mean you can read it.)
+See also `file-readable-p' and `file-attributes'. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
absname = ENCODE_FILE (absname);
- return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;
+ return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
- "Return t if FILENAME can be executed by you.\n\
-For a directory, this means you can access files in that directory.")
- (filename)
- Lisp_Object filename;
-
+ doc: /* Return t if FILENAME can be executed by you.
+For a directory, this means you can access files in that directory. */)
+ (filename)
+ Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
absname = ENCODE_FILE (absname);
- return (check_executable (XSTRING (absname)->data) ? Qt : Qnil);
+ return (check_executable (SDATA (absname)) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
- "Return t if file FILENAME exists and you can read it.\n\
-See also `file-exists-p' and `file-attributes'.")
- (filename)
+ doc: /* Return t if file FILENAME exists and you can read it.
+See also `file-exists-p' and `file-attributes'. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object absname;
int flags;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
#if defined(DOS_NT) || defined(macintosh)
/* Under MS-DOS, Windows, and Macintosh, open does not work for
directories. */
- if (access (XSTRING (absname)->data, 0) == 0)
+ if (access (SDATA (absname), 0) == 0)
return Qt;
return Qnil;
#else /* not DOS_NT and not macintosh */
/* Opening a fifo without O_NONBLOCK can wait.
We don't want to wait. But we don't want to mess wth O_NONBLOCK
except in the case of a fifo, on a system which handles it. */
- desc = stat (XSTRING (absname)->data, &statbuf);
+ desc = stat (SDATA (absname), &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = emacs_open (XSTRING (absname)->data, flags, 0);
+ desc = emacs_open (SDATA (absname), flags, 0);
if (desc < 0)
return Qnil;
emacs_close (desc);
/* Having this before file-symlink-p mysteriously caused it to be forgotten
on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
- "Return t if file FILENAME can be written or created by you.")
- (filename)
+ doc: /* Return t if file FILENAME can be written or created by you. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object absname, dir, encoded;
Lisp_Object handler;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (stat (XSTRING (encoded)->data, &statbuf) >= 0)
- return (check_writable (XSTRING (encoded)->data)
+ if (stat (SDATA (encoded), &statbuf) >= 0)
+ return (check_writable (SDATA (encoded))
? Qt : Qnil);
dir = Ffile_name_directory (absname);
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- if (stat (XSTRING (dir)->data, &statbuf) < 0)
+ if (stat (SDATA (dir), &statbuf) < 0)
return Qnil;
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
+ return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
? Qt : Qnil);
#endif
}
\f
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
- "Access file FILENAME, and get an error if that does not work.\n\
-The second argument STRING is used in the error message.\n\
-If there is no error, we return nil.")
- (filename, string)
+ doc: /* Access file FILENAME, and get an error if that does not work.
+The second argument STRING is used in the error message.
+If there is no error, we return nil. */)
+ (filename, string)
Lisp_Object filename, string;
{
- Lisp_Object handler, encoded_filename;
+ Lisp_Object handler, encoded_filename, absname;
int fd;
- CHECK_STRING (filename, 0);
- CHECK_STRING (string, 1);
+ CHECK_STRING (filename);
+ absname = Fexpand_file_name (filename, Qnil);
+
+ CHECK_STRING (string);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename, Qaccess_file);
+ handler = Ffind_file_name_handler (absname, Qaccess_file);
if (!NILP (handler))
- return call3 (handler, Qaccess_file, filename, string);
+ return call3 (handler, Qaccess_file, absname, string);
- encoded_filename = ENCODE_FILE (filename);
+ encoded_filename = ENCODE_FILE (absname);
- fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
+ fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
if (fd < 0)
- report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
+ report_file_error (SDATA (string), Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
}
\f
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
- "Return non-nil if file FILENAME is the name of a symbolic link.\n\
-The value is the name of the file to which it is linked.\n\
-Otherwise returns nil.")
- (filename)
+ doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
+The value is the link target, as a string.
+Otherwise returns nil. */)
+ (filename)
Lisp_Object filename;
{
-#ifdef S_IFLNK
- char *buf;
- int bufsize;
- int valsize;
- Lisp_Object val;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
+#ifdef S_IFLNK
+ {
+ char *buf;
+ int bufsize;
+ int valsize;
+ Lisp_Object val;
+
filename = ENCODE_FILE (filename);
bufsize = 50;
bufsize *= 2;
buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
-
+
errno = 0;
- valsize = readlink (XSTRING (filename)->data, buf, bufsize);
+ valsize = readlink (SDATA (filename), buf, bufsize);
if (valsize == -1)
{
#ifdef ERANGE
}
}
while (valsize >= bufsize);
-
+
val = make_string (buf, valsize);
if (buf[0] == '/' && index (buf, ':'))
val = concat2 (build_string ("/:"), val);
xfree (buf);
val = DECODE_FILE (val);
return val;
+ }
#else /* not S_IFLNK */
return Qnil;
#endif /* not S_IFLNK */
}
DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
- "Return t if FILENAME names an existing directory.\n\
-Symbolic links to directories count as directories.\n\
-See `file-symlink-p' to distinguish symlinks.")
- (filename)
+ doc: /* Return t if FILENAME names an existing directory.
+Symbolic links to directories count as directories.
+See `file-symlink-p' to distinguish symlinks. */)
+ (filename)
Lisp_Object filename;
{
register Lisp_Object absname;
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
}
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
- "Return t if file FILENAME is the name of a directory as a file,\n\
-and files in that directory can be opened by you. In order to use a\n\
-directory as a buffer's current directory, this predicate must return true.\n\
-A directory name spec may be given instead; then the value is t\n\
-if the directory so specified exists and really is a readable and\n\
-searchable directory.")
- (filename)
+ doc: /* Return t if file 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. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object handler;
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- /* It's an unlikely combination, but yes we really do need to gcpro:
- Suppose that file-accessible-directory-p has no handler, but
- file-directory-p does have a handler; this handler causes a GC which
- relocates the string in `filename'; and finally file-directory-p
- returns non-nil. Then we would end up passing a garbaged string
- to file-executable-p. */
GCPRO1 (filename);
tem = (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)));
}
DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
- "Return t if file FILENAME is the name of a regular file.\n\
-This is the sort of file that holds an ordinary stream of data bytes.")
- (filename)
+ doc: /* Return t if file FILENAME is the name of a regular file.
+This is the sort of file that holds an ordinary stream of data bytes. */)
+ (filename)
Lisp_Object filename;
{
register Lisp_Object absname;
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- result = stat (XSTRING (absname)->data, &st);
+ result = stat (SDATA (absname), &st);
Vw32_get_true_file_attributes = tem;
if (result < 0)
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
}
#else
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
#endif
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
- "Return mode bits of file named FILENAME, as an integer.")
- (filename)
+ doc: /* Return mode bits of file named FILENAME, as an integer. */)
+ (filename)
Lisp_Object filename;
{
Lisp_Object absname;
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
- if (check_executable (XSTRING (absname)->data))
+ if (check_executable (SDATA (absname)))
st.st_mode |= S_IEXEC;
#endif /* MSDOS && __DJGPP__ < 2 */
}
DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
- "Set mode bits of file named FILENAME to MODE (an integer).\n\
-Only the 12 low bits of MODE are used.")
+ doc: /* Set mode bits of file named FILENAME to MODE (an integer).
+Only the 12 low bits of MODE are used. */)
(filename, mode)
Lisp_Object filename, mode;
{
Lisp_Object handler;
absname = Fexpand_file_name (filename, current_buffer->directory);
- CHECK_NUMBER (mode, 1);
+ CHECK_NUMBER (mode);
/* If the file name has special constructs in it,
call the corresponding file handler. */
encoded_absname = ENCODE_FILE (absname);
- if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0)
+ if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
}
DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
- "Set the file permission bits for newly created files.\n\
-The argument MODE should be an integer; only the low 9 bits are used.\n\
-This setting is inherited by subprocesses.")
- (mode)
+ doc: /* Set the file permission bits for newly created files.
+The argument MODE should be an integer; only the low 9 bits are used.
+This setting is inherited by subprocesses. */)
+ (mode)
Lisp_Object mode;
{
- CHECK_NUMBER (mode, 0);
+ CHECK_NUMBER (mode);
umask ((~ XINT (mode)) & 0777);
}
DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
- "Return the default file protection for created files.\n\
-The value is an integer.")
- ()
+ doc: /* Return the default file protection for created files.
+The value is an integer. */)
+ ()
{
int realmask;
Lisp_Object value;
#ifdef unix
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
- "Tell Unix to finish all pending disk updates.")
- ()
+ doc: /* Tell Unix to finish all pending disk updates. */)
+ ()
{
sync ();
return Qnil;
#endif /* unix */
DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
- "Return t if file FILE1 is newer than file FILE2.\n\
-If FILE1 does not exist, the answer is nil;\n\
-otherwise, if FILE2 does not exist, the answer is t.")
- (file1, file2)
+ doc: /* Return t if file FILE1 is newer than file FILE2.
+If FILE1 does not exist, the answer is nil;
+otherwise, if FILE2 does not exist, the answer is t. */)
+ (file1, file2)
Lisp_Object file1, file2;
{
Lisp_Object absname1, absname2;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
- CHECK_STRING (file1, 0);
- CHECK_STRING (file2, 0);
+ CHECK_STRING (file1);
+ CHECK_STRING (file2);
absname1 = Qnil;
GCPRO2 (absname1, file2);
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (XSTRING (absname1)->data, &st) < 0)
+ if (stat (SDATA (absname1), &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
- if (stat (XSTRING (absname2)->data, &st) < 0)
+ if (stat (SDATA (absname2), &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
read_non_regular ()
{
int nbytes;
-
+
immediate_quit = 1;
QUIT;
nbytes = emacs_read (non_regular_fd,
- BEG_ADDR + PT_BYTE - 1 + non_regular_inserted,
+ BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
non_regular_nbytes);
- Fsignal (Qquit, Qnil);
immediate_quit = 0;
return make_number (nbytes);
}
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
- 1, 5, 0,
- "Insert contents of file FILENAME after point.\n\
-Returns list of absolute file name and number of bytes inserted.\n\
-If second argument VISIT is non-nil, the buffer's visited filename\n\
-and last save file modtime are set, and it is marked unmodified.\n\
-If visiting and the file does not exist, visiting is completed\n\
-before the error is signaled.\n\
-The optional third and fourth arguments BEG and END\n\
-specify what portion of the file to insert.\n\
-These arguments count bytes in the file, not characters in the buffer.\n\
-If VISIT is non-nil, BEG and END must be nil.\n\
-\n\
-If optional fifth argument REPLACE is non-nil,\n\
-it means replace the current buffer contents (in the accessible portion)\n\
-with the file contents. This is better than simply deleting and inserting\n\
-the whole thing because (1) it preserves some marker positions\n\
-and (2) it puts less data in the undo list.\n\
-When REPLACE is non-nil, the value is the number of characters actually read,\n\
-which is often less than the number of characters to be read.\n\
-\n\
-This does code conversion according to the value of\n\
-`coding-system-for-read' or `file-coding-system-alist',\n\
-and sets the variable `last-coding-system-used' to the coding system\n\
-actually used.")
- (filename, visit, beg, end, replace)
+ 1, 5, 0,
+ doc: /* Insert contents of file FILENAME after point.
+Returns list of absolute file name and number of characters inserted.
+If second argument VISIT is non-nil, the buffer's visited filename
+and last save file modtime are set, and it is marked unmodified.
+If visiting and the file does not exist, visiting is completed
+before the error is signaled.
+The optional third and fourth arguments BEG and END
+specify what portion of the file to insert.
+These arguments count bytes in the file, not characters in the buffer.
+If VISIT is non-nil, BEG and END must be nil.
+
+If optional fifth argument REPLACE is non-nil,
+it means replace the current buffer contents (in the accessible portion)
+with the file contents. This is better than simply deleting and inserting
+the whole thing because (1) it preserves some marker positions
+and (2) it puts less data in the undo list.
+When REPLACE is non-nil, the value is the number of characters actually read,
+which is often less than the number of characters to be read.
+
+This does code conversion according to the value of
+`coding-system-for-read' or `file-coding-system-alist',
+and sets the variable `last-coding-system-used' to the coding system
+actually used. */)
+ (filename, visit, beg, end, replace)
Lisp_Object filename, visit, beg, end, replace;
{
struct stat st;
int inserted = 0;
register int how_much;
register int unprocessed;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
int replace_handled = 0;
int set_coding_system = 0;
int coding_system_decided = 0;
- int gap_size;
int read_quit = 0;
if (current_buffer->base_buffer && ! NILP (visit))
GCPRO4 (filename, val, p, orig_filename);
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (XSTRING (filename)->data, &st);
+ total = stat (SDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
if (total < 0)
#else
#ifndef APOLLO
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
#else
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
#endif /* WINDOWSNT */
#endif
if (fd < 0)
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
record_unwind_protect (close_file_unwind, make_number (fd));
/* Supposedly happens on VMS. */
+ /* Can happen on any platform that uses long as type of off_t, but allows
+ file sizes to exceed 2Gb. VMS is no longer officially supported, so
+ give a message suitable for the latter case. */
if (! not_regular && st.st_size < 0)
- error ("File size is negative");
+ error ("Maximum buffer size exceeded");
/* Prevent redisplay optimizations. */
current_buffer->clip_changed = 1;
}
if (!NILP (beg))
- CHECK_NUMBER (beg, 0);
+ CHECK_NUMBER (beg);
else
XSETFASTINT (beg, 0);
if (!NILP (end))
- CHECK_NUMBER (end, 0);
+ CHECK_NUMBER (end);
else
{
if (! not_regular)
}
}
- if (BEG < Z)
+ if (EQ (Vcoding_system_for_read, Qauto_save_coding))
+ {
+ /* We use emacs-mule for auto saving... */
+ setup_coding_system (Qemacs_mule, &coding);
+ /* ... but with the special flag to indicate to read in a
+ multibyte sequence for eight-bit-control char as is. */
+ coding.flags = 1;
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ coding.eol_type = CODING_EOL_LF;
+ coding_system_decided = 1;
+ }
+ else if (BEG < Z)
{
/* Decide the coding system to use for reading the file now
because we can't use an optimized method for handling
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread > 0)
{
struct buffer *prev = current_buffer;
- int count1;
+ Lisp_Object buffer;
+ struct buffer *buf;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- /* The call to temp_output_buffer_setup binds
- standard-output. */
- count1 = specpdl_ptr - specpdl;
- temp_output_buffer_setup (" *code-converting-work*");
-
- set_buffer_internal (XBUFFER (Vstandard_output));
- current_buffer->enable_multibyte_characters = Qnil;
+ buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
+ buf = XBUFFER (buffer);
+
+ delete_all_overlays (buf);
+ buf->directory = current_buffer->directory;
+ buf->read_only = Qnil;
+ buf->filename = Qnil;
+ buf->undo_list = Qt;
+ eassert (buf->overlays_before == NULL);
+ eassert (buf->overlays_after == NULL);
+
+ set_buffer_internal (buf);
+ Ferase_buffer ();
+ buf->enable_multibyte_characters = Qnil;
+
insert_1_both (read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
val = call2 (Vset_auto_coding_function,
filename, make_number (nread));
set_buffer_internal (prev);
- /* Remove the binding for standard-output. */
- unbind_to (count1, Qnil);
-
/* Discard the unwind protect for recovering the
current buffer. */
specpdl_ptr--;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
nread = emacs_read (fd, buffer + total_read, trial - total_read);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
total_read += nread;
}
-
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = total_read;
-
+
/* Compare with same_at_start to avoid counting some buffer text
as matching both at the file's beginning and at the end. */
while (bufpos > 0 && same_at_end > same_at_start
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
if (coding.cmp_data && coding.cmp_data->used)
coding_restore_composition (&coding, Fcurrent_buffer ());
coding_free_composition_data (&coding);
-
+
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
before exiting the loop, it is set to a negative value if I/O
error occurs. */
how_much = 0;
-
+
/* Total bytes inserted. */
inserted = 0;
-
+
/* Here, we don't do code conversion in the loop. It is done by
code_convert_region after all data are read into the buffer. */
{
int gap_size = GAP_SIZE;
-
+
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
here doesn't do any harm. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, BEG_ADDR + PT_BYTE - 1 + inserted, trytry);
+ this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
immediate_quit = 0;
}
-
+
if (this <= 0)
{
how_much = this;
if (how_much < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
notfound:
this way, we can run Lisp program safely before decoding
the inserted text. */
Lisp_Object unwind_data;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
inserted);
}
+ /* Now INSERTED is measured in characters. */
+
#ifdef DOS_NT
/* Use the conversion type to determine buffer-file-type
(find-buffer-file-type is now used to help determine the
conversion). */
- if ((coding.eol_type == CODING_EOL_UNDECIDED
+ if ((coding.eol_type == CODING_EOL_UNDECIDED
|| coding.eol_type == CODING_EOL_LF)
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
if (!EQ (current_buffer->undo_list, Qt))
current_buffer->undo_list = Qnil;
#ifdef APOLLO
- stat (XSTRING (filename)->data, &st);
+ stat (SDATA (filename), &st);
#endif
if (NILP (handler))
Fcons (orig_filename, Qnil)));
}
+ if (set_coding_system)
+ Vlast_coding_system_used = coding.symbol;
+
+ if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
+ {
+ insval = call1 (Qafter_insert_file_set_coding, make_number (inserted));
+ if (! NILP (insval))
+ {
+ CHECK_NUMBER (insval);
+ inserted = XFASTINT (insval);
+ }
+ }
+
/* Decode file format */
if (inserted > 0)
{
int empty_undo_list_p = 0;
-
+
/* If we're anyway going to discard undo information, don't
record it in the first place. The buffer's undo list at this
point is either nil or t when visiting a file. */
empty_undo_list_p = NILP (current_buffer->undo_list);
current_buffer->undo_list = Qt;
}
-
+
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
- CHECK_NUMBER (insval, 0);
+ CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
-
+
if (!NILP (visit))
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
- if (set_coding_system)
- Vlast_coding_system_used = coding.symbol;
-
/* Call after-change hooks for the inserted text, aside from the case
of normal visiting (not with REPLACE), which is done in a new buffer
"before" the buffer is changed. */
}
p = Vafter_insert_file_functions;
- while (!NILP (p))
+ while (CONSP (p))
{
- insval = call1 (Fcar (p), make_number (inserted));
+ insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval, 0);
+ CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
}
QUIT;
- p = Fcdr (p);
+ p = XCDR (p);
}
if (!NILP (visit)
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object));
+static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object));
/* If build_annotations switched buffers, switch back to BUF.
Kill the temporary buffer that was selected in the meantime.
return Qnil;
}
+/* Decide the coding-system to encode the data with. */
+
+void
+choose_write_coding_system (start, end, filename,
+ append, visit, lockname, coding)
+ Lisp_Object start, end, filename, append, visit, lockname;
+ struct coding_system *coding;
+{
+ Lisp_Object val;
+
+ if (auto_saving)
+ {
+ /* We use emacs-mule for auto saving... */
+ setup_coding_system (Qemacs_mule, coding);
+ /* ... but with the special flag to indicate not to strip off
+ leading code of eight-bit-control chars. */
+ coding->flags = 1;
+ goto done_setup_coding;
+ }
+ else if (!NILP (Vcoding_system_for_write))
+ {
+ val = Vcoding_system_for_write;
+ if (coding_system_require_warning
+ && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+ /* Confirm that VAL can surely encode the current region. */
+ val = call5 (Vselect_safe_coding_system_function,
+ start, end, Fcons (Qt, Fcons (val, Qnil)),
+ Qnil, filename);
+ }
+ else
+ {
+ /* If the variable `buffer-file-coding-system' is set locally,
+ it means that the file was read with some kind of code
+ conversion or the variable is explicitly set by users. We
+ had better write it out with the same coding system even if
+ `enable-multibyte-characters' is nil.
+
+ If it is not set locally, we anyway have to convert EOL
+ format if the default value of `buffer-file-coding-system'
+ tells that it is not Unix-like (LF only) format. */
+ int using_default_coding = 0;
+ int force_raw_text = 0;
+
+ val = current_buffer->buffer_file_coding_system;
+ if (NILP (val)
+ || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ {
+ val = Qnil;
+ if (NILP (current_buffer->enable_multibyte_characters))
+ force_raw_text = 1;
+ }
+
+ if (NILP (val))
+ {
+ /* Check file-coding-system-alist. */
+ Lisp_Object args[7], coding_systems;
+
+ args[0] = Qwrite_region; args[1] = start; args[2] = end;
+ args[3] = filename; args[4] = append; args[5] = visit;
+ args[6] = lockname;
+ coding_systems = Ffind_operation_coding_system (7, args);
+ if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
+ val = XCDR (coding_systems);
+ }
+
+ if (NILP (val)
+ && !NILP (current_buffer->buffer_file_coding_system))
+ {
+ /* If we still have not decided a coding system, use the
+ default value of buffer-file-coding-system. */
+ val = current_buffer->buffer_file_coding_system;
+ using_default_coding = 1;
+ }
+
+ if (!force_raw_text
+ && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+ /* Confirm that VAL can surely encode the current region. */
+ val = call5 (Vselect_safe_coding_system_function,
+ start, end, val, Qnil, filename);
+
+ setup_coding_system (Fcheck_coding_system (val), coding);
+ if (coding->eol_type == CODING_EOL_UNDECIDED
+ && !using_default_coding)
+ {
+ if (! EQ (default_buffer_file_coding.symbol,
+ buffer_defaults.buffer_file_coding_system))
+ setup_coding_system (buffer_defaults.buffer_file_coding_system,
+ &default_buffer_file_coding);
+ if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
+ {
+ Lisp_Object subsidiaries;
+
+ coding->eol_type = default_buffer_file_coding.eol_type;
+ subsidiaries = Fget (coding->symbol, Qeol_type);
+ if (VECTORP (subsidiaries)
+ && XVECTOR (subsidiaries)->size == 3)
+ coding->symbol
+ = XVECTOR (subsidiaries)->contents[coding->eol_type];
+ }
+ }
+
+ if (force_raw_text)
+ setup_raw_text_coding_system (coding);
+ goto done_setup_coding;
+ }
+
+ setup_coding_system (Fcheck_coding_system (val), coding);
+
+ done_setup_coding:
+ if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
+}
+
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
- "r\nFWrite region to file: \ni\ni\ni\np",
- "Write current region into specified file.\n\
-When called from a program, takes three arguments:\n\
-START, END and FILENAME. START and END are buffer positions.\n\
-Optional fourth argument APPEND if non-nil means\n\
- append to existing file contents (if any). If it is an integer,\n\
- seek to that offset in the file before writing.\n\
-Optional fifth argument VISIT if t means\n\
- set the last-save-file-modtime of buffer to this file's modtime\n\
- and mark buffer not modified.\n\
-If VISIT is a string, it is a second file name;\n\
- the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
- VISIT is also the file name to lock and unlock for clash detection.\n\
-If VISIT is neither t nor nil nor a string,\n\
- that means do not print the \"Wrote file\" message.\n\
-The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
- use for locking and unlocking, overriding FILENAME and VISIT.\n\
-The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
- for an existing file with the same name. If MUSTBENEW is `excl',\n\
- that means to get an error if the file already exists; never overwrite.\n\
- If MUSTBENEW is neither nil nor `excl', that means ask for\n\
- confirmation before overwriting, but do go ahead and overwrite the file\n\
- if the user confirms.\n\
-Kludgy feature: if START is a string, then that string is written\n\
-to the file, instead of any buffer contents, and END is ignored.\n\
-\n\
-This does code conversion according to the value of\n\
-`coding-system-for-write', `buffer-file-coding-system', or\n\
-`file-coding-system-alist', and sets the variable\n\
-`last-coding-system-used' to the coding system actually used.")
-
- (start, end, filename, append, visit, lockname, mustbenew)
+ "r\nFWrite region to file: \ni\ni\ni\np",
+ doc: /* Write current region into specified file.
+When called from a program, requires three arguments:
+START, END and FILENAME. START and END are normally buffer positions
+specifying the part of the buffer to write.
+If START is nil, that means to use the entire buffer contents.
+If START is a string, then output that string to the file
+instead of any buffer contents; END is ignored.
+
+Optional fourth argument APPEND if non-nil means
+ append to existing file contents (if any). If it is an integer,
+ seek to that offset in the file before writing.
+Optional fifth argument VISIT if t means
+ set the last-save-file-modtime of buffer to this file's modtime
+ and mark buffer not modified.
+If VISIT is a string, it is a second file name;
+ the output goes to FILENAME, but the buffer is marked as visiting VISIT.
+ VISIT is also the file name to lock and unlock for clash detection.
+If VISIT is neither t nor nil nor a string,
+ that means do not display the \"Wrote file\" message.
+The optional sixth arg LOCKNAME, if non-nil, specifies the name to
+ use for locking and unlocking, overriding FILENAME and VISIT.
+The optional seventh arg MUSTBENEW, if non-nil, insists on a check
+ for an existing file with the same name. If MUSTBENEW is `excl',
+ that means to get an error if the file already exists; never overwrite.
+ If MUSTBENEW is neither nil nor `excl', that means ask for
+ confirmation before overwriting, but do go ahead and overwrite the file
+ if the user confirms.
+
+This does code conversion according to the value of
+`coding-system-for-write', `buffer-file-coding-system', or
+`file-coding-system-alist', and sets the variable
+`last-coding-system-used' to the coding system actually used. */)
+ (start, end, filename, append, visit, lockname, mustbenew)
Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
register int desc;
int failure;
int save_errno = 0;
- unsigned char *fn;
+ const unsigned char *fn;
struct stat st;
int tem;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int count1;
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
- GCPRO4 (start, filename, visit, lockname);
-
- /* Decide the coding-system to encode the data with. */
- {
- Lisp_Object val;
-
- if (auto_saving)
- val = Qnil;
- else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else
- {
- /* If the variable `buffer-file-coding-system' is set locally,
- it means that the file was read with some kind of code
- conversion or the variable is explicitly set by users. We
- had better write it out with the same coding system even if
- `enable-multibyte-characters' is nil.
-
- If it is not set locally, we anyway have to convert EOL
- format if the default value of `buffer-file-coding-system'
- tells that it is not Unix-like (LF only) format. */
- int using_default_coding = 0;
- int force_raw_text = 0;
-
- val = current_buffer->buffer_file_coding_system;
- if (NILP (val)
- || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
- {
- val = Qnil;
- if (NILP (current_buffer->enable_multibyte_characters))
- force_raw_text = 1;
- }
-
- if (NILP (val))
- {
- /* Check file-coding-system-alist. */
- Lisp_Object args[7], coding_systems;
-
- args[0] = Qwrite_region; args[1] = start; args[2] = end;
- args[3] = filename; args[4] = append; args[5] = visit;
- args[6] = lockname;
- coding_systems = Ffind_operation_coding_system (7, args);
- if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
- val = XCDR (coding_systems);
- }
-
- if (NILP (val)
- && !NILP (current_buffer->buffer_file_coding_system))
- {
- /* If we still have not decided a coding system, use the
- default value of buffer-file-coding-system. */
- val = current_buffer->buffer_file_coding_system;
- using_default_coding = 1;
- }
-
- if (!force_raw_text
- && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
- /* Confirm that VAL can surely encode the current region. */
- val = call3 (Vselect_safe_coding_system_function, start, end, val);
-
- setup_coding_system (Fcheck_coding_system (val), &coding);
- if (coding.eol_type == CODING_EOL_UNDECIDED
- && !using_default_coding)
- {
- if (! EQ (default_buffer_file_coding.symbol,
- buffer_defaults.buffer_file_coding_system))
- setup_coding_system (buffer_defaults.buffer_file_coding_system,
- &default_buffer_file_coding);
- if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
- {
- Lisp_Object subsidiaries;
-
- coding.eol_type = default_buffer_file_coding.eol_type;
- subsidiaries = Fget (coding.symbol, Qeol_type);
- if (VECTORP (subsidiaries)
- && XVECTOR (subsidiaries)->size == 3)
- coding.symbol
- = XVECTOR (subsidiaries)->contents[coding.eol_type];
- }
- }
-
- if (force_raw_text)
- setup_raw_text_coding_system (&coding);
- goto done_setup_coding;
- }
-
- setup_coding_system (Fcheck_coding_system (val), &coding);
-
- done_setup_coding:
- if (!STRINGP (start) && !NILP (current_buffer->selective_display))
- coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
- }
-
- Vlast_coding_system_used = coding.symbol;
+ GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
- if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+ if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
visit_file = filename;
- UNGCPRO;
-
- annotations = Qnil;
if (NILP (lockname))
lockname = visit_file;
- GCPRO5 (start, filename, annotations, visit_file, lockname);
+ annotations = Qnil;
/* If the file name has special constructs in it,
call the corresponding file handler. */
return val;
}
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
XSETFASTINT (start, BEG);
XSETFASTINT (end, Z);
+ Fwiden ();
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
- count1 = specpdl_ptr - specpdl;
+ count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
- annotations = build_annotations (start, end, coding.pre_write_conversion);
- if (current_buffer != given_buffer)
+
+ if (!STRINGP (start))
{
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
+ annotations = build_annotations (start, end);
+
+ if (current_buffer != given_buffer)
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
+ }
+
+ UNGCPRO;
+
+ GCPRO5 (start, filename, annotations, visit_file, lockname);
+
+ /* Decide the coding-system to encode the data with.
+ We used to make this choice before calling build_annotations, but that
+ leads to problems when a write-annotate-function takes care of
+ unsavable chars (as was the case with X-Symbol). */
+ choose_write_coding_system (start, end, filename,
+ append, visit, lockname, &coding);
+ Vlast_coding_system_used = coding.symbol;
+
+ given_buffer = current_buffer;
+ if (! STRINGP (start))
+ {
+ annotations = build_annotations_2 (start, end,
+ coding.pre_write_conversion, annotations);
+ if (current_buffer != given_buffer)
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
}
#ifdef CLASH_DETECTION
encoded_filename = ENCODE_FILE (filename);
- fn = XSTRING (encoded_filename)->data;
+ fn = SDATA (encoded_filename);
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
- ? XSTRING (current_buffer->filename)->data : 0,
+ ? SDATA (current_buffer->filename) : 0,
fn);
}
else /* Write to temporary name and rename if no errors */
{
temp_name = Fmake_temp_name (concat2 (temp_name,
build_string ("$$SAVE$$")));
- fname = XSTRING (filename)->data;
- fn = XSTRING (temp_name)->data;
+ fname = SDATA (filename);
+ fn = SDATA (temp_name);
desc = creat_copy_attrs (fname, fn);
if (desc < 0)
{
if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
{
long ret;
-
+
if (NUMBERP (append))
ret = lseek (desc, XINT (append), 1);
else
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
}
-
+
UNGCPRO;
#ifdef VMS
if (STRINGP (start))
{
- failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,
+ failure = 0 > a_write (desc, start, 0, SCHARS (start),
&annotations, &coding);
save_errno = errno;
}
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s", XSTRING (filename)->data,
+ error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
if (visiting)
return Qnil;
if (!auto_saving)
- message_with_string ("Wrote %s", visit_file, 1);
+ message_with_string ((INTEGERP (append)
+ ? "Updated %s"
+ : ! NILP (append)
+ ? "Added to %s"
+ : "Wrote %s"),
+ visit_file, 1);
return Qnil;
}
Lisp_Object merge ();
DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
- "Return t if (car A) is numerically less than (car B).")
- (a, b)
+ doc: /* Return t if (car A) is numerically less than (car B). */)
+ (a, b)
Lisp_Object a, b;
{
return Flss (Fcar (a), Fcar (b));
as save-excursion would do. */
static Lisp_Object
-build_annotations (start, end, pre_write_conversion)
- Lisp_Object start, end, pre_write_conversion;
+build_annotations (start, end)
+ Lisp_Object start, end;
{
Lisp_Object annotations;
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
- int i;
+ int i, used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
- while (!NILP (p))
+ while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
+ if (EQ (Qt, XCAR (p)) && !used_global)
+ { /* Use the global value of the hook. */
+ Lisp_Object arg[2];
+ used_global = 1;
+ arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
+ arg[1] = XCDR (p);
+ p = Fappend (2, arg);
+ continue;
+ }
Vwrite_region_annotations_so_far = annotations;
- res = call2 (Fcar (p), start, end);
+ res = call2 (XCAR (p), start, end);
/* If the function makes a different buffer current,
assume that means this buffer contains altered text to be output.
Reset START and END from the buffer bounds
}
Flength (res); /* Check basic validity of return value */
annotations = merge (annotations, res, Qcar_less_than_car);
- p = Fcdr (p);
+ p = XCDR (p);
}
/* Now do the same for annotation functions implied by the file-format */
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
- for (i = 0; !NILP (p); p = Fcdr (p), ++i)
+ for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
-
+
Vwrite_region_annotations_so_far = annotations;
/* Value is either a list of annotations or nil if the function
has written annotations to a temporary buffer, which is now
current. */
- res = call5 (Qformat_annotate_function, Fcar (p), start, end,
+ res = call5 (Qformat_annotate_function, XCAR (p), start, end,
original_buffer, make_number (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (end, ZV);
annotations = Qnil;
}
-
+
if (CONSP (res))
annotations = merge (annotations, res, Qcar_less_than_car);
}
+ UNGCPRO;
+ return annotations;
+}
+
+static Lisp_Object
+build_annotations_2 (start, end, pre_write_conversion, annotations)
+ Lisp_Object start, end, pre_write_conversion, annotations;
+{
+ struct gcpro gcpro1;
+ Lisp_Object res;
+
+ GCPRO1 (annotations);
/* At last, do the same for the function PRE_WRITE_CONVERSION
implied by the current coding-system. */
if (!NILP (pre_write_conversion))
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))
+ if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
return -1;
}
*annot = Fcdr (*annot);
if (STRINGP (string))
{
- addr = XSTRING (string)->data;
- nbytes = STRING_BYTES (XSTRING (string));
+ addr = SDATA (string);
+ nbytes = SBYTES (string);
coding->src_multibyte = STRING_MULTIBYTE (string);
}
else if (start < end)
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
- Sverify_visited_file_modtime, 1, 1, 0,
- "Return t if last mod time of BUF's visited file matches what BUF records.\n\
-This means that the file has not been changed since it was visited or saved.")
- (buf)
+ Sverify_visited_file_modtime, 1, 1, 0,
+ doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
+This means that the file has not been changed since it was visited or saved. */)
+ (buf)
Lisp_Object buf;
{
struct buffer *b;
Lisp_Object handler;
Lisp_Object filename;
- CHECK_BUFFER (buf, 0);
+ CHECK_BUFFER (buf);
b = XBUFFER (buf);
if (!STRINGP (b->filename)) return Qt;
filename = ENCODE_FILE (b->filename);
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
}
DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
- Sclear_visited_file_modtime, 0, 0, 0,
- "Clear out records of last mod time of visited file.\n\
-Next attempt to save will certainly not complain of a discrepancy.")
- ()
+ Sclear_visited_file_modtime, 0, 0, 0,
+ doc: /* Clear out records of last mod time of visited file.
+Next attempt to save will certainly not complain of a discrepancy. */)
+ ()
{
current_buffer->modtime = 0;
return Qnil;
}
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
- Svisited_file_modtime, 0, 0, 0,
- "Return the current buffer's recorded visited file modification time.\n\
-The value is a list of the form (HIGH . LOW), like the time values\n\
-that `file-attributes' returns.")
- ()
+ Svisited_file_modtime, 0, 0, 0,
+ doc: /* Return the current buffer's recorded visited file modification time.
+The value is a list of the form (HIGH . LOW), like the time values
+that `file-attributes' returns. */)
+ ()
{
return long_to_cons ((unsigned long) current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
- Sset_visited_file_modtime, 0, 1, 0,
- "Update buffer's recorded modification time from the visited file's time.\n\
-Useful if the buffer was not read from the file normally\n\
-or if the file itself has been changed for some known benign reason.\n\
-An argument specifies the modification time value to use\n\
-\(instead of that of the visited file), in the form of a list\n\
-\(HIGH . LOW) or (HIGH LOW).")
- (time_list)
+ Sset_visited_file_modtime, 0, 1, 0,
+ doc: /* Update buffer's recorded modification time from the visited file's time.
+Useful if the buffer was not read from the file normally
+or if the file itself has been changed for some known benign reason.
+An argument specifies the modification time value to use
+\(instead of that of the visited file), in the form of a list
+\(HIGH . LOW) or (HIGH LOW). */)
+ (time_list)
Lisp_Object time_list;
{
if (!NILP (time_list))
filename = ENCODE_FILE (filename);
- if (stat (XSTRING (filename)->data, &st) >= 0)
+ if (stat (SDATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
Lisp_Object args[3], msg;
int i, nbytes;
struct gcpro gcpro1;
-
+
ring_bell ();
-
+
args[0] = build_string ("Auto-saving %s: %s");
args[1] = current_buffer->name;
args[2] = Ferror_message_string (error);
msg = Fformat (3, args);
GCPRO1 (msg);
- nbytes = STRING_BYTES (XSTRING (msg));
+ nbytes = SBYTES (msg);
for (i = 0; i < 3; ++i)
{
if (i == 0)
- message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
else
- message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
/* Get visited file's mode to become the auto save file's mode. */
if (! NILP (current_buffer->filename)
- && stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
+ && stat (SDATA (current_buffer->filename), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else
if (!NILP (stream))
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
| XFASTINT (XCDR (stream))));
- pop_message ();
return Qnil;
}
return Qnil;
}
+static Lisp_Object
+do_auto_save_make_dir (dir)
+ Lisp_Object dir;
+{
+ return call2 (Qmake_directory, dir, Qt);
+}
+
+static Lisp_Object
+do_auto_save_eh (ignore)
+ Lisp_Object ignore;
+{
+ return Qnil;
+}
+
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
- "Auto-save all buffers that need it.\n\
-This is all buffers that have auto-saving enabled\n\
-and are changed since last auto-saved.\n\
-Auto-saving writes the buffer into a file\n\
-so that your editing is not lost if the system crashes.\n\
-This file is not the file you visited; that changes only when you save.\n\
-Normally we run the normal hook `auto-save-hook' before saving.\n\n\
-A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
-A non-nil CURRENT-ONLY argument means save only current buffer.")
- (no_message, current_only)
+ doc: /* Auto-save all buffers that need it.
+This is all buffers that have auto-saving enabled
+and are changed since last auto-saved.
+Auto-saving writes the buffer into a file
+so that your editing is not lost if the system crashes.
+This file is not the file you visited; that changes only when you save.
+Normally we run the normal hook `auto-save-hook' before saving.
+
+A non-nil NO-MESSAGE argument means do not print any message if successful.
+A non-nil CURRENT-ONLY argument means save only current buffer. */)
+ (no_message, current_only)
Lisp_Object no_message, current_only;
{
struct buffer *old = current_buffer, *b;
Lisp_Object oquit;
FILE *stream;
Lisp_Object lispstream;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
- int message_p = push_message ();
-
+ int old_message_p = 0;
+ struct gcpro gcpro1, gcpro2;
+
+ if (max_specpdl_size < specpdl_size + 40)
+ max_specpdl_size = specpdl_size + 40;
+
+ if (minibuf_level)
+ no_message = Qt;
+
+ if (NILP (no_message))
+ {
+ old_message_p = push_message ();
+ record_unwind_protect (pop_message_unwind, Qnil);
+ }
+
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
oquit = Vquit_flag;
/* No GCPRO needed, because (when it matters) all Lisp_Object variables
point to non-strings reached from Vbuffer_alist. */
- if (minibuf_level)
- no_message = Qt;
-
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
if (STRINGP (Vauto_save_list_file_name))
{
Lisp_Object listfile;
-
+
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
/* Don't try to create the directory when shutting down Emacs,
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
+ dir = Qnil;
+ GCPRO2 (dir, listfile);
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
- call2 (Qmake_directory, dir, Qt);
+ internal_condition_case_1 (do_auto_save_make_dir,
+ dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
+ do_auto_save_eh);
+ UNGCPRO;
}
-
- stream = fopen (XSTRING (listfile)->data, "w");
+
+ stream = fopen (SDATA (listfile), "w");
if (stream != NULL)
{
/* Arrange to close that file whether or not we get an error.
{
if (!NILP (b->filename))
{
- fwrite (XSTRING (b->filename)->data, 1,
- STRING_BYTES (XSTRING (b->filename)), stream);
+ fwrite (SDATA (b->filename), 1,
+ SBYTES (b->filename), stream);
}
putc ('\n', stream);
- fwrite (XSTRING (b->auto_save_file_name)->data, 1,
- STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
+ fwrite (SDATA (b->auto_save_file_name), 1,
+ SBYTES (b->auto_save_file_name), stream);
putc ('\n', stream);
}
{
/* It has shrunk too much; turn off auto-saving here. */
minibuffer_auto_raise = orig_minibuffer_auto_raise;
- message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
+ message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
b->name, 1);
minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
if (auto_saved && NILP (no_message))
{
- if (message_p)
+ if (old_message_p)
{
+ /* If we are going to restore an old message,
+ give time to read ours. */
sit_for (1, 0, 0, 0, 0);
restore_message ();
}
else
+ /* If we displayed a message and then restored a state
+ with no message, leave a "done" message on the screen. */
message1 ("Auto-saving...done");
}
Vquit_flag = oquit;
+ /* This restores the message-stack status. */
unbind_to (count, Qnil);
return Qnil;
}
DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
- Sset_buffer_auto_saved, 0, 0, 0,
- "Mark current buffer as auto-saved with its current text.\n\
-No auto-save file will be written until the buffer changes again.")
- ()
+ Sset_buffer_auto_saved, 0, 0, 0,
+ doc: /* Mark current buffer as auto-saved with its current text.
+No auto-save file will be written until the buffer changes again. */)
+ ()
{
current_buffer->auto_save_modified = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
}
DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
- Sclear_buffer_auto_save_failure, 0, 0, 0,
- "Clear any record of a recent auto-save failure in the current buffer.")
- ()
+ Sclear_buffer_auto_save_failure, 0, 0, 0,
+ doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
+ ()
{
current_buffer->auto_save_failure_time = -1;
return Qnil;
}
DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
- 0, 0, 0,
- "Return t if buffer has been auto-saved since last read in or saved.")
- ()
+ 0, 0, 0,
+ doc: /* Return t if buffer has been auto-saved since last read in or saved. */)
+ ()
{
return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
}
double_dollars (val)
Lisp_Object val;
{
- register unsigned char *old, *new;
+ register const unsigned char *old;
+ register unsigned char *new;
register int n;
int osize, count;
- osize = STRING_BYTES (XSTRING (val));
+ osize = SBYTES (val);
/* Count the number of $ characters. */
- for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
+ for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
- old = XSTRING (val)->data;
- val = make_uninit_multibyte_string (XSTRING (val)->size + count,
+ old = SDATA (val);
+ val = make_uninit_multibyte_string (SCHARS (val) + count,
osize + count);
- new = XSTRING (val)->data;
+ new = SDATA (val);
for (n = osize; n > 0; n--)
if (*old != '$')
*new++ = *old++;
return val;
}
+static Lisp_Object
+read_file_name_cleanup (arg)
+ Lisp_Object arg;
+{
+ return (current_buffer->directory = arg);
+}
+
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
- 3, 3, 0,
- "Internal subroutine for read-file-name. Do not call this.")
- (string, dir, action)
+ 3, 3, 0,
+ doc: /* Internal subroutine for read-file-name. Do not call this. */)
+ (string, dir, action)
Lisp_Object string, dir, action;
/* action is nil for complete, t for return list of completions,
lambda for verify final value */
int changed;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
realdir = dir;
name = string;
/* No need to protect ACTION--we only compare it with t and nil. */
GCPRO5 (string, realdir, name, specdir, orig_string);
- if (XSTRING (string)->size == 0)
+ if (SCHARS (string) == 0)
{
if (EQ (action, Qlambda))
{
UNGCPRO;
if (EQ (action, Qt))
- return Ffile_name_all_completions (name, realdir);
+ {
+ Lisp_Object all = Ffile_name_all_completions (name, realdir);
+ Lisp_Object comp;
+ int count;
+
+ if (NILP (Vread_file_name_predicate)
+ || EQ (Vread_file_name_predicate, Qfile_exists_p))
+ return all;
+
+#ifndef VMS
+ if (EQ (Vread_file_name_predicate, Qfile_directory_p))
+ {
+ /* Brute-force speed up for directory checking:
+ Discard strings which don't end in a slash. */
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ {
+ Lisp_Object tem = XCAR (all);
+ int len;
+ if (STRINGP (tem) &&
+ (len = SCHARS (tem), len > 0) &&
+ IS_DIRECTORY_SEP (SREF (tem, len-1)))
+ comp = Fcons (tem, comp);
+ }
+ }
+ else
+#endif
+ {
+ /* Must do it the hard (and slow) way. */
+ GCPRO3 (all, comp, specdir);
+ count = SPECPDL_INDEX ();
+ record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
+ current_buffer->directory = realdir;
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ if (!NILP (call1 (Vread_file_name_predicate, XCAR (all))))
+ comp = Fcons (XCAR (all), comp);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+ }
+ return Fnreverse (comp);
+ }
+
/* Only other case actually used is ACTION = lambda */
#ifdef VMS
/* Supposedly this helps commands such as `cd' that read directory names,
but can someone explain how it helps them? -- RMS */
- if (XSTRING (name)->size == 0)
+ if (SCHARS (name) == 0)
return Qt;
#endif /* VMS */
+ if (!NILP (Vread_file_name_predicate))
+ return call1 (Vread_file_name_predicate, string);
return Ffile_exists_p (string);
}
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
- "Read file name, prompting with PROMPT and completing in directory DIR.\n\
-Value is not expanded---you must call `expand-file-name' yourself.\n\
-Default name to DEFAULT-FILENAME if user enters a null string.\n\
- (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
- except that if INITIAL is specified, that combined with DIR is used.)\n\
-Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
- Non-nil and non-t means also require confirmation after completion.\n\
-Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.\n\
-\n\
-If this command was invoked with the mouse, use a file dialog box if\n\
-`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
-provides a file dialog box..")
- (prompt, dir, default_filename, mustmatch, initial)
- Lisp_Object prompt, dir, default_filename, mustmatch, initial;
+DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
+ doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-FILENAME if user enters a null string.
+ (If DEFAULT-FILENAME is omitted, the visited file name is used,
+ except that if INITIAL is specified, that combined with DIR is used.)
+Fourth arg MUSTMATCH non-nil means require existing file's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+If optional sixth arg PREDICATE is non-nil, possible completions and the
+resulting file name must satisfy (funcall PREDICATE NAME).
+DIR defaults to current buffer's directory default.
+
+If this command was invoked with the mouse, use a file dialog box if
+`use-dialog-box' is non-nil, and the window system or X toolkit in use
+provides a file dialog box. */)
+ (prompt, dir, default_filename, mustmatch, initial, predicate)
+ Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
+ Lisp_Object decoded_homedir;
int replace_in_history = 0;
int add_to_history = 0;
int count;
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (default_filename))
- {
- if (! NILP (initial))
- default_filename = Fexpand_file_name (initial, dir);
- else
- default_filename = current_buffer->filename;
- }
+ default_filename = !NILP (initial)
+ ? Fexpand_file_name (initial, dir)
+ : current_buffer->filename;
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
CORRECT_DIR_SEPS (homedir);
}
#endif
+ if (homedir != 0)
+ decoded_homedir
+ = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
if (homedir != 0
&& STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
+ && !strncmp (SDATA (decoded_homedir), SDATA (dir),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
+ dir = concat2 (build_string ("~"), dir);
}
/* Likewise for default_filename. */
if (homedir != 0
&& STRINGP (default_filename)
- && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+ && !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
{
default_filename
- = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
- XSTRING (default_filename)->data[0] = '~';
+ = Fsubstring (default_filename,
+ make_number (SCHARS (decoded_homedir)), Qnil);
+ default_filename = concat2 (build_string ("~"), default_filename);
}
if (!NILP (default_filename))
{
- CHECK_STRING (default_filename, 3);
+ CHECK_STRING (default_filename);
default_filename = double_dollars (default_filename);
}
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- pos = make_number (XSTRING (double_dollars (dir))->size);
+ pos = make_number (SCHARS (double_dollars (dir)));
insdef = Fcons (double_dollars (insdef), pos);
}
else
else
insdef = Qnil;
- count = specpdl_ptr - specpdl;
+ if (!NILP (Vread_file_name_function))
+ {
+ Lisp_Object args[7];
+
+ GCPRO2 (insdef, default_filename);
+ args[0] = Vread_file_name_function;
+ args[1] = prompt;
+ args[2] = dir;
+ args[3] = default_filename;
+ args[4] = mustmatch;
+ args[5] = initial;
+ args[6] = predicate;
+ RETURN_UNGCPRO (Ffuncall (7, args));
+ }
+
+ count = SPECPDL_INDEX ();
#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
specbind (intern ("minibuffer-completing-file-name"), Qt);
+ specbind (intern ("read-file-name-predicate"),
+ (NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
-
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
+
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
+ && use_file_dialog
&& have_menus_p ())
{
/* If DIR contains a file name, split it. */
Lisp_Object file;
file = Ffile_name_nondirectory (dir);
- if (XSTRING (file)->size && NILP (default_filename))
+ if (SCHARS (file) && NILP (default_filename))
{
default_filename = file;
dir = Ffile_name_directory (dir);
if (! replace_in_history)
add_to_history = 1;
- val = build_string ("");
+ val = empty_string;
}
unbind_to (count, Qnil);
if (!NILP (tem) && !NILP (default_filename))
val = default_filename;
- else if (XSTRING (val)->size == 0 && NILP (insdef))
+ else if (SCHARS (val) == 0 && NILP (insdef))
{
if (!NILP (default_filename))
val = default_filename;
Fset (Qfile_name_history,
Fcons (val1, tem));
}
-
+
return val;
}
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
+ Qauto_save_coding = intern ("auto-save-coding");
staticpro (&Qexpand_file_name);
staticpro (&Qsubstitute_in_file_name);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
staticpro (&Qset_visited_file_modtime);
+ staticpro (&Qauto_save_coding);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, Qnil);
#endif /* DOS_NT */
DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
- "*Coding system for encoding file names.\n\
-If it is nil, default-file-name-coding-system (which see) is used.");
+ doc: /* *Coding system for encoding file names.
+If it is nil, `default-file-name-coding-system' (which see) is used. */);
Vfile_name_coding_system = Qnil;
DEFVAR_LISP ("default-file-name-coding-system",
&Vdefault_file_name_coding_system,
- "Default coding system for encoding file names.\n\
-This variable is used only when file-name-coding-system is nil.\n\
-\n\
-This variable is set/changed by the command set-language-environment.\n\
-User should not set this variable manually,\n\
-instead use file-name-coding-system to get a constant encoding\n\
-of file names regardless of the current language environment.");
+ doc: /* Default coding system for encoding file names.
+This variable is used only when `file-name-coding-system' is nil.
+
+This variable is set/changed by the command `set-language-environment'.
+User should not set this variable manually,
+instead use `file-name-coding-system' to get a constant encoding
+of file names regardless of the current language environment. */);
Vdefault_file_name_coding_system = Qnil;
DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format,
- "*Format in which to write auto-save files.\n\
-Should be a list of symbols naming formats that are defined in `format-alist'.\n\
-If it is t, which is the default, auto-save files are written in the\n\
-same format as a regular save would use.");
+ doc: /* *Format in which to write auto-save files.
+Should be a list of symbols naming formats that are defined in `format-alist'.
+If it is t, which is the default, auto-save files are written in the
+same format as a regular save would use. */);
Vauto_save_file_format = Qt;
Qformat_decode = intern ("format-decode");
staticpro (&Qformat_decode);
Qformat_annotate_function = intern ("format-annotate-function");
staticpro (&Qformat_annotate_function);
-
+ Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
+ staticpro (&Qafter_insert_file_set_coding);
+
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
+ DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
+ doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
+ Vread_file_name_function = Qnil;
+
+ DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
+ doc: /* Current predicate used by `read-file-name-internal'. */);
+ Vread_file_name_predicate = Qnil;
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
- "*Non-nil means when reading a filename start with default dir in minibuffer.");
+ doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
insert_default_directory = 1;
DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
- "*Non-nil means write new files with record format `stmlf'.\n\
-nil means use format `var'. This variable is meaningful only on VMS.");
+ doc: /* *Non-nil means write new files with record format `stmlf'.
+nil means use format `var'. This variable is meaningful only on VMS. */);
vms_stmlf_recfm = 0;
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
- "Directory separator character for built-in functions that return file names.\n\
-The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
-This variable affects the built-in functions only on Windows,\n\
-on other platforms, it is initialized so that Lisp code can find out\n\
-what the normal separator is.\n\
-\n\
-WARNING: This variable is deprecated and will be removed in the near\n\
-future. DO NOT USE IT.");
+ doc: /* Directory separator character for built-in functions that return file names.
+The value is always ?/. Don't use this variable, just use `/'. */);
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
- "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
-If a file name matches REGEXP, then all I/O on that file is done by calling\n\
-HANDLER.\n\
-\n\
-The first argument given to HANDLER is the name of the I/O primitive\n\
-to be handled; the remaining arguments are the arguments that were\n\
-passed to that primitive. For example, if you do\n\
- (file-exists-p FILENAME)\n\
-and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
- (funcall HANDLER 'file-exists-p FILENAME)\n\
-The function `find-file-name-handler' checks this list for a handler\n\
-for its argument.");
+ doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
+If a file name matches REGEXP, then all I/O on that file is done by calling
+HANDLER.
+
+The first argument given to HANDLER is the name of the I/O primitive
+to be handled; the remaining arguments are the arguments that were
+passed to that primitive. For example, if you do
+ (file-exists-p FILENAME)
+and FILENAME is handled by HANDLER, then HANDLER is called like this:
+ (funcall HANDLER 'file-exists-p FILENAME)
+The function `find-file-name-handler' checks this list for a handler
+for its argument. */);
Vfile_name_handler_alist = Qnil;
DEFVAR_LISP ("set-auto-coding-function",
&Vset_auto_coding_function,
- "If non-nil, a function to call to decide a coding system of file.\n\
-Two arguments are passed to this function: the file name\n\
-and the length of a file contents following the point.\n\
-This function should return a coding system to decode the file contents.\n\
-It should check the file name against `auto-coding-alist'.\n\
-If no coding system is decided, it should check a coding system\n\
-specified in the heading lines with the format:\n\
- -*- ... coding: CODING-SYSTEM; ... -*-\n\
-or local variable spec of the tailing lines with `coding:' tag.");
+ doc: /* If non-nil, a function to call to decide a coding system of file.
+Two arguments are passed to this function: the file name
+and the length of a file contents following the point.
+This function should return a coding system to decode the file contents.
+It should check the file name against `auto-coding-alist'.
+If no coding system is decided, it should check a coding system
+specified in the heading lines with the format:
+ -*- ... coding: CODING-SYSTEM; ... -*-
+or local variable spec of the tailing lines with `coding:' tag. */);
Vset_auto_coding_function = Qnil;
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
- "A list of functions to be called at the end of `insert-file-contents'.\n\
-Each is passed one argument, the number of bytes inserted. It should return\n\
-the new byte count, and leave point the same. If `insert-file-contents' is\n\
-intercepted by a handler from `file-name-handler-alist', that handler is\n\
-responsible for calling the after-insert-file-functions if appropriate.");
+ doc: /* A list of functions to be called at the end of `insert-file-contents'.
+Each is passed one argument, the number of characters inserted.
+It should return the new character count, and leave point the same.
+If `insert-file-contents' is intercepted by a handler from
+`file-name-handler-alist', that handler is responsible for calling the
+functions in `after-insert-file-functions' if appropriate. */);
Vafter_insert_file_functions = Qnil;
DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
- "A list of functions to be called at the start of `write-region'.\n\
-Each is passed two arguments, START and END as for `write-region'.\n\
-These are usually two numbers but not always; see the documentation\n\
-for `write-region'. The function should return a list of pairs\n\
-of the form (POSITION . STRING), consisting of strings to be effectively\n\
-inserted at the specified positions of the file being written (1 means to\n\
-insert before the first byte written). The POSITIONs must be sorted into\n\
-increasing order. If there are several functions in the list, the several\n\
-lists are merged destructively.");
+ doc: /* A list of functions to be called at the start of `write-region'.
+Each is passed two arguments, START and END as for `write-region'.
+These are usually two numbers but not always; see the documentation
+for `write-region'. The function should return a list of pairs
+of the form (POSITION . STRING), consisting of strings to be effectively
+inserted at the specified positions of the file being written (1 means to
+insert before the first byte written). The POSITIONs must be sorted into
+increasing order. If there are several functions in the list, the several
+lists are merged destructively. Alternatively, the function can return
+with a different buffer current; in that case it should pay attention
+to the annotations returned by previous functions and listed in
+`write-region-annotations-so-far'.*/);
Vwrite_region_annotate_functions = Qnil;
+ staticpro (&Qwrite_region_annotate_functions);
+ Qwrite_region_annotate_functions
+ = intern ("write-region-annotate-functions");
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
- "When an annotation function is called, this holds the previous annotations.\n\
-These are the annotations made by other annotation functions\n\
-that were already called. See also `write-region-annotate-functions'.");
+ doc: /* When an annotation function is called, this holds the previous annotations.
+These are the annotations made by other annotation functions
+that were already called. See also `write-region-annotate-functions'. */);
Vwrite_region_annotations_so_far = Qnil;
DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
- "A list of file name handlers that temporarily should not be used.\n\
-This applies only to the operation `inhibit-file-name-operation'.");
+ doc: /* A list of file name handlers that temporarily should not be used.
+This applies only to the operation `inhibit-file-name-operation'. */);
Vinhibit_file_name_handlers = Qnil;
DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
- "The operation for which `inhibit-file-name-handlers' is applicable.");
+ doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
Vinhibit_file_name_operation = Qnil;
DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
- "File name in which we write a list of all auto save file names.\n\
-This variable is initialized automatically from `auto-save-list-file-prefix'\n\
-shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
-a non-nil value.");
+ doc: /* File name in which we write a list of all auto save file names.
+This variable is initialized automatically from `auto-save-list-file-prefix'
+shortly after Emacs reads your `.emacs' file, if you have not yet given it
+a non-nil value. */);
Vauto_save_list_file_name = Qnil;
defsubr (&Sfind_file_name_handler);
#endif
}
+/* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff