(construct_menu_click, construct_mouse_click):
[bpt/emacs.git] / src / dired.c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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 1, or (at your option)
9 any later version.
10
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.
15
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. */
19
20
21 #include <stdio.h>
22 #include <sys/types.h>
23 #include <sys/stat.h>
24
25 #include <config.h>
26
27 #ifdef VMS
28 #include <string.h>
29 #include <rms.h>
30 #include <rmsdef.h>
31 #endif
32
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.
41
42 Since applying strlen to the name always works, we'll just do that. */
43 #define NAMLEN(p) strlen (p->d_name)
44
45 #ifdef SYSV_SYSTEM_DIR
46
47 #include <dirent.h>
48 #define DIRENTRY struct dirent
49
50 #else /* not SYSV_SYSTEM_DIR */
51
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 */
61
62 #ifndef MSDOS
63 #define DIRENTRY struct direct
64
65 extern DIR *opendir ();
66 extern struct direct *readdir ();
67
68 #endif /* not MSDOS */
69 #endif /* not SYSV_SYSTEM_DIR */
70
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
76
77 #include "lisp.h"
78 #include "buffer.h"
79 #include "commands.h"
80
81 #include "regex.h"
82
83 /* A search buffer, with a fastmap allocated and ready to go. */
84 extern struct re_pattern_buffer searchbuf;
85
86 #define min(a, b) ((a) < (b) ? (a) : (b))
87
88 /* if system does not have symbolic links, it does not have lstat.
89 In that case, use ordinary stat instead. */
90
91 #ifndef S_IFLNK
92 #define lstat stat
93 #endif
94
95 extern int completion_ignore_case;
96 extern Lisp_Object Ffind_file_name_handler ();
97
98 Lisp_Object Vcompletion_ignored_extensions;
99
100 Lisp_Object Qcompletion_ignore_case;
101
102 Lisp_Object Qdirectory_files;
103 Lisp_Object Qfile_name_completion;
104 Lisp_Object Qfile_name_all_completions;
105 Lisp_Object Qfile_attributes;
106 \f
107 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
108 "Return a list of names of files in DIRECTORY.\n\
109 There are three optional arguments:\n\
110 If FULL is non-nil, absolute pathnames of the files are returned.\n\
111 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
112 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
113 NOSORT is useful if you plan to sort the result yourself.")
114 (dirname, full, match, nosort)
115 Lisp_Object dirname, full, match, nosort;
116 {
117 DIR *d;
118 int length;
119 Lisp_Object list, name, dirfilename;
120 Lisp_Object handler;
121
122 /* If the file name has special constructs in it,
123 call the corresponding file handler. */
124 handler = Ffind_file_name_handler (dirname);
125 if (!NILP (handler))
126 {
127 Lisp_Object args[6];
128
129 args[0] = handler;
130 args[1] = Qdirectory_files;
131 args[2] = dirname;
132 args[3] = full;
133 args[4] = match;
134 args[5] = nosort;
135 return Ffuncall (6, args);
136 }
137
138 {
139 struct gcpro gcpro1, gcpro2;
140
141 /* Because of file name handlers, these functions might call
142 Ffuncall, and cause a GC. */
143 GCPRO1 (match);
144 dirname = Fexpand_file_name (dirname, Qnil);
145 UNGCPRO;
146 GCPRO2 (match, dirname);
147 dirfilename = Fdirectory_file_name (dirname);
148 UNGCPRO;
149 }
150
151 if (!NILP (match))
152 {
153 CHECK_STRING (match, 3);
154
155 /* MATCH might be a flawed regular expression. Rather than
156 catching and signalling our own errors, we just call
157 compile_pattern to do the work for us. */
158 #ifdef VMS
159 compile_pattern (match, &searchbuf, 0,
160 buffer_defaults.downcase_table->contents);
161 #else
162 compile_pattern (match, &searchbuf, 0, 0);
163 #endif
164 }
165
166 /* Now searchbuf is the compiled form of MATCH; don't call anything
167 which might compile a new regexp until we're done with the loop! */
168
169 /* Do this opendir after anything which might signal an error; if
170 an error is signalled while the directory stream is open, we
171 have to make sure it gets closed, and setting up an
172 unwind_protect to do so would be a pain. */
173 d = opendir (XSTRING (dirfilename)->data);
174 if (! d)
175 report_file_error ("Opening directory", Fcons (dirname, Qnil));
176
177 list = Qnil;
178 length = XSTRING (dirname)->size;
179
180 /* Loop reading blocks */
181 while (1)
182 {
183 DIRENTRY *dp = readdir (d);
184 int len;
185
186 if (!dp) break;
187 len = NAMLEN (dp);
188 if (DIRENTRY_NONEMPTY (dp))
189 {
190 if (NILP (match)
191 || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
192 {
193 if (!NILP (full))
194 {
195 int index = XSTRING (dirname)->size;
196 int total = len + index;
197 #ifndef VMS
198 if (length == 0
199 || XSTRING (dirname)->data[length - 1] != '/')
200 total++;
201 #endif /* VMS */
202
203 name = make_uninit_string (total);
204 bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
205 index);
206 #ifndef VMS
207 if (length == 0
208 || XSTRING (dirname)->data[length - 1] != '/')
209 XSTRING (name)->data[index++] = '/';
210 #endif /* VMS */
211 bcopy (dp->d_name, XSTRING (name)->data + index, len);
212 }
213 else
214 name = make_string (dp->d_name, len);
215 list = Fcons (name, list);
216 }
217 }
218 }
219 closedir (d);
220 if (!NILP (nosort))
221 return list;
222 return Fsort (Fnreverse (list), Qstring_lessp);
223 }
224 \f
225 Lisp_Object file_name_completion ();
226
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;
236 {
237 Lisp_Object handler;
238 /* Don't waste time trying to complete a null string.
239 Besides, this case happens when user is being asked for
240 a directory name and has supplied one ending in a /.
241 We would not want to add anything in that case
242 even if there are some unique characters in that directory. */
243 if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
244 return file;
245
246 /* If the file name has special constructs in it,
247 call the corresponding file handler. */
248 handler = Ffind_file_name_handler (dirname);
249 if (!NILP (handler))
250 return call3 (handler, Qfile_name_completion, file, dirname);
251
252 return file_name_completion (file, dirname, 0, 0);
253 }
254
255 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
256 Sfile_name_all_completions, 2, 2, 0,
257 "Return a list of all completions of file name FILE in directory DIR.\n\
258 These are all file names in directory DIR which begin with FILE.")
259 (file, dirname)
260 Lisp_Object file, dirname;
261 {
262 Lisp_Object handler;
263
264 /* If the file name has special constructs in it,
265 call the corresponding file handler. */
266 handler = Ffind_file_name_handler (dirname);
267 if (!NILP (handler))
268 return call3 (handler, Qfile_name_all_completions, file, dirname);
269
270 return file_name_completion (file, dirname, 1, 0);
271 }
272
273 Lisp_Object
274 file_name_completion (file, dirname, all_flag, ver_flag)
275 Lisp_Object file, dirname;
276 int all_flag, ver_flag;
277 {
278 DIR *d;
279 DIRENTRY *dp;
280 int bestmatchsize, skip;
281 register int compare, matchsize;
282 unsigned char *p1, *p2;
283 int matchcount = 0;
284 Lisp_Object bestmatch, tem, elt, name;
285 struct stat st;
286 int directoryp;
287 int passcount;
288 int count = specpdl_ptr - specpdl;
289 struct gcpro gcpro1, gcpro2, gcpro3;
290
291 #ifdef VMS
292 extern DIRENTRY * readdirver ();
293
294 DIRENTRY *((* readfunc) ());
295
296 /* Filename completion on VMS ignores case, since VMS filesys does. */
297 specbind (Qcompletion_ignore_case, Qt);
298
299 readfunc = readdir;
300 if (ver_flag)
301 readfunc = readdirver;
302 file = Fupcase (file);
303 #else /* not VMS */
304 CHECK_STRING (file, 0);
305 #endif /* not VMS */
306
307 #ifdef FILE_SYSTEM_CASE
308 file = FILE_SYSTEM_CASE (file);
309 #endif
310 bestmatch = Qnil;
311 GCPRO3 (file, dirname, bestmatch);
312 dirname = Fexpand_file_name (dirname, Qnil);
313
314 /* With passcount = 0, ignore files that end in an ignored extension.
315 If nothing found then try again with passcount = 1, don't ignore them.
316 If looking for all completions, start with passcount = 1,
317 so always take even the ignored ones.
318
319 ** It would not actually be helpful to the user to ignore any possible
320 completions when making a list of them.** */
321
322 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
323 {
324 if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
325 report_file_error ("Opening directory", Fcons (dirname, Qnil));
326
327 /* Loop reading blocks */
328 /* (att3b compiler bug requires do a null comparison this way) */
329 while (1)
330 {
331 DIRENTRY *dp;
332 int len;
333
334 #ifdef VMS
335 dp = (*readfunc) (d);
336 #else
337 dp = readdir (d);
338 #endif
339 if (!dp) break;
340
341 len = NAMLEN (dp);
342
343 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
344 goto quit;
345 if (! DIRENTRY_NONEMPTY (dp)
346 || len < XSTRING (file)->size
347 || 0 <= scmp (dp->d_name, XSTRING (file)->data,
348 XSTRING (file)->size))
349 continue;
350
351 if (file_name_completion_stat (dirname, dp, &st) < 0)
352 continue;
353
354 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
355 tem = Qnil;
356 if (!directoryp)
357 {
358 /* Compare extensions-to-be-ignored against end of this file name */
359 /* if name is not an exact match against specified string */
360 if (!passcount && len > XSTRING (file)->size)
361 /* and exit this for loop if a match is found */
362 for (tem = Vcompletion_ignored_extensions;
363 CONSP (tem); tem = XCONS (tem)->cdr)
364 {
365 elt = XCONS (tem)->car;
366 if (XTYPE (elt) != Lisp_String) continue;
367 skip = len - XSTRING (elt)->size;
368 if (skip < 0) continue;
369
370 if (0 <= scmp (dp->d_name + skip,
371 XSTRING (elt)->data,
372 XSTRING (elt)->size))
373 continue;
374 break;
375 }
376 }
377
378 /* Unless an ignored-extensions match was found,
379 process this name as a completion */
380 if (passcount || !CONSP (tem))
381 {
382 /* Update computation of how much all possible completions match */
383
384 matchcount++;
385
386 if (all_flag || NILP (bestmatch))
387 {
388 /* This is a possible completion */
389 if (directoryp)
390 {
391 /* This completion is a directory; make it end with '/' */
392 name = Ffile_name_as_directory (make_string (dp->d_name, len));
393 }
394 else
395 name = make_string (dp->d_name, len);
396 if (all_flag)
397 {
398 bestmatch = Fcons (name, bestmatch);
399 }
400 else
401 {
402 bestmatch = name;
403 bestmatchsize = XSTRING (name)->size;
404 }
405 }
406 else
407 {
408 compare = min (bestmatchsize, len);
409 p1 = XSTRING (bestmatch)->data;
410 p2 = (unsigned char *) dp->d_name;
411 matchsize = scmp(p1, p2, compare);
412 if (matchsize < 0)
413 matchsize = compare;
414 if (completion_ignore_case)
415 {
416 /* If this is an exact match except for case,
417 use it as the best match rather than one that is not
418 an exact match. This way, we get the case pattern
419 of the actual match. */
420 if ((matchsize == len
421 && matchsize + !!directoryp
422 < XSTRING (bestmatch)->size)
423 ||
424 /* If there is no exact match ignoring case,
425 prefer a match that does not change the case
426 of the input. */
427 (((matchsize == len)
428 ==
429 (matchsize + !!directoryp
430 == XSTRING (bestmatch)->size))
431 /* If there is more than one exact match aside from
432 case, and one of them is exact including case,
433 prefer that one. */
434 && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size)
435 && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size)))
436 {
437 bestmatch = make_string (dp->d_name, len);
438 if (directoryp)
439 bestmatch = Ffile_name_as_directory (bestmatch);
440 }
441 }
442
443 /* If this dirname all matches, see if implicit following
444 slash does too. */
445 if (directoryp
446 && compare == matchsize
447 && bestmatchsize > matchsize
448 && p1[matchsize] == '/')
449 matchsize++;
450 bestmatchsize = matchsize;
451 }
452 }
453 }
454 closedir (d);
455 }
456
457 UNGCPRO;
458 bestmatch = unbind_to (count, bestmatch);
459
460 if (all_flag || NILP (bestmatch))
461 return bestmatch;
462 if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
463 return Qt;
464 return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
465 quit:
466 if (d) closedir (d);
467 Vquit_flag = Qnil;
468 return Fsignal (Qquit, Qnil);
469 }
470
471 file_name_completion_stat (dirname, dp, st_addr)
472 Lisp_Object dirname;
473 DIRENTRY *dp;
474 struct stat *st_addr;
475 {
476 int len = NAMLEN (dp);
477 int pos = XSTRING (dirname)->size;
478 char *fullname = (char *) alloca (len + pos + 2);
479
480 bcopy (XSTRING (dirname)->data, fullname, pos);
481 #ifndef VMS
482 if (fullname[pos - 1] != '/')
483 fullname[pos++] = '/';
484 #endif
485
486 bcopy (dp->d_name, fullname + pos, len);
487 fullname[pos + len] = 0;
488
489 #ifdef S_IFLNK
490 return lstat (fullname, st_addr);
491 #else
492 return stat (fullname, st_addr);
493 #endif
494 }
495 \f
496 #ifdef VMS
497
498 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
499 Sfile_name_all_versions, 2, 2, 0,
500 "Return a list of all versions of file name FILE in directory DIR.")
501 (file, dirname)
502 Lisp_Object file, dirname;
503 {
504 return file_name_completion (file, dirname, 1, 1);
505 }
506
507 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
508 "Return the maximum number of versions allowed for FILE.\n\
509 Returns nil if the file cannot be opened or if there is no version limit.")
510 (filename)
511 Lisp_Object filename;
512 {
513 Lisp_Object retval;
514 struct FAB fab;
515 struct RAB rab;
516 struct XABFHC xabfhc;
517 int status;
518
519 filename = Fexpand_file_name (filename, Qnil);
520 fab = cc$rms_fab;
521 xabfhc = cc$rms_xabfhc;
522 fab.fab$l_fna = XSTRING (filename)->data;
523 fab.fab$b_fns = strlen (fab.fab$l_fna);
524 fab.fab$l_xab = (char *) &xabfhc;
525 status = sys$open (&fab, 0, 0);
526 if (status != RMS$_NORMAL) /* Probably non-existent file */
527 return Qnil;
528 sys$close (&fab, 0, 0);
529 if (xabfhc.xab$w_verlimit == 32767)
530 return Qnil; /* No version limit */
531 else
532 return make_number (xabfhc.xab$w_verlimit);
533 }
534
535 #endif /* VMS */
536 \f
537 Lisp_Object
538 make_time (time)
539 int time;
540 {
541 return Fcons (make_number (time >> 16),
542 Fcons (make_number (time & 0177777), Qnil));
543 }
544
545 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
546 "Return a list of attributes of file FILENAME.\n\
547 Value is nil if specified file cannot be opened.\n\
548 Otherwise, list elements are:\n\
549 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
550 1. Number of links to file.\n\
551 2. File uid.\n\
552 3. File gid.\n\
553 4. Last access time, as a list of two integers.\n\
554 First integer has high-order 16 bits of time, second has low 16 bits.\n\
555 5. Last modification time, likewise.\n\
556 6. Last status change time, likewise.\n\
557 7. Size in bytes (-1, if number is out of range).\n\
558 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
559 9. t iff file's gid would change if file were deleted and recreated.\n\
560 10. inode number.\n\
561 11. Device number.\n\
562 \n\
563 If file does not exist, returns nil.")
564 (filename)
565 Lisp_Object filename;
566 {
567 Lisp_Object values[12];
568 Lisp_Object dirname;
569 struct stat s;
570 struct stat sdir;
571 char modes[10];
572 Lisp_Object handler;
573
574 filename = Fexpand_file_name (filename, Qnil);
575
576 /* If the file name has special constructs in it,
577 call the corresponding file handler. */
578 handler = Ffind_file_name_handler (filename);
579 if (!NILP (handler))
580 return call2 (handler, Qfile_attributes, filename);
581
582 if (lstat (XSTRING (filename)->data, &s) < 0)
583 return Qnil;
584
585 #ifdef MSDOS
586 {
587 char *tmpnam = XSTRING (Ffile_name_nondirectory (filename))->data;
588 int l = strlen (tmpnam);
589
590 if (l >= 5
591 && S_ISREG (s.st_mode)
592 && (stricmp (&tmpnam[l - 4], ".com") == 0
593 || stricmp (&tmpnam[l - 4], ".exe") == 0
594 || stricmp (&tmpnam[l - 4], ".bat") == 0))
595 {
596 s.st_mode |= S_IEXEC;
597 }
598 }
599 #endif /* MSDOS */
600
601 switch (s.st_mode & S_IFMT)
602 {
603 default:
604 values[0] = Qnil; break;
605 case S_IFDIR:
606 values[0] = Qt; break;
607 #ifdef S_IFLNK
608 case S_IFLNK:
609 values[0] = Ffile_symlink_p (filename); break;
610 #endif
611 }
612 values[1] = make_number (s.st_nlink);
613 values[2] = make_number (s.st_uid);
614 values[3] = make_number (s.st_gid);
615 values[4] = make_time (s.st_atime);
616 values[5] = make_time (s.st_mtime);
617 values[6] = make_time (s.st_ctime);
618 values[7] = make_number (s.st_size);
619 /* If the size is out of range, give back -1. */
620 if (XINT (values[7]) != s.st_size)
621 XSETINT (values[7], -1);
622 filemodestring (&s, modes);
623 values[8] = make_string (modes, 10);
624 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
625 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
626 #endif
627 #ifdef BSD4_2 /* file gid will be dir gid */
628 dirname = Ffile_name_directory (filename);
629 if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0)
630 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
631 else /* if we can't tell, assume worst */
632 values[9] = Qt;
633 #else /* file gid will be egid */
634 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
635 #endif /* BSD4_2 (or BSD4_3) */
636 #ifdef BSD4_3
637 #undef BSD4_2 /* ok, you can look again without throwing up */
638 #endif
639 values[10] = make_number (s.st_ino);
640 values[11] = make_number (s.st_dev);
641 return Flist (sizeof(values) / sizeof(values[0]), values);
642 }
643 \f
644 syms_of_dired ()
645 {
646 Qdirectory_files = intern ("directory-files");
647 Qfile_name_completion = intern ("file-name-completion");
648 Qfile_name_all_completions = intern ("file-name-all-completions");
649 Qfile_attributes = intern ("file-attributes");
650
651 defsubr (&Sdirectory_files);
652 defsubr (&Sfile_name_completion);
653 #ifdef VMS
654 defsubr (&Sfile_name_all_versions);
655 defsubr (&Sfile_version_limit);
656 #endif /* VMS */
657 defsubr (&Sfile_name_all_completions);
658 defsubr (&Sfile_attributes);
659
660 #ifdef VMS
661 Qcompletion_ignore_case = intern ("completion-ignore-case");
662 staticpro (&Qcompletion_ignore_case);
663 #endif /* VMS */
664
665 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
666 "*Completion ignores filenames ending in any string in this list.\n\
667 This variable does not affect lists of possible completions,\n\
668 but does affect the commands that actually do completions.");
669 Vcompletion_ignored_extensions = Qnil;
670 }