# HG changeset patch # User Richard M. Stallman # Date 750202248 0 # Node ID 8800a7377ceb963fb393b212e9bf20629b86eca7 # Parent 0be7300b18d90820a24c5904e68d3d1c2597318e (Vafter_insert_file_functions): New variable. (Vwrite_region_annotate_functions): New variable. (Qcar_less_than_car): New variable. (Fcar_less_than_car): New function. (syms_of_fileio): Make Lisp variables and function available. staticpro Qcar_less_than_car. (a_write, build_annotations): New functions. (Fwrite_region): Call them. (Finsert_file_contents): Run the Vafter_insert_file_functions. diff -r 0be7300b18d9 -r 8800a7377ceb src/fileio.c --- a/src/fileio.c Sat Oct 09 20:03:33 1993 +0000 +++ b/src/fileio.c Sat Oct 09 21:30:48 1993 +0000 @@ -100,6 +100,12 @@ whose I/O is done with a special handler. */ Lisp_Object Vfile_name_handler_alist; +/* Functions to be called to process text properties in inserted file. */ +Lisp_Object Vafter_insert_file_functions; + +/* Functions to be called to create text property annotations for file. */ +Lisp_Object Vwrite_region_annotate_functions; + /* Nonzero means, when reading a filename in the minibuffer, start out by inserting the default directory into the minibuffer. */ int insert_default_directory; @@ -112,6 +118,8 @@ Lisp_Object Qfile_name_history; +Lisp_Object Qcar_less_than_car; + report_file_error (string, data) char *string; Lisp_Object data; @@ -2353,13 +2361,15 @@ register int inserted = 0; register int how_much; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1; - Lisp_Object handler, val; + struct gcpro gcpro1, gcpro2; + Lisp_Object handler, val, insval; + Lisp_Object p; int total; val = Qnil; - - GCPRO1 (filename); + p = Qnil; + + GCPRO2 (filename, p); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only(); @@ -2523,6 +2533,22 @@ signal_after_change (point, 0, inserted); + if (inserted > 0) + { + p = Vafter_insert_file_functions; + while (!NILP (p)) + { + insval = call1 (Fcar (p), make_number (inserted)); + if (!NILP (insval)) + { + CHECK_NUMBER (insval, 0); + inserted = XFASTINT (insval); + } + QUIT; + p = Fcdr (p); + } + } + if (!NILP (val)) RETURN_UNGCPRO (val); RETURN_UNGCPRO (Fcons (filename, @@ -2530,6 +2556,8 @@ Qnil))); } +static Lisp_Object build_annotations (); + DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, "r\nFWrite region to file: ", "Write current region into specified file.\n\ @@ -2555,13 +2583,15 @@ int save_errno; unsigned char *fn; struct stat st; - int tem; + int tem, tem2; int count = specpdl_ptr - specpdl; #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ #endif /* VMS */ Lisp_Object handler; Lisp_Object visit_file; + Lisp_Object annotations; + int visiting, quietly; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Special kludge to simplify auto-saving */ @@ -2579,7 +2609,12 @@ else visit_file = filename; - GCPRO4 (start, filename, visit, visit_file); + visiting = (EQ (visit, Qt) || XTYPE (visit) == Lisp_String); + quietly = !NILP (visit); + + annotations = Qnil; + + GCPRO4 (start, filename, annotations, visit_file); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2594,7 +2629,7 @@ /* Do this before reporting IO error to avoid a "file has changed on disk" warning on next attempt to save. */ - if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) + if (visiting) { current_buffer->modtime = 0; current_buffer->save_modified = MODIFF; @@ -2605,6 +2640,8 @@ return val; } + annotations = build_annotations (start, end); + #ifdef CLASH_DETECTION if (!auto_saving) lock_file (visit_file); @@ -2713,18 +2750,20 @@ if (XTYPE (start) == Lisp_String) { - failure = 0 > e_write (desc, XSTRING (start)->data, - XSTRING (start)->size); + failure = 0 > a_write (desc, XSTRING (start)->data, + XSTRING (start)->size, 0, &annotations); save_errno = errno; } else if (XINT (start) != XINT (end)) { + tem2 = 1; if (XINT (start) < GPT) { register int end1 = XINT (end); tem = XINT (start); - failure = 0 > e_write (desc, &FETCH_CHAR (tem), - min (GPT, end1) - tem); + failure = 0 > a_write (desc, &FETCH_CHAR (tem), + min (GPT, end1) - tem, 1, &annotations); + tem2 += min (GPT, end1) - tem; save_errno = errno; } @@ -2732,7 +2771,15 @@ { tem = XINT (start); tem = max (tem, GPT); - failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem); + failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, + tem2, &annotations); + tem2 += XINT (end) - tem; + save_errno = errno; + } + if (tem2 == 1) + { + /* If file was empty, still need to write the annotations */ + failure = 0 > a_write (desc, "", 0, 1, &annotations); save_errno = errno; } } @@ -2795,19 +2842,19 @@ /* Do this before reporting IO error to avoid a "file has changed on disk" warning on next attempt to save. */ - if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) + if (visiting) current_buffer->modtime = st.st_mtime; if (failure) error ("IO error writing %s: %s", fn, err_str (save_errno)); - if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) + if (visiting) { current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; } - else if (!NILP (visit)) + else if (quietly) return Qnil; if (!auto_saving) @@ -2816,6 +2863,87 @@ return Qnil; } +Lisp_Object merge (); + +DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, + "Return t if (car A) is numerically less than (car B)." + (a, b) + Lisp_Object a, b; +{ + return Flss (Fcar (a), Fcar (b)); +} + +/* Build the complete list of annotations appropriate for writing out + the text between START and END, by calling all the functions in + write-region-annotate-functions and merging the lists they return. */ + +static Lisp_Object +build_annotations (start, end) + Lisp_Object start, end; +{ + Lisp_Object annotations; + Lisp_Object p, res; + struct gcpro gcpro1, gcpro2; + + annotations = Qnil; + p = Vwrite_region_annotate_functions; + GCPRO2 (annotations, p); + while (!NILP (p)) + { + res = call2 (Fcar (p), start, end); + Flength (res); /* Check basic validity of return value */ + annotations = merge (annotations, res, Qcar_less_than_car); + p = Fcdr (p); + } + UNGCPRO; + return annotations; +} + +/* Write to descriptor DESC the LEN characters starting at ADDR, + assuming they start at position POS in the buffer. + Intersperse with them the annotations from *ANNOT + (those which fall within the range of positions POS to POS + LEN), + each at its appropriate position. + + Modify *ANNOT by discarding elements as we output them. + The return value is negative in case of system call failure. */ + +int +a_write (desc, addr, len, pos, annot) + int desc; + register char *addr; + register int len; + int pos; + Lisp_Object *annot; +{ + Lisp_Object tem; + int nextpos; + int lastpos = pos + len; + + while (1) + { + tem = Fcar_safe (Fcar (*annot)); + if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) + nextpos = XFASTINT (tem); + else + return e_write (desc, addr, lastpos - pos); + if (nextpos > pos) + { + if (0 > e_write (desc, addr, nextpos - pos)) + return -1; + addr += nextpos - pos; + pos = nextpos; + } + tem = Fcdr (Fcar (*annot)); + if (STRINGP (tem)) + { + if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) + return -1; + } + *annot = Fcdr (*annot); + } +} + int e_write (desc, addr, len) int desc; @@ -3411,6 +3539,9 @@ Qfile_already_exists = intern("file-already-exists"); staticpro (&Qfile_already_exists); + Qcar_less_than_car = intern ("car-less-than-car"); + staticpro (&Qcar_less_than_car); + Fput (Qfile_error, Qerror_conditions, Fcons (Qfile_error, Fcons (Qerror, Qnil))); Fput (Qfile_error, Qerror_message, @@ -3446,6 +3577,24 @@ for its argument."); Vfile_name_handler_alist = Qnil; + DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, + "A list of functions to be called at the end of `insert-file-contents'. +Each is passed one argument, the number of bytes inserted. It should return +the new byte count, and leave point the same. If `insert-file-contents' is +intercepted by a handler from `file-name-handler-alist', that handler is +responsible for calling the after-insert-file-functions if appropriate."); + Vafter_insert_file_functions = Qnil; + + DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, + "A list of functions to be called at the start of `write-region'. +Each is passed two arguments, START and END as for `write-region'. It should +return a list of pairs (POSITION . STRING) of strings to be effectively +inserted at the specified positions of the file being written (1 means to +insert before the first byte written). The POSITIONs must be sorted into +increasing order. If there are several functions in the list, the several +lists are merged destructively."); + Vwrite_region_annotate_functions = Qnil; + defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory); @@ -3485,6 +3634,7 @@ defsubr (&Sfile_newer_than_file_p); defsubr (&Sinsert_file_contents); defsubr (&Swrite_region); + defsubr (&Scar_less_than_car); defsubr (&Sverify_visited_file_modtime); defsubr (&Sclear_visited_file_modtime); defsubr (&Svisited_file_modtime);