![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dired.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to dired.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Lisp functions for making directory listings.
2: Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <stdio.h>
23: #include <sys/types.h>
24: #include <sys/stat.h>
25:
26: #include "config.h"
27:
28: #ifdef SYSV_SYSTEM_DIR
29:
30: #include <dirent.h>
31: #define DIRENTRY struct dirent
32: #define NAMLEN(p) strlen (p->d_name)
33:
34: #else
35:
36: #ifdef NONSYSTEM_DIR_LIBRARY
37: #include "ndir.h"
38: #else /* not NONSYSTEM_DIR_LIBRARY */
39: #include <sys/dir.h>
40: #endif /* not NONSYSTEM_DIR_LIBRARY */
41:
42: #define DIRENTRY struct direct
43: #define NAMLEN(p) p->d_namlen
44:
45: extern DIR *opendir ();
46: extern struct direct *readdir ();
47:
48: #endif
49:
50: #undef NULL
51:
52: #include "lisp.h"
53: #include "buffer.h"
54: #include "commands.h"
55:
56: #include "regex.h"
57:
58: #define min(a, b) ((a) < (b) ? (a) : (b))
59:
60: /* if system does not have symbolic links, it does not have lstat.
61: In that case, use ordinary stat instead. */
62:
63: #ifndef S_IFLNK
64: #define lstat stat
65: #endif
66:
67: Lisp_Object Vcompletion_ignored_extensions;
68:
69: Lisp_Object Qcompletion_ignore_case;
70:
71: DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 3, 0,
72: "Return a list of names of files in DIRECTORY.\n\
73: If FULL is non-NIL, absolute pathnames of the files are returned.\n\
74: If MATCH is non-NIL, only pathnames containing that regexp are returned.")
75: (dirname, full, match)
76: Lisp_Object dirname, full, match;
77: {
78: DIR *d;
79: char slashfilename[MAXNAMLEN+2];
80: char *filename = slashfilename;
81: int length;
82: Lisp_Object list, name;
83:
84: /* In search.c */
85: extern struct re_pattern_buffer searchbuf;
86:
87: if (!NULL (match))
88: {
89: CHECK_STRING (match, 3);
90: /* Compile it now so we don't get an error after opendir */
91: #ifdef VMS
92: compile_pattern (match, &searchbuf, (char *) downcase_table);
93: #else
94: compile_pattern (match, &searchbuf, 0);
95: #endif
96: }
97:
98: dirname = Fexpand_file_name (dirname, Qnil);
99: if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
100: report_file_error ("Opening directory", Fcons (dirname, Qnil));
101:
102: list = Qnil;
103: length = XSTRING (dirname)->size;
104: #ifndef VMS
105: if (length == 0 || XSTRING (dirname)->data[length - 1] != '/')
106: *filename++ = '/';
107: #endif /* VMS */
108:
109: /* Loop reading blocks */
110: while (1)
111: {
112: DIRENTRY *dp = readdir (d);
113: int len;
114:
115: if (!dp) break;
116: len = NAMLEN (dp);
117: if (dp->d_ino)
118: {
119: strncpy (filename, dp->d_name, len);
120: filename[len] = 0;
121: if (NULL (match) ||
122: (0 <= re_search (&searchbuf, filename, len, 0, len, 0)))
123: {
124: if (!NULL (full))
125: name = concat2 (dirname, build_string (slashfilename));
126: else
127: name = build_string (filename);
128: list = Fcons (name, list);
129: }
130: }
131: }
132: closedir (d);
133: return Fsort (Fnreverse (list), Qstring_lessp);
134: }
135:
136: Lisp_Object file_name_completion ();
137:
138: DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
139: 2, 2, 0,
140: "Complete file name FILE in directory DIR.\n\
141: Returns the longest string common to all filenames in DIR\n\
142: that start with FILE.\n\
143: If there is only one and FILE matches it exactly, returns t.\n\
144: Returns nil if DIR contains no name starting with FILE.")
145: (file, dirname)
146: Lisp_Object file, dirname;
147: {
148: /* Don't waste time trying to complete a null string.
149: Besides, this case happens when user is being asked for
150: a directory name and has supplied one ending in a /.
151: We would not want to add anything in that case
152: even if there are some unique characters in that directory. */
153: if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
154: return file;
155: return file_name_completion (file, dirname, 0, 0);
156: }
157:
158: DEFUN ("file-name-all-completions", Ffile_name_all_completions,
159: Sfile_name_all_completions, 2, 2, 0,
160: "Return a list of all completions of file name FILE in directory DIR.")
161: (file, dirname)
162: Lisp_Object file, dirname;
163: {
164: return file_name_completion (file, dirname, 1, 0);
165: }
166:
167: #ifdef VMS
168:
169: DEFUN ("file-name-all-versions", Ffile_name_all_versions,
170: Sfile_name_all_versions, 2, 2, 0,
171: "Return a list of all versions of file name FILE in directory DIR.")
172: (file, dirname)
173: Lisp_Object file, dirname;
174: {
175: return file_name_completion (file, dirname, 1, 1);
176: }
177:
178: #endif /* VMS */
179:
180: Lisp_Object
181: file_name_completion (file, dirname, all_flag, ver_flag)
182: Lisp_Object file, dirname;
183: int all_flag, ver_flag;
184: {
185: DIR *d;
186: DIRENTRY *dp;
187: int bestmatchsize, skip;
188: register int compare, matchsize;
189: unsigned char *p1, *p2;
190: int matchcount = 0;
191: Lisp_Object bestmatch, tem, elt, name;
192: struct stat st;
193: int directoryp;
194: int passcount;
195: int count = specpdl_ptr - specpdl;
196: #ifdef VMS
197: extern DIRENTRY * readdirver ();
198:
199: DIRENTRY *((* readfunc) ());
200:
201: /* Filename completion on VMS ignores case, since VMS filesys does. */
202: specbind (Qcompletion_ignore_case, Qt);
203:
204: readfunc = readdir;
205: if (ver_flag)
206: readfunc = readdirver;
207: file = Fupcase (file);
208: #endif /* VMS */
209:
210: dirname = Fexpand_file_name (dirname, Qnil);
211: bestmatch = Qnil;
212:
213: /* passcount = 0, ignore files that end in an ignored extension.
214: If nothing found then try again with passcount = 1, don't ignore them.
215: If looking for all completions, start with passcount = 1,
216: so always take even the ignored ones. */
217: for (passcount = !!all_flag; NULL (bestmatch) && passcount < 2; passcount++)
218: {
219: if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
220: report_file_error ("Opening directory", Fcons (dirname, Qnil));
221:
222: /* Loop reading blocks */
223: /* (att3b compiler bug requires do a null comparison this way) */
224: while (1)
225: {
226: DIRENTRY *dp;
227: int len;
228:
229: #ifdef VMS
230: dp = (*readfunc) (d);
231: #else
232: dp = readdir (d);
233: #endif
234: if (!dp) break;
235:
236: len = NAMLEN (dp);
237:
238: if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
239: goto quit;
240: if (!dp->d_ino
241: || len < XSTRING (file)->size
242: || 0 <= scmp (dp->d_name, XSTRING (file)->data,
243: XSTRING (file)->size))
244: continue;
245:
246: if (file_name_completion_stat (dirname, dp, &st) < 0)
247: continue;
248:
249: directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
250: tem = Qnil;
251: if (!directoryp)
252: {
253: /* Compare extensions-to-be-ignored against end of this file name */
254: /* if name is not an exact match against specified string */
255: if (!passcount && len > XSTRING (file)->size)
256: /* and exit this for loop if a match is found */
257: for (tem = Vcompletion_ignored_extensions;
258: CONSP (tem); tem = XCONS (tem)->cdr)
259: {
260: elt = XCONS (tem)->car;
261: if (XTYPE (elt) != Lisp_String) continue;
262: skip = len - XSTRING (elt)->size;
263: if (skip < 0) continue;
264:
265: if (0 <= scmp (dp->d_name + skip,
266: XSTRING (elt)->data,
267: XSTRING (elt)->size))
268: continue;
269: break;
270: }
271: }
272:
273: /* Unless an ignored-extensions match was found,
274: process this name as a completion */
275: if (passcount || !CONSP (tem))
276: {
277: /* Update computation of how much all possible completions match */
278:
279: matchcount++;
280:
281: if (all_flag || NULL (bestmatch))
282: {
283: /* This is a possible completion */
284: if (directoryp)
285: {
286: /* This completion is a directory; make it end with '/' */
287: name = Ffile_name_as_directory (make_string (dp->d_name, len));
288: }
289: else
290: name = make_string (dp->d_name, len);
291: if (all_flag)
292: {
293: bestmatch = Fcons (name, bestmatch);
294: }
295: else
296: {
297: bestmatch = name;
298: bestmatchsize = XSTRING (name)->size;
299: }
300: }
301: else
302: {
303: compare = min (bestmatchsize, len);
304: p1 = XSTRING (bestmatch)->data;
305: p2 = (unsigned char *) dp->d_name;
306: for (matchsize = 0; matchsize < compare; matchsize++)
307: if (p1[matchsize] != p2[matchsize]) break;
308: /* If this dirname all matches,
309: see if implicit following slash does too. */
310: if (directoryp &&
311: compare == matchsize &&
312: bestmatchsize > matchsize &&
313: p1[matchsize] == '/')
314: matchsize++;
315: bestmatchsize = min (matchsize, bestmatchsize);
316: }
317: }
318: }
319: closedir (d);
320: }
321:
322: unbind_to (count);
323:
324: if (all_flag || NULL (bestmatch))
325: return bestmatch;
326: if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
327: return Qt;
328: return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
329: quit:
330: if (d) closedir (d);
331: Vquit_flag = Qnil;
332: return Fsignal (Qquit, Qnil);
333: }
334:
335: file_name_completion_stat (dirname, dp, st_addr)
336: Lisp_Object dirname;
337: DIRENTRY *dp;
338: struct stat *st_addr;
339: {
340: int len = NAMLEN (dp);
341: int pos = XSTRING (dirname)->size;
342: char *fullname = (char *) alloca (len + pos + 2);
343:
344: bcopy (XSTRING (dirname)->data, fullname, pos);
345: #ifndef VMS
346: if (fullname[pos - 1] != '/')
347: fullname[pos++] = '/';
348: #endif
349:
350: bcopy (dp->d_name, fullname + pos, len);
351: fullname[pos + len] = 0;
352:
353: return stat (fullname, st_addr);
354: }
355:
356: Lisp_Object
357: make_time (time)
358: int time;
359: {
360: return Fcons (make_number (time >> 16),
361: Fcons (make_number (time & 0177777), Qnil));
362: }
363:
364: DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
365: "Return a list of attributes of file FILENAME.\n\
366: Value is nil if specified file cannot be opened.\n\
367: Otherwise, list elements are:\n\
368: 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
369: 1. Number of links to file.\n\
370: 2. File uid.\n\
371: 3. File gid.\n\
372: 4. Last access time, as a list of two integers.\n\
373: First integer has high-order 16 bits of time, second has low 16 bits.\n\
374: 5. Last modification time, likewise.\n\
375: 6. Last status change time, likewise.\n\
376: 7. Size in bytes.\n\
377: 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
378: 9. t iff file's gid would change if file were deleted and recreated.\n\
379: 10. inode number.\n\
380: \n\
381: If file does not exists, returns nil.")
382: (filename)
383: Lisp_Object filename;
384: {
385: Lisp_Object values[11];
386: Lisp_Object dirname;
387: struct stat s;
388: struct stat sdir;
389: char modes[10];
390:
391: filename = Fexpand_file_name (filename, Qnil);
392: if (lstat (XSTRING (filename)->data, &s) < 0)
393: return Qnil;
394:
395: switch (s.st_mode & S_IFMT)
396: {
397: default:
398: values[0] = Qnil; break;
399: case S_IFDIR:
400: values[0] = Qt; break;
401: #ifdef S_IFLNK
402: case S_IFLNK:
403: values[0] = Ffile_symlink_p (filename); break;
404: #endif
405: }
406: values[1] = make_number (s.st_nlink);
407: values[2] = make_number (s.st_uid);
408: values[3] = make_number (s.st_gid);
409: values[4] = make_time (s.st_atime);
410: values[5] = make_time (s.st_mtime);
411: values[6] = make_time (s.st_ctime);
412: /* perhaps we should set this to most-positive-fixnum if it is too large? */
413: values[7] = make_number (s.st_size);
414: filemodestring (&s, modes);
415: values[8] = make_string (modes, 10);
416: #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
417: #define BSD4_2 /* A new meaning to the term `backwards compatability' */
418: #endif
419: #ifdef BSD4_2 /* file gid will be dir gid */
420: dirname = Ffile_name_directory (filename);
421: if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0)
422: values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
423: else /* if we can't tell, assume worst */
424: values[9] = Qt;
425: #else /* file gid will be egid */
426: values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
427: #endif /* BSD4_2 (or BSD4_3) */
428: #ifdef BSD4_3
429: #undef BSD4_2 /* ok, you can look again without throwing up */
430: #endif
431: values[10] = make_number (s.st_ino);
432: return Flist (11, values);
433: }
434:
435: syms_of_dired ()
436: {
437: defsubr (&Sdirectory_files);
438: defsubr (&Sfile_name_completion);
439: #ifdef VMS
440: defsubr (&Sfile_name_all_versions);
441: #endif /* VMS */
442: defsubr (&Sfile_name_all_completions);
443: defsubr (&Sfile_attributes);
444:
445: #ifdef VMS
446: Qcompletion_ignore_case = intern ("completion-ignore-case");
447: staticpro (&Qcompletion_ignore_case);
448: #endif /* VMS */
449:
450: DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
451: "*Completion ignores filenames ending in any string in this list.");
452: Vcompletion_ignored_extensions = Qnil;
453: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.