#include <perror.h>
#include <stddef.h>
#include <string.h>
-#else
-#include <sys/dir.h>
#endif
#include <errno.h>
#endif
#include "lisp.h"
+#include "intervals.h"
#include "buffer.h"
#include "window.h"
Lisp_Object Qfile_error, Qfile_already_exists;
+Lisp_Object Qfile_name_history;
+
report_file_error (string, data)
char *string;
Lisp_Object data;
close (XFASTINT (fd));
}
\f
+Lisp_Object Qexpand_file_name;
+Lisp_Object Qdirectory_file_name;
+Lisp_Object Qfile_name_directory;
+Lisp_Object Qfile_name_nondirectory;
+Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory;
Lisp_Object Qdelete_directory;
Lisp_Object filename;
{
Lisp_Object chain;
- for (chain = Vfile_handler_alist; XTYPE (chain) == Lisp_Cons;
+ for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
Lisp_Object string;
string = XCONS (elt)->car;
if (XTYPE (string) == Lisp_String
- && fast_string_match (string, filename))
+ && fast_string_match (string, filename) >= 0)
return XCONS (elt)->cdr;
}
}
{
register unsigned char *beg;
register unsigned char *p;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = find_file_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_directory, file);
+
beg = XSTRING (file)->data;
p = beg + XSTRING (file)->size;
Lisp_Object file;
{
register unsigned char *beg, *p, *end;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = find_file_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_nondirectory, file);
+
beg = XSTRING (file)->data;
end = p = beg + XSTRING (file)->size;
Lisp_Object file;
{
char *buf;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
if (NILP (file))
return Qnil;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = find_file_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_as_directory, file);
+
buf = (char *) alloca (XSTRING (file)->size + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
&& (ptr[rlen] == ']' || ptr[rlen] == '>')
&& ptr[rlen - 1] == '.')
{
- ptr[rlen - 1] = ']';
- ptr[rlen] = '\0';
- return directory_file_name (ptr, dst);
+ char * buf = (char *) alloca (strlen (ptr) + 1);
+ strcpy (buf, ptr);
+ buf[rlen - 1] = ']';
+ buf[rlen] = '\0';
+ return directory_file_name (buf, dst);
}
else
dst[slen - 1] = ':';
Lisp_Object directory;
{
char *buf;
+ Lisp_Object handler;
CHECK_STRING (directory, 0);
if (NILP (directory))
return Qnil;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = find_file_handler (directory);
+ if (!NILP (handler))
+ return call2 (handler, Qdirectory_file_name, directory);
+
#ifdef VMS
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
int lbrack = 0, rbrack = 0;
int dots = 0;
#endif /* VMS */
+ Lisp_Object handler;
CHECK_STRING (name, 0);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = find_file_handler (name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, name, defalt);
+
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
#endif /* not VMS */
}
\f
+/* A slightly faster and more convenient way to get
+ (directory-file-name (expand-file-name FOO)). The return value may
+ have had its last character zapped with a '\0' character, meaning
+ that it is acceptable to system calls, but not to other lisp
+ functions. Callers should make sure that the return value doesn't
+ escape. */
+
Lisp_Object
expand_and_dir_to_file (filename, defdir)
Lisp_Object filename, defdir;
filename = Fexpand_file_name (filename, Qnil);
newname = Fexpand_file_name (newname, Qnil);
- /* If the file name has special constructs in it,
+ /* If the input 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);
+ /* Likewise for output file name. */
+ handler = find_file_handler (newname);
if (!NILP (handler))
return call3 (handler, Qcopy_file, filename, newname);
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
- return call3 (handler, Qmake_symbolic_link, filename, newname);
+ return call3 (handler, Qmake_symbolic_link, filename, linkname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_exists_p, filename);
+ return call2 (handler, Qfile_exists_p, abspath);
return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_executable_p, filename);
+ return call2 (handler, Qfile_executable_p, abspath);
return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_readable_p, filename);
+ return call2 (handler, Qfile_readable_p, abspath);
return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_writable_p, filename);
+ return call2 (handler, Qfile_writable_p, abspath);
if (access (XSTRING (abspath)->data, 0) >= 0)
return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_directory_p, filename);
+ return call2 (handler, Qfile_directory_p, abspath);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call2 (handler, Qfile_modes, filename);
+ return call2 (handler, Qfile_modes, abspath);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (abspath);
if (!NILP (handler))
- return call3 (handler, Qset_file_modes, filename, mode);
+ return call3 (handler, Qset_file_modes, abspath, mode);
#ifndef APOLLO
if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
struct stat st;
int mtime1;
Lisp_Object handler;
+ struct gcpro gcpro1, gcpro2;
CHECK_STRING (file1, 0);
CHECK_STRING (file2, 0);
+ abspath1 = Qnil;
+ GCPRO2 (abspath1, file2);
abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
+ UNGCPRO;
/* If the file name has special constructs in it,
call the corresponding file handler. */
}
if (inserted > 0)
- MODIFF++;
- record_insert (point, inserted);
+ {
+ record_insert (point, inserted);
+
+ /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
+ offset_intervals (current_buffer, point, inserted);
+ MODIFF++;
+ }
close (fd);
and mark buffer not modified.\n\
If VISIT is neither t nor nil, it means do not print\n\
the \"Wrote file\" message.\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\
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.")
(start, end, filename, append, visit)
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
#endif /* VMS */
+ Lisp_Object handler;
+ Lisp_Object visit_file = XTYPE (visit) == Lisp_String ? visit : filename;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Special kludge to simplify auto-saving */
if (NILP (start))
else if (XTYPE (start) != Lisp_String)
validate_region (&start, &end);
+ GCPRO4 (start, filename, visit, visit_file);
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];
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
next attempt to save. */
- if (EQ (visit, Qt))
+ if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
{
current_buffer->modtime = 0;
current_buffer->save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
- current_buffer->filename = filename;
+ current_buffer->filename = visit_file;
}
+ UNGCPRO;
return val;
}
#ifdef CLASH_DETECTION
if (!auto_saving)
- lock_file (filename);
+ lock_file (visit_file);
#endif /* CLASH_DETECTION */
+ fn = XSTRING (filename)->data;
desc = -1;
if (!NILP (append))
desc = open (fn, O_WRONLY);
desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
#endif /* not VMS */
+ UNGCPRO;
+
if (desc < 0)
{
#ifdef CLASH_DETECTION
save_errno = errno;
- if (!auto_saving) unlock_file (filename);
+ if (!auto_saving) unlock_file (visit_file);
errno = save_errno;
#endif /* CLASH_DETECTION */
report_file_error ("Opening output file", Fcons (filename, Qnil));
if (lseek (desc, 0, 2) < 0)
{
#ifdef CLASH_DETECTION
- if (!auto_saving) unlock_file (filename);
+ if (!auto_saving) unlock_file (visit_file);
#endif /* CLASH_DETECTION */
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
#ifdef CLASH_DETECTION
if (!auto_saving)
- unlock_file (filename);
+ unlock_file (visit_file);
#endif /* CLASH_DETECTION */
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
next attempt to save. */
- if (EQ (visit, Qt))
+ if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
current_buffer->modtime = st.st_mtime;
if (failure)
error ("IO error writing %s: %s", fn, err_str (save_errno));
- if (EQ (visit, Qt))
+ if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
{
current_buffer->save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
- current_buffer->filename = filename;
+ current_buffer->filename = visit_file;
}
else if (!NILP (visit))
return Qnil;
if (!auto_saving)
- message ("Wrote %s", fn);
+ message ("Wrote %s", XSTRING (visit_file)->data);
return Qnil;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = find_file_handler (b->filename);
if (!NILP (handler))
- return call2 (handler, Qverify_visited_file_modtime, filename);
+ return call2 (handler, Qverify_visited_file_modtime, buf);
if (stat (XSTRING (b->filename)->data, &st) < 0)
{
{
register Lisp_Object filename;
struct stat st;
+ Lisp_Object handler;
filename = Fexpand_file_name (current_buffer->filename, Qnil);
b->auto_save_file_name = Qnil;
/* Prevent warning from repeating if user does so. */
XFASTINT (b->save_length) = 0;
- Fsleep_for (make_number (1));
+ Fsleep_for (make_number (1), Qnil);
continue;
}
set_buffer_internal (b);
}
}
- if (auto_saved)
- record_auto_save ();
+ /* Prevent another auto save till enough input events come in. */
+ record_auto_save ();
if (auto_saved && NILP (nomsg))
message1 (omessage ? omessage : "Auto-saving...done");
lambda for verify final value */
{
Lisp_Object name, specdir, realdir, val, orig_string;
+ int changed;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ realdir = dir;
+ name = string;
+ orig_string = Qnil;
+ specdir = Qnil;
+ changed = 0;
+ /* No need to protect ACTION--we only compare it with t and nil. */
+ GCPRO4 (string, realdir, name, specdir);
if (XSTRING (string)->size == 0)
{
- orig_string = Qnil;
- name = string;
- realdir = dir;
if (EQ (action, Qlambda))
- return Qnil;
+ {
+ UNGCPRO;
+ return Qnil;
+ }
}
else
{
orig_string = string;
string = Fsubstitute_in_file_name (string);
+ changed = NILP (Fstring_equal (string, orig_string));
name = Ffile_name_nondirectory (string);
- realdir = Ffile_name_directory (string);
- if (NILP (realdir))
- realdir = dir;
- else
- realdir = Fexpand_file_name (realdir, dir);
+ val = Ffile_name_directory (string);
+ if (! NILP (val))
+ realdir = Fexpand_file_name (val, realdir);
}
if (NILP (action))
{
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir);
+ UNGCPRO;
if (XTYPE (val) != Lisp_String)
{
- if (NILP (Fstring_equal (string, orig_string)))
+ if (changed)
return string;
- return (val);
+ return val;
}
if (!NILP (specdir))
}
}
#endif /* Not VMS */
- return (val);
+ return val;
}
+ UNGCPRO;
if (EQ (action, Qt))
return Ffile_name_all_completions (name, realdir);
(prompt, dir, defalt, mustmatch, initial)
Lisp_Object prompt, dir, defalt, mustmatch, initial;
{
- Lisp_Object val, insdef, tem, backup_n;
+ Lisp_Object val, insdef, insdef1, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
int count;
if (insert_default_directory)
{
insdef = dir;
+ insdef1 = dir;
if (!NILP (initial))
{
- Lisp_Object args[2];
+ Lisp_Object args[2], pos;
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- backup_n = make_number (- (XSTRING (initial)->size));
+ pos = make_number (XSTRING (dir)->size);
+ insdef1 = Fcons (insdef, pos);
}
- else
- backup_n = Qnil;
}
else
- {
- insdef = build_string ("");
- backup_n = Qnil;
- }
+ insdef = Qnil, insdef1 = Qnil;
#ifdef VMS
count = specpdl_ptr - specpdl;
GCPRO2 (insdef, defalt);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch,
- insert_default_directory ? insdef : Qnil, backup_n);
+ dir, mustmatch, insdef1,
+ Qfile_name_history);
#ifdef VMS
unbind_to (count, Qnil);
GCPRO2 (insdef, defalt);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch,
- insert_default_directory ? insdef : Qnil, Qnil);
+ insert_default_directory ? insdef : Qnil,
+ Qfile_name_history);
#ifdef VMS
unbind_to (count, Qnil);
\f
syms_of_fileio ()
{
+ Qexpand_file_name = intern ("expand-file-name");
+ Qdirectory_file_name = intern ("directory-file-name");
+ Qfile_name_directory = intern ("file-name-directory");
+ Qfile_name_nondirectory = intern ("file-name-nondirectory");
+ Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
Qmake_directory = intern ("make-directory");
Qdelete_directory = intern ("delete-directory");
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
+ Qfile_name_history = intern ("file-name-history");
+ Fset (Qfile_name_history, Qnil);
+
+ staticpro (&Qcopy_file);
+ staticpro (&Qmake_directory);
+ staticpro (&Qdelete_directory);
+ staticpro (&Qdelete_file);
+ staticpro (&Qrename_file);
+ staticpro (&Qadd_name_to_file);
+ staticpro (&Qmake_symbolic_link);
+ staticpro (&Qfile_exists_p);
+ staticpro (&Qfile_executable_p);
+ staticpro (&Qfile_readable_p);
+ staticpro (&Qfile_symlink_p);
+ staticpro (&Qfile_writable_p);
+ staticpro (&Qfile_directory_p);
+ staticpro (&Qfile_accessible_directory_p);
+ staticpro (&Qfile_modes);
+ staticpro (&Qset_file_modes);
+ staticpro (&Qfile_newer_than_file_p);
+ staticpro (&Qinsert_file_contents);
+ staticpro (&Qwrite_region);
+ staticpro (&Qverify_visited_file_modtime);
+ staticpro (&Qfile_name_history);
+
Qfile_error = intern ("file-error");
staticpro (&Qfile_error);
Qfile_already_exists = intern("file-already-exists");
nil means use format `var'. This variable is meaningful only on VMS.");
vms_stmlf_recfm = 0;
+ 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)");
+ Vfile_name_handler_alist = Qnil;
+
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Sfile_name_as_directory);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+#ifdef unix
defsubr (&Sunix_sync);
+#endif
}
HCoop / bpt / emacs.git / blobdiff