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