Mercurial > emacs
changeset 153:636408ebaaaa
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 31 Dec 1990 04:18:02 +0000 |
parents | 50e816f7e0a5 |
children | 48df093640da |
files | src/dired.c src/mocklisp.c |
diffstat | 2 files changed, 720 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dired.c Mon Dec 31 04:18:02 1990 +0000 @@ -0,0 +1,478 @@ +/* Lisp functions for making directory listings. + Copyright (C) 1985, 1986 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +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 1, 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 +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +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, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +#include <stdio.h> +#include <sys/types.h> +#include <sys/stat.h> + +#include "config.h" + +#ifdef SYSV_SYSTEM_DIR + +#include <dirent.h> +#define DIRENTRY struct dirent +#define NAMLEN(p) strlen (p->d_name) + +#else + +#ifdef NONSYSTEM_DIR_LIBRARY +#include "ndir.h" +#else /* not NONSYSTEM_DIR_LIBRARY */ +#include <sys/dir.h> +#endif /* not NONSYSTEM_DIR_LIBRARY */ + +#define DIRENTRY struct direct +#define NAMLEN(p) p->d_namlen + +extern DIR *opendir (); +extern struct direct *readdir (); + +#endif + +#undef NULL + +#include "lisp.h" +#include "buffer.h" +#include "commands.h" + +#include "regex.h" +#include "search.h" + +#define min(a, b) ((a) < (b) ? (a) : (b)) + +/* if system does not have symbolic links, it does not have lstat. + In that case, use ordinary stat instead. */ + +#ifndef S_IFLNK +#define lstat stat +#endif + +Lisp_Object Vcompletion_ignored_extensions; + +Lisp_Object Qcompletion_ignore_case; + +DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, + "Return a list of names of files in DIRECTORY.\n\ +There are three optional arguments:\n\ +If FULL is non-nil, absolute pathnames of the files are returned.\n\ +If MATCH is non-nil, only pathnames containing that regexp are returned.\n\ +If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ + NOSORT is useful if you plan to sort the result yourself.") + (dirname, full, match, nosort) + Lisp_Object dirname, full, match, nosort; +{ + DIR *d; + int length; + Lisp_Object list, name; + + if (!NULL (match)) + { + CHECK_STRING (match, 3); + /* Compile it now so we don't get an error after opendir */ +#ifdef VMS + compile_pattern (match, &searchbuf, + buffer_defaults.downcase_table->contents); +#else + compile_pattern (match, &searchbuf, 0); +#endif + } + + dirname = Fexpand_file_name (dirname, Qnil); + if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data))) + report_file_error ("Opening directory", Fcons (dirname, Qnil)); + + list = Qnil; + length = XSTRING (dirname)->size; + + /* Loop reading blocks */ + while (1) + { + DIRENTRY *dp = readdir (d); + int len; + + if (!dp) break; + len = NAMLEN (dp); + if (dp->d_ino) + { + if (NULL (match) + || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0))) + { + if (!NULL (full)) + { + int index = XSTRING (dirname)->size; + int total = len + index; +#ifndef VMS + if (length == 0 + || XSTRING (dirname)->data[length - 1] != '/') + total++; +#endif /* VMS */ + + name = make_uninit_string (total); + bcopy (XSTRING (dirname)->data, XSTRING (name)->data, + index); +#ifndef VMS + if (length == 0 + || XSTRING (dirname)->data[length - 1] != '/') + XSTRING (name)->data[index++] = '/'; +#endif /* VMS */ + bcopy (dp->d_name, XSTRING (name)->data + index, len); + } + else + name = make_string (dp->d_name, len); + list = Fcons (name, list); + } + } + } + closedir (d); + if (!NULL (nosort)) + return list; + return Fsort (Fnreverse (list), Qstring_lessp); +} + +Lisp_Object file_name_completion (); + +DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, + 2, 2, 0, + "Complete file name FILE in directory DIR.\n\ +Returns the longest string\n\ +common to all filenames in DIR that start with FILE.\n\ +If there is only one and FILE matches it exactly, returns t.\n\ +Returns nil if DIR contains no name starting with FILE.") + (file, dirname) + Lisp_Object file, dirname; +{ + /* Don't waste time trying to complete a null string. + Besides, this case happens when user is being asked for + a directory name and has supplied one ending in a /. + We would not want to add anything in that case + even if there are some unique characters in that directory. */ + if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0) + return file; + return file_name_completion (file, dirname, 0, 0); +} + +DEFUN ("file-name-all-completions", Ffile_name_all_completions, + Sfile_name_all_completions, 2, 2, 0, + "Return a list of all completions of file name FILE in directory DIR.\n\ +These are all file names in directory DIR which begin with FILE.") + (file, dirname) + Lisp_Object file, dirname; +{ + return file_name_completion (file, dirname, 1, 0); +} + +#ifdef VMS + +DEFUN ("file-name-all-versions", Ffile_name_all_versions, + Sfile_name_all_versions, 2, 2, 0, + "Return a list of all versions of file name FILE in directory DIR.") + (file, dirname) + Lisp_Object file, dirname; +{ + return file_name_completion (file, dirname, 1, 1); +} + +#endif /* VMS */ + +Lisp_Object +file_name_completion (file, dirname, all_flag, ver_flag) + Lisp_Object file, dirname; + int all_flag, ver_flag; +{ + DIR *d; + DIRENTRY *dp; + int bestmatchsize, skip; + register int compare, matchsize; + unsigned char *p1, *p2; + int matchcount = 0; + Lisp_Object bestmatch, tem, elt, name; + struct stat st; + int directoryp; + int passcount; + int count = specpdl_ptr - specpdl; +#ifdef VMS + extern DIRENTRY * readdirver (); + + DIRENTRY *((* readfunc) ()); + + /* Filename completion on VMS ignores case, since VMS filesys does. */ + specbind (Qcompletion_ignore_case, Qt); + + readfunc = readdir; + if (ver_flag) + readfunc = readdirver; + file = Fupcase (file); +#else /* not VMS */ + CHECK_STRING (file, 0); +#endif /* not VMS */ + + dirname = Fexpand_file_name (dirname, Qnil); + bestmatch = Qnil; + + /* With passcount = 0, ignore files that end in an ignored extension. + If nothing found then try again with passcount = 1, don't ignore them. + If looking for all completions, start with passcount = 1, + so always take even the ignored ones. + + ** It would not actually be helpful to the user to ignore any possible + completions when making a list of them.** */ + + for (passcount = !!all_flag; NULL (bestmatch) && passcount < 2; passcount++) + { + if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data))) + report_file_error ("Opening directory", Fcons (dirname, Qnil)); + + /* Loop reading blocks */ + /* (att3b compiler bug requires do a null comparison this way) */ + while (1) + { + DIRENTRY *dp; + int len; + +#ifdef VMS + dp = (*readfunc) (d); +#else + dp = readdir (d); +#endif + if (!dp) break; + + len = NAMLEN (dp); + + if (!NULL (Vquit_flag) && NULL (Vinhibit_quit)) + goto quit; + if (!dp->d_ino + || len < XSTRING (file)->size + || 0 <= scmp (dp->d_name, XSTRING (file)->data, + XSTRING (file)->size)) + continue; + + if (file_name_completion_stat (dirname, dp, &st) < 0) + continue; + + directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); + tem = Qnil; + if (!directoryp) + { + /* Compare extensions-to-be-ignored against end of this file name */ + /* if name is not an exact match against specified string */ + if (!passcount && len > XSTRING (file)->size) + /* and exit this for loop if a match is found */ + for (tem = Vcompletion_ignored_extensions; + CONSP (tem); tem = XCONS (tem)->cdr) + { + elt = XCONS (tem)->car; + if (XTYPE (elt) != Lisp_String) continue; + skip = len - XSTRING (elt)->size; + if (skip < 0) continue; + + if (0 <= scmp (dp->d_name + skip, + XSTRING (elt)->data, + XSTRING (elt)->size)) + continue; + break; + } + } + + /* Unless an ignored-extensions match was found, + process this name as a completion */ + if (passcount || !CONSP (tem)) + { + /* Update computation of how much all possible completions match */ + + matchcount++; + + if (all_flag || NULL (bestmatch)) + { + /* This is a possible completion */ + if (directoryp) + { + /* This completion is a directory; make it end with '/' */ + name = Ffile_name_as_directory (make_string (dp->d_name, len)); + } + else + name = make_string (dp->d_name, len); + if (all_flag) + { + bestmatch = Fcons (name, bestmatch); + } + else + { + bestmatch = name; + bestmatchsize = XSTRING (name)->size; + } + } + else + { + compare = min (bestmatchsize, len); + p1 = XSTRING (bestmatch)->data; + p2 = (unsigned char *) dp->d_name; + matchsize = scmp(p1, p2, compare); + if (matchsize < 0) + matchsize = compare; + /* If this dirname all matches, + see if implicit following slash does too. */ + if (directoryp + && compare == matchsize + && bestmatchsize > matchsize + && p1[matchsize] == '/') + matchsize++; + bestmatchsize = min (matchsize, bestmatchsize); + } + } + } + closedir (d); + } + + unbind_to (count, Qnil); + + if (all_flag || NULL (bestmatch)) + return bestmatch; + if (matchcount == 1 && bestmatchsize == XSTRING (file)->size) + return Qt; + return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize)); + quit: + if (d) closedir (d); + Vquit_flag = Qnil; + return Fsignal (Qquit, Qnil); +} + +file_name_completion_stat (dirname, dp, st_addr) + Lisp_Object dirname; + DIRENTRY *dp; + struct stat *st_addr; +{ + int len = NAMLEN (dp); + int pos = XSTRING (dirname)->size; + char *fullname = (char *) alloca (len + pos + 2); + + bcopy (XSTRING (dirname)->data, fullname, pos); +#ifndef VMS + if (fullname[pos - 1] != '/') + fullname[pos++] = '/'; +#endif + + bcopy (dp->d_name, fullname + pos, len); + fullname[pos + len] = 0; + + return stat (fullname, st_addr); +} + +Lisp_Object +make_time (time) + int time; +{ + return Fcons (make_number (time >> 16), + Fcons (make_number (time & 0177777), Qnil)); +} + +DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0, + "Return a list of attributes of file FILENAME.\n\ +Value is nil if specified file cannot be opened.\n\ +Otherwise, list elements are:\n\ + 0. t for directory, string (name linked to) for symbolic link, or nil.\n\ + 1. Number of links to file.\n\ + 2. File uid.\n\ + 3. File gid.\n\ + 4. Last access time, as a list of two integers.\n\ + First integer has high-order 16 bits of time, second has low 16 bits.\n\ + 5. Last modification time, likewise.\n\ + 6. Last status change time, likewise.\n\ + 7. Size in bytes.\n\ + 8. File modes, as a string of ten letters or dashes as in ls -l.\n\ + 9. t iff file's gid would change if file were deleted and recreated.\n\ +10. inode number.\n\ +11. Device number.\n\ +\n\ +If file does not exists, returns nil.") + (filename) + Lisp_Object filename; +{ + Lisp_Object values[12]; + Lisp_Object dirname; + struct stat s; + struct stat sdir; + char modes[10]; + + filename = Fexpand_file_name (filename, Qnil); + if (lstat (XSTRING (filename)->data, &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); + values[2] = make_number (s.st_uid); + values[3] = make_number (s.st_gid); + values[4] = make_time (s.st_atime); + values[5] = make_time (s.st_mtime); + values[6] = make_time (s.st_ctime); + /* perhaps we should set this to most-positive-fixnum if it is too large? */ + values[7] = make_number (s.st_size); + filemodestring (&s, modes); + values[8] = make_string (modes, 10); +#ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */ +#define BSD4_2 /* A new meaning to the term `backwards compatability' */ +#endif +#ifdef BSD4_2 /* file gid will be dir gid */ + dirname = Ffile_name_directory (filename); + if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0) + values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; + else /* if we can't tell, assume worst */ + values[9] = Qt; +#else /* file gid will be egid */ + values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; +#endif /* BSD4_2 (or BSD4_3) */ +#ifdef BSD4_3 +#undef BSD4_2 /* ok, you can look again without throwing up */ +#endif + values[10] = make_number (s.st_ino); + values[11] = make_number (s.st_dev); + return Flist (sizeof(values) / sizeof(values[0]), values); +} + +syms_of_dired () +{ + defsubr (&Sdirectory_files); + defsubr (&Sfile_name_completion); +#ifdef VMS + defsubr (&Sfile_name_all_versions); +#endif /* VMS */ + defsubr (&Sfile_name_all_completions); + defsubr (&Sfile_attributes); + +#ifdef VMS + Qcompletion_ignore_case = intern ("completion-ignore-case"); + staticpro (&Qcompletion_ignore_case); +#endif /* VMS */ + + DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions, + "*Completion ignores filenames ending in any string in this list.\n\ +This variable does not affect lists of possible completions,\n\ +but does affect the commands that actually do completions."); + Vcompletion_ignored_extensions = Qnil; +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/mocklisp.c Mon Dec 31 04:18:02 1990 +0000 @@ -0,0 +1,242 @@ +/* Mocklisp compatibility functions for GNU Emacs Lisp interpreter. + Copyright (C) 1985, 1986 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +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 1, 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 +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +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, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +/* Compatibility for mocklisp */ + +#include "config.h" +#include "lisp.h" +#include "buffer.h" + +/* Now in lisp code ("macrocode...") +* DEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0, +* "Define mocklisp functions") +* (args) +* Lisp_Object args; +* { +* Lisp_Object elt; +* +* while (!NULL (args)) +* { +* elt = Fcar (args); +* Ffset (Fcar (elt), Fcons (Qmocklisp, Fcdr (elt))); +* args = Fcdr (args); +* } +* return Qnil; +* } +*/ + +DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0, "Mocklisp version of `if'.") + (args) + Lisp_Object args; +{ + register Lisp_Object val; + struct gcpro gcpro1; + + GCPRO1 (args); + while (!NULL (args)) + { + val = Feval (Fcar (args)); + args = Fcdr (args); + if (NULL (args)) break; + if (XINT (val)) + { + val = Feval (Fcar (args)); + break; + } + args = Fcdr (args); + } + UNGCPRO; + return val; +} + +/* Now converted to regular "while" by hairier conversion code. +* DEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0, "while for mocklisp programs") +* (args) +* Lisp_Object args; +* { +* Lisp_Object test, body, tem; +* struct gcpro gcpro1, gcpro2; +* +* GCPRO2 (test, body); +* +* test = Fcar (args); +* body = Fcdr (args); +* while (tem = Feval (test), XINT (tem)) +* { +* QUIT; +* Fprogn (body); +* } +* +* UNGCPRO; +* return Qnil; +*} + +/* This is the main entry point to mocklisp execution. + When eval sees a mocklisp function being called, it calls here + with the unevaluated argument list */ + +Lisp_Object +ml_apply (function, args) + Lisp_Object function, args; +{ + register int count = specpdl_ptr - specpdl; + register Lisp_Object val; + + specbind (Qmocklisp_arguments, args); + val = Fprogn (Fcdr (function)); + return unbind_to (count, val); +} + +DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0, + "Number of arguments to currently executing mocklisp function.") + () +{ + if (EQ (Vmocklisp_arguments, Qinteractive)) + return make_number (0); + return Flength (Vmocklisp_arguments); +} + +DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0, + "Argument number N to currently executing mocklisp function.") + (n, prompt) + Lisp_Object n, prompt; +{ + if (EQ (Vmocklisp_arguments, Qinteractive)) + return Fread_string (prompt, Qnil); + CHECK_NUMBER (n, 0); + XSETINT (n, XINT (n) - 1); /* Mocklisp likes to be origin-1 */ + return Fcar (Fnthcdr (n, Vmocklisp_arguments)); +} + +DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0, + "True if currently executing mocklisp function was called interactively.") + () +{ + return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil; +} + +DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, + 2, UNEVALLED, 0, + "Evaluate second argument, using first argument as prefix arg value.") + (args) + Lisp_Object args; +{ + struct gcpro gcpro1; + GCPRO1 (args); + Vcurrent_prefix_arg = Feval (Fcar (args)); + UNGCPRO; + return Feval (Fcar (Fcdr (args))); +} + +DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop, + 0, UNEVALLED, 0, + "") + (args) + Lisp_Object args; +{ + register Lisp_Object tem; + register int i; + struct gcpro gcpro1; + + /* Set `arg' in case we call a built-in function that looks at it. Still are a few. */ + if (NULL (Vcurrent_prefix_arg)) + i = 1; + else + { + tem = Vcurrent_prefix_arg; + if (CONSP (tem)) + tem = Fcar (tem); + if (EQ (tem, Qminus)) + i = -1; + else i = XINT (tem); + } + + GCPRO1 (args); + while (i-- > 0) + Fprogn (args); + UNGCPRO; + return Qnil; +} + +#if 0 /* Now in mlsupport.el */ + +DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0, + "Return a substring of STRING, starting at index FROM and of length LENGTH.\n\ +If either FROM or LENGTH is negative, the length of STRING is added to it.") + (string, from, to) + Lisp_Object string, from, to; +{ + CHECK_STRING (string, 0); + CHECK_NUMBER (from, 1); + CHECK_NUMBER (to, 2); + + if (XINT (from) < 0) + XSETINT (from, XINT (from) + XSTRING (string)->size); + if (XINT (to) < 0) + XSETINT (to, XINT (to) + XSTRING (string)->size); + XSETINT (to, XINT (to) + XINT (from)); + return Fsubstring (string, from, to); +} +#endif NOTDEF +DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0, + "Mocklisp-compatibility insert function.\n\ +Like the function `insert' except that any argument that is a number\n\ +is converted into a string by expressing it in decimal.") + (nargs, args) + int nargs; + Lisp_Object *args; +{ + register int argnum; + register Lisp_Object tem; + + for (argnum = 0; argnum < nargs; argnum++) + { + tem = args[argnum]; + retry: + if (XTYPE (tem) == Lisp_Int) + tem = Fint_to_string (tem); + if (XTYPE (tem) == Lisp_String) + insert1 (tem); + else + { + tem = wrong_type_argument (Qstringp, tem); + goto retry; + } + } + return Qnil; +} + + +syms_of_mocklisp () +{ + Qmocklisp = intern ("mocklisp"); + staticpro (&Qmocklisp); + +/*defsubr (&Sml_defun);*/ + defsubr (&Sml_if); +/*defsubr (&Sml_while);*/ + defsubr (&Sml_arg); + defsubr (&Sml_nargs); + defsubr (&Sml_interactive); + defsubr (&Sml_provide_prefix_argument); + defsubr (&Sml_prefix_argument_loop); +/*defsubr (&Sml_substr);*/ + defsubr (&Sinsert_string); +}