plist module
[bpt/emacs.git] / src / editfns.c
index 84a5c83..747f59e 100644 (file)
@@ -1,6 +1,6 @@
 /* Lisp functions pertaining to editing.
 
-Copyright (C) 1985-1987, 1989, 1993-2013 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2014 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -343,16 +343,15 @@ overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
   return idx;
 }
 
-/* Return the value of property PROP, in OBJECT at POSITION.
-   It's the value of PROP that a char inserted at POSITION would get.
-   OBJECT is optional and defaults to the current buffer.
-   If OBJECT is a buffer, then overlay properties are considered as well as
-   text properties.
-   If OBJECT is a window, then that window's buffer is used, but
-   window-specific overlays are considered only if they are associated
-   with OBJECT. */
-Lisp_Object
-get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object object)
+DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
+       doc: /* Return the value of POSITION's property PROP, in OBJECT.
+Almost identical to `get-char-property' except for the following difference:
+Whereas `get-char-property' returns the property of the char at (i.e. right
+after) POSITION, this pays attention to properties's stickiness and overlays's
+advancement settings, in order to find the property of POSITION itself,
+i.e. the property that a char would inherit if it were inserted
+at POSITION.  */)
+  (Lisp_Object position, register Lisp_Object prop, Lisp_Object object)
 {
   CHECK_NUMBER_COERCE_MARKER (position);
 
@@ -484,7 +483,7 @@ find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
      specially.  */
   if (NILP (merge_at_boundary))
     {
-      Lisp_Object field = get_pos_property (pos, Qfield, Qnil);
+      Lisp_Object field = Fget_pos_property (pos, Qfield, Qnil);
       if (!EQ (field, after_field))
        at_field_end = 1;
       if (!EQ (field, before_field))
@@ -647,7 +646,7 @@ also considered to be `on the boundary'.
 
 If the optional argument ONLY-IN-LINE is non-nil and constraining
 NEW-POS would move it to a different line, NEW-POS is returned
-unconstrained.  This useful for commands that move by line, like
+unconstrained.  This is useful for commands that move by line, like
 \\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
 only in the case where they can still move to the right line.
 
@@ -683,7 +682,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
       && (!NILP (Fget_char_property (new_pos, Qfield, Qnil))
           || !NILP (Fget_char_property (old_pos, Qfield, Qnil))
           /* To recognize field boundaries, we must also look at the
-             previous positions; we could use `get_pos_property'
+             previous positions; we could use `Fget_pos_property'
              instead, but in itself that would fail inside non-sticky
              fields (like comint prompts).  */
           || (XFASTINT (new_pos) > BEGV
@@ -694,10 +693,12 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
           /* Field boundaries are again a problem; but now we must
              decide the case exactly, so we need to call
              `get_pos_property' as well.  */
-          || (NILP (get_pos_property (old_pos, inhibit_capture_property, Qnil))
+          || (NILP (Fget_pos_property (old_pos, inhibit_capture_property, Qnil))
               && (XFASTINT (old_pos) <= BEGV
-                  || NILP (Fget_char_property (old_pos, inhibit_capture_property, Qnil))
-                  || NILP (Fget_char_property (prev_old, inhibit_capture_property, Qnil))))))
+                  || NILP (Fget_char_property
+                          (old_pos, inhibit_capture_property, Qnil))
+                  || NILP (Fget_char_property
+                          (prev_old, inhibit_capture_property, Qnil))))))
     /* It is possible that NEW_POS is not within the same field as
        OLD_POS; try to move NEW_POS so that it is.  */
     {
@@ -717,7 +718,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
          /* NEW_POS should be constrained, but only if either
             ONLY_IN_LINE is nil (in which case any constraint is OK),
             or NEW_POS and FIELD_BOUND are on the same line (in which
-            case the constraint is OK even if ONLY_IN_LINE is non-nil). */
+            case the constraint is OK even if ONLY_IN_LINE is non-nil).  */
          && (NILP (only_in_line)
              /* This is the ONLY_IN_LINE case, check that NEW_POS and
                 FIELD_BOUND are on the same line by seeing whether
@@ -758,7 +759,7 @@ This function does not move point.  */)
   (Lisp_Object n)
 {
   ptrdiff_t orig, orig_byte, end;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
   specbind (Qinhibit_point_motion_hooks, Qt);
 
   if (NILP (n))
@@ -773,7 +774,7 @@ This function does not move point.  */)
 
   SET_PT_BOTH (orig, orig_byte);
 
-  unbind_to (count, Qnil);
+  dynwind_end ();
 
   /* Return END constrained to the current input field.  */
   return Fconstrain_to_field (make_number (end), make_number (orig),
@@ -933,12 +934,13 @@ usage: (save-excursion &rest BODY)  */)
   (Lisp_Object args)
 {
   register Lisp_Object val;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 
   record_unwind_protect (save_excursion_restore, save_excursion_save ());
 
   val = Fprogn (args);
-  return unbind_to (count, val);
+  dynwind_end ();
+  return val;
 }
 
 DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0,
@@ -947,10 +949,12 @@ BODY is executed just like `progn'.
 usage: (save-current-buffer &rest BODY)  */)
   (Lisp_Object args)
 {
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 
   record_unwind_current_buffer ();
-  return unbind_to (count, Fprogn (args));
+  Lisp_Object tem0 = Fprogn (args);
+  dynwind_end ();
+  return tem0;
 }
 \f
 DEFUN ("buffer-size", Fbuffer_size, Sbuffer_size, 0, 1, 0,
@@ -1702,6 +1706,7 @@ by text that describes the specified date and time in TIME:
 %G is the year corresponding to the ISO week, %g within the century.
 %m is the numeric month.
 %b and %h are the locale's abbreviated month name, %B the full name.
+ (%h is not supported on MS-Windows.)
 %d is the day of the month, zero-padded, %e is blank-padded.
 %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
 %a is the locale's abbreviated name of the day of week, %A the full name.
@@ -1721,6 +1726,7 @@ by text that describes the specified date and time in TIME:
 %c is the locale's date and time format.
 %x is the locale's "preferred" date format.
 %D is like "%m/%d/%y".
+%F is the ISO 8601 date format (like "%Y-%m-%d").
 
 %R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
 %X is the locale's "preferred" time format.
@@ -1739,7 +1745,7 @@ The modifiers are `E' and `O'.  For certain characters X,
 %EX is a locale's alternative version of %X;
 %OX is like %X, but uses the locale's number symbols.
 
-For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".
+For example, to produce full ISO 8601 format, use "%FT%T%z".
 
 usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL)  */)
   (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
@@ -2235,7 +2241,7 @@ general_insert_function (void (*insert_func)
            len = CHAR_STRING (c, str);
          else
            {
-             str[0] = ASCII_CHAR_P (c) ? c : multibyte_char_to_unibyte (c);
+             str[0] = CHAR_TO_BYTE8 (c);
              len = 1;
            }
          (*insert_func) ((char *) str, len);
@@ -2825,7 +2831,7 @@ Both characters must have the same length of multi-byte form.  */)
   ptrdiff_t changed = 0;
   unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
   unsigned char *p;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 #define COMBINING_NO    0
 #define COMBINING_BEFORE 1
 #define COMBINING_AFTER  2
@@ -2849,7 +2855,7 @@ Both characters must have the same length of multi-byte form.  */)
       len = CHAR_STRING (fromc, fromstr);
       if (CHAR_STRING (toc, tostr) != len)
        error ("Characters in `subst-char-in-region' have different byte-lengths");
-      if (!ASCII_BYTE_P (*tostr))
+      if (!ASCII_CHAR_P (*tostr))
        {
          /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
             complete multibyte character, it may be combined with the
@@ -2942,7 +2948,7 @@ Both characters must have the same length of multi-byte form.  */)
                  : ((pos_byte_next < Z_BYTE
                      && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next)))
                     || (pos_byte > BEG_BYTE
-                        && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte - 1))))))
+                        && ! ASCII_CHAR_P (FETCH_BYTE (pos_byte - 1))))))
            {
              Lisp_Object tem, string;
 
@@ -2990,7 +2996,7 @@ Both characters must have the same length of multi-byte form.  */)
       update_compositions (changed, last_changed, CHECK_ALL);
     }
 
-  unbind_to (count, Qnil);
+  dynwind_end ();
   return Qnil;
 }
 
@@ -3123,7 +3129,7 @@ It returns the number of characters changed.  */)
              else
                {
                  nc = tt[oc];
-                 if (! ASCII_BYTE_P (nc) && multibyte)
+                 if (! ASCII_CHAR_P (nc) && multibyte)
                    {
                      str_len = BYTE8_STRING (nc, buf);
                      str = buf;
@@ -3360,10 +3366,6 @@ save_restriction_restore (Lisp_Object data)
 
          buf->clip_changed = 1; /* Remember that the narrowing changed. */
        }
-      /* These aren't needed anymore, so don't wait for GC.  */
-      free_marker (XCAR (data));
-      free_marker (XCDR (data));
-      free_cons (XCONS (data));
     }
   else
     /* A buffer, which means that there was no old restriction.  */
@@ -3406,11 +3408,12 @@ usage: (save-restriction &rest BODY)  */)
   (Lisp_Object body)
 {
   register Lisp_Object val;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 
   record_unwind_protect (save_restriction_restore, save_restriction_save ());
   val = Fprogn (body);
-  return unbind_to (count, val);
+  dynwind_end ();
+  return val;
 }
 \f
 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
@@ -3419,6 +3422,9 @@ The message also goes into the `*Messages*' buffer, if `message-log-max'
 is non-nil.  (In keyboard macros, that's all it does.)
 Return the message.
 
+In batch mode, the message is printed to the standard error stream,
+followed by a newline.
+
 The first argument is a format control string, and the rest are data
 to be formatted under control of the string.  See `format' for details.
 
@@ -3468,23 +3474,14 @@ usage: (message-box FORMAT-STRING &rest ARGS)  */)
   else
     {
       Lisp_Object val = Fformat (nargs, args);
-#ifdef HAVE_MENUS
-      /* The MS-DOS frames support popup menus even though they are
-        not FRAME_WINDOW_P.  */
-      if (FRAME_WINDOW_P (XFRAME (selected_frame))
-         || FRAME_MSDOS_P (XFRAME (selected_frame)))
-      {
-       Lisp_Object pane, menu;
-       struct gcpro gcpro1;
-       pane = list1 (Fcons (build_string ("OK"), Qt));
-       GCPRO1 (pane);
-       menu = Fcons (val, pane);
-       Fx_popup_dialog (Qt, menu, Qt);
-       UNGCPRO;
-       return val;
-      }
-#endif /* HAVE_MENUS */
-      message3 (val);
+      Lisp_Object pane, menu;
+      struct gcpro gcpro1;
+
+      pane = list1 (Fcons (build_string ("OK"), Qt));
+      GCPRO1 (pane);
+      menu = Fcons (val, pane);
+      Fx_popup_dialog (Qt, menu, Qt);
+      UNGCPRO;
       return val;
     }
 }
@@ -3503,11 +3500,9 @@ message; let the minibuffer contents show.
 usage: (message-or-box FORMAT-STRING &rest ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-#ifdef HAVE_MENUS
   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
       && use_dialog_box)
     return Fmessage_box (nargs, args);
-#endif
   return Fmessage (nargs, args);
 }
 
@@ -3548,7 +3543,7 @@ usage: (propertize STRING &rest PROPERTIES)  */)
   Fadd_text_properties (make_number (0),
                        make_number (SCHARS (string)),
                        properties, string);
-  RETURN_UNGCPRO (string);
+  return string;
 }
 
 DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
@@ -3605,13 +3600,12 @@ specifier truncates the string to the given width.
 usage: (format STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  ptrdiff_t n;         /* The number of the next arg to substitute */
+  ptrdiff_t n;         /* The number of the next arg to substitute */
   char initial_buffer[4000];
   char *buf = initial_buffer;
   ptrdiff_t bufsize = sizeof initial_buffer;
   ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
   char *p;
-  ptrdiff_t buf_save_value_index IF_LINT (= 0);
   char *format, *end, *format_start;
   ptrdiff_t formatlen, nchars;
   /* True if the format is multibyte.  */
@@ -3641,8 +3635,8 @@ usage: (format STRING &rest OBJECTS)  */)
   struct info
   {
     ptrdiff_t start, end;
-    unsigned converted_to_string : 1;
-    unsigned intervals : 1;
+    bool_bf converted_to_string : 1;
+    bool_bf intervals : 1;
   } *info = 0;
 
   /* It should not be necessary to GCPRO ARGS, because
@@ -3882,7 +3876,7 @@ usage: (format STRING &rest OBJECTS)  */)
 
                  if (p > buf
                      && multibyte
-                     && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+                     && !ASCII_CHAR_P (*((unsigned char *) p - 1))
                      && STRING_MULTIBYTE (args[n])
                      && !CHAR_HEAD_P (SREF (args[n], 0)))
                    maybe_combine_byte = 1;
@@ -4172,7 +4166,7 @@ usage: (format STRING &rest OBJECTS)  */)
            {
              /* Copy a whole multibyte character.  */
              if (p > buf
-                 && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+                 && !ASCII_CHAR_P (*((unsigned char *) p - 1))
                  && !CHAR_HEAD_P (*format))
                maybe_combine_byte = 1;
 
@@ -4186,7 +4180,7 @@ usage: (format STRING &rest OBJECTS)  */)
          else
            {
              unsigned char uc = *format++;
-             if (! multibyte || ASCII_BYTE_P (uc))
+             if (! multibyte || ASCII_CHAR_P (uc))
                convbytes = 1;
              else
                {
@@ -4218,16 +4212,12 @@ usage: (format STRING &rest OBJECTS)  */)
 
        if (buf == initial_buffer)
          {
-           buf = xmalloc (bufsize);
-           sa_must_free = 1;
-           buf_save_value_index = SPECPDL_INDEX ();
-           record_unwind_protect_ptr (xfree, buf);
+           buf = xmalloc_atomic (bufsize);
            memcpy (buf, initial_buffer, used);
          }
        else
          {
            buf = xrealloc (buf, bufsize);
-           set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
          }
 
        p = buf + used;
@@ -4383,17 +4373,22 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer.  */)
     return Qnil;
 
   i1 = XFASTINT (c1);
-  if (NILP (BVAR (current_buffer, enable_multibyte_characters))
-      && ! ASCII_CHAR_P (i1))
-    {
-      MAKE_CHAR_MULTIBYTE (i1);
-    }
   i2 = XFASTINT (c2);
-  if (NILP (BVAR (current_buffer, enable_multibyte_characters))
-      && ! ASCII_CHAR_P (i2))
+
+  /* FIXME: It is possible to compare multibyte characters even when
+     the current buffer is unibyte.  Unfortunately this is ambiguous
+     for characters between 128 and 255, as they could be either
+     eight-bit raw bytes or Latin-1 characters.  Assume the former for
+     now.  See Bug#17011, and also see casefiddle.c's casify_object,
+     which has a similar problem.  */
+  if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
     {
-      MAKE_CHAR_MULTIBYTE (i2);
+      if (SINGLE_BYTE_CHAR_P (i1))
+       i1 = UNIBYTE_TO_CHAR (i1);
+      if (SINGLE_BYTE_CHAR_P (i2))
+       i2 = UNIBYTE_TO_CHAR (i2);
     }
+
   return (downcase (i1) == downcase (i2) ? Qt :  Qnil);
 }
 \f
@@ -4782,6 +4777,8 @@ Transposing beyond buffer boundaries is an error.  */)
 void
 syms_of_editfns (void)
 {
+#include "editfns.x"
+
   DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions");
 
   DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion,
@@ -4828,94 +4825,6 @@ functions if all the text being accessed has this property.  */);
   DEFVAR_LISP ("operating-system-release", Voperating_system_release,
               doc: /* The release of the operating system Emacs is running on.  */);
 
-  defsubr (&Spropertize);
-  defsubr (&Schar_equal);
-  defsubr (&Sgoto_char);
-  defsubr (&Sstring_to_char);
-  defsubr (&Schar_to_string);
-  defsubr (&Sbyte_to_string);
-  defsubr (&Sbuffer_substring);
-  defsubr (&Sbuffer_substring_no_properties);
-  defsubr (&Sbuffer_string);
-
-  defsubr (&Spoint_marker);
-  defsubr (&Smark_marker);
-  defsubr (&Spoint);
-  defsubr (&Sregion_beginning);
-  defsubr (&Sregion_end);
-
   DEFSYM (Qfield, "field");
   DEFSYM (Qboundary, "boundary");
-  defsubr (&Sfield_beginning);
-  defsubr (&Sfield_end);
-  defsubr (&Sfield_string);
-  defsubr (&Sfield_string_no_properties);
-  defsubr (&Sdelete_field);
-  defsubr (&Sconstrain_to_field);
-
-  defsubr (&Sline_beginning_position);
-  defsubr (&Sline_end_position);
-
-  defsubr (&Ssave_excursion);
-  defsubr (&Ssave_current_buffer);
-
-  defsubr (&Sbuffer_size);
-  defsubr (&Spoint_max);
-  defsubr (&Spoint_min);
-  defsubr (&Spoint_min_marker);
-  defsubr (&Spoint_max_marker);
-  defsubr (&Sgap_position);
-  defsubr (&Sgap_size);
-  defsubr (&Sposition_bytes);
-  defsubr (&Sbyte_to_position);
-
-  defsubr (&Sbobp);
-  defsubr (&Seobp);
-  defsubr (&Sbolp);
-  defsubr (&Seolp);
-  defsubr (&Sfollowing_char);
-  defsubr (&Sprevious_char);
-  defsubr (&Schar_after);
-  defsubr (&Schar_before);
-  defsubr (&Sinsert);
-  defsubr (&Sinsert_before_markers);
-  defsubr (&Sinsert_and_inherit);
-  defsubr (&Sinsert_and_inherit_before_markers);
-  defsubr (&Sinsert_char);
-  defsubr (&Sinsert_byte);
-
-  defsubr (&Suser_login_name);
-  defsubr (&Suser_real_login_name);
-  defsubr (&Suser_uid);
-  defsubr (&Suser_real_uid);
-  defsubr (&Sgroup_gid);
-  defsubr (&Sgroup_real_gid);
-  defsubr (&Suser_full_name);
-  defsubr (&Semacs_pid);
-  defsubr (&Scurrent_time);
-  defsubr (&Sget_internal_run_time);
-  defsubr (&Sformat_time_string);
-  defsubr (&Sfloat_time);
-  defsubr (&Sdecode_time);
-  defsubr (&Sencode_time);
-  defsubr (&Scurrent_time_string);
-  defsubr (&Scurrent_time_zone);
-  defsubr (&Sset_time_zone_rule);
-  defsubr (&Ssystem_name);
-  defsubr (&Smessage);
-  defsubr (&Smessage_box);
-  defsubr (&Smessage_or_box);
-  defsubr (&Scurrent_message);
-  defsubr (&Sformat);
-
-  defsubr (&Sinsert_buffer_substring);
-  defsubr (&Scompare_buffer_substrings);
-  defsubr (&Ssubst_char_in_region);
-  defsubr (&Stranslate_region_internal);
-  defsubr (&Sdelete_region);
-  defsubr (&Sdelete_and_extract_region);
-  defsubr (&Swiden);
-  defsubr (&Snarrow_to_region);
-  defsubr (&Ssave_restriction);
-  defsubr (&Stranspose_regions);
 }