153
|
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
|
|
57 #define min(a, b) ((a) < (b) ? (a) : (b))
|
|
58
|
|
59 /* if system does not have symbolic links, it does not have lstat.
|
|
60 In that case, use ordinary stat instead. */
|
|
61
|
|
62 #ifndef S_IFLNK
|
|
63 #define lstat stat
|
|
64 #endif
|
|
65
|
|
66 Lisp_Object Vcompletion_ignored_extensions;
|
|
67
|
|
68 Lisp_Object Qcompletion_ignore_case;
|
|
69
|
|
70 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
|
|
71 "Return a list of names of files in DIRECTORY.\n\
|
|
72 There are three optional arguments:\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.\n\
|
|
75 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
|
|
76 NOSORT is useful if you plan to sort the result yourself.")
|
|
77 (dirname, full, match, nosort)
|
|
78 Lisp_Object dirname, full, match, nosort;
|
|
79 {
|
|
80 DIR *d;
|
|
81 int length;
|
|
82 Lisp_Object list, name;
|
|
83
|
|
84 if (!NULL (match))
|
|
85 {
|
|
86 CHECK_STRING (match, 3);
|
|
87 /* Compile it now so we don't get an error after opendir */
|
|
88 #ifdef VMS
|
|
89 compile_pattern (match, &searchbuf,
|
|
90 buffer_defaults.downcase_table->contents);
|
|
91 #else
|
|
92 compile_pattern (match, &searchbuf, 0);
|
|
93 #endif
|
|
94 }
|
|
95
|
|
96 dirname = Fexpand_file_name (dirname, Qnil);
|
|
97 if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
|
|
98 report_file_error ("Opening directory", Fcons (dirname, Qnil));
|
|
99
|
|
100 list = Qnil;
|
|
101 length = XSTRING (dirname)->size;
|
|
102
|
|
103 /* Loop reading blocks */
|
|
104 while (1)
|
|
105 {
|
|
106 DIRENTRY *dp = readdir (d);
|
|
107 int len;
|
|
108
|
|
109 if (!dp) break;
|
|
110 len = NAMLEN (dp);
|
|
111 if (dp->d_ino)
|
|
112 {
|
|
113 if (NULL (match)
|
|
114 || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
|
|
115 {
|
|
116 if (!NULL (full))
|
|
117 {
|
|
118 int index = XSTRING (dirname)->size;
|
|
119 int total = len + index;
|
|
120 #ifndef VMS
|
|
121 if (length == 0
|
|
122 || XSTRING (dirname)->data[length - 1] != '/')
|
|
123 total++;
|
|
124 #endif /* VMS */
|
|
125
|
|
126 name = make_uninit_string (total);
|
|
127 bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
|
|
128 index);
|
|
129 #ifndef VMS
|
|
130 if (length == 0
|
|
131 || XSTRING (dirname)->data[length - 1] != '/')
|
|
132 XSTRING (name)->data[index++] = '/';
|
|
133 #endif /* VMS */
|
|
134 bcopy (dp->d_name, XSTRING (name)->data + index, len);
|
|
135 }
|
|
136 else
|
|
137 name = make_string (dp->d_name, len);
|
|
138 list = Fcons (name, list);
|
|
139 }
|
|
140 }
|
|
141 }
|
|
142 closedir (d);
|
|
143 if (!NULL (nosort))
|
|
144 return list;
|
|
145 return Fsort (Fnreverse (list), Qstring_lessp);
|
|
146 }
|
|
147
|
|
148 Lisp_Object file_name_completion ();
|
|
149
|
|
150 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
|
|
151 2, 2, 0,
|
|
152 "Complete file name FILE in directory DIR.\n\
|
|
153 Returns the longest string\n\
|
|
154 common to all filenames in DIR that start with FILE.\n\
|
|
155 If there is only one and FILE matches it exactly, returns t.\n\
|
|
156 Returns nil if DIR contains no name starting with FILE.")
|
|
157 (file, dirname)
|
|
158 Lisp_Object file, dirname;
|
|
159 {
|
|
160 /* Don't waste time trying to complete a null string.
|
|
161 Besides, this case happens when user is being asked for
|
|
162 a directory name and has supplied one ending in a /.
|
|
163 We would not want to add anything in that case
|
|
164 even if there are some unique characters in that directory. */
|
|
165 if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
|
|
166 return file;
|
|
167 return file_name_completion (file, dirname, 0, 0);
|
|
168 }
|
|
169
|
|
170 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
|
|
171 Sfile_name_all_completions, 2, 2, 0,
|
|
172 "Return a list of all completions of file name FILE in directory DIR.\n\
|
|
173 These are all file names in directory DIR which begin with FILE.")
|
|
174 (file, dirname)
|
|
175 Lisp_Object file, dirname;
|
|
176 {
|
|
177 return file_name_completion (file, dirname, 1, 0);
|
|
178 }
|
|
179
|
|
180 #ifdef VMS
|
|
181
|
|
182 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
|
|
183 Sfile_name_all_versions, 2, 2, 0,
|
|
184 "Return a list of all versions of file name FILE in directory DIR.")
|
|
185 (file, dirname)
|
|
186 Lisp_Object file, dirname;
|
|
187 {
|
|
188 return file_name_completion (file, dirname, 1, 1);
|
|
189 }
|
|
190
|
|
191 #endif /* VMS */
|
|
192
|
|
193 Lisp_Object
|
|
194 file_name_completion (file, dirname, all_flag, ver_flag)
|
|
195 Lisp_Object file, dirname;
|
|
196 int all_flag, ver_flag;
|
|
197 {
|
|
198 DIR *d;
|
|
199 DIRENTRY *dp;
|
|
200 int bestmatchsize, skip;
|
|
201 register int compare, matchsize;
|
|
202 unsigned char *p1, *p2;
|
|
203 int matchcount = 0;
|
|
204 Lisp_Object bestmatch, tem, elt, name;
|
|
205 struct stat st;
|
|
206 int directoryp;
|
|
207 int passcount;
|
|
208 int count = specpdl_ptr - specpdl;
|
|
209 #ifdef VMS
|
|
210 extern DIRENTRY * readdirver ();
|
|
211
|
|
212 DIRENTRY *((* readfunc) ());
|
|
213
|
|
214 /* Filename completion on VMS ignores case, since VMS filesys does. */
|
|
215 specbind (Qcompletion_ignore_case, Qt);
|
|
216
|
|
217 readfunc = readdir;
|
|
218 if (ver_flag)
|
|
219 readfunc = readdirver;
|
|
220 file = Fupcase (file);
|
|
221 #else /* not VMS */
|
|
222 CHECK_STRING (file, 0);
|
|
223 #endif /* not VMS */
|
|
224
|
|
225 dirname = Fexpand_file_name (dirname, Qnil);
|
|
226 bestmatch = Qnil;
|
|
227
|
|
228 /* With passcount = 0, ignore files that end in an ignored extension.
|
|
229 If nothing found then try again with passcount = 1, don't ignore them.
|
|
230 If looking for all completions, start with passcount = 1,
|
|
231 so always take even the ignored ones.
|
|
232
|
|
233 ** It would not actually be helpful to the user to ignore any possible
|
|
234 completions when making a list of them.** */
|
|
235
|
|
236 for (passcount = !!all_flag; NULL (bestmatch) && passcount < 2; passcount++)
|
|
237 {
|
|
238 if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
|
|
239 report_file_error ("Opening directory", Fcons (dirname, Qnil));
|
|
240
|
|
241 /* Loop reading blocks */
|
|
242 /* (att3b compiler bug requires do a null comparison this way) */
|
|
243 while (1)
|
|
244 {
|
|
245 DIRENTRY *dp;
|
|
246 int len;
|
|
247
|
|
248 #ifdef VMS
|
|
249 dp = (*readfunc) (d);
|
|
250 #else
|
|
251 dp = readdir (d);
|
|
252 #endif
|
|
253 if (!dp) break;
|
|
254
|
|
255 len = NAMLEN (dp);
|
|
256
|
|
257 if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
|
|
258 goto quit;
|
|
259 if (!dp->d_ino
|
|
260 || len < XSTRING (file)->size
|
|
261 || 0 <= scmp (dp->d_name, XSTRING (file)->data,
|
|
262 XSTRING (file)->size))
|
|
263 continue;
|
|
264
|
|
265 if (file_name_completion_stat (dirname, dp, &st) < 0)
|
|
266 continue;
|
|
267
|
|
268 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
|
|
269 tem = Qnil;
|
|
270 if (!directoryp)
|
|
271 {
|
|
272 /* Compare extensions-to-be-ignored against end of this file name */
|
|
273 /* if name is not an exact match against specified string */
|
|
274 if (!passcount && len > XSTRING (file)->size)
|
|
275 /* and exit this for loop if a match is found */
|
|
276 for (tem = Vcompletion_ignored_extensions;
|
|
277 CONSP (tem); tem = XCONS (tem)->cdr)
|
|
278 {
|
|
279 elt = XCONS (tem)->car;
|
|
280 if (XTYPE (elt) != Lisp_String) continue;
|
|
281 skip = len - XSTRING (elt)->size;
|
|
282 if (skip < 0) continue;
|
|
283
|
|
284 if (0 <= scmp (dp->d_name + skip,
|
|
285 XSTRING (elt)->data,
|
|
286 XSTRING (elt)->size))
|
|
287 continue;
|
|
288 break;
|
|
289 }
|
|
290 }
|
|
291
|
|
292 /* Unless an ignored-extensions match was found,
|
|
293 process this name as a completion */
|
|
294 if (passcount || !CONSP (tem))
|
|
295 {
|
|
296 /* Update computation of how much all possible completions match */
|
|
297
|
|
298 matchcount++;
|
|
299
|
|
300 if (all_flag || NULL (bestmatch))
|
|
301 {
|
|
302 /* This is a possible completion */
|
|
303 if (directoryp)
|
|
304 {
|
|
305 /* This completion is a directory; make it end with '/' */
|
|
306 name = Ffile_name_as_directory (make_string (dp->d_name, len));
|
|
307 }
|
|
308 else
|
|
309 name = make_string (dp->d_name, len);
|
|
310 if (all_flag)
|
|
311 {
|
|
312 bestmatch = Fcons (name, bestmatch);
|
|
313 }
|
|
314 else
|
|
315 {
|
|
316 bestmatch = name;
|
|
317 bestmatchsize = XSTRING (name)->size;
|
|
318 }
|
|
319 }
|
|
320 else
|
|
321 {
|
|
322 compare = min (bestmatchsize, len);
|
|
323 p1 = XSTRING (bestmatch)->data;
|
|
324 p2 = (unsigned char *) dp->d_name;
|
|
325 matchsize = scmp(p1, p2, compare);
|
|
326 if (matchsize < 0)
|
|
327 matchsize = compare;
|
|
328 /* If this dirname all matches,
|
|
329 see if implicit following slash does too. */
|
|
330 if (directoryp
|
|
331 && compare == matchsize
|
|
332 && bestmatchsize > matchsize
|
|
333 && p1[matchsize] == '/')
|
|
334 matchsize++;
|
|
335 bestmatchsize = min (matchsize, bestmatchsize);
|
|
336 }
|
|
337 }
|
|
338 }
|
|
339 closedir (d);
|
|
340 }
|
|
341
|
|
342 unbind_to (count, Qnil);
|
|
343
|
|
344 if (all_flag || NULL (bestmatch))
|
|
345 return bestmatch;
|
|
346 if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
|
|
347 return Qt;
|
|
348 return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
|
|
349 quit:
|
|
350 if (d) closedir (d);
|
|
351 Vquit_flag = Qnil;
|
|
352 return Fsignal (Qquit, Qnil);
|
|
353 }
|
|
354
|
|
355 file_name_completion_stat (dirname, dp, st_addr)
|
|
356 Lisp_Object dirname;
|
|
357 DIRENTRY *dp;
|
|
358 struct stat *st_addr;
|
|
359 {
|
|
360 int len = NAMLEN (dp);
|
|
361 int pos = XSTRING (dirname)->size;
|
|
362 char *fullname = (char *) alloca (len + pos + 2);
|
|
363
|
|
364 bcopy (XSTRING (dirname)->data, fullname, pos);
|
|
365 #ifndef VMS
|
|
366 if (fullname[pos - 1] != '/')
|
|
367 fullname[pos++] = '/';
|
|
368 #endif
|
|
369
|
|
370 bcopy (dp->d_name, fullname + pos, len);
|
|
371 fullname[pos + len] = 0;
|
|
372
|
|
373 return stat (fullname, st_addr);
|
|
374 }
|
|
375
|
|
376 Lisp_Object
|
|
377 make_time (time)
|
|
378 int time;
|
|
379 {
|
|
380 return Fcons (make_number (time >> 16),
|
|
381 Fcons (make_number (time & 0177777), Qnil));
|
|
382 }
|
|
383
|
|
384 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
|
|
385 "Return a list of attributes of file FILENAME.\n\
|
|
386 Value is nil if specified file cannot be opened.\n\
|
|
387 Otherwise, list elements are:\n\
|
|
388 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
|
|
389 1. Number of links to file.\n\
|
|
390 2. File uid.\n\
|
|
391 3. File gid.\n\
|
|
392 4. Last access time, as a list of two integers.\n\
|
|
393 First integer has high-order 16 bits of time, second has low 16 bits.\n\
|
|
394 5. Last modification time, likewise.\n\
|
|
395 6. Last status change time, likewise.\n\
|
|
396 7. Size in bytes.\n\
|
|
397 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
|
|
398 9. t iff file's gid would change if file were deleted and recreated.\n\
|
|
399 10. inode number.\n\
|
|
400 11. Device number.\n\
|
|
401 \n\
|
|
402 If file does not exists, returns nil.")
|
|
403 (filename)
|
|
404 Lisp_Object filename;
|
|
405 {
|
|
406 Lisp_Object values[12];
|
|
407 Lisp_Object dirname;
|
|
408 struct stat s;
|
|
409 struct stat sdir;
|
|
410 char modes[10];
|
|
411
|
|
412 filename = Fexpand_file_name (filename, Qnil);
|
|
413 if (lstat (XSTRING (filename)->data, &s) < 0)
|
|
414 return Qnil;
|
|
415
|
|
416 switch (s.st_mode & S_IFMT)
|
|
417 {
|
|
418 default:
|
|
419 values[0] = Qnil; break;
|
|
420 case S_IFDIR:
|
|
421 values[0] = Qt; break;
|
|
422 #ifdef S_IFLNK
|
|
423 case S_IFLNK:
|
|
424 values[0] = Ffile_symlink_p (filename); break;
|
|
425 #endif
|
|
426 }
|
|
427 values[1] = make_number (s.st_nlink);
|
|
428 values[2] = make_number (s.st_uid);
|
|
429 values[3] = make_number (s.st_gid);
|
|
430 values[4] = make_time (s.st_atime);
|
|
431 values[5] = make_time (s.st_mtime);
|
|
432 values[6] = make_time (s.st_ctime);
|
|
433 /* perhaps we should set this to most-positive-fixnum if it is too large? */
|
|
434 values[7] = make_number (s.st_size);
|
|
435 filemodestring (&s, modes);
|
|
436 values[8] = make_string (modes, 10);
|
|
437 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
|
|
438 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
|
|
439 #endif
|
|
440 #ifdef BSD4_2 /* file gid will be dir gid */
|
|
441 dirname = Ffile_name_directory (filename);
|
|
442 if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0)
|
|
443 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
|
|
444 else /* if we can't tell, assume worst */
|
|
445 values[9] = Qt;
|
|
446 #else /* file gid will be egid */
|
|
447 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
|
|
448 #endif /* BSD4_2 (or BSD4_3) */
|
|
449 #ifdef BSD4_3
|
|
450 #undef BSD4_2 /* ok, you can look again without throwing up */
|
|
451 #endif
|
|
452 values[10] = make_number (s.st_ino);
|
|
453 values[11] = make_number (s.st_dev);
|
|
454 return Flist (sizeof(values) / sizeof(values[0]), values);
|
|
455 }
|
|
456
|
|
457 syms_of_dired ()
|
|
458 {
|
|
459 defsubr (&Sdirectory_files);
|
|
460 defsubr (&Sfile_name_completion);
|
|
461 #ifdef VMS
|
|
462 defsubr (&Sfile_name_all_versions);
|
|
463 #endif /* VMS */
|
|
464 defsubr (&Sfile_name_all_completions);
|
|
465 defsubr (&Sfile_attributes);
|
|
466
|
|
467 #ifdef VMS
|
|
468 Qcompletion_ignore_case = intern ("completion-ignore-case");
|
|
469 staticpro (&Qcompletion_ignore_case);
|
|
470 #endif /* VMS */
|
|
471
|
|
472 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
|
|
473 "*Completion ignores filenames ending in any string in this list.\n\
|
|
474 This variable does not affect lists of possible completions,\n\
|
|
475 but does affect the commands that actually do completions.");
|
|
476 Vcompletion_ignored_extensions = Qnil;
|
|
477 }
|