Improve performance of &key parsing
[bpt/emacs.git] / src / editfns.c
index 90346a8..5018020 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.
 
@@ -64,7 +64,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 extern Lisp_Object w32_get_internal_run_time (void);
 #endif
 
-static Lisp_Object format_time_string (char const *, ptrdiff_t, EMACS_TIME,
+static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
                                       bool, struct tm *);
 static int tm_diff (struct tm *, struct tm *);
 static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
@@ -233,26 +233,12 @@ Beginning of buffer is position (point-min), end is (point-max).
 The return value is POSITION.  */)
   (register Lisp_Object position)
 {
-  ptrdiff_t pos;
-
-  if (MARKERP (position)
-      && current_buffer == XMARKER (position)->buffer)
-    {
-      pos = marker_position (position);
-      if (pos < BEGV)
-       SET_PT_BOTH (BEGV, BEGV_BYTE);
-      else if (pos > ZV)
-       SET_PT_BOTH (ZV, ZV_BYTE);
-      else
-       SET_PT_BOTH (pos, marker_byte_position (position));
-
-      return position;
-    }
-
-  CHECK_NUMBER_COERCE_MARKER (position);
-
-  pos = clip_to_bounds (BEGV, XINT (position), ZV);
-  SET_PT (pos);
+  if (MARKERP (position))
+    set_point_from_marker (position);
+  else if (INTEGERP (position))
+    SET_PT (clip_to_bounds (BEGV, XINT (position), ZV));
+  else
+    wrong_type_argument (Qinteger_or_marker_p, position);
   return position;
 }
 
@@ -357,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);
 
@@ -498,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))
@@ -661,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.
 
@@ -697,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
@@ -708,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.  */
     {
@@ -731,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
@@ -1420,7 +1407,7 @@ least significant 16 bits.  USEC and PSEC are the microsecond and
 picosecond counts.  */)
   (void)
 {
-  return make_lisp_time (current_emacs_time ());
+  return make_lisp_time (current_timespec ());
 }
 
 DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
@@ -1450,7 +1437,7 @@ does the same thing as `current-time'.  */)
       usecs -= 1000000;
       secs++;
     }
-  return make_lisp_time (make_emacs_time (secs, usecs * 1000));
+  return make_lisp_time (make_timespec (secs, usecs * 1000));
 #else /* ! HAVE_GETRUSAGE  */
 #ifdef WINDOWSNT
   return w32_get_internal_run_time ();
@@ -1481,10 +1468,10 @@ make_time (time_t t)
    UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
    correspondingly negative picosecond count.  */
 Lisp_Object
-make_lisp_time (EMACS_TIME t)
+make_lisp_time (struct timespec t)
 {
-  int ns = EMACS_NSECS (t);
-  return make_time_tail (EMACS_SECS (t), list2i (ns / 1000, ns % 1000 * 1000));
+  int ns = t.tv_nsec;
+  return make_time_tail (t.tv_sec, list2i (ns / 1000, ns % 1000 * 1000));
 }
 
 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
@@ -1529,7 +1516,7 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
    list, generate the corresponding time value.
 
    If RESULT is not null, store into *RESULT the converted time;
-   this can fail if the converted time does not fit into EMACS_TIME.
+   this can fail if the converted time does not fit into struct timespec.
    If *DRESULT is not null, store into *DRESULT the number of
    seconds since the start of the POSIX Epoch.
 
@@ -1537,7 +1524,7 @@ disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
 bool
 decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
                        Lisp_Object psec,
-                       EMACS_TIME *result, double *dresult)
+                       struct timespec *result, double *dresult)
 {
   EMACS_INT hi, lo, us, ps;
   if (! (INTEGERP (high) && INTEGERP (low)
@@ -1565,7 +1552,7 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
          /* Return the greatest representable time that is not greater
             than the requested time.  */
          time_t sec = hi;
-         *result = make_emacs_time ((sec << 16) + lo, us * 1000 + ps / 1000);
+         *result = make_timespec ((sec << 16) + lo, us * 1000 + ps / 1000);
        }
       else
        {
@@ -1583,15 +1570,15 @@ decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
 /* Decode a Lisp list SPECIFIED_TIME that represents a time.
    If SPECIFIED_TIME is nil, use the current time.
 
-   Round the time down to the nearest EMACS_TIME value.
+   Round the time down to the nearest struct timespec value.
    Return seconds since the Epoch.
    Signal an error if unsuccessful.  */
-EMACS_TIME
+struct timespec
 lisp_time_argument (Lisp_Object specified_time)
 {
-  EMACS_TIME t;
+  struct timespec t;
   if (NILP (specified_time))
-    t = current_emacs_time ();
+    t = current_timespec ();
   else
     {
       Lisp_Object high, low, usec, psec;
@@ -1613,12 +1600,12 @@ lisp_seconds_argument (Lisp_Object specified_time)
   else
     {
       Lisp_Object high, low, usec, psec;
-      EMACS_TIME t;
+      struct timespec t;
       if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
             && decode_time_components (high, low, make_number (0),
                                        make_number (0), &t, 0)))
        error ("Invalid time specification");
-      return EMACS_SECS (t);
+      return t.tv_sec;
     }
 }
 
@@ -1639,8 +1626,8 @@ or (if you need time as a string) `format-time-string'.  */)
   double t;
   if (NILP (specified_time))
     {
-      EMACS_TIME now = current_emacs_time ();
-      t = EMACS_SECS (now) + EMACS_NSECS (now) / 1e9;
+      struct timespec now = current_timespec ();
+      t = now.tv_sec + now.tv_nsec / 1e9;
     }
   else
     {
@@ -1716,6 +1703,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.
@@ -1735,6 +1723,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.
@@ -1753,12 +1742,12 @@ 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)
 {
-  EMACS_TIME t = lisp_time_argument (timeval);
+  struct timespec t = lisp_time_argument (timeval);
   struct tm tm;
 
   CHECK_STRING (format_string);
@@ -1770,20 +1759,20 @@ usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL)  */)
 
 static Lisp_Object
 format_time_string (char const *format, ptrdiff_t formatlen,
-                   EMACS_TIME t, bool ut, struct tm *tmp)
+                   struct timespec t, bool ut, struct tm *tmp)
 {
   char buffer[4000];
   char *buf = buffer;
   ptrdiff_t size = sizeof buffer;
   size_t len;
   Lisp_Object bufstring;
-  int ns = EMACS_NSECS (t);
+  int ns = t.tv_nsec;
   struct tm *tm;
   USE_SAFE_ALLOCA;
 
   while (1)
     {
-      time_t *taddr = emacs_secs_addr (&t);
+      time_t *taddr = &t.tv_sec;
       block_input ();
 
       synchronize_system_time_locale ();
@@ -2068,17 +2057,17 @@ in this case, `current-time-zone' returns a list containing nil for
 the data it can't find.  */)
   (Lisp_Object specified_time)
 {
-  EMACS_TIME value;
+  struct timespec value;
   int offset;
   struct tm *t;
   struct tm localtm;
   Lisp_Object zone_offset, zone_name;
 
   zone_offset = Qnil;
-  value = make_emacs_time (lisp_seconds_argument (specified_time), 0);
+  value = make_timespec (lisp_seconds_argument (specified_time), 0);
   zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm);
   block_input ();
-  t = gmtime (emacs_secs_addr (&value));
+  t = gmtime (&value.tv_sec);
   if (t)
     offset = tm_diff (&localtm, t);
   unblock_input ();
@@ -2330,6 +2319,10 @@ to multibyte for insertion (see `unibyte-char-to-multibyte').
 If the current buffer is unibyte, multibyte strings are converted
 to unibyte for insertion.
 
+If an overlay begins at the insertion point, the inserted text falls
+outside the overlay; if a nonempty overlay ends at the insertion
+point, the inserted text falls inside that overlay.
+
 usage: (insert-before-markers &rest ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -3429,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.
 
@@ -3478,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;
     }
 }
@@ -3513,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);
 }
 
@@ -3651,8 +3636,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
@@ -4229,7 +4214,7 @@ usage: (format STRING &rest OBJECTS)  */)
        if (buf == initial_buffer)
          {
            buf = xmalloc (bufsize);
-           sa_must_free = 1;
+           sa_must_free = true;
            buf_save_value_index = SPECPDL_INDEX ();
            record_unwind_protect_ptr (xfree, buf);
            memcpy (buf, initial_buffer, used);
@@ -4847,6 +4832,7 @@ functions if all the text being accessed has this property.  */);
   defsubr (&Sbuffer_substring);
   defsubr (&Sbuffer_substring_no_properties);
   defsubr (&Sbuffer_string);
+  defsubr (&Sget_pos_property);
 
   defsubr (&Spoint_marker);
   defsubr (&Smark_marker);