/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
This file is part of GNU Emacs.
whose I/O is done with a special handler. */
Lisp_Object Vfile_name_handler_alist;
+/* Format for auto-save files */
+Lisp_Object Vauto_save_file_format;
+
+/* Lisp functions for translating file formats */
+Lisp_Object Qformat_decode, Qformat_annotate_function;
+
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
}
\f
Lisp_Object Qexpand_file_name;
+Lisp_Object Qsubstitute_in_file_name;
Lisp_Object Qdirectory_file_name;
Lisp_Object Qfile_name_directory;
Lisp_Object Qfile_name_nondirectory;
Lisp_Object Qfile_symlink_p;
Lisp_Object Qfile_writable_p;
Lisp_Object Qfile_directory_p;
+Lisp_Object Qfile_regular_p;
Lisp_Object Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
Lisp_Object Qwrite_region;
Lisp_Object Qverify_visited_file_modtime;
Lisp_Object Qset_visited_file_modtime;
-Lisp_Object Qsubstitute_in_file_name;
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\
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
-#ifdef MSDOS
- && p[-1] != ':' && p[-1] != '\\'
-#endif
) p--;
if (p == beg)
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
-#ifdef MSDOS
- && p[-1] != ':'
-#endif
) p--;
return make_string (p, end - p);
}
#else /* not VMS */
/* For Unix syntax, Append a slash if necessary */
-#ifdef MSDOS
- if (out[size] != ':' && out[size] != '/' && out[size] != '\\')
-#else /* not MSDOS */
if (!IS_ANY_SEP (out[size]))
{
out[size + 1] = DIRECTORY_SEP;
out[size + 2] = '\0';
}
-#endif /* not MSDOS */
#endif /* not VMS */
return out;
}
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
+#ifdef APOLLO
+ /* Handle // as root for apollo's. */
+ if ((slen > 2 && dst[slen - 1] == '/')
+ || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
+ dst[slen - 1] = 0;
+#else
if (slen > 1
&& IS_DIRECTORY_SEP (dst[slen - 1])
- && !IS_DEVICE_SEP (dst[slen - 2]))
+ && !IS_ANY_SEP (dst[slen - 2]))
dst[slen - 1] = 0;
+#endif
return 1;
}
defalt = current_buffer->directory;
CHECK_STRING (defalt, 1);
+ if (!NILP (defalt))
+ {
+ handler = Ffind_file_name_handler (defalt, Qexpand_file_name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, name, defalt);
+ }
+
o = XSTRING (defalt)->data;
/* Make sure DEFALT is properly expanded.
nm++;
else
{
- drive = tolower (colon[-1]) - 'a';
+ drive = colon[-1];
nm = colon + 1;
if (!IS_DIRECTORY_SEP (*nm))
{
defdir = alloca (MAXPATHLEN + 1);
- relpath = getdefdir (drive + 1, defdir);
+ relpath = getdefdir (tolower (drive) - 'a' + 1, defdir);
}
}
}
/* "//" anywhere isn't necessarily hairy; we just start afresh
with the second slash. */
if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
-#ifdef APOLLO
- /* // at start of filename is meaningful on Apollo system */
+#if defined (APOLLO) || defined (WINDOWSNT)
+ /* // at start of filename is meaningful on Apollo
+ and WindowsNT systems */
&& nm != p
-#endif /* APOLLO */
-#ifdef WINDOWSNT
- /* \\ or // at the start of a pathname is meaningful on NT. */
- && nm != p
-#endif /* WINDOWSNT */
+#endif /* APOLLO || WINDOWSNT */
)
nm = p + 1;
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
#ifdef DOS_NT
+ /* Problem when expanding "~\" if HOME is not on current drive.
+ Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
+ if (newdir[1] == ':')
+ drive = newdir[0];
dostounix_filename (newdir);
#endif
nm++;
/* Adding `length > 1 &&' makes ~ expand into / when homedir
is the root dir. People disagree about whether that is right.
Anyway, we can't take the risk of this change now. */
-#ifdef MSDOS
+#ifdef DOS_NT
if (newdir[1] != ':' && length > 1)
#endif
if (IS_DIRECTORY_SEP (newdir[length - 1]))
{
*o++ = *p++;
}
-#ifdef WINDOWSNT
- else if (!strncmp (p, "\\\\", 2) || !strncmp (p, "//", 2))
-#else /* not WINDOWSNT */
- else if (!strncmp (p, "//", 2)
-#endif /* not WINDOWSNT */
-#ifdef APOLLO
- /* // at start of filename is meaningful in Apollo system */
+ else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
+#if defined (APOLLO) || defined (WINDOWSNT)
+ /* // at start of filename is meaningful in Apollo
+ and WindowsNT systems */
&& o != target
#endif /* APOLLO */
-#ifdef WINDOWSNT
- /* \\ at start of filename is meaningful in Windows-NT */
- && o != target
-#endif /* WINDOWSNT */
)
{
o = target;
*o++ = *p;
p += 2;
}
-#ifdef WINDOWSNT
- else if (!strncmp (p, "\\..", 3) || !strncmp (p, "/..", 3))
-#else /* not WINDOWSNT */
- else if (!strncmp (p, "/..", 3)
-#endif /* not WINDOWSNT */
+ else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
/* `/../' is the "superroot" on certain file systems. */
&& o != target
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
-#ifdef APOLLO
- if (o == target + 1 && o[-1] == '/' && o[0] == '/')
+#if defined (APOLLO) || defined (WINDOWSNT)
+ if (o == target + 1
+ && IS_DIRECTORY_SEP (o[-1]) && IS_DIRECTORY_SEP (o[0]))
++o;
else
-#endif /* APOLLO */
-#ifdef WINDOWSNT
- if (o == target + 1 && (o[-1] == '/' && o[0] == '/')
- || (o[-1] == '\\' && o[0] == '\\'))
- ++o;
- else
-#endif /* WINDOWSNT */
+#endif /* APOLLO || WINDOWSNT */
if (o == target && IS_ANY_SEP (*o))
++o;
p += 3;
)
{
target -= 2;
- target[0] = (drive < 0 ? getdisk () : drive) + 'a';
+ target[0] = (drive < 0 ? getdisk () + 'A' : drive);
target[1] = ':';
}
#endif /* DOS_NT */
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"))
-#endif
chmod (XSTRING (newname)->data, st.st_mode & 07777);
}
UNGCPRO;
return Qnil;
}
-
+\f
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
"Create a directory. One argument, a file name string.")
return Qnil;
}
+static Lisp_Object
+internal_delete_file_1 (ignore)
+ Lisp_Object ignore;
+{
+ return Qt;
+}
+
+/* Delete file FILENAME, returning 1 if successful and 0 if failed. */
+
+int
+internal_delete_file (filename)
+ Lisp_Object filename;
+{
+ return NILP (internal_condition_case_1 (Fdelete_file, filename,
+ Qt, internal_delete_file_1));
+}
+\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 the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
+ handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
if (!NILP (handler))
- return call2 (handler, Qfile_directory_p, abspath);
+ return call2 (handler, Qfile_regular_p, abspath);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
if (!NILP (handler))
return call3 (handler, Qset_file_modes, abspath, mode);
-#ifndef APOLLO
if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (abspath, Qnil));
-#else /* APOLLO */
- if (!egetenv ("USE_DOMAIN_ACLS"))
- {
- struct stat st;
- struct timeval tvp[2];
-
- /* chmod on apollo also change the file's modtime; need to save the
- modtime and then restore it. */
- if (stat (XSTRING (abspath)->data, &st) < 0)
- {
- report_file_error ("Doing chmod", Fcons (abspath, Qnil));
- return (Qnil);
- }
-
- if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
- report_file_error ("Doing chmod", Fcons (abspath, Qnil));
-
- /* reset the old accessed and modified times. */
- tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
- tvp[0].tv_usec = 0;
- tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
- tvp[1].tv_usec = 0;
-
- if (utimes (XSTRING (abspath)->data, tvp) < 0)
- report_file_error ("Doing utimes", Fcons (abspath, Qnil));
- }
-#endif /* APOLLO */
return Qnil;
}
int total;
int not_regular = 0;
+ if (current_buffer->base_buffer && ! NILP (visit))
+ error ("Cannot do file visiting in an indirect buffer");
+
+ if (!NILP (current_buffer->read_only))
+ Fbarf_if_buffer_read_only ();
+
val = Qnil;
p = Qnil;
GCPRO3 (filename, val, p);
- if (!NILP (current_buffer->read_only))
- Fbarf_if_buffer_read_only();
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
current_buffer->filename = filename;
}
- current_buffer->save_modified = MODIFF;
+ SAVE_MODIFF = MODIFF;
current_buffer->auto_save_modified = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
#ifdef CLASH_DETECTION
if (NILP (handler))
{
- if (!NILP (current_buffer->filename))
- unlock_file (current_buffer->filename);
+ if (!NILP (current_buffer->file_truename))
+ unlock_file (current_buffer->file_truename);
unlock_file (filename);
}
#endif /* CLASH_DETECTION */
report_file_error ("Opening input file", Fcons (filename, Qnil));
}
+ /* Decode file format */
+ if (inserted > 0)
+ {
+ insval = call3 (Qformat_decode,
+ Qnil, make_number (inserted), visit);
+ CHECK_NUMBER (insval, 0);
+ inserted = XFASTINT (insval);
+ }
+
if (inserted > 0 && NILP (visit) && total > 0)
signal_after_change (point, 0, inserted);
= NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
#endif /* DOS_NT */
+ if (current_buffer->base_buffer && ! NILP (visit))
+ error ("Cannot do file visiting in an indirect buffer");
+
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
if (visiting)
{
- current_buffer->save_modified = MODIFF;
+ SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
}
if (visiting)
{
- current_buffer->save_modified = MODIFF;
+ SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
update_mode_lines++;
annotations = merge (annotations, res, Qcar_less_than_car);
p = Fcdr (p);
}
+
+ /* Now do the same for annotation functions implied by the file-format */
+ if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
+ p = Vauto_save_file_format;
+ else
+ p = current_buffer->file_format;
+ while (!NILP (p))
+ {
+ struct buffer *given_buffer = current_buffer;
+ Vwrite_region_annotations_so_far = annotations;
+ res = call3 (Qformat_annotate_function, Fcar (p), start, end);
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ annotations = Qnil;
+ }
+ Flength (res);
+ annotations = merge (annotations, res, Qcar_less_than_car);
+ p = Fcdr (p);
+ }
UNGCPRO;
return annotations;
}
if (STRINGP (Vauto_save_list_file_name))
{
+ Lisp_Object listfile;
+ listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
#ifdef DOS_NT
- listdesc = open (XSTRING (Vauto_save_list_file_name)->data,
+ listdesc = open (XSTRING (listfile)->data,
O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
S_IREAD | S_IWRITE);
#else /* not DOS_NT */
- listdesc = creat (XSTRING (Vauto_save_list_file_name)->data, 0666);
+ listdesc = creat (XSTRING (listfile)->data, 0666);
#endif /* not DOS_NT */
}
else
b = XBUFFER (buf);
/* Record all the buffers that have auto save mode
- in the special file that lists them. */
+ in the special file that lists them. For each of these buffers,
+ Record visited name (if any) and auto save name. */
if (STRINGP (b->auto_save_file_name)
&& listdesc >= 0 && do_handled_files == 0)
{
+ if (!NILP (b->filename))
+ {
+ write (listdesc, XSTRING (b->filename)->data,
+ XSTRING (b->filename)->size);
+ }
+ write (listdesc, "\n", 1);
write (listdesc, XSTRING (b->auto_save_file_name)->data,
XSTRING (b->auto_save_file_name)->size);
write (listdesc, "\n", 1);
&& b != current_buffer)
continue;
+ /* Don't auto-save indirect buffers.
+ The base buffer takes care of it. */
+ if (b->base_buffer)
+ continue;
+
/* Check for auto save enabled
and file changed since last auto save
and file changed since last real save. */
if (STRINGP (b->auto_save_file_name)
- && b->save_modified < BUF_MODIFF (b)
+ && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& b->auto_save_modified < BUF_MODIFF (b)
/* -1 means we've turned off autosaving for a while--see below. */
&& XINT (b->save_length) >= 0
"Return t if buffer has been auto-saved since last read in or saved.")
()
{
- return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
+ return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
}
\f
/* Reading and completing file names */
syms_of_fileio ()
{
Qexpand_file_name = intern ("expand-file-name");
+ Qsubstitute_in_file_name = intern ("substitute-in-file-name");
Qdirectory_file_name = intern ("directory-file-name");
Qfile_name_directory = intern ("file-name-directory");
Qfile_name_nondirectory = intern ("file-name-nondirectory");
Qfile_symlink_p = intern ("file-symlink-p");
Qfile_writable_p = intern ("file-writable-p");
Qfile_directory_p = intern ("file-directory-p");
+ Qfile_regular_p = intern ("file-regular-p");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
- Qsubstitute_in_file_name = intern ("substitute-in-file-name");
staticpro (&Qexpand_file_name);
+ staticpro (&Qsubstitute_in_file_name);
staticpro (&Qdirectory_file_name);
staticpro (&Qfile_name_directory);
staticpro (&Qfile_name_nondirectory);
staticpro (&Qfile_symlink_p);
staticpro (&Qfile_writable_p);
staticpro (&Qfile_directory_p);
+ staticpro (&Qfile_regular_p);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qfile_modes);
staticpro (&Qset_file_modes);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
- staticpro (&Qsubstitute_in_file_name);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, Qnil);
staticpro (&Qfind_buffer_file_type);
#endif /* DOS_NT */
+ 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.");
+ Vauto_save_file_format = Qt;
+
+ Qformat_decode = intern ("format-decode");
+ staticpro (&Qformat_decode);
+ Qformat_annotate_function = intern ("format-annotate-function");
+ staticpro (&Qformat_annotate_function);
+
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
HCoop / bpt / emacs.git / blobdiff