* lisp.h (modify_region): Rename to...
[bpt/emacs.git] / src / editfns.c
index 2d1a3cb..d60f417 100644 (file)
@@ -21,7 +21,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <config.h>
 #include <sys/types.h>
 #include <stdio.h>
-#include <setjmp.h>
 
 #ifdef HAVE_PWD_H
 #include <pwd.h>
@@ -739,17 +738,18 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.  */)
 DEFUN ("line-beginning-position",
        Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
        doc: /* Return the character position of the first character on the current line.
-With argument N not nil or 1, move forward N - 1 lines first.
-If scan reaches end of buffer, return that position.
+With optional argument N, scan forward N - 1 lines first.
+If the scan reaches the end of the buffer, return that position.
 
-The returned position is of the first character in the logical order,
-i.e. the one that has the smallest character position.
+This function ignores text display directionality; it returns the
+position of the first character in logical order, i.e. the smallest
+character position on the line.
 
 This function constrains the returned position to the current field
-unless that would be on a different line than the original,
+unless that position would be on a different line than the original,
 unconstrained result.  If N is nil or 1, and a front-sticky field
 starts at point, the scan stops as soon as it starts.  To ignore field
-boundaries bind `inhibit-field-text-motion' to t.
+boundaries, bind `inhibit-field-text-motion' to t.
 
 This function does not move point.  */)
   (Lisp_Object n)
@@ -783,8 +783,9 @@ DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
 With argument N not nil or 1, move forward N - 1 lines first.
 If scan reaches end of buffer, return that position.
 
-The returned position is of the last character in the logical order,
-i.e. the character whose buffer position is the largest one.
+This function ignores text display directionality; it returns the
+position of the last character in logical order, i.e. the largest
+character position on the line.
 
 This function constrains the returned position to the current field
 unless that would be on a different line than the original,
@@ -812,34 +813,43 @@ This function does not move point.  */)
                              Qnil, Qt, Qnil);
 }
 
-\f
+/* Save current buffer state for `save-excursion' special form.
+   We (ab)use Lisp_Misc_Save_Value to allow explicit free and so
+   offload some work from GC.  */
+
 Lisp_Object
 save_excursion_save (void)
 {
-  bool visible = (XBUFFER (XWINDOW (selected_window)->buffer)
-                 == current_buffer);
-
-  return Fcons (Fpoint_marker (),
-               Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
-                      Fcons (visible ? Qt : Qnil,
-                             Fcons (BVAR (current_buffer, mark_active),
-                                    selected_window))));
+  Lisp_Object save, *data = xmalloc (word_size * 4);
+
+  data[0] = Fpoint_marker ();
+  /* Do not copy the mark if it points to nowhere.  */
+  data[1] = (XMARKER (BVAR (current_buffer, mark))->buffer
+            ? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
+            : Qnil);
+  /* Selected window if current buffer is shown in it, nil otherwise.  */
+  data[2] = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+            ? selected_window : Qnil);
+  data[3] = BVAR (current_buffer, mark_active);
+
+  save = make_save_value (data, 4);
+  XSAVE_VALUE (save)->dogc = 1;
+  return save;
 }
 
+/* Restore saved buffer before leaving `save-excursion' special form.  */
+
 Lisp_Object
 save_excursion_restore (Lisp_Object info)
 {
-  Lisp_Object tem, tem1, omark, nmark;
+  Lisp_Object tem, tem1, omark, nmark, *data = XSAVE_VALUE (info)->pointer;
   struct gcpro gcpro1, gcpro2, gcpro3;
-  bool visible_p;
 
-  tem = Fmarker_buffer (XCAR (info));
-  /* If buffer being returned to is now deleted, avoid error */
-  /* Otherwise could get error here while unwinding to top level
-     and crash */
-  /* In that case, Fmarker_buffer returns nil now.  */
+  tem = Fmarker_buffer (data[0]);
+  /* If we're unwinding to top level, saved buffer may be deleted.  This
+     means that all of its markers are unchained and so tem is nil.  */
   if (NILP (tem))
-    return Qnil;
+    goto out;
 
   omark = nmark = Qnil;
   GCPRO3 (info, omark, nmark);
@@ -847,35 +857,24 @@ save_excursion_restore (Lisp_Object info)
   Fset_buffer (tem);
 
   /* Point marker.  */
-  tem = XCAR (info);
+  tem = data[0];
   Fgoto_char (tem);
   unchain_marker (XMARKER (tem));
 
   /* Mark marker.  */
-  info = XCDR (info);
-  tem = XCAR (info);
+  tem = data[1];
   omark = Fmarker_position (BVAR (current_buffer, mark));
-  Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
-  nmark = Fmarker_position (tem);
-  unchain_marker (XMARKER (tem));
+  if (NILP (tem))
+    unchain_marker (XMARKER (BVAR (current_buffer, mark)));
+  else
+    {
+      Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
+      nmark = Fmarker_position (tem);
+      unchain_marker (XMARKER (tem));
+    }
 
-  /* visible */
-  info = XCDR (info);
-  visible_p = !NILP (XCAR (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 */
-
-  /* Mark active */
-  info = XCDR (info);
-  tem = XCAR (info);
+  /* Mark active.  */
+  tem = data[3];
   tem1 = BVAR (current_buffer, mark_active);
   bset_mark_active (current_buffer, tem);
 
@@ -899,8 +898,8 @@ save_excursion_restore (Lisp_Object info)
   /* If buffer was visible in a window, and a different window was
      selected, and the old selected window is still showing this
      buffer, restore point in that window.  */
-  tem = XCDR (info);
-  if (visible_p
+  tem = data[2];
+  if (WINDOWP (tem)
       && !EQ (tem, selected_window)
       && (tem1 = XWINDOW (tem)->buffer,
          (/* Window is live...  */
@@ -910,6 +909,10 @@ save_excursion_restore (Lisp_Object info)
     Fset_window_point (tem, make_number (PT));
 
   UNGCPRO;
+
+ out:
+
+  free_save_value (info);
   return Qnil;
 }
 
@@ -1218,9 +1221,9 @@ of the user with that uid, or nil if there is no such user.  */)
     return Vuser_login_name;
 
   CONS_TO_INTEGER (uid, uid_t, id);
-  BLOCK_INPUT;
+  block_input ();
   pw = getpwuid (id);
-  UNBLOCK_INPUT;
+  unblock_input ();
   return (pw ? build_string (pw->pw_name) : Qnil);
 }
 
@@ -1278,15 +1281,15 @@ name, or nil if there is no such user.  */)
     {
       uid_t u;
       CONS_TO_INTEGER (uid, uid_t, u);
-      BLOCK_INPUT;
+      block_input ();
       pw = getpwuid (u);
-      UNBLOCK_INPUT;
+      unblock_input ();
     }
   else if (STRINGP (uid))
     {
-      BLOCK_INPUT;
+      block_input ();
       pw = getpwnam (SSDATA (uid));
-      UNBLOCK_INPUT;
+      unblock_input ();
     }
   else
     error ("Invalid UID specification");
@@ -1329,15 +1332,6 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
   return Vsystem_name;
 }
 
-const char *
-get_system_name (void)
-{
-  if (STRINGP (Vsystem_name))
-    return SSDATA (Vsystem_name);
-  else
-    return "";
-}
-
 DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
        doc: /* Return the process ID of Emacs, as a number.  */)
   (void)
@@ -1762,14 +1756,14 @@ format_time_string (char const *format, ptrdiff_t formatlen,
   while (1)
     {
       time_t *taddr = emacs_secs_addr (&t);
-      BLOCK_INPUT;
+      block_input ();
 
       synchronize_system_time_locale ();
 
       tm = ut ? gmtime (taddr) : localtime (taddr);
       if (! tm)
        {
-         UNBLOCK_INPUT;
+         unblock_input ();
          time_overflow ();
        }
       *tmp = *tm;
@@ -1781,14 +1775,14 @@ format_time_string (char const *format, ptrdiff_t formatlen,
 
       /* Buffer was too small, so make it bigger and try again.  */
       len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns);
-      UNBLOCK_INPUT;
+      unblock_input ();
       if (STRING_BYTES_BOUND <= len)
        string_overflow ();
       size = len + 1;
       buf = SAFE_ALLOCA (size);
     }
 
-  UNBLOCK_INPUT;
+  unblock_input ();
   bufstring = make_unibyte_string (buf, len);
   SAFE_FREE ();
   return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
@@ -1816,11 +1810,11 @@ DOW and ZONE.)  */)
   struct tm *decoded_time;
   Lisp_Object list_args[9];
 
-  BLOCK_INPUT;
+  block_input ();
   decoded_time = localtime (&time_spec);
   if (decoded_time)
     save_tm = *decoded_time;
-  UNBLOCK_INPUT;
+  unblock_input ();
   if (! (decoded_time
         && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year
         && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
@@ -1836,13 +1830,13 @@ DOW and ZONE.)  */)
   XSETFASTINT (list_args[6], save_tm.tm_wday);
   list_args[7] = save_tm.tm_isdst ? Qt : Qnil;
 
-  BLOCK_INPUT;
+  block_input ();
   decoded_time = gmtime (&time_spec);
   if (decoded_time == 0)
     list_args[8] = Qnil;
   else
     XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
-  UNBLOCK_INPUT;
+  unblock_input ();
   return Flist (9, list_args);
 }
 
@@ -1900,9 +1894,9 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)  */)
     zone = XCAR (zone);
   if (NILP (zone))
     {
-      BLOCK_INPUT;
+      block_input ();
       value = mktime (&tm);
-      UNBLOCK_INPUT;
+      unblock_input ();
     }
   else
     {
@@ -1927,7 +1921,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)  */)
       else
        error ("Invalid time zone specification");
 
-      BLOCK_INPUT;
+      block_input ();
 
       /* Set TZ before calling mktime; merely adjusting mktime's returned
         value doesn't suffice, since that would mishandle leap seconds.  */
@@ -1941,7 +1935,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)  */)
 #ifdef LOCALTIME_CACHE
       tzset ();
 #endif
-      UNBLOCK_INPUT;
+      unblock_input ();
 
       xfree (newenv);
     }
@@ -1977,7 +1971,7 @@ but this is considered obsolete.  */)
      newline, and without the 4-digit year limit.  Don't use asctime
      or ctime, as they might dump core if the year is outside the
      range -999 .. 9999.  */
-  BLOCK_INPUT;
+  block_input ();
   tm = localtime (&value);
   if (tm)
     {
@@ -1993,7 +1987,7 @@ but this is considered obsolete.  */)
                     tm->tm_hour, tm->tm_min, tm->tm_sec,
                     tm->tm_year + year_base);
     }
-  UNBLOCK_INPUT;
+  unblock_input ();
   if (! tm)
     time_overflow ();
 
@@ -2049,11 +2043,11 @@ the data it can't find.  */)
   zone_offset = Qnil;
   value = make_emacs_time (lisp_seconds_argument (specified_time), 0);
   zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm);
-  BLOCK_INPUT;
+  block_input ();
   t = gmtime (emacs_secs_addr (&value));
   if (t)
     offset = tm_diff (&localtm, t);
-  UNBLOCK_INPUT;
+  unblock_input ();
 
   if (t)
     {
@@ -2100,7 +2094,7 @@ only the former.  */)
   if (! (NILP (tz) || EQ (tz, Qt)))
     CHECK_STRING (tz);
 
-  BLOCK_INPUT;
+  block_input ();
 
   /* When called for the first time, save the original TZ.  */
   old_environbuf = environbuf;
@@ -2117,7 +2111,7 @@ only the former.  */)
   set_time_zone_rule (tzstring);
   environbuf = environ;
 
-  UNBLOCK_INPUT;
+  unblock_input ();
 
   xfree (old_environbuf);
   return Qnil;
@@ -2613,7 +2607,7 @@ They default to the values of (point-min) and (point-max) in BUFFER.  */)
   if (NILP (buf))
     nsberror (buffer);
   bp = XBUFFER (buf);
-  if (NILP (BVAR (bp, name)))
+  if (!BUFFER_LIVE_P (bp))
     error ("Selecting deleted buffer");
 
   if (NILP (start))
@@ -2677,7 +2671,7 @@ determines whether case is significant or ignored.  */)
       if (NILP (buf1))
        nsberror (buffer1);
       bp1 = XBUFFER (buf1);
-      if (NILP (BVAR (bp1, name)))
+      if (!BUFFER_LIVE_P (bp1))
        error ("Selecting deleted buffer");
     }
 
@@ -2715,7 +2709,7 @@ determines whether case is significant or ignored.  */)
       if (NILP (buf2))
        nsberror (buffer2);
       bp2 = XBUFFER (buf2);
-      if (NILP (BVAR (bp2, name)))
+      if (!BUFFER_LIVE_P (bp2))
        error ("Selecting deleted buffer");
     }
 
@@ -2783,8 +2777,8 @@ determines whether case is significant or ignored.  */)
 
       if (!NILP (trt))
        {
-         c1 = CHAR_TABLE_TRANSLATE (trt, c1);
-         c2 = CHAR_TABLE_TRANSLATE (trt, c2);
+         c1 = char_table_translate (trt, c1);
+         c2 = char_table_translate (trt, c2);
        }
       if (c1 < c2)
        return make_number (- 1 - chars);
@@ -2928,7 +2922,7 @@ Both characters must have the same length of multi-byte form.  */)
          else if (!changed)
            {
              changed = -1;
-             modify_region (current_buffer, pos, XINT (end), 0);
+             modify_region_1 (pos, XINT (end), false);
 
              if (! NILP (noundo))
                {
@@ -3104,7 +3098,7 @@ It returns the number of characters changed.  */)
   pos = XINT (start);
   pos_byte = CHAR_TO_BYTE (pos);
   end_pos = XINT (end);
-  modify_region (current_buffer, pos, end_pos, 0);
+  modify_region_1 (pos, end_pos, false);
 
   cnt = 0;
   for (; pos < end_pos; )
@@ -3433,8 +3427,8 @@ static ptrdiff_t message_length;
 
 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
        doc: /* Display a message at the bottom of the screen.
-The message also goes into the `*Messages*' buffer.
-\(In keyboard macros, that's all it does.)
+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.
 
 The first argument is a format control string, and the rest are data
@@ -4628,7 +4622,7 @@ Transposing beyond buffer boundaries is an error.  */)
 
   if (end1 == start2)          /* adjacent regions */
     {
-      modify_region (current_buffer, start1, end2, 0);
+      modify_region_1 (start1, end2, false);
       record_change (start1, len1 + len2);
 
       tmp_interval1 = copy_intervals (cur_intv, start1, len1);
@@ -4687,8 +4681,8 @@ Transposing beyond buffer boundaries is an error.  */)
         {
          USE_SAFE_ALLOCA;
 
-          modify_region (current_buffer, start1, end1, 0);
-          modify_region (current_buffer, start2, end2, 0);
+          modify_region_1 (start1, end1, false);
+          modify_region_1 (start2, end2, false);
           record_change (start1, len1);
           record_change (start2, len2);
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
@@ -4721,7 +4715,7 @@ Transposing beyond buffer boundaries is an error.  */)
         {
          USE_SAFE_ALLOCA;
 
-          modify_region (current_buffer, start1, end2, 0);
+          modify_region_1 (start1, end2, false);
           record_change (start1, (end2 - start1));
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
           tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);
@@ -4754,7 +4748,7 @@ Transposing beyond buffer boundaries is an error.  */)
          USE_SAFE_ALLOCA;
 
           record_change (start1, (end2 - start1));
-          modify_region (current_buffer, start1, end2, 0);
+          modify_region_1 (start1, end2, false);
 
           tmp_interval1 = copy_intervals (cur_intv, start1, len1);
           tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);