|
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"
|
|
195
|
30 #include "opaque.h"
|
|
0
|
31 #include "sysfile.h"
|
|
|
32 #include "sysdir.h"
|
|
373
|
33 #include "systime.h"
|
|
|
34 #include "syspwd.h"
|
|
0
|
35
|
|
|
36 Lisp_Object Vcompletion_ignored_extensions;
|
|
|
37 Lisp_Object Qdirectory_files;
|
|
|
38 Lisp_Object Qfile_name_completion;
|
|
|
39 Lisp_Object Qfile_name_all_completions;
|
|
|
40 Lisp_Object Qfile_attributes;
|
|
|
41
|
|
195
|
42 static Lisp_Object
|
|
209
|
43 close_directory_unwind (Lisp_Object unwind_obj)
|
|
195
|
44 {
|
|
|
45 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
|
|
|
46 closedir (d);
|
|
|
47 free_opaque_ptr (unwind_obj);
|
|
|
48 return Qnil;
|
|
|
49 }
|
|
|
50
|
|
20
|
51 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
|
|
0
|
52 Return a list of names of files in DIRECTORY.
|
|
|
53 There are four optional arguments:
|
|
|
54 If FULL is non-nil, absolute pathnames of the files are returned.
|
|
|
55 If MATCH is non-nil, only pathnames containing that regexp are returned.
|
|
|
56 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
|
|
|
57 NOSORT is useful if you plan to sort the result yourself.
|
|
185
|
58 If FILES-ONLY is the symbol t, then only the "files" in the directory
|
|
0
|
59 will be returned; subdirectories will be excluded. If FILES-ONLY is not
|
|
|
60 nil and not t, then only the subdirectories will be returned. Otherwise,
|
|
|
61 if FILES-ONLY is nil (the default) then both files and subdirectories will
|
|
|
62 be returned.
|
|
20
|
63 */
|
|
|
64 (dirname, full, match, nosort, files_only))
|
|
0
|
65 {
|
|
267
|
66 /* This function can GC */
|
|
0
|
67 DIR *d;
|
|
267
|
68 Lisp_Object list = Qnil;
|
|
|
69 Bytecount dirnamelen;
|
|
0
|
70 Lisp_Object handler;
|
|
173
|
71 struct re_pattern_buffer *bufp = NULL;
|
|
195
|
72 int speccount = specpdl_depth ();
|
|
|
73 char *statbuf, *statbuf_tail;
|
|
0
|
74
|
|
267
|
75 struct gcpro gcpro1, gcpro2;
|
|
|
76 GCPRO2 (dirname, list);
|
|
0
|
77
|
|
|
78 /* If the file name has special constructs in it,
|
|
|
79 call the corresponding file handler. */
|
|
|
80 handler = Ffind_file_name_handler (dirname, Qdirectory_files);
|
|
|
81 if (!NILP (handler))
|
|
267
|
82 {
|
|
|
83 UNGCPRO;
|
|
|
84 if (!NILP (files_only))
|
|
|
85 return call6 (handler, Qdirectory_files, dirname, full, match, nosort,
|
|
|
86 files_only);
|
|
|
87 else
|
|
|
88 return call5 (handler, Qdirectory_files, dirname, full, match,
|
|
|
89 nosort);
|
|
|
90 }
|
|
0
|
91
|
|
120
|
92 /* #### why do we do Fexpand_file_name after file handlers here,
|
|
|
93 but earlier everywhere else? */
|
|
0
|
94 dirname = Fexpand_file_name (dirname, Qnil);
|
|
267
|
95 dirname = Ffile_name_as_directory (dirname);
|
|
|
96 dirnamelen = XSTRING_LENGTH (dirname);
|
|
0
|
97
|
|
267
|
98 statbuf = (char *)alloca (dirnamelen + MAXNAMLEN + 1);
|
|
|
99 memcpy (statbuf, XSTRING_DATA (dirname), dirnamelen);
|
|
|
100 statbuf_tail = statbuf + dirnamelen;
|
|
0
|
101
|
|
|
102 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
|
|
195
|
103 potential regexp cache smashage. It comes before the opendir()
|
|
|
104 because it might signal an error. */
|
|
0
|
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 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
|
|
|
113 }
|
|
|
114
|
|
|
115 /* Now *bufp is the compiled form of MATCH; don't call anything
|
|
|
116 which might compile a new regexp until we're done with the loop! */
|
|
|
117
|
|
267
|
118 /* Do this opendir after anything which might signal an error.
|
|
380
|
119 NOTE: the above comment is old; previously, there was no
|
|
267
|
120 unwind-protection in case of error, but now there is. */
|
|
|
121 d = opendir ((char *) XSTRING_DATA (dirname));
|
|
|
122 if (!d)
|
|
0
|
123 report_file_error ("Opening directory", list1 (dirname));
|
|
|
124
|
|
209
|
125 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
|
|
195
|
126
|
|
0
|
127 /* Loop reading blocks */
|
|
|
128 while (1)
|
|
|
129 {
|
|
|
130 DIRENTRY *dp = readdir (d);
|
|
|
131 int len;
|
|
|
132
|
|
267
|
133 if (!dp)
|
|
|
134 break;
|
|
0
|
135 len = NAMLEN (dp);
|
|
267
|
136 if (DIRENTRY_NONEMPTY (dp)
|
|
|
137 && (NILP (match)
|
|
|
138 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
|
|
0
|
139 {
|
|
267
|
140 if (!NILP (files_only))
|
|
0
|
141 {
|
|
267
|
142 int dir_p;
|
|
|
143 struct stat st;
|
|
|
144 char *cur_statbuf = statbuf;
|
|
|
145 char *cur_statbuf_tail = statbuf_tail;
|
|
|
146
|
|
|
147 /* #### I don't think the code under `if' is necessary
|
|
|
148 anymore. The crashes in this function were reported
|
|
|
149 because MAXNAMLEN was used to remember the *whole*
|
|
|
150 statbuf, instead of using MAXPATHLEN. This should be
|
|
276
|
151 tested after 21.0 is released. */
|
|
0
|
152
|
|
267
|
153 /* We normally use the buffer created by alloca.
|
|
|
154 However, if the file name we get too big, we'll use a
|
|
|
155 malloced buffer, and free it. It is undefined how
|
|
|
156 stat() will react to this, but we avoid a buffer
|
|
|
157 overrun. */
|
|
|
158 if (len > MAXNAMLEN)
|
|
|
159 {
|
|
|
160 cur_statbuf = (char *)xmalloc (dirnamelen + len + 1);
|
|
|
161 memcpy (cur_statbuf, statbuf, dirnamelen);
|
|
|
162 cur_statbuf_tail = cur_statbuf + dirnamelen;
|
|
|
163 }
|
|
|
164 memcpy (cur_statbuf_tail, dp->d_name, len);
|
|
|
165 cur_statbuf_tail[len] = 0;
|
|
0
|
166
|
|
267
|
167 if (stat (cur_statbuf, &st) < 0)
|
|
|
168 dir_p = 0;
|
|
|
169 else
|
|
|
170 dir_p = ((st.st_mode & S_IFMT) == S_IFDIR);
|
|
195
|
171
|
|
267
|
172 if (cur_statbuf != statbuf)
|
|
|
173 xfree (cur_statbuf);
|
|
0
|
174
|
|
267
|
175 if (EQ (files_only, Qt) && dir_p)
|
|
|
176 continue;
|
|
|
177 else if (!EQ (files_only, Qt) && !dir_p)
|
|
|
178 continue;
|
|
|
179 }
|
|
0
|
180
|
|
380
|
181 {
|
|
|
182 Lisp_Object name =
|
|
384
|
183 make_string ((Bufbyte *)dp->d_name, len);
|
|
380
|
184 if (!NILP (full))
|
|
|
185 name = concat2 (dirname, name);
|
|
267
|
186
|
|
380
|
187 list = Fcons (name, list);
|
|
|
188 }
|
|
0
|
189 }
|
|
|
190 }
|
|
195
|
191 unbind_to (speccount, Qnil); /* This will close the dir */
|
|
267
|
192
|
|
380
|
193 if (NILP (nosort))
|
|
|
194 list = Fsort (Fnreverse (list), Qstring_lessp);
|
|
|
195
|
|
|
196 RETURN_UNGCPRO (list);
|
|
0
|
197 }
|
|
|
198
|
|
185
|
199 static Lisp_Object file_name_completion (Lisp_Object file,
|
|
|
200 Lisp_Object dirname,
|
|
0
|
201 int all_flag, int ver_flag);
|
|
|
202
|
|
20
|
203 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
|
|
0
|
204 Complete file name FILE in directory DIR.
|
|
|
205 Returns the longest string common to all filenames in DIR
|
|
|
206 that start with FILE.
|
|
|
207 If there is only one and FILE matches it exactly, returns t.
|
|
|
208 Returns nil if DIR contains no name starting with FILE.
|
|
|
209
|
|
|
210 Filenames which end with any member of `completion-ignored-extensions'
|
|
|
211 are not considered as possible completions for FILE unless there is no
|
|
|
212 other possible completion. `completion-ignored-extensions' is not applied
|
|
|
213 to the names of directories.
|
|
20
|
214 */
|
|
|
215 (file, dirname))
|
|
0
|
216 {
|
|
120
|
217 /* This function can GC. GC checked 1996.04.06. */
|
|
0
|
218 Lisp_Object handler;
|
|
|
219
|
|
|
220 /* If the directory name has special constructs in it,
|
|
|
221 call the corresponding file handler. */
|
|
|
222 handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
|
|
|
223 if (!NILP (handler))
|
|
|
224 return call3 (handler, Qfile_name_completion, file, dirname);
|
|
|
225
|
|
|
226 /* If the file name has special constructs in it,
|
|
|
227 call the corresponding file handler. */
|
|
|
228 handler = Ffind_file_name_handler (file, Qfile_name_completion);
|
|
|
229 if (!NILP (handler))
|
|
|
230 return call3 (handler, Qfile_name_completion, file, dirname);
|
|
|
231
|
|
|
232 return file_name_completion (file, dirname, 0, 0);
|
|
|
233 }
|
|
|
234
|
|
20
|
235 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
|
|
0
|
236 Return a list of all completions of file name FILE in directory DIR.
|
|
|
237 These are all file names in directory DIR which begin with FILE.
|
|
|
238
|
|
|
239 Filenames which end with any member of `completion-ignored-extensions'
|
|
|
240 are not considered as possible completions for FILE unless there is no
|
|
|
241 other possible completion. `completion-ignored-extensions' is not applied
|
|
|
242 to the names of directories.
|
|
20
|
243 */
|
|
|
244 (file, dirname))
|
|
0
|
245 {
|
|
120
|
246 /* This function can GC. GC checked 1997.06.04. */
|
|
0
|
247 Lisp_Object handler;
|
|
118
|
248 struct gcpro gcpro1;
|
|
0
|
249
|
|
118
|
250 GCPRO1 (dirname);
|
|
|
251 dirname = Fexpand_file_name (dirname, Qnil);
|
|
0
|
252 /* If the file name has special constructs in it,
|
|
|
253 call the corresponding file handler. */
|
|
|
254 handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
|
|
118
|
255 UNGCPRO;
|
|
0
|
256 if (!NILP (handler))
|
|
|
257 return call3 (handler, Qfile_name_all_completions, file,
|
|
|
258 dirname);
|
|
|
259
|
|
|
260 return file_name_completion (file, dirname, 1, 0);
|
|
|
261 }
|
|
|
262
|
|
|
263 static int
|
|
|
264 file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp,
|
|
|
265 struct stat *st_addr)
|
|
|
266 {
|
|
|
267 Bytecount len = NAMLEN (dp);
|
|
14
|
268 Bytecount pos = XSTRING_LENGTH (dirname);
|
|
0
|
269 int value;
|
|
|
270 char *fullname = (char *) alloca (len + pos + 2);
|
|
|
271
|
|
14
|
272 memcpy (fullname, XSTRING_DATA (dirname), pos);
|
|
0
|
273 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
|
|
|
274 fullname[pos++] = DIRECTORY_SEP;
|
|
|
275
|
|
|
276 memcpy (fullname + pos, dp->d_name, len);
|
|
|
277 fullname[pos + len] = 0;
|
|
|
278
|
|
|
279 #ifdef S_IFLNK
|
|
|
280 /* We want to return success if a link points to a nonexistent file,
|
|
|
281 but we want to return the status for what the link points to,
|
|
|
282 in case it is a directory. */
|
|
|
283 value = lstat (fullname, st_addr);
|
|
|
284 if (S_ISLNK (st_addr->st_mode))
|
|
|
285 stat (fullname, st_addr);
|
|
|
286 #else
|
|
|
287 value = stat (fullname, st_addr);
|
|
|
288 #endif
|
|
173
|
289 return value;
|
|
0
|
290 }
|
|
|
291
|
|
|
292 static Lisp_Object
|
|
267
|
293 file_name_completion_unwind (Lisp_Object locative)
|
|
219
|
294 {
|
|
|
295 DIR *d;
|
|
267
|
296 Lisp_Object obj = XCAR (locative);
|
|
219
|
297
|
|
373
|
298 if (!NILP (obj))
|
|
|
299 {
|
|
|
300 d = (DIR *)get_opaque_ptr (obj);
|
|
|
301 closedir (d);
|
|
|
302 free_opaque_ptr (obj);
|
|
|
303 }
|
|
267
|
304 free_cons (XCONS (locative));
|
|
219
|
305 return Qnil;
|
|
|
306 }
|
|
|
307
|
|
|
308 static Lisp_Object
|
|
0
|
309 file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
|
|
|
310 int ver_flag)
|
|
|
311 {
|
|
|
312 /* This function can GC */
|
|
|
313 DIR *d = 0;
|
|
|
314 int matchcount = 0;
|
|
|
315 Lisp_Object bestmatch = Qnil;
|
|
|
316 Charcount bestmatchsize = 0;
|
|
|
317 struct stat st;
|
|
|
318 int passcount;
|
|
|
319 int speccount = specpdl_depth ();
|
|
|
320 Charcount file_name_length;
|
|
267
|
321 Lisp_Object locative;
|
|
0
|
322 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
323
|
|
|
324 GCPRO3 (file, dirname, bestmatch);
|
|
|
325
|
|
|
326 CHECK_STRING (file);
|
|
|
327
|
|
219
|
328 #ifdef WINDOWSNT
|
|
|
329 /* Filename completion on Windows ignores case, since Windows
|
|
|
330 filesystems do. */
|
|
0
|
331 specbind (Qcompletion_ignore_case, Qt);
|
|
267
|
332 #endif /* WINDOWSNT */
|
|
0
|
333
|
|
|
334 #ifdef FILE_SYSTEM_CASE
|
|
|
335 file = FILE_SYSTEM_CASE (file);
|
|
|
336 #endif
|
|
|
337 dirname = Fexpand_file_name (dirname, Qnil);
|
|
272
|
338 file_name_length = XSTRING_CHAR_LENGTH (file);
|
|
0
|
339
|
|
|
340 /* With passcount = 0, ignore files that end in an ignored extension.
|
|
|
341 If nothing found then try again with passcount = 1, don't ignore them.
|
|
|
342 If looking for all completions, start with passcount = 1,
|
|
|
343 so always take even the ignored ones.
|
|
|
344
|
|
|
345 ** It would not actually be helpful to the user to ignore any possible
|
|
|
346 completions when making a list of them.** */
|
|
|
347
|
|
219
|
348 /* We cannot use close_directory_unwind() because we change the
|
|
|
349 directory. The old code used to just avoid signaling errors, and
|
|
|
350 call closedir, but it was wrong, because it made sane handling of
|
|
|
351 QUIT impossible and, besides, various utility functions like
|
|
|
352 regexp_ignore_completion_p can signal errors. */
|
|
267
|
353 locative = noseeum_cons (Qnil, Qnil);
|
|
|
354 record_unwind_protect (file_name_completion_unwind, locative);
|
|
219
|
355
|
|
0
|
356 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
|
|
|
357 {
|
|
16
|
358 d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (dirname)));
|
|
0
|
359 if (!d)
|
|
|
360 report_file_error ("Opening directory", list1 (dirname));
|
|
267
|
361 XCAR (locative) = make_opaque_ptr ((void *)d);
|
|
0
|
362
|
|
|
363 /* Loop reading blocks */
|
|
|
364 while (1)
|
|
|
365 {
|
|
|
366 DIRENTRY *dp;
|
|
|
367 Bytecount len;
|
|
|
368 /* scmp() works in characters, not bytes, so we have to compute
|
|
|
369 this value: */
|
|
|
370 Charcount cclen;
|
|
|
371 int directoryp;
|
|
|
372 int ignored_extension_p = 0;
|
|
|
373 Bufbyte *d_name;
|
|
|
374
|
|
267
|
375 dp = readdir (d);
|
|
0
|
376 if (!dp) break;
|
|
|
377
|
|
377
|
378 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
|
|
0
|
379 d_name = (Bufbyte *) dp->d_name;
|
|
|
380 len = NAMLEN (dp);
|
|
2
|
381 cclen = bytecount_to_charcount (d_name, len);
|
|
0
|
382
|
|
219
|
383 QUIT;
|
|
0
|
384
|
|
|
385 if (! DIRENTRY_NONEMPTY (dp)
|
|
|
386 || cclen < file_name_length
|
|
14
|
387 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
|
|
0
|
388 continue;
|
|
|
389
|
|
|
390 if (file_name_completion_stat (dirname, dp, &st) < 0)
|
|
|
391 continue;
|
|
|
392
|
|
|
393 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
|
|
|
394 if (directoryp)
|
|
|
395 {
|
|
|
396 #ifndef TRIVIAL_DIRECTORY_ENTRY
|
|
|
397 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
|
|
|
398 #endif
|
|
|
399 /* "." and ".." are never interesting as completions, but are
|
|
2
|
400 actually in the way in a directory containing only one file. */
|
|
0
|
401 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
|
|
|
402 continue;
|
|
|
403 }
|
|
|
404 else
|
|
|
405 {
|
|
|
406 /* Compare extensions-to-be-ignored against end of this file name */
|
|
2
|
407 /* if name is not an exact match against specified string. */
|
|
0
|
408 if (!passcount && cclen > file_name_length)
|
|
|
409 {
|
|
|
410 Lisp_Object tem;
|
|
|
411 /* and exit this for loop if a match is found */
|
|
219
|
412 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
|
|
0
|
413 {
|
|
|
414 Lisp_Object elt = XCAR (tem);
|
|
|
415 Charcount skip;
|
|
|
416
|
|
219
|
417 CHECK_STRING (elt);
|
|
|
418
|
|
272
|
419 skip = cclen - XSTRING_CHAR_LENGTH (elt);
|
|
0
|
420 if (skip < 0) continue;
|
|
|
421
|
|
|
422 if (0 > scmp (charptr_n_addr (d_name, skip),
|
|
14
|
423 XSTRING_DATA (elt),
|
|
272
|
424 XSTRING_CHAR_LENGTH (elt)))
|
|
0
|
425 {
|
|
|
426 ignored_extension_p = 1;
|
|
|
427 break;
|
|
|
428 }
|
|
|
429 }
|
|
|
430 }
|
|
|
431 }
|
|
|
432
|
|
|
433 /* If an ignored-extensions match was found,
|
|
|
434 don't process this name as a completion. */
|
|
|
435 if (!passcount && ignored_extension_p)
|
|
|
436 continue;
|
|
|
437
|
|
2
|
438 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
|
|
0
|
439 continue;
|
|
|
440
|
|
|
441 /* Update computation of how much all possible completions match */
|
|
|
442 matchcount++;
|
|
|
443
|
|
|
444 if (all_flag || NILP (bestmatch))
|
|
|
445 {
|
|
|
446 Lisp_Object name = Qnil;
|
|
|
447 struct gcpro ngcpro1;
|
|
|
448 NGCPRO1 (name);
|
|
|
449 /* This is a possible completion */
|
|
2
|
450 name = make_string (d_name, len);
|
|
|
451 if (directoryp) /* Completion is a directory; end it with '/' */
|
|
|
452 name = Ffile_name_as_directory (name);
|
|
0
|
453 if (all_flag)
|
|
|
454 {
|
|
|
455 bestmatch = Fcons (name, bestmatch);
|
|
|
456 }
|
|
|
457 else
|
|
|
458 {
|
|
|
459 bestmatch = name;
|
|
272
|
460 bestmatchsize = XSTRING_CHAR_LENGTH (name);
|
|
0
|
461 }
|
|
|
462 NUNGCPRO;
|
|
|
463 }
|
|
|
464 else
|
|
|
465 {
|
|
|
466 Charcount compare = min (bestmatchsize, cclen);
|
|
14
|
467 Bufbyte *p1 = XSTRING_DATA (bestmatch);
|
|
0
|
468 Bufbyte *p2 = d_name;
|
|
|
469 Charcount matchsize = scmp (p1, p2, compare);
|
|
|
470
|
|
|
471 if (matchsize < 0)
|
|
|
472 matchsize = compare;
|
|
|
473 if (completion_ignore_case)
|
|
|
474 {
|
|
|
475 /* If this is an exact match except for case,
|
|
|
476 use it as the best match rather than one that is not
|
|
|
477 an exact match. This way, we get the case pattern
|
|
|
478 of the actual match. */
|
|
2
|
479 if ((matchsize == cclen
|
|
185
|
480 && matchsize + !!directoryp
|
|
272
|
481 < XSTRING_CHAR_LENGTH (bestmatch))
|
|
0
|
482 ||
|
|
|
483 /* If there is no exact match ignoring case,
|
|
|
484 prefer a match that does not change the case
|
|
|
485 of the input. */
|
|
2
|
486 (((matchsize == cclen)
|
|
0
|
487 ==
|
|
185
|
488 (matchsize + !!directoryp
|
|
272
|
489 == XSTRING_CHAR_LENGTH (bestmatch)))
|
|
0
|
490 /* If there is more than one exact match aside from
|
|
|
491 case, and one of them is exact including case,
|
|
|
492 prefer that one. */
|
|
14
|
493 && 0 > scmp_1 (p2, XSTRING_DATA (file),
|
|
0
|
494 file_name_length, 0)
|
|
14
|
495 && 0 <= scmp_1 (p1, XSTRING_DATA (file),
|
|
0
|
496 file_name_length, 0)))
|
|
|
497 {
|
|
2
|
498 bestmatch = make_string (d_name, len);
|
|
0
|
499 if (directoryp)
|
|
2
|
500 bestmatch = Ffile_name_as_directory (bestmatch);
|
|
0
|
501 }
|
|
|
502 }
|
|
|
503
|
|
|
504 /* If this dirname all matches,
|
|
|
505 see if implicit following slash does too. */
|
|
|
506 if (directoryp
|
|
|
507 && compare == matchsize
|
|
|
508 && bestmatchsize > matchsize
|
|
|
509 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
|
|
|
510 matchsize++;
|
|
|
511 bestmatchsize = matchsize;
|
|
|
512 }
|
|
|
513 }
|
|
|
514 closedir (d);
|
|
267
|
515 free_opaque_ptr (XCAR (locative));
|
|
|
516 XCAR (locative) = Qnil;
|
|
0
|
517 }
|
|
|
518
|
|
|
519 unbind_to (speccount, Qnil);
|
|
|
520
|
|
|
521 UNGCPRO;
|
|
|
522
|
|
|
523 if (all_flag || NILP (bestmatch))
|
|
|
524 return bestmatch;
|
|
|
525 if (matchcount == 1 && bestmatchsize == file_name_length)
|
|
|
526 return Qt;
|
|
227
|
527 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
|
|
0
|
528 }
|
|
|
529
|
|
|
530
|
|
377
|
531
|
|
|
532 /* The *pwent() functions do not exist on NT */
|
|
|
533 #ifndef WINDOWSNT
|
|
|
534
|
|
373
|
535 static Lisp_Object user_name_completion (Lisp_Object user,
|
|
|
536 int all_flag,
|
|
|
537 int *uniq);
|
|
|
538
|
|
|
539 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
|
|
|
540 Complete user name USER.
|
|
|
541
|
|
|
542 Returns the longest string common to all user names that start
|
|
|
543 with USER. If there is only one and USER matches it exactly,
|
|
|
544 returns t. Returns nil if there is no user name starting with USER.
|
|
|
545 */
|
|
|
546 (user))
|
|
|
547 {
|
|
|
548 return user_name_completion (user, 0, NULL);
|
|
|
549 }
|
|
|
550
|
|
|
551 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
|
|
|
552 Complete user name USER.
|
|
|
553
|
|
|
554 This function is identical to `user-name-completion', except that
|
|
|
555 the cons of the completion and an indication of whether the
|
|
|
556 completion was unique is returned.
|
|
|
557
|
|
|
558 The car of the returned value is the longest string common to all
|
|
|
559 user names that start with USER. If there is only one and USER
|
|
|
560 matches it exactly, the car is t. The car is nil if there is no
|
|
|
561 user name starting with USER. The cdr of the result is non-nil
|
|
|
562 if and only if the completion returned in the car was unique.
|
|
|
563 */
|
|
|
564 (user))
|
|
|
565 {
|
|
|
566 int uniq;
|
|
|
567 Lisp_Object completed;
|
|
|
568
|
|
|
569 completed = user_name_completion (user, 0, &uniq);
|
|
|
570 return Fcons (completed, uniq ? Qt : Qnil);
|
|
|
571 }
|
|
|
572
|
|
|
573 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
|
|
|
574 Return a list of all completions of user name USER.
|
|
|
575 These are all user names which begin with USER.
|
|
|
576 */
|
|
|
577 (user))
|
|
|
578 {
|
|
|
579 return user_name_completion (user, 1, NULL);
|
|
|
580 }
|
|
|
581
|
|
|
582 static Lisp_Object
|
|
|
583 user_name_completion_unwind (Lisp_Object locative)
|
|
|
584 {
|
|
|
585 Lisp_Object obj1 = XCAR (locative);
|
|
|
586 Lisp_Object obj2 = XCDR (locative);
|
|
|
587 char **cache;
|
|
|
588 int clen, i;
|
|
|
589
|
|
|
590
|
|
|
591 if (!NILP (obj1) && !NILP (obj2))
|
|
|
592 {
|
|
|
593 /* clean up if interrupted building cache */
|
|
|
594 cache = *(char ***)get_opaque_ptr (obj1);
|
|
|
595 clen = *(int *)get_opaque_ptr (obj2);
|
|
|
596 free_opaque_ptr (obj1);
|
|
|
597 free_opaque_ptr (obj2);
|
|
|
598 for (i = 0; i < clen; i++)
|
|
|
599 free (cache[i]);
|
|
|
600 free (cache);
|
|
|
601 }
|
|
|
602
|
|
|
603 free_cons (XCONS (locative));
|
|
|
604 endpwent ();
|
|
|
605
|
|
|
606 return Qnil;
|
|
|
607 }
|
|
|
608
|
|
|
609 static char **user_cache;
|
|
|
610 static int user_cache_len;
|
|
|
611 static int user_cache_max;
|
|
|
612 static long user_cache_time;
|
|
|
613
|
|
|
614 #define USER_CACHE_REBUILD (24*60*60) /* 1 day, in seconds */
|
|
|
615
|
|
|
616 static Lisp_Object
|
|
|
617 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
|
|
|
618 {
|
|
|
619 /* This function can GC */
|
|
|
620 struct passwd *pw;
|
|
|
621 int matchcount = 0;
|
|
|
622 Lisp_Object bestmatch = Qnil;
|
|
|
623 Charcount bestmatchsize = 0;
|
|
|
624 int speccount = specpdl_depth ();
|
|
|
625 int i, cmax, clen;
|
|
|
626 char **cache;
|
|
|
627 Charcount user_name_length;
|
|
|
628 Lisp_Object locative;
|
|
|
629 EMACS_TIME t;
|
|
|
630 struct gcpro gcpro1, gcpro2;
|
|
|
631
|
|
|
632 GCPRO2 (user, bestmatch);
|
|
|
633
|
|
|
634 CHECK_STRING (user);
|
|
|
635
|
|
|
636 user_name_length = XSTRING_CHAR_LENGTH (user);
|
|
|
637
|
|
|
638 /* Cache user name lookups because it tends to be quite slow.
|
|
|
639 * Rebuild the cache occasionally to catch changes */
|
|
|
640 EMACS_GET_TIME (t);
|
|
|
641 if (user_cache &&
|
|
|
642 EMACS_SECS (t) - user_cache_time > USER_CACHE_REBUILD)
|
|
|
643 {
|
|
|
644 for (i = 0; i < user_cache_len; i++)
|
|
|
645 free (user_cache[i]);
|
|
|
646 free (user_cache);
|
|
|
647 user_cache = NULL;
|
|
|
648 user_cache_len = 0;
|
|
|
649 user_cache_max = 0;
|
|
|
650 }
|
|
|
651
|
|
|
652 if (user_cache == NULL || user_cache_max <= 0)
|
|
|
653 {
|
|
|
654 cmax = 200;
|
|
|
655 clen = 0;
|
|
|
656 cache = (char **) malloc (cmax*sizeof (char *));
|
|
|
657
|
|
|
658 setpwent ();
|
|
|
659 locative = noseeum_cons (Qnil, Qnil);
|
|
|
660 XCAR (locative) = make_opaque_ptr ((void *) &cache);
|
|
|
661 XCDR (locative) = make_opaque_ptr ((void *) &clen);
|
|
|
662 record_unwind_protect (user_name_completion_unwind, locative);
|
|
|
663 /* #### may need to slow down interrupts around call to getpwent
|
|
|
664 * below. at least the call to getpwnam in Fuser_full_name
|
|
|
665 * is documented as needing it on irix. */
|
|
|
666 while ((pw = getpwent ()))
|
|
|
667 {
|
|
|
668 if (clen >= cmax)
|
|
|
669 {
|
|
|
670 cmax *= 2;
|
|
|
671 cache = (char **) realloc (cache, cmax*sizeof (char *));
|
|
|
672 }
|
|
|
673
|
|
|
674 QUIT;
|
|
|
675
|
|
|
676 cache[clen++] = strdup (pw->pw_name);
|
|
|
677 }
|
|
|
678 free_opaque_ptr (XCAR (locative));
|
|
|
679 free_opaque_ptr (XCDR (locative));
|
|
|
680 XCAR (locative) = Qnil;
|
|
|
681 XCDR (locative) = Qnil;
|
|
|
682
|
|
|
683 unbind_to (speccount, Qnil); /* free locative cons, endpwent() */
|
|
|
684
|
|
|
685 user_cache_max = cmax;
|
|
|
686 user_cache_len = clen;
|
|
|
687 user_cache = cache;
|
|
|
688 user_cache_time = EMACS_SECS (t);
|
|
|
689 }
|
|
|
690
|
|
|
691 for (i = 0; i < user_cache_len; i++)
|
|
|
692 {
|
|
380
|
693 Bufbyte *d_name = (Bufbyte *) user_cache[i];
|
|
|
694 Bytecount len = strlen ((char *) d_name);
|
|
373
|
695 /* scmp() works in chars, not bytes, so we have to compute this: */
|
|
380
|
696 Charcount cclen = bytecount_to_charcount (d_name, len);
|
|
373
|
697
|
|
|
698 QUIT;
|
|
|
699
|
|
|
700 if (cclen < user_name_length ||
|
|
|
701 0 <= scmp (d_name, XSTRING_DATA (user), user_name_length))
|
|
|
702 continue;
|
|
|
703
|
|
|
704 matchcount++; /* count matching completions */
|
|
|
705
|
|
|
706 if (all_flag || NILP (bestmatch))
|
|
|
707 {
|
|
|
708 Lisp_Object name = Qnil;
|
|
|
709 struct gcpro ngcpro1;
|
|
|
710 NGCPRO1 (name);
|
|
|
711 /* This is a possible completion */
|
|
|
712 name = make_string (d_name, len);
|
|
|
713 if (all_flag)
|
|
|
714 {
|
|
|
715 bestmatch = Fcons (name, bestmatch);
|
|
|
716 }
|
|
|
717 else
|
|
|
718 {
|
|
|
719 bestmatch = name;
|
|
|
720 bestmatchsize = XSTRING_CHAR_LENGTH (name);
|
|
|
721 }
|
|
|
722 NUNGCPRO;
|
|
|
723 }
|
|
|
724 else
|
|
|
725 {
|
|
|
726 Charcount compare = min (bestmatchsize, cclen);
|
|
|
727 Bufbyte *p1 = XSTRING_DATA (bestmatch);
|
|
|
728 Bufbyte *p2 = d_name;
|
|
|
729 Charcount matchsize = scmp (p1, p2, compare);
|
|
|
730
|
|
|
731 if (matchsize < 0)
|
|
|
732 matchsize = compare;
|
|
|
733 if (completion_ignore_case)
|
|
|
734 {
|
|
|
735 /* If this is an exact match except for case,
|
|
|
736 use it as the best match rather than one that is not
|
|
|
737 an exact match. This way, we get the case pattern
|
|
|
738 of the actual match. */
|
|
|
739 if ((matchsize == cclen
|
|
|
740 && matchsize < XSTRING_CHAR_LENGTH (bestmatch))
|
|
|
741 ||
|
|
|
742 /* If there is no exact match ignoring case,
|
|
|
743 prefer a match that does not change the case
|
|
|
744 of the input. */
|
|
|
745 (((matchsize == cclen)
|
|
|
746 ==
|
|
|
747 (matchsize == XSTRING_CHAR_LENGTH (bestmatch)))
|
|
|
748 /* If there is more than one exact match aside from
|
|
|
749 case, and one of them is exact including case,
|
|
|
750 prefer that one. */
|
|
|
751 && 0 > scmp_1 (p2, XSTRING_DATA (user),
|
|
|
752 user_name_length, 0)
|
|
|
753 && 0 <= scmp_1 (p1, XSTRING_DATA (user),
|
|
|
754 user_name_length, 0)))
|
|
|
755 {
|
|
|
756 bestmatch = make_string (d_name, len);
|
|
|
757 }
|
|
|
758 }
|
|
|
759
|
|
|
760 bestmatchsize = matchsize;
|
|
|
761 }
|
|
|
762 }
|
|
|
763
|
|
|
764 UNGCPRO;
|
|
|
765
|
|
|
766 if (uniq)
|
|
|
767 *uniq = (matchcount == 1);
|
|
|
768
|
|
|
769 if (all_flag || NILP (bestmatch))
|
|
|
770 return bestmatch;
|
|
|
771 if (matchcount == 1 && bestmatchsize == user_name_length)
|
|
|
772 return Qt;
|
|
|
773 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
|
|
|
774 }
|
|
377
|
775 #endif /* ! defined WINDOWSNT */
|
|
373
|
776
|
|
|
777
|
|
0
|
778 Lisp_Object
|
|
280
|
779 make_directory_hash_table (CONST char *path)
|
|
0
|
780 {
|
|
|
781 DIR *d;
|
|
380
|
782 Lisp_Object hash =
|
|
|
783 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
|
|
0
|
784 if ((d = opendir (path)))
|
|
|
785 {
|
|
280
|
786 DIRENTRY *dp;
|
|
|
787
|
|
0
|
788 while ((dp = readdir (d)))
|
|
|
789 {
|
|
280
|
790 Bytecount len = NAMLEN (dp);
|
|
0
|
791 if (DIRENTRY_NONEMPTY (dp))
|
|
377
|
792 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
|
|
|
793 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
|
|
0
|
794 }
|
|
|
795 closedir (d);
|
|
|
796 }
|
|
|
797 return hash;
|
|
|
798 }
|
|
|
799
|
|
|
800 Lisp_Object
|
|
|
801 wasteful_word_to_lisp (unsigned int item)
|
|
|
802 {
|
|
|
803 /* Compatibility: in other versions, file-attributes returns a LIST
|
|
|
804 of two 16 bit integers... */
|
|
|
805 Lisp_Object cons = word_to_lisp (item);
|
|
|
806 XCDR (cons) = Fcons (XCDR (cons), Qnil);
|
|
|
807 return cons;
|
|
|
808 }
|
|
|
809
|
|
20
|
810 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
|
|
0
|
811 Return a list of attributes of file FILENAME.
|
|
|
812 Value is nil if specified file cannot be opened.
|
|
|
813 Otherwise, list elements are:
|
|
|
814 0. t for directory, string (name linked to) for symbolic link, or nil.
|
|
|
815 1. Number of links to file.
|
|
|
816 2. File uid.
|
|
|
817 3. File gid.
|
|
|
818 4. Last access time, as a list of two integers.
|
|
|
819 First integer has high-order 16 bits of time, second has low 16 bits.
|
|
|
820 5. Last modification time, likewise.
|
|
|
821 6. Last status change time, likewise.
|
|
|
822 7. Size in bytes. (-1, if number is out of range).
|
|
|
823 8. File modes, as a string of ten letters or dashes as in ls -l.
|
|
|
824 9. t iff file's gid would change if file were deleted and recreated.
|
|
|
825 10. inode number.
|
|
|
826 11. Device number.
|
|
|
827
|
|
|
828 If file does not exist, returns nil.
|
|
20
|
829 */
|
|
|
830 (filename))
|
|
0
|
831 {
|
|
120
|
832 /* This function can GC. GC checked 1997.06.04. */
|
|
0
|
833 Lisp_Object values[12];
|
|
|
834 Lisp_Object dirname = Qnil;
|
|
|
835 struct stat s;
|
|
|
836 char modes[10];
|
|
|
837 Lisp_Object handler;
|
|
|
838 struct gcpro gcpro1, gcpro2;
|
|
|
839
|
|
120
|
840 GCPRO2 (filename, dirname);
|
|
0
|
841 filename = Fexpand_file_name (filename, Qnil);
|
|
|
842
|
|
|
843 /* If the file name has special constructs in it,
|
|
|
844 call the corresponding file handler. */
|
|
|
845 handler = Ffind_file_name_handler (filename, Qfile_attributes);
|
|
|
846 if (!NILP (handler))
|
|
120
|
847 {
|
|
|
848 UNGCPRO;
|
|
|
849 return call2 (handler, Qfile_attributes, filename);
|
|
|
850 }
|
|
0
|
851
|
|
14
|
852 if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
|
|
120
|
853 {
|
|
|
854 UNGCPRO;
|
|
|
855 return Qnil;
|
|
|
856 }
|
|
0
|
857
|
|
|
858 #ifdef BSD4_2
|
|
|
859 dirname = Ffile_name_directory (filename);
|
|
|
860 #endif
|
|
|
861
|
|
|
862 #ifdef MSDOS
|
|
|
863 {
|
|
14
|
864 char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
|
|
0
|
865 int l = strlen (tmpnam);
|
|
|
866
|
|
185
|
867 if (l >= 5
|
|
0
|
868 && S_ISREG (s.st_mode)
|
|
14
|
869 && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
|
|
|
870 stricmp (&tmpnam[l - 4], ".exe") == 0 ||
|
|
|
871 stricmp (&tmpnam[l - 4], ".bat") == 0))
|
|
0
|
872 {
|
|
|
873 s.st_mode |= S_IEXEC;
|
|
|
874 }
|
|
|
875 }
|
|
|
876 #endif /* MSDOS */
|
|
|
877
|
|
|
878 switch (s.st_mode & S_IFMT)
|
|
|
879 {
|
|
|
880 default:
|
|
|
881 values[0] = Qnil;
|
|
|
882 break;
|
|
|
883 case S_IFDIR:
|
|
|
884 values[0] = Qt;
|
|
|
885 break;
|
|
|
886 #ifdef S_IFLNK
|
|
|
887 case S_IFLNK:
|
|
|
888 values[0] = Ffile_symlink_p (filename);
|
|
|
889 break;
|
|
|
890 #endif
|
|
|
891 }
|
|
|
892 values[1] = make_int (s.st_nlink);
|
|
|
893 values[2] = make_int (s.st_uid);
|
|
|
894 values[3] = make_int (s.st_gid);
|
|
|
895 values[4] = wasteful_word_to_lisp (s.st_atime);
|
|
|
896 values[5] = wasteful_word_to_lisp (s.st_mtime);
|
|
|
897 values[6] = wasteful_word_to_lisp (s.st_ctime);
|
|
|
898 values[7] = make_int ((EMACS_INT) s.st_size);
|
|
|
899 /* If the size is out of range, give back -1. */
|
|
|
900 /* #### Fix when Emacs gets bignums! */
|
|
|
901 if (XINT (values[7]) != s.st_size)
|
|
272
|
902 values[7] = make_int (-1);
|
|
0
|
903 filemodestring (&s, modes);
|
|
|
904 values[8] = make_string ((Bufbyte *) modes, 10);
|
|
|
905 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
|
|
|
906 {
|
|
|
907 struct stat sdir;
|
|
|
908
|
|
14
|
909 if (!NILP (dirname) && stat ((char *) XSTRING_DATA (dirname), &sdir) == 0)
|
|
0
|
910 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
|
|
|
911 else /* if we can't tell, assume worst */
|
|
|
912 values[9] = Qt;
|
|
|
913 }
|
|
|
914 #else /* file gid will be egid */
|
|
|
915 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
|
|
|
916 #endif /* BSD4_2 or BSD4_3 */
|
|
|
917 values[10] = make_int (s.st_ino);
|
|
|
918 values[11] = make_int (s.st_dev);
|
|
|
919 UNGCPRO;
|
|
|
920 return Flist (countof (values), values);
|
|
|
921 }
|
|
|
922
|
|
|
923
|
|
|
924 /************************************************************************/
|
|
|
925 /* initialization */
|
|
|
926 /************************************************************************/
|
|
|
927
|
|
|
928 void
|
|
|
929 syms_of_dired (void)
|
|
|
930 {
|
|
|
931 defsymbol (&Qdirectory_files, "directory-files");
|
|
|
932 defsymbol (&Qfile_name_completion, "file-name-completion");
|
|
|
933 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
|
|
|
934 defsymbol (&Qfile_attributes, "file-attributes");
|
|
|
935
|
|
20
|
936 DEFSUBR (Fdirectory_files);
|
|
|
937 DEFSUBR (Ffile_name_completion);
|
|
|
938 DEFSUBR (Ffile_name_all_completions);
|
|
377
|
939 #ifndef WINDOWSNT
|
|
373
|
940 DEFSUBR (Fuser_name_completion);
|
|
|
941 DEFSUBR (Fuser_name_completion_1);
|
|
|
942 DEFSUBR (Fuser_name_all_completions);
|
|
377
|
943 #endif
|
|
20
|
944 DEFSUBR (Ffile_attributes);
|
|
0
|
945 }
|
|
|
946
|
|
|
947 void
|
|
|
948 vars_of_dired (void)
|
|
|
949 {
|
|
|
950 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
|
|
|
951 *Completion ignores filenames ending in any string in this list.
|
|
|
952 This variable does not affect lists of possible completions,
|
|
|
953 but does affect the commands that actually do completions.
|
|
|
954 It is used by the functions `file-name-completion' and
|
|
|
955 `file-name-all-completions'.
|
|
|
956 */ );
|
|
|
957 Vcompletion_ignored_extensions = Qnil;
|
|
373
|
958
|
|
382
|
959 #ifndef WINDOWSNT
|
|
373
|
960 user_cache = NULL;
|
|
|
961 user_cache_len = 0;
|
|
|
962 user_cache_max = 0;
|
|
382
|
963 #endif
|
|
0
|
964 }
|
