Commit 32f4334d authored by Richard M. Stallman's avatar Richard M. Stallman

*** empty log message ***

parent e59a8453
......@@ -64,6 +64,10 @@ extern struct direct *readdir ();
Lisp_Object Vcompletion_ignored_extensions;
Lisp_Object Qcompletion_ignore_case;
Lisp_Object Qdirectory_files;
Lisp_Object Qfile_name_completion;
Lisp_Object Qfile_name_all_completions;
DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
"Return a list of names of files in DIRECTORY.\n\
......@@ -78,6 +82,23 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
DIR *d;
int length;
Lisp_Object list, name;
Lisp_Object handler;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
{
Lisp_Object args[6];
args[0] = handler;
args[1] = Qdirectory_files;
args[2] = dirname;
args[3] = full;
args[4] = match;
args[5] = nosort;
return Ffuncall (6, args);
}
if (!NILP (match))
{
......@@ -158,6 +179,7 @@ Returns nil if DIR contains no name starting with FILE.")
(file, dirname)
Lisp_Object file, dirname;
{
Lisp_Object handler;
/* Don't waste time trying to complete a null string.
Besides, this case happens when user is being asked for
a directory name and has supplied one ending in a /.
......@@ -165,6 +187,13 @@ Returns nil if DIR contains no name starting with FILE.")
even if there are some unique characters in that directory. */
if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
return file;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qfile_name_completion, file, dirname);
return file_name_completion (file, dirname, 0, 0);
}
......@@ -175,6 +204,14 @@ These are all file names in directory DIR which begin with FILE.")
(file, dirname)
Lisp_Object file, dirname;
{
Lisp_Object handler;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qfile_name_all_completions, file, dirname);
return file_name_completion (file, dirname, 1, 0);
}
......@@ -409,8 +446,16 @@ If file does not exists, returns nil.")
struct stat s;
struct stat sdir;
char modes[10];
Lisp_Object handler;
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_attributes, filename);
if (lstat (XSTRING (filename)->data, &s) < 0)
return Qnil;
......@@ -457,6 +502,10 @@ If file does not exists, returns nil.")
syms_of_dired ()
{
Qdirectory_files = intern ("directory-files");
Qfile_name_completion = intern ("file-name-completion");
Qfile_name_all_completions = intern ("file-name-all-completions");
defsubr (&Sdirectory_files);
defsubr (&Sfile_name_completion);
#ifdef VMS
......
......@@ -87,6 +87,10 @@ int auto_saving;
a new file with the same mode as the original */
int auto_save_mode_bits;
/* Alist of elements (REGEXP . HANDLER) for file names
whose I/O is done with a special handler. */
Lisp_Object Vfile_name_handler_alist;
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
......@@ -124,6 +128,52 @@ close_file_unwind (fd)
close (XFASTINT (fd));
}
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
Lisp_Object Qadd_name_to_file;
Lisp_Object Qmake_symbolic_link;
Lisp_Object Qfile_exists_p;
Lisp_Object Qfile_executable_p;
Lisp_Object Qfile_readable_p;
Lisp_Object Qfile_symlink_p;
Lisp_Object Qfile_writable_p;
Lisp_Object Qfile_directory_p;
Lisp_Object Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
Lisp_Object Qverify_visited_file_modtime;
/* If FILENAME is handled specially on account of its syntax,
return its handler function. Otherwise, return nil. */
Lisp_Object
find_file_handler (filename)
Lisp_Object filename;
{
Lisp_Object chain;
for (chain = Vfile_handler_alist; XTYPE (chain) == Lisp_Cons;
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
elt = XCONS (chain)->car;
if (XTYPE (elt) == Lisp_Cons)
{
Lisp_Object string;
string = XCONS (elt)->car;
if (XTYPE (string) == Lisp_String
&& fast_string_match (string, filename))
return XCONS (elt)->cdr;
}
}
return Qnil;
}
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
"Return the directory component in file name NAME.\n\
......@@ -1383,6 +1433,7 @@ A prefix arg makes KEEP-TIME non-nil.")
int ifd, ofd, n;
char buf[16 * 1024];
struct stat st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
int count = specpdl_ptr - specpdl;
......@@ -1391,6 +1442,13 @@ A prefix arg makes KEEP-TIME non-nil.")
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qcopy_file, filename, newname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "copy to it",
......@@ -1452,15 +1510,21 @@ DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake director
Lisp_Object dirname;
{
unsigned char *dir;
Lisp_Object handler;
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
handler = find_file_handler (dirname);
if (!NILP (handler))
return call2 (handler, Qmake_directory, dirname);
dir = XSTRING (dirname)->data;
if (mkdir (dir, 0777) != 0)
report_file_error ("Creating directory", Flist (1, &dirname));
return Qnil;
return Qnil;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
......@@ -1469,11 +1533,16 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete
Lisp_Object dirname;
{
unsigned char *dir;
Lisp_Object handler;
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
dir = XSTRING (dirname)->data;
handler = find_file_handler (dirname);
if (!NILP (handler))
return call2 (handler, Qdelete_directory, dirname);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &dirname));
......@@ -1486,8 +1555,14 @@ If file has multiple names, it continues to exist with the other names.")
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
if (0 > unlink (XSTRING (filename)->data))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
......@@ -1507,6 +1582,7 @@ This is what happens in interactive use with M-x.")
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, newname);
......@@ -1514,6 +1590,13 @@ This is what happens in interactive use with M-x.")
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qrename_file, filename, newname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "rename to it",
......@@ -1558,6 +1641,7 @@ This is what happens in interactive use with M-x.")
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, newname);
......@@ -1565,6 +1649,13 @@ This is what happens in interactive use with M-x.")
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qadd_name_to_file, filename, newname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "make it a new name",
......@@ -1599,6 +1690,7 @@ This happens for interactive use with M-x.")
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, linkname);
......@@ -1608,6 +1700,13 @@ This happens for interactive use with M-x.")
filename = Fexpand_file_name (filename, Qnil);
#endif
linkname = Fexpand_file_name (linkname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qmake_symbolic_link, filename, newname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (linkname, "make it a link",
......@@ -1714,9 +1813,17 @@ See also `file-readable-p' and `file-attributes'.")
Lisp_Object filename;
{
Lisp_Object abspath;
Lisp_Object handler;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, filename);
return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
}
......@@ -1728,9 +1835,17 @@ For directories this means you can change to that directory.")
{
Lisp_Object abspath;
Lisp_Object handler;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, filename);
return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
}
......@@ -1741,9 +1856,17 @@ See also `file-exists-p' and `file-attributes'.")
Lisp_Object filename;
{
Lisp_Object abspath;
Lisp_Object handler;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, filename);
return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
}
......@@ -1759,10 +1882,17 @@ Otherwise returns NIL.")
int bufsize;
int valsize;
Lisp_Object val;
Lisp_Object handler;
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
bufsize = 100;
while (1)
{
......@@ -1795,9 +1925,17 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
Lisp_Object filename;
{
Lisp_Object abspath, dir;
Lisp_Object handler;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, filename);
if (access (XSTRING (abspath)->data, 0) >= 0)
return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
dir = Ffile_name_directory (abspath);
......@@ -1818,9 +1956,16 @@ if the directory so specified exists and really is a directory.")
{
register Lisp_Object abspath;
struct stat st;
Lisp_Object handler;
abspath = expand_and_dir_to_file (filename, current_buffer->directory);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, filename);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
......@@ -1836,6 +1981,14 @@ searchable directory.")
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
if (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)))
return Qnil;
......@@ -1850,9 +2003,16 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
{
Lisp_Object abspath;
struct stat st;
Lisp_Object handler;
abspath = expand_and_dir_to_file (filename, current_buffer->directory);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_modes, filename);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
return make_number (st.st_mode & 07777);
......@@ -1865,10 +2025,17 @@ Only the 12 low bits of MODE are used.")
Lisp_Object filename, mode;
{
Lisp_Object abspath;
Lisp_Object handler;
abspath = Fexpand_file_name (filename, current_buffer->directory);
CHECK_NUMBER (mode, 1);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, filename, mode);
#ifndef APOLLO
if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (abspath, Qnil));
......@@ -1953,23 +2120,29 @@ otherwise, if FILE2 does not exist, the answer is t.")
(file1, file2)
Lisp_Object file1, file2;
{
Lisp_Object abspath;
Lisp_Object abspath1, abspath2;
struct stat st;
int mtime1;
Lisp_Object handler;
CHECK_STRING (file1, 0);
CHECK_STRING (file2, 0);
abspath = expand_and_dir_to_file (file1, current_buffer->directory);
abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
if (stat (XSTRING (abspath)->data, &st) < 0)
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (abspath1);
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
if (stat (XSTRING (abspath1)->data, &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
abspath = expand_and_dir_to_file (file2, current_buffer->directory);
if (stat (XSTRING (abspath)->data, &st) < 0)
if (stat (XSTRING (abspath2)->data, &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
......@@ -1992,7 +2165,10 @@ before the error is signaled.")
register int how_much;
int count = specpdl_ptr - specpdl;
struct gcpro gcpro1;
Lisp_Object handler, val;
val = Qnil;
GCPRO1 (filename);
if (!NILP (current_buffer->read_only))
Fbarf_if_buffer_read_only();
......@@ -2000,6 +2176,16 @@ before the error is signaled.")
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
{
val = call3 (handler, Qinsert_file_contents, filename, visit);
st.st_mtime = 0;
goto handled;
}
fd = -1;
#ifndef APOLLO
......@@ -2088,6 +2274,7 @@ before the error is signaled.")
XSTRING (filename)->data, err_str (errno));
notfound:
handled:
if (!NILP (visit))
{
......@@ -2100,18 +2287,23 @@ before the error is signaled.")
current_buffer->auto_save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
#ifdef CLASH_DETECTION
if (!NILP (current_buffer->filename))
unlock_file (current_buffer->filename);
unlock_file (filename);
if (NILP (handler))
{
if (!NILP (current_buffer->filename))
unlock_file (current_buffer->filename);
unlock_file (filename);
}
#endif /* CLASH_DETECTION */
current_buffer->filename = filename;
/* If visiting nonexistent file, return nil. */
if (st.st_mtime == -1)
if (current_buffer->modtime == -1)
report_file_error ("Opening input file", Fcons (filename, Qnil));
}
signal_after_change (point, 0, inserted);
if (!NILP (val))
RETURN_UNGCPRO (val);
RETURN_UNGCPRO (Fcons (filename,
Fcons (make_number (inserted),
Qnil)));
......@@ -2157,6 +2349,35 @@ to the file, instead of any buffer contents, and END is ignored.")
filename = Fexpand_file_name (filename, Qnil);
fn = XSTRING (filename)->data;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
{
Lisp_Object args[7];
Lisp_Object val;
args[0] = handler;
args[1] = Qwrite_region;
args[2] = start;
args[3] = end;
args[4] = filename;
args[5] = append;
args[6] = visit;
val = Ffuncall (7, args);
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
next attempt to save. */
if (EQ (visit, Qt))
{
current_buffer->modtime = 0;
current_buffer->save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
current_buffer->filename = filename;
}
return val;
}
#ifdef CLASH_DETECTION
if (!auto_saving)
lock_file (filename);
......@@ -2410,6 +2631,7 @@ This means that the file has not been changed since it was visited or saved.")
{
struct buffer *b;
struct stat st;
Lisp_Object handler;
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
......@@ -2417,6 +2639,12 @@ This means that the file has not been changed since it was visited or saved.")
if (XTYPE (b->filename) != Lisp_String) return Qt;
if (b->modtime == 0) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, filename);
if (stat (XSTRING (b->filename)->data, &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
......@@ -2456,8 +2684,14 @@ or if the file itself has been changed for some known benign reason.")
struct stat st;
filename = Fexpand_file_name (current_buffer->filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
current_buffer->modtime = 0;
if (stat (XSTRING (filename)->data, &st) >= 0)
else if (stat (XSTRING (filename)->data, &st) >= 0)
current_buffer->modtime = st.st_mtime;
return Qnil;
......@@ -2831,6 +3065,27 @@ DIR defaults to current buffer's directory default.")
syms_of_fileio ()
{
Qcopy_file = intern ("copy-file");
Qmake_directory = intern ("make-directory");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
Qadd_name_to_file = intern ("add-name-to-file");
Qmake_symbolic_link = intern ("make-symbolic-link");
Qfile_exists_p = intern ("file-exists-p");
Qfile_executable_p = intern ("file-executable-p");
Qfile_readable_p = intern ("file-readable-p");
Qfile_symlink_p = intern ("file-symlink-p");
Qfile_writable_p = intern ("file-writable-p");
Qfile_directory_p = intern ("file-directory-p");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
Qinsert_file_contents = intern (