|
0
|
1 /* Lisp functions for making directory listings.
|
|
|
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 This file is part of XEmacs.
|
|
|
5
|
|
|
6 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
7 under the terms of the GNU General Public License as published by the
|
|
|
8 Free Software Foundation; either version 2, or (at your option) any
|
|
|
9 later version.
|
|
|
10
|
|
|
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
14 for more details.
|
|
|
15
|
|
|
16 You should have received a copy of the GNU General Public License
|
|
|
17 along with XEmacs; see the file COPYING. If not, write to
|
|
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
19 Boston, MA 02111-1307, USA. */
|
|
|
20
|
|
|
21 /* Synched up with: FSF 19.30. */
|
|
|
22
|
|
|
23 #include <config.h>
|
|
|
24 #include "lisp.h"
|
|
|
25
|
|
|
26 #include "buffer.h"
|
|
|
27 #include "commands.h"
|
|
|
28 #include "elhash.h"
|
|
|
29 #include "regex.h"
|
|
|
30
|
|
|
31 #include "sysfile.h"
|
|
|
32 #include "sysdir.h"
|
|
|
33
|
|
|
34 Lisp_Object Vcompletion_ignored_extensions;
|
|
|
35
|
|
|
36 Lisp_Object Qdirectory_files;
|
|
|
37 Lisp_Object Qfile_name_completion;
|
|
|
38 Lisp_Object Qfile_name_all_completions;
|
|
|
39 Lisp_Object Qfile_attributes;
|
|
|
40
|
|
|
41 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0 /*
|
|
|
42 Return a list of names of files in DIRECTORY.
|
|
|
43 There are four optional arguments:
|
|
|
44 If FULL is non-nil, absolute pathnames of the files are returned.
|
|
|
45 If MATCH is non-nil, only pathnames containing that regexp are returned.
|
|
|
46 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
|
|
|
47 NOSORT is useful if you plan to sort the result yourself.
|
|
|
48 If FILES-ONLY is the symbol t, then only the \"files\" in the directory
|
|
|
49 will be returned; subdirectories will be excluded. If FILES-ONLY is not
|
|
|
50 nil and not t, then only the subdirectories will be returned. Otherwise,
|
|
|
51 if FILES-ONLY is nil (the default) then both files and subdirectories will
|
|
|
52 be returned.
|
|
|
53 */ )
|
|
|
54 (dirname, full, match, nosort, files_only)
|
|
|
55 Lisp_Object dirname, full, match, nosort, files_only;
|
|
|
56 {
|
|
|
57 /* This function can GC */
|
|
|
58 DIR *d;
|
|
|
59 Bytecount dirname_length;
|
|
|
60 Lisp_Object list, name, dirfilename = Qnil;
|
|
|
61 Lisp_Object handler;
|
|
|
62 struct re_pattern_buffer *bufp;
|
|
|
63
|
|
|
64 char statbuf [MAXNAMLEN+2];
|
|
|
65 char *statbuf_tail;
|
|
|
66 Lisp_Object tail_cons;
|
|
|
67 char slashfilename[MAXNAMLEN+2];
|
|
|
68 char *filename = slashfilename;
|
|
|
69
|
|
|
70 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
|
|
71
|
|
|
72 /* #### Needs more gcpro's */
|
|
|
73 GCPRO5 (dirname, match, files_only, tail_cons, dirfilename);
|
|
|
74
|
|
|
75 /* If the file name has special constructs in it,
|
|
|
76 call the corresponding file handler. */
|
|
|
77 handler = Ffind_file_name_handler (dirname, Qdirectory_files);
|
|
|
78 if (!NILP (handler))
|
|
|
79 {
|
|
|
80 UNGCPRO;
|
|
|
81 if (!NILP (files_only))
|
|
|
82 return call6 (handler, Qdirectory_files, dirname, full, match, nosort,
|
|
|
83 files_only);
|
|
|
84 else
|
|
|
85 return call5 (handler, Qdirectory_files, dirname, full, match,
|
|
|
86 nosort);
|
|
|
87 }
|
|
|
88
|
|
|
89 dirname = Fexpand_file_name (dirname, Qnil);
|
|
|
90 dirfilename = Fdirectory_file_name (dirname);
|
|
|
91
|
|
|
92 {
|
|
|
93 /* XEmacs: this should come before the opendir() because it might error. */
|
|
|
94 Lisp_Object name_as_dir = Ffile_name_as_directory (dirname);
|
|
|
95 CHECK_STRING (name_as_dir);
|
|
|
96 memcpy (statbuf, ((char *) string_data (XSTRING (name_as_dir))),
|
|
|
97 string_length (XSTRING (name_as_dir)));
|
|
|
98 statbuf_tail = statbuf + string_length (XSTRING (name_as_dir));
|
|
|
99 }
|
|
|
100
|
|
|
101 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
|
|
|
102 potential regexp cache smashage. This should come before the
|
|
|
103 opendir() because it might signal an error.
|
|
|
104 */
|
|
|
105 if (!NILP (match))
|
|
|
106 {
|
|
|
107 CHECK_STRING (match);
|
|
|
108
|
|
|
109 /* MATCH might be a flawed regular expression. Rather than
|
|
|
110 catching and signalling our own errors, we just call
|
|
|
111 compile_pattern to do the work for us. */
|
|
|
112 #ifdef VMS
|
|
|
113 bufp =
|
|
|
114 compile_pattern (match, 0,
|
|
|
115 (char *) MIRROR_DOWNCASE_TABLE_AS_STRING
|
|
|
116 (XBUFFER (Vbuffer_defaults)), 0, ERROR_ME);
|
|
|
117 #else
|
|
|
118 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
|
|
|
119 #endif
|
|
|
120 }
|
|
|
121
|
|
|
122 /* Now *bufp is the compiled form of MATCH; don't call anything
|
|
|
123 which might compile a new regexp until we're done with the loop! */
|
|
|
124
|
|
|
125 /* Do this opendir after anything which might signal an error; if
|
|
|
126 an error is signalled while the directory stream is open, we
|
|
|
127 have to make sure it gets closed, and setting up an
|
|
|
128 unwind_protect to do so would be a pain. */
|
|
|
129 d = opendir ((char *) string_data (XSTRING (dirfilename)));
|
|
|
130 if (! d)
|
|
|
131 report_file_error ("Opening directory", list1 (dirname));
|
|
|
132
|
|
|
133 list = Qnil;
|
|
|
134 tail_cons = Qnil;
|
|
|
135 dirname_length = string_length (XSTRING (dirname));
|
|
|
136 #ifndef VMS
|
|
|
137 if (dirname_length == 0
|
|
|
138 || !IS_ANY_SEP (string_byte (XSTRING (dirname), dirname_length - 1)))
|
|
|
139 {
|
|
|
140 *filename++ = DIRECTORY_SEP;
|
|
|
141 dirname_length++;
|
|
|
142 }
|
|
|
143 #endif /* VMS */
|
|
|
144
|
|
|
145 /* Loop reading blocks */
|
|
|
146 while (1)
|
|
|
147 {
|
|
|
148 DIRENTRY *dp = readdir (d);
|
|
|
149 int len;
|
|
|
150
|
|
|
151 if (!dp) break;
|
|
|
152 len = NAMLEN (dp);
|
|
|
153 if (DIRENTRY_NONEMPTY (dp))
|
|
|
154 {
|
|
|
155 int result;
|
|
|
156 Lisp_Object oinhibit_quit = Vinhibit_quit;
|
|
|
157 strncpy (filename, dp->d_name, len);
|
|
|
158 filename[len] = 0;
|
|
|
159 /* re_search can now QUIT, so prevent it to avoid
|
|
|
160 filedesc lossage */
|
|
|
161 Vinhibit_quit = Qt;
|
|
|
162 result = (NILP (match)
|
|
|
163 || (0 <= re_search (bufp, filename, len, 0, len, 0)));
|
|
|
164 Vinhibit_quit = oinhibit_quit;
|
|
|
165 if (result)
|
|
|
166 {
|
|
|
167 if (!NILP (files_only))
|
|
|
168 {
|
|
|
169 int dir_p;
|
|
|
170 struct stat st;
|
|
|
171
|
|
|
172 memcpy (statbuf_tail, filename, len);
|
|
|
173 statbuf_tail [len] = 0;
|
|
|
174
|
|
|
175 if (stat (statbuf, &st) < 0)
|
|
|
176 dir_p = 0;
|
|
|
177 else
|
|
|
178 dir_p = ((st.st_mode & S_IFMT) == S_IFDIR);
|
|
|
179
|
|
|
180 if (EQ (files_only, Qt) && dir_p)
|
|
|
181 continue;
|
|
|
182 else if (!EQ (files_only, Qt) && !dir_p)
|
|
|
183 continue;
|
|
|
184 }
|
|
|
185
|
|
|
186 if (!NILP (full))
|
|
|
187 name = concat2 (dirname, build_string (slashfilename));
|
|
|
188 else
|
|
|
189 name = make_string ((Bufbyte *) filename, len);
|
|
|
190
|
|
|
191 if (NILP (tail_cons))
|
|
|
192 {
|
|
|
193 list = list1 (name);
|
|
|
194 tail_cons = list;
|
|
|
195 }
|
|
|
196 else
|
|
|
197 {
|
|
|
198 XCDR (tail_cons) = list1 (name);
|
|
|
199 tail_cons = XCDR (tail_cons);
|
|
|
200 }
|
|
|
201 }
|
|
|
202 }
|
|
|
203 }
|
|
|
204 closedir (d);
|
|
|
205 UNGCPRO;
|
|
|
206 if (!NILP (nosort))
|
|
|
207 return list;
|
|
|
208 return Fsort (Fnreverse (list), Qstring_lessp);
|
|
|
209 }
|
|
|
210
|
|
|
211 static Lisp_Object file_name_completion (Lisp_Object file,
|
|
|
212 Lisp_Object dirname,
|
|
|
213 int all_flag, int ver_flag);
|
|
|
214
|
|
|
215 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
|
|
|
216 2, 2, 0 /*
|
|
|
217 Complete file name FILE in directory DIR.
|
|
|
218 Returns the longest string common to all filenames in DIR
|
|
|
219 that start with FILE.
|
|
|
220 If there is only one and FILE matches it exactly, returns t.
|
|
|
221 Returns nil if DIR contains no name starting with FILE.
|
|
|
222
|
|
|
223 Filenames which end with any member of `completion-ignored-extensions'
|
|
|
224 are not considered as possible completions for FILE unless there is no
|
|
|
225 other possible completion. `completion-ignored-extensions' is not applied
|
|
|
226 to the names of directories.
|
|
|
227 */ )
|
|
|
228 (file, dirname)
|
|
|
229 Lisp_Object file, dirname;
|
|
|
230 {
|
|
|
231 /* This function can GC */
|
|
|
232 Lisp_Object handler;
|
|
|
233
|
|
|
234 /* If the directory name has special constructs in it,
|
|
|
235 call the corresponding file handler. */
|
|
|
236 handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
|
|
|
237 if (!NILP (handler))
|
|
|
238 return call3 (handler, Qfile_name_completion, file, dirname);
|
|
|
239
|
|
|
240 /* If the file name has special constructs in it,
|
|
|
241 call the corresponding file handler. */
|
|
|
242 handler = Ffind_file_name_handler (file, Qfile_name_completion);
|
|
|
243 if (!NILP (handler))
|
|
|
244 return call3 (handler, Qfile_name_completion, file, dirname);
|
|
|
245
|
|
|
246 return file_name_completion (file, dirname, 0, 0);
|
|
|
247 }
|
|
|
248
|
|
|
249 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
|
|
|
250 Sfile_name_all_completions, 2, 2, 0 /*
|
|
|
251 Return a list of all completions of file name FILE in directory DIR.
|
|
|
252 These are all file names in directory DIR which begin with FILE.
|
|
|
253
|
|
|
254 Filenames which end with any member of `completion-ignored-extensions'
|
|
|
255 are not considered as possible completions for FILE unless there is no
|
|
|
256 other possible completion. `completion-ignored-extensions' is not applied
|
|
|
257 to the names of directories.
|
|
|
258 */ )
|
|
|
259 (file, dirname)
|
|
|
260 Lisp_Object file, dirname;
|
|
|
261 {
|
|
|
262 /* This function can GC */
|
|
|
263 Lisp_Object handler;
|
|
|
264
|
|
|
265 /* If the file name has special constructs in it,
|
|
|
266 call the corresponding file handler. */
|
|
|
267 handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
|
|
|
268 if (!NILP (handler))
|
|
|
269 return call3 (handler, Qfile_name_all_completions, file,
|
|
|
270 dirname);
|
|
|
271
|
|
|
272 return file_name_completion (file, dirname, 1, 0);
|
|
|
273 }
|
|
|
274
|
|
|
275 static int
|
|
|
276 file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp,
|
|
|
277 struct stat *st_addr)
|
|
|
278 {
|
|
|
279 Bytecount len = NAMLEN (dp);
|
|
|
280 Bytecount pos = string_length (XSTRING (dirname));
|
|
|
281 int value;
|
|
|
282 char *fullname = (char *) alloca (len + pos + 2);
|
|
|
283
|
|
|
284 memcpy (fullname, string_data (XSTRING (dirname)), pos);
|
|
|
285 #ifndef VMS
|
|
|
286 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
|
|
|
287 fullname[pos++] = DIRECTORY_SEP;
|
|
|
288 #endif
|
|
|
289
|
|
|
290 memcpy (fullname + pos, dp->d_name, len);
|
|
|
291 fullname[pos + len] = 0;
|
|
|
292
|
|
|
293 #ifdef S_IFLNK
|
|
|
294 /* We want to return success if a link points to a nonexistent file,
|
|
|
295 but we want to return the status for what the link points to,
|
|
|
296 in case it is a directory. */
|
|
|
297 value = lstat (fullname, st_addr);
|
|
|
298 if (S_ISLNK (st_addr->st_mode))
|
|
|
299 stat (fullname, st_addr);
|
|
|
300 #else
|
|
|
301 value = stat (fullname, st_addr);
|
|
|
302 #endif
|
|
|
303 return (value);
|
|
|
304 }
|
|
|
305
|
|
|
306 static Lisp_Object
|
|
|
307 file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
|
|
|
308 int ver_flag)
|
|
|
309 {
|
|
|
310 /* This function can GC */
|
|
|
311 DIR *d = 0;
|
|
|
312 int matchcount = 0;
|
|
|
313 Lisp_Object bestmatch = Qnil;
|
|
|
314 Charcount bestmatchsize = 0;
|
|
|
315 struct stat st;
|
|
|
316 int passcount;
|
|
|
317 int speccount = specpdl_depth ();
|
|
|
318 Charcount file_name_length;
|
|
|
319 DIRENTRY *((*readfunc) (DIR *)) = readdir;
|
|
|
320 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
321
|
|
|
322 GCPRO3 (file, dirname, bestmatch);
|
|
|
323
|
|
|
324 CHECK_STRING (file);
|
|
|
325
|
|
|
326 #ifdef VMS
|
|
|
327 /* Filename completion on VMS ignores case, since VMS filesys does. */
|
|
|
328 specbind (Qcompletion_ignore_case, Qt);
|
|
|
329
|
|
|
330 if (ver_flag)
|
|
|
331 readfunc = readdirver;
|
|
|
332 #endif /* VMS */
|
|
|
333
|
|
|
334 #ifdef FILE_SYSTEM_CASE
|
|
|
335 file = FILE_SYSTEM_CASE (file);
|
|
|
336 #endif
|
|
|
337 dirname = Fexpand_file_name (dirname, Qnil);
|
|
|
338 bestmatch = Qnil;
|
|
|
339 file_name_length = string_char_length (XSTRING (file));
|
|
|
340
|
|
|
341 /* With passcount = 0, ignore files that end in an ignored extension.
|
|
|
342 If nothing found then try again with passcount = 1, don't ignore them.
|
|
|
343 If looking for all completions, start with passcount = 1,
|
|
|
344 so always take even the ignored ones.
|
|
|
345
|
|
|
346 ** It would not actually be helpful to the user to ignore any possible
|
|
|
347 completions when making a list of them.** */
|
|
|
348
|
|
|
349 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
|
|
|
350 {
|
|
|
351 d = opendir ((char *)
|
|
|
352 string_data (XSTRING (Fdirectory_file_name (dirname))));
|
|
|
353 if (!d)
|
|
|
354 report_file_error ("Opening directory", list1 (dirname));
|
|
|
355
|
|
|
356 /* Loop reading blocks */
|
|
|
357 /* (att3b compiler bug requires do a null comparison this way) */
|
|
|
358 while (1)
|
|
|
359 {
|
|
|
360 DIRENTRY *dp;
|
|
|
361 Bytecount len;
|
|
|
362 /* scmp() works in characters, not bytes, so we have to compute
|
|
|
363 this value: */
|
|
|
364 Charcount cclen;
|
|
|
365 int directoryp;
|
|
|
366 int ignored_extension_p = 0;
|
|
|
367 Bufbyte *d_name;
|
|
|
368
|
|
|
369 dp = (*readfunc) (d);
|
|
|
370 if (!dp) break;
|
|
|
371
|
|
|
372 d_name = (Bufbyte *) dp->d_name;
|
|
|
373 len = NAMLEN (dp);
|
|
|
374 /* mrb: #### FIX: The Name must be converted using
|
|
|
375 file-name-coding system or some such. At least this
|
|
|
376 change allows the saving of files in directories with
|
|
|
377 Japanese file names */
|
|
|
378 /*cclen = bytecount_to_charcount (d_name, len);*/
|
|
|
379 cclen = len;
|
|
|
380
|
|
|
381 /* Can't just use QUIT because we have to make sure the file
|
|
|
382 descriptor gets closed. */
|
|
|
383 if (QUITP)
|
|
|
384 {
|
|
|
385 closedir (d);
|
|
|
386 signal_quit ();
|
|
|
387 }
|
|
|
388
|
|
|
389 if (! DIRENTRY_NONEMPTY (dp)
|
|
|
390 || cclen < file_name_length
|
|
|
391 || 0 <= scmp (d_name,
|
|
|
392 string_data (XSTRING (file)),
|
|
|
393 file_name_length))
|
|
|
394 continue;
|
|
|
395
|
|
|
396 if (file_name_completion_stat (dirname, dp, &st) < 0)
|
|
|
397 continue;
|
|
|
398
|
|
|
399 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
|
|
|
400 if (directoryp)
|
|
|
401 {
|
|
|
402 #ifndef TRIVIAL_DIRECTORY_ENTRY
|
|
|
403 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
|
|
|
404 #endif
|
|
|
405 /* "." and ".." are never interesting as completions, but are
|
|
|
406 actually in the way in a directory contains only one file. */
|
|
|
407 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
|
|
|
408 continue;
|
|
|
409 }
|
|
|
410 else
|
|
|
411 {
|
|
|
412 /* Compare extensions-to-be-ignored against end of this file name */
|
|
|
413 /* if name is not an exact match against specified string */
|
|
|
414 if (!passcount && cclen > file_name_length)
|
|
|
415 {
|
|
|
416 Lisp_Object tem;
|
|
|
417 /* and exit this for loop if a match is found */
|
|
|
418 for (tem = Vcompletion_ignored_extensions;
|
|
|
419 CONSP (tem);
|
|
|
420 tem = XCDR (tem))
|
|
|
421 {
|
|
|
422 Lisp_Object elt = XCAR (tem);
|
|
|
423 Charcount skip;
|
|
|
424
|
|
|
425 if (!STRINGP (elt)) continue;
|
|
|
426 skip = cclen - string_char_length (XSTRING (elt));
|
|
|
427 if (skip < 0) continue;
|
|
|
428
|
|
|
429 if (0 > scmp (charptr_n_addr (d_name, skip),
|
|
|
430 string_data (XSTRING (elt)),
|
|
|
431 string_char_length (XSTRING (elt))))
|
|
|
432 {
|
|
|
433 ignored_extension_p = 1;
|
|
|
434 break;
|
|
|
435 }
|
|
|
436 }
|
|
|
437 }
|
|
|
438 }
|
|
|
439
|
|
|
440 /* If an ignored-extensions match was found,
|
|
|
441 don't process this name as a completion. */
|
|
|
442 if (!passcount && ignored_extension_p)
|
|
|
443 continue;
|
|
|
444
|
|
|
445 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, len))
|
|
|
446 continue;
|
|
|
447
|
|
|
448 /* Update computation of how much all possible completions match */
|
|
|
449 matchcount++;
|
|
|
450
|
|
|
451 if (all_flag || NILP (bestmatch))
|
|
|
452 {
|
|
|
453 Lisp_Object name = Qnil;
|
|
|
454 struct gcpro ngcpro1;
|
|
|
455 NGCPRO1 (name);
|
|
|
456 /* This is a possible completion */
|
|
|
457 if (directoryp)
|
|
|
458 {
|
|
|
459 /* This completion is a directory; make it end with '/' */
|
|
|
460 name = Ffile_name_as_directory
|
|
|
461 /* make_string (d_name, len); */
|
|
|
462 (make_ext_string (d_name, len, FORMAT_BINARY));
|
|
|
463 }
|
|
|
464 else
|
|
|
465 /* name = make_string (d_name, len) */
|
|
|
466 name = make_ext_string (d_name, len, FORMAT_BINARY);
|
|
|
467 if (all_flag)
|
|
|
468 {
|
|
|
469 bestmatch = Fcons (name, bestmatch);
|
|
|
470 }
|
|
|
471 else
|
|
|
472 {
|
|
|
473 bestmatch = name;
|
|
|
474 bestmatchsize = string_char_length (XSTRING (name));
|
|
|
475 }
|
|
|
476 NUNGCPRO;
|
|
|
477 }
|
|
|
478 else
|
|
|
479 {
|
|
|
480 Charcount compare = min (bestmatchsize, cclen);
|
|
|
481 Bufbyte *p1 = string_data (XSTRING (bestmatch));
|
|
|
482 Bufbyte *p2 = d_name;
|
|
|
483 Charcount matchsize = scmp (p1, p2, compare);
|
|
|
484
|
|
|
485 if (matchsize < 0)
|
|
|
486 matchsize = compare;
|
|
|
487 if (completion_ignore_case)
|
|
|
488 {
|
|
|
489 /* If this is an exact match except for case,
|
|
|
490 use it as the best match rather than one that is not
|
|
|
491 an exact match. This way, we get the case pattern
|
|
|
492 of the actual match. */
|
|
|
493 if ((matchsize == len
|
|
|
494 && matchsize + !!directoryp
|
|
|
495 < string_char_length (XSTRING (bestmatch)))
|
|
|
496 ||
|
|
|
497 /* If there is no exact match ignoring case,
|
|
|
498 prefer a match that does not change the case
|
|
|
499 of the input. */
|
|
|
500 (((matchsize == len)
|
|
|
501 ==
|
|
|
502 (matchsize + !!directoryp
|
|
|
503 == string_char_length (XSTRING (bestmatch))))
|
|
|
504 /* If there is more than one exact match aside from
|
|
|
505 case, and one of them is exact including case,
|
|
|
506 prefer that one. */
|
|
|
507 && 0 > scmp_1 (p2, string_data (XSTRING (file)),
|
|
|
508 file_name_length, 0)
|
|
|
509 && 0 <= scmp_1 (p1, string_data (XSTRING (file)),
|
|
|
510 file_name_length, 0)))
|
|
|
511 {
|
|
|
512 /* bestmatch = make_string (d_name, len); */ /* mrb */
|
|
|
513 bestmatch = make_ext_string (d_name, len, FORMAT_BINARY);
|
|
|
514 if (directoryp)
|
|
|
515 bestmatch =
|
|
|
516 Ffile_name_as_directory (bestmatch);
|
|
|
517 }
|
|
|
518 }
|
|
|
519
|
|
|
520 /* If this dirname all matches,
|
|
|
521 see if implicit following slash does too. */
|
|
|
522 if (directoryp
|
|
|
523 && compare == matchsize
|
|
|
524 && bestmatchsize > matchsize
|
|
|
525 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
|
|
|
526 matchsize++;
|
|
|
527 bestmatchsize = matchsize;
|
|
|
528 }
|
|
|
529 }
|
|
|
530 closedir (d);
|
|
|
531 }
|
|
|
532
|
|
|
533 unbind_to (speccount, Qnil);
|
|
|
534
|
|
|
535 UNGCPRO;
|
|
|
536
|
|
|
537 if (all_flag || NILP (bestmatch))
|
|
|
538 return bestmatch;
|
|
|
539 if (matchcount == 1 && bestmatchsize == file_name_length)
|
|
|
540 return Qt;
|
|
|
541 return Fsubstring (bestmatch, make_int (0), make_int (bestmatchsize));
|
|
|
542 }
|
|
|
543
|
|
|
544
|
|
|
545 Lisp_Object
|
|
|
546 make_directory_hash_table (char *path)
|
|
|
547 {
|
|
|
548 DIR *d;
|
|
|
549 DIRENTRY *dp;
|
|
|
550 Bytecount len;
|
|
|
551 Lisp_Object hash = make_lisp_hashtable (100, HASHTABLE_NONWEAK,
|
|
|
552 HASHTABLE_EQUAL);
|
|
|
553 if ((d = opendir (path)))
|
|
|
554 {
|
|
|
555 while ((dp = readdir (d)))
|
|
|
556 {
|
|
|
557 len = NAMLEN (dp);
|
|
|
558 if (DIRENTRY_NONEMPTY (dp))
|
|
|
559 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
|
|
|
560 }
|
|
|
561 closedir (d);
|
|
|
562 }
|
|
|
563 return hash;
|
|
|
564 }
|
|
|
565
|
|
|
566 #ifdef VMS
|
|
|
567
|
|
|
568 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
|
|
|
569 Sfile_name_all_versions, 2, 2, 0 /*
|
|
|
570 Return a list of all versions of file name FILE in directory DIR.
|
|
|
571 */ )
|
|
|
572 (file, dirname)
|
|
|
573 Lisp_Object file, dirname;
|
|
|
574 {
|
|
|
575 /* This function can GC */
|
|
|
576 return file_name_completion (file, dirname, 1, 1);
|
|
|
577 }
|
|
|
578
|
|
|
579 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0 /*
|
|
|
580 Return the maximum number of versions allowed for FILE.
|
|
|
581 Returns nil if the file cannot be opened or if there is no version limit.
|
|
|
582 */ )
|
|
|
583 (filename)
|
|
|
584 Lisp_Object filename;
|
|
|
585 {
|
|
|
586 /* This function can GC */
|
|
|
587 Lisp_Object retval;
|
|
|
588 struct FAB fab;
|
|
|
589 struct RAB rab;
|
|
|
590 struct XABFHC xabfhc;
|
|
|
591 int status;
|
|
|
592
|
|
|
593 filename = Fexpand_file_name (filename, Qnil);
|
|
|
594 CHECK_STRING (filename);
|
|
|
595 fab = cc$rms_fab;
|
|
|
596 xabfhc = cc$rms_xabfhc;
|
|
|
597 fab.fab$l_fna = string_data (XSTRING (filename));
|
|
|
598 fab.fab$b_fns = strlen (fab.fab$l_fna);
|
|
|
599 fab.fab$l_xab = (char *) &xabfhc;
|
|
|
600 status = sys$open (&fab, 0, 0);
|
|
|
601 if (status != RMS$_NORMAL) /* Probably non-existent file */
|
|
|
602 return Qnil;
|
|
|
603 sys$close (&fab, 0, 0);
|
|
|
604 if (xabfhc.xab$w_verlimit == 32767)
|
|
|
605 return Qnil; /* No version limit */
|
|
|
606 else
|
|
|
607 return make_int (xabfhc.xab$w_verlimit);
|
|
|
608 }
|
|
|
609
|
|
|
610 #endif /* VMS */
|
|
|
611
|
|
|
612
|
|
|
613 Lisp_Object
|
|
|
614 wasteful_word_to_lisp (unsigned int item)
|
|
|
615 {
|
|
|
616 /* Compatibility: in other versions, file-attributes returns a LIST
|
|
|
617 of two 16 bit integers... */
|
|
|
618 Lisp_Object cons = word_to_lisp (item);
|
|
|
619 XCDR (cons) = Fcons (XCDR (cons), Qnil);
|
|
|
620 return cons;
|
|
|
621 }
|
|
|
622
|
|
|
623 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0 /*
|
|
|
624 Return a list of attributes of file FILENAME.
|
|
|
625 Value is nil if specified file cannot be opened.
|
|
|
626 Otherwise, list elements are:
|
|
|
627 0. t for directory, string (name linked to) for symbolic link, or nil.
|
|
|
628 1. Number of links to file.
|
|
|
629 2. File uid.
|
|
|
630 3. File gid.
|
|
|
631 4. Last access time, as a list of two integers.
|
|
|
632 First integer has high-order 16 bits of time, second has low 16 bits.
|
|
|
633 5. Last modification time, likewise.
|
|
|
634 6. Last status change time, likewise.
|
|
|
635 7. Size in bytes. (-1, if number is out of range).
|
|
|
636 8. File modes, as a string of ten letters or dashes as in ls -l.
|
|
|
637 9. t iff file's gid would change if file were deleted and recreated.
|
|
|
638 10. inode number.
|
|
|
639 11. Device number.
|
|
|
640
|
|
|
641 If file does not exist, returns nil.
|
|
|
642 */ )
|
|
|
643 (filename)
|
|
|
644 Lisp_Object filename;
|
|
|
645 {
|
|
|
646 /* This function can GC */
|
|
|
647 Lisp_Object values[12];
|
|
|
648 Lisp_Object dirname = Qnil;
|
|
|
649 struct stat s;
|
|
|
650 char modes[10];
|
|
|
651 Lisp_Object handler;
|
|
|
652 struct gcpro gcpro1, gcpro2;
|
|
|
653
|
|
|
654 GCPRO1 (filename);
|
|
|
655 filename = Fexpand_file_name (filename, Qnil);
|
|
|
656
|
|
|
657 /* If the file name has special constructs in it,
|
|
|
658 call the corresponding file handler. */
|
|
|
659 handler = Ffind_file_name_handler (filename, Qfile_attributes);
|
|
|
660 UNGCPRO;
|
|
|
661 if (!NILP (handler))
|
|
|
662 return call2 (handler, Qfile_attributes, filename);
|
|
|
663
|
|
|
664 if (lstat ((char *) string_data (XSTRING (filename)), &s) < 0)
|
|
|
665 return Qnil;
|
|
|
666
|
|
|
667 GCPRO2 (filename, dirname);
|
|
|
668
|
|
|
669 #ifdef BSD4_2
|
|
|
670 dirname = Ffile_name_directory (filename);
|
|
|
671 #endif
|
|
|
672
|
|
|
673 #ifdef MSDOS
|
|
|
674 {
|
|
|
675 char *tmpnam =
|
|
|
676 (char *) string_data (XSTRING (Ffile_name_nondirectory (filename)));
|
|
|
677 int l = strlen (tmpnam);
|
|
|
678
|
|
|
679 if (l >= 5
|
|
|
680 && S_ISREG (s.st_mode)
|
|
|
681 && (stricmp (&tmpnam[l - 4], ".com") == 0
|
|
|
682 || stricmp (&tmpnam[l - 4], ".exe") == 0
|
|
|
683 || stricmp (&tmpnam[l - 4], ".bat") == 0))
|
|
|
684 {
|
|
|
685 s.st_mode |= S_IEXEC;
|
|
|
686 }
|
|
|
687 }
|
|
|
688 #endif /* MSDOS */
|
|
|
689
|
|
|
690 switch (s.st_mode & S_IFMT)
|
|
|
691 {
|
|
|
692 default:
|
|
|
693 values[0] = Qnil;
|
|
|
694 break;
|
|
|
695 case S_IFDIR:
|
|
|
696 values[0] = Qt;
|
|
|
697 break;
|
|
|
698 #ifdef S_IFLNK
|
|
|
699 case S_IFLNK:
|
|
|
700 values[0] = Ffile_symlink_p (filename);
|
|
|
701 break;
|
|
|
702 #endif
|
|
|
703 }
|
|
|
704 values[1] = make_int (s.st_nlink);
|
|
|
705 values[2] = make_int (s.st_uid);
|
|
|
706 values[3] = make_int (s.st_gid);
|
|
|
707 values[4] = wasteful_word_to_lisp (s.st_atime);
|
|
|
708 values[5] = wasteful_word_to_lisp (s.st_mtime);
|
|
|
709 values[6] = wasteful_word_to_lisp (s.st_ctime);
|
|
|
710 values[7] = make_int ((EMACS_INT) s.st_size);
|
|
|
711 /* If the size is out of range, give back -1. */
|
|
|
712 /* #### Fix when Emacs gets bignums! */
|
|
|
713 if (XINT (values[7]) != s.st_size)
|
|
|
714 XSETINT (values[7], -1);
|
|
|
715 filemodestring (&s, modes);
|
|
|
716 values[8] = make_string ((Bufbyte *) modes, 10);
|
|
|
717 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
|
|
|
718 {
|
|
|
719 struct stat sdir;
|
|
|
720
|
|
|
721 if (!NILP (dirname) && stat ((char *) string_data (XSTRING (dirname)), &sdir) == 0)
|
|
|
722 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
|
|
|
723 else /* if we can't tell, assume worst */
|
|
|
724 values[9] = Qt;
|
|
|
725 }
|
|
|
726 #else /* file gid will be egid */
|
|
|
727 #ifdef WINDOWSNT
|
|
|
728 values[9] = Qnil; /* sorry, no group IDs on NT */
|
|
|
729 #else /* not WINDOWSNT */
|
|
|
730 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
|
|
|
731 #endif /* not WINDOWSNT */
|
|
|
732 #endif /* BSD4_2 or BSD4_3 */
|
|
|
733 #ifdef WINDOWSNT
|
|
|
734 /* Fill in the inode and device values specially...see nt.c. */
|
|
|
735 if (!get_inode_and_device_vals (filename, &values[10], &values[11]))
|
|
|
736 {
|
|
|
737 UNGCPRO;
|
|
|
738 return Qnil;
|
|
|
739 }
|
|
|
740 #else /* not WINDOWSNT */
|
|
|
741 values[10] = make_int (s.st_ino);
|
|
|
742 values[11] = make_int (s.st_dev);
|
|
|
743 #endif /* not WINDOWSNT */
|
|
|
744 UNGCPRO;
|
|
|
745 return Flist (countof (values), values);
|
|
|
746 }
|
|
|
747
|
|
|
748
|
|
|
749 /************************************************************************/
|
|
|
750 /* initialization */
|
|
|
751 /************************************************************************/
|
|
|
752
|
|
|
753 void
|
|
|
754 syms_of_dired (void)
|
|
|
755 {
|
|
|
756 defsymbol (&Qdirectory_files, "directory-files");
|
|
|
757 defsymbol (&Qfile_name_completion, "file-name-completion");
|
|
|
758 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
|
|
|
759 defsymbol (&Qfile_attributes, "file-attributes");
|
|
|
760
|
|
|
761 defsubr (&Sdirectory_files);
|
|
|
762 defsubr (&Sfile_name_completion);
|
|
|
763 #ifdef VMS
|
|
|
764 defsubr (&Sfile_name_all_versions);
|
|
|
765 defsubr (&Sfile_version_limit);
|
|
|
766 #endif /* VMS */
|
|
|
767 defsubr (&Sfile_name_all_completions);
|
|
|
768 defsubr (&Sfile_attributes);
|
|
|
769 }
|
|
|
770
|
|
|
771 void
|
|
|
772 vars_of_dired (void)
|
|
|
773 {
|
|
|
774 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
|
|
|
775 *Completion ignores filenames ending in any string in this list.
|
|
|
776 This variable does not affect lists of possible completions,
|
|
|
777 but does affect the commands that actually do completions.
|
|
|
778 It is used by the functions `file-name-completion' and
|
|
|
779 `file-name-all-completions'.
|
|
|
780 */ );
|
|
|
781 Vcompletion_ignored_extensions = Qnil;
|
|
|
782 }
|
