Lisp_Object Qdirectory_file_name;
Lisp_Object Qfile_name_directory;
Lisp_Object Qfile_name_nondirectory;
+Lisp_Object Qunhandled_file_name_directory;
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory;
Lisp_Object Qwrite_region;
Lisp_Object Qverify_visited_file_modtime;
-/* If FILENAME is handled specially on account of its syntax,
- return its handler function. Otherwise, return nil. */
-
-Lisp_Object
-find_file_handler (filename)
- Lisp_Object filename;
+DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
+ "Return FILENAME's handler function, if its syntax is handled specially.\n\
+Otherwise, return nil.\n\
+A file name is handled if one of the regular expressions in\n\
+`file-name-handler-alist' matches it.")
+ (filename)
+ Lisp_Object filename;
{
+ /* This function must not munge the match data. */
+
Lisp_Object chain;
for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
chain = XCONS (chain)->cdr)
&& fast_string_match (string, filename) >= 0)
return XCONS (elt)->cdr;
}
+
+ QUIT;
}
return Qnil;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (file);
+ handler = Ffind_file_name_handler (file);
if (!NILP (handler))
return call2 (handler, Qfile_name_directory, file);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (file);
+ handler = Ffind_file_name_handler (file);
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, file);
return make_string (p, end - p);
}
+
+DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
+ "Return a directly usable directory name somehow associated with FILENAME.\n\
+A `directly usable' directory name is one that may be used without the\n\
+intervention of any file handler.\n\
+If FILENAME is a directly usable file itself, return\n\
+(file-name-directory FILENAME).\n\
+The `call-process' and `start-process' functions use this function to\n\
+get a current directory to run processes in.")
+ (filename)
+ Lisp_Object filename;
+{
+ Lisp_Object handler;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ if (!NILP (handler))
+ return call2 (handler, Qunhandled_file_name_directory, filename);
+
+ return Ffile_name_directory (filename);
+}
+
\f
char *
file_name_as_directory (out, in)
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (file);
+ handler = Ffind_file_name_handler (file);
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
&& (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] = ':';
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (directory);
+ handler = Ffind_file_name_handler (directory);
if (!NILP (handler))
return call2 (handler, Qdirectory_file_name, directory);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (name);
+ handler = Ffind_file_name_handler (name);
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, name, defalt);
lose = 0;
while (*p)
{
+ /* Since we know the path is absolute, we can assume that each
+ element starts with a "/". */
+
+ /* "//" anywhere isn't necessarily hairy; we just start afresh
+ with the second slash. */
if (p[0] == '/' && p[1] == '/'
#ifdef APOLLO
/* // at start of filename is meaningful on Apollo system */
#endif /* APOLLO */
)
nm = p + 1;
+
+ /* "~" is hairy as the start of any path element. */
if (p[0] == '/' && p[1] == '~')
nm = p + 1, lose = 1;
- if (p[0] == '/' && p[1] == '.'
- && (p[2] == '/' || p[2] == 0
- || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
+
+ /* "." and ".." are hairy. */
+ if (p[0] == '/'
+ && p[1] == '.'
+ && (p[2] == '/'
+ || p[2] == 0
+ || (p[2] == '.' && (p[3] == '/'
+ || p[3] == 0))))
lose = 1;
#ifdef VMS
if (p[0] == '\\')
newdir = 0;
if (nm[0] == '~') /* prefix ~ */
- if (nm[1] == '/'
+ {
+ if (nm[1] == '/'
#ifdef VMS
- || nm[1] == ':'
-#endif /* VMS */
- || nm[1] == 0)/* ~ by itself */
- {
- if (!(newdir = (unsigned char *) egetenv ("HOME")))
- newdir = (unsigned char *) "";
- nm++;
+ || nm[1] == ':'
+#endif /* VMS */
+ || nm[1] == 0) /* ~ by itself */
+ {
+ 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 */
- {
- for (p = nm; *p && (*p != '/'
+ nm++; /* Don't leave the slash in nm. */
+#endif /* VMS */
+ }
+ else /* ~user/filename */
+ {
+ for (p = nm; *p && (*p != '/'
#ifdef VMS
- && *p != ':'
-#endif /* VMS */
- ); p++);
- o = (unsigned char *) alloca (p - nm + 1);
- bcopy ((char *) nm, o, p - nm);
- o [p - nm] = 0;
+ && *p != ':'
+#endif /* VMS */
+ ); p++);
+ o = (unsigned char *) alloca (p - nm + 1);
+ bcopy ((char *) nm, o, p - nm);
+ o [p - nm] = 0;
- pw = (struct passwd *) getpwnam (o + 1);
- if (pw)
- {
- newdir = (unsigned char *) pw -> pw_dir;
+ pw = (struct passwd *) getpwnam (o + 1);
+ if (pw)
+ {
+ newdir = (unsigned char *) pw -> pw_dir;
#ifdef VMS
- nm = p + 1; /* skip the terminator */
+ nm = p + 1; /* skip the terminator */
#else
- nm = p;
-#endif /* VMS */
- }
+ nm = p;
+#endif /* VMS */
+ }
- /* If we don't find a user of that name, leave the name
- unchanged; don't move nm forward to p. */
- }
+ /* If we don't find a user of that name, leave the name
+ unchanged; don't move nm forward to p. */
+ }
+ }
if (nm[0] != '/'
#ifdef VMS
strcpy (target, newdir);
else
#endif
- file_name_as_directory (target, newdir);
+ file_name_as_directory (target, newdir);
}
strcat (target, nm);
strcpy (target, sys_translate_unix (target));
#endif /* VMS */
- /* Now canonicalize by removing /. and /foo/.. if they appear */
+ /* Now canonicalize by removing /. and /foo/.. if they appear. */
p = target;
o = target;
o = target;
p++;
}
- else if (p[0] == '/' && p[1] == '.' &&
- (p[2] == '/' || p[2] == 0))
- p += 2;
+ else if (p[0] == '/'
+ && p[1] == '.'
+ && (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 (!strncmp (p, "/..", 3)
/* `/../' is the "superroot" on certain file systems. */
&& o != target
/* If the input file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call3 (handler, Qcopy_file, filename, newname);
/* Likewise for output file name. */
- handler = find_file_handler (newname);
+ handler = Ffind_file_name_handler (newname);
if (!NILP (handler))
return call3 (handler, Qcopy_file, filename, newname);
return Qnil;
}
-DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake directory: ",
+DEFUN ("make-directory-internal", Fmake_directory_internal,
+ Smake_directory_internal, 1, 1, 0,
"Create a directory. One argument, a file name string.")
(dirname)
Lisp_Object dirname;
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
- handler = find_file_handler (dirname);
+ handler = Ffind_file_name_handler (dirname);
if (!NILP (handler))
- return call2 (handler, Qmake_directory, dirname);
-
+ return call3 (handler, Qmake_directory, dirname, Qnil);
+
dir = XSTRING (dirname)->data;
if (mkdir (dir, 0777) != 0)
dirname = Fexpand_file_name (dirname, Qnil);
dir = XSTRING (dirname)->data;
- handler = find_file_handler (dirname);
+ handler = Ffind_file_name_handler (dirname);
if (!NILP (handler))
return call2 (handler, Qdelete_directory, dirname);
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call3 (handler, Qrename_file, filename, newname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call3 (handler, Qadd_name_to_file, filename, newname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call3 (handler, Qmake_symbolic_link, filename, linkname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call2 (handler, Qfile_modes, abspath);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath);
+ handler = Ffind_file_name_handler (abspath);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, abspath, mode);
return Qnil;
}
-DEFUN ("set-umask", Fset_umask, Sset_umask, 1, 1, 0,
- "Select which permission bits to disable in newly created files.\n\
-MASK should be an integer; if a permission's bit in MASK is 1,\n\
-subsequently created files will not have that permission enabled.\n\
-Only the low 9 bits are used.\n\
+DEFUN ("set-default-file-mode", Fset_default_file_mode, Sset_default_file_mode, 1, 1, 0,
+ "Set the file permission bits for newly created files.\n\
+The argument MODE should be an integer; only the low 9 bits are used.\n\
This setting is inherited by subprocesses.")
- (mask)
- Lisp_Object mask;
+ (mode)
+ Lisp_Object mode;
{
- CHECK_NUMBER (mask, 0);
+ CHECK_NUMBER (mode, 0);
- umask (XINT (mask) & 0777);
+ umask ((~ XINT (mode)) & 0777);
return Qnil;
}
-DEFUN ("umask", Fumask, Sumask, 0, 0, 0,
- "Return the current umask value.\n\
-The umask value determines which permissions are enabled in newly\n\
-created files. If a permission's bit in the umask is 1, subsequently\n\
-created files will not have that permission enabled.")
+DEFUN ("default-file-mode", Fdefault_file_mode, Sdefault_file_mode, 0, 0, 0,
+ "Return the default file protection for created files.\n\
+The value is an integer.")
()
{
- Lisp_Object mask;
+ int realmask;
+ Lisp_Object value;
- XSET (mask, Lisp_Int, umask (0));
- umask (XINT (mask));
+ realmask = umask (0);
+ umask (realmask);
- return mask;
+ XSET (value, Lisp_Int, (~ realmask) & 0777);
+ return value;
}
#ifdef unix
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (abspath1);
+ handler = Ffind_file_name_handler (abspath1);
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
{
val = call3 (handler, Qinsert_file_contents, filename, visit);
Optional fifth argument VISIT if t means\n\
set the last-save-file-modtime of buffer to this file's modtime\n\
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\
+If VISIT is neither t nor nil nor a string,\n\
+ that means do not print the \"Wrote file\" message.\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)
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
#endif /* VMS */
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
+ 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);
- GCPRO2 (start, filename);
+ GCPRO4 (start, filename, visit, visit_file);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
{
/* 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;
{
#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 (b->filename);
+ handler = Ffind_file_name_handler (b->filename);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = find_file_handler (filename);
+ handler = Ffind_file_name_handler (filename);
if (!NILP (handler))
current_buffer->modtime = 0;
Qdirectory_file_name = intern ("directory-file-name");
Qfile_name_directory = intern ("file-name-directory");
Qfile_name_nondirectory = intern ("file-name-nondirectory");
+ Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
Qmake_directory = intern ("make-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 (&Qexpand_file_name);
+ staticpro (&Qdirectory_file_name);
+ staticpro (&Qfile_name_directory);
+ staticpro (&Qfile_name_nondirectory);
+ staticpro (&Qunhandled_file_name_directory);
+ staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
staticpro (&Qmake_directory);
staticpro (&Qdelete_directory);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
+
+ Qfile_name_history = intern ("file-name-history");
+ Fset (Qfile_name_history, Qnil);
staticpro (&Qfile_name_history);
Qfile_error = intern ("file-error");
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)");
+ (funcall HANDLER 'file-exists-p FILENAME)\n\
+The function `find-file-name-handler' checks this list for a handler\n\
+for its argument.");
Vfile_name_handler_alist = Qnil;
+ defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
+ defsubr (&Sunhandled_file_name_directory);
defsubr (&Sfile_name_as_directory);
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_name);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
- defsubr (&Smake_directory);
+ defsubr (&Smake_directory_internal);
defsubr (&Sdelete_directory);
defsubr (&Sdelete_file);
defsubr (&Srename_file);
defsubr (&Sfile_accessible_directory_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
- defsubr (&Sset_umask);
- defsubr (&Sumask);
+ defsubr (&Sset_default_file_mode);
+ defsubr (&Sdefault_file_mode);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sinsert_file_contents);
defsubr (&Swrite_region);
HCoop / bpt / emacs.git / blobdiff