Index: src/ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/src/ChangeLog,v retrieving revision 1.3671 diff -w -U3 -r1.3671 ChangeLog --- src/ChangeLog 10 May 2004 04:15:14 -0000 1.3671 +++ src/ChangeLog 10 May 2004 05:51:30 -0000 @@ -3,6 +3,26 @@ * fns.c (count_combining): Delete it. (concat): Don't check combining bytes. +2004-05-09 John Wiegley + + * lisp.h (enum pvec_type): Added PVEC_FILE_HANDLE type. Added + Lisp_File_Handle structure, and several macros for dealing with + these types. + + * fileio.c: Implemented several new functions: file-handle-p, + file-handle-open, file-handle-close, file-handle-read, + file-handle-write. + (syms_of_fileio): Declare these routines to the lisp interpretor. + + * data.c: Added global Qfile_handle. + (Ftype_of): Check for file handles. + (syms_of_data): Intern the symbol "file-handle". + (syms_of_data): Setup the variable Qfile_handle. + + * alloc.c (enum mem_type): Added MEM_TYPE_FILE_HANDLE. + (allocate_file_handle): New routine for allocating file handle + objects. + 2004-05-09 Jason Rumney * w32fns.c (Vw32_ansi_code_page): New Lisp variable. Index: src/alloc.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/alloc.c,v retrieving revision 1.333 diff -w -U3 -r1.333 alloc.c --- src/alloc.c 26 Apr 2004 21:42:49 -0000 1.333 +++ src/alloc.c 10 May 2004 05:51:35 -0000 @@ -291,6 +291,7 @@ MEM_TYPE_VECTOR, MEM_TYPE_PROCESS, MEM_TYPE_HASH_TABLE, + MEM_TYPE_FILE_HANDLE, MEM_TYPE_FRAME, MEM_TYPE_WINDOW }; @@ -2558,6 +2559,21 @@ v->contents[i] = Qnil; return (struct Lisp_Hash_Table *) v; +} + + +struct Lisp_File_Handle * +allocate_file_handle () +{ + EMACS_INT len = VECSIZE (struct Lisp_File_Handle); + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FILE_HANDLE); + EMACS_INT i; + + for (i = 0; i < len; ++i) + v->contents[i] = Qnil; + v->size = len; + + return (struct Lisp_File_Handle *) v; } Index: src/data.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/data.c,v retrieving revision 1.239 diff -w -U3 -r1.239 data.c --- src/data.c 9 May 2004 00:49:06 -0000 1.239 +++ src/data.c 10 May 2004 05:51:49 -0000 @@ -93,7 +93,7 @@ static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; -static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; +static Lisp_Object Qchar_table, Qbool_vector, Qhash_table, Qfile_handle; static Lisp_Object Qsubrp, Qmany, Qunevalled; static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); @@ -243,6 +243,8 @@ return Qframe; if (GC_HASH_TABLE_P (object)) return Qhash_table; + if (GC_FILE_HANDLEP (object)) + return Qfile_handle; return Qvector; case Lisp_Float: @@ -3227,6 +3229,7 @@ Qchar_table = intern ("char-table"); Qbool_vector = intern ("bool-vector"); Qhash_table = intern ("hash-table"); + Qfile_handle = intern ("file-handle"); staticpro (&Qinteger); staticpro (&Qsymbol); @@ -3246,6 +3249,7 @@ staticpro (&Qchar_table); staticpro (&Qbool_vector); staticpro (&Qhash_table); + staticpro (&Qfile_handle); defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); Index: src/fileio.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/fileio.c,v retrieving revision 1.503 diff -w -U3 -r1.503 fileio.c --- src/fileio.c 4 May 2004 19:23:31 -0000 1.503 +++ src/fileio.c 10 May 2004 05:51:50 -0000 @@ -6365,6 +6365,152 @@ } +DEFUN ("file-handle-p", Ffile_handle_p, Sfile_handle_p, 1, 1, 0, + doc: /* Return t if OBJECT is a direct file handle. */) + (object) + Lisp_Object object; +{ + if (FILE_HANDLEP (object)) + return Qt; + return Qnil; +} + + +DEFUN ("file-handle-open", Ffile_handle_open, Sfile_handle_open, + 2, 2, 0, + doc: /* Open a file handle for direct reading/writing. */) + (path, mode) + Lisp_Object path, mode; +{ + FILE *stream; + Lisp_Object handle, lispstream; + struct Lisp_File_Handle *lh; + + if (! STRINGP (path) || ! STRINGP (mode)) + return Qnil; + + if (! Ffile_exists_p (path)) + return Qnil; + + stream = fopen(SDATA (path), SDATA (mode)); + if (! stream) + return Qnil; + + lh = allocate_file_handle (); + + /* Arrange to close that file whether or not we get an error. + Also reset auto_saving to 0. */ + lispstream = Fcons (Qnil, Qnil); + XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); + XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); + + lh->handle = lispstream; + + XSETFILE_HANDLE (handle, lh); + xassert (FILE_HANDLEP (handle)); + xassert (XFILE_HANDLE (handle) == lh); + + return handle; +} + +DEFUN ("file-handle-close", Ffile_handle_close, Sfile_handle_close, + 1, 1, 0, + doc: /* Close a direct file handle. */) + (handle) + Lisp_Object handle; +{ + FILE *stream; + Lisp_Object lispstream; + struct Lisp_File_Handle *lh; + + if (! FILE_HANDLEP (handle)) + return Qnil; + + lh = XFILE_HANDLE(handle); + + lispstream = lh->handle; + if (! CONSP(lispstream)) + return Qnil; + + stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 | + XFASTINT (XCDR (lispstream))); + lh->handle = Qnil; + if (! stream) + return Qnil; + + fclose(stream); + + return Qt; +} + +DEFUN ("file-handle-read", Ffile_handle_read, Sfile_handle_read, + 2, 2, 0, + doc: /* Close a direct file handle. */) + (handle, length) + Lisp_Object handle, length; +{ + FILE *stream; + Lisp_Object lispstream, data; + struct Lisp_File_Handle *lh; + unsigned char *buf; + int read; + + if (! FILE_HANDLEP (handle)) + return Qnil; + + lh = XFILE_HANDLE(handle); + + lispstream = lh->handle; + if (! CONSP(lispstream)) + return Qnil; + + stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 | + XFASTINT (XCDR (lispstream))); + if (! stream) + return Qnil; + + buf = (unsigned char *) alloca (XFASTINT (length)); + data = make_string (buf, XFASTINT (length)); + read = fread(SDATA (data), 1, XFASTINT (length), stream); + if (read != XFASTINT (length)) + return Fsubstring (data, make_number (0), make_number (read)); + + return data; +} + +DEFUN ("file-handle-write", Ffile_handle_write, Sfile_handle_write, + 2, 2, 0, + doc: /* Close a direct file handle. */) + (handle, data) + Lisp_Object handle, data; +{ + FILE *stream; + Lisp_Object lispstream; + struct Lisp_File_Handle *lh; + int wrote; + + if (! FILE_HANDLEP (handle)) + return Qnil; + + lh = XFILE_HANDLE(handle); + + lispstream = lh->handle; + if (! CONSP(lispstream)) + return Qnil; + + stream = (FILE *) (XFASTINT (XCAR (lispstream)) << 16 | + XFASTINT (XCDR (lispstream))); + if (! stream) + return Qnil; + + wrote = fwrite(SDATA (data), 1, SCHARS (data), stream); + if (wrote != SCHARS (data)) + return Qnil; + + return Qt; +} + + void init_fileio_once () { @@ -6678,6 +6824,12 @@ defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); + + defsubr (&Sfile_handle_p); + defsubr (&Sfile_handle_open); + defsubr (&Sfile_handle_close); + defsubr (&Sfile_handle_read); + defsubr (&Sfile_handle_write); #ifdef unix defsubr (&Sunix_sync); Index: src/lisp.h =================================================================== RCS file: /cvsroot/emacs/emacs/src/lisp.h,v retrieving revision 1.489 diff -w -U3 -r1.489 lisp.h --- src/lisp.h 26 Apr 2004 21:26:17 -0000 1.489 +++ src/lisp.h 10 May 2004 05:51:54 -0000 @@ -267,7 +267,8 @@ PVEC_BOOL_VECTOR = 0x10000, PVEC_BUFFER = 0x20000, PVEC_HASH_TABLE = 0x40000, - PVEC_TYPE_MASK = 0x7fe00 + PVEC_FILE_HANDLE = 0x80000, + PVEC_TYPE_MASK = 0xffe00 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to GDB. It doesn't work on OS Alpha. Moved to a variable in @@ -513,6 +514,16 @@ #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) +struct Lisp_File_Handle + { + EMACS_INT size; + struct Lisp_Vector *v_next; + Lisp_Object handle; +}; + +#define XSETFILE_HANDLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FILE_HANDLE)) +#define XFILE_HANDLE(a) ((struct Lisp_File_Handle *) XPNTR (a)) + /* Convenience macros for dealing with Lisp arrays. */ #define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX] @@ -1421,6 +1432,8 @@ #define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME) +#define FILE_HANDLEP(x) PSEUDOVECTORP (x, PVEC_FILE_HANDLE) +#define GC_FILE_HANDLEP(x) GC_PSEUDOVECTORP (x, PVEC_FILE_HANDLE) #define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top)) @@ -2447,6 +2460,7 @@ extern struct Lisp_Vector *allocate_vector P_ ((EMACS_INT)); extern struct Lisp_Vector *allocate_other_vector P_ ((EMACS_INT)); extern struct Lisp_Hash_Table *allocate_hash_table P_ ((void)); +extern struct Lisp_File_Handle *allocate_file_handle P_ ((void)); extern struct window *allocate_window P_ ((void)); extern struct frame *allocate_frame P_ ((void)); extern struct Lisp_Process *allocate_process P_ ((void)); Index: src/print.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/print.c,v retrieving revision 1.199 diff -w -U3 -r1.199 print.c --- src/print.c 26 Apr 2004 21:56:26 -0000 1.199 +++ src/print.c 10 May 2004 05:51:57 -0000 @@ -1872,6 +1872,10 @@ strout (buf, -1, -1, printcharfun, 0); PRINTCHAR ('>'); } + else if (FILE_HANDLEP (obj)) + { + strout ("#", -1, -1, printcharfun, 0); + } else if (BUFFERP (obj)) { if (NILP (XBUFFER (obj)->name)) Index: lisp/eshell/esh-io.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/eshell/esh-io.el,v retrieving revision 1.8 diff -w -U3 -r1.8 esh-io.el --- lisp/eshell/esh-io.el 1 Sep 2003 15:45:23 -0000 1.8 +++ lisp/eshell/esh-io.el 10 May 2004 05:51:57 -0000 @@ -260,6 +260,10 @@ ;; If we were redirecting to a file, save the file and close the ;; buffer. + ((and (fboundp 'file-handle-p) + (file-handle-p target)) + (file-handle-close target)) + ((markerp target) (let ((buf (marker-buffer target))) (when buf ; somebody's already killed it! @@ -337,6 +341,11 @@ (if (nth 2 redir) (funcall (nth 1 redir) mode) (nth 1 redir)) + (if (fboundp 'file-handle-open) + (cond ((eq mode 'overwrite) + (file-handle-open target "w")) + ((eq mode 'append) + (file-handle-open target "a"))) (let* ((exists (get-file-buffer target)) (buf (find-file-noselect target t))) (with-current-buffer buf @@ -348,7 +357,7 @@ (erase-buffer)) ((eq mode 'append) (goto-char (point-max)))) - (point-marker)))))) + (point-marker))))))) ((or (bufferp target) (and (boundp 'eshell-buffer-shorthand) (symbol-value 'eshell-buffer-shorthand) @@ -461,6 +470,11 @@ "Insert OBJECT into TARGET. Returns what was actually sent, or nil if nothing was sent." (cond + ((and (fboundp 'file-handle-p) + (file-handle-p target)) + (setq object (eshell-stringify object)) + (file-handle-write target object)) + ((functionp target) (funcall target object))