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