/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,89,93,94,95,96,97 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
+#include "charset.h"
#include "window.h"
#include "systime.h"
Lisp_Object Qbuffer_access_fontify_functions;
Lisp_Object Vbuffer_access_fontified_property;
+Lisp_Object Fuser_full_name ();
+
/* Some static data, and a function to initialize it for each run */
Lisp_Object Vsystem_name;
char *user_name;
register unsigned char *p, *q, *r;
struct passwd *pw; /* password entry for the current user */
- extern char *index ();
Lisp_Object tem;
/* Set up system_name even when dumping. */
/* If the user name claimed in the environment vars differs from
the real uid, use the claimed name to find the full name. */
tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
- if (NILP (tem))
- pw = (struct passwd *) getpwnam (XSTRING (Vuser_login_name)->data);
+ Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid())
+ : Vuser_login_name);
- p = (unsigned char *) (pw ? USER_FULL_NAME : "unknown");
- q = (unsigned char *) index (p, ',');
- Vuser_full_name = make_string (p, q ? q - p : strlen (p));
-
-#ifdef AMPERSAND_FULL_NAME
- p = XSTRING (Vuser_full_name)->data;
- q = (unsigned char *) index (p, '&');
- /* Substitute the login name for the &, upcasing the first character. */
- if (q)
- {
- r = (unsigned char *) alloca (strlen (p)
- + XSTRING (Vuser_login_name)->size + 1);
- bcopy (p, r, q - p);
- r[q - p] = 0;
- strcat (r, XSTRING (Vuser_login_name)->data);
- r[q - p] = UPCASE (r[q - p]);
- strcat (r, q + 1);
- Vuser_full_name = build_string (r);
- }
-#endif /* AMPERSAND_FULL_NAME */
-
p = (unsigned char *) getenv ("NAME");
if (p)
Vuser_full_name = build_string (p);
+ else if (NILP (Vuser_full_name))
+ Vuser_full_name = build_string ("unknown");
}
\f
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
- "Convert arg CHARACTER to a one-character string containing that character.")
+ "Convert arg CHAR to a string containing multi-byte form of that character.")
(character)
Lisp_Object character;
{
- char c;
+ int len;
+ char workbuf[4], *str;
+
CHECK_NUMBER (character, 0);
- c = XINT (character);
- return make_string (&c, 1);
+ len = CHAR_STRING (XFASTINT (character), workbuf, str);
+ return make_string (str, len);
}
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
- "Convert arg STRING to a character, the first character of that string.")
+ "Convert arg STRING to a character, the first character of that string.\n\
+A multibyte character is handled correctly.")
(string)
register Lisp_Object string;
{
register Lisp_Object val;
register struct Lisp_String *p;
CHECK_STRING (string, 0);
-
p = XSTRING (string);
if (p->size)
- XSETFASTINT (val, ((unsigned char *) p->data)[0]);
+ XSETFASTINT (val, STRING_CHAR (p->data, p->size));
else
XSETFASTINT (val, 0);
return val;
}
+
+DEFUN ("sref", Fsref, Ssref, 2, 2, 0,
+ "Return the character in STRING at INDEX. INDEX starts at 0.\n\
+A multibyte character is handled correctly.\n\
+INDEX not pointing at character boundary is an error.")
+ (str, idx)
+ Lisp_Object str, idx;
+{
+ register int idxval, len;
+ register unsigned char *p;
+ register Lisp_Object val;
+
+ CHECK_STRING (str, 0);
+ CHECK_NUMBER (idx, 1);
+ idxval = XINT (idx);
+ if (idxval < 0 || idxval >= (len = XVECTOR (str)->size))
+ args_out_of_range (str, idx);
+ p = XSTRING (str)->data + idxval;
+ if (!CHAR_HEAD_P (p))
+ error ("Not character boundary");
+
+ len = XSTRING (str)->size - idxval;
+ XSETFASTINT (val, STRING_CHAR (p, len));
+ return val;
+}
+
\f
static Lisp_Object
buildmark (val)
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
"Set point to POSITION, a number or marker.\n\
-Beginning of buffer is position (point-min), end is (point-max).")
+Beginning of buffer is position (point-min), end is (point-max).\n\
+If the position is in the middle of a multibyte form,\n\
+the actual point is set at the head of the multibyte form\n\
+except in the case that `enable-multibyte-characters' is nil.")
(position)
register Lisp_Object position;
{
+ int pos;
+ unsigned char *p;
+
CHECK_NUMBER_COERCE_MARKER (position, 0);
- SET_PT (clip_to_bounds (BEGV, XINT (position), ZV));
+ pos = clip_to_bounds (BEGV, XINT (position), ZV);
+ /* If POS is in a middle of multi-byte form (i.e. *P >= 0xA0), we
+ must decrement POS until it points the head of the multi-byte
+ form. */
+ if (!NILP (current_buffer->enable_multibyte_characters)
+ && *(p = POS_ADDR (pos)) >= 0xA0
+ && pos > BEGV)
+ {
+ /* Since a multi-byte form does not contain the gap, POS should
+ not stride over the gap while it is being decreased. So, we
+ set the limit as below. */
+ unsigned char *p_min = pos < GPT ? BEG_ADDR : GAP_END_ADDR;
+ unsigned int saved_pos = pos;
+
+ do {
+ p--, pos--;
+ } while (p > p_min && *p >= 0xA0);
+ if (*p < 0x80)
+ /* This was an invalid multi-byte form. */
+ pos = saved_pos;
+ XSETFASTINT (position, pos);
+ }
+ SET_PT (pos);
return position;
}
DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
"Return the character following point, as a number.\n\
-At the end of the buffer or accessible region, return 0.")
+At the end of the buffer or accessible region, return 0.\n\
+If `enable-multibyte-characters' is nil or point is not\n\
+ at character boundary, multibyte form is ignored,\n\
+ and only one byte following point is returned as a character.")
()
{
Lisp_Object temp;
DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
"Return the character preceding point, as a number.\n\
-At the beginning of the buffer or accessible region, return 0.")
+At the beginning of the buffer or accessible region, return 0.\n\
+If `enable-multibyte-characters' is nil or point is not\n\
+ at character boundary, multi-byte form is ignored,\n\
+ and only one byte preceding point is returned as a character.")
()
{
Lisp_Object temp;
if (PT <= BEGV)
XSETFASTINT (temp, 0);
+ else if (!NILP (current_buffer->enable_multibyte_characters))
+ {
+ int pos = PT;
+ DEC_POS (pos);
+ XSETFASTINT (temp, FETCH_CHAR (pos));
+ }
else
- XSETFASTINT (temp, FETCH_CHAR (PT - 1));
+ XSETFASTINT (temp, FETCH_BYTE (PT - 1));
return temp;
}
"Return T if point is at the beginning of a line.")
()
{
- if (PT == BEGV || FETCH_CHAR (PT - 1) == '\n')
+ if (PT == BEGV || FETCH_BYTE (PT - 1) == '\n')
return Qt;
return Qnil;
}
`End of a line' includes point being at the end of the buffer.")
()
{
- if (PT == ZV || FETCH_CHAR (PT) == '\n')
+ if (PT == ZV || FETCH_BYTE (PT) == '\n')
return Qt;
return Qnil;
}
-DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0,
+DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0,
"Return character in current buffer at position POS.\n\
POS is an integer or a buffer pointer.\n\
-If POS is out of range, the value is nil.")
+If POS is out of range, the value is nil.\n\
+If `enable-multibyte-characters' is nil or POS is not at character boundary,\n\
+ multi-byte form is ignored, and only one byte at POS\n\
+ is returned as a character.")
(pos)
Lisp_Object pos;
{
register Lisp_Object val;
register int n;
- CHECK_NUMBER_COERCE_MARKER (pos, 0);
+ if (NILP (pos))
+ n = PT;
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
- n = XINT (pos);
- if (n < BEGV || n >= ZV) return Qnil;
+ n = XINT (pos);
+ if (n < BEGV || n >= ZV)
+ return Qnil;
+ }
XSETFASTINT (val, FETCH_CHAR (n));
return val;
}
+
+DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0,
+ "Return character in current buffer preceding position POS.\n\
+POS is an integer or a buffer pointer.\n\
+If POS is out of range, the value is nil.\n\
+If `enable-multibyte-characters' is nil or POS is not at character boundary,\n\
+multi-byte form is ignored, and only one byte preceding POS\n\
+is returned as a character.")
+ (pos)
+ Lisp_Object pos;
+{
+ register Lisp_Object val;
+ register int n;
+
+ if (NILP (pos))
+ n = PT;
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+ n = XINT (pos);
+ }
+
+ if (!NILP (current_buffer->enable_multibyte_characters))
+ {
+ DEC_POS (n);
+ if (n < BEGV || n >= ZV)
+ return Qnil;
+ XSETFASTINT (val, FETCH_CHAR (n));
+ }
+ else
+ {
+ n--;
+ if (n < BEGV || n >= ZV)
+ return Qnil;
+ XSETFASTINT (val, FETCH_BYTE (n));
+ }
+ return val;
+}
\f
DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0,
"Return the name under which the user logged in, as a string.\n\
DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0,
"Return the full name of the user logged in, as a string.\n\
If optional argument UID is an integer, return the full name of the user\n\
-with that uid, or nil if there is no such user.")
+with that uid, or \"unknown\" if there is no such user.\n\
+If UID is a string, return the full name of the user with that login\n\
+name, or \"unknown\" if no such user could be found.")
(uid)
Lisp_Object uid;
{
struct passwd *pw;
+ register unsigned char *p, *q;
+ extern char *index ();
+ Lisp_Object full;
if (NILP (uid))
- return Vuser_full_name;
+ return Vuser_full_name;
+ else if (NUMBERP (uid))
+ pw = (struct passwd *) getpwuid (XINT (uid));
+ else if (STRINGP (uid))
+ pw = (struct passwd *) getpwnam (XSTRING (uid)->data);
+ else
+ error ("Invalid UID specification");
- CHECK_NUMBER (uid, 0);
- pw = (struct passwd *) getpwuid (XINT (uid));
- return (pw ? build_string (pw->pw_gecos) : Qnil);
+ if (!pw)
+ return Qnil;
+
+ p = (unsigned char *) USER_FULL_NAME;
+ /* Chop off everything after the first comma. */
+ q = (unsigned char *) index (p, ',');
+ full = make_string (p, q ? q - p : strlen (p));
+
+#ifdef AMPERSAND_FULL_NAME
+ p = XSTRING (full)->data;
+ q = (unsigned char *) index (p, '&');
+ /* Substitute the login name for the &, upcasing the first character. */
+ if (q)
+ {
+ register unsigned char *r;
+ Lisp_Object login;
+
+ login = Fuser_login_name (make_number (pw->pw_uid));
+ r = (unsigned char *) alloca (strlen (p) + XSTRING (login)->size + 1);
+ bcopy (p, r, q - p);
+ r[q - p] = 0;
+ strcat (r, XSTRING (login)->data);
+ r[q - p] = UPCASE (r[q - p]);
+ strcat (r, q + 1);
+ full = build_string (r);
+ }
+#endif /* AMPERSAND_FULL_NAME */
+
+ return full;
}
DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
char *
get_system_name ()
{
- return (char *) XSTRING (Vsystem_name)->data;
+ if (STRINGP (Vsystem_name))
+ return (char *) XSTRING (Vsystem_name)->data;
+ else
+ return "";
}
DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
}
}
-DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 2, 0,
- "Use FORMAT-STRING to format the time TIME.\n\
-TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\
-`current-time' and `file-attributes'.\n\
-FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\
-%a is replaced by the abbreviated name of the day of week.\n\
-%A is replaced by the full name of the day of week.\n\
-%b is replaced by the abbreviated name of the month.\n\
-%B is replaced by the full name of the month.\n\
-%c stands for the preferred date/time format of the C locale.\n\
-%d is replaced by the day of month, zero-padded.\n\
-%D is a synonym for \"%m/%d/%y\".\n\
-%e is replaced by the day of month, blank-padded.\n\
-%h is a synonym for \"%b\".\n\
-%H is replaced by the hour (00-23).\n\
-%I is replaced by the hour (00-12).\n\
-%j is replaced by the day of the year (001-366).\n\
-%k is replaced by the hour (0-23), blank padded.\n\
-%l is replaced by the hour (1-12), blank padded.\n\
-%m is replaced by the month (01-12).\n\
-%M is replaced by the minute (00-59).\n\
-%n is a synonym for \"\\n\".\n\
-%p is replaced by AM or PM, as appropriate.\n\
-%r is a synonym for \"%I:%M:%S %p\".\n\
-%R is a synonym for \"%H:%M\".\n\
-%S is replaced by the second (00-60).\n\
-%t is a synonym for \"\\t\".\n\
-%T is a synonym for \"%H:%M:%S\".\n\
-%U is replaced by the week of the year (00-53), first day of week is Sunday.\n\
-%w is replaced by the day of week (0-6), Sunday is day 0.\n\
-%W is replaced by the week of the year (00-53), first day of week is Monday.\n\
-%x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
-%X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
-%y is replaced by the year without century (00-99).\n\
-%Y is replaced by the year with century.\n\
-%Z is replaced by the time zone abbreviation.\n\
+/*
+DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
+ "Use FORMAT-STRING to format the time TIME, or now if omitted.\n\
+TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by\n\
+`current-time' or `file-attributes'.\n\
+The third, optional, argument UNIVERSAL, if non-nil, means describe TIME\n\
+as Universal Time; nil means describe TIME in the local time zone.\n\
+The value is a copy of FORMAT-STRING, but with certain constructs replaced\n\
+by text that describes the specified date and time in TIME:\n\
+\n\
+%Y is the year, %y within the century, %C the century.\n\
+%G is the year corresponding to the ISO week, %g within the century.\n\
+%m is the numeric month, %b and %h the abbreviated name, %B the full name.\n\
+%d is the day of the month, zero-padded, %e is blank-padded.\n\
+%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.\n\
+%a is the abbreviated name of the day of week, %A the full name.\n\
+%U is the week number starting on Sunday, %W starting on Monday,\n\
+ %V according to ISO 8601.\n\
+%j is the day of the year.\n\
\n\
-The number of options reflects the `strftime' function.")
- (format_string, time)
- Lisp_Object format_string, time;
+%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H\n\
+ only blank-padded, %l is like %I blank-padded.\n\
+%p is AM or PM.\n\
+%M is the minute.\n\
+%S is the second.\n\
+%Z is the time zone name, %z is the numeric form.\n\
+%s is the number of seconds since 1970-01-01 00:00:00 +0000.\n\
+\n\
+%c is the locale's date and time format.\n\
+%x is the locale's \"preferred\" date format.\n\
+%D is like \"%m/%d/%y\".\n\
+\n\
+%R is like \"%H:%M\", %T is like \"%H:%M:%S\", %r is like \"%I:%M:%S %p\".\n\
+%X is the locale's \"preferred\" time format.\n\
+\n\
+Finally, %n is like \n, %t is like \t, %% is a literal %.\n\
+\n\
+Certain flags and modifiers are available with some format controls.\n\
+The flags are `_' and `-'. For certain characters X, %_X is like %X,\n\
+but padded with blanks; %-X is like %X, but without padding.\n\
+%NX (where N stands for an integer) is like %X,\n\
+but takes up at least N (a number) positions.\n\
+The modifiers are `E' and `O'. For certain characters X,\n\
+%EX is a locale's alternative version of %X;\n\
+%OX is like %X, but uses the locale's number symbols.\n\
+\n\
+For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\".")
+*/
+
+DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
+ 0 /* See immediately above */)
+ (format_string, time, universal)
+ Lisp_Object format_string, time, universal;
{
time_t value;
int size;
while (1)
{
- char *buf = (char *) alloca (size);
- *buf = 1;
- if (emacs_strftime (buf, size, XSTRING (format_string)->data,
- localtime (&value))
- || !*buf)
+ char *buf = (char *) alloca (size + 1);
+ int result;
+
+ result = emacs_strftime (buf, size, XSTRING (format_string)->data,
+ (NILP (universal) ? localtime (&value)
+ : gmtime (&value)));
+ if (result > 0 && result < size)
return build_string (buf);
- /* If buffer was too small, make it bigger. */
- size *= 2;
+ if (result < 0)
+ error ("Invalid time format specification");
+
+ /* If buffer was too small, make it bigger and try again. */
+ result = emacs_strftime (buf, 0, XSTRING (format_string)->data,
+ (NILP (universal) ? localtime (&value)
+ : gmtime (&value)));
+ size = result + 1;
}
}
{
time_t time;
struct tm tm;
- Lisp_Object zone = (nargs > 6)? args[nargs - 1] : Qnil;
+ Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil);
CHECK_NUMBER (args[0], 0); /* second */
CHECK_NUMBER (args[1], 1); /* minute */
char *tzstring;
char **oldenv = environ, **newenv;
- if (zone == Qt)
+ if (EQ (zone, Qt))
tzstring = "UTC0";
else if (STRINGP (zone))
tzstring = (char *) XSTRING (zone)->data;
Programs can use this function to decode a time,\n\
since the number of columns in each field is fixed.\n\
The format is `Sun Sep 16 01:03:52 1973'.\n\
+However, see also the functions `decode-time' and `format-time-string'\n\
+which provide a much more powerful and general facility.\n\
+\n\
If an argument is given, it specifies a time to format\n\
instead of the current time. The argument should have the form:\n\
(HIGH . LOW)\n\
return Fcons (make_number (offset), Fcons (build_string (s), Qnil));
}
else
- return Fmake_list (2, Qnil);
+ return Fmake_list (make_number (2), Qnil);
}
/* This holds the value of `environ' produced by the previous
if (NILP (tz))
tzstring = 0;
- else if (tz == Qt)
+ else if (EQ (tz, Qt))
tzstring = "UTC0";
else
{
return Qnil;
}
-/* These two values are known to load tz files in buggy implementations.
+#ifdef LOCALTIME_CACHE
+
+/* These two values are known to load tz files in buggy implementations,
+ i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
Their values shouldn't matter in non-buggy implementations.
We don't use string literals for these strings,
since if a string in the environment is in readonly
See Sun bugs 1113095 and 1114114, ``Timezone routines
improperly modify environment''. */
-static char set_time_zone_rule_tz1[] = "TZ=GMT0";
-static char set_time_zone_rule_tz2[] = "TZ=GMT1";
+static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
+static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
+
+#endif
/* Set the local time zone rule to TZSTRING.
This allocates memory into `environ', which it is the caller's
#endif
}
\f
+/* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC
+ (if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a
+ type of object is Lisp_String). INHERIT is passed to
+ INSERT_FROM_STRING_FUNC as the last argument. */
+
+general_insert_function (insert_func, insert_from_string_func,
+ inherit, nargs, args)
+ int (*insert_func)(), (*insert_from_string_func)();
+ int inherit, nargs;
+ register Lisp_Object *args;
+{
+ register int argnum;
+ register Lisp_Object val;
+
+ for (argnum = 0; argnum < nargs; argnum++)
+ {
+ val = args[argnum];
+ retry:
+ if (INTEGERP (val))
+ {
+ char workbuf[4], *str;
+ int len;
+
+ if (!NILP (current_buffer->enable_multibyte_characters))
+ len = CHAR_STRING (XFASTINT (val), workbuf, str);
+ else
+ workbuf[0] = XINT (val), str = workbuf, len = 1;
+ (*insert_func) (str, len);
+ }
+ else if (STRINGP (val))
+ {
+ (*insert_from_string_func) (val, 0, XSTRING (val)->size, inherit);
+ }
+ else
+ {
+ val = wrong_type_argument (Qchar_or_string_p, val);
+ goto retry;
+ }
+ }
+}
+
void
insert1 (arg)
Lisp_Object arg;
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
"Insert the arguments, either strings or characters, at point.\n\
-Point moves forward so that it ends up after the inserted text.\n\
+Point and before-insertion-markers move forward so that it ends up\n\
+ after the inserted text.\n\
Any other markers at the point of insertion remain before the text.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- register int argnum;
- register Lisp_Object tem;
- char str[1];
-
- for (argnum = 0; argnum < nargs; argnum++)
- {
- tem = args[argnum];
- retry:
- if (INTEGERP (tem))
- {
- str[0] = XINT (tem);
- insert (str, 1);
- }
- else if (STRINGP (tem))
- {
- insert_from_string (tem, 0, XSTRING (tem)->size, 0);
- }
- else
- {
- tem = wrong_type_argument (Qchar_or_string_p, tem);
- goto retry;
- }
- }
-
+ general_insert_function (insert, insert_from_string, 0, nargs, args);
return Qnil;
}
DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit,
0, MANY, 0,
"Insert the arguments at point, inheriting properties from adjoining text.\n\
-Point moves forward so that it ends up after the inserted text.\n\
+Point and before-insertion-markers move forward so that it ends up\n\
+ after the inserted text.\n\
Any other markers at the point of insertion remain before the text.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- register int argnum;
- register Lisp_Object tem;
- char str[1];
-
- for (argnum = 0; argnum < nargs; argnum++)
- {
- tem = args[argnum];
- retry:
- if (INTEGERP (tem))
- {
- str[0] = XINT (tem);
- insert_and_inherit (str, 1);
- }
- else if (STRINGP (tem))
- {
- insert_from_string (tem, 0, XSTRING (tem)->size, 1);
- }
- else
- {
- tem = wrong_type_argument (Qchar_or_string_p, tem);
- goto retry;
- }
- }
-
+ general_insert_function (insert_and_inherit, insert_from_string, 1,
+ nargs, args);
return Qnil;
}
DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
"Insert strings or characters at point, relocating markers after the text.\n\
-Point moves forward so that it ends up after the inserted text.\n\
+Point and before-insertion-markers move forward so that it ends up\n\
+ after the inserted text.\n\
Any other markers at the point of insertion also end up after the text.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- register int argnum;
- register Lisp_Object tem;
- char str[1];
-
- for (argnum = 0; argnum < nargs; argnum++)
- {
- tem = args[argnum];
- retry:
- if (INTEGERP (tem))
- {
- str[0] = XINT (tem);
- insert_before_markers (str, 1);
- }
- else if (STRINGP (tem))
- {
- insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 0);
- }
- else
- {
- tem = wrong_type_argument (Qchar_or_string_p, tem);
- goto retry;
- }
- }
-
+ general_insert_function (insert_before_markers,
+ insert_from_string_before_markers, 0,
+ nargs, args);
return Qnil;
}
int nargs;
register Lisp_Object *args;
{
- register int argnum;
- register Lisp_Object tem;
- char str[1];
-
- for (argnum = 0; argnum < nargs; argnum++)
- {
- tem = args[argnum];
- retry:
- if (INTEGERP (tem))
- {
- str[0] = XINT (tem);
- insert_before_markers_and_inherit (str, 1);
- }
- else if (STRINGP (tem))
- {
- insert_from_string_before_markers (tem, 0, XSTRING (tem)->size, 1);
- }
- else
- {
- tem = wrong_type_argument (Qchar_or_string_p, tem);
- goto retry;
- }
- }
-
+ general_insert_function (insert_before_markers_and_inherit,
+ insert_from_string_before_markers, 1,
+ nargs, args);
return Qnil;
}
\f
DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
"Insert COUNT (second arg) copies of CHARACTER (first arg).\n\
-Point and all markers are affected as in the function `insert'.\n\
+Point and before-insertion-markers are affected as in the function `insert'.\n\
Both arguments are required.\n\
The optional third arg INHERIT, if non-nil, says to inherit text properties\n\
from adjoining text, if those properties are sticky.")
register unsigned char *string;
register int strlen;
register int i, n;
+ int len;
+ unsigned char workbuf[4], *str;
CHECK_NUMBER (character, 0);
CHECK_NUMBER (count, 1);
- n = XINT (count);
+ if (!NILP (current_buffer->enable_multibyte_characters))
+ len = CHAR_STRING (XFASTINT (character), workbuf, str);
+ else
+ workbuf[0] = XFASTINT (character), str = workbuf, len = 1;
+ n = XINT (count) * len;
if (n <= 0)
return Qnil;
- strlen = min (n, 256);
+ strlen = min (n, 256 * len);
string = (unsigned char *) alloca (strlen);
for (i = 0; i < strlen; i++)
- string[i] = XFASTINT (character);
+ string[i] = str[i % len];
while (n >= strlen)
{
+ QUIT;
if (!NILP (inherit))
insert_and_inherit (string, strlen);
else
move_gap (start);
result = make_uninit_string (end - start);
- bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);
+ bcopy (POS_ADDR (start), XSTRING (result)->data, end - start);
/* If desired, update and copy the text properties. */
#ifdef USE_TEXT_PROPERTIES
int c2 = *BUF_CHAR_ADDRESS (bp2, begp2 + i);
if (trt)
{
- c1 = trt[c1];
- c2 = trt[c2];
+ c1 = XINT (trt[c1]);
+ c2 = XINT (trt[c2]);
}
if (c1 < c2)
return make_number (- 1 - i);
Ssubst_char_in_region, 4, 5, 0,
"From START to END, replace FROMCHAR with TOCHAR each time it occurs.\n\
If optional arg NOUNDO is non-nil, don't record this change for undo\n\
-and don't mark the buffer as really changed.")
+and don't mark the buffer as really changed.\n\
+Both characters must have the same length of multi-byte form.")
(start, end, fromchar, tochar, noundo)
Lisp_Object start, end, fromchar, tochar, noundo;
{
- register int pos, stop, look;
+ register int pos, stop, i, len;
int changed = 0;
+ unsigned char fromwork[4], *fromstr, towork[4], *tostr, *p;
int count = specpdl_ptr - specpdl;
validate_region (&start, &end);
CHECK_NUMBER (fromchar, 2);
CHECK_NUMBER (tochar, 3);
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ {
+ len = CHAR_STRING (XFASTINT (fromchar), fromwork, fromstr);
+ if (CHAR_STRING (XFASTINT (tochar), towork, tostr) != len)
+ error ("Characters in subst-char-in-region have different byte-lengths");
+ }
+ else
+ {
+ len = 1;
+ fromwork[0] = XFASTINT (fromchar), fromstr = fromwork;
+ towork[0] = XFASTINT (tochar), tostr = towork;
+ }
+
pos = XINT (start);
stop = XINT (end);
- look = XINT (fromchar);
/* If we don't want undo, turn off putting stuff on the list.
That's faster than getting rid of things,
current_buffer->filename = Qnil;
}
- while (pos < stop)
+ if (pos < GPT)
+ stop = min(stop, GPT);
+ p = POS_ADDR (pos);
+ while (1)
{
- if (FETCH_CHAR (pos) == look)
+ if (pos >= stop)
+ {
+ if (pos >= XINT (end)) break;
+ stop = XINT (end);
+ p = POS_ADDR (pos);
+ }
+ if (p[0] == fromstr[0]
+ && (len == 1
+ || (p[1] == fromstr[1]
+ && (len == 2 || (p[2] == fromstr[2]
+ && (len == 3 || p[3] == fromstr[3]))))))
{
if (! changed)
{
- modify_region (current_buffer, XINT (start), stop);
+ modify_region (current_buffer, XINT (start), XINT (end));
if (! NILP (noundo))
{
current_buffer->auto_save_modified++;
}
- changed = 1;
+ changed = 1;
}
if (NILP (noundo))
- record_change (pos, 1);
- FETCH_CHAR (pos) = XINT (tochar);
+ record_change (pos, len);
+ for (i = 0; i < len; i++) *p++ = tostr[i];
+ pos += len;
}
- pos++;
+ else
+ pos++, p++;
}
if (changed)
cnt = 0;
for (; pos < stop; ++pos)
{
- oc = FETCH_CHAR (pos);
+ oc = FETCH_BYTE (pos);
if (oc < size)
{
nc = tt[oc];
if (nc != oc)
{
record_change (pos, 1);
- FETCH_CHAR (pos) = nc;
+ *(POS_ADDR (pos)) = nc;
signal_after_change (pos, 1, 1);
++cnt;
}
else if (FLOATP (args[n]) && *format != 's')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
- args[n] = Ftruncate (args[n]);
+ args[n] = Ftruncate (args[n], Qnil);
total += 30;
/* We have to put an arbitrary limit on minlen
since otherwise it could make alloca fail. */
(c1, c2)
register Lisp_Object c1, c2;
{
- Lisp_Object *downcase = DOWNCASE_TABLE;
CHECK_NUMBER (c1, 0);
CHECK_NUMBER (c2, 1);
- if (!NILP (current_buffer->case_fold_search)
- ? ((XINT (downcase[0xff & XFASTINT (c1)])
- == XINT (downcase[0xff & XFASTINT (c2)]))
- && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff))
- : XINT (c1) == XINT (c2))
+ if (XINT (c1) == XINT (c2)
+ && (NILP (current_buffer->case_fold_search)
+ || DOWNCASE (XFASTINT (c1)) == DOWNCASE (XFASTINT (c2))))
return Qt;
return Qnil;
}
for (marker = BUF_MARKERS (current_buffer); !NILP (marker);
marker = XMARKER (marker)->chain)
{
- mpos = Fmarker_position (marker);
+ mpos = marker_position (marker);
if (mpos >= start1 && mpos < end2)
{
if (mpos < end1)
#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* First region smaller than second. */
#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end1, Qnil, Qnil);
- Fset_text_properties (start2, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end1),
+ Qnil, Qnil);
+ Fset_text_properties (make_number (start2), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
if (len1 > 20000)
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* holds region 2 */
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* holds region 1 */
defsubr (&Sgoto_char);
defsubr (&Sstring_to_char);
defsubr (&Schar_to_string);
+ defsubr (&Ssref);
defsubr (&Sbuffer_substring);
defsubr (&Sbuffer_substring_no_properties);
defsubr (&Sbuffer_string);
defsubr (&Sfollowing_char);
defsubr (&Sprevious_char);
defsubr (&Schar_after);
+ defsubr (&Schar_before);
defsubr (&Sinsert);
defsubr (&Sinsert_before_markers);
defsubr (&Sinsert_and_inherit);