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