comparison src/editfns.c @ 13767:862fff660446

(Fset_time_zone_rule): Move static var environbuf to top level. (syms_of_editfns): Initialize environbuf explicitly. (Vbuffer_access_fontified_property): New variable. (syms_of_editfns): Set up Lisp var. (make_buffer_string): Don't call the Vbuffer_access_fontify_functions if the text is already fontified. (Fbuffer_string): Pas 1 for PROPS arg. (update_buffer_properties): New subroutine. (Finsert_buffer_substring): Use update_buffer_properties. (make_buffer_string): New arg PROPS. (Fbuffer_string, Fbuffer_substring): Pass new arg. (Fbuffer_substring_no_properties): New function. (syms_of_editfns): defsubr it. (Vbuffer_access_fontify_functions): New variable. (Qbuffer_access_fontify_functions): New variable. (syms_of_editfns): Set up Lisp variable, initialize them. (make_buffer_string): Run this new hook.

13766:adaa14fd574e

extern char **environ;
extern Lisp_Object make_time ();
extern void insert_from_buffer ();
static long difftm ();
static void set_time_zone_rule ();

/* Some static data, and a function to initialize it for each run */

Lisp_Object Vsystem_name;
Lisp_Object Vuser_real_login_name;	/* login name of current user ID */

    }
  else
    return Fmake_list (2, Qnil);
}

DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
  "Set the local time zone using TZ, a string specifying a time zone rule.\n\
If TZ is nil, use implementation-defined default time zone information.")
  (tz)
     Lisp_Object tz;
{
  static char **environbuf;
  char *tzstring;

  if (NILP (tz))
    tzstring = 0;
  else

/* Making strings from buffer contents.  */

/* Return a Lisp_String containing the text of the current buffer from
   START to END.  If text properties are in use and the current buffer
   has properties in the range specified, the resulting string will also
   have them.

   We don't want to use plain old make_string here, because it calls
   make_uninit_string, which can cause the buffer arena to be
   compacted.  make_string has no way of knowing that the data has
   been moved, and thus copies the wrong data into the string.  This
   doesn't effect most of the other users of make_string, so it should
   be left as is.  But we should use this function when conjuring
   buffer substrings.  */

Lisp_Object
make_buffer_string (start, end)
     int start, end;
{
  Lisp_Object result, tem, tem1;

  if (start < GPT && GPT < end)
    move_gap (start);

  result = make_uninit_string (end - start);
  bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);

  tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
  tem1 = Ftext_properties_at (make_number (start), Qnil);

#ifdef USE_TEXT_PROPERTIES
  if (XINT (tem) != end || !NILP (tem1))
    copy_intervals_to_string (result, current_buffer, start, end - start);
#endif

  return result;
}

DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
  "Return the contents of part of the current buffer as a string.\n\
The two arguments START and END are character positions;\n\

  validate_region (&b, &e);
  beg = XINT (b);
  end = XINT (e);

  return make_buffer_string (beg, end);
}

DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
  "Return the contents of the current buffer as a string.\n\
If narrowing is in effect, this function returns only the visible part\n\
of the buffer.")
  ()
{
  return make_buffer_string (BEGV, ZV);
}

DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
  1, 3, 0,
  "Insert before point a substring of the contents of buffer BUFFER.\n\

They default to the beginning and the end of BUFFER.")
  (buf, b, e)
     Lisp_Object buf, b, e;
{
  register int beg, end, temp;
  register struct buffer *bp;
  Lisp_Object buffer;

  buffer = Fget_buffer (buf);
  if (NILP (buffer))
    nsberror (buf);

  if (beg > end)
    temp = beg, beg = end, end = temp;

  if (!(BUF_BEGV (bp) <= beg && end <= BUF_ZV (bp)))
    args_out_of_range (b, e);

  insert_from_buffer (bp, beg, end - beg, 0);
  return Qnil;
}


void
syms_of_editfns ()
{
  DEFVAR_LISP ("system-name", &Vsystem_name,
	       "The name of the machine Emacs is running on.");
  
  DEFVAR_LISP ("user-full-name", &Vuser_full_name,
	       "The full name of the user logged in.");

  defsubr (&Schar_equal);
  defsubr (&Sgoto_char);
  defsubr (&Sstring_to_char);
  defsubr (&Schar_to_string);
  defsubr (&Sbuffer_substring);
  defsubr (&Sbuffer_string);

  defsubr (&Spoint_marker);
  defsubr (&Smark_marker);
  defsubr (&Spoint);

13767:862fff660446

extern char **environ;
extern Lisp_Object make_time ();
extern void insert_from_buffer ();
static long difftm ();
static void set_time_zone_rule ();
static void update_buffer_properties ();

Lisp_Object Vbuffer_access_fontify_functions;
Lisp_Object Qbuffer_access_fontify_functions;
Lisp_Object Vbuffer_access_fontified_property;

/* Some static data, and a function to initialize it for each run */

Lisp_Object Vsystem_name;
Lisp_Object Vuser_real_login_name;	/* login name of current user ID */

    }
  else
    return Fmake_list (2, Qnil);
}

/* This holds the value of `environ' produced by the previous
   call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
   has never been called.  */
static char **environbuf;

DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
  "Set the local time zone using TZ, a string specifying a time zone rule.\n\
If TZ is nil, use implementation-defined default time zone information.")
  (tz)
     Lisp_Object tz;
{
  char *tzstring;

  if (NILP (tz))
    tzstring = 0;
  else

/* Making strings from buffer contents.  */

/* Return a Lisp_String containing the text of the current buffer from
   START to END.  If text properties are in use and the current buffer
   has properties in the range specified, the resulting string will also
   have them, if PROPS is nonzero.

   We don't want to use plain old make_string here, because it calls
   make_uninit_string, which can cause the buffer arena to be
   compacted.  make_string has no way of knowing that the data has
   been moved, and thus copies the wrong data into the string.  This
   doesn't effect most of the other users of make_string, so it should
   be left as is.  But we should use this function when conjuring
   buffer substrings.  */

Lisp_Object
make_buffer_string (start, end, props)
     int start, end;
     int props;
{
  Lisp_Object result, tem, tem1;

  if (start < GPT && GPT < end)
    move_gap (start);

  result = make_uninit_string (end - start);
  bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);

  /* If desired, update and copy the text properties.  */
#ifdef USE_TEXT_PROPERTIES
  if (props)
    {
      update_buffer_properties (start, end);

      tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
      tem1 = Ftext_properties_at (make_number (start), Qnil);

      if (XINT (tem) != end || !NILP (tem1))
	copy_intervals_to_string (result, current_buffer, start, end - start);
    }
#endif

  return result;
}

/* Call Vbuffer_access_fontify_functions for the range START ... END
   in the current buffer, if necessary.  */

static void
update_buffer_properties (start, end)
     int start, end;
{
#ifdef USE_TEXT_PROPERTIES
  /* If this buffer has some access functions,
     call them, specifying the range of the buffer being accessed.  */
  if (!NILP (Vbuffer_access_fontify_functions))
    {
      Lisp_Object args[3];
      Lisp_Object tem;

      args[0] = Qbuffer_access_fontify_functions;
      XSETINT (args[1], start);
      XSETINT (args[2], end);

      /* But don't call them if we can tell that the work
	 has already been done.  */
      if (!NILP (Vbuffer_access_fontified_property))
	{
	  tem = Ftext_property_any (args[1], args[2],
				    Vbuffer_access_fontified_property,
				    Qnil, Qnil);
	  if (! NILP (tem))
	    Frun_hook_with_args (3, &args);
	}
      else
	Frun_hook_with_args (3, &args);
    }
#endif
}

DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
  "Return the contents of part of the current buffer as a string.\n\
The two arguments START and END are character positions;\n\

  validate_region (&b, &e);
  beg = XINT (b);
  end = XINT (e);

  return make_buffer_string (beg, end, 1);
}

DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties,
       Sbuffer_substring_no_properties, 2, 2, 0,
  "Return the characters of part of the buffer, without the text properties.\n\
The two arguments START and END are character positions;\n\
they can be in either order.")
  (b, e)
     Lisp_Object b, e;
{
  register int beg, end;

  validate_region (&b, &e);
  beg = XINT (b);
  end = XINT (e);

  return make_buffer_string (beg, end, 0);
}

DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
  "Return the contents of the current buffer as a string.\n\
If narrowing is in effect, this function returns only the visible part\n\
of the buffer.")
  ()
{
  return make_buffer_string (BEGV, ZV, 1);
}

DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
  1, 3, 0,
  "Insert before point a substring of the contents of buffer BUFFER.\n\

They default to the beginning and the end of BUFFER.")
  (buf, b, e)
     Lisp_Object buf, b, e;
{
  register int beg, end, temp;
  register struct buffer *bp, *obuf;
  Lisp_Object buffer;

  buffer = Fget_buffer (buf);
  if (NILP (buffer))
    nsberror (buf);

  if (beg > end)
    temp = beg, beg = end, end = temp;

  if (!(BUF_BEGV (bp) <= beg && end <= BUF_ZV (bp)))
    args_out_of_range (b, e);

  obuf = current_buffer;
  set_buffer_internal_1 (bp);
  update_buffer_properties (beg, end);
  set_buffer_internal_1 (obuf);

  insert_from_buffer (bp, beg, end - beg, 0);
  return Qnil;
}


void
syms_of_editfns ()
{
  environbuf = 0;

  Qbuffer_access_fontify_functions
    = intern ("buffer-access-fontify-functions");
  staticpro (&Qbuffer_access_fontify_functions);

  DEFVAR_LISP ("buffer-access-fontify-functions",
	       &Vbuffer_access_fontify_functions,
	       "List of functions called by `buffer-substring' to fontify if necessary.\n\
Each function is called with two arguments which specify the range\n\
of the buffer being accessed.");
  Vbuffer_access_fontify_functions = Qnil;

  DEFVAR_LISP ("buffer_access_fontified_property",
	       &Vbuffer_access_fontified_property,
       "Property which (if non-nil) indicates text has been fontified.\n\
`buffer-substring' need not call the `buffer-access-fontify-functions'\n\
functions if all the text being accessed has this property.");
  Vbuffer_access_fontified_property = Qnil;

  DEFVAR_LISP ("system-name", &Vsystem_name,
	       "The name of the machine Emacs is running on.");
  
  DEFVAR_LISP ("user-full-name", &Vuser_full_name,
	       "The full name of the user logged in.");

  defsubr (&Schar_equal);
  defsubr (&Sgoto_char);
  defsubr (&Sstring_to_char);
  defsubr (&Schar_to_string);
  defsubr (&Sbuffer_substring);
  defsubr (&Sbuffer_substring_no_properties);
  defsubr (&Sbuffer_string);

  defsubr (&Spoint_marker);
  defsubr (&Smark_marker);
  defsubr (&Spoint);