Remove buggy non-native image scrolling

[gnu-emacs] / src / data.c

diff --git a/src/data.c b/src/data.c
index d06b9916b3a61204def8006927a5cdb0b6c3cb53..2574cbbd7645d2f128eef567fa49dfcd37a713aa 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 *,


@@ -186,7 +183,7 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,

-       doc: /* Return t if OBJECT is nil.  */
+       doc: /* Return t if OBJECT is nil, and return nil otherwise.  */

        attributes: const)
   (Lisp_Object object)
 {
        attributes: const)
   (Lisp_Object object)
 {


@@ -223,9 +220,16 @@ for example, (type-of 1) returns `integer'.  */)
        case Lisp_Misc_Overlay:
          return Qoverlay;
        case Lisp_Misc_Float:
        case Lisp_Misc_Overlay:
          return Qoverlay;
        case Lisp_Misc_Float:

-         return Qfloat;
+          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))


@@ -424,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)


@@ -557,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;
 }


@@ -567,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;
 }


@@ -788,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.  */


@@ -1240,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:


@@ -1527,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))
     {


@@ -1540,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


@@ -1645,8 +1658,10 @@ The function `default-value' gets the default value and `set-default' sets it.
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))

-         message ("Making %s buffer-local while let-bound!",
-                  SDATA (SYMBOL_NAME (variable)));
+         {
+           AUTO_STRING (format, "Making %s buffer-local while let-bound!");
+           CALLN (Fmessage, format, SYMBOL_NAME (variable));
+         }

       }
     }
 
       }
     }
 


@@ -1659,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,


@@ -1667,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'.


@@ -1728,9 +1743,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))
        Lisp_Object symbol;
        XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
        if (let_shadows_global_binding_p (symbol))

-         message ("Making %s local to %s while let-bound!",
-                  SDATA (SYMBOL_NAME (variable)),
-                  SDATA (BVAR (current_buffer, name)));
+         {
+           AUTO_STRING (format, "Making %s local to %s while let-bound!");
+           CALLN (Fmessage, format, SYMBOL_NAME (variable),
+                  BVAR (current_buffer, name));
+         }

       }
     }
 
       }
     }
 


@@ -1740,8 +1757,11 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
   if (NILP (tem))
     {
       if (let_shadows_buffer_binding_p (sym))
   if (NILP (tem))
     {
       if (let_shadows_buffer_binding_p (sym))

-       message ("Making %s buffer-local while locally let-bound!",
-                SDATA (SYMBOL_NAME (variable)));
+       {
+         AUTO_STRING (format,
+                      "Making %s buffer-local while locally let-bound!");
+         CALLN (Fmessage, format, SYMBOL_NAME (variable));
+       }

 
       /* Swap out any local binding for some other buffer, and make
         sure the current value is permanently recorded, if it's the
 
       /* Swap out any local binding for some other buffer, and make
         sure the current value is permanently recorded, if it's the


@@ -1906,8 +1926,10 @@ frame-local bindings).  */)
     Lisp_Object symbol;
     XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
     if (let_shadows_global_binding_p (symbol))
     Lisp_Object symbol;
     XSETSYMBOL (symbol, sym); /* In case `variable' is aliased.  */
     if (let_shadows_global_binding_p (symbol))

-      message ("Making %s frame-local while let-bound!",
-              SDATA (SYMBOL_NAME (variable)));
+      {
+       AUTO_STRING (format, "Making %s frame-local while let-bound!");
+       CALLN (Fmessage, format, SYMBOL_NAME (variable));
+      }

   }
   return variable;
 }
   }
   return variable;
 }


@@ -2125,8 +2147,6 @@ DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
        doc: /* Return the function at the end of OBJECT's function chain.
 If OBJECT is not a symbol, just return it.  Otherwise, follow all
 function indirections to find the final function binding and return it.
        doc: /* Return the function at the end of OBJECT's function chain.
 If OBJECT is not a symbol, just return it.  Otherwise, follow all
 function indirections to find the final function binding and return it.

-If the final symbol in the chain is unbound, signal a void-function error.
-Optional arg NOERROR non-nil means to return nil instead of signaling.

 Signal a cyclic-function-indirection error if there is a loop in the
 function chain of symbols.  */)
   (register Lisp_Object object, Lisp_Object noerror)
 Signal a cyclic-function-indirection error if there is a loop in the
 function chain of symbols.  */)
   (register Lisp_Object object, Lisp_Object noerror)


@@ -2141,9 +2161,6 @@ function chain of symbols.  */)
   if (!NILP (result))
     return result;
 
   if (!NILP (result))
     return result;
 

-  if (NILP (noerror))
-    xsignal1 (Qvoid_function, object);
-

   return Qnil;
 }
 \f
   return Qnil;
 }
 \f


@@ -2211,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);


@@ -2234,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);


@@ -2406,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.  */


@@ -2598,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:


@@ -2627,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:


@@ -2722,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
            {


@@ -2777,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;


@@ -3445,7 +3482,6 @@ syms_of_data (void)
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qsymbolp, "symbolp");

-  DEFSYM (Qkeywordp, "keywordp");

   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");
   DEFSYM (Qintegerp, "integerp");
   DEFSYM (Qnatnump, "natnump");
   DEFSYM (Qwholenump, "wholenump");


@@ -3457,9 +3493,11 @@ 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 (Qbuffer_or_string_p, "buffer-or-string-p");
   DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");

-  DEFSYM (Qboundp, "boundp");

   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");
   DEFSYM (Qfboundp, "fboundp");
 
   DEFSYM (Qfloatp, "floatp");


@@ -3475,10 +3513,6 @@ syms_of_data (void)
 
   DEFSYM (Qcdr, "cdr");
 
 
   DEFSYM (Qcdr, "cdr");
 

-  /* Handle automatic advice activation.  */
-  DEFSYM (Qad_advice_info, "ad-advice-info");
-  DEFSYM (Qad_activate_internal, "ad-activate-internal");
-

   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is
   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is


@@ -3552,6 +3586,10 @@ syms_of_data (void)
   DEFSYM (Qcons, "cons");
   DEFSYM (Qmarker, "marker");
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qcons, "cons");
   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");


@@ -3563,7 +3601,6 @@ syms_of_data (void)
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");
   DEFSYM (Qchar_table, "char-table");
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");

-  DEFSYM (Qmisc, "misc");

 
   DEFSYM (Qdefun, "defun");
 
 
   DEFSYM (Qdefun, "defun");
 


@@ -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);