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