#include <config.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#ifndef VMS
#include <grp.h>
#endif
#include <errno.h>
#ifdef VMS
#include <string.h>
#include <rms.h>
#include <rmsdef.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#define NAMLEN(p) strlen (p->d_name)
#ifdef SYSV_SYSTEM_DIR
#include <dirent.h>
#define DIRENTRY struct dirent
#else
#ifdef NONSYSTEM_DIR_LIBRARY
#include "ndir.h"
#else
#ifdef MSDOS
#include <dirent.h>
#else
#include <sys/dir.h>
#endif
#endif
#include <sys/stat.h>
#ifndef MSDOS
#define DIRENTRY struct direct
extern DIR *opendir ();
extern struct direct *readdir ();
#endif
#endif
#if defined(MSDOS) || defined(__CYGWIN__)
#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
#else
#define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
#endif
#include "lisp.h"
#include "systime.h"
#include "buffer.h"
#include "commands.h"
#include "charset.h"
#include "coding.h"
#include "regex.h"
#include "blockinput.h"
extern struct re_pattern_buffer *compile_pattern ();
extern void filemodestring P_ ((struct stat *, char *));
#ifndef S_IFLNK
#define lstat stat
#endif
extern int completion_ignore_case;
extern Lisp_Object Vcompletion_regexp_list;
Lisp_Object Vcompletion_ignored_extensions;
Lisp_Object Qcompletion_ignore_case;
Lisp_Object Qdirectory_files;
Lisp_Object Qdirectory_files_and_attributes;
Lisp_Object Qfile_name_completion;
Lisp_Object Qfile_name_all_completions;
Lisp_Object Qfile_attributes;
Lisp_Object Qfile_attributes_lessp;
static int scmp P_ ((unsigned char *, unsigned char *, int));
Lisp_Object
directory_files_internal_unwind (dh)
Lisp_Object dh;
{
DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
BLOCK_INPUT;
closedir (d);
UNBLOCK_INPUT;
return Qnil;
}
Lisp_Object
directory_files_internal (directory, full, match, nosort, attrs, id_format)
Lisp_Object directory, full, match, nosort;
int attrs;
Lisp_Object id_format;
{
DIR *d;
int directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
int needsep = 0;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
#ifdef VMS
bufp = compile_pattern (match, 0,
buffer_defaults.downcase_table, 0, 1);
#else
# ifdef WINDOWSNT
bufp = compile_pattern (match, 0,
buffer_defaults.case_canon_table, 0, 1);
# else
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif
#endif
}
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = ENCODE_FILE (directory);
BLOCK_INPUT;
d = opendir (SDATA (dirfilename));
UNBLOCK_INPUT;
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
record_unwind_protect (directory_files_internal_unwind,
make_save_value (d, 0));
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
#ifndef VMS
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
#endif
for (;;)
{
errno = 0;
dp = readdir (d);
if (dp == NULL && (0
#ifdef EAGAIN
|| errno == EAGAIN
#endif
#ifdef EINTR
|| errno == EINTR
#endif
))
{ QUIT; continue; }
if (dp == NULL)
break;
if (DIRENTRY_NONEMPTY (dp))
{
int len;
int wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
len = NAMLEN (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
name = DECODE_FILE (name);
len = SBYTES (name);
immediate_quit = 1;
QUIT;
if (NILP (match)
|| (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
int nbytes = len + directory_nbytes + needsep;
int nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
bcopy (SDATA (directory), SDATA (fullname),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
bcopy (SDATA (name),
SDATA (fullname) + directory_nbytes + needsep,
len);
nchars = chars_in_text (SDATA (fullname), nbytes);
if (nchars > nbytes)
abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
Lisp_Object decoded_fullname, fileattrs;
struct gcpro gcpro1, gcpro2;
decoded_fullname = fileattrs = Qnil;
GCPRO2 (decoded_fullname, fileattrs);
decoded_fullname = Fexpand_file_name (name, directory);
fileattrs = Ffile_attributes (decoded_fullname, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
UNGCPRO;
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
}
BLOCK_INPUT;
closedir (d);
UNBLOCK_INPUT;
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
RETURN_UNGCPRO (list);
}
DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
doc: )
(directory, full, match, nosort)
Lisp_Object directory, full, match, nosort;
{
Lisp_Object handler;
directory = Fexpand_file_name (directory, Qnil);
handler = Ffind_file_name_handler (directory, Qdirectory_files);
if (!NILP (handler))
return call5 (handler, Qdirectory_files, directory,
full, match, nosort);
return directory_files_internal (directory, full, match, nosort, 0, Qnil);
}
DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
Sdirectory_files_and_attributes, 1, 5, 0,
doc: )
(directory, full, match, nosort, id_format)
Lisp_Object directory, full, match, nosort, id_format;
{
Lisp_Object handler;
directory = Fexpand_file_name (directory, Qnil);
handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
if (!NILP (handler))
return call6 (handler, Qdirectory_files_and_attributes,
directory, full, match, nosort, id_format);
return directory_files_internal (directory, full, match, nosort, 1, id_format);
}
Lisp_Object file_name_completion ();
DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
2, 3, 0,
doc: )
(file, directory, predicate)
Lisp_Object file, directory, predicate;
{
Lisp_Object handler;
handler = Ffind_file_name_handler (directory, Qfile_name_completion);
if (!NILP (handler))
return call4 (handler, Qfile_name_completion, file, directory, predicate);
handler = Ffind_file_name_handler (file, Qfile_name_completion);
if (!NILP (handler))
return call4 (handler, Qfile_name_completion, file, directory, predicate);
return file_name_completion (file, directory, 0, 0, predicate);
}
DEFUN ("file-name-all-completions", Ffile_name_all_completions,
Sfile_name_all_completions, 2, 2, 0,
doc: )
(file, directory)
Lisp_Object file, directory;
{
Lisp_Object handler;
handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
if (!NILP (handler))
return call3 (handler, Qfile_name_all_completions, file, directory);
handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
if (!NILP (handler))
return call3 (handler, Qfile_name_all_completions, file, directory);
return file_name_completion (file, directory, 1, 0, Qnil);
}
static int file_name_completion_stat ();
Lisp_Object
file_name_completion (file, dirname, all_flag, ver_flag, predicate)
Lisp_Object file, dirname;
int all_flag, ver_flag;
Lisp_Object predicate;
{
DIR *d;
int bestmatchsize = 0, skip;
register int compare, matchsize;
unsigned char *p1, *p2;
int matchcount = 0;
Lisp_Object bestmatch, tem, elt, name;
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
struct stat st;
int directoryp;
int passcount;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
#ifdef VMS
extern DIRENTRY * readdirver ();
DIRENTRY *((* readfunc) ());
specbind (Qcompletion_ignore_case, Qt);
readfunc = readdir;
if (ver_flag)
readfunc = readdirver;
file = Fupcase (file);
#else
CHECK_STRING (file);
#endif
#ifdef FILE_SYSTEM_CASE
file = FILE_SYSTEM_CASE (file);
#endif
bestmatch = Qnil;
encoded_file = encoded_dir = Qnil;
GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
dirname = Fexpand_file_name (dirname, Qnil);
encoded_file = ENCODE_FILE (file);
encoded_dir = ENCODE_FILE (dirname);
for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
{
int inner_count = SPECPDL_INDEX ();
BLOCK_INPUT;
d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
UNBLOCK_INPUT;
if (!d)
report_file_error ("Opening directory", Fcons (dirname, Qnil));
record_unwind_protect (directory_files_internal_unwind,
make_save_value (d, 0));
while (1)
{
DIRENTRY *dp;
int len;
#ifdef VMS
dp = (*readfunc) (d);
#else
errno = 0;
dp = readdir (d);
if (dp == NULL && (0
# ifdef EAGAIN
|| errno == EAGAIN
# endif
# ifdef EINTR
|| errno == EINTR
# endif
))
{ QUIT; continue; }
#endif
if (!dp) break;
len = NAMLEN (dp);
QUIT;
if (! DIRENTRY_NONEMPTY (dp)
|| len < SCHARS (encoded_file)
|| 0 <= scmp (dp->d_name, SDATA (encoded_file),
SCHARS (encoded_file)))
continue;
if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
continue;
directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
tem = Qnil;
if (directoryp)
{
#ifndef TRIVIAL_DIRECTORY_ENTRY
#define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
#endif
if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
continue;
if (!passcount && len > SCHARS (encoded_file))
for (tem = Vcompletion_ignored_extensions;
CONSP (tem); tem = XCDR (tem))
{
int elt_len;
elt = XCAR (tem);
if (!STRINGP (elt))
continue;
elt = ENCODE_FILE (elt);
elt_len = SCHARS (elt) - 1;
if (elt_len <= 0)
continue;
p1 = SDATA (elt);
if (p1[elt_len] != '/')
continue;
skip = len - elt_len;
if (skip < 0)
continue;
if (0 <= scmp (dp->d_name + skip, p1, elt_len))
continue;
break;
}
}
else
{
if (!passcount && len > SCHARS (encoded_file))
for (tem = Vcompletion_ignored_extensions;
CONSP (tem); tem = XCDR (tem))
{
elt = XCAR (tem);
if (!STRINGP (elt)) continue;
elt = ENCODE_FILE (elt);
skip = len - SCHARS (elt);
if (skip < 0) continue;
if (0 <= scmp (dp->d_name + skip,
SDATA (elt),
SCHARS (elt)))
continue;
break;
}
}
if (!passcount && CONSP (tem))
continue;
if (!passcount)
{
Lisp_Object regexps;
Lisp_Object zero;
XSETFASTINT (zero, 0);
for (regexps = Vcompletion_regexp_list; CONSP (regexps);
regexps = XCDR (regexps))
{
tem = Fstring_match (XCAR (regexps),
make_string (dp->d_name, len), zero);
if (NILP (tem))
break;
}
if (CONSP (regexps))
continue;
}
if (directoryp)
{
name = Ffile_name_as_directory (make_string (dp->d_name, len));
}
else
name = make_string (dp->d_name, len);
if (!NILP (predicate))
{
Lisp_Object decoded;
Lisp_Object val;
struct gcpro gcpro1;
GCPRO1 (name);
decoded = Fexpand_file_name (DECODE_FILE (name), dirname);
val = call1 (predicate, decoded);
UNGCPRO;
if (NILP (val))
continue;
}
matchcount++;
if (all_flag)
{
name = DECODE_FILE (name);
bestmatch = Fcons (name, bestmatch);
}
else if (NILP (bestmatch))
{
bestmatch = name;
bestmatchsize = SCHARS (name);
}
else
{
compare = min (bestmatchsize, len);
p1 = SDATA (bestmatch);
p2 = (unsigned char *) dp->d_name;
matchsize = scmp (p1, p2, compare);
if (matchsize < 0)
matchsize = compare;
if (completion_ignore_case)
{
if ((matchsize == len
&& matchsize + !!directoryp
< SCHARS (bestmatch))
||
(((matchsize == len)
==
(matchsize + !!directoryp
== SCHARS (bestmatch)))
&& !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
&& bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
bestmatch = name;
}
if (directoryp
&& compare == matchsize
&& bestmatchsize > matchsize
&& IS_ANY_SEP (p1[matchsize]))
matchsize++;
bestmatchsize = matchsize;
}
}
bestmatch = unbind_to (inner_count, bestmatch);
}
UNGCPRO;
bestmatch = unbind_to (count, bestmatch);
if (all_flag || NILP (bestmatch))
{
if (STRINGP (bestmatch))
bestmatch = DECODE_FILE (bestmatch);
return bestmatch;
}
if (matchcount == 1 && bestmatchsize == SCHARS (file))
return Qt;
bestmatch = Fsubstring (bestmatch, make_number (0),
make_number (bestmatchsize));
bestmatch = DECODE_FILE (bestmatch);
return bestmatch;
}
static int
scmp (s1, s2, len)
register unsigned char *s1, *s2;
int len;
{
register int l = len;
if (completion_ignore_case)
{
while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
l--;
}
else
{
while (l && *s1++ == *s2++)
l--;
}
if (l == 0)
return -1;
else
return len - l;
}
static int
file_name_completion_stat (dirname, dp, st_addr)
Lisp_Object dirname;
DIRENTRY *dp;
struct stat *st_addr;
{
int len = NAMLEN (dp);
int pos = SCHARS (dirname);
int value;
char *fullname = (char *) alloca (len + pos + 2);
#ifdef MSDOS
#if __DJGPP__ > 1
unsigned short save_djstat_flags = _djstat_flags;
_djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
#endif
#endif
bcopy (SDATA (dirname), fullname, pos);
#ifndef VMS
if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
fullname[pos++] = DIRECTORY_SEP;
#endif
bcopy (dp->d_name, fullname + pos, len);
fullname[pos + len] = 0;
#ifdef S_IFLNK
value = lstat (fullname, st_addr);
stat (fullname, st_addr);
return value;
#else
value = stat (fullname, st_addr);
#ifdef MSDOS
#if __DJGPP__ > 1
_djstat_flags = save_djstat_flags;
#endif
#endif
return value;
#endif
}
#ifdef VMS
DEFUN ("file-name-all-versions", Ffile_name_all_versions,
Sfile_name_all_versions, 2, 2, 0,
doc: )
(file, directory)
Lisp_Object file, directory;
{
return file_name_completion (file, directory, 1, 1, Qnil);
}
DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object retval;
struct FAB fab;
struct RAB rab;
struct XABFHC xabfhc;
int status;
filename = Fexpand_file_name (filename, Qnil);
fab = cc$rms_fab;
xabfhc = cc$rms_xabfhc;
fab.fab$l_fna = SDATA (filename);
fab.fab$b_fns = strlen (fab.fab$l_fna);
fab.fab$l_xab = (char *) &xabfhc;
status = sys$open (&fab, 0, 0);
if (status != RMS$_NORMAL)
return Qnil;
sys$close (&fab, 0, 0);
if (xabfhc.xab$w_verlimit == 32767)
return Qnil;
else
return make_number (xabfhc.xab$w_verlimit);
}
#endif
Lisp_Object
make_time (time)
time_t time;
{
return Fcons (make_number (time >> 16),
Fcons (make_number (time & 0177777), Qnil));
}
DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
doc: )
(filename, id_format)
Lisp_Object filename, id_format;
{
Lisp_Object values[12];
Lisp_Object encoded;
struct stat s;
struct passwd *pw;
struct group *gr;
#if defined (BSD4_2) || defined (BSD4_3)
Lisp_Object dirname;
struct stat sdir;
#endif
char modes[10];
Lisp_Object handler;
struct gcpro gcpro1;
EMACS_INT uid, gid, ino;
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qfile_attributes);
if (!NILP (handler))
{
if (NILP (id_format))
return call2 (handler, Qfile_attributes, filename);
else
return call3 (handler, Qfile_attributes, filename, id_format);
}
GCPRO1 (filename);
encoded = ENCODE_FILE (filename);
UNGCPRO;
if (lstat (SDATA (encoded), &s) < 0)
return Qnil;
switch (s.st_mode & S_IFMT)
{
default:
values[0] = Qnil; break;
case S_IFDIR:
values[0] = Qt; break;
#ifdef S_IFLNK
case S_IFLNK:
values[0] = Ffile_symlink_p (filename); break;
#endif
}
values[1] = make_number (s.st_nlink);
uid = s.st_uid;
gid = s.st_gid;
if (NILP (id_format) || EQ (id_format, Qinteger))
{
values[2] = make_fixnum_or_float (uid);
values[3] = make_fixnum_or_float (gid);
}
else
{
BLOCK_INPUT;
pw = (struct passwd *) getpwuid (uid);
values[2] = (pw ? build_string (pw->pw_name)
: make_fixnum_or_float (uid));
gr = (struct group *) getgrgid (gid);
values[3] = (gr ? build_string (gr->gr_name)
: make_fixnum_or_float (gid));
UNBLOCK_INPUT;
}
values[4] = make_time (s.st_atime);
values[5] = make_time (s.st_mtime);
values[6] = make_time (s.st_ctime);
values[7] = make_number (s.st_size);
if (XINT (values[7]) != s.st_size)
values[7] = make_float ((double)s.st_size);
if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
values[7] = make_float ((double) ((unsigned long) s.st_size));
filemodestring (&s, modes);
values[8] = make_string (modes, 10);
#if defined (BSD4_2) || defined (BSD4_3)
dirname = Ffile_name_directory (filename);
if (! NILP (dirname))
encoded = ENCODE_FILE (dirname);
if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
values[9] = (sdir.st_gid != gid) ? Qt : Qnil;
else
values[9] = Qt;
#else
values[9] = (gid != getegid ()) ? Qt : Qnil;
#endif
ino = s.st_ino;
if (FIXNUM_OVERFLOW_P (ino))
values[10] = Fcons (make_number (ino >> 16),
make_number (ino & 0xffff));
else
values[10] = make_number (ino);
if (FIXNUM_OVERFLOW_P (s.st_dev))
values[11] = Fcons (make_number (s.st_dev >> 16),
make_number (s.st_dev & 0xffff));
else
values[11] = make_number (s.st_dev);
return Flist (sizeof(values) / sizeof(values[0]), values);
}
DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
doc: )
(f1, f2)
Lisp_Object f1, f2;
{
return Fstring_lessp (Fcar (f1), Fcar (f2));
}
void
syms_of_dired ()
{
Qdirectory_files = intern ("directory-files");
Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
Qfile_name_completion = intern ("file-name-completion");
Qfile_name_all_completions = intern ("file-name-all-completions");
Qfile_attributes = intern ("file-attributes");
Qfile_attributes_lessp = intern ("file-attributes-lessp");
staticpro (&Qdirectory_files);
staticpro (&Qdirectory_files_and_attributes);
staticpro (&Qfile_name_completion);
staticpro (&Qfile_name_all_completions);
staticpro (&Qfile_attributes);
staticpro (&Qfile_attributes_lessp);
defsubr (&Sdirectory_files);
defsubr (&Sdirectory_files_and_attributes);
defsubr (&Sfile_name_completion);
#ifdef VMS
defsubr (&Sfile_name_all_versions);
defsubr (&Sfile_version_limit);
#endif
defsubr (&Sfile_name_all_completions);
defsubr (&Sfile_attributes);
defsubr (&Sfile_attributes_lessp);
#ifdef VMS
Qcompletion_ignore_case = intern ("completion-ignore-case");
staticpro (&Qcompletion_ignore_case);
#endif
DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
doc: );
Vcompletion_ignored_extensions = Qnil;
}