(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.

1 files changed, 164 insertions, 14 deletions

diff --git a/src/fileio.c b/src/fileio.c
index 347585fc4d2..c2fca1b375b 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -100,6 +100,12 @@ int auto_save_mode_bits;
    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_error, Qfile_already_exists;
 
 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 @@ If VISIT is non-nil, BEG and END must be nil.")
   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;
+  p = Qnil;
 
-  GCPRO1 (filename);
+  GCPRO2 (filename, p);
   if (!NILP (current_buffer->read_only))
     Fbarf_if_buffer_read_only();
 
@@ -2523,6 +2533,22 @@ If VISIT is non-nil, BEG and END must be nil.")
 
   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 @@ If VISIT is non-nil, BEG and END must be nil.")
                                 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 @@ to the file, instead of any buffer contents, and END is ignored.")
   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 @@ to the file, instead of any buffer contents, and END is ignored.")
   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 @@ to the file, instead of any buffer contents, and END is ignored.")
       /* 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 @@ to the file, instead of any buffer contents, and END is ignored.")
       return val;
     }
 
+  annotations = build_annotations (start, end);
+
 #ifdef CLASH_DETECTION
   if (!auto_saving)
     lock_file (visit_file);
@@ -2713,18 +2750,20 @@ to the file, instead of any buffer contents, and END is ignored.")
 
   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 @@ to the file, instead of any buffer contents, and END is ignored.")
         {
           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 @@ to the file, instead of any buffer contents, and END is ignored.")
   /* 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 @@ to the file, instead of any buffer contents, and END is ignored.")
   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 @@ syms_of_fileio ()
   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 @@ The function `find-file-name-handler' checks this list for a handler\n\
 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 @@ for its argument.");
   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);