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