/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001, 2002
+ Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001, 02, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
{
extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */
Lisp_Object m;
-
+
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
Fsignal (Qmark_inactive, Qnil);
-
+
m = Fmarker_position (current_buffer->mark);
if (NILP (m))
error ("The mark is not set now, so there is no region");
-
+
if ((PT < XFASTINT (m)) == beginningp)
m = make_number (PT);
return m;
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. */
-static Lisp_Object
+Lisp_Object
get_pos_property (position, prop, object)
Lisp_Object position, object;
register Lisp_Object prop;
{
- struct window *w = 0;
-
CHECK_NUMBER_COERCE_MARKER (position);
if (NILP (object))
XSETBUFFER (object, current_buffer);
-
- if (WINDOWP (object))
- {
- w = XWINDOW (object);
- object = w->buffer;
- }
- if (BUFFERP (object))
+ else if (WINDOWP (object))
+ object = XWINDOW (object)->buffer;
+
+ if (!BUFFERP (object))
+ /* pos-property only makes sense in buffers right now, since strings
+ have no overlays and no notion of insertion for which stickiness
+ could be obeyed. */
+ return Fget_text_property (position, prop, object);
+ else
{
int posn = XINT (position);
int noverlays;
}
}
}
-
- }
- { /* Now check the text-properties. */
- int stickiness = text_property_stickiness (Qfield, position);
- if (stickiness > 0)
- return Fget_text_property (position, Qfield, Qnil);
- else if (stickiness < 0 && XINT (position) > BEGV)
- return Fget_text_property (make_number (XINT (position) - 1),
- Qfield, Qnil);
- else
- return Qnil;
- }
+ { /* Now check the text-properties. */
+ int stickiness = text_property_stickiness (prop, position, object);
+ if (stickiness > 0)
+ return Fget_text_property (position, prop, object);
+ else if (stickiness < 0
+ && XINT (position) > BUF_BEGV (XBUFFER (object)))
+ return Fget_text_property (make_number (XINT (position) - 1),
+ prop, object);
+ else
+ return Qnil;
+ }
+ }
}
/* Find the field surrounding POS in *BEG and *END. If POS is nil,
/* 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
Any other markers at the point of insertion remain before the text.
If the current buffer is multibyte, unibyte strings are converted
-to multibyte for insertion (see `unibyte-char-to-multibyte').
+to multibyte for insertion (see `string-make-multibyte').
If the current buffer is unibyte, multibyte strings are converted
-to unibyte for insertion.
+to unibyte for insertion (see `string-make-unibyte').
+
+When operating on binary data, it may be necessary to preserve the
+original bytes of a unibyte string when inserting it into a multibyte
+buffer; to accomplish this, apply `string-as-multibyte' to the string
+and insert the result.
usage: (insert &rest ARGS) */)
(nargs, args)
clip_to_bounds (beg->charpos, pt, end->charpos),
clip_to_bounds (beg->bytepos, BUF_PT_BYTE (buf),
end->bytepos));
-
+
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
}
register int n; /* The number of the next arg to substitute */
register int total; /* An estimate of the final length */
char *buf, *p;
- register unsigned char *format, *end;
+ register unsigned char *format, *end, *format_start;
int nchars;
/* Nonzero if the output should be a multibyte string,
which is true if any of the inputs is one. */
must consider such a situation or not. */
int maybe_combine_byte;
unsigned char *this_format;
+ /* Precision for each spec, or -1, a flag value meaning no precision
+ was given in that spec. Element 0, corresonding to the format
+ string itself, will not be used. Element NARGS, corresponding to
+ no argument, *will* be assigned to in the case that a `%' and `.'
+ occur after the final format specifier. */
+ int *precision = (int *) (alloca(nargs * sizeof (int)));
int longest_format;
Lisp_Object val;
+ int arg_intervals = 0;
+
+ /* discarded[I] is 1 if byte I of the format
+ string was not copied into the output.
+ It is 2 if byte I was not the first byte of its character. */
+ char *discarded;
+
+ /* Each element records, for one argument,
+ the start and end bytepos in the output string,
+ and whether the argument is a string with intervals.
+ info[0] is unused. Unused elements have -1 for start. */
struct info
{
- int start, end;
+ int start, end, intervals;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
because of an object that we will pass through prin1,
and in that case, we won't know it here. */
for (n = 0; n < nargs; n++)
- if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
- multibyte = 1;
+ {
+ if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
+ multibyte = 1;
+ /* Piggyback on this loop to initialize precision[N]. */
+ precision[n] = -1;
+ }
CHECK_STRING (args[0]);
+ /* We may have to change "%S" to "%s". */
+ args[0] = Fcopy_sequence (args[0]);
+
+ /* GC should never happen here, so abort if it does. */
+ abort_on_gc++;
/* If we start out planning a unibyte result,
- and later find it has to be multibyte, we jump back to retry. */
+ then discover it has to be multibyte, we jump back to retry.
+ That can only happen from the first large while loop below. */
retry:
format = SDATA (args[0]);
+ format_start = format;
end = format + SBYTES (args[0]);
longest_format = 0;
/* Make room in result for all the non-%-codes in the control string. */
total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]);
+ /* Allocate the info and discarded tables. */
+ {
+ int nbytes = nargs * sizeof *info;
+ int i;
+ info = (struct info *) alloca (nbytes);
+ bzero (info, nbytes);
+ for (i = 0; i <= nargs; i++)
+ info[i].start = -1;
+ discarded = (char *) alloca (SBYTES (args[0]));
+ bzero (discarded, SBYTES (args[0]));
+ }
+
/* Add to TOTAL enough space to hold the converted arguments. */
n = 0;
int thissize = 0;
int actual_width = 0;
unsigned char *this_format_start = format - 1;
- int field_width, precision;
+ int field_width = 0;
/* General format specifications look like
the output should be padded with blanks, iff the output
string is shorter than field-width.
- if precision is specified, it specifies the number of
+ If precision is specified, it specifies the number of
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- precision = field_width = 0;
-
+ /* NOTE the handling of specifiers here differs in some ways
+ from the libc model. There are bugs in this code that lead
+ to incorrect formatting when flags recognized by C but
+ neither parsed nor rejected here are used. Further
+ revisions will be made soon. */
+
+ /* incorrect list of flags to skip; will be fixed */
while (index ("-*# 0", *format))
++format;
field_width = 10 * field_width + *format - '0';
}
+ /* N is not incremented for another few lines below, so refer to
+ element N+1 (which might be precision[NARGS]). */
if (*format == '.')
{
++format;
- for (precision = 0; *format >= '0' && *format <= '9'; ++format)
- precision = 10 * precision + *format - '0';
+ for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format)
+ precision[n+1] = 10 * precision[n+1] + *format - '0';
}
if (format - this_format_start + 1 > longest_format)
goto retry;
}
args[n] = tem;
+ /* If we restart the loop, we should not come here again
+ because args[n] is now a string and calling
+ Fprin1_to_string on it produces superflous double
+ quotes. So, change "%S" to "%s" now. */
+ *format = 's';
goto string;
}
else if (SYMBOLP (args[n]))
string:
if (*format != 's' && *format != 'S')
error ("Format specifier doesn't match argument type");
- thissize = CONVERTED_BYTE_SIZE (multibyte, args[n]);
+ /* In the case (PRECISION[N] > 0), THISSIZE may not need
+ to be as large as is calculated here. Easy check for
+ the case PRECISION = 0. */
+ thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0;
actual_width = lisp_string_width (args[n], -1, NULL, NULL);
}
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
error ("Invalid format operation %%%c", *format);
thissize = 30;
- if (*format == 'c'
- && (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
- || XINT (args[n]) == 0))
+ if (*format == 'c')
{
- if (! multibyte)
+ if (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
+ /* Note: No one can remeber why we have to treat
+ the character 0 as a multibyte character here.
+ But, until it causes a real problem, let's
+ don't change it. */
+ || XINT (args[n]) == 0)
{
- multibyte = 1;
- goto retry;
+ if (! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
+ args[n] = Fchar_to_string (args[n]);
+ thissize = SBYTES (args[n]);
+ }
+ else if (! ASCII_BYTE_P (XINT (args[n])) && multibyte)
+ {
+ args[n]
+ = Fchar_to_string (Funibyte_char_to_multibyte (args[n]));
+ thissize = SBYTES (args[n]);
}
- args[n] = Fchar_to_string (args[n]);
- thissize = SBYTES (args[n]);
}
}
else if (FLOATP (args[n]) && *format != 's')
/* Note that we're using sprintf to print floats,
so we have to take into account what that function
prints. */
- thissize = MAX_10_EXP + 100 + precision;
+ /* Filter out flag value of -1. */
+ thissize = (MAX_10_EXP + 100
+ + (precision[n] > 0 ? precision[n] : 0));
}
else
{
total += thissize + 4;
}
+ abort_on_gc--;
+
/* Now we can no longer jump to retry.
TOTAL and LONGEST_FORMAT are known for certain. */
/* Scan the format and store result in BUF. */
format = SDATA (args[0]);
+ format_start = format;
+ end = format + SBYTES (args[0]);
maybe_combine_byte = 0;
while (format != end)
{
int negative = 0;
unsigned char *this_format_start = format;
+ discarded[format - format_start] = 1;
format++;
/* Process a numeric arg and skip it. */
+ /* NOTE atoi is the wrong thing to use here; will be fixed */
minlen = atoi (format);
if (minlen < 0)
minlen = - minlen, negative = 1;
+ /* NOTE the parsing here is not consistent with the first
+ pass, and neither attempt is what we want to do. Will be
+ fixed. */
while ((*format >= '0' && *format <= '9')
|| *format == '-' || *format == ' ' || *format == '.')
- format++;
+ {
+ discarded[format - format_start] = 1;
+ format++;
+ }
if (*format++ == '%')
{
++n;
+ discarded[format - format_start - 1] = 1;
+ info[n].start = nchars;
+
if (STRINGP (args[n]))
{
- int padding, nbytes, start, end;
- int width = lisp_string_width (args[n], -1, NULL, NULL);
+ /* handle case (precision[n] >= 0) */
+
+ int width, padding;
+ int nbytes, start, end;
+ int nchars_string;
+
+ /* lisp_string_width ignores a precision of 0, but GNU
+ libc functions print 0 characters when the precision
+ is 0. Imitate libc behavior here. Changing
+ lisp_string_width is the right thing, and will be
+ done, but meanwhile we work with it. */
+
+ if (precision[n] == 0)
+ width = nchars_string = nbytes = 0;
+ else if (precision[n] > 0)
+ width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes);
+ else
+ { /* no precision spec given for this argument */
+ width = lisp_string_width (args[n], -1, NULL, NULL);
+ nbytes = SBYTES (args[n]);
+ nchars_string = SCHARS (args[n]);
+ }
/* If spec requires it, pad on right with spaces. */
padding = minlen - width;
}
start = nchars;
-
+ nchars += nchars_string;
+ end = nchars;
+
if (p > buf
&& multibyte
&& !ASCII_BYTE_P (*((unsigned char *) p - 1))
&& STRING_MULTIBYTE (args[n])
&& !CHAR_HEAD_P (SREF (args[n], 0)))
maybe_combine_byte = 1;
- nbytes = copy_text (SDATA (args[n]), p,
- SBYTES (args[n]),
- STRING_MULTIBYTE (args[n]), multibyte);
- p += nbytes;
- nchars += SCHARS (args[n]);
- end = nchars;
+
+ p += copy_text (SDATA (args[n]), p,
+ nbytes,
+ STRING_MULTIBYTE (args[n]), multibyte);
if (negative)
while (padding-- > 0)
/* If this argument has text properties, record where
in the result string it appears. */
if (STRING_INTERVALS (args[n]))
- {
- if (!info)
- {
- int nbytes = nargs * sizeof *info;
- info = (struct info *) alloca (nbytes);
- bzero (info, nbytes);
- }
-
- info[n].start = start;
- info[n].end = end;
- }
+ info[n].intervals = arg_intervals = 1;
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
{
p += this_nchars;
nchars += this_nchars;
}
+
+ info[n].end = nchars;
}
else if (STRING_MULTIBYTE (args[0]))
{
&& !CHAR_HEAD_P (*format))
maybe_combine_byte = 1;
*p++ = *format++;
- while (! CHAR_HEAD_P (*format)) *p++ = *format++;
+ while (! CHAR_HEAD_P (*format))
+ {
+ discarded[format - format_start] = 2;
+ *p++ = *format++;
+ }
nchars++;
}
else if (multibyte)
arguments has text properties, set up text properties of the
result string. */
- if (STRING_INTERVALS (args[0]) || info)
+ if (STRING_INTERVALS (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
if (CONSP (props))
{
- new_len = make_number (SCHARS (val));
- extend_property_ranges (props, len, new_len);
+ int bytepos = 0, position = 0, translated = 0, argn = 1;
+ Lisp_Object list;
+
+ /* Adjust the bounds of each text property
+ to the proper start and end in the output string. */
+ /* We take advantage of the fact that the positions in PROPS
+ are in increasing order, so that we can do (effectively)
+ one scan through the position space of the format string.
+
+ BYTEPOS is the byte position in the format string,
+ POSITION is the untranslated char position in it,
+ TRANSLATED is the translated char position in BUF,
+ and ARGN is the number of the next arg we will come to. */
+ for (list = props; CONSP (list); list = XCDR (list))
+ {
+ Lisp_Object item;
+ int pos;
+
+ item = XCAR (list);
+
+ /* First adjust the property start position. */
+ pos = XINT (XCAR (item));
+
+ /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
+ up to this position. */
+ for (; position < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
+ {
+ position++;
+ if (translated == info[argn].start)
+ {
+ translated += info[argn].end - info[argn].start;
+ argn++;
+ }
+ }
+ }
+
+ XSETCAR (item, make_number (translated));
+
+ /* Likewise adjust the property end position. */
+ pos = XINT (XCAR (XCDR (item)));
+
+ for (; bytepos < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
+ {
+ position++;
+ if (translated == info[argn].start)
+ {
+ translated += info[argn].end - info[argn].start;
+ argn++;
+ }
+ }
+ }
+
+ XSETCAR (XCDR (item), make_number (translated));
+ }
+
add_text_properties_from_list (val, props, make_number (0));
}
/* Add text properties from arguments. */
- if (info)
+ if (arg_intervals)
for (n = 1; n < nargs; ++n)
- if (info[n].end)
+ if (info[n].intervals)
{
len = make_number (SCHARS (args[n]));
new_len = make_number (info[n].end - info[n].start);
return val;
}
-
-/* VARARGS 1 */
Lisp_Object
-#ifdef NO_ARG_ARRAY
-format1 (string1, arg0, arg1, arg2, arg3, arg4)
- EMACS_INT arg0, arg1, arg2, arg3, arg4;
-#else
-format1 (string1)
-#endif
+format2 (string1, arg0, arg1)
char *string1;
+ Lisp_Object arg0, arg1;
{
- char buf[100];
-#ifdef NO_ARG_ARRAY
- EMACS_INT args[5];
- args[0] = arg0;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- doprnt (buf, sizeof buf, string1, (char *)0, 5, (char **) args);
-#else
- doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1);
-#endif
- return build_string (buf);
+ Lisp_Object args[3];
+ args[0] = build_string (string1);
+ args[1] = arg0;
+ args[2] = arg1;
+ return Fformat (3, args);
}
\f
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,