#include <pwd.h>
#endif
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
}
\f
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
- "Convert arg CHAR to a string containing multi-byte form of that character.")
+ "Convert arg CHAR to a string containing that character.")
(character)
Lisp_Object character;
{
CHECK_NUMBER (character, 0);
len = CHAR_STRING (XFASTINT (character), workbuf, str);
- return make_multibyte_string (str, 1, len);
+ return make_string_from_bytes (str, 1, len);
}
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
CHECK_STRING (string, 0);
p = XSTRING (string);
if (p->size)
- XSETFASTINT (val, STRING_CHAR (p->data, p->size));
+ XSETFASTINT (val, STRING_CHAR (p->data, STRING_BYTES (p)));
else
XSETFASTINT (val, 0);
return val;
int pos;
unsigned char *p;
- if (MARKERP (position))
+ if (MARKERP (position)
+ && current_buffer == XMARKER (position)->buffer)
{
pos = marker_position (position);
if (pos < BEGV)
Executes BODY just like `progn'.\n\
The values of point, mark and the current buffer are restored\n\
even in case of abnormal exit (throw or error).\n\
-The state of activation of the mark is also restored.")
+The state of activation of the mark is also restored.\n\
+\n\
+This construct does not save `deactivate-mark', and therefore\n\
+functions that change the buffer will still cause deactivation\n\
+of the mark at the end of the command. To prevent that, bind\n\
+`deactivate-mark' with `let'.")
(args)
Lisp_Object args;
{
return buildmark (ZV, ZV_BYTE);
}
+DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
+ "Return the byte position for character position POSITION.")
+ (position)
+ Lisp_Object position;
+{
+ CHECK_NUMBER_COERCE_MARKER (position, 1);
+ return make_number (CHAR_TO_BYTE (XINT (position)));
+}
+\f
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.\n\
register Lisp_Object val;
if (NILP (pos))
- return make_number (FETCH_CHAR (PT_BYTE));
-
- if (MARKERP (pos))
- pos_byte = marker_byte_position (pos);
+ pos_byte = PT_BYTE;
+ else if (MARKERP (pos))
+ {
+ pos_byte = marker_byte_position (pos);
+ if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
+ return Qnil;
+ }
else
{
CHECK_NUMBER_COERCE_MARKER (pos, 0);
+ if (pos < BEGV || pos >= ZV)
+ return Qnil;
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
- if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
- return Qnil;
-
return make_number (FETCH_CHAR (pos_byte));
}
if (NILP (pos))
pos_byte = PT_BYTE;
else if (MARKERP (pos))
- pos_byte = marker_byte_position (pos);
+ {
+ pos_byte = marker_byte_position (pos);
+
+ if (pos_byte <= BEGV_BYTE || pos_byte > ZV_BYTE)
+ return Qnil;
+ }
else
{
CHECK_NUMBER_COERCE_MARKER (pos, 0);
+ if (pos <= BEGV || pos > ZV)
+ return Qnil;
+
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
- if (pos_byte <= BEGV_BYTE || pos_byte > ZV_BYTE)
- return Qnil;
-
if (!NILP (current_buffer->enable_multibyte_characters))
{
DEC_POS (pos_byte);
error ("Invalid time specification");
/* This is probably enough. */
- size = XSTRING (format_string)->size_byte * 6 + 50;
+ size = STRING_BYTES (XSTRING (format_string)) * 6 + 50;
while (1)
{
{
(*insert_from_string_func) (val, 0, 0,
XSTRING (val)->size,
- XSTRING (val)->size_byte,
+ STRING_BYTES (XSTRING (val)),
inherit);
}
else
int start, end;
int props;
{
- Lisp_Object result, tem, tem1;
int start_byte = CHAR_TO_BYTE (start);
int end_byte = CHAR_TO_BYTE (end);
+ return make_buffer_string_both (start, start_byte, end, end_byte, props);
+}
+
+/* Return a Lisp_String containing the text of the current buffer from
+ START / START_BYTE to END / END_BYTE.
+
+ 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_both (start, start_byte, end, end_byte, props)
+ int start, start_byte, end, end_byte;
+ int props;
+{
+ Lisp_Object result, tem, tem1;
+
if (start < GPT && GPT < end)
move_gap (start);
- result = make_uninit_multibyte_string (end - start, end_byte - start_byte);
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ result = make_uninit_multibyte_string (end - start, end_byte - start_byte);
+ else
+ result = make_uninit_string (end - start);
bcopy (BYTE_POS_ADDR (start_byte), XSTRING (result)->data,
end_byte - start_byte);
(start, end, fromchar, tochar, noundo)
Lisp_Object start, end, fromchar, tochar, noundo;
{
- register int pos, stop, i, len, end_byte;
+ register int pos, pos_byte, stop, i, len, end_byte;
int changed = 0;
unsigned char fromwork[4], *fromstr, towork[4], *tostr, *p;
int count = specpdl_ptr - specpdl;
towork[0] = XFASTINT (tochar), tostr = towork;
}
- pos = CHAR_TO_BYTE (XINT (start));
+ pos = XINT (start);
+ pos_byte = CHAR_TO_BYTE (pos);
stop = CHAR_TO_BYTE (XINT (end));
end_byte = stop;
current_buffer->filename = Qnil;
}
- if (pos < GPT_BYTE)
+ if (pos_byte < GPT_BYTE)
stop = min (stop, GPT_BYTE);
- p = BYTE_POS_ADDR (pos);
while (1)
{
- if (pos >= stop)
+ if (pos_byte >= stop)
{
- if (pos >= end_byte) break;
+ if (pos_byte >= end_byte) break;
stop = end_byte;
- p = BYTE_POS_ADDR (pos);
}
+ p = BYTE_POS_ADDR (pos_byte);
if (p[0] == fromstr[0]
&& (len == 1
|| (p[1] == fromstr[1]
}
if (NILP (noundo))
- record_change (pos, len);
+ record_change (pos, 1);
for (i = 0; i < len; i++) *p++ = tostr[i];
- pos += len;
}
- else
- pos++, p++;
+ INC_BOTH (pos, pos_byte);
}
if (changed)
signal_after_change (XINT (start),
- stop - XINT (start), stop - XINT (start));
+ XINT (end) - XINT (start), XINT (end) - XINT (start));
unbind_to (count, Qnil);
return Qnil;
validate_region (&start, &end);
CHECK_STRING (table, 2);
- size = XSTRING (table)->size_byte;
+ size = STRING_BYTES (XSTRING (table));
tt = XSTRING (table)->data;
pos_byte = CHAR_TO_BYTE (XINT (start));
message_text = (char *)xmalloc (80);
message_length = 80;
}
- if (XSTRING (val)->size > message_length)
+ if (STRING_BYTES (XSTRING (val)) > message_length)
{
- message_length = XSTRING (val)->size_byte;
+ message_length = STRING_BYTES (XSTRING (val));
message_text = (char *)xrealloc (message_text, message_length);
}
- bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size_byte);
- message2 (message_text, XSTRING (val)->size_byte,
+ bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val)));
+ message2 (message_text, STRING_BYTES (XSTRING (val)),
STRING_MULTIBYTE (val));
return val;
}
message_text = (char *)xmalloc (80);
message_length = 80;
}
- if (XSTRING (val)->size_byte > message_length)
+ if (STRING_BYTES (XSTRING (val)) > message_length)
{
- message_length = XSTRING (val)->size_byte;
+ message_length = STRING_BYTES (XSTRING (val));
message_text = (char *)xrealloc (message_text, message_length);
}
- bcopy (XSTRING (val)->data, message_text, XSTRING (val)->size_byte);
- message2 (message_text, XSTRING (val)->size_byte);
+ bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val)));
+ message2 (message_text, STRING_BYTES (XSTRING (val)),
+ STRING_MULTIBYTE (val));
return val;
#endif /* not HAVE_MENUS */
}
#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
(((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
- ? XSTRING (STRING)->size_byte \
- : count_size_as_multibyte (XSTRING (STRING)->data, \
- XSTRING (STRING)->size_byte))
+ ? count_size_as_multibyte (XSTRING (STRING)->data, \
+ STRING_BYTES (XSTRING (STRING))) \
+ : STRING_BYTES (XSTRING (STRING)))
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
"Format a string out of a control-string and arguments.\n\
register Lisp_Object *args;
{
register int n; /* The number of the next arg to substitute */
- register int total = 5; /* An estimate of the final length */
+ register int total; /* An estimate of the final length */
char *buf, *p;
register unsigned char *format, *end;
int length, nchars;
which is true if any of the inputs is one. */
int multibyte = 0;
unsigned char *this_format;
- int longest_format = 0;
+ int longest_format;
+ Lisp_Object val;
extern char *index ();
/* It should not be necessary to GCPRO ARGS, because
the caller in the interpreter should take care of that. */
+ /* Try to determine whether the result should be multibyte.
+ This is not always right; sometimes the result needs to be multibyte
+ 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;
CHECK_STRING (args[0], 0);
+
+ /* If we start out planning a unibyte result,
+ and later find it has to be multibyte, we jump back to retry. */
+ retry:
+
format = XSTRING (args[0])->data;
- end = format + XSTRING (args[0])->size_byte;
+ end = format + STRING_BYTES (XSTRING (args[0]));
+ longest_format = 0;
/* Make room in result for all the non-%-codes in the control string. */
- total += CONVERTED_BYTE_SIZE (multibyte, args[0]);
+ total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]);
/* Add to TOTAL enough space to hold the converted arguments. */
/* For `S', prin1 the argument and then treat like a string. */
register Lisp_Object tem;
tem = Fprin1_to_string (args[n], Qnil);
+ if (STRING_MULTIBYTE (tem) && ! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
args[n] = tem;
goto string;
}
else if (SYMBOLP (args[n]))
{
XSETSTRING (args[n], XSYMBOL (args[n])->name);
+ if (STRING_MULTIBYTE (args[n]) && ! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
goto string;
}
else if (STRINGP (args[n]))
if (*format == 'e' || *format == 'f' || *format == 'g')
args[n] = Ffloat (args[n]);
#endif
- thissize = 30;
+ thissize = 30;
+ if (*format == 'c'
+ && (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
+ || XINT (args[n]) == 0))
+ {
+ if (! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
+ args[n] = Fchar_to_string (args[n]);
+ thissize = STRING_BYTES (XSTRING (args[n]));
+ }
}
#ifdef LISP_FLOAT_TYPE
else if (FLOATP (args[n]) && *format != 's')
/* Anything but a string, convert to a string using princ. */
register Lisp_Object tem;
tem = Fprin1_to_string (args[n], Qt);
+ if (STRING_MULTIBYTE (tem) & ! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
args[n] = tem;
goto string;
}
total += thissize + 4;
}
+ /* Now we can no longer jump to retry.
+ TOTAL and LONGEST_FORMAT are known for certain. */
+
this_format = (unsigned char *) alloca (longest_format + 1);
/* Allocate the space for the result.
if (*format == '%')
{
int minlen;
+ int negative = 0;
unsigned char *this_format_start = format;
format++;
/* Process a numeric arg and skip it. */
minlen = atoi (format);
if (minlen < 0)
- minlen = - minlen;
+ minlen = - minlen, negative = 1;
while ((*format >= '0' && *format <= '9')
|| *format == '-' || *format == ' ' || *format == '.')
if (STRINGP (args[n]))
{
int padding, nbytes;
+ int width = strwidth (XSTRING (args[n])->data,
+ STRING_BYTES (XSTRING (args[n])));
+
+ /* If spec requires it, pad on right with spaces. */
+ padding = minlen - width;
+ if (! negative)
+ while (padding-- > 0)
+ {
+ *p++ = ' ';
+ nchars++;
+ }
nbytes = copy_text (XSTRING (args[n])->data, p,
- XSTRING (args[n])->size_byte,
+ STRING_BYTES (XSTRING (args[n])),
STRING_MULTIBYTE (args[n]), multibyte);
p += nbytes;
nchars += XSTRING (args[n])->size;
- /* If spec requires it, pad on right with spaces. */
- padding = minlen - XSTRING (args[n])->size;
- while (padding-- > 0)
- {
- *p++ = ' ';
- nchars++;
- }
+ if (negative)
+ while (padding-- > 0)
+ {
+ *p++ = ' ';
+ nchars++;
+ }
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
{
format - this_format_start);
this_format[format - this_format_start] = 0;
- sprintf (p, this_format, XINT (args[n]));
+ if (INTEGERP (args[n]))
+ sprintf (p, this_format, XINT (args[n]));
+ else
+ sprintf (p, this_format, XFLOAT (args[n])->data);
this_nchars = strlen (p);
p += this_nchars;
nchars += this_nchars;
}
}
- else if (multibyte && !STRING_MULTIBYTE (args[0]))
+ else if (STRING_MULTIBYTE (args[0]))
+ {
+ /* Copy a whole multibyte character. */
+ *p++ = *format++;
+ while (! CHAR_HEAD_P (*format)) *p++ = *format++;
+ nchars++;
+ }
+ else if (multibyte)
{
/* Convert a single-byte character to multibyte. */
int len = copy_text (format, p, 1, 0, 1);
*p++ = *format++, nchars++;
}
+ val = make_specified_string (buf, nchars, p - buf, multibyte);
+
/* If we allocated BUF with malloc, free it too. */
if (total >= 1000)
xfree (buf);
- return make_multibyte_string (buf, nchars, p - buf);
+ return val;
}
/* VARARGS 1 */
args[2] = arg2;
args[3] = arg3;
args[4] = arg4;
- doprnt (buf, sizeof buf, string1, (char *)0, 5, args);
+ doprnt (buf, sizeof buf, string1, (char *)0, 5, (char **) args);
#else
doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1);
#endif
int start1_byte, start2_byte, len1_byte, len2_byte;
int gap, len1, len_mid, len2;
unsigned char *start1_addr, *start2_addr, *temp;
+ int combined_before_bytes_1, combined_after_bytes_1;
+ int combined_before_bytes_2, combined_after_bytes_2;
+ struct gcpro gcpro1, gcpro2;
#ifdef USE_TEXT_PROPERTIES
INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2;
len2 = end2 - start2;
if (start2 < end1)
- error ("Transposed regions not properly ordered");
+ error ("Transposed regions overlap");
else if (start1 == end1 || start2 == end2)
- error ("Transposed region may not be of length 0");
+ error ("Transposed region has length 0");
/* The possibilities are:
1. Adjacent (contiguous) regions, or separate but equal regions
start2_byte = CHAR_TO_BYTE (start2);
len1_byte = CHAR_TO_BYTE (end1) - start1_byte;
len2_byte = CHAR_TO_BYTE (end2) - start2_byte;
+
+ if (end1 == start2)
+ {
+ combined_before_bytes_2
+ = count_combining_before (BYTE_POS_ADDR (start2_byte),
+ len2_byte, start1, start1_byte);
+ combined_before_bytes_1
+ = count_combining_before (BYTE_POS_ADDR (start1_byte),
+ len1_byte, end2, start2_byte + len2_byte);
+ combined_after_bytes_1
+ = count_combining_after (BYTE_POS_ADDR (start1_byte),
+ len1_byte, end2, start2_byte + len2_byte);
+ combined_after_bytes_2 = 0;
+ }
+ else
+ {
+ combined_before_bytes_2
+ = count_combining_before (BYTE_POS_ADDR (start2_byte),
+ len2_byte, start1, start1_byte);
+ combined_before_bytes_1
+ = count_combining_before (BYTE_POS_ADDR (start1_byte),
+ len1_byte, start2, start2_byte);
+ combined_after_bytes_2
+ = count_combining_after (BYTE_POS_ADDR (start2_byte),
+ len2_byte, end1, start1_byte + len1_byte);
+ combined_after_bytes_1
+ = count_combining_after (BYTE_POS_ADDR (start1_byte),
+ len1_byte, end2, start2_byte + len2_byte);
+ }
+
+ /* If any combining is going to happen, do this the stupid way,
+ because replace handles combining properly. */
+ if (combined_before_bytes_1 || combined_before_bytes_2
+ || combined_after_bytes_1 || combined_after_bytes_2)
+ {
+ Lisp_Object text1, text2;
+
+ text1 = text2 = Qnil;
+ GCPRO2 (text1, text2);
+
+ text1 = make_buffer_string_both (start1, start1_byte,
+ end1, start1_byte + len1_byte, 1);
+ text2 = make_buffer_string_both (start2, start2_byte,
+ end2, start2_byte + len2_byte, 1);
+
+ transpose_markers (start1, end1, start2, end2,
+ start1_byte, start1_byte + len1_byte,
+ start2_byte, start2_byte + len2_byte);
+
+ replace_range (start2, end2, text1, 1, 0, 1);
+ replace_range (start1, end1, text2, 1, 0, 1);
+
+ UNGCPRO;
+ return Qnil;
+ }
/* Hmmm... how about checking to see if the gap is large
enough to use as the temporary storage? That would avoid an
defsubr (&Spoint);
defsubr (&Sregion_beginning);
defsubr (&Sregion_end);
+
+ defsubr (&Sline_beginning_position);
+ defsubr (&Sline_end_position);
+
/* defsubr (&Smark); */
/* defsubr (&Sset_mark); */
defsubr (&Ssave_excursion);
defsubr (&Spoint_min);
defsubr (&Spoint_min_marker);
defsubr (&Spoint_max_marker);
-
- defsubr (&Sline_beginning_position);
- defsubr (&Sline_end_position);
+ defsubr (&Sposition_bytes);
defsubr (&Sbobp);
defsubr (&Seobp);