else
inhibited_handlers = Qnil;
- for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
+ for (chain = Vfile_name_handler_alist; CONSP (chain);
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
elt = XCONS (chain)->car;
- if (XTYPE (elt) == Lisp_Cons)
+ if (CONSP (elt))
{
Lisp_Object string;
string = XCONS (elt)->car;
- if (XTYPE (string) == Lisp_String
- && fast_string_match (string, filename) >= 0)
+ if (STRINGP (string) && fast_string_match (string, filename) >= 0)
{
Lisp_Object handler, tem;
return abspath;
}
\f
+void
barf_or_query_if_file_exists (absname, querystring, interactive)
Lisp_Object absname;
unsigned char *querystring;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
int count = specpdl_ptr - specpdl;
- Lisp_Object args[6];
int input_file_statable_p;
GCPRO2 (filename, newname);
ok_if_already_exists, keep_date));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
ifd = open (XSTRING (filename)->data, O_RDONLY);
if (ifd < 0)
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
+ if (set_file_times (XSTRING (newname)->data, atime, mtime))
+ report_file_error ("I/O error", Fcons (newname, Qnil));
}
#ifdef APOLLO
if (!egetenv ("USE_DOMAIN_ACLS"))
filename, newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
#ifndef BSD4_1
if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
#else
newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "make it a new name",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
unlink (XSTRING (newname)->data);
if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
{
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 NEWNAME already exists\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 NEWNAME already exists.\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)
Lisp_Object filename, linkname, ok_if_already_exists;
linkname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
{
/* If we didn't complain already, silently delete existing file. */
else
return Qnil;
}
+\f
+/* Return nonzero if file FILENAME exists and can be executed. */
+
+static int
+check_executable (filename)
+ char *filename;
+{
+#ifdef __HURD__
+ mach_port_t file;
+ int access_mode;
+
+ file = path_lookup (filename, 0, 0);
+ if (file == MACH_PORT_NULL)
+ /* File can't be opened. */
+ access_mode = 0;
+ else
+ {
+ file_access (file, &access_mode);
+ mach_port_deallocate (mach_task_self (), file);
+ }
+ return !!(access_mode & O_EXEC);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it. */
+ return (access (filename, 1) >= 0);
+#endif
+}
+
+/* Return nonzero if file FILENAME exists and can be written. */
+
+static int
+check_writable (filename)
+ char *filename;
+{
+#ifdef __HURD__
+ mach_port_t file;
+ int access_mode;
+
+ file = path_lookup (filename, 0, 0);
+ if (file == MACH_PORT_NULL)
+ /* File can't be opened. */
+ access_mode = 0;
+ else
+ {
+ file_access (file, &access_mode);
+ mach_port_deallocate (mach_task_self (), file);
+ }
+ return !!(access_mode & O_WRITE);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it.
+ Opening with O_WRONLY could work for an ordinary file,
+ but would lose for directories. */
+ return (access (filename, 2) >= 0);
+#endif
+}
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\
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, abspath);
- return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
+ return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
#endif /* not S_IFLNK */
}
-#ifdef SOLARIS_BROKEN_ACCESS
-/* In Solaris 2.1, the readonly-ness of the filesystem is not
- considered by the access system call. This is Sun's bug, but we
- still have to make Emacs work. */
-
-#include <sys/statvfs.h>
-
-static int
-ro_fsys (path)
- char *path;
-{
- struct statvfs statvfsb;
-
- if (statvfs(path, &statvfsb))
- return 1; /* error from statvfs, be conservative and say not wrtable */
- else
- /* Otherwise, fsys is ro if bit is set. */
- return statvfsb.f_flag & ST_RDONLY;
-}
-#else
-/* But on every other os, access has already done the right thing. */
-#define ro_fsys(path) 0
-#endif
-
/* 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,
{
Lisp_Object abspath, dir;
Lisp_Object handler;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, abspath);
- if (access (XSTRING (abspath)->data, 0) >= 0)
- return ((access (XSTRING (abspath)->data, 2) >= 0
- && ! ro_fsys ((char *) XSTRING (abspath)->data))
+ if (stat (XSTRING (abspath)->data, &statbuf) >= 0)
+ return (check_writable (XSTRING (abspath)->data)
? Qt : Qnil);
dir = Ffile_name_directory (abspath);
#ifdef VMS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif /* MSDOS */
- return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
- && ! ro_fsys ((char *) XSTRING (dir)->data))
+ return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
}
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- /* Need to gcpro in case the first function call has a handler that
- causes filename to be relocated. */
+ /* 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)));
/* Determine file type from name and remove LFs from CR-LFs if the file
is deemed to be a text file. */
{
- struct gcpro gcpro1;
- Lisp_Object code;
- code = Qnil;
- GCPRO1 (filename);
current_buffer->buffer_file_type
= call1 (Qfind_buffer_file_type, filename);
- UNGCPRO;
if (NILP (current_buffer->buffer_file_type))
{
int reduced_size
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qwrite_region);
/* If FILENAME has no handler, see if VISIT has one. */
- if (NILP (handler) && XTYPE (visit) == Lisp_String)
+ if (NILP (handler) && STRINGP (visit))
handler = Ffind_file_name_handler (visit, Qwrite_region);
if (!NILP (handler))
/* Discard the unwind protect for close_file_unwind. */
specpdl_ptr = specpdl + count1;
/* Restore the original current buffer. */
- GCPRO1 (visit_file);
- unbind_to (count);
- UNGCPRO;
+ visit_file = unbind_to (count, visit_file);
#ifdef CLASH_DETECTION
if (!auto_saving)
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
- if (XTYPE (b->filename) != Lisp_String) return Qt;
+ if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
/* If the file name has special constructs in it,
/* Record all the buffers that have auto save mode
in the special file that lists them. */
- if (XTYPE (b->auto_save_file_name) == Lisp_String
+ if (STRINGP (b->auto_save_file_name)
&& listdesc >= 0 && do_handled_files == 0)
{
write (listdesc, XSTRING (b->auto_save_file_name)->data,
/* Check for auto save enabled
and file changed since last auto save
and file changed since last real save. */
- if (XTYPE (b->auto_save_file_name) == Lisp_String
+ if (STRINGP (b->auto_save_file_name)
&& b->save_modified < BUF_MODIFF (b)
&& b->auto_save_modified < BUF_MODIFF (b)
/* -1 means we've turned off autosaving for a while--see below. */
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir);
UNGCPRO;
- if (XTYPE (val) != Lisp_String)
+ if (!STRINGP (val))
{
if (changed)
return double_dollars (string);
"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 if user enters a null string.\n\
- (If DEFAULT is omitted, the visited file name is used.)\n\
+ (If DEFAULT 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\
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (defalt))
- defalt = current_buffer->filename;
+ {
+ if (! NILP (initial))
+ defalt = Fexpand_file_name (initial, dir);
+ else
+ defalt = current_buffer->filename;
+ }
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& XSTRING (dir)->data[strlen (homedir)] == '/')
{
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& XSTRING (dir)->data[strlen (homedir)] == '/')
{
HCoop / bpt / emacs.git / blobdiff