1 /* files.c -- Extendable file handling
2 Copyright (C) 1998 John Harper <john@dcs.warwick.ac.uk>
3 $Id$
4
5 This file is part of Jade.
6
7 Jade is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 Jade is distributed in the hope that it will be useful, but
13 WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with Jade; see the file COPYING. If not, write to
19 the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
20
21 #define _GNU_SOURCE
22
23 #include "repint.h"
24
25 #include <stdio.h>
26 #include <stdarg.h>
27 #include <string.h>
28 #ifdef NEED_MEMORY_H
29 # include <memory.h>
30 #endif
31 #ifdef HAVE_UNISTD_H
32 # include <unistd.h>
33 #endif
34
35 #ifndef DEV_SLASH_NULL
36 # define DEV_SLASH_NULL "/dev/null"
37 #endif
38
39 /* List of operations. If there's a file handler defined for the file
40 being manipulated it will be called to execute the operation.
41
42 (file-name-absolute-p NAME)
43 (expand-file-name NAME)
44 (local-file-name NAME)
45 (canonical-file-name NAME)
46
47 (file-name-nondirectory NAME)
48 (file-name-directory NAME)
49 (file-name-as-directory NAME)
50 (directory-file-name NAME)
51
52 (open-file NAME ACCESS-TYPE)
53 (close-file FILE)
54 (flush-file FILE)
55 (seek-file FILE [OFFSET] [WHENCE])
56
57 [ XXX these are for jade only, must be defined later.. ]
58 (write-buffer-contents FILE-OR-NAME START END)
59 (read-file-contents FILE-OR-NAME)
60 (insert-file-contents FILE-OR-NAME)
61
62 (delete-file NAME)
63 (rename-file OLD-NAME NEW-NAME)
64 (copy-file SOURCE DEST)
65 (copy-file-to-local-fs SOURCE LOCAL-DEST)
66 (copy-file-from-local-fs LOCAL-SOURCE DEST)
67 (make-directory NAME)
68 (delete-directory NAME)
69
70 (file-exists-p NAME)
71 (file-regular-p NAME)
72 (file-readable-p NAME)
73 (file-writable-p NAME)
74 (file-directory-p NAME)
75 (file-symlink-p NAME)
76 (file-owner-p NAME)
77 (file-nlinks NAME)
78 (file-size NAME)
79 (file-modes NAME)
80 (file-modes-as-string NAME)
81 (set-file-modes NAME MODES)
82 (file-modtime NAME)
83 (directory-files NAME)
84 (read-symlink NAME)
85 (make-symlink NAME CONTENTS)
86
87 ACCESS-TYPE is one of `read', `write' or `append'.
88 WHENCE is one off `nil', `start', `end'. */
89
90 DEFSYM(file_handler_alist, "file-handler-alist"); /*
91 ::doc:file-handler-alist::
92 a list of `(REGEXP . HANDLER)'. If REGEXP matches the name of a file
93 being manipulated the function HANDLER is called as (HANDLER OPERATION
94 ARGS...) where ARGS matches how the original function is called.
95 ::end:: */
96
97 DEFSYM(default_directory, "default-directory"); /*
98 ::doc:default-directory::
99 Buffer-local variable absolutely defining the directory to which all files
100 accessed in the buffer are resolved from (unless they're absolute.)
101 ::end:: */
102
103 /* List of all allocated file objects */
104 static rep_file *file_list;
105
106 int rep_file_type;
107
108 DEFSYM(file_name_absolute_p, "file-name-absolute-p");
109 DEFSYM(expand_file_name, "expand-file-name");
110 DEFSYM(local_file_name, "local-file-name");
111 DEFSYM(canonical_file_name, "canonical-file-name");
112 DEFSYM(file_name_nondirectory, "file-name-nondirectory");
113 DEFSYM(file_name_directory, "file-name-directory");
114 DEFSYM(file_name_as_directory, "file-name-as-directory");
115 DEFSYM(directory_file_name, "directory-file-name");
116 DEFSYM(open_file, "open-file");
117 DEFSYM(close_file, "close-file");
118 DEFSYM(flush_file, "flush-file");
119 DEFSYM(seek_file, "seek-file");
120 DEFSYM(delete_file, "delete-file");
121 DEFSYM(rename_file, "rename-file");
122 DEFSYM(make_directory, "make-directory");
123 DEFSYM(delete_directory, "delete-directory");
124 DEFSYM(copy_file, "copy-file");
125 DEFSYM(copy_file_to_local_fs, "copy-file-to-local-fs");
126 DEFSYM(copy_file_from_local_fs, "copy-file-from-local-fs");
127 DEFSYM(file_readable_p, "file-readable-p");
128 DEFSYM(file_writable_p, "file-writable-p");
129 DEFSYM(file_executable_p, "file-executable-p");
130 DEFSYM(file_exists_p, "file-exists-p");
131 DEFSYM(file_regular_p, "file-regular-p");
132 DEFSYM(file_directory_p, "file-directory-p");
133 DEFSYM(file_symlink_p, "file-symlink-p");
134 DEFSYM(file_owner_p, "file-owner-p");
135 DEFSYM(file_gid, "file-gid");
136 DEFSYM(file_uid, "file-uid");
137 DEFSYM(file_nlinks, "file-nlinks");
138 DEFSYM(file_size, "file-size");
139 DEFSYM(file_modes, "file-modes");
140 DEFSYM(set_file_modes, "set-file-modes");
141 DEFSYM(file_modes_as_string, "file-modes-as-string");
142 DEFSYM(file_modtime, "file-modtime");
143 DEFSYM(directory_files, "directory-files");
144 DEFSYM(read_symlink, "read-symlink");
145 DEFSYM(make_symlink, "make-symlink");
146
147 DEFSYM(start, "start");
148 DEFSYM(end, "end");
149
150 DEFSYM(read, "read");
151 DEFSYM(write, "write");
152 DEFSYM(append, "append");
153
154 DEFSYM(fh_env_key, "fh-env-key");
155
156 /* Vector of blocked operations */
157 struct blocked_op *rep_blocked_ops[op_MAX];
158
159 int rep_op_write_buffer_contents = op_write_buffer_contents;
160 int rep_op_read_file_contents = op_read_file_contents;
161 int rep_op_insert_file_contents = op_insert_file_contents;
162
163
164
165 DEFSYM (rep_io_file_handlers, "rep.io.file-handlers");
166
167 static inline repv
get_fh_env(void)168 get_fh_env (void)
169 {
170 repv ret = F_structure_ref (rep_structure, Qfh_env_key);
171 return rep_VOIDP (ret) ? Qt : ret;
172 }
173
174 /* this is duplicated in rep/io/file-handlers.jl */
175 static inline repv
file_handler_ref(repv handler)176 file_handler_ref (repv handler)
177 {
178 repv tem = Fget_structure (Qrep_io_file_handlers);
179 if (tem != Qnil)
180 {
181 tem = F_structure_ref (tem, handler);
182 if (!tem || rep_VOIDP (tem))
183 tem = Qnil;
184 }
185 return tem;
186 }
187
188 repv
rep_signal_file_error(repv cdr)189 rep_signal_file_error(repv cdr)
190 {
191 repv data = Fcons(rep_lookup_errno(), Qnil);
192 if(cdr)
193 {
194 if(rep_CONSP(cdr) || rep_NILP(cdr))
195 rep_CDR(data) = cdr;
196 else
197 rep_CDR(data) = Fcons(cdr, Qnil);
198 }
199 return Fsignal(Qfile_error, data);
200 }
201
202 DEFSTRING(unbound_file, "File is unbound");
203 repv
rep_unbound_file_error(repv file)204 rep_unbound_file_error(repv file)
205 {
206 return rep_signal_file_error(rep_list_2(rep_VAL(&unbound_file), file));
207 }
208
209 /* Note that this function never returns rep_NULL. It preserves the
210 regexp match data throughout. */
211 repv
rep_get_file_handler(repv file_name,int op)212 rep_get_file_handler(repv file_name, int op)
213 {
214 repv list = Fsymbol_value(Qfile_handler_alist, Qt);
215 struct rep_saved_regexp_data matches;
216 if(!list)
217 return Qnil;
218 rep_DECLARE1(file_name, rep_STRINGP);
219 rep_push_regexp_data(&matches);
220 while(rep_CONSP(list) && rep_CONSP(rep_CAR(list)))
221 {
222 repv tem = Fstring_match(rep_CAR(rep_CAR(list)), file_name,
223 Qnil, Qnil);
224 if(tem && !rep_NILP(tem))
225 {
226 /* Check that this operation isn't already active. */
227 struct blocked_op *ptr = rep_blocked_ops[op];
228 repv handler = rep_CDR(rep_CAR(list));
229 while(ptr != 0 && ptr->handler != handler)
230 ptr = ptr->next;
231 if(ptr == 0)
232 {
233 rep_pop_regexp_data();
234 return handler;
235 }
236 }
237 list = rep_CDR(list);
238 rep_TEST_INT;
239 if(rep_INTERRUPTP)
240 break;
241 }
242 rep_pop_regexp_data();
243 return Qnil;
244 }
245
246 /* Call the file handler function HANDLER, for file operation
247 OP/SYM. Pass NARGS arguments to it (each a lisp object). Note that
248 for the duration of the call, all args and HANDLER will be
249 gc-protected, and the the regexp match data is preserved. */
250 repv
rep_call_file_handler(repv handler,int op,repv sym,int nargs,...)251 rep_call_file_handler(repv handler, int op, repv sym, int nargs, ...)
252 {
253 struct blocked_op op_data;
254 struct rep_saved_regexp_data matches;
255 repv arg_list = Qnil;
256 repv *ptr = &arg_list;
257 repv res;
258 int i;
259 va_list args;
260
261 va_start(args, nargs);
262 for(i = 0; i < nargs; i++)
263 {
264 *ptr = Fcons((repv)va_arg(args, repv), Qnil);
265 ptr = &rep_CDR(*ptr);
266 }
267 va_end(args);
268 arg_list = Fcons(sym, arg_list);
269
270 /* before it gets dereferenced */
271 op_data.handler = handler;
272
273 if (rep_SYMBOLP(handler))
274 {
275 repv fh_env = get_fh_env ();
276 if (fh_env == Qt)
277 handler = file_handler_ref (handler);
278 else
279 {
280 repv tem = Fassq (handler, fh_env);
281 if (tem && rep_CONSP(tem))
282 {
283 if (rep_CDR(tem) == Qt)
284 handler = file_handler_ref (handler);
285 else if (rep_FUNARGP(rep_CDR(tem)))
286 handler = rep_CDR(tem);
287 }
288 }
289 }
290
291 if (handler != rep_NULL && !rep_VOIDP (handler))
292 {
293 rep_push_regexp_data(&matches);
294 op_data.next = rep_blocked_ops[op];
295 rep_blocked_ops[op] = &op_data;
296 /* handler and arg_list are automatically protected by rep_funcall */
297 res = rep_funcall(handler, arg_list, rep_FALSE);
298 rep_blocked_ops[op] = op_data.next;
299 rep_pop_regexp_data();
300 }
301 else
302 res = rep_NULL;
303
304 return res;
305 }
306
307 /* *rep_FILEP may be an opened file, or the name of a file. Returns the handler
308 to call, or nil if no handler exists, or rep_NULL if an error occurred.
309 Expands *rep_FILEP to its canonical form, leaving this value in *rep_FILEP. */
310 repv
rep_get_handler_from_file_or_name(repv * filep,int op)311 rep_get_handler_from_file_or_name(repv *filep, int op)
312 {
313 repv file = *filep, handler;
314 if(!rep_FILEP(file) && !rep_STRINGP(file))
315 return rep_signal_arg_error(file, 1);
316 if(rep_FILEP(file))
317 {
318 if(rep_NILP(rep_FILE(file)->name))
319 return rep_unbound_file_error(file);
320 handler = rep_FILE(file)->handler;
321 if(handler == Qt)
322 handler = Qnil;
323 }
324 else
325 {
326 file = Fexpand_file_name(file, Qnil);
327 if(file)
328 {
329 *filep = file;
330 handler = rep_get_file_handler(file, op);
331 }
332 else
333 handler = Qnil;
334 }
335 return handler;
336 }
337
338 /* Expand *FILE-NAME leaving the result in *FILE-NAME, and find
339 its handler for OP. Return the handler or nil. */
340 repv
rep_expand_and_get_handler(repv * file_namep,int op)341 rep_expand_and_get_handler(repv *file_namep, int op)
342 {
343 repv file_name = *file_namep, handler;
344 rep_DECLARE1(file_name, rep_STRINGP);
345 file_name = Fexpand_file_name(file_name, Qnil);
346 if(!file_name)
347 return rep_NULL;
348 handler = rep_get_file_handler(file_name, op);
349 *file_namep = file_name;
350 return handler;
351 }
352
353 /* Similar to above, but also tries to make file name local to the
354 underlying fs if at all possible. */
355 repv
rep_localise_and_get_handler(repv * file_namep,int op)356 rep_localise_and_get_handler(repv *file_namep, int op)
357 {
358 repv file_name = *file_namep, handler;
359 rep_DECLARE1(file_name, rep_STRINGP);
360 file_name = Flocal_file_name(file_name);
361 if(!file_name)
362 return rep_NULL;
363 if(rep_NILP(file_name))
364 {
365 file_name = Fexpand_file_name(*file_namep, Qnil);
366 if(!file_name)
367 return rep_NULL;
368 }
369 handler = rep_get_file_handler(file_name, op);
370 *file_namep = file_name;
371 return handler;
372 }
373
374
375 /* File name handling */
376
377 DEFUN("file-name-absolute-p", Ffile_name_absolute_p,
378 Sfile_name_absolute_p, (repv file), rep_Subr1) /*
379 ::doc:rep.io.files#file-name-absolute-p::
380 file-name-absolute-p FILE-NAME
381
382 Returns t if FILE-NAME is context-independent, i.e. it does not name a file
383 relative to the default-directory.
384 ::end:: */
385 {
386 repv handler;
387 rep_DECLARE1(file, rep_STRINGP);
388 handler = rep_get_file_handler(file, op_file_name_absolute_p);
389 if(rep_NILP(handler))
390 return rep_file_name_absolute_p(file);
391 else
392 return rep_call_file_handler(handler, op_file_name_absolute_p,
393 Qfile_name_absolute_p, 1, file);
394 }
395
396 DEFUN("expand-file-name", Fexpand_file_name, Sexpand_file_name,
397 (repv file_name, repv dir_name), rep_Subr2) /*
398 ::doc:rep.io.files#expand-file-name::
399 expand-file-name FILE-NAME [BASE-DIR]
400
401 Expands FILE-NAME assuming that it specifies a file relative to BASE-DIR.
402 If BASE-DIR is undefined it is taken as the current value of the
403 `default-directory' variable. While expanding the file name, any obvious
404 simplifications will be performed (e.g. on Unix the removal of "." and
405 ".." where possible).
406
407 Note that the returned file name will only be absolute if one of the
408 following conditions is met:
409 1. BASE-DIR (or `default-directory') is absolute
410 2. FILE-NAME is already absolute.
411
412 Note for file handler implementors: when a handler is called for the
413 `expand-file-name' operation, it will only ever receive one argument,
414 the already expanded file name. The only action that may be need to
415 be taken is to simplify the file name (e.g. removing "." and ".." entries
416 or whatever).
417 ::end:: */
418 {
419 repv abs, handler;
420 rep_GC_root gc_file_name, gc_dir_name;
421
422 rep_DECLARE1(file_name, rep_STRINGP);
423
424 rep_PUSHGC(gc_file_name, file_name);
425 rep_PUSHGC(gc_dir_name, dir_name);
426 abs = Ffile_name_absolute_p(file_name);
427 if(!abs)
428 {
429 rep_POPGC; rep_POPGC;
430 return rep_NULL;
431 }
432 else if(rep_NILP(abs))
433 {
434 /* Not absolute, tack on DIR */
435
436 if(!rep_STRINGP(dir_name))
437 dir_name = Fsymbol_value(Qdefault_directory, Qt);
438 if(rep_VOIDP(dir_name))
439 dir_name = Qnil;
440 dir_name = Ffile_name_as_directory(dir_name);
441 if(dir_name && rep_STRINGP(dir_name) && rep_STRING_LEN(dir_name) > 0)
442 file_name = rep_concat2(rep_STR(dir_name), rep_STR(file_name));
443 }
444 rep_POPGC; rep_POPGC;
445 if(!file_name)
446 return rep_NULL;
447
448 /* Now simplify FILE-NAME. */
449
450 handler = rep_get_file_handler(file_name, op_expand_file_name);
451 if(rep_NILP(handler))
452 return rep_expand_file_name(file_name);
453 else
454 return rep_call_file_handler(handler, op_expand_file_name,
455 Qexpand_file_name, 1, file_name);
456 }
457
458 DEFUN("local-file-name", Flocal_file_name, Slocal_file_name,
459 (repv file), rep_Subr1) /*
460 ::doc:rep.io.files#local-file-name::
461 local-file-name FILE-NAME
462
463 When possible, return a string absolutely naming the file in the local
464 file system that FILE-NAME refers to. If FILE-NAME does not refer to
465 a file in the local system, return nil.
466 ::end:: */
467 {
468 repv handler = rep_expand_and_get_handler(&file, op_local_file_name);
469 if(!handler)
470 return rep_NULL;
471 if(rep_NILP(handler))
472 /* Assume that it's already a local file. */
473 return file;
474 else
475 return rep_call_file_handler(handler, op_local_file_name,
476 Qlocal_file_name, 1, file);
477 }
478
479 DEFUN("canonical-file-name", Fcanonical_file_name, Scanonical_file_name,
480 (repv file), rep_Subr1) /*
481 ::doc:rep.io.files#canonical-file-name::
482 canonical-file-name FILE-NAME
483
484 Return the canonical name of the file called FILE-NAME. The canonical name
485 of a file is defined such that two files can be compared simply by comparing
486 their canonical names; if the names match, they refer to the same file.
487
488 (Note that the opposite isn't always true, if two canonical names don't
489 match the file could still be the same, for example via links. On most
490 operating systems, symbolic links will be expanded where possible.)
491 ::end:: */
492 {
493 repv handler = rep_expand_and_get_handler(&file, op_canonical_file_name);
494 if(!handler)
495 return rep_NULL;
496 if(rep_NILP(handler))
497 return rep_canonical_file_name(file);
498 else
499 return rep_call_file_handler(handler, op_canonical_file_name,
500 Qcanonical_file_name, 1, file);
501 }
502
503 DEFUN("file-name-nondirectory", Ffile_name_nondirectory,
504 Sfile_name_nondirectory, (repv file), rep_Subr1) /*
505 ::doc:rep.io.files#file-name-nondirectory::
506 file-name-nondirectory FILE-NAME
507
508 Return the directory component of FILE-NAME, including the final
509 directory separator.
510 ::end:: */
511 {
512 repv handler;
513 rep_DECLARE1(file, rep_STRINGP);
514 handler = rep_get_file_handler(file, op_file_name_nondirectory);
515 if(rep_NILP(handler))
516 return rep_file_name_nondirectory(file);
517 else
518 return rep_call_file_handler(handler, op_file_name_nondirectory,
519 Qfile_name_nondirectory, 1, file);
520 }
521
522 DEFUN("file-name-directory", Ffile_name_directory,
523 Sfile_name_directory, (repv file), rep_Subr1) /*
524 ::doc:rep.io.files#file-name-directory::
525 file-name-directory FILE-NAME
526
527 Return the file name component of FILE-NAME, i.e. everything following
528 the final directory separator.
529 ::end:: */
530 {
531 repv handler;
532 rep_DECLARE1(file, rep_STRINGP);
533 handler = rep_get_file_handler(file, op_file_name_directory);
534 if(rep_NILP(handler))
535 return rep_file_name_directory(file);
536 else
537 return rep_call_file_handler(handler, op_file_name_directory,
538 Qfile_name_directory, 1, file);
539 }
540
541 DEFUN("file-name-as-directory", Ffile_name_as_directory,
542 Sfile_name_as_directory, (repv file), rep_Subr1) /*
543 ::doc:rep.io.files#file-name-as-directory::
544 file-name-as-directory FILE-NAME
545
546 Return FILE-NAME such that it names a directory (i.e with a terminating
547 directory separator character.)
548 ::end:: */
549 {
550 repv handler;
551 rep_DECLARE1(file, rep_STRINGP);
552 handler = rep_get_file_handler(file, op_file_name_as_directory);
553 if(rep_NILP(handler))
554 return rep_file_name_as_directory(file);
555 else
556 return rep_call_file_handler(handler, op_file_name_as_directory,
557 Qfile_name_as_directory, 1, file);
558 }
559
560 DEFUN("directory-file-name", Fdirectory_file_name,
561 Sdirectory_file_name, (repv file), rep_Subr1) /*
562 ::doc:rep.io.files#directory-file-name::
563 directory-file-name DIR-NAME
564
565 Return the name of the file representing the directory called DIR-NAME.
566 This is the opposite of file-name-as-directory, since its effect is to
567 _remove_ any terminating directory separator.
568 ::end:: */
569 {
570 repv handler;
571 rep_DECLARE1(file, rep_STRINGP);
572 handler = rep_get_file_handler(file, op_directory_file_name);
573 if(rep_NILP(handler))
574 return rep_directory_file_name(file);
575 else
576 return rep_call_file_handler(handler, op_directory_file_name,
577 Qdirectory_file_name, 1, file);
578 }
579
580
581 /* input handlers */
582
583 struct input_handler {
584 struct input_handler *next;
585 int fd;
586 repv function;
587 };
588
589 static struct input_handler *input_handlers;
590
591 static void
input_handler_callback(int fd)592 input_handler_callback (int fd)
593 {
594 struct input_handler *x;
595 for (x = input_handlers; x != 0; x = x->next)
596 {
597 if (x->fd == fd)
598 {
599 rep_call_lisp0 (x->function);
600 break;
601 }
602 }
603 }
604
605 DEFUN("set-input-handler", Fset_input_handler, Sset_input_handler,
606 (repv file, repv function), rep_Subr2) /*
607 ::doc:rep.io.files#set-input-handler::
608 set-input-handler LOCAL-FILE FUNCTION
609
610 Arrange for FUNCTION to be called whenever pending input is available
611 on LOCAL-FILE. Note that this makes LOCAL-FILE do non-blocking input.
612 ::end:: */
613 {
614 int fd;
615 rep_DECLARE(1, file, rep_FILEP(file) && rep_LOCAL_FILE_P(file));
616 fd = fileno(rep_FILE(file)->file.fh);
617 if (function != Qnil)
618 {
619 struct input_handler *x;
620 for (x = input_handlers; x != 0; x = x->next)
621 {
622 if (x->fd == fd)
623 {
624 x->function = function;
625 return function;
626 }
627 }
628 x = rep_alloc (sizeof (struct input_handler));
629 x->next = input_handlers;
630 input_handlers = x;
631 x->fd = fd;
632 x->function = function;
633 rep_register_input_fd (fd, input_handler_callback);
634 return function;
635 }
636 else
637 {
638 struct input_handler **p;
639 for (p = &input_handlers; *p != 0; p = &((*p)->next))
640 {
641 if ((*p)->fd == fd)
642 {
643 struct input_handler *x = *p;
644 *p = x->next;
645 rep_deregister_input_fd (fd);
646 rep_free (x);
647 }
648 }
649 return Qnil;
650 }
651 }
652
653 static void
mark_input_handlers(void)654 mark_input_handlers (void)
655 {
656 struct input_handler *x;
657 for (x = input_handlers; x != 0; x = x->next)
658 {
659 rep_MARKVAL(x->function);
660 }
661 }
662
663
664 /* File structures */
665
666 static repv
make_file(void)667 make_file(void)
668 {
669 repv file = rep_VAL(rep_ALLOC_CELL(sizeof(rep_file)));
670 if(file == rep_NULL)
671 return rep_mem_error();
672 rep_data_after_gc += sizeof (rep_file);
673 rep_FILE(file)->car = rep_file_type | rep_LFF_BOGUS_LINE_NUMBER;
674 rep_FILE(file)->name = Qnil;
675 rep_FILE(file)->handler = Qnil;
676 rep_FILE(file)->handler_data = Qnil;
677 rep_FILE(file)->file.stream = Qnil;
678 rep_FILE(file)->next = file_list;
679 file_list = rep_FILE(file);
680 return file;
681 }
682
683 static void
file_sweep(void)684 file_sweep(void)
685 {
686 rep_file *lf = file_list;
687 file_list = NULL;
688 while(lf)
689 {
690 rep_file *nxt = lf->next;
691 if(!rep_GC_CELL_MARKEDP(rep_VAL(lf)))
692 {
693 if(rep_LOCAL_FILE_P(rep_VAL(lf))
694 && !(lf->car & rep_LFF_DONT_CLOSE))
695 {
696 fclose(lf->file.fh);
697 }
698 rep_FREE_CELL(lf);
699 }
700 else
701 {
702 rep_GC_CLR_CELL(rep_VAL(lf));
703 lf->next = file_list;
704 file_list = lf;
705 }
706 lf = nxt;
707 }
708 }
709
710 static void
file_prin(repv strm,repv obj)711 file_prin(repv strm, repv obj)
712 {
713 rep_stream_puts(strm, "#<file ", -1, rep_FALSE);
714 if(rep_FILE(obj)->name != Qnil)
715 {
716 rep_stream_puts(strm, rep_PTR(rep_FILE(obj)->name), -1, rep_TRUE);
717 rep_stream_putc(strm, '>');
718 }
719 else
720 rep_stream_puts(strm, "*unbound*>", -1, rep_FALSE);
721 }
722
723 static void
file_mark(repv val)724 file_mark(repv val)
725 {
726 rep_MARKVAL(rep_FILE(val)->name);
727 rep_MARKVAL(rep_FILE(val)->handler);
728 rep_MARKVAL(rep_FILE(val)->handler_data);
729 if(!rep_LOCAL_FILE_P(val))
730 rep_MARKVAL(rep_FILE(val)->file.stream);
731 }
732
733 DEFUN("filep", Ffilep, Sfilep, (repv arg), rep_Subr1) /*
734 ::doc:rep.io.files#filep::
735 filep ARG
736
737 Returns t if ARG is a file object.
738 ::end:: */
739 {
740 return rep_FILEP(arg) ? Qt : Qnil;
741 }
742
743 DEFUN("file-binding", Ffile_binding, Sfile_binding,
744 (repv file), rep_Subr1) /*
745 ::doc:rep.io.files#file-binding::
746 file-binding FILE
747
748 Returns the name of the logical file that FILE was opened to access, or nil
749 if it has been closed, but is still to be garbage collected.
750 ::end:: */
751 {
752 rep_DECLARE1(file, rep_FILEP);
753 return rep_FILE(file)->name;
754 }
755
756 DEFUN("file-ttyp", Ffile_ttyp, Sfile_ttyp, (repv file), rep_Subr1) /*
757 ::doc:rep.io.files#file-ttyp::
758 file-ttyp FILE
759
760 Returns true if FILE is linked to a tty.
761 ::end:: */
762 {
763 rep_DECLARE1 (file, rep_FILEP);
764 return (rep_LOCAL_FILE_P (file)
765 && isatty (fileno (rep_FILE (file)->file.fh))) ? Qt : Qnil;
766 }
767
768 DEFUN("file-bound-stream", Ffile_bound_stream, Sfile_bound_stream,
769 (repv file), rep_Subr1) /*
770 ::doc:rep.io.files#file-bound-stream::
771 file-bound-stream FILE
772
773 If file object FILE doesn't refer to a local file, return the stream
774 that it's bound to.
775 ::end:: */
776 {
777 rep_DECLARE1(file, rep_FILEP);
778 return !rep_LOCAL_FILE_P(file) ? rep_FILE(file)->file.stream : Qnil;
779 }
780
781 DEFUN("file-handler-data", Ffile_handler_data, Sfile_handler_data,
782 (repv file), rep_Subr1) /*
783 ::doc:rep.io.files#file-handler-data::
784 file-handler-data FILE
785
786 Return the handler-specific data for FILE.
787 ::end:: */
788 {
789 rep_DECLARE1(file, rep_FILEP);
790 return rep_FILE(file)->handler_data;
791 }
792
793 DEFUN("set-file-handler-data", Fset_file_handler_data,
794 Sset_file_handler_data, (repv file, repv data), rep_Subr2) /*
795 ::doc:rep.io.files#set-file-handler-data::
796 set-file-handler-data FILE DATA
797
798 Set the handler-specific data of file object FILE to DATA.
799 ::end:: */
800 {
801 rep_DECLARE1(file, rep_FILEP);
802 rep_FILE(file)->handler_data = data;
803 return data;
804 }
805
806
807 /* Low level file handling Lisp functions */
808
809 DEFUN("open-file", Fopen_file, Sopen_file,
810 (repv file_name, repv access_type), rep_Subr2) /*
811 ::doc:rep.io.files#open-file::
812 open-file FILE-NAME ACCESS-TYPE
813
814 Return a new file object referencing the logical file called FILE-NAME,
815 for ACCESS-TYPE requests. ACCESS-TYPE can be one of the symbols:
816
817 read For input
818 write Truncate or create the file, and open for output
819 append Open for output at the end of the file.
820 ::end:: */
821 {
822 repv handler, file;
823 rep_GC_root gc;
824
825 rep_DECLARE1(file_name, rep_STRINGP);
826 rep_DECLARE2(access_type, rep_SYMBOLP);
827
828 rep_PUSHGC(gc, access_type);
829 file_name = Fexpand_file_name(file_name, Qnil);
830 rep_POPGC;
831 if(!file_name)
832 return file_name;
833
834 handler = rep_get_file_handler(file_name, op_open_file);
835 if(rep_NILP(handler))
836 {
837 file = make_file();
838 if(file != rep_NULL)
839 {
840 rep_FILE(file)->file.fh = fopen(rep_STR(file_name),
841 (access_type == Qwrite ? "w"
842 : (access_type == Qappend ? "a"
843 : "r")));
844 if(rep_FILE(file)->file.fh == 0)
845 return rep_signal_file_error(file_name);
846 rep_FILE(file)->handler = Qt;
847 rep_FILE(file)->handler_data = file_name;
848 if (access_type != Qwrite)
849 {
850 rep_FILE (file)->line_number = 1;
851 rep_FILE (file)->car &= ~rep_LFF_BOGUS_LINE_NUMBER;
852 }
853 }
854 }
855 else
856 file = rep_call_file_handler(handler, op_open_file, Qopen_file,
857 2, file_name, access_type);
858 if(file && rep_FILEP(file))
859 {
860 /* Install the original file name. */
861 rep_FILE(file)->name = file_name;
862 }
863 return file;
864 }
865
866 DEFUN("make-file-from-stream", Fmake_file_from_stream,
867 Smake_file_from_stream,
868 (repv file_name, repv stream, repv handler),
869 rep_Subr3) /*
870 ::doc:rep.io.files#make-file-from-stream::
871 make-file-from-stream FILE-NAME STREAM HANDLER
872
873 Return a new file object that refers to the logical file called FILE-NAME,
874 that is not in the local filing system. All access to the file object
875 will be directed through the stream object STREAM, and the file handler
876 function HANDLER.
877 ::end:: */
878 {
879 repv file;
880 rep_DECLARE1(file_name, rep_STRINGP);
881 file = make_file();
882 if(file != rep_NULL)
883 {
884 rep_FILE(file)->name = file_name;
885 rep_FILE(file)->handler = handler;
886 rep_FILE(file)->file.stream = stream;
887 }
888 return file;
889 }
890
891 DEFUN("close-file", Fclose_file, Sclose_file, (repv file), rep_Subr1) /*
892 ::doc:rep.io.files#close-file::
893 close-file FILE
894
895 Signal that there will be no more I/O through the file object FILE.
896 ::end:: */
897 {
898 rep_DECLARE1(file, rep_FILEP);
899 if(rep_NILP(rep_FILE(file)->name))
900 return rep_unbound_file_error(file);
901 if(rep_LOCAL_FILE_P(file))
902 {
903 Fset_input_handler (file, Qnil);
904 if (!(rep_FILE(file)->car & rep_LFF_DONT_CLOSE))
905 fclose(rep_FILE(file)->file.fh);
906 else
907 {
908 /* One of stdin, stdout, stderr. freopen onto /dev/null */
909 char *mode;
910 if (rep_FILE(file)->file.fh == stdin)
911 mode = "r";
912 else
913 mode = "w";
914 freopen (DEV_SLASH_NULL, mode, rep_FILE(file)->file.fh);
915 return Qt;
916 }
917 }
918 else
919 rep_call_file_handler(rep_FILE(file)->handler, op_close_file,
920 Qclose_file, 1, file);
921 rep_FILE(file)->name = Qnil;
922 rep_FILE(file)->handler = Qnil;
923 rep_FILE(file)->file.stream = Qnil;
924 return Qt;
925 }
926
927 DEFUN("flush-file", Fflush_file, Sflush_file,
928 (repv file), rep_Subr1) /*
929 ::doc:rep.io.files#flush-file::
930 flush-file FILE
931
932 Flush any buffered output on FILE. This is usually unnecessary since
933 all output will be flushed when FILE is eventually closed.
934 ::end:: */
935 {
936 rep_DECLARE1(file, rep_FILEP);
937 if(rep_NILP(rep_FILE(file)->name))
938 return rep_unbound_file_error(file);
939 if(rep_LOCAL_FILE_P(file))
940 fflush(rep_FILE(file)->file.fh);
941 else
942 rep_call_file_handler(rep_FILE(file)->handler, op_flush_file,
943 Qflush_file, 1, file);
944 return file;
945 }
946
947 DEFUN("seek-file", Fseek_file, Sseek_file,
948 (repv file, repv offset, repv where), rep_Subr3) /*
949 ::doc:rep.io.files#seek-file::
950 seek-file FILE [OFFSET] [WHERE-FROM]
951
952 Called as (seek-file FILE), returns the distance in bytes from the start
953 of the file that the next character would be read from.
954
955 Called as (seek-file FILE OFFSET [WHERE]) alters the position from which the
956 next byte will be read. WHERE can be one of,
957
958 nil OFFSET bytes after the current position
959 start OFFSET bytes after the beginning of the file
960 end OFFSET bytes before the end of the file.
961
962 Note that not all files may be seekable; if (seek-file FILE) returns
963 nil (i.e. the current position is unknown) any attempts to set the
964 current position will also fail.
965 ::end:: */
966 {
967 rep_DECLARE1(file, rep_FILEP);
968 rep_DECLARE2_OPT(offset, rep_INTP);
969 if(!rep_FILE(file)->name)
970 return rep_unbound_file_error(file);
971 if(rep_LOCAL_FILE_P(file))
972 {
973 if(offset == Qnil)
974 return rep_make_long_int (ftell(rep_FILE(file)->file.fh));
975 else
976 {
977 int whence = SEEK_CUR;
978 if(where == Qstart)
979 whence = SEEK_SET;
980 else if(where == Qend)
981 whence = SEEK_END;
982
983 if (whence == SEEK_SET && offset == rep_MAKE_INT (0))
984 {
985 rep_FILE (file)->line_number = 1;
986 rep_FILE (file)->car &= ~rep_LFF_BOGUS_LINE_NUMBER;
987 }
988 else
989 rep_FILE (file)->car |= rep_LFF_BOGUS_LINE_NUMBER;
990
991 if(fseek(rep_FILE(file)->file.fh,
992 rep_get_long_int(offset), whence) != 0)
993 {
994 if (rep_FILE (file)->car & rep_LFF_SILENT_ERRORS)
995 return Qnil;
996 else
997 return rep_signal_file_error(rep_LIST_1(file));
998 }
999 else
1000 return Qt;
1001 }
1002 }
1003 else
1004 return rep_call_file_handler(rep_FILE(file)->handler, op_seek_file,
1005 Qseek_file, 3, file, offset, where);
1006 }
1007
1008 DEFUN("set-file-ignore-errors", Fset_file_ignore_errors,
1009 Sset_file_ignore_errors, (repv file, repv status), rep_Subr2)
1010 {
1011 rep_DECLARE1 (file, rep_FILEP);
1012 rep_FILE (file)->car &= ~rep_LFF_SILENT_ERRORS;
1013 rep_FILE (file)->car |= (status == Qnil) ? 0 : rep_LFF_SILENT_ERRORS;
1014 return rep_undefined_value;
1015 }
1016
1017
1018 /* General file operations */
1019
1020 DEFUN_INT("delete-file", Fdelete_file, Sdelete_file, (repv file_name),
1021 rep_Subr1, "fFile to delete:") /*
1022 ::doc:rep.io.files#delete-file::
1023 delete-file FILE-NAME
1024
1025 Delete the file called FILE-NAME.
1026 ::end:: */
1027 {
1028 repv handler = rep_expand_and_get_handler(&file_name, op_delete_file);
1029 if(!handler)
1030 return handler;
1031 if(rep_NILP(handler))
1032 return rep_delete_file(file_name);
1033 else
1034 return rep_call_file_handler(handler, op_delete_file,
1035 Qdelete_file, 1, file_name);
1036 }
1037
1038 DEFSTRING(cant_rename, "Can't rename files across handlers");
1039 DEFUN_INT("rename-file", Frename_file, Srename_file,
1040 (repv old, repv new), rep_Subr2,
1041 "fOld name of file:" rep_DS_NL "FNew name of file:") /*
1042 ::doc:rep.io.files#rename-file::
1043 rename-file OLD-NAME NEW-NAME
1044
1045 Rename the file called OLD-NAME so that it is called NEW-NAME. Note that
1046 this almost certainly won't work across filing systems.
1047 ::end:: */
1048 {
1049 repv old_handler, new_handler;
1050 rep_GC_root gc_old, gc_new;
1051
1052 rep_PUSHGC(gc_old, old);
1053 rep_PUSHGC(gc_new, new);
1054 old_handler = rep_localise_and_get_handler(&old, op_rename_file);
1055 new_handler = rep_localise_and_get_handler(&new, op_rename_file);
1056 rep_POPGC; rep_POPGC;
1057 if(!old_handler || !new_handler)
1058 return rep_NULL;
1059
1060 if(old_handler == new_handler)
1061 {
1062 if(rep_NILP(old_handler))
1063 /* Both names on local fs. */
1064 return rep_rename_file(old, new);
1065 else
1066 return rep_call_file_handler(old_handler, op_rename_file,
1067 Qrename_file, 2, old, new);
1068 }
1069 else
1070 /* TODO: use copy ops to make this work. */
1071 return Fsignal(Qfile_error, rep_LIST_1(rep_VAL(&cant_rename)));
1072 }
1073
1074 DEFUN_INT("make-directory", Fmake_directory, Smake_directory,
1075 (repv dir_name), rep_Subr1,
1076 "DDirectory to create:") /*
1077 ::doc:rep.io.files#make-directory::
1078 make-directory DIRECTORY-NAME
1079
1080 Create a directory called DIRECTORY-NAME.
1081 ::end:: */
1082 {
1083 repv handler = rep_expand_and_get_handler(&dir_name, op_make_directory);
1084 if(!handler)
1085 return handler;
1086 if(rep_NILP(handler))
1087 return rep_make_directory(dir_name);
1088 else
1089 return rep_call_file_handler(handler, op_make_directory,
1090 Qmake_directory, 1, dir_name);
1091 }
1092
1093 DEFUN_INT("delete-directory", Fdelete_directory, Sdelete_directory,
1094 (repv dir_name), rep_Subr1,
1095 "DDirectory to delete:") /*
1096 ::doc:rep.io.files#delete-directory::
1097 delete-directory DIRECTORY-NAME
1098
1099 Delete the directory called DIRECTORY-NAME. Note that the directory in
1100 question should be empty.
1101 ::end:: */
1102 {
1103 repv handler = rep_expand_and_get_handler(&dir_name, op_delete_directory);
1104 if(!handler)
1105 return handler;
1106 if(rep_NILP(handler))
1107 return rep_delete_directory(dir_name);
1108 else
1109 return rep_call_file_handler(handler, op_delete_directory,
1110 Qdelete_directory, 1, dir_name);
1111 }
1112
1113 DEFUN_INT("copy-file", Fcopy_file, Scopy_file, (repv src, repv dst),
1114 rep_Subr2, "fSource file:" rep_DS_NL "FDestination file:") /*
1115 ::doc:rep.io.files#copy-file::
1116 copy-file SOURCE DESTINATION
1117
1118 Create a new copy of the file called SOURCE, as the file called DESTINATION.
1119 ::end:: */
1120 {
1121 repv src_handler, dst_handler, res;
1122 rep_GC_root gc_src, gc_dst;
1123
1124 rep_PUSHGC(gc_src, src);
1125 rep_PUSHGC(gc_dst, dst);
1126 src_handler = rep_localise_and_get_handler(&src, op_copy_file);
1127 dst_handler = rep_localise_and_get_handler(&dst, op_copy_file);
1128 rep_POPGC; rep_POPGC;
1129 if(!src_handler || !dst_handler)
1130 return rep_NULL;
1131
1132 if(src_handler == dst_handler)
1133 {
1134 if(rep_NILP(src_handler))
1135 /* Both names on local fs. */
1136 res = rep_copy_file(src, dst);
1137 else
1138 res = rep_call_file_handler(src_handler, op_copy_file,
1139 Qcopy_file, 2, src, dst);
1140 }
1141 else if(rep_NILP(src_handler))
1142 {
1143 /* Copying from local to remote */
1144 res = rep_call_file_handler(dst_handler, op_copy_file_from_local_fs,
1145 Qcopy_file_from_local_fs, 2, src, dst);
1146 }
1147 else if(rep_NILP(dst_handler))
1148 {
1149 /* Copying from remote to local */
1150 res = rep_call_file_handler(src_handler, op_copy_file_to_local_fs,
1151 Qcopy_file_to_local_fs, 2, src, dst);
1152 }
1153 else
1154 {
1155 /* Copy from remote-1 to remote-2 via local fs. */
1156 repv temp = Fmake_temp_name();
1157 if(temp)
1158 {
1159 res = rep_call_file_handler(src_handler, op_copy_file_to_local_fs,
1160 Qcopy_file_to_local_fs, 2, src, temp);
1161 if(res)
1162 {
1163 res = rep_call_file_handler(dst_handler,
1164 op_copy_file_from_local_fs,
1165 Qcopy_file_from_local_fs,
1166 2, temp, dst);
1167 }
1168 remove(rep_STR(temp));
1169 }
1170 else
1171 res = rep_NULL;
1172 }
1173 return res;
1174 }
1175
1176
1177 /* File attribute operations */
1178
1179 DEFUN("file-readable-p", Ffile_readable_p, Sfile_readable_p,
1180 (repv file), rep_Subr1) /*
1181 ::doc:rep.io.files#file-readable-p::
1182 file-readable-p FILE-NAME
1183
1184 Returns t if the file called FILE-NAME is available for reading from.
1185 ::end:: */
1186 {
1187 repv handler = rep_expand_and_get_handler(&file, op_file_readable_p);
1188 if(!handler)
1189 return handler;
1190 if(rep_NILP(handler))
1191 return rep_file_readable_p(file);
1192 else
1193 return rep_call_file_handler(handler, op_file_readable_p,
1194 Qfile_readable_p, 1, file);
1195 }
1196
1197 DEFUN("file-writable-p", Ffile_writable_p, Sfile_writable_p,
1198 (repv file), rep_Subr1) /*
1199 ::doc:rep.io.files#file-writeable-p::
1200 file-writable-p FILE-NAME
1201
1202 Returns t if the file called FILE-NAME is available for writing to.
1203 ::end:: */
1204 {
1205 repv handler = rep_expand_and_get_handler(&file, op_file_writable_p);
1206 if(!handler)
1207 return handler;
1208 if(rep_NILP(handler))
1209 return rep_file_writable_p(file);
1210 else
1211 return rep_call_file_handler(handler, op_file_writable_p,
1212 Qfile_writable_p, 1, file);
1213 }
1214
1215 DEFUN("file-executable-p", Ffile_executable_p, Sfile_executable_p,
1216 (repv file), rep_Subr1) /*
1217 ::doc:rep.io.files#file-executable-p::
1218 file-executable-p FILE-NAME
1219
1220 Returns t if the file called FILE-NAME is executable.
1221 ::end:: */
1222 {
1223 repv handler = rep_expand_and_get_handler(&file, op_file_executable_p);
1224 if(!handler)
1225 return handler;
1226 if(rep_NILP(handler))
1227 return rep_file_executable_p(file);
1228 else
1229 return rep_call_file_handler(handler, op_file_executable_p,
1230 Qfile_executable_p, 1, file);
1231 }
1232
1233 DEFUN("file-exists-p", Ffile_exists_p, Sfile_exists_p,
1234 (repv file), rep_Subr1) /*
1235 ::doc:rep.io.files#file-exists-p::
1236 file-exists-p FILE-NAME
1237
1238 Returns t if the file called FILE-NAME exists.
1239 ::end:: */
1240 {
1241 repv handler = rep_expand_and_get_handler(&file, op_file_exists_p);
1242 if(!handler)
1243 return handler;
1244 if(rep_NILP(handler))
1245 return rep_file_exists_p(file);
1246 else
1247 return rep_call_file_handler(handler, op_file_exists_p,
1248 Qfile_exists_p, 1, file);
1249 }
1250
1251 DEFUN("file-regular-p", Ffile_regular_p, Sfile_regular_p,
1252 (repv file), rep_Subr1) /*
1253 ::doc:rep.io.files#file-regular-p::
1254 file-regular-p FILE-NAME
1255
1256 Returns t if the file called FILE-NAME is a normal file, ie, not a
1257 directory, device, symbolic link, etc...
1258 ::end:: */
1259 {
1260 repv handler = rep_expand_and_get_handler(&file, op_file_regular_p);
1261 if(!handler)
1262 return handler;
1263 if(rep_NILP(handler))
1264 return rep_file_regular_p(file);
1265 else
1266 return rep_call_file_handler(handler, op_file_regular_p,
1267 Qfile_regular_p, 1, file);
1268 }
1269
1270 DEFUN("file-directory-p", Ffile_directory_p, Sfile_directory_p,
1271 (repv file), rep_Subr1) /*
1272 ::doc:rep.io.files#file-directory-p::
1273 file-directory-p FILE-NAME
1274
1275 Returns t if the file called FILE-NAME is a directory.
1276 ::end:: */
1277 {
1278 repv handler = rep_expand_and_get_handler(&file, op_file_directory_p);
1279 if(!handler)
1280 return handler;
1281 if(rep_NILP(handler))
1282 return rep_file_directory_p(file);
1283 else
1284 return rep_call_file_handler(handler, op_file_directory_p,
1285 Qfile_directory_p, 1, file);
1286 }
1287
1288 DEFUN("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p,
1289 (repv file), rep_Subr1) /*
1290 ::doc:rep.io.files#file-symlink-p::
1291 file-symlink-p FILE-NAME
1292
1293 Returns t if the file called FILE-NAME is a symbolic link to another file.
1294 ::end:: */
1295 {
1296 repv handler = rep_expand_and_get_handler(&file, op_file_symlink_p);
1297 if(!handler)
1298 return handler;
1299 if(rep_NILP(handler))
1300 return rep_file_symlink_p(file);
1301 else
1302 return rep_call_file_handler(handler, op_file_symlink_p,
1303 Qfile_symlink_p, 1, file);
1304 }
1305
1306 DEFUN("file-owner-p", Ffile_owner_p, Sfile_owner_p,
1307 (repv file), rep_Subr1) /*
1308 ::doc:rep.io.files#file-owner-p::
1309 file-owner-p FILE-NAME
1310
1311 Returns t if the ownership (uid & gid) of the file called FILE-NAME is the
1312 same as that of any files written by the editor.
1313 ::end:: */
1314 {
1315 repv handler = rep_expand_and_get_handler(&file, op_file_owner_p);
1316 if(!handler)
1317 return handler;
1318 if(rep_NILP(handler))
1319 return rep_file_owner_p(file);
1320 else
1321 return rep_call_file_handler(handler, op_file_owner_p,
1322 Qfile_owner_p, 1, file);
1323 }
1324
1325 DEFUN("file-gid", Ffile_gid, Sfile_gid,
1326 (repv file), rep_Subr1) /*
1327 ::doc::rep.io.files#file-gid::
1328 file-gid FILE-NAME
1329
1330 Returns the gid of the file called FILE-NAME
1331 ::end:: */
1332 {
1333 repv handler = rep_expand_and_get_handler(&file, op_file_gid);
1334 if (!handler)
1335 return handler;
1336 if(rep_NILP(handler))
1337 return rep_file_gid(file);
1338 else
1339 return rep_call_file_handler(handler, op_file_gid,
1340 Qfile_gid, 1, file);
1341 }
1342
1343 DEFUN("file-uid", Ffile_uid, Sfile_uid,
1344 (repv file), rep_Subr1) /*
1345 ::doc::rep.io.files#file-uid::
1346 file-uid FILE-NAME
1347
1348 Returns the uid of the file called FILE-NAME
1349 ::end:: */
1350 {
1351 repv handler = rep_expand_and_get_handler(&file, op_file_uid);
1352 if (!handler)
1353 return handler;
1354 if (rep_NILP(handler))
1355 return rep_file_uid(file);
1356 else
1357 return rep_call_file_handler(handler, op_file_uid,
1358 Qfile_uid, 1, file);
1359 }
1360
1361 DEFUN("file-nlinks", Ffile_nlinks, Sfile_nlinks,
1362 (repv file), rep_Subr1) /*
1363 ::doc:rep.io.files#file-nlinks::
1364 file-nlinks FILE-NAME
1365
1366 Returns the number of links pointing to the file called FILE-NAME. This will
1367 be one if FILE-NAME has only one name. Doesn't count symbolic links.
1368 ::end:: */
1369 {
1370 repv handler = rep_expand_and_get_handler(&file, op_file_nlinks);
1371 if(!handler)
1372 return handler;
1373 if(rep_NILP(handler))
1374 return rep_file_nlinks(file);
1375 else
1376 return rep_call_file_handler(handler, op_file_nlinks,
1377 Qfile_nlinks, 1, file);
1378 }
1379
1380 DEFUN("file-size", Ffile_size, Sfile_size,
1381 (repv file), rep_Subr1) /*
1382 ::doc:rep.io.files#file-size::
1383 file-size FILE-NAME
1384
1385 Returns the size of the file called FILE-NAME in bytes.
1386 ::end:: */
1387 {
1388 repv handler = rep_expand_and_get_handler(&file, op_file_size);
1389 if(!handler)
1390 return handler;
1391 if(rep_NILP(handler))
1392 return rep_file_size(file);
1393 else
1394 return rep_call_file_handler(handler, op_file_size,
1395 Qfile_size, 1, file);
1396 }
1397
1398 DEFUN("file-modes", Ffile_modes, Sfile_modes,
1399 (repv file), rep_Subr1) /*
1400 ::doc:rep.io.files#file-modes::
1401 file-modes FILE-NAME
1402
1403 Return the access permissions of the file called FILE-NAME. Note that the
1404 format of this object is filing system dependent. It's only portable use
1405 is as an argument to set-file-modes.
1406 ::end:: */
1407 {
1408 repv handler = rep_expand_and_get_handler(&file, op_file_modes);
1409 if(!handler)
1410 return handler;
1411 if(rep_NILP(handler))
1412 return rep_file_modes(file);
1413 else
1414 return rep_call_file_handler(handler, op_file_modes,
1415 Qfile_modes, 1, file);
1416 }
1417
1418 DEFUN("set-file-modes", Fset_file_modes, Sset_file_modes,
1419 (repv file, repv modes), rep_Subr2) /*
1420 ::doc:rep.io.files#set-file-modes::
1421 set-file-modes FILE-NAME MODES
1422
1423 Sets the access permissions of the file called FILE-NAME to MODES. The only
1424 portable way of getting MODES is from the `file-modes' function since it
1425 may change across filing systems.
1426 ::end:: */
1427 {
1428 repv handler = rep_expand_and_get_handler(&file, op_set_file_modes);
1429 if(!handler)
1430 return handler;
1431 if(rep_NILP(handler))
1432 return rep_set_file_modes(file, modes);
1433 else
1434 return rep_call_file_handler(handler, op_set_file_modes,
1435 Qset_file_modes, 2, file, modes);
1436 }
1437
1438 DEFUN("file-modes-as-string", Ffile_modes_as_string,
1439 Sfile_modes_as_string, (repv file), rep_Subr1) /*
1440 ::doc:rep.io.files#file-modes-as-string::
1441 file-modes-as-string FILE-NAME
1442
1443 Returns a ten character string describing the attributes of the file
1444 called FILE-NAME.
1445 ::end:: */
1446 {
1447 repv handler = rep_expand_and_get_handler(&file, op_file_modes_as_string);
1448 if(!handler)
1449 return handler;
1450 if(rep_NILP(handler))
1451 return rep_file_modes_as_string(file);
1452 else
1453 return rep_call_file_handler(handler, op_file_modes_as_string,
1454 Qfile_modes_as_string, 1, file);
1455 }
1456
1457 DEFUN("file-modtime", Ffile_modtime, Sfile_modtime,
1458 (repv file), rep_Subr1) /*
1459 ::doc:rep.io.files#file-modtime::
1460 file-modtime FILE-NAME
1461
1462 Return the time that the file called FILE-NAME was last modified, as a cons
1463 cell storing two integers, the low 24 bits, and the high bits.
1464 ::end:: */
1465 {
1466 repv handler = rep_expand_and_get_handler(&file, op_file_modtime);
1467 if(!handler)
1468 return handler;
1469 if(rep_NILP(handler))
1470 return rep_file_modtime(file);
1471 else
1472 return rep_call_file_handler(handler, op_file_modtime,
1473 Qfile_modtime, 1, file);
1474 }
1475
1476 rep_bool
rep_file_newer_than(repv name1,repv name2)1477 rep_file_newer_than(repv name1, repv name2)
1478 {
1479 rep_bool res = rep_FALSE;
1480 repv time1;
1481 rep_GC_root gc_name1, gc_name2;
1482
1483 rep_PUSHGC(gc_name1, name1);
1484 rep_PUSHGC(gc_name2, name2);
1485 time1 = Ffile_modtime(name1);
1486 if(time1 && !rep_NILP(time1))
1487 {
1488 repv time2;
1489 rep_GC_root gc_time1;
1490
1491 rep_PUSHGC(gc_time1, time1);
1492 time2 = Ffile_modtime(name2);
1493 rep_POPGC;
1494
1495 if(time2 && !rep_NILP(time2))
1496 {
1497 repv foo = Ftime_later_p(time1, time2);
1498 if(foo && !rep_NILP(foo))
1499 res = rep_TRUE;
1500 }
1501 }
1502 rep_POPGC; rep_POPGC;
1503
1504 return res;
1505 }
1506
1507 DEFUN("directory-files", Fdirectory_files, Sdirectory_files,
1508 (repv dir), rep_Subr1) /*
1509 ::doc:rep.io.files#directory-files::
1510 directory-files DIRECTORY
1511
1512 Returns a list of the names of all files in the directory called DIRECTORY.
1513 The list is unsorted.
1514 ::end:: */
1515 {
1516 repv handler = rep_expand_and_get_handler(&dir, op_directory_files);
1517 if(!handler)
1518 return handler;
1519 if(rep_NILP(handler))
1520 return rep_directory_files(dir);
1521 else
1522 return rep_call_file_handler(handler, op_directory_files,
1523 Qdirectory_files, 1, dir);
1524 }
1525
1526 DEFUN("read-symlink", Fread_symlink, Sread_symlink, (repv file), rep_Subr1) /*
1527 ::doc:rep.io.files#read-symlink::
1528 read-symlink FILENAME
1529
1530 Return the string that is the contents of the symbolic link FILENAME. This
1531 string may be relative to the directory containing FILENAME.
1532
1533 Signals an error if FILENAME isn't a symbolic link.
1534 ::end:: */
1535 {
1536 repv handler = rep_expand_and_get_handler(&file, op_read_symlink);
1537 if(!handler)
1538 return handler;
1539 if(rep_NILP(handler))
1540 return rep_read_symlink(file);
1541 else
1542 return rep_call_file_handler(handler, op_read_symlink,
1543 Qread_symlink, 1, file);
1544 }
1545
1546 DEFUN("make-symlink", Fmake_symlink, Smake_symlink,
1547 (repv file, repv contents), rep_Subr2) /*
1548 ::doc:rep.io.files#make-symlink::
1549 make-symlink FILENAME CONTENTS
1550
1551 Create a symbolic link FILENAME pointing to the file called CONTENTS.
1552 CONTENTS may be relative to the directory containing FILENAME.
1553 ::end:: */
1554 {
1555 repv handler = rep_expand_and_get_handler(&file, op_make_symlink);
1556 rep_DECLARE2(contents, rep_STRINGP);
1557 if(!handler)
1558 return handler;
1559 if(rep_NILP(handler))
1560 return rep_make_symlink(file, contents);
1561 else
1562 return rep_call_file_handler(handler, op_make_symlink,
1563 Qmake_symlink, 2, file, contents);
1564 }
1565
1566
1567 /* Utility functions */
1568
1569 repv
rep_file_fdopen(int fd,char * mode)1570 rep_file_fdopen (int fd, char *mode)
1571 {
1572 rep_file *ptr;
1573 for (ptr = file_list; ptr != 0; ptr = ptr->next)
1574 {
1575 if (rep_LOCAL_FILE_P (rep_VAL (ptr)) && fileno (ptr->file.fh) == fd)
1576 return rep_VAL (ptr);
1577 }
1578 ptr = rep_FILE (make_file ());
1579 ptr->handler = Qt;
1580 ptr->file.fh = fdopen (fd, mode);
1581 if (ptr->file.fh == 0)
1582 return rep_NULL;
1583 else
1584 return rep_VAL (ptr);
1585 }
1586
1587 DEFSTRING(stdin_name, "<stdin>");
1588 DEFUN("stdin-file", Fstdin_file, Sstdin_file, (void), rep_Subr0) /*
1589 ::doc:rep.io.files#stdin-file::
1590 stdin-file
1591
1592 Returns the file object representing the editor's standard input.
1593 ::end:: */
1594 {
1595 static repv stdin_file;
1596 if(stdin_file)
1597 return stdin_file;
1598 stdin_file = make_file();
1599 rep_FILE(stdin_file)->name = rep_VAL(&stdin_name);
1600 rep_FILE(stdin_file)->handler = Qt;
1601 rep_FILE(stdin_file)->file.fh = stdin;
1602 rep_FILE(stdin_file)->car |= rep_LFF_DONT_CLOSE;
1603 rep_mark_static(&stdin_file);
1604 return stdin_file;
1605 }
1606
1607 DEFSTRING(stdout_name, "<stdout>");
1608 DEFUN("stdout-file", Fstdout_file, Sstdout_file, (void), rep_Subr0) /*
1609 ::doc:rep.io.files#stdout-file::
1610 stdout-file
1611
1612 Returns the file object representing the editor's standard output.
1613 ::end:: */
1614 {
1615 static repv stdout_file;
1616 if(stdout_file)
1617 return stdout_file;
1618 stdout_file = make_file();
1619 rep_FILE(stdout_file)->name = rep_VAL(&stdout_name);
1620 rep_FILE(stdout_file)->handler = Qt;
1621 rep_FILE(stdout_file)->file.fh = stdout;
1622 rep_FILE(stdout_file)->car |= rep_LFF_DONT_CLOSE;
1623 rep_mark_static(&stdout_file);
1624 return stdout_file;
1625 }
1626
1627 DEFSTRING(stderr_name, "<stderr>");
1628 DEFUN("stderr-file", Fstderr_file, Sstderr_file, (void), rep_Subr0) /*
1629 ::doc:rep.io.files#stderr-file::
1630 stderr-file
1631
1632 Returns the file object representing the editor's standard output.
1633 ::end:: */
1634 {
1635 static repv stderr_file;
1636 if(stderr_file)
1637 return stderr_file;
1638 stderr_file = make_file();
1639 rep_FILE(stderr_file)->name = rep_VAL(&stderr_name);
1640 rep_FILE(stderr_file)->handler = Qt;
1641 rep_FILE(stderr_file)->file.fh = stderr;
1642 rep_FILE(stderr_file)->car |= rep_LFF_DONT_CLOSE;
1643 rep_mark_static(&stderr_file);
1644 return stderr_file;
1645 }
1646
1647 DEFSTRING(no_temp, "Can't create temporary file name");
1648 DEFUN("make-temp-name", Fmake_temp_name, Smake_temp_name, (void), rep_Subr0) /*
1649 ::doc:rep.io.files#make-temp-name::
1650 make-temp-name
1651
1652 Returns the name of a unique file in the local filing system.
1653 ::end:: */
1654 {
1655 char buf[L_tmpnam];
1656 if(tmpnam(buf))
1657 return rep_string_dup(buf);
1658 else
1659 return rep_signal_file_error(rep_VAL(&no_temp));
1660 }
1661
1662 DEFUN("set-file-handler-environment", Fset_file_handler_environment,
1663 Sset_file_handler_environment, (repv env, repv structure), rep_Subr2) /*
1664 ::doc:rep.io.files#set-file-handler-environment::
1665 set-file-handler-environment ENV
1666 ::end:: */
1667 {
1668 return Fstructure_define (structure, Qfh_env_key, env);
1669 }
1670
1671
1672 /* init */
1673
1674 void
rep_files_init(void)1675 rep_files_init(void)
1676 {
1677 repv tem;
1678
1679 Qfh_env_key = Fmake_symbol (rep_VAL (&str_fh_env_key));
1680 rep_mark_static (&Qfh_env_key);
1681
1682 rep_INTERN_SPECIAL(file_handler_alist);
1683 Fset (Qfile_handler_alist, Qnil);
1684
1685 rep_INTERN_SPECIAL(default_directory);
1686 tem = rep_getpwd();
1687 if (tem == rep_NULL)
1688 tem = rep_null_string ();
1689 Fset (Qdefault_directory, tem);
1690
1691 rep_INTERN(file_name_absolute_p);
1692 rep_INTERN(expand_file_name);
1693 rep_INTERN(local_file_name);
1694 rep_INTERN(canonical_file_name);
1695 rep_INTERN(file_name_nondirectory);
1696 rep_INTERN(file_name_directory);
1697 rep_INTERN(file_name_as_directory);
1698 rep_INTERN(directory_file_name);
1699 rep_INTERN(open_file);
1700 rep_INTERN(close_file);
1701 rep_INTERN(flush_file);
1702 rep_INTERN(seek_file);
1703 rep_INTERN(delete_file);
1704 rep_INTERN(rename_file);
1705 rep_INTERN(make_directory);
1706 rep_INTERN(delete_directory);
1707 rep_INTERN(copy_file);
1708 rep_INTERN(copy_file_to_local_fs);
1709 rep_INTERN(copy_file_from_local_fs);
1710 rep_INTERN(file_readable_p);
1711 rep_INTERN(file_writable_p);
1712 rep_INTERN(file_executable_p);
1713 rep_INTERN(file_exists_p);
1714 rep_INTERN(file_regular_p);
1715 rep_INTERN(file_directory_p);
1716 rep_INTERN(file_symlink_p);
1717 rep_INTERN(file_owner_p);
1718 rep_INTERN(file_gid);
1719 rep_INTERN(file_uid);
1720 rep_INTERN(file_nlinks);
1721 rep_INTERN(file_size);
1722 rep_INTERN(file_modes);
1723 rep_INTERN(set_file_modes);
1724 rep_INTERN(file_modes_as_string);
1725 rep_INTERN(file_modtime);
1726 rep_INTERN(directory_files);
1727 rep_INTERN(read_symlink);
1728 rep_INTERN(make_symlink);
1729
1730 rep_INTERN(start); rep_INTERN(end);
1731 rep_INTERN(read); rep_INTERN(write); rep_INTERN(append);
1732
1733 rep_INTERN(rep_io_file_handlers);
1734
1735 tem = rep_push_structure ("rep.io.files");
1736
1737 rep_ADD_SUBR(Sfilep);
1738 rep_ADD_SUBR(Sfile_binding);
1739 rep_ADD_SUBR(Sfile_ttyp);
1740 rep_ADD_SUBR(Sfile_bound_stream);
1741 rep_ADD_SUBR(Sfile_handler_data);
1742 rep_ADD_SUBR(Sset_file_handler_data);
1743
1744 rep_ADD_SUBR(Sfile_name_absolute_p);
1745 rep_ADD_SUBR(Sexpand_file_name);
1746 rep_ADD_SUBR(Slocal_file_name);
1747 rep_ADD_SUBR(Scanonical_file_name);
1748 rep_ADD_SUBR(Sfile_name_nondirectory);
1749 rep_ADD_SUBR(Sfile_name_directory);
1750 rep_ADD_SUBR(Sfile_name_as_directory);
1751 rep_ADD_SUBR(Sdirectory_file_name);
1752
1753 rep_ADD_SUBR(Sset_input_handler);
1754
1755 rep_ADD_SUBR(Sopen_file);
1756 rep_ADD_SUBR(Smake_file_from_stream);
1757 rep_ADD_SUBR(Sclose_file);
1758 rep_ADD_SUBR(Sflush_file);
1759 rep_ADD_SUBR(Sseek_file);
1760 rep_ADD_SUBR(Sset_file_ignore_errors);
1761
1762 rep_ADD_SUBR_INT(Sdelete_file);
1763 rep_ADD_SUBR_INT(Srename_file);
1764 rep_ADD_SUBR_INT(Scopy_file);
1765 rep_ADD_SUBR_INT(Smake_directory);
1766 rep_ADD_SUBR_INT(Sdelete_directory);
1767
1768 rep_ADD_SUBR(Sfile_readable_p);
1769 rep_ADD_SUBR(Sfile_writable_p);
1770 rep_ADD_SUBR(Sfile_executable_p);
1771 rep_ADD_SUBR(Sfile_exists_p);
1772 rep_ADD_SUBR(Sfile_regular_p);
1773 rep_ADD_SUBR(Sfile_directory_p);
1774 rep_ADD_SUBR(Sfile_symlink_p);
1775 rep_ADD_SUBR(Sfile_owner_p);
1776 rep_ADD_SUBR(Sfile_gid);
1777 rep_ADD_SUBR(Sfile_uid);
1778 rep_ADD_SUBR(Sfile_nlinks);
1779 rep_ADD_SUBR(Sfile_size);
1780 rep_ADD_SUBR(Sfile_modes);
1781 rep_ADD_SUBR(Sset_file_modes);
1782 rep_ADD_SUBR(Sfile_modes_as_string);
1783 rep_ADD_SUBR(Sfile_modtime);
1784 rep_ADD_SUBR(Sdirectory_files);
1785 rep_ADD_SUBR(Sread_symlink);
1786 rep_ADD_SUBR(Smake_symlink);
1787
1788 rep_ADD_SUBR(Sstdin_file);
1789 rep_ADD_SUBR(Sstdout_file);
1790 rep_ADD_SUBR(Sstderr_file);
1791 rep_ADD_SUBR(Smake_temp_name);
1792 rep_ADD_SUBR(Sset_file_handler_environment);
1793
1794 rep_pop_structure (tem);
1795
1796 /* Initialise the type information. */
1797 rep_file_type = rep_register_new_type("file", rep_ptr_cmp,
1798 file_prin, file_prin, file_sweep,
1799 file_mark, mark_input_handlers,
1800 0, 0, 0, 0, 0, 0);
1801 }
1802
1803 void
rep_files_kill(void)1804 rep_files_kill(void)
1805 {
1806 rep_file *lf = file_list;
1807 while(lf)
1808 {
1809 rep_file *nxt = lf->next;
1810 if(rep_LOCAL_FILE_P(rep_VAL(lf))
1811 && !(lf->car & rep_LFF_DONT_CLOSE))
1812 {
1813 fclose(lf->file.fh);
1814 }
1815 rep_FREE_CELL(lf);
1816 lf = nxt;
1817 }
1818 file_list = NULL;
1819 }
1820