Minor tweaks of copying text properties when padding strings

[gnu-emacs] / src / data.c

diff --git a/src/data.c b/src/data.c
index 80f2ac9f90477664548243901f9971d9784e1f31..71da916ae748c9e317882714811abbe8052deac3 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1,13 +1,13 @@
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.

-   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
+   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software

    Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
    Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.

 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -32,9 +32,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 #include "keyboard.h"
 #include "frame.h"
 #include "buffer.h"
 #include "keyboard.h"
 #include "frame.h"

-#include "syssignal.h"
-#include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p.  */
-#include "font.h"

 #include "keymap.h"
 
 static void swap_in_symval_forwarding (struct Lisp_Symbol *,
 #include "keymap.h"
 
 static void swap_in_symval_forwarding (struct Lisp_Symbol *,


@@ -226,8 +223,13 @@ for example, (type-of 1) returns `integer'.  */)
           return Qfloat;
         case Lisp_Misc_Finalizer:
           return Qfinalizer;
           return Qfloat;
         case Lisp_Misc_Finalizer:
           return Qfinalizer;

+#ifdef HAVE_MODULES
+       case Lisp_Misc_User_Ptr:
+         return Quser_ptr;
+#endif
+       default:
+         emacs_abort ();

        }
        }

-      emacs_abort ();

 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))
 
     case Lisp_Vectorlike:
       if (WINDOW_CONFIGURATIONP (object))


@@ -426,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
   return Qnil;
 }
 
   return Qnil;
 }
 

+#ifdef HAVE_MODULES
+DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0,
+       doc: /* Return t if OBJECT is a module user pointer.  */)
+     (Lisp_Object object)
+{
+  if (USER_PTRP (object))
+    return Qt;
+  return Qnil;
+}
+#endif
+

 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
        doc: /* Return t if OBJECT is a built-in function.  */)
   (Lisp_Object object)
 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
        doc: /* Return t if OBJECT is a built-in function.  */)
   (Lisp_Object object)


@@ -559,7 +572,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);
   (register Lisp_Object cell, Lisp_Object newcar)
 {
   CHECK_CONS (cell);

-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));

   XSETCAR (cell, newcar);
   return newcar;
 }
   XSETCAR (cell, newcar);
   return newcar;
 }


@@ -569,7 +582,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
   (register Lisp_Object cell, Lisp_Object newcdr)
 {
   CHECK_CONS (cell);
   (register Lisp_Object cell, Lisp_Object newcdr)
 {
   CHECK_CONS (cell);

-  CHECK_IMPURE (cell);
+  CHECK_IMPURE (cell, XCONS (cell));

   XSETCDR (cell, newcdr);
   return newcdr;
 }
   XSETCDR (cell, newcdr);
   return newcdr;
 }


@@ -790,7 +803,7 @@ SUBR must be a built-in function.  */)
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
        doc: /* Return the interactive form of CMD or nil if none.
 If CMD is not a command, the return value is nil.
 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
        doc: /* Return the interactive form of CMD or nil if none.
 If CMD is not a command, the return value is nil.

-Value, if non-nil, is a list \(interactive SPEC).  */)
+Value, if non-nil, is a list (interactive SPEC).  */)

   (Lisp_Object cmd)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
   (Lisp_Object cmd)
 {
   Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */


@@ -1242,6 +1255,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
        return;
     }
 
        return;
     }
 

+  maybe_set_redisplay (symbol);

   sym = XSYMBOL (symbol);
 
  start:
   sym = XSYMBOL (symbol);
 
  start:


@@ -1529,10 +1543,8 @@ usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;
   (Lisp_Object args)
 {
   Lisp_Object args_left, symbol, val;

-  struct gcpro gcpro1;

 
   args_left = val = args;
 
   args_left = val = args;

-  GCPRO1 (args);

 
   while (CONSP (args_left))
     {
 
   while (CONSP (args_left))
     {


@@ -1542,7 +1554,6 @@ usage: (setq-default [VAR VALUE]...)  */)
       args_left = Fcdr (XCDR (args_left));
     }
 
       args_left = Fcdr (XCDR (args_left));
     }
 

-  UNGCPRO;

   return val;
 }
 \f
   return val;
 }
 \f


@@ -1603,8 +1614,8 @@ The function `default-value' gets the default value and `set-default' sets it.
 {
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
 {
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;

-  union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
-  bool forwarded IF_LINT (= 0);
+  union Lisp_Val_Fwd valcontents;
+  bool forwarded;

 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);


@@ -1663,7 +1674,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
        doc: /* Make VARIABLE have a separate value in the current buffer.
 Other buffers will continue to share a common default value.
 \(The buffer-local value of VARIABLE starts out as the same value
        doc: /* Make VARIABLE have a separate value in the current buffer.
 Other buffers will continue to share a common default value.
 \(The buffer-local value of VARIABLE starts out as the same value

-VARIABLE previously had.  If VARIABLE was void, it remains void.\)
+VARIABLE previously had.  If VARIABLE was void, it remains void.)

 Return VARIABLE.
 
 If the variable is already arranged to become local when set,
 Return VARIABLE.
 
 If the variable is already arranged to become local when set,


@@ -1671,7 +1682,7 @@ this function causes a local value to exist for this buffer,
 just as setting the variable would do.
 
 This function returns VARIABLE, and therefore
 just as setting the variable would do.
 
 This function returns VARIABLE, and therefore

-  (set (make-local-variable 'VARIABLE) VALUE-EXP)
+  (set (make-local-variable \\='VARIABLE) VALUE-EXP)

 works.
 
 See also `make-variable-buffer-local'.
 works.
 
 See also `make-variable-buffer-local'.


@@ -1681,8 +1692,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   (Lisp_Object variable)
 {
   Lisp_Object tem;
   (Lisp_Object variable)
 {
   Lisp_Object tem;

-  bool forwarded IF_LINT (= 0);
-  union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
+  bool forwarded;
+  union Lisp_Val_Fwd valcontents;

   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
 
   struct Lisp_Symbol *sym;
   struct Lisp_Buffer_Local_Value *blv = NULL;
 


@@ -2217,10 +2228,10 @@ bool-vector.  IDX starts at 0.  */)
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
   CHECK_ARRAY (array, Qarrayp);

-  CHECK_IMPURE (array);

 
   if (VECTORP (array))
     {
 
   if (VECTORP (array))
     {

+      CHECK_IMPURE (array, XVECTOR (array));

       if (idxval < 0 || idxval >= ASIZE (array))
        args_out_of_range (array, idx);
       ASET (array, idxval, newelt);
       if (idxval < 0 || idxval >= ASIZE (array))
        args_out_of_range (array, idx);
       ASET (array, idxval, newelt);


@@ -2240,6 +2251,7 @@ bool-vector.  IDX starts at 0.  */)
     {
       int c;
 
     {
       int c;
 

+      CHECK_IMPURE (array, XSTRING (array));

       if (idxval < 0 || idxval >= SCHARS (array))
        args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);
       if (idxval < 0 || idxval >= SCHARS (array))
        args_out_of_range (array, idx);
       CHECK_CHARACTER (newelt);


@@ -2412,6 +2424,33 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
   return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
 \f
   return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
 \f

+/* Convert the integer I to a cons-of-integers, where I is not in
+   fixnum range.  */
+
+#define INTBIG_TO_LISP(i, extremum)                                \
+  (eassert (FIXNUM_OVERFLOW_P (i)),                                \
+   (! (FIXNUM_OVERFLOW_P ((extremum) >> 16)                        \
+       && FIXNUM_OVERFLOW_P ((i) >> 16))                           \
+    ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff))   \
+    : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24)                \
+        && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24))                    \
+    ? Fcons (make_number ((i) >> 16 >> 24),                        \
+            Fcons (make_number ((i) >> 16 & 0xffffff),             \
+                   make_number ((i) & 0xffff)))                    \
+    : make_float (i)))
+
+Lisp_Object
+intbig_to_lisp (intmax_t i)
+{
+  return INTBIG_TO_LISP (i, INTMAX_MIN);
+}
+
+Lisp_Object
+uintbig_to_lisp (uintmax_t i)
+{
+  return INTBIG_TO_LISP (i, UINTMAX_MAX);
+}
+

 /* Convert the cons-of-integers, integer, or float value C to an
    unsigned value with maximum value MAX.  Signal an error if C does not
    have a valid format or is out of range.  */
 /* Convert the cons-of-integers, integer, or float value C to an
    unsigned value with maximum value MAX.  Signal an error if C does not
    have a valid format or is out of range.  */


@@ -2419,7 +2458,7 @@ uintmax_t
 cons_to_unsigned (Lisp_Object c, uintmax_t max)
 {
   bool valid = 0;
 cons_to_unsigned (Lisp_Object c, uintmax_t max)
 {
   bool valid = 0;

-  uintmax_t val IF_LINT (= 0);
+  uintmax_t val;

   if (INTEGERP (c))
     {
       valid = 0 <= XINT (c);
   if (INTEGERP (c))
     {
       valid = 0 <= XINT (c);


@@ -2472,7 +2511,7 @@ intmax_t
 cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
 {
   bool valid = 0;
 cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
 {
   bool valid = 0;

-  intmax_t val IF_LINT (= 0);
+  intmax_t val;

   if (INTEGERP (c))
     {
       val = XINT (c);
   if (INTEGERP (c))
     {
       val = XINT (c);


@@ -2604,6 +2643,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
       accum = 0;
       break;
     case Amult:
       accum = 0;
       break;
     case Amult:

+    case Adiv:

       accum = 1;
       break;
     case Alogand:
       accum = 1;
       break;
     case Alogand:


@@ -2633,39 +2673,28 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
       switch (code)
        {
        case Aadd:
       switch (code)
        {
        case Aadd:

-         if (INT_ADD_OVERFLOW (accum, next))
-           {
-             overflow = 1;
-             accum &= INTMASK;
-           }
-         accum += next;
+         overflow |= INT_ADD_WRAPV (accum, next, &accum);

          break;
        case Asub:
          break;
        case Asub:

-         if (INT_SUBTRACT_OVERFLOW (accum, next))
-           {
-             overflow = 1;
-             accum &= INTMASK;
-           }
-         accum = argnum ? accum - next : nargs == 1 ? - next : next;
+         if (! argnum)
+           accum = nargs == 1 ? - next : next;
+         else
+           overflow |= INT_SUBTRACT_WRAPV (accum, next, &accum);

          break;
        case Amult:
          break;
        case Amult:

-         if (INT_MULTIPLY_OVERFLOW (accum, next))
-           {
-             EMACS_UINT a = accum, b = next, ab = a * b;
-             overflow = 1;
-             accum = ab & INTMASK;
-           }
-         else
-           accum *= next;
+         overflow |= INT_MULTIPLY_WRAPV (accum, next, &accum);

          break;
        case Adiv:
          break;
        case Adiv:

-         if (!argnum)
+         if (! (argnum || nargs == 1))

            accum = next;
          else
            {
              if (next == 0)
                xsignal0 (Qarith_error);
            accum = next;
          else
            {
              if (next == 0)
                xsignal0 (Qarith_error);

-             accum /= next;
+             if (INT_DIVIDE_OVERFLOW (accum, next))
+               overflow = true;
+             else
+               accum /= next;

            }
          break;
        case Alogand:
            }
          break;
        case Alogand:


@@ -2728,7 +2757,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
          accum *= next;
          break;
        case Adiv:
          accum *= next;
          break;
        case Adiv:

-         if (!argnum)
+         if (! (argnum || nargs == 1))

            accum = next;
          else
            {
            accum = next;
          else
            {


@@ -2783,9 +2812,11 @@ usage: (* &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN ("/", Fquo, Squo, 1, MANY, 0,
 }
 
 DEFUN ("/", Fquo, Squo, 1, MANY, 0,

-       doc: /* Return first argument divided by all the remaining arguments.
+       doc: /* Divide number by divisors and return the result.
+With two or more arguments, return first argument divided by the rest.
+With one argument, return 1 divided by the argument.

 The arguments must be numbers or markers.
 The arguments must be numbers or markers.

-usage: (/ DIVIDEND &rest DIVISORS)  */)
+usage: (/ NUMBER &rest DIVISORS)  */)

   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t argnum;
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t argnum;


@@ -3462,6 +3493,9 @@ syms_of_data (void)
   DEFSYM (Qbool_vector_p, "bool-vector-p");
   DEFSYM (Qchar_or_string_p, "char-or-string-p");
   DEFSYM (Qmarkerp, "markerp");
   DEFSYM (Qbool_vector_p, "bool-vector-p");
   DEFSYM (Qchar_or_string_p, "char-or-string-p");
   DEFSYM (Qmarkerp, "markerp");

+#ifdef HAVE_MODULES
+  DEFSYM (Quser_ptrp, "user-ptrp");
+#endif

   DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
   DEFSYM (Qfboundp, "fboundp");
   DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
   DEFSYM (Qfboundp, "fboundp");


@@ -3553,6 +3587,9 @@ syms_of_data (void)
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qfinalizer, "finalizer");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qfinalizer, "finalizer");

+#ifdef HAVE_MODULES
+  DEFSYM (Quser_ptr, "user-ptr");
+#endif

   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");
   DEFSYM (Qfloat, "float");
   DEFSYM (Qwindow_configuration, "window-configuration");
   DEFSYM (Qprocess, "process");


@@ -3667,6 +3704,9 @@ syms_of_data (void)
   defsubr (&Sbyteorder);
   defsubr (&Ssubr_arity);
   defsubr (&Ssubr_name);
   defsubr (&Sbyteorder);
   defsubr (&Ssubr_arity);
   defsubr (&Ssubr_name);

+#ifdef HAVE_MODULES
+  defsubr (&Suser_ptrp);
+#endif

 
   defsubr (&Sbool_vector_exclusive_or);
   defsubr (&Sbool_vector_union);
 
   defsubr (&Sbool_vector_exclusive_or);
   defsubr (&Sbool_vector_union);