]> code.delx.au - gnu-emacs/blobdiff - src/editfns.c
[!SYSTEM_MALLOC] (MEMMOVE_MISSING): Defined.
[gnu-emacs] / src / editfns.c
index e8b2a08c79f8707ee6740129a4d6968a73714191..de8d167191b51a632402931dca0959545576a110 100644 (file)
@@ -20,7 +20,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #include <sys/types.h>
 
-#include "config.h"
+#include <config.h>
 
 #ifdef VMS
 #include "vms-pwd.h"
@@ -197,9 +197,11 @@ static Lisp_Object
 region_limit (beginningp)
      int beginningp;
 {
+  extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */
   register Lisp_Object m;
-  if (!NILP (Vtransient_mark_mode) && NILP (current_buffer->mark_active))
-    error ("There is no region now");
+  if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
+      && NILP (current_buffer->mark_active))
+    Fsignal (Qmark_inactive, Qnil);
   m = Fmarker_position (current_buffer->mark);
   if (NILP (m)) error ("There is no region now");
   if ((point < XFASTINT (m)) == beginningp)
@@ -310,10 +312,15 @@ save_excursion_restore (info)
   Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
   unchain_marker (tem);
   tem = Fcdr (Fcdr (info));
+#if 0 /* We used to make the current buffer visible in the selected window
+        if that was true previously.  That avoids some anomalies.
+        But it creates others, and it wasn't documented, and it is simpler
+        and cleaner never to alter the window/buffer connections.  */
   tem1 = Fcar (tem);
   if (!NILP (tem1)
       && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
     Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
+#endif /* 0 */
 
   tem1 = current_buffer->mark_active;
   current_buffer->mark_active = Fcdr (tem);
@@ -353,7 +360,7 @@ DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0,
 
 DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0,
   "Return the minimum permissible value of point in the current buffer.\n\
-This is 1, unless a clipping restriction is in effect.")
+This is 1, unless narrowing (a buffer restriction) is in effect.")
   ()
 {
   Lisp_Object temp;
@@ -363,7 +370,7 @@ This is 1, unless a clipping restriction is in effect.")
 
 DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
   "Return a marker to the minimum permissible value of point in this buffer.\n\
-This is the beginning, unless a clipping restriction is in effect.")
+This is the beginning, unless narrowing (a buffer restriction) is in effect.")
   ()
 {
   return buildmark (BEGV);
@@ -371,8 +378,8 @@ This is the beginning, unless a clipping restriction is in effect.")
 
 DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
   "Return the maximum permissible value of point in the current buffer.\n\
-This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
-in which case it is less.")
+This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
+is in effect, in which case it is less.")
   ()
 {
   Lisp_Object temp;
@@ -382,8 +389,8 @@ in which case it is less.")
 
 DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
   "Return a marker to the maximum permissible value of point in this buffer.\n\
-This is (1+ (buffer-size)), unless a clipping restriction is in effect,\n\
-in which case it is less.")
+This is (1+ (buffer-size)), unless narrowing (a buffer restriction)\n\
+is in effect, in which case it is less.")
   ()
 {
   return buildmark (ZV);
@@ -712,7 +719,43 @@ Any other markers at the point of insertion remain before the text.")
        }
       else if (XTYPE (tem) == Lisp_String)
        {
-         insert_from_string (tem, 0, XSTRING (tem)->size);
+         insert_from_string (tem, 0, XSTRING (tem)->size, 0);
+       }
+      else
+       {
+         tem = wrong_type_argument (Qchar_or_string_p, tem);
+         goto retry;
+       }
+    }
+
+  return Qnil;
+}
+
+DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit,
+   0, MANY, 0,
+  "Insert the arguments at point, inheriting properties from adjoining text.\n\
+Point moves forward so that it ends up after the inserted text.\n\
+Any other markers at the point of insertion remain before the text.")
+  (nargs, args)
+     int nargs;
+     register Lisp_Object *args;
+{
+  register int argnum;
+  register Lisp_Object tem;
+  char str[1];
+
+  for (argnum = 0; argnum < nargs; argnum++)
+    {
+      tem = args[argnum];
+    retry:
+      if (XTYPE (tem) == Lisp_Int)
+       {
+         str[0] = XINT (tem);
+         insert (str, 1);
+       }
+      else if (XTYPE (tem) == Lisp_String)
+       {
+         insert_from_string (tem, 0, XSTRING (tem)->size, 1);
        }
       else
        {
@@ -747,7 +790,44 @@ Any other markers at the point of insertion also end up after the text.")
        }
       else if (XTYPE (tem) == Lisp_String)
        {
-         insert_from_string_before_markers (tem, 0, XSTRING (tem)->size);
+         insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 0);
+       }
+      else
+       {
+         tem = wrong_type_argument (Qchar_or_string_p, tem);
+         goto retry;
+       }
+    }
+
+  return Qnil;
+}
+
+DEFUN ("insert-before-markers-and-inherit",
+  Finsert_and_inherit_before_markers, Sinsert_and_inherit_before_markers,
+  0, MANY, 0,
+  "Insert text at point, relocating markers and inheriting properties.\n\
+Point moves forward so that it ends up after the inserted text.\n\
+Any other markers at the point of insertion also end up after the text.")
+  (nargs, args)
+     int nargs;
+     register Lisp_Object *args;
+{
+  register int argnum;
+  register Lisp_Object tem;
+  char str[1];
+
+  for (argnum = 0; argnum < nargs; argnum++)
+    {
+      tem = args[argnum];
+    retry:
+      if (XTYPE (tem) == Lisp_Int)
+       {
+         str[0] = XINT (tem);
+         insert_before_markers (str, 1);
+       }
+      else if (XTYPE (tem) == Lisp_String)
+       {
+         insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 1);
        }
       else
        {
@@ -795,7 +875,7 @@ Both arguments are required.")
 
 /* Return a Lisp_String containing the text of the current buffer from
    START to END.  If text properties are in use and the current buffer
-   has properties in the range specifed, the resulting string will also
+   has properties in the range specified, the resulting string will also
    have them.
 
    We don't want to use plain old make_string here, because it calls
@@ -810,7 +890,7 @@ Lisp_Object
 make_buffer_string (start, end)
      int start, end;
 {
-  Lisp_Object result;
+  Lisp_Object result, tem;
 
   if (start < GPT && GPT < end)
     move_gap (start);
@@ -818,8 +898,12 @@ make_buffer_string (start, end)
   result = make_uninit_string (end - start);
   bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);
 
-  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
-  copy_intervals_to_string (result, current_buffer, start, end - start);
+  tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
+
+#ifdef USE_TEXT_PROPERTIES
+  if (XINT (tem) != end)
+    copy_intervals_to_string (result, current_buffer, start, end - start);
+#endif
 
   return result;
 }
@@ -849,7 +933,7 @@ DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
 
 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
   1, 3, 0,
-  "Insert before point a substring of the contents buffer BUFFER.\n\
+  "Insert before point a substring of the contents of buffer BUFFER.\n\
 BUFFER may be a buffer or a buffer name.\n\
 Arguments START and END are character numbers specifying the substring.\n\
 They default to the beginning and the end of BUFFER.")
@@ -911,7 +995,7 @@ They default to the beginning and the end of BUFFER.")
 
   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
   graft_intervals_into_buffer (copy_intervals (bp->intervals, start, len),
-                              opoint, bp);
+                              opoint, len, current_buffer, 0);
 
   return Qnil;
 }
@@ -1047,6 +1131,7 @@ and don't mark the buffer as really changed.")
      Lisp_Object start, end, fromchar, tochar, noundo;
 {
   register int pos, stop, look;
+  int changed = 0;
 
   validate_region (&start, &end);
   CHECK_NUMBER (fromchar, 2);
@@ -1056,7 +1141,6 @@ and don't mark the buffer as really changed.")
   stop = XINT (end);
   look = XINT (fromchar);
 
-  modify_region (current_buffer, pos, stop);
   if (! NILP (noundo))
     {
       if (MODIFF - 1 == current_buffer->save_modified)
@@ -1069,15 +1153,23 @@ and don't mark the buffer as really changed.")
     {
       if (FETCH_CHAR (pos) == look)
        {
+         if (! changed)
+           {
+             modify_region (current_buffer, XINT (start), stop);
+             changed = 1;
+           }
+
          if (NILP (noundo))
            record_change (pos, 1);
          FETCH_CHAR (pos) = XINT (tochar);
-         if (NILP (noundo))
-           signal_after_change (pos, 1, 1);
        }
       pos++;
     }
 
+  if (changed)
+    signal_after_change (XINT (start),
+                        stop - XINT (start), stop - XINT (start));
+
   return Qnil;
 }
 
@@ -1365,7 +1457,7 @@ Use %% to put a single % into the output.")
        else if (XTYPE (args[n]) == Lisp_Int && *format != 's')
          {
 #ifdef LISP_FLOAT_TYPE
-           /* The following loop issumes the Lisp type indicates
+           /* The following loop assumes the Lisp type indicates
               the proper way to pass the argument.
               So make sure we have a flonum if the argument should
               be a double.  */
@@ -1394,29 +1486,34 @@ Use %% to put a single % into the output.")
 
   {
     register int nstrings = n + 1;
+
+    /* Allocate twice as many strings as we have %-escapes; floats occupy
+       two slots, and we're not sure how many of those we have.  */
     register unsigned char **strings
-      = (unsigned char **) alloca (nstrings * sizeof (unsigned char *));
+      = (unsigned char **) alloca (2 * nstrings * sizeof (unsigned char *));
+    int i;
 
+    i = 0;
     for (n = 0; n < nstrings; n++)
       {
        if (n >= nargs)
-         strings[n] = (unsigned char *) "";
+         strings[i++] = (unsigned char *) "";
        else if (XTYPE (args[n]) == Lisp_Int)
          /* We checked above that the corresponding format effector
             isn't %s, which would cause MPV.  */
-         strings[n] = (unsigned char *) XINT (args[n]);
+         strings[i++] = (unsigned char *) XINT (args[n]);
 #ifdef LISP_FLOAT_TYPE
        else if (XTYPE (args[n]) == Lisp_Float)
          {
            union { double d; int half[2]; } u;
 
            u.d = XFLOAT (args[n])->data;
-           strings[n++] = (unsigned char *) u.half[0];
-           strings[n] = (unsigned char *) u.half[1];
+           strings[i++] = (unsigned char *) u.half[0];
+           strings[i++] = (unsigned char *) u.half[1];
          }
 #endif
        else
-         strings[n] = XSTRING (args[n])->data;
+         strings[i++] = XSTRING (args[n])->data;
       }
 
     /* Format it in bigger and bigger buf's until it all fits. */
@@ -1425,7 +1522,7 @@ Use %% to put a single % into the output.")
        buf = (char *) alloca (total + 1);
        buf[total - 1] = 0;
 
-       length = doprnt (buf, total + 1, strings[0], end, nargs, strings + 1);
+       length = doprnt (buf, total + 1, strings[0], end, i-1, strings + 1);
        if (buf[total - 1] == 0)
          break;
 
@@ -1485,17 +1582,10 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer.")
 void
 syms_of_editfns ()
 {
-  DEFVAR_LISP ("system-name", &Vsystem_name,
-              "The name of the machine Emacs is running on.");
-  
-  DEFVAR_LISP ("user-full-name", &Vuser_full_name,
-              "The full name of the user logged in.");
-
-  DEFVAR_LISP ("user-name", &Vuser_name,
-              "The user's name, based on the effective uid.");
-
-  DEFVAR_LISP ("user-real-name", &Vuser_real_name,
-              "The user's name, base upon the real uid.");
+  staticpro (&Vuser_name);
+  staticpro (&Vuser_full_name);
+  staticpro (&Vuser_real_name);
+  staticpro (&Vsystem_name);
 
   defsubr (&Schar_equal);
   defsubr (&Sgoto_char);
@@ -1528,6 +1618,8 @@ syms_of_editfns ()
   defsubr (&Schar_after);
   defsubr (&Sinsert);
   defsubr (&Sinsert_before_markers);
+  defsubr (&Sinsert_and_inherit);
+  defsubr (&Sinsert_and_inherit_before_markers);
   defsubr (&Sinsert_char);
 
   defsubr (&Suser_login_name);