This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
#endif
#include <ctype.h>
-
-#ifdef VMS
-#include "vmsdir.h"
-#include <perror.h>
-#include <stddef.h>
-#include <string.h>
-#endif
-
#include <errno.h>
#ifndef vax11c
#define DRIVE_LETTER(x) (tolower (x))
#endif
-#ifdef VMS
-#include <file.h>
-#include <rmsdef.h>
-#include <fab.h>
-#include <nam.h>
-#endif
-
#include "systime.h"
#ifdef HPUX
#include <netio.h>
-#ifndef HPUX8
-#ifndef HPUX9
-#include <errnet.h>
-#endif
-#endif
#endif
#include "commands.h"
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* Set by auto_save_1 if an error occurred during the last auto-save. */
+int auto_save_error_occurred;
+
/* 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
/* 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 completion ignores case when reading file name. */
-int read_file_name_completion_ignore_case;
-
-/* Nonzero means, when reading a filename in the minibuffer,
- start out by inserting the default directory into the minibuffer. */
-int insert_default_directory;
-
-/* On VMS, nonzero means write new files with record format stmlf.
- Zero means use var format. */
-int vms_stmlf_recfm;
+/* Whether or not files are auto-saved into themselves. */
+Lisp_Object Vauto_save_visited_file_name;
/* On NT, specifies the directory separator character, used (eg.) when
expanding file names. This can be bound to / or \. */
int write_region_inhibit_fsync;
#endif
+/* Non-zero means call move-file-to-trash in Fdelete_file or
+ Fdelete_directory. */
+int delete_by_moving_to_trash;
+
+/* Lisp function for moving files to trash. */
+Lisp_Object Qmove_file_to_trash;
+
extern Lisp_Object Vuser_login_name;
#ifdef WINDOWSNT
doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
Otherwise return a directory name.
-Given a Unix syntax file name, returns a string ending in slash;
-on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
+Given a Unix syntax file name, returns a string ending in slash. */)
(filename)
Lisp_Object filename;
{
p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
-#ifdef VMS
- && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
-#endif /* VMS */
#ifdef DOS_NT
/* only recognise drive specifier at the beginning */
&& !(p[-1] == ':'
end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
-#ifdef VMS
- && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
-#endif /* VMS */
#ifdef DOS_NT
/* only recognise drive specifier at beginning */
&& !(p[-1] == ':'
return out;
}
-#ifdef VMS
- /* Is it already a directory string? */
- if (in[size] == ':' || in[size] == ']' || in[size] == '>')
- return out;
- /* Is it a VMS directory file name? If so, hack VMS syntax. */
- else if (! index (in, '/')
- && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
- || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
- || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
- || ! strncmp (&in[size - 5], ".dir", 4))
- && (in[size - 1] == '.' || in[size - 1] == ';')
- && in[size] == '1')))
- {
- register char *p, *dot;
- char brack;
-
- /* x.dir -> [.x]
- dir:x.dir --> dir:[x]
- dir:[x]y.dir --> dir:[x.y] */
- p = in + size;
- while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
- if (p != in)
- {
- strncpy (out, in, p - in);
- out[p - in] = '\0';
- if (*p == ':')
- {
- brack = ']';
- strcat (out, ":[");
- }
- else
- {
- brack = *p;
- strcat (out, ".");
- }
- p++;
- }
- else
- {
- brack = ']';
- strcpy (out, "[.");
- }
- dot = index (p, '.');
- if (dot)
- {
- /* blindly remove any extension */
- size = strlen (out) + (dot - p);
- strncat (out, p, dot - p);
- }
- else
- {
- strcat (out, p);
- size = strlen (out);
- }
- out[size++] = brack;
- out[size] = '\0';
- }
-#else /* not VMS */
/* For Unix syntax, Append a slash if necessary */
if (!IS_DIRECTORY_SEP (out[size]))
{
#ifdef DOS_NT
CORRECT_DIR_SEPS (out);
#endif
-#endif /* not VMS */
return out;
}
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. */)
+For a Unix-syntax file name, just appends a slash. */)
(file)
Lisp_Object file;
{
\f
/*
* Convert from directory name to filename.
- * On VMS:
- * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
- * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
* On UNIX, it's simple: just make sure there isn't a terminating /
* Value is nonzero if the string output is different from the input.
char *src, *dst;
{
long slen;
-#ifdef VMS
- long rlen;
- char * ptr, * rptr;
- char bracket;
- struct FAB fab = cc$rms_fab;
- struct NAM nam = cc$rms_nam;
- char esa[NAM$C_MAXRSS];
-#endif /* VMS */
slen = strlen (src);
-#ifdef VMS
- if (! index (src, '/')
- && (src[slen - 1] == ']'
- || src[slen - 1] == ':'
- || src[slen - 1] == '>'))
- {
- /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
- fab.fab$l_fna = src;
- fab.fab$b_fns = slen;
- fab.fab$l_nam = &nam;
- fab.fab$l_fop = FAB$M_NAM;
-
- nam.nam$l_esa = esa;
- nam.nam$b_ess = sizeof esa;
- nam.nam$b_nop |= NAM$M_SYNCHK;
-
- /* We call SYS$PARSE to handle such things as [--] for us. */
- if (SYS$PARSE (&fab, 0, 0) == RMS$_NORMAL)
- {
- slen = nam.nam$b_esl;
- if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
- slen -= 2;
- esa[slen] = '\0';
- src = esa;
- }
- if (src[slen - 1] != ']' && src[slen - 1] != '>')
- {
- /* what about when we have logical_name:???? */
- if (src[slen - 1] == ':')
- { /* Xlate logical name and see what we get */
- ptr = strcpy (dst, src); /* upper case for getenv */
- while (*ptr)
- {
- if ('a' <= *ptr && *ptr <= 'z')
- *ptr -= 040;
- ptr++;
- }
- dst[slen - 1] = 0; /* remove colon */
- if (!(src = egetenv (dst)))
- return 0;
- /* should we jump to the beginning of this procedure?
- Good points: allows us to use logical names that xlate
- to Unix names,
- Bad points: can be a problem if we just translated to a device
- name...
- For now, I'll punt and always expect VMS names, and hope for
- the best! */
- slen = strlen (src);
- if (src[slen - 1] != ']' && src[slen - 1] != '>')
- { /* no recursion here! */
- strcpy (dst, src);
- return 0;
- }
- }
- else
- { /* not a directory spec */
- strcpy (dst, src);
- return 0;
- }
- }
- bracket = src[slen - 1];
-
- /* If bracket is ']' or '>', bracket - 2 is the corresponding
- opening bracket. */
- ptr = index (src, bracket - 2);
- if (ptr == 0)
- { /* no opening bracket */
- strcpy (dst, src);
- return 0;
- }
- if (!(rptr = rindex (src, '.')))
- rptr = ptr;
- slen = rptr - src;
- strncpy (dst, src, slen);
- dst[slen] = '\0';
- if (*rptr == '.')
- {
- dst[slen++] = bracket;
- dst[slen] = '\0';
- }
- else
- {
- /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
- then translate the device and recurse. */
- if (dst[slen - 1] == ':'
- && dst[slen - 2] != ':' /* skip decnet nodes */
- && strcmp (src + slen, "[000000]") == 0)
- {
- dst[slen - 1] = '\0';
- if ((ptr = egetenv (dst))
- && (rlen = strlen (ptr) - 1) > 0
- && (ptr[rlen] == ']' || ptr[rlen] == '>')
- && ptr[rlen - 1] == '.')
- {
- 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] = ':';
- }
- strcat (dst, "[000000]");
- slen += 8;
- }
- rptr++;
- rlen = strlen (rptr) - 1;
- strncat (dst, rptr, rlen);
- dst[slen + rlen] = '\0';
- strcat (dst, ".DIR.1");
- return 1;
- }
-#endif /* VMS */
+
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
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\". */)
+In Unix-syntax, this function just removes the final slash. */)
(directory)
Lisp_Object 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
- chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (SBYTES (directory) + 20 + 255);
-#else
buf = (char *) alloca (SBYTES (directory) + 20);
-#endif
directory_file_name (SDATA (directory), buf);
return make_specified_string (buf, -1, strlen (buf),
STRING_MULTIBYTE (directory));
(name, default_directory)
Lisp_Object name, default_directory;
{
- unsigned char *nm;
+ /* These point to SDATA and need to be careful with string-relocation
+ during GC (via DECODE_FILE). */
+ unsigned char *nm, *newdir;
+ int nm_in_name;
+ /* This should only point to alloca'd data. */
+ unsigned char *target;
- register unsigned char *newdir, *p, *o;
int tlen;
- unsigned char *target;
struct passwd *pw;
-#ifdef VMS
- unsigned char * colon = 0;
- unsigned char * close = 0;
- unsigned char * slash = 0;
- unsigned char * brack = 0;
- int lbrack = 0, rbrack = 0;
- int dots = 0;
-#endif /* VMS */
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
int length;
Lisp_Object handler, result;
int multibyte;
+ Lisp_Object hdir;
CHECK_STRING (name);
return call3 (handler, Qexpand_file_name, name, default_directory);
}
- o = SDATA (default_directory);
-
- /* Make sure DEFAULT_DIRECTORY is properly expanded.
- It would be better to do this down below where we actually use
- default_directory. Unfortunately, calling Fexpand_file_name recursively
- could invoke GC, and the strings might be relocated. This would
- be annoying because we have pointers into strings lying around
- that would need adjusting, and people would add new pointers to
- the code and forget to adjust them, resulting in intermittent bugs.
- Putting this call here avoids all that crud.
-
- The EQ test avoids infinite recursion. */
- if (! NILP (default_directory) && !EQ (default_directory, name)
- /* Save time in some common cases - as long as default_directory
- is not relative, it can be canonicalized with name below (if it
- is needed at all) without requiring it to be expanded now. */
+ {
+ unsigned char *o = SDATA (default_directory);
+
+ /* Make sure DEFAULT_DIRECTORY is properly expanded.
+ It would be better to do this down below where we actually use
+ default_directory. Unfortunately, calling Fexpand_file_name recursively
+ could invoke GC, and the strings might be relocated. This would
+ be annoying because we have pointers into strings lying around
+ that would need adjusting, and people would add new pointers to
+ the code and forget to adjust them, resulting in intermittent bugs.
+ Putting this call here avoids all that crud.
+
+ The EQ test avoids infinite recursion. */
+ if (! NILP (default_directory) && !EQ (default_directory, name)
+ /* Save time in some common cases - as long as default_directory
+ is not relative, it can be canonicalized with name below (if it
+ is needed at all) without requiring it to be expanded now. */
#ifdef DOS_NT
- /* Detect MSDOS file names with drive specifiers. */
- && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))
+ /* Detect MSDOS file names with drive specifiers. */
+ && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
+ && IS_DIRECTORY_SEP (o[2]))
#ifdef WINDOWSNT
- /* Detect Windows file names in UNC format. */
- && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
+ /* Detect Windows file names in UNC format. */
+ && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
#endif
#else /* not DOS_NT */
/* Detect Unix absolute file names (/... alone is not absolute on
DOS or Windows). */
- && ! (IS_DIRECTORY_SEP (o[0]))
+ && ! (IS_DIRECTORY_SEP (o[0]))
#endif /* not DOS_NT */
- )
- {
- struct gcpro gcpro1;
-
- GCPRO1 (name);
- default_directory = Fexpand_file_name (default_directory, Qnil);
- UNGCPRO;
- }
+ )
+ {
+ struct gcpro gcpro1;
+ GCPRO1 (name);
+ default_directory = Fexpand_file_name (default_directory, Qnil);
+ UNGCPRO;
+ }
+ }
name = FILE_SYSTEM_CASE (name);
multibyte = STRING_MULTIBYTE (name);
if (multibyte != STRING_MULTIBYTE (default_directory))
}
nm = SDATA (name);
+ nm_in_name = 1;
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
a local copy to modify, even if there ends up being no change. */
nm = strcpy (alloca (strlen (nm) + 1), nm);
+ nm_in_name = 0;
/* Note if special escape prefix is present, but remove for now. */
if (nm[0] == '/' && nm[1] == ':')
"//somedir". */
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
-#endif /* WINDOWSNT */
-#endif /* DOS_NT */
-#ifdef WINDOWSNT
/* Discard any previous drive specifier if nm is now in UNC format. */
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
{
drive = 0;
}
-#endif
+#endif /* WINDOWSNT */
+#endif /* DOS_NT */
/* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
none are found, we can probably return right away. We will avoid
#ifdef WINDOWSNT
&& (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
#endif
-#ifdef VMS
- || index (nm, ':')
-#endif /* VMS */
)
{
/* If it turns out that the filename we want to return is just a
non-zero value, that means we've discovered that we can't do
that cool trick. */
int lose = 0;
+ unsigned char *p = nm;
- p = nm;
while (*p)
{
/* Since we know the name is absolute, we can assume that each
&& IS_DIRECTORY_SEP (p[0])
&& IS_DIRECTORY_SEP (p[1]))
lose = 1;
-
-#ifdef VMS
- if (p[0] == '\\')
- lose = 1;
- if (p[0] == '/') {
- /* if dev:[dir]/, move nm to / */
- if (!slash && p > nm && (brack || colon)) {
- nm = (brack ? brack + 1 : colon + 1);
- lbrack = rbrack = 0;
- brack = 0;
- colon = 0;
- }
- slash = p;
- }
- if (p[0] == '-')
-#ifdef NO_HYPHENS_IN_FILENAMES
- if (lbrack == rbrack)
- {
- /* Avoid clobbering negative version numbers. */
- if (dots < 2)
- p[0] = '_';
- }
- else
-#endif /* NO_HYPHENS_IN_FILENAMES */
- if (lbrack > rbrack
- && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
- && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
- lose = 1;
-#ifdef NO_HYPHENS_IN_FILENAMES
- else
- p[0] = '_';
-#endif /* NO_HYPHENS_IN_FILENAMES */
- /* count open brackets, reset close bracket pointer */
- if (p[0] == '[' || p[0] == '<')
- lbrack++, brack = 0;
- /* count close brackets, set close bracket pointer */
- if (p[0] == ']' || p[0] == '>')
- rbrack++, brack = p;
- /* detect ][ or >< */
- if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
- lose = 1;
- if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
- nm = p + 1, lose = 1;
- if (p[0] == ':' && (colon || slash))
- /* if dev1:[dir]dev2:, move nm to dev2: */
- if (brack)
- {
- nm = brack + 1;
- brack = 0;
- }
- /* if /name/dev:, move nm to dev: */
- else if (slash)
- nm = slash + 1;
- /* if node::dev:, move colon following dev */
- else if (colon && colon[-1] == ':')
- colon = p;
- /* if dev1:dev2:, move nm to dev2: */
- else if (colon && colon[-1] != ':')
- {
- nm = colon + 1;
- colon = 0;
- }
- if (p[0] == ':' && !colon)
- {
- if (p[1] == ':')
- p++;
- colon = p;
- }
- if (lbrack == rbrack)
- if (p[0] == ';')
- dots = 2;
- else if (p[0] == '.')
- dots++;
-#endif /* VMS */
p++;
}
if (!lose)
{
-#ifdef VMS
- if (index (nm, '/'))
- {
- nm = sys_translate_unix (nm);
- return make_specified_string (nm, -1, strlen (nm), multibyte);
- }
-#endif /* VMS */
#ifdef DOS_NT
/* Make sure directories are all separated with / or \ as
desired, but avoid allocation of a new string when not
if (nm[0] == '~') /* prefix ~ */
{
if (IS_DIRECTORY_SEP (nm[1])
-#ifdef VMS
- || nm[1] == ':'
-#endif /* VMS */
|| nm[1] == 0) /* ~ by itself */
{
+ Lisp_Object tem;
+
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
nm++;
+ /* egetenv may return a unibyte string, which will bite us since
+ we expect the directory to be multibyte. */
+ tem = build_string (newdir);
+ if (!STRING_MULTIBYTE (tem))
+ {
+ /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
+ after which `nm' won't point to the right place any more. */
+ int offset = nm - SDATA (name);
+ hdir = DECODE_FILE (tem);
+ newdir = SDATA (hdir);
+ if (nm_in_name)
+ nm = SDATA (name) + offset;
+ }
#ifdef DOS_NT
collapse_newdir = 0;
#endif
-#ifdef VMS
- nm++; /* Don't leave the slash in nm. */
-#endif /* VMS */
}
else /* ~user/filename */
{
- for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)
-#ifdef VMS
- && *p != ':'
-#endif /* VMS */
- ); p++);
- o = (unsigned char *) alloca (p - nm + 1);
+ unsigned char *o, *p;
+ for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
+ o = alloca (p - nm + 1);
bcopy ((char *) nm, o, p - nm);
o [p - nm] = 0;
if (pw)
{
newdir = (unsigned char *) pw -> pw_dir;
-#ifdef VMS
- nm = p + 1; /* skip the terminator */
-#else
nm = p;
#ifdef DOS_NT
collapse_newdir = 0;
#endif
-#endif /* VMS */
}
/* If we don't find a user of that name, leave the name
#endif
#ifdef WINDOWSNT
&& !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
-#endif
-#ifdef VMS
- && !index (nm, ':')
#endif
&& !newdir)
{
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
{
+ unsigned char *p;
newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
p = newdir + 2;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
if (newdir)
{
-#ifndef VMS
if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
{
#ifdef DOS_NT
strcpy (target, newdir);
}
else
-#endif
file_name_as_directory (target, newdir);
}
strcat (target, nm);
-#ifdef VMS
- if (index (target, '/'))
- strcpy (target, sys_translate_unix (target));
-#endif /* VMS */
-
- /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
/* Now canonicalize by removing `//', `/.' and `/foo/..' if they
appear. */
+ {
+ unsigned char *p = target;
+ unsigned char *o = target;
- p = target;
- o = target;
-
- while (*p)
- {
-#ifdef VMS
- if (*p != ']' && *p != '>' && *p != '-')
- {
- if (*p == '\\')
- p++;
- *o++ = *p++;
- }
- else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
- /* brackets are offset from each other by 2 */
- {
- p += 2;
- if (*p != '.' && *p != '-' && o[-1] != '.')
- /* convert [foo][bar] to [bar] */
- while (o[-1] != '[' && o[-1] != '<')
- o--;
- else if (*p == '-' && *o != '.')
- *--p = '.';
- }
- else if (p[0] == '-' && o[-1] == '.'
- && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
- /* flush .foo.- ; leave - if stopped by '[' or '<' */
- {
- do
- o--;
- while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
- if (p[1] == '.') /* foo.-.bar ==> bar. */
+ while (*p)
+ {
+ if (!IS_DIRECTORY_SEP (*p))
+ {
+ *o++ = *p++;
+ }
+ else if (p[1] == '.'
+ && (IS_DIRECTORY_SEP (p[2])
+ || p[2] == 0))
+ {
+ /* If "/." is the entire filename, keep the "/". Otherwise,
+ just delete the whole "/.". */
+ if (o == target && p[2] == '\0')
+ *o++ = *p;
p += 2;
- else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
- p++, o--;
- /* else [foo.-] ==> [-] */
- }
- else
- {
-#ifdef NO_HYPHENS_IN_FILENAMES
- if (*p == '-'
- && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
- && p[1] != ']' && p[1] != '>' && p[1] != '.')
- *p = '_';
-#endif /* NO_HYPHENS_IN_FILENAMES */
- *o++ = *p++;
- }
-#else /* not VMS */
- if (!IS_DIRECTORY_SEP (*p))
- {
- *o++ = *p++;
- }
- else if (p[1] == '.'
- && (IS_DIRECTORY_SEP (p[2])
- || p[2] == 0))
- {
- /* If "/." is the entire filename, keep the "/". Otherwise,
- just delete the whole "/.". */
- if (o == target && p[2] == '\0')
- *o++ = *p;
- p += 2;
- }
- else if (p[1] == '.' && p[2] == '.'
- /* `/../' is the "superroot" on certain file systems.
- Turned off on DOS_NT systems because they have no
- "superroot" and because this causes us to produce
- file names like "d:/../foo" which fail file-related
- functions of the underlying OS. (To reproduce, try a
- long series of "../../" in default_directory, longer
- than the number of levels from the root.) */
+ }
+ else if (p[1] == '.' && p[2] == '.'
+ /* `/../' is the "superroot" on certain file systems.
+ Turned off on DOS_NT systems because they have no
+ "superroot" and because this causes us to produce
+ file names like "d:/../foo" which fail file-related
+ functions of the underlying OS. (To reproduce, try a
+ long series of "../../" in default_directory, longer
+ than the number of levels from the root.) */
#ifndef DOS_NT
- && o != target
+ && o != target
#endif
- && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
- {
- while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
- ;
- /* Keep initial / only if this is the whole name. */
- if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
- ++o;
- p += 3;
- }
- else if (p > target && IS_DIRECTORY_SEP (p[1]))
- /* Collapse multiple `/' in a row. */
- p++;
- else
- {
- *o++ = *p++;
- }
-#endif /* not VMS */
- }
+ && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
+ {
+ while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
+ ;
+ /* Keep initial / only if this is the whole name. */
+ if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
+ ++o;
+ p += 3;
+ }
+ else if (p > target && IS_DIRECTORY_SEP (p[1]))
+ /* Collapse multiple `/' in a row. */
+ p++;
+ else
+ {
+ *o++ = *p++;
+ }
+ }
#ifdef DOS_NT
- /* At last, set drive name. */
+ /* At last, set drive name. */
#ifdef WINDOWSNT
- /* Except for network file name. */
- if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
+ /* Except for network file name. */
+ if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
#endif /* WINDOWSNT */
- {
- if (!drive) abort ();
- target -= 2;
- target[0] = DRIVE_LETTER (drive);
- target[1] = ':';
- }
- /* Reinsert the escape prefix if required. */
- if (is_escaped)
- {
- target -= 2;
- target[0] = '/';
- target[1] = ':';
- }
- CORRECT_DIR_SEPS (target);
+ {
+ if (!drive) abort ();
+ target -= 2;
+ target[0] = DRIVE_LETTER (drive);
+ target[1] = ':';
+ }
+ /* Reinsert the escape prefix if required. */
+ if (is_escaped)
+ {
+ target -= 2;
+ target[0] = '/';
+ target[1] = ':';
+ }
+ CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
- result = make_specified_string (target, -1, o - target, multibyte);
+ result = make_specified_string (target, -1, o - target, multibyte);
+ }
/* Again look to see if the file name has special constructs in it
and perhaps call the corresponding file handler. This is needed
unsigned char *target;
struct passwd *pw;
int lose;
-#ifdef VMS
- unsigned char * colon = 0;
- unsigned char * close = 0;
- unsigned char * slash = 0;
- unsigned char * brack = 0;
- int lbrack = 0, rbrack = 0;
- int dots = 0;
-#endif /* VMS */
CHECK_STRING (name);
-
-#ifdef VMS
- /* Filenames on VMS are always upper case. */
- name = Fupcase (name);
-#endif
-
nm = SDATA (name);
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
- if (
- nm[0] == '/'
-#ifdef VMS
- || index (nm, ':')
-#endif /* VMS */
- )
+ if (nm[0] == '/')
{
p = nm;
lose = 0;
&& (p[2] == '/' || p[2] == 0
|| (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
lose = 1;
-#ifdef VMS
- if (p[0] == '\\')
- lose = 1;
- if (p[0] == '/') {
- /* if dev:[dir]/, move nm to / */
- if (!slash && p > nm && (brack || colon)) {
- nm = (brack ? brack + 1 : colon + 1);
- lbrack = rbrack = 0;
- brack = 0;
- colon = 0;
- }
- slash = p;
- }
- if (p[0] == '-')
-#ifndef VMS4_4
- /* VMS pre V4.4,convert '-'s in filenames. */
- if (lbrack == rbrack)
- {
- if (dots < 2) /* this is to allow negative version numbers */
- p[0] = '_';
- }
- else
-#endif /* VMS4_4 */
- if (lbrack > rbrack
- && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
- && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
- lose = 1;
-#ifndef VMS4_4
- else
- p[0] = '_';
-#endif /* VMS4_4 */
- /* count open brackets, reset close bracket pointer */
- if (p[0] == '[' || p[0] == '<')
- lbrack++, brack = 0;
- /* count close brackets, set close bracket pointer */
- if (p[0] == ']' || p[0] == '>')
- rbrack++, brack = p;
- /* detect ][ or >< */
- if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
- lose = 1;
- if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
- nm = p + 1, lose = 1;
- if (p[0] == ':' && (colon || slash))
- /* if dev1:[dir]dev2:, move nm to dev2: */
- if (brack)
- {
- nm = brack + 1;
- brack = 0;
- }
- /* If /name/dev:, move nm to dev: */
- else if (slash)
- nm = slash + 1;
- /* If node::dev:, move colon following dev */
- else if (colon && colon[-1] == ':')
- colon = p;
- /* If dev1:dev2:, move nm to dev2: */
- else if (colon && colon[-1] != ':')
- {
- nm = colon + 1;
- colon = 0;
- }
- if (p[0] == ':' && !colon)
- {
- if (p[1] == ':')
- p++;
- colon = p;
- }
- if (lbrack == rbrack)
- if (p[0] == ';')
- dots = 2;
- else if (p[0] == '.')
- dots++;
-#endif /* VMS */
p++;
}
if (!lose)
{
-#ifdef VMS
- if (index (nm, '/'))
- return build_string (sys_translate_unix (nm));
-#endif /* VMS */
if (nm == SDATA (name))
return name;
return build_string (nm);
newdir = 0;
if (nm[0] == '~') /* prefix ~ */
- if (nm[1] == '/'
-#ifdef VMS
- || nm[1] == ':'
-#endif /* VMS */
- || nm[1] == 0)/* ~/filename */
+ if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
{
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
nm++;
-#ifdef VMS
- nm++; /* Don't leave the slash in nm. */
-#endif /* VMS */
}
else /* ~user/filename */
{
/* Find end of name. */
unsigned char *ptr = (unsigned char *) index (user, '/');
int len = ptr ? ptr - user : strlen (user);
-#ifdef VMS
- unsigned char *ptr1 = index (user, ':');
- if (ptr1 != 0 && ptr1 - user < len)
- len = ptr1 - user;
-#endif /* VMS */
/* Copy the user name into temp storage. */
o = (unsigned char *) alloca (len + 1);
bcopy ((char *) user, o, len);
nm += len;
}
- if (nm[0] != '/'
-#ifdef VMS
- && !index (nm, ':')
-#endif /* not VMS */
- && !newdir)
+ if (nm[0] != '/' && !newdir)
{
if (NILP (defalt))
defalt = current_buffer->directory;
if (newdir)
{
-#ifndef VMS
if (nm[0] == 0 || nm[0] == '/')
strcpy (target, newdir);
else
-#endif
file_name_as_directory (target, newdir);
}
strcat (target, nm);
-#ifdef VMS
- if (index (target, '/'))
- strcpy (target, sys_translate_unix (target));
-#endif /* VMS */
/* Now canonicalize by removing /. and /foo/.. if they appear */
while (*p)
{
-#ifdef VMS
- if (*p != ']' && *p != '>' && *p != '-')
- {
- if (*p == '\\')
- p++;
- *o++ = *p++;
- }
- else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
- /* brackets are offset from each other by 2 */
- {
- p += 2;
- if (*p != '.' && *p != '-' && o[-1] != '.')
- /* convert [foo][bar] to [bar] */
- while (o[-1] != '[' && o[-1] != '<')
- o--;
- else if (*p == '-' && *o != '.')
- *--p = '.';
- }
- else if (p[0] == '-' && o[-1] == '.'
- && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
- /* flush .foo.- ; leave - if stopped by '[' or '<' */
- {
- do
- o--;
- while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
- if (p[1] == '.') /* foo.-.bar ==> bar. */
- p += 2;
- else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
- p++, o--;
- /* else [foo.-] ==> [-] */
- }
- else
- {
-#ifndef VMS4_4
- if (*p == '-'
- && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
- && p[1] != ']' && p[1] != '>' && p[1] != '.')
- *p = '_';
-#endif /* VMS4_4 */
- *o++ = *p++;
- }
-#else /* not VMS */
if (*p != '/')
{
*o++ = *p++;
{
*o++ = *p++;
}
-#endif /* not VMS */
}
return make_string (target, o - target);
{
return
(IS_DIRECTORY_SEP (*filename) || *filename == '~'
-#ifdef VMS
- /* ??? This criterion is probably wrong for '<'. */
- || index (filename, ':') || index (filename, '<')
- || (*filename == '[' && (filename[1] != '-'
- || (filename[2] != '.' && filename[2] != ']'))
- && filename[1] != '.')
-#endif /* VMS */
#ifdef DOS_NT
|| (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
&& IS_DIRECTORY_SEP (filename[2]))
for (p = nm + 1; p < endp; p++)
{
if ((0
-#ifdef VMS
- || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
-#endif /* VMS */
|| IS_DIRECTORY_SEP (p[-1]))
&& file_name_absolute_p (p)
#if defined (WINDOWSNT) || defined(CYGWIN)
#endif /* not (WINDOWSNT || CYGWIN) */
)
{
- for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
-#ifdef VMS
- && *s != ':'
-#endif /* VMS */
- ); s++);
+ for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
{
unsigned char *o = alloca (s - p + 1);
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. */)
+If `/~' appears, all of FILENAME through that `/' is discarded. */)
(filename)
Lisp_Object filename;
{
(make_specified_string (p, -1, endp - p,
STRING_MULTIBYTE (filename)));
-#ifdef VMS
- return filename;
-#else
/* See if any variables are substituted into the string
and find the total length of their values in `total' */
/* Get variable value */
o = (unsigned char *) egetenv (target);
if (o)
- {
- total += strlen (o);
+ { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
+ total += strlen (o) * (STRING_MULTIBYTE (filename) ? 2 : 1);
substituted = 1;
}
else if (*p == '}')
error ("Substituting nonexistent environment variable \"%s\"", target);
/* NOTREACHED */
-#endif /* not VMS */
return Qnil;
}
\f
register Lisp_Object absname;
absname = Fexpand_file_name (filename, defdir);
-#ifdef VMS
- {
- 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 (SCHARS (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
return absname;
}
\f
}
#endif /* S_ISREG && S_ISLNK */
-#ifdef VMS
- /* Create the copy file with the same record format as the input file */
- 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 = emacs_open (SDATA (encoded_newname),
| (NILP (ok_if_already_exists) ? O_EXCL : 0),
0666);
#endif /* not MSDOS */
-#endif /* VMS */
if (ofd < 0)
report_file_error ("Opening output file", Fcons (newname, Qnil));
if (!NILP (handler))
return call2 (handler, Qdelete_directory, directory);
+ if (delete_by_moving_to_trash)
+ return call1 (Qmove_file_to_trash, directory);
+
encoded_dir = ENCODE_FILE (directory);
dir = SDATA (encoded_dir);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
+ if (delete_by_moving_to_trash)
+ return call1 (Qmove_file_to_trash, filename);
+
encoded_file = ENCODE_FILE (filename);
if (0 > unlink (SDATA (encoded_file)))
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
-#ifndef BSD4_1
if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
-#else
- if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
- || 0 > unlink (SDATA (encoded_file)))
-#endif
{
if (errno == EXDEV)
{
return Qnil;
}
-#ifdef S_IFLNK
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
doc: /* Make a symbolic link to FILENAME, named LINKNAME.
RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
linkname, ok_if_already_exists));
+#ifdef S_IFLNK
encoded_filename = ENCODE_FILE (filename);
encoded_linkname = ENCODE_FILE (linkname);
}
UNGCPRO;
return Qnil;
-}
-#endif /* S_IFLNK */
-
-#ifdef VMS
-
-DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
- 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
- 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);
- if (NILP (string))
- delete_logical_name (SDATA (name));
- else
- {
- CHECK_STRING (string);
- if (SCHARS (string) == 0)
- delete_logical_name (SDATA (name));
- else
- define_logical_name (SDATA (name), SDATA (string));
- }
+#else
+ UNGCPRO;
+ xsignal1 (Qfile_error, build_string ("Symbolic links are not supported"));
- return string;
+#endif /* S_IFLNK */
}
-#endif /* VMS */
-
-#ifdef HPUX_NET
-
-DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
- doc: /* Open a network connection to PATH using LOGIN as the login string. */)
- (path, login)
- Lisp_Object path, login;
-{
- int netresult;
-
- CHECK_STRING (path);
- CHECK_STRING (login);
-
- netresult = netunam (SDATA (path), SDATA (login));
- if (netresult == -1)
- return Qnil;
- else
- return Qt;
-}
-#endif /* HPUX_NET */
\f
DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1, 1, 0,
#else
return (S_ISREG (st.st_mode)
&& len >= 5
- && (stricmp ((suffix = filename + len-4), ".com") == 0
- || stricmp (suffix, ".exe") == 0
- || stricmp (suffix, ".bat") == 0)
+ && (xstrcasecmp ((suffix = filename + len-4), ".com") == 0
+ || xstrcasecmp (suffix, ".exe") == 0
+ || xstrcasecmp (suffix, ".bat") == 0)
|| (st.st_mode & S_IFMT) == S_IFDIR);
#endif /* not WINDOWSNT */
#else /* not DOS_NT */
? Qt : Qnil);
dir = Ffile_name_directory (absname);
-#ifdef VMS
- if (!NILP (dir))
- dir = Fdirectory_file_name (dir);
-#endif /* VMS */
#ifdef MSDOS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
struct stat st;
register int fd;
int inserted = 0;
+ int nochange = 0;
register int how_much;
register int unprocessed;
int count = SPECPDL_INDEX ();
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. */
+ file sizes to exceed 2Gb, so give a suitable message. */
if (! not_regular && st.st_size < 0)
error ("Maximum buffer size exceeded");
how_much += this;
- BUF_SET_PT (XBUFFER (conversion_buffer),
- BUF_Z (XBUFFER (conversion_buffer)));
+ BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
+ BUF_Z (XBUFFER (conversion_buffer)));
decode_coding_c_string (&coding, read_buf, unprocessed + this,
conversion_buffer);
unprocessed = coding.carryover_bytes;
{
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
- del_range_byte (same_at_start, same_at_end, 0);
+ if (same_at_start == same_at_end)
+ nochange = 1;
+ else
+ del_range_byte (same_at_start, same_at_end, 0);
inserted = 0;
unbind_to (this_count, Qnil);
if (!NILP (visit))
{
- if (!EQ (current_buffer->undo_list, Qt))
+ if (!EQ (current_buffer->undo_list, Qt) && !nochange)
current_buffer->undo_list = Qnil;
if (NILP (handler))
}
}
- /* Decode file format */
+ /* Decode file format. */
if (inserted > 0)
{
- /* Don't run point motion or modification hooks when decoding. */
+ /* Don't run point motion or modification hooks when decoding. */
int count = SPECPDL_INDEX ();
+ int old_inserted = inserted;
specbind (Qinhibit_point_motion_hooks, Qt);
specbind (Qinhibit_modification_hooks, Qt);
- /* Save old undo list and don't record undo for decoding. */
+ /* Save old undo list and don't record undo for decoding. */
old_undo = current_buffer->undo_list;
current_buffer->undo_list = Qt;
else
{
/* If REPLACE is non-nil and we succeeded in not replacing the
- beginning or end of the buffer text with the file's contents,
- call format-decode with `point' positioned at the beginning of
- the buffer and `inserted' equalling the number of characters
- in the buffer. Otherwise, format-decode might fail to
- correctly analyze the beginning or end of the buffer. Hence
- we temporarily save `point' and `inserted' here and restore
- `point' iff format-decode did not insert or delete any text.
- Otherwise we leave `point' at point-min. */
+ beginning or end of the buffer text with the file's contents,
+ call format-decode with `point' positioned at the beginning
+ of the buffer and `inserted' equalling the number of
+ characters in the buffer. Otherwise, format-decode might
+ fail to correctly analyze the beginning or end of the buffer.
+ Hence we temporarily save `point' and `inserted' here and
+ restore `point' iff format-decode did not insert or delete
+ any text. Otherwise we leave `point' at point-min. */
int opoint = PT;
int opoint_byte = PT_BYTE;
int oinserted = ZV - BEGV;
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
point back to position before inserted text and leave
- value of inserted alone. */
+ value of inserted alone. */
SET_PT_BOTH (opoint, opoint_byte);
else
/* format_decode modified buffer's characters => consider
- entire buffer changed and leave point at point-min. */
+ entire buffer changed and leave point at point-min. */
inserted = XFASTINT (insval);
}
/* For consistency with format-decode call these now iff inserted > 0
- (martin 2007-06-28) */
+ (martin 2007-06-28). */
p = Vafter_insert_file_functions;
while (CONSP (p))
{
}
else
{
- /* For the rationale of this see the comment on format-decode above. */
+ /* For the rationale of this see the comment on
+ format-decode above. */
int opoint = PT;
int opoint_byte = PT_BYTE;
int oinserted = ZV - BEGV;
/* after_insert_file_functions didn't modify
buffer's characters => move point back to
position before inserted text and leave value of
- inserted alone. */
+ inserted alone. */
SET_PT_BOTH (opoint, opoint_byte);
else
/* after_insert_file_functions did modify buffer's
characters => consider entire buffer changed and
- leave point at point-min. */
+ leave point at point-min. */
inserted = XFASTINT (insval);
}
}
if (NILP (visit))
{
- Lisp_Object lbeg, lend;
- XSETINT (lbeg, PT);
- XSETINT (lend, PT + inserted);
- if (CONSP (old_undo))
+ current_buffer->undo_list = old_undo;
+ if (CONSP (old_undo) && inserted != old_inserted)
{
+ /* Adjust the last undo record for the size change during
+ the format conversion. */
Lisp_Object tem = XCAR (old_undo);
- if (CONSP (tem) && INTEGERP (XCAR (tem)) &&
- INTEGERP (XCDR (tem)) && EQ (XCAR (tem), lbeg))
- /* In the non-visiting case record only the final insertion. */
- current_buffer->undo_list =
- Fcons (Fcons (lbeg, lend), Fcdr (old_undo));
+ if (CONSP (tem) && INTEGERP (XCAR (tem))
+ && INTEGERP (XCDR (tem))
+ && XFASTINT (XCDR (tem)) == PT + old_inserted)
+ XSETCDR (tem, make_number (PT + inserted));
}
}
else
/* If undo_list was Qt before, keep it that way.
- Otherwise start with an empty undo_list. */
+ Otherwise start with an empty undo_list. */
current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil;
unbind_to (count, Qnil);
struct stat st;
int count = SPECPDL_INDEX ();
int count1;
-#ifdef VMS
- unsigned char *fname = 0; /* If non-0, original filename (must rename) */
-#endif /* VMS */
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
+ /* Do it later, so write-region-annotate-function can work differently
+ if we save "the buffer" vs "a region".
+ This is useful in tar-mode. --Stef
XSETFASTINT (start, BEG);
- XSETFASTINT (end, Z);
+ XSETFASTINT (end, Z); */
Fwiden ();
}
}
}
+ if (NILP (start))
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
+
UNGCPRO;
GCPRO5 (start, filename, annotations, visit_file, lockname);
#endif /* not DOS_NT */
if (desc < 0 && (NILP (append) || errno == ENOENT))
-#ifdef VMS
- if (auto_saving) /* Overwrite any previous version of autosave file */
- {
- vms_truncate (fn); /* if fn exists, truncate to zero length */
- desc = emacs_open (fn, O_RDWR, 0);
- if (desc < 0)
- desc = creat_copy_attrs (STRINGP (current_buffer->filename)
- ? SDATA (current_buffer->filename) : 0,
- fn);
- }
- else /* Write to temporary name and rename if no errors */
- {
- Lisp_Object temp_name;
- temp_name = Ffile_name_directory (filename);
-
- if (!NILP (temp_name))
- {
- temp_name = Fmake_temp_name (concat2 (temp_name,
- build_string ("$$SAVE$$")));
- fname = SDATA (filename);
- fn = SDATA (temp_name);
- desc = creat_copy_attrs (fname, fn);
- if (desc < 0)
- {
- /* If we can't open the temporary file, try creating a new
- version of the original file. VMS "creat" creates a
- new version rather than truncating an existing file. */
- fn = fname;
- fname = 0;
- desc = creat (fn, 0666);
-#if 0 /* This can clobber an existing file and fail to replace it,
- if the user runs out of space. */
- if (desc < 0)
- {
- /* We can't make a new version;
- try to truncate and rewrite existing version if any. */
- vms_truncate (fn);
- desc = emacs_open (fn, O_RDWR, 0);
- }
-#endif
- }
- }
- else
- desc = creat (fn, 0666);
- }
-#else /* not VMS */
#ifdef DOS_NT
desc = emacs_open (fn,
O_WRONLY | O_CREAT | buffer_file_type
| (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
auto_saving ? auto_save_mode_bits : 0666);
#endif /* not DOS_NT */
-#endif /* not VMS */
if (desc < 0)
{
UNGCPRO;
-#ifdef VMS
-/*
- * Kludge Warning: The VMS C RTL likes to insert carriage returns
- * if we do writes that don't end with a carriage return. Furthermore
- * it cannot handle writes of more then 16K. The modified
- * version of "sys_write" in SYSDEP.C (see comment there) copes with
- * this EXCEPT for the last record (if it doesn't end with a carriage
- * return). This implies that if your buffer doesn't end with a carriage
- * return, you get one free... tough. However it also means that if
- * we make two calls to sys_write (a la the following code) you can
- * get one at the gap as well. The easiest way to fix this (honest)
- * is to move the gap to the next newline (or the end of the buffer).
- * Thus this change.
- *
- * Yech!
- */
- if (GPT > BEG && GPT_ADDR[-1] != '\n')
- move_gap (find_next_newline (GPT, 1));
-#else
#if 0
/* The new encoding routine doesn't require the following. */
move_gap_both (PT, PT_BYTE);
SET_PT_BOTH (opoint, opoint_byte);
}
-#endif
#endif
failure = 0;
but who knows about all the other machines with NFS?) */
#if 0
- /* On VMS, must do the stat after the close
- since closing changes the modtime. */
-#ifndef VMS
- /* Recall that #if defined does not work on VMS. */
#define FOO
fstat (desc, &st);
-#endif
#endif
/* NFS can report a write failure now. */
if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
-#ifdef VMS
- /* If we wrote to a temporary name and had no errors, rename to real name. */
- if (fname)
- {
- if (!failure)
- failure = (rename (fn, fname) != 0), save_errno = errno;
- fn = fname;
- }
-#endif /* VMS */
-
#ifndef FOO
stat (fn, &st);
#endif
char *msgbuf;
USE_SAFE_ALLOCA;
+ auto_save_error_occurred = 1;
+
ring_bell (XFRAME (selected_frame));
args[0] = build_string ("Auto-saving %s: %s");
}
return
- Fwrite_region (Qnil, Qnil,
- current_buffer->auto_save_file_name,
- Qnil, Qlambda, Qnil, Qnil);
+ Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil,
+ NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
+ Qnil, Qnil);
}
static Lisp_Object
make_number (minibuffer_auto_raise));
minibuffer_auto_raise = 0;
auto_saving = 1;
+ auto_save_error_occurred = 0;
/* On first pass, save all files that don't have handlers.
On second pass, save all files that do have handlers.
sit_for (make_number (1), 0, 0);
restore_message ();
}
- else
- /* If we displayed a message and then restored a state
+ else if (!auto_save_error_occurred)
+ /* Don't overwrite the error message if an error occurred.
+ If we displayed a message and then restored a state
with no message, leave a "done" message on the screen. */
message1 ("Auto-saving...done");
}
}
\f
/* Reading and completing file names */
-extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
-extern Lisp_Object Qcompletion_ignore_case;
-
-/* In the string VAL, change each $ to $$ and return the result. */
-
-static Lisp_Object
-double_dollars (val)
- Lisp_Object val;
-{
- register const unsigned char *old;
- register unsigned char *new;
- register int n;
- int osize, count;
-
- osize = SBYTES (val);
-
- /* Count the number of $ characters. */
- for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
- if (*old++ == '$') count++;
- if (count > 0)
- {
- old = SDATA (val);
- val = make_uninit_multibyte_string (SCHARS (val) + count,
- osize + count);
- new = SDATA (val);
- for (n = osize; n > 0; n--)
- if (*old != '$')
- *new++ = *old++;
- else
- {
- *new++ = '$';
- *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,
- 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 */
-{
- Lisp_Object name, specdir, realdir, val, orig_string;
- int changed;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
- CHECK_STRING (string);
-
- realdir = dir;
- name = string;
- orig_string = Qnil;
- specdir = Qnil;
- changed = 0;
- /* No need to protect ACTION--we only compare it with t and nil. */
- GCPRO5 (string, realdir, name, specdir, orig_string);
-
- if (SCHARS (string) == 0)
- {
- if (EQ (action, Qlambda))
- {
- 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);
- 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, Vread_file_name_predicate);
- UNGCPRO;
- if (!STRINGP (val))
- {
- if (changed)
- return double_dollars (string);
- return val;
- }
-
- if (!NILP (specdir))
- val = concat2 (specdir, val);
-#ifndef VMS
- return double_dollars (val);
-#else /* not VMS */
- return val;
-#endif /* not VMS */
- }
- UNGCPRO;
-
- if (EQ (action, Qt))
- {
- 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 = SBYTES (tem), len > 0) &&
- IS_DIRECTORY_SEP (SREF (tem, len-1)))
- comp = Fcons (tem, comp);
- }
- }
- else
-#endif
- {
- /* Must do it the hard (and slow) way. */
- Lisp_Object tem;
- 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))
- {
- tem = call1 (Vread_file_name_predicate, XCAR (all));
- if (!NILP (tem))
- 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 (SCHARS (name) == 0)
- return Qt;
-#endif /* VMS */
- string = Fexpand_file_name (string, dir);
- if (!NILP (Vread_file_name_predicate))
- return call1 (Vread_file_name_predicate, string);
- return Ffile_exists_p (string);
-}
DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
Snext_read_file_uses_dialog_p, 0, 0, 0,
before any other event (mouse or keypress) is handeled. */)
()
{
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
+#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
return Qnil;
}
-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 exits the minibuffer with
-the same non-empty string that was inserted by this function.
- (If DEFAULT-FILENAME is omitted, the visited file name is used,
- except that if INITIAL is specified, that combined with DIR is used.)
-If the user exits with an empty minibuffer, this function returns
-an empty string. (This can only happen if the user erased the
-pre-inserted contents or if `insert-default-directory' is nil.)
-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 should be an absolute directory name. It defaults to the value of
-`default-directory'.
-
-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.
-
-See also `read-file-name-completion-ignore-case'
-and `read-file-name-function'. */)
- (prompt, dir, default_filename, mustmatch, initial, predicate)
+Lisp_Object
+Fread_file_name (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 (Ffile_name_absolute_p (dir)))
- dir = Fexpand_file_name (dir, Qnil);
- if (NILP (default_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");
-#ifdef DOS_NT
- /* homedir can be NULL in temacs, since Vglobal_environment is not
- yet set up. We shouldn't crash in that case. */
- if (homedir != 0)
- {
- homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
- CORRECT_DIR_SEPS (homedir);
- }
-#endif
- if (homedir != 0)
- decoded_homedir
- = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
- if (homedir != 0
- && STRINGP (dir)
- && !strncmp (SDATA (decoded_homedir), SDATA (dir),
- SBYTES (decoded_homedir))
- && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
- {
- 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 (SDATA (decoded_homedir), SDATA (default_filename),
- SBYTES (decoded_homedir))
- && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
- {
- default_filename
- = Fsubstring (default_filename,
- make_number (SCHARS (decoded_homedir)), Qnil);
- default_filename = concat2 (build_string ("~"), default_filename);
- }
- if (!NILP (default_filename))
- {
- CHECK_STRING (default_filename);
- default_filename = double_dollars (default_filename);
- }
-
- if (insert_default_directory && STRINGP (dir))
- {
- insdef = dir;
- if (!NILP (initial))
- {
- Lisp_Object args[2], pos;
-
- args[0] = insdef;
- args[1] = initial;
- insdef = Fconcat (2, args);
- pos = make_number (SCHARS (double_dollars (dir)));
- insdef = Fcons (double_dollars (insdef), pos);
- }
- else
- insdef = double_dollars (insdef);
- }
- else if (STRINGP (initial))
- insdef = Fcons (double_dollars (initial), make_number (0));
- else
- insdef = Qnil;
-
- 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 ();
- specbind (Qcompletion_ignore_case,
- read_file_name_completion_ignore_case ? Qt : Qnil);
- 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) || defined (USE_GTK) || defined (HAVE_CARBON)
- if (! NILP (Fnext_read_file_uses_dialog_p ()))
- {
- /* If DIR contains a file name, split it. */
- Lisp_Object file;
- file = Ffile_name_nondirectory (dir);
- if (SCHARS (file) && NILP (default_filename))
- {
- default_filename = file;
- dir = Ffile_name_directory (dir);
- }
- if (!NILP(default_filename))
- default_filename = Fexpand_file_name (default_filename, dir);
- val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
- EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
- add_to_history = 1;
- }
- else
-#endif
- val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch, insdef,
- Qfile_name_history, default_filename, Qnil);
-
- tem = Fsymbol_value (Qfile_name_history);
- if (CONSP (tem) && EQ (XCAR (tem), val))
- replace_in_history = 1;
-
- /* If Fcompleting_read returned the inserted default string itself
- (rather than a new string with the same contents),
- it has to mean that the user typed RET with the minibuffer empty.
- In that case, we really want to return ""
- so that commands such as set-visited-file-name can distinguish. */
- if (EQ (val, default_filename))
- {
- /* In this case, Fcompleting_read has not added an element
- to the history. Maybe we should. */
- if (! replace_in_history)
- add_to_history = 1;
-
- val = empty_unibyte_string;
- }
-
- unbind_to (count, Qnil);
- UNGCPRO;
- if (NILP (val))
- error ("No file name specified");
-
- tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
-
- if (!NILP (tem) && !NILP (default_filename))
- val = default_filename;
- val = Fsubstitute_in_file_name (val);
-
- if (replace_in_history)
- /* Replace what Fcompleting_read added to the history
- with what we will actually return. */
- {
- Lisp_Object val1 = double_dollars (val);
- tem = Fsymbol_value (Qfile_name_history);
- if (history_delete_duplicates)
- XSETCDR (tem, Fdelete (val1, XCDR(tem)));
- XSETCAR (tem, val1);
- }
- else if (add_to_history)
- {
- /* Add the value to the history--but not if it matches
- the last value already there. */
- Lisp_Object val1 = double_dollars (val);
- tem = Fsymbol_value (Qfile_name_history);
- if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
- {
- if (history_delete_duplicates) tem = Fdelete (val1, tem);
- Fset (Qfile_name_history, Fcons (val1, tem));
- }
- }
-
- return val;
+ Lisp_Object args[7];
+
+ GCPRO1 (default_filename);
+ args[0] = intern ("read-file-name");
+ args[1] = prompt;
+ args[2] = dir;
+ args[3] = default_filename;
+ args[4] = mustmatch;
+ args[5] = initial;
+ args[6] = predicate;
+ RETURN_UNGCPRO (Ffuncall (7, args));
}
\f
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 ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
- doc: /* *Non-nil means when reading a file name completion ignores case. */);
-#if defined VMS || defined DOS_NT || defined MAC_OS
- read_file_name_completion_ignore_case = 1;
-#else
- read_file_name_completion_ignore_case = 0;
-#endif
-
- DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
- doc: /* *Non-nil means when reading a filename start with default dir in minibuffer.
-If the initial minibuffer contents are non-empty, you can usually
-request a default filename by typing RETURN without editing. For some
-commands, exiting with an empty minibuffer has a special meaning,
-such as making the current buffer visit no file in the case of
-`set-visited-file-name'.
-If this variable is non-nil, the minibuffer contents are always
-initially non-empty and typing RETURN without editing will fetch the
-default name, if one is provided. Note however that this default name
-is not necessarily the name originally inserted in the minibuffer, if
-that is just the default directory.
-If this variable is nil, the minibuffer often starts out empty. In
-that case you may have to explicitly fetch the next history element to
-request the default name. */);
- insert_default_directory = 1;
-
- DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
- 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,
doc: /* Directory separator character for built-in functions that return file names.
The value is always ?/. Don't use this variable, just use `/'. */);
a non-nil value. */);
Vauto_save_list_file_name = Qnil;
+ DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name,
+ doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
+Normally auto-save files are written under other names. */);
+ Vauto_save_visited_file_name = Qnil;
+
#ifdef HAVE_FSYNC
DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
doc: /* *Non-nil means don't call fsync in `write-region'.
write_region_inhibit_fsync = 0;
#endif
+ DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash,
+ doc: /* Specifies whether to use the system's trash can.
+When non-nil, the function `move-file-to-trash' will be used by
+`delete-file' and `delete-directory'. */);
+ delete_by_moving_to_trash = 0;
+ Qmove_file_to_trash = intern ("move-file-to-trash");
+ staticpro (&Qmove_file_to_trash);
+
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Sdelete_file);
defsubr (&Srename_file);
defsubr (&Sadd_name_to_file);
-#ifdef S_IFLNK
defsubr (&Smake_symbolic_link);
-#endif /* S_IFLNK */
-#ifdef VMS
- defsubr (&Sdefine_logical_name);
-#endif /* VMS */
-#ifdef HPUX_NET
- defsubr (&Ssysnetunam);
-#endif /* HPUX_NET */
defsubr (&Sfile_name_absolute_p);
defsubr (&Sfile_exists_p);
defsubr (&Sfile_executable_p);
defsubr (&Sclear_buffer_auto_save_failure);
defsubr (&Srecent_auto_save_p);
- defsubr (&Sread_file_name_internal);
- defsubr (&Sread_file_name);
defsubr (&Snext_read_file_uses_dialog_p);
#ifdef HAVE_SYNC
HCoop / bpt / emacs.git / blobdiff