More changes for itcl.
[emacs.git] / src / dired.c
blob834729a0319400c274b1e9ba125a50243e12e544
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include <config.h>
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
27 #ifdef VMS
28 #include <string.h>
29 #include <rms.h>
30 #include <rmsdef.h>
31 #endif
33 /* The d_nameln member of a struct dirent includes the '\0' character
34 on some systems, but not on others. What's worse, you can't tell
35 at compile-time which one it will be, since it really depends on
36 the sort of system providing the filesystem you're reading from,
37 not the system you are running on. Paul Eggert
38 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
39 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
40 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
42 Since applying strlen to the name always works, we'll just do that. */
43 #define NAMLEN(p) strlen (p->d_name)
45 #ifdef SYSV_SYSTEM_DIR
47 #include <dirent.h>
48 #define DIRENTRY struct dirent
50 #else /* not SYSV_SYSTEM_DIR */
52 #ifdef NONSYSTEM_DIR_LIBRARY
53 #include "ndir.h"
54 #else /* not NONSYSTEM_DIR_LIBRARY */
55 #ifdef MSDOS
56 #include <dirent.h>
57 #else
58 #include <sys/dir.h>
59 #endif
60 #endif /* not NONSYSTEM_DIR_LIBRARY */
62 #ifndef MSDOS
63 #define DIRENTRY struct direct
65 extern DIR *opendir ();
66 extern struct direct *readdir ();
68 #endif /* not MSDOS */
69 #endif /* not SYSV_SYSTEM_DIR */
71 #ifdef MSDOS
72 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
73 #else
74 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
75 #endif
77 #include "lisp.h"
78 #include "buffer.h"
79 #include "commands.h"
81 #include "regex.h"
83 /* Returns a search buffer, with a fastmap allocated and ready to go. */
84 extern struct re_pattern_buffer *compile_pattern ();
86 #define min(a, b) ((a) < (b) ? (a) : (b))
88 /* if system does not have symbolic links, it does not have lstat.
89 In that case, use ordinary stat instead. */
91 #ifndef S_IFLNK
92 #define lstat stat
93 #endif
95 extern int completion_ignore_case;
96 extern Lisp_Object Vcompletion_regexp_list;
98 Lisp_Object Vcompletion_ignored_extensions;
99 Lisp_Object Qcompletion_ignore_case;
100 Lisp_Object Qdirectory_files;
101 Lisp_Object Qfile_name_completion;
102 Lisp_Object Qfile_name_all_completions;
103 Lisp_Object Qfile_attributes;
105 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
106 "Return a list of names of files in DIRECTORY.\n\
107 There are three optional arguments:\n\
108 If FULL is non-nil, absolute pathnames of the files are returned.\n\
109 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
110 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
111 NOSORT is useful if you plan to sort the result yourself.")
112 (dirname, full, match, nosort)
113 Lisp_Object dirname, full, match, nosort;
115 DIR *d;
116 int dirnamelen;
117 Lisp_Object list, name, dirfilename;
118 Lisp_Object handler;
119 struct re_pattern_buffer *bufp;
121 /* If the file name has special constructs in it,
122 call the corresponding file handler. */
123 handler = Ffind_file_name_handler (dirname, Qdirectory_files);
124 if (!NILP (handler))
126 Lisp_Object args[6];
128 args[0] = handler;
129 args[1] = Qdirectory_files;
130 args[2] = dirname;
131 args[3] = full;
132 args[4] = match;
133 args[5] = nosort;
134 return Ffuncall (6, args);
138 struct gcpro gcpro1, gcpro2;
140 /* Because of file name handlers, these functions might call
141 Ffuncall, and cause a GC. */
142 GCPRO1 (match);
143 dirname = Fexpand_file_name (dirname, Qnil);
144 UNGCPRO;
145 GCPRO2 (match, dirname);
146 dirfilename = Fdirectory_file_name (dirname);
147 UNGCPRO;
150 if (!NILP (match))
152 CHECK_STRING (match, 3);
154 /* MATCH might be a flawed regular expression. Rather than
155 catching and signalling our own errors, we just call
156 compile_pattern to do the work for us. */
157 #ifdef VMS
158 bufp = compile_pattern (match, 0,
159 buffer_defaults.downcase_table->contents, 0);
160 #else
161 bufp = compile_pattern (match, 0, 0, 0);
162 #endif
165 /* Now *bufp is the compiled form of MATCH; don't call anything
166 which might compile a new regexp until we're done with the loop! */
168 /* Do this opendir after anything which might signal an error; if
169 an error is signalled while the directory stream is open, we
170 have to make sure it gets closed, and setting up an
171 unwind_protect to do so would be a pain. */
172 d = opendir (XSTRING (dirfilename)->data);
173 if (! d)
174 report_file_error ("Opening directory", Fcons (dirname, Qnil));
176 list = Qnil;
177 dirnamelen = XSTRING (dirname)->size;
179 /* Loop reading blocks */
180 while (1)
182 DIRENTRY *dp = readdir (d);
183 int len;
185 if (!dp) break;
186 len = NAMLEN (dp);
187 if (DIRENTRY_NONEMPTY (dp))
189 if (NILP (match)
190 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0)))
192 if (!NILP (full))
194 int afterdirindex = dirnamelen;
195 int total = len + dirnamelen;
196 int needsep = 0;
198 /* Decide whether we need to add a directory separator. */
199 #ifndef VMS
200 if (dirnamelen == 0
201 || !IS_ANY_SEP (XSTRING (dirname)->data[dirnamelen - 1]))
202 needsep = 1;
203 #endif /* VMS */
205 name = make_uninit_string (total + needsep);
206 bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
207 dirnamelen);
208 if (needsep)
209 XSTRING (name)->data[afterdirindex++] = DIRECTORY_SEP;
210 bcopy (dp->d_name,
211 XSTRING (name)->data + afterdirindex, len);
213 else
214 name = make_string (dp->d_name, len);
215 list = Fcons (name, list);
219 closedir (d);
220 if (!NILP (nosort))
221 return list;
222 return Fsort (Fnreverse (list), Qstring_lessp);
225 Lisp_Object file_name_completion ();
227 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
228 2, 2, 0,
229 "Complete file name FILE in directory DIR.\n\
230 Returns the longest string\n\
231 common to all filenames in DIR that start with FILE.\n\
232 If there is only one and FILE matches it exactly, returns t.\n\
233 Returns nil if DIR contains no name starting with FILE.")
234 (file, dirname)
235 Lisp_Object file, dirname;
237 Lisp_Object handler;
239 /* If the file name has special constructs in it,
240 call the corresponding file handler. */
241 handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
242 if (!NILP (handler))
243 return call3 (handler, Qfile_name_completion, file, dirname);
245 return file_name_completion (file, dirname, 0, 0);
248 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
249 Sfile_name_all_completions, 2, 2, 0,
250 "Return a list of all completions of file name FILE in directory DIR.\n\
251 These are all file names in directory DIR which begin with FILE.")
252 (file, dirname)
253 Lisp_Object file, dirname;
255 Lisp_Object handler;
257 /* If the file name has special constructs in it,
258 call the corresponding file handler. */
259 handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
260 if (!NILP (handler))
261 return call3 (handler, Qfile_name_all_completions, file, dirname);
263 return file_name_completion (file, dirname, 1, 0);
266 Lisp_Object
267 file_name_completion (file, dirname, all_flag, ver_flag)
268 Lisp_Object file, dirname;
269 int all_flag, ver_flag;
271 DIR *d;
272 DIRENTRY *dp;
273 int bestmatchsize, skip;
274 register int compare, matchsize;
275 unsigned char *p1, *p2;
276 int matchcount = 0;
277 Lisp_Object bestmatch, tem, elt, name;
278 struct stat st;
279 int directoryp;
280 int passcount;
281 int count = specpdl_ptr - specpdl;
282 struct gcpro gcpro1, gcpro2, gcpro3;
284 #ifdef VMS
285 extern DIRENTRY * readdirver ();
287 DIRENTRY *((* readfunc) ());
289 /* Filename completion on VMS ignores case, since VMS filesys does. */
290 specbind (Qcompletion_ignore_case, Qt);
292 readfunc = readdir;
293 if (ver_flag)
294 readfunc = readdirver;
295 file = Fupcase (file);
296 #else /* not VMS */
297 CHECK_STRING (file, 0);
298 #endif /* not VMS */
300 #ifdef FILE_SYSTEM_CASE
301 file = FILE_SYSTEM_CASE (file);
302 #endif
303 bestmatch = Qnil;
304 GCPRO3 (file, dirname, bestmatch);
305 dirname = Fexpand_file_name (dirname, Qnil);
307 /* With passcount = 0, ignore files that end in an ignored extension.
308 If nothing found then try again with passcount = 1, don't ignore them.
309 If looking for all completions, start with passcount = 1,
310 so always take even the ignored ones.
312 ** It would not actually be helpful to the user to ignore any possible
313 completions when making a list of them.** */
315 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
317 if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
318 report_file_error ("Opening directory", Fcons (dirname, Qnil));
320 /* Loop reading blocks */
321 /* (att3b compiler bug requires do a null comparison this way) */
322 while (1)
324 DIRENTRY *dp;
325 int len;
327 #ifdef VMS
328 dp = (*readfunc) (d);
329 #else
330 dp = readdir (d);
331 #endif
332 if (!dp) break;
334 len = NAMLEN (dp);
336 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
337 goto quit;
338 if (! DIRENTRY_NONEMPTY (dp)
339 || len < XSTRING (file)->size
340 || 0 <= scmp (dp->d_name, XSTRING (file)->data,
341 XSTRING (file)->size))
342 continue;
344 if (file_name_completion_stat (dirname, dp, &st) < 0)
345 continue;
347 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
348 tem = Qnil;
349 if (directoryp)
351 #ifndef TRIVIAL_DIRECTORY_ENTRY
352 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
353 #endif
354 /* "." and ".." are never interesting as completions, but are
355 actually in the way in a directory contains only one file. */
356 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
357 continue;
359 else
361 /* Compare extensions-to-be-ignored against end of this file name */
362 /* if name is not an exact match against specified string */
363 if (!passcount && len > XSTRING (file)->size)
364 /* and exit this for loop if a match is found */
365 for (tem = Vcompletion_ignored_extensions;
366 CONSP (tem); tem = XCONS (tem)->cdr)
368 elt = XCONS (tem)->car;
369 if (!STRINGP (elt)) continue;
370 skip = len - XSTRING (elt)->size;
371 if (skip < 0) continue;
373 if (0 <= scmp (dp->d_name + skip,
374 XSTRING (elt)->data,
375 XSTRING (elt)->size))
376 continue;
377 break;
381 /* If an ignored-extensions match was found,
382 don't process this name as a completion. */
383 if (!passcount && CONSP (tem))
384 continue;
386 if (!passcount)
388 Lisp_Object regexps;
389 Lisp_Object zero;
390 XSETFASTINT (zero, 0);
392 /* Ignore this element if it fails to match all the regexps. */
393 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
394 regexps = XCONS (regexps)->cdr)
396 tem = Fstring_match (XCONS (regexps)->car, elt, zero);
397 if (NILP (tem))
398 break;
400 if (CONSP (regexps))
401 continue;
404 /* Update computation of how much all possible completions match */
406 matchcount++;
408 if (all_flag || NILP (bestmatch))
410 /* This is a possible completion */
411 if (directoryp)
413 /* This completion is a directory; make it end with '/' */
414 name = Ffile_name_as_directory (make_string (dp->d_name, len));
416 else
417 name = make_string (dp->d_name, len);
418 if (all_flag)
420 bestmatch = Fcons (name, bestmatch);
422 else
424 bestmatch = name;
425 bestmatchsize = XSTRING (name)->size;
428 else
430 compare = min (bestmatchsize, len);
431 p1 = XSTRING (bestmatch)->data;
432 p2 = (unsigned char *) dp->d_name;
433 matchsize = scmp(p1, p2, compare);
434 if (matchsize < 0)
435 matchsize = compare;
436 if (completion_ignore_case)
438 /* If this is an exact match except for case,
439 use it as the best match rather than one that is not
440 an exact match. This way, we get the case pattern
441 of the actual match. */
442 if ((matchsize == len
443 && matchsize + !!directoryp
444 < XSTRING (bestmatch)->size)
446 /* If there is no exact match ignoring case,
447 prefer a match that does not change the case
448 of the input. */
449 (((matchsize == len)
451 (matchsize + !!directoryp
452 == XSTRING (bestmatch)->size))
453 /* If there is more than one exact match aside from
454 case, and one of them is exact including case,
455 prefer that one. */
456 && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size)
457 && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size)))
459 bestmatch = make_string (dp->d_name, len);
460 if (directoryp)
461 bestmatch = Ffile_name_as_directory (bestmatch);
465 /* If this dirname all matches, see if implicit following
466 slash does too. */
467 if (directoryp
468 && compare == matchsize
469 && bestmatchsize > matchsize
470 && IS_ANY_SEP (p1[matchsize]))
471 matchsize++;
472 bestmatchsize = matchsize;
475 closedir (d);
478 UNGCPRO;
479 bestmatch = unbind_to (count, bestmatch);
481 if (all_flag || NILP (bestmatch))
482 return bestmatch;
483 if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
484 return Qt;
485 return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
486 quit:
487 if (d) closedir (d);
488 Vquit_flag = Qnil;
489 return Fsignal (Qquit, Qnil);
492 file_name_completion_stat (dirname, dp, st_addr)
493 Lisp_Object dirname;
494 DIRENTRY *dp;
495 struct stat *st_addr;
497 int len = NAMLEN (dp);
498 int pos = XSTRING (dirname)->size;
499 int value;
500 char *fullname = (char *) alloca (len + pos + 2);
502 bcopy (XSTRING (dirname)->data, fullname, pos);
503 #ifndef VMS
504 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
505 fullname[pos++] = DIRECTORY_SEP;
506 #endif
508 bcopy (dp->d_name, fullname + pos, len);
509 fullname[pos + len] = 0;
511 #ifdef S_IFLNK
512 /* We want to return success if a link points to a nonexistent file,
513 but we want to return the status for what the link points to,
514 in case it is a directory. */
515 value = lstat (fullname, st_addr);
516 stat (fullname, st_addr);
517 return value;
518 #else
519 return stat (fullname, st_addr);
520 #endif
523 #ifdef VMS
525 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
526 Sfile_name_all_versions, 2, 2, 0,
527 "Return a list of all versions of file name FILE in directory DIR.")
528 (file, dirname)
529 Lisp_Object file, dirname;
531 return file_name_completion (file, dirname, 1, 1);
534 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
535 "Return the maximum number of versions allowed for FILE.\n\
536 Returns nil if the file cannot be opened or if there is no version limit.")
537 (filename)
538 Lisp_Object filename;
540 Lisp_Object retval;
541 struct FAB fab;
542 struct RAB rab;
543 struct XABFHC xabfhc;
544 int status;
546 filename = Fexpand_file_name (filename, Qnil);
547 fab = cc$rms_fab;
548 xabfhc = cc$rms_xabfhc;
549 fab.fab$l_fna = XSTRING (filename)->data;
550 fab.fab$b_fns = strlen (fab.fab$l_fna);
551 fab.fab$l_xab = (char *) &xabfhc;
552 status = sys$open (&fab, 0, 0);
553 if (status != RMS$_NORMAL) /* Probably non-existent file */
554 return Qnil;
555 sys$close (&fab, 0, 0);
556 if (xabfhc.xab$w_verlimit == 32767)
557 return Qnil; /* No version limit */
558 else
559 return make_number (xabfhc.xab$w_verlimit);
562 #endif /* VMS */
564 Lisp_Object
565 make_time (time)
566 int time;
568 return Fcons (make_number (time >> 16),
569 Fcons (make_number (time & 0177777), Qnil));
572 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
573 "Return a list of attributes of file FILENAME.\n\
574 Value is nil if specified file cannot be opened.\n\
575 Otherwise, list elements are:\n\
576 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
577 1. Number of links to file.\n\
578 2. File uid.\n\
579 3. File gid.\n\
580 4. Last access time, as a list of two integers.\n\
581 First integer has high-order 16 bits of time, second has low 16 bits.\n\
582 5. Last modification time, likewise.\n\
583 6. Last status change time, likewise.\n\
584 7. Size in bytes (-1, if number is out of range).\n\
585 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
586 9. t iff file's gid would change if file were deleted and recreated.\n\
587 10. inode number.\n\
588 11. Device number.\n\
590 If file does not exist, returns nil.")
591 (filename)
592 Lisp_Object filename;
594 Lisp_Object values[12];
595 Lisp_Object dirname;
596 struct stat s;
597 struct stat sdir;
598 char modes[10];
599 Lisp_Object handler;
601 filename = Fexpand_file_name (filename, Qnil);
603 /* If the file name has special constructs in it,
604 call the corresponding file handler. */
605 handler = Ffind_file_name_handler (filename, Qfile_attributes);
606 if (!NILP (handler))
607 return call2 (handler, Qfile_attributes, filename);
609 if (lstat (XSTRING (filename)->data, &s) < 0)
610 return Qnil;
612 #ifdef MSDOS
614 char *tmpnam = XSTRING (Ffile_name_nondirectory (filename))->data;
615 int l = strlen (tmpnam);
617 if (l >= 5
618 && S_ISREG (s.st_mode)
619 && (stricmp (&tmpnam[l - 4], ".com") == 0
620 || stricmp (&tmpnam[l - 4], ".exe") == 0
621 || stricmp (&tmpnam[l - 4], ".bat") == 0))
623 s.st_mode |= S_IEXEC;
626 #endif /* MSDOS */
628 switch (s.st_mode & S_IFMT)
630 default:
631 values[0] = Qnil; break;
632 case S_IFDIR:
633 values[0] = Qt; break;
634 #ifdef S_IFLNK
635 case S_IFLNK:
636 values[0] = Ffile_symlink_p (filename); break;
637 #endif
639 values[1] = make_number (s.st_nlink);
640 values[2] = make_number (s.st_uid);
641 values[3] = make_number (s.st_gid);
642 values[4] = make_time (s.st_atime);
643 values[5] = make_time (s.st_mtime);
644 values[6] = make_time (s.st_ctime);
645 values[7] = make_number ((int) s.st_size);
646 /* If the size is out of range, give back -1. */
647 if (XINT (values[7]) != s.st_size)
648 XSETINT (values[7], -1);
649 filemodestring (&s, modes);
650 values[8] = make_string (modes, 10);
651 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
652 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
653 #endif
654 #ifdef BSD4_2 /* file gid will be dir gid */
655 dirname = Ffile_name_directory (filename);
656 if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0)
657 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
658 else /* if we can't tell, assume worst */
659 values[9] = Qt;
660 #else /* file gid will be egid */
661 #ifdef WINDOWSNT
662 values[9] = Qnil; /* sorry, no group IDs on NT */
663 #else /* not WINDOWSNT */
664 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
665 #endif /* not WINDOWSNT */
666 #endif /* BSD4_2 (or BSD4_3) */
667 #ifdef BSD4_3
668 #undef BSD4_2 /* ok, you can look again without throwing up */
669 #endif
670 #ifdef WINDOWSNT
671 /* Fill in the inode and device values specially...see nt.c. */
672 if (!get_inode_and_device_vals (filename, &values[10], &values[11])) {
673 return Qnil;
675 #else /* not WINDOWSNT */
676 values[10] = make_number (s.st_ino);
677 values[11] = make_number (s.st_dev);
678 #endif /* not WINDOWSNT */
679 return Flist (sizeof(values) / sizeof(values[0]), values);
682 syms_of_dired ()
684 Qdirectory_files = intern ("directory-files");
685 Qfile_name_completion = intern ("file-name-completion");
686 Qfile_name_all_completions = intern ("file-name-all-completions");
687 Qfile_attributes = intern ("file-attributes");
689 defsubr (&Sdirectory_files);
690 defsubr (&Sfile_name_completion);
691 #ifdef VMS
692 defsubr (&Sfile_name_all_versions);
693 defsubr (&Sfile_version_limit);
694 #endif /* VMS */
695 defsubr (&Sfile_name_all_completions);
696 defsubr (&Sfile_attributes);
698 #ifdef VMS
699 Qcompletion_ignore_case = intern ("completion-ignore-case");
700 staticpro (&Qcompletion_ignore_case);
701 #endif /* VMS */
703 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
704 "*Completion ignores filenames ending in any string in this list.\n\
705 This variable does not affect lists of possible completions,\n\
706 but does affect the commands that actually do completions.");
707 Vcompletion_ignored_extensions = Qnil;