/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95,96,97,98 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Boston, MA 02111-1307, USA. */
-#include <sys/types.h>
-
#include <config.h>
+#include <sys/types.h>
#ifdef VMS
#include "vms-pwd.h"
#include <pwd.h>
#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "charset.h"
+#include "coding.h"
#include "window.h"
#include "systime.h"
#endif
extern char **environ;
+extern int use_dialog_box;
extern Lisp_Object make_time ();
extern void insert_from_buffer ();
static int tm_diff ();
static void update_buffer_properties ();
-size_t emacs_strftime ();
+size_t emacs_strftimeu ();
void set_time_zone_rule ();
Lisp_Object Vbuffer_access_fontify_functions;
Lisp_Object Fuser_full_name ();
+/* Non-nil means don't stop at field boundary in text motion commands. */
+
+Lisp_Object Vinhibit_field_text_motion;
+
/* Some static data, and a function to initialize it for each run */
Lisp_Object Vsystem_name;
init_editfns ()
{
char *user_name;
- register unsigned char *p, *q, *r;
+ register unsigned char *p;
struct passwd *pw; /* password entry for the current user */
Lisp_Object tem;
}
\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;
{
int len;
- unsigned char workbuf[4], *str;
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
CHECK_NUMBER (character, 0);
- len = CHAR_STRING (XFASTINT (character), workbuf, str);
- return make_multibyte_string (str, 1, len);
+ len = CHAR_STRING (XFASTINT (character), str);
+ 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, STRING_BYTES (p)));
+ {
+ if (STRING_MULTIBYTE (string))
+ XSETFASTINT (val, STRING_CHAR (p->data, STRING_BYTES (p)));
+ else
+ XSETFASTINT (val, p->data[0]);
+ }
else
XSETFASTINT (val, 0);
return val;
register Lisp_Object position;
{
int pos;
- unsigned char *p;
if (MARKERP (position)
&& current_buffer == XMARKER (position)->buffer)
return current_buffer->mark;
}
\f
+/* Return nonzero if POS1 and POS2 have the same value
+ for the text property PROP. */
+
+static int
+text_property_eq (prop, pos1, pos2)
+ Lisp_Object prop;
+ Lisp_Object pos1, pos2;
+{
+ Lisp_Object pval1, pval2;
+
+ pval1 = Fget_text_property (pos1, prop, Qnil);
+ pval2 = Fget_text_property (pos2, prop, Qnil);
+
+ return EQ (pval1, pval2);
+}
+
+/* Return the direction from which the text-property PROP would be
+ inherited by any new text inserted at POS: 1 if it would be
+ inherited from the char after POS, -1 if it would be inherited from
+ the char before POS, and 0 if from neither. */
+
+static int
+text_property_stickiness (prop, pos)
+ Lisp_Object prop;
+ Lisp_Object pos;
+{
+ Lisp_Object front_sticky;
+
+ if (XINT (pos) > BEGV)
+ /* Consider previous character. */
+ {
+ Lisp_Object prev_pos, rear_non_sticky;
+
+ prev_pos = make_number (XINT (pos) - 1);
+ rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, Qnil);
+
+ if (EQ (rear_non_sticky, Qnil)
+ || (CONSP (rear_non_sticky)
+ && !Fmemq (prop, rear_non_sticky)))
+ /* PROP is not rear-non-sticky, and since this takes precedence over
+ any front-stickiness, PROP is inherited from before. */
+ return -1;
+ }
+
+ /* Consider following character. */
+ front_sticky = Fget_text_property (pos, Qfront_sticky, Qnil);
+
+ if (EQ (front_sticky, Qt)
+ || (CONSP (front_sticky)
+ && Fmemq (prop, front_sticky)))
+ /* PROP is inherited from after. */
+ return 1;
+
+ /* PROP is not inherited from either side. */
+ return 0;
+}
+\f
+/* Symbol for the text property used to mark fields. */
+Lisp_Object Qfield;
+
+/* Find the field surrounding POS in *BEG and *END. If POS is nil,
+ the value of point is used instead.
+
+ If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
+ position of a field, then the beginning of the previous field
+ is returned instead of the beginning of POS's field (since the end of
+ a field is actually also the beginning of the next input
+ field, this behavior is sometimes useful).
+
+ Either BEG or END may be 0, in which case the corresponding value
+ is not stored. */
+
+void
+find_field (pos, merge_at_boundary, beg, end)
+ Lisp_Object pos;
+ Lisp_Object merge_at_boundary;
+ int *beg, *end;
+{
+ /* 1 if POS counts as the start of a field. */
+ int at_field_start = 0;
+ /* 1 if POS counts as the end of a field. */
+ int at_field_end = 0;
+
+ if (NILP (pos))
+ XSETFASTINT (pos, PT);
+ else
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+ if (NILP (merge_at_boundary) && XFASTINT (pos) > BEGV)
+ /* See if we need to handle the case where POS is at beginning of a
+ field, which can also be interpreted as the end of the previous
+ field. We decide which one by seeing which field the `field'
+ property sticks to. The case where if MERGE_AT_BOUNDARY is
+ non-nil (see function comment) is actually the more natural one;
+ then we avoid treating the beginning of a field specially. */
+ {
+ /* First see if POS is actually *at* a boundary. */
+ Lisp_Object after_field, before_field;
+
+ after_field = Fget_text_property (pos, Qfield, Qnil);
+ before_field = Fget_text_property (make_number (XINT (pos) - 1),
+ Qfield, Qnil);
+
+ if (! EQ (after_field, before_field))
+ /* We are at a boundary, see which direction is inclusive. */
+ {
+ int stickiness = text_property_stickiness (Qfield, pos);
+
+ if (stickiness > 0)
+ at_field_start = 1;
+ else if (stickiness < 0)
+ at_field_end = 1;
+ else
+ /* STICKINESS == 0 means that any inserted text will get a
+ `field' text-property of nil, so check to see if that
+ matches either of the adjacent characters (this being a
+ kind of "stickiness by default"). */
+ {
+ if (NILP (before_field))
+ at_field_end = 1; /* Sticks to the left. */
+ else if (NILP (after_field))
+ at_field_start = 1; /* Sticks to the right. */
+ }
+ }
+ }
+
+ if (beg)
+ {
+ if (at_field_start)
+ /* POS is at the edge of a field, and we should consider it as
+ the beginning of the following field. */
+ *beg = XFASTINT (pos);
+ else
+ /* Find the previous field boundary. */
+ {
+ Lisp_Object prev;
+ prev = Fprevious_single_property_change (pos, Qfield, Qnil, Qnil);
+ *beg = NILP (prev) ? BEGV : XFASTINT (prev);
+ }
+ }
+
+ if (end)
+ {
+ if (at_field_end)
+ /* POS is at the edge of a field, and we should consider it as
+ the end of the previous field. */
+ *end = XFASTINT (pos);
+ else
+ /* Find the next field boundary. */
+ {
+ Lisp_Object next;
+ next = Fnext_single_property_change (pos, Qfield, Qnil, Qnil);
+ *end = NILP (next) ? ZV : XFASTINT (next);
+ }
+ }
+}
+\f
+DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0,
+ "Delete the field surrounding POS.\n\
+A field is a region of text with the same `field' property.\n\
+If POS is nil, the value of point is used for POS.")
+ (pos)
+ Lisp_Object pos;
+{
+ int beg, end;
+ find_field (pos, Qnil, &beg, &end);
+ if (beg != end)
+ del_range (beg, end);
+ return Qnil;
+}
+
+DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0,
+ "Return the contents of the field surrounding POS as a string.\n\
+A field is a region of text with the same `field' property.\n\
+If POS is nil, the value of point is used for POS.")
+ (pos)
+ Lisp_Object pos;
+{
+ int beg, end;
+ find_field (pos, Qnil, &beg, &end);
+ return make_buffer_string (beg, end, 1);
+}
+
+DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0,
+ "Return the contents of the field around POS, without text-properties.\n\
+A field is a region of text with the same `field' property.\n\
+If POS is nil, the value of point is used for POS.")
+ (pos)
+ Lisp_Object pos;
+{
+ int beg, end;
+ find_field (pos, Qnil, &beg, &end);
+ return make_buffer_string (beg, end, 0);
+}
+
+DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 2, 0,
+ "Return the beginning of the field surrounding POS.\n\
+A field is a region of text with the same `field' property.\n\
+If POS is nil, the value of point is used for POS.\n\
+If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its\n\
+field, then the beginning of the *previous* field is returned.")
+ (pos, escape_from_edge)
+ Lisp_Object pos, escape_from_edge;
+{
+ int beg;
+ find_field (pos, escape_from_edge, &beg, 0);
+ return make_number (beg);
+}
+
+DEFUN ("field-end", Ffield_end, Sfield_end, 0, 2, 0,
+ "Return the end of the field surrounding POS.\n\
+A field is a region of text with the same `field' property.\n\
+If POS is nil, the value of point is used for POS.\n\
+If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,\n\
+then the end of the *following* field is returned.")
+ (pos, escape_from_edge)
+ Lisp_Object pos, escape_from_edge;
+{
+ int end;
+ find_field (pos, escape_from_edge, 0, &end);
+ return make_number (end);
+}
+
+DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 4, 0,
+ "Return the position closest to NEW-POS that is in the same field as OLD-POS.\n\
+A field is a region of text with the same `field' property.\n\
+If NEW-POS is nil, then the current point is used instead, and set to the\n\
+constrained position if that is is different.\n\
+\n\
+If OLD-POS is at the boundary of two fields, then the allowable\n\
+positions for NEW-POS depends on the value of the optional argument\n\
+ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is\n\
+constrained to the field that has the same `field' text-property\n\
+as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE\n\
+is non-nil, NEW-POS is constrained to the union of the two adjacent\n\
+fields.\n\
+\n\
+If the optional argument ONLY-IN-LINE is non-nil and constraining\n\
+NEW-POS would move it to a different line, NEW-POS is returned\n\
+unconstrained. This useful for commands that move by line, like\n\
+\\[next-line] or \\[beginning-of-line], which should generally respect field boundaries\n\
+only in the case where they can still move to the right line.")
+ (new_pos, old_pos, escape_from_edge, only_in_line)
+ Lisp_Object new_pos, old_pos, escape_from_edge, only_in_line;
+{
+ /* If non-zero, then the original point, before re-positioning. */
+ int orig_point = 0;
+
+ if (NILP (new_pos))
+ /* Use the current point, and afterwards, set it. */
+ {
+ orig_point = PT;
+ XSETFASTINT (new_pos, PT);
+ }
+
+ if (!EQ (new_pos, old_pos) && !text_property_eq (Qfield, new_pos, old_pos))
+ /* NEW_POS is not within the same field as OLD_POS; try to
+ move NEW_POS so that it is. */
+ {
+ int fwd;
+ Lisp_Object field_bound;
+
+ CHECK_NUMBER_COERCE_MARKER (new_pos, 0);
+ CHECK_NUMBER_COERCE_MARKER (old_pos, 0);
+
+ fwd = (XFASTINT (new_pos) > XFASTINT (old_pos));
+
+ if (fwd)
+ field_bound = Ffield_end (old_pos, escape_from_edge);
+ else
+ field_bound = Ffield_beginning (old_pos, escape_from_edge);
+
+ if (/* If ONLY_IN_LINE is non-nil, we only constrain NEW_POS if doing
+ so would remain within the same line. */
+ NILP (only_in_line)
+ /* In that case, see if ESCAPE_FROM_EDGE caused FIELD_BOUND
+ to jump to the other side of NEW_POS, which would mean
+ that NEW_POS is already acceptable, and that we don't
+ have to do the line-check. */
+ || ((XFASTINT (field_bound) < XFASTINT (new_pos)) ? !fwd : fwd)
+ /* If not, see if there's no newline intervening between
+ NEW_POS and FIELD_BOUND. */
+ || (find_before_next_newline (XFASTINT (new_pos),
+ XFASTINT (field_bound),
+ fwd ? -1 : 1)
+ == XFASTINT (field_bound)))
+ /* Constrain NEW_POS to FIELD_BOUND. */
+ new_pos = field_bound;
+
+ if (orig_point && XFASTINT (new_pos) != orig_point)
+ /* The NEW_POS argument was originally nil, so automatically set PT. */
+ SET_PT (XFASTINT (new_pos));
+ }
+
+ return new_pos;
+}
+\f
DEFUN ("line-beginning-position", Fline_beginning_position, Sline_beginning_position,
0, 1, 0,
"Return the character position of the first character on the current line.\n\
With argument N not nil or 1, move forward N - 1 lines first.\n\
If scan reaches end of buffer, return that position.\n\
+The scan does not cross a field boundary unless it would move\n\
+beyond there to a different line. And if N is nil or 1,\n\
+and scan starts at a field boundary, the scan stops as soon as it starts.\n\n\
This function does not move point.")
(n)
Lisp_Object n;
orig_byte = PT_BYTE;
Fforward_line (make_number (XINT (n) - 1));
end = PT;
+
SET_PT_BOTH (orig, orig_byte);
- return make_number (end);
+ /* Return END constrained to the current input field. */
+ if (NILP (Vinhibit_field_text_motion))
+ end = Fconstrain_to_field (make_number (end), make_number (orig),
+ XINT (n) != 1 ? Qt : Qnil,
+ Qt);
+ return end;
}
DEFUN ("line-end-position", Fline_end_position, Sline_end_position,
(n)
Lisp_Object n;
{
+ int end_pos;
+ register int orig = PT;
+
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n, 0);
- return make_number (find_before_next_newline
- (PT, 0, XINT (n) - (XINT (n) <= 0)));
+ end_pos = find_before_next_newline (orig, 0, XINT (n) - (XINT (n) <= 0));
+
+ /* Return END_POS constrained to the current input field. */
+ if (NILP (Vinhibit_field_text_motion))
+ end_pos = Fconstrain_to_field (make_number (end_pos), make_number (orig),
+ Qnil, Qt);
+ return end_pos;
}
\f
Lisp_Object
return unbind_to (count, val);
}
\f
-DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 0, 0,
- "Return the number of characters in the current buffer.")
- ()
+DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0,
+ "Return the number of characters in the current buffer.\n\
+If BUFFER, return the number of characters in that buffer instead.")
+ (buffer)
+ Lisp_Object buffer;
{
- Lisp_Object temp;
- XSETFASTINT (temp, Z - BEG);
- return temp;
+ if (NILP (buffer))
+ return make_number (Z - BEG);
+ else
+ {
+ CHECK_BUFFER (buffer, 1);
+ return make_number (BUF_Z (XBUFFER (buffer))
+ - BUF_BEG (XBUFFER (buffer)));
+ }
}
DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0,
return buildmark (ZV, ZV_BYTE);
}
+DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
+ "Return the position of the gap, in the current buffer.\n\
+See also `gap-size'.")
+ ()
+{
+ Lisp_Object temp;
+ XSETFASTINT (temp, GPT);
+ return temp;
+}
+
+DEFUN ("gap-size", Fgap_size, Sgap_size, 0, 0, 0,
+ "Return the size of the current buffer's gap.\n\
+See also `gap-position'.")
+ ()
+{
+ Lisp_Object temp;
+ XSETFASTINT (temp, GAP_SIZE);
+ return temp;
+}
+
DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
- "Return the byte position for character position POSITION.")
+ "Return the byte position for character position POSITION.\n\
+If POSITION is out of range, the value is nil.")
(position)
Lisp_Object position;
{
CHECK_NUMBER_COERCE_MARKER (position, 1);
+ if (XINT (position) < BEG || XINT (position) > Z)
+ return Qnil;
return make_number (CHAR_TO_BYTE (XINT (position)));
}
+
+DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0,
+ "Return the character position for byte position BYTEPOS.\n\
+If BYTEPOS is out of range, the value is nil.")
+ (bytepos)
+ Lisp_Object bytepos;
+{
+ CHECK_NUMBER (bytepos, 1);
+ if (XINT (bytepos) < BEG_BYTE || XINT (bytepos) > Z_BYTE)
+ return Qnil;
+ return make_number (BYTE_TO_CHAR (XINT (bytepos)));
+}
\f
DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
"Return the character following point, as a number.\n\
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.\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.")
+If POS is out of range, the value is nil.")
(pos)
Lisp_Object pos;
{
register int pos_byte;
- register Lisp_Object val;
if (NILP (pos))
- pos_byte = PT_BYTE;
- else if (MARKERP (pos))
+ {
+ pos_byte = PT_BYTE;
+ XSETFASTINT (pos, PT);
+ }
+
+ if (MARKERP (pos))
{
pos_byte = marker_byte_position (pos);
if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
else
{
CHECK_NUMBER_COERCE_MARKER (pos, 0);
- if (pos < BEGV || pos >= ZV)
+ if (XINT (pos) < BEGV || XINT (pos) >= ZV)
return Qnil;
pos_byte = CHAR_TO_BYTE (XINT (pos));
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.")
+If POS is out of range, the value is nil.")
(pos)
Lisp_Object pos;
{
register int pos_byte;
if (NILP (pos))
- pos_byte = PT_BYTE;
- else if (MARKERP (pos))
+ {
+ pos_byte = PT_BYTE;
+ XSETFASTINT (pos, PT);
+ }
+
+ if (MARKERP (pos))
{
pos_byte = marker_byte_position (pos);
{
CHECK_NUMBER_COERCE_MARKER (pos, 0);
- if (pos <= BEGV || pos > ZV)
+ if (XINT (pos) <= BEGV || XINT (pos) > ZV)
return Qnil;
pos_byte = CHAR_TO_BYTE (XINT (pos));
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 the full name corresponding to Emacs's userid is not known,\n\
+return \"unknown\".\n\
+\n\
If optional argument UID is an integer, return the full name of the user\n\
-with that uid, or \"unknown\" if there is no such user.\n\
+with that uid, or nil 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.")
+name, or nil if there is no such user.")
(uid)
Lisp_Object uid;
{
}
}
+/* Write information into buffer S of size MAXSIZE, according to the
+ FORMAT of length FORMAT_LEN, using time information taken from *TP.
+ Default to Universal Time if UT is nonzero, local time otherwise.
+ Return the number of bytes written, not including the terminating
+ '\0'. If S is NULL, nothing will be written anywhere; so to
+ determine how many bytes would be written, use NULL for S and
+ ((size_t) -1) for MAXSIZE.
+
+ This function behaves like emacs_strftimeu, except it allows null
+ bytes in FORMAT. */
+static size_t
+emacs_memftimeu (s, maxsize, format, format_len, tp, ut)
+ char *s;
+ size_t maxsize;
+ const char *format;
+ size_t format_len;
+ const struct tm *tp;
+ int ut;
+{
+ size_t total = 0;
+
+ /* Loop through all the null-terminated strings in the format
+ argument. Normally there's just one null-terminated string, but
+ there can be arbitrarily many, concatenated together, if the
+ format contains '\0' bytes. emacs_strftimeu stops at the first
+ '\0' byte so we must invoke it separately for each such string. */
+ for (;;)
+ {
+ size_t len;
+ size_t result;
+
+ if (s)
+ s[0] = '\1';
+
+ result = emacs_strftimeu (s, maxsize, format, tp, ut);
+
+ if (s)
+ {
+ if (result == 0 && s[0] != '\0')
+ return 0;
+ s += result + 1;
+ }
+
+ maxsize -= result + 1;
+ total += result;
+ len = strlen (format);
+ if (len == format_len)
+ return total;
+ total++;
+ format += len + 1;
+ format_len -= len + 1;
+ }
+}
+
/*
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_t value;
int size;
+ struct tm *tm;
+ int ut = ! NILP (universal);
CHECK_STRING (format_string, 1);
if (! lisp_time_argument (time, &value))
error ("Invalid time specification");
+ format_string = code_convert_string_norecord (format_string,
+ Vlocale_coding_system, 1);
+
/* This is probably enough. */
size = STRING_BYTES (XSTRING (format_string)) * 6 + 50;
+ tm = ut ? gmtime (&value) : localtime (&value);
+ if (! tm)
+ error ("Specified time is not representable");
+
+ synchronize_system_time_locale ();
+
while (1)
{
char *buf = (char *) alloca (size + 1);
int result;
buf[0] = '\1';
- result = emacs_strftime (buf, size, XSTRING (format_string)->data,
- (NILP (universal) ? localtime (&value)
- : gmtime (&value)));
+ result = emacs_memftimeu (buf, size, XSTRING (format_string)->data,
+ STRING_BYTES (XSTRING (format_string)),
+ tm, ut);
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
- return build_string (buf);
+ return code_convert_string_norecord (make_string (buf, result),
+ Vlocale_coding_system, 0);
/* If buffer was too small, make it bigger and try again. */
- result = emacs_strftime (NULL, 0x7fffffff, XSTRING (format_string)->data,
- (NILP (universal) ? localtime (&value)
- : gmtime (&value)));
+ result = emacs_memftimeu (NULL, (size_t) -1,
+ XSTRING (format_string)->data,
+ STRING_BYTES (XSTRING (format_string)),
+ tm, ut);
size = result + 1;
}
}
error ("Invalid time specification");
decoded_time = localtime (&time_spec);
+ if (! decoded_time)
+ error ("Specified time is not representable");
XSETFASTINT (list_args[0], decoded_time->tm_sec);
XSETFASTINT (list_args[1], decoded_time->tm_min);
XSETFASTINT (list_args[2], decoded_time->tm_hour);
{
time_t value;
struct tm *t;
+ struct tm gmt;
if (lisp_time_argument (specified_time, &value)
- && (t = gmtime (&value)) != 0)
+ && (t = gmtime (&value)) != 0
+ && (gmt = *t, t = localtime (&value)) != 0)
{
- struct tm gmt;
- int offset;
- char *s, buf[6];
-
- gmt = *t; /* Make a copy, in case localtime modifies *t. */
- t = localtime (&value);
- offset = tm_diff (t, &gmt);
- s = 0;
+ int offset = tm_diff (t, &gmt);
+ char *s = 0;
+ char buf[6];
#ifdef HAVE_TM_ZONE
if (t->tm_zone)
s = (char *)t->tm_zone;
retry:
if (INTEGERP (val))
{
- unsigned char workbuf[4], *str;
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
if (!NILP (current_buffer->enable_multibyte_characters))
- len = CHAR_STRING (XFASTINT (val), workbuf, str);
+ len = CHAR_STRING (XFASTINT (val), str);
else
- workbuf[0] = XINT (val), str = workbuf, len = 1;
+ {
+ str[0] = (SINGLE_BYTE_CHAR_P (XINT (val))
+ ? XINT (val)
+ : multibyte_char_to_unibyte (XINT (val), Qnil));
+ len = 1;
+ }
(*insert_func) (str, len);
}
else if (STRINGP (val))
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
"Insert the arguments, either strings or characters, at point.\n\
-Point and before-insertion-markers move forward so that it ends up\n\
+Point and before-insertion markers move forward to end up\n\
after the inserted text.\n\
-Any other markers at the point of insertion remain before the text.")
+Any other markers at the point of insertion remain before the text.\n\
+\n\
+If the current buffer is multibyte, unibyte strings are converted\n\
+to multibyte for insertion (see `unibyte-char-to-multibyte').\n\
+If the current buffer is unibyte, multibyte strings are converted\n\
+to unibyte for insertion.")
(nargs, args)
int nargs;
register Lisp_Object *args;
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 and before-insertion-markers move forward so that it ends up\n\
+Point and before-insertion markers move forward to end up\n\
after the inserted text.\n\
-Any other markers at the point of insertion remain before the text.")
+Any other markers at the point of insertion remain before the text.\n\
+\n\
+If the current buffer is multibyte, unibyte strings are converted\n\
+to multibyte for insertion (see `unibyte-char-to-multibyte').\n\
+If the current buffer is unibyte, multibyte strings are converted\n\
+to unibyte for insertion.")
(nargs, args)
int nargs;
register Lisp_Object *args;
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 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.")
+Point and markers move forward to end up after the inserted text.\n\
+\n\
+If the current buffer is multibyte, unibyte strings are converted\n\
+to multibyte for insertion (see `unibyte-char-to-multibyte').\n\
+If the current buffer is unibyte, multibyte strings are converted\n\
+to unibyte for insertion.")
(nargs, args)
int nargs;
register Lisp_Object *args;
DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers,
Sinsert_and_inherit_before_markers, 0, MANY, 0,
"Insert text at point, relocating markers and inheriting properties.\n\
-Point moves forward so that it ends up after the inserted text.\n\
-Any other markers at the point of insertion also end up after the text.")
+Point and markers move forward to end up after the inserted text.\n\
+\n\
+If the current buffer is multibyte, unibyte strings are converted\n\
+to multibyte for insertion (see `unibyte-char-to-multibyte').\n\
+If the current buffer is unibyte, multibyte strings are converted\n\
+to unibyte for insertion.")
(nargs, args)
int nargs;
register Lisp_Object *args;
\f
DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
"Insert COUNT (second arg) copies of CHARACTER (first arg).\n\
-Point and before-insertion-markers are affected as in the function `insert'.\n\
Both arguments are required.\n\
+Point, and before-insertion markers, are relocated as in the function `insert'.\n\
The optional third arg INHERIT, if non-nil, says to inherit text properties\n\
from adjoining text, if those properties are sticky.")
(character, count, inherit)
register int strlen;
register int i, n;
int len;
- unsigned char workbuf[4], *str;
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
CHECK_NUMBER (character, 0);
CHECK_NUMBER (count, 1);
if (!NILP (current_buffer->enable_multibyte_characters))
- len = CHAR_STRING (XFASTINT (character), workbuf, str);
+ len = CHAR_STRING (XFASTINT (character), str);
else
- workbuf[0] = XFASTINT (character), str = workbuf, len = 1;
+ str[0] = XFASTINT (character), len = 1;
n = XINT (count) * len;
if (n <= 0)
return Qnil;
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);
/* If desired, update and copy the text properties. */
-#ifdef USE_TEXT_PROPERTIES
if (props)
{
update_buffer_properties (start, end);
copy_intervals_to_string (result, current_buffer, start,
end - start);
}
-#endif
return result;
}
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))
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\
-they can be in either order.")
+they can be in either order.\n\
+The string returned is multibyte if the buffer is multibyte.")
(start, end)
Lisp_Object start, 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.")
+of the buffer. If in a mini-buffer, don't include the prompt in the\n\
+string returned.")
()
{
return make_buffer_string (BEGV, ZV, 1);
(buffer1, start1, end1, buffer2, start2, end2)
Lisp_Object buffer1, start1, end1, buffer2, start2, end2;
{
- register int begp1, endp1, begp2, endp2, temp, len1, len2, length, i;
+ register int begp1, endp1, begp2, endp2, temp;
register struct buffer *bp1, *bp2;
register Lisp_Object *trt
= (!NILP (current_buffer->case_fold_search)
? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0);
int chars = 0;
- int beg1_byte, beg2_byte;
+ int i1, i2, i1_byte, i2_byte;
/* Find the first buffer and its substring. */
&& endp2 <= BUF_ZV (bp2)))
args_out_of_range (start2, end2);
- beg1_byte = buf_charpos_to_bytepos (bp1, begp1);
- beg2_byte = buf_charpos_to_bytepos (bp2, begp2);
- len1 = buf_charpos_to_bytepos (bp1, endp1) - begp1;
- len2 = buf_charpos_to_bytepos (bp2, endp2) - begp2;
- length = len1;
- if (len2 < length)
- length = len2;
+ i1 = begp1;
+ i2 = begp2;
+ i1_byte = buf_charpos_to_bytepos (bp1, i1);
+ i2_byte = buf_charpos_to_bytepos (bp2, i2);
- for (i = 0; i < length; i++)
+ while (i1 < endp1 && i2 < endp2)
{
- unsigned char *p1 = BUF_BYTE_ADDRESS (bp1, beg1_byte + i);
- int c1 = *p1;
- int c2 = *BUF_BYTE_ADDRESS (bp2, beg2_byte + i);
+ /* When we find a mismatch, we must compare the
+ characters, not just the bytes. */
+ int c1, c2;
- /* If a character begins here,
- count the previous character now. */
- if (i > 0
- && (NILP (current_buffer->enable_multibyte_characters)
- || CHAR_HEAD_P (*p1)))
- chars++;
+ if (! NILP (bp1->enable_multibyte_characters))
+ {
+ c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
+ BUF_INC_POS (bp1, i1_byte);
+ i1++;
+ }
+ else
+ {
+ c1 = BUF_FETCH_BYTE (bp1, i1);
+ c1 = unibyte_char_to_multibyte (c1);
+ i1++;
+ }
+
+ if (! NILP (bp2->enable_multibyte_characters))
+ {
+ c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte);
+ BUF_INC_POS (bp2, i2_byte);
+ i2++;
+ }
+ else
+ {
+ c2 = BUF_FETCH_BYTE (bp2, i2);
+ c2 = unibyte_char_to_multibyte (c2);
+ i2++;
+ }
if (trt)
{
return make_number (- 1 - chars);
if (c1 > c2)
return make_number (chars + 1);
+
+ chars++;
}
/* The strings match as far as they go.
If one is shorter, that one is less. */
- if (length < len1)
+ if (chars < endp1 - begp1)
return make_number (chars + 1);
- else if (length < len2)
+ else if (chars < endp2 - begp2)
return make_number (- chars - 1);
/* Same length too => they are equal. */
{
register int pos, pos_byte, stop, i, len, end_byte;
int changed = 0;
- unsigned char fromwork[4], *fromstr, towork[4], *tostr, *p;
+ unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
+ unsigned char *p;
int count = specpdl_ptr - specpdl;
+#define COMBINING_NO 0
+#define COMBINING_BEFORE 1
+#define COMBINING_AFTER 2
+#define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
+ int maybe_byte_combining = COMBINING_NO;
+ int last_changed;
validate_region (&start, &end);
CHECK_NUMBER (fromchar, 2);
if (! NILP (current_buffer->enable_multibyte_characters))
{
- len = CHAR_STRING (XFASTINT (fromchar), fromwork, fromstr);
- if (CHAR_STRING (XFASTINT (tochar), towork, tostr) != len)
+ len = CHAR_STRING (XFASTINT (fromchar), fromstr);
+ if (CHAR_STRING (XFASTINT (tochar), tostr) != len)
error ("Characters in subst-char-in-region have different byte-lengths");
+ if (!ASCII_BYTE_P (*tostr))
+ {
+ /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
+ complete multibyte character, it may be combined with the
+ after bytes. If it is in the range 0xA0..0xFF, it may be
+ combined with the before and after bytes. */
+ if (!CHAR_HEAD_P (*tostr))
+ maybe_byte_combining = COMBINING_BOTH;
+ else if (BYTES_BY_CHAR_HEAD (*tostr) > len)
+ maybe_byte_combining = COMBINING_AFTER;
+ }
}
else
{
len = 1;
- fromwork[0] = XFASTINT (fromchar), fromstr = fromwork;
- towork[0] = XFASTINT (tochar), tostr = towork;
+ fromstr[0] = XFASTINT (fromchar);
+ tostr[0] = XFASTINT (tochar);
}
pos = XINT (start);
stop = min (stop, GPT_BYTE);
while (1)
{
+ int pos_byte_next = pos_byte;
+
if (pos_byte >= stop)
{
if (pos_byte >= end_byte) break;
stop = end_byte;
}
p = BYTE_POS_ADDR (pos_byte);
- if (p[0] == fromstr[0]
+ INC_POS (pos_byte_next);
+ if (pos_byte_next - pos_byte == len
+ && p[0] == fromstr[0]
&& (len == 1
|| (p[1] == fromstr[1]
&& (len == 2 || (p[2] == fromstr[2]
{
if (! changed)
{
- modify_region (current_buffer, XINT (start), XINT (end));
+ changed = pos;
+ modify_region (current_buffer, changed, XINT (end));
if (! NILP (noundo))
{
if (MODIFF - 1 == current_buffer->auto_save_modified)
current_buffer->auto_save_modified++;
}
-
- changed = 1;
}
- if (NILP (noundo))
- record_change (pos, 1);
- for (i = 0; i < len; i++) *p++ = tostr[i];
+ /* Take care of the case where the new character
+ combines with neighboring bytes. */
+ if (maybe_byte_combining
+ && (maybe_byte_combining == COMBINING_AFTER
+ ? (pos_byte_next < Z_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next)))
+ : ((pos_byte_next < Z_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (pos_byte_next)))
+ || (pos_byte > BEG_BYTE
+ && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte - 1))))))
+ {
+ Lisp_Object tem, string;
+
+ struct gcpro gcpro1;
+
+ tem = current_buffer->undo_list;
+ GCPRO1 (tem);
+
+ /* Make a multibyte string containing this single character. */
+ string = make_multibyte_string (tostr, 1, len);
+ /* replace_range is less efficient, because it moves the gap,
+ but it handles combining correctly. */
+ replace_range (pos, pos + 1, string,
+ 0, 0, 1);
+ pos_byte_next = CHAR_TO_BYTE (pos);
+ if (pos_byte_next > pos_byte)
+ /* Before combining happened. We should not increment
+ POS. So, to cancel the later increment of POS,
+ decrease it now. */
+ pos--;
+ else
+ INC_POS (pos_byte_next);
+
+ if (! NILP (noundo))
+ current_buffer->undo_list = tem;
+
+ UNGCPRO;
+ }
+ else
+ {
+ if (NILP (noundo))
+ record_change (pos, 1);
+ for (i = 0; i < len; i++) *p++ = tostr[i];
+ }
+ last_changed = pos + 1;
}
- INC_BOTH (pos, pos_byte);
+ pos_byte = pos_byte_next;
+ pos++;
}
if (changed)
- signal_after_change (XINT (start),
- XINT (end) - XINT (start), XINT (end) - XINT (start));
+ {
+ signal_after_change (changed,
+ last_changed - changed, last_changed - changed);
+ update_compositions (changed, last_changed, CHECK_ALL);
+ }
unbind_to (count, Qnil);
return Qnil;
int cnt; /* Number of changes made. */
int size; /* Size of translate table. */
int pos;
+ int multibyte = !NILP (current_buffer->enable_multibyte_characters);
validate_region (&start, &end);
CHECK_STRING (table, 2);
register unsigned char *p = BYTE_POS_ADDR (pos_byte);
int len;
int oc;
+ int pos_byte_next;
- oc = STRING_CHAR_AND_LENGTH (p, stop - pos_byte, len);
+ if (multibyte)
+ oc = STRING_CHAR_AND_LENGTH (p, stop - pos_byte, len);
+ else
+ oc = *p, len = 1;
+ pos_byte_next = pos_byte + len;
if (oc < size && len == 1)
{
nc = tt[oc];
if (nc != oc)
{
- record_change (pos, 1);
- *p = nc;
- signal_after_change (pos, 1, 1);
+ /* Take care of the case where the new character
+ combines with neighboring bytes. */
+ if (!ASCII_BYTE_P (nc)
+ && (CHAR_HEAD_P (nc)
+ ? ! CHAR_HEAD_P (FETCH_BYTE (pos_byte + 1))
+ : (pos_byte > BEG_BYTE
+ && ! ASCII_BYTE_P (FETCH_BYTE (pos_byte - 1)))))
+ {
+ Lisp_Object string;
+
+ string = make_multibyte_string (tt + oc, 1, 1);
+ /* This is less efficient, because it moves the gap,
+ but it handles combining correctly. */
+ replace_range (pos, pos + 1, string,
+ 1, 0, 1);
+ pos_byte_next = CHAR_TO_BYTE (pos);
+ if (pos_byte_next > pos_byte)
+ /* Before combining happened. We should not
+ increment POS. So, to cancel the later
+ increment of POS, we decrease it now. */
+ pos--;
+ else
+ INC_POS (pos_byte_next);
+ }
+ else
+ {
+ record_change (pos, 1);
+ *p = nc;
+ signal_after_change (pos, 1, 1);
+ update_compositions (pos, pos + 1, CHECK_BORDER);
+ }
++cnt;
}
}
- pos_byte += len;
+ pos_byte = pos_byte_next;
pos++;
}
del_range (XINT (start), XINT (end));
return Qnil;
}
+
+DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
+ Sdelete_and_extract_region, 2, 2, 0,
+ "Delete the text between START and END and return it.")
+ (start, end)
+ Lisp_Object start, end;
+{
+ validate_region (&start, &end);
+ return del_range_1 (XINT (start), XINT (end), 1, 1);
+}
\f
DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
"Remove restrictions (narrowing) from current buffer.\n\
register Lisp_Object tem;
int obegv, ozv;
- buf = XBUFFER (XCONS (data)->car);
+ buf = XBUFFER (XCAR (data));
- data = XCONS (data)->cdr;
+ data = XCDR (data);
- tem = XCONS (data)->car;
+ tem = XCAR (data);
newhead = XINT (tem);
- tem = XCONS (data)->cdr;
+ tem = XCDR (data);
newtail = XINT (tem);
if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
{
\n\
`save-restriction' can get confused if, within the BODY, you widen\n\
and then make changes outside the area within the saved restrictions.\n\
+See Info node `(elisp)Narrowing' for details and an appropriate technique.\n\
\n\
Note: if you are using both `save-excursion' and `save-restriction',\n\
use `save-excursion' outermost:\n\
return unbind_to (count, val);
}
\f
+#ifndef HAVE_MENUS
+
/* Buffer for the most recent text displayed by Fmessage. */
static char *message_text;
/* Allocated length of that buffer. */
static int message_length;
+#endif /* not HAVE_MENUS */
+
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
"Print a one-line message at the bottom of the screen.\n\
The first argument is a format control string, and the rest are data\n\
{
register Lisp_Object val;
val = Fformat (nargs, args);
- /* Copy the data so that it won't move when we GC. */
- if (! message_text)
- {
- message_text = (char *)xmalloc (80);
- message_length = 80;
- }
- if (STRING_BYTES (XSTRING (val)) > message_length)
- {
- message_length = STRING_BYTES (XSTRING (val));
- message_text = (char *)xrealloc (message_text, message_length);
- }
- bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val)));
- message2 (message_text, STRING_BYTES (XSTRING (val)),
- STRING_MULTIBYTE (val));
+ message3 (val, STRING_BYTES (XSTRING (val)), STRING_MULTIBYTE (val));
return val;
}
}
message_text = (char *)xrealloc (message_text, message_length);
}
bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val)));
- message2 (message_text, STRING_BYTES (XSTRING (val)));
+ message2 (message_text, STRING_BYTES (XSTRING (val)),
+ STRING_MULTIBYTE (val));
return val;
#endif /* not HAVE_MENUS */
}
Lisp_Object *args;
{
#ifdef HAVE_MENUS
- if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && NILP (use_dialog_box))
return Fmessage_box (nargs, args);
#endif
return Fmessage (nargs, args);
"Return the string currently displayed in the echo area, or nil if none.")
()
{
- return (echo_area_glyphs
- ? make_string (echo_area_glyphs, echo_area_glyphs_length)
- : Qnil);
+ return current_message ();
+}
+
+
+DEFUN ("propertize", Fpropertize, Spropertize, 3, MANY, 0,
+ "Return a copy of STRING with text properties added.\n\
+First argument is the string to copy.\n\
+Remaining arguments are sequences of PROPERTY VALUE pairs for text\n\
+properties to add to the result ")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object properties, string;
+ struct gcpro gcpro1, gcpro2;
+ int i;
+
+ /* Number of args must be odd. */
+ if ((nargs & 1) == 0 || nargs < 3)
+ error ("Wrong number of arguments");
+
+ properties = string = Qnil;
+ GCPRO2 (properties, string);
+
+ /* First argument must be a string. */
+ CHECK_STRING (args[0], 0);
+ string = Fcopy_sequence (args[0]);
+
+ for (i = 1; i < nargs; i += 2)
+ {
+ CHECK_SYMBOL (args[i], i);
+ properties = Fcons (args[i], Fcons (args[i + 1], properties));
+ }
+
+ Fadd_text_properties (make_number (0),
+ make_number (XSTRING (string)->size),
+ properties, string);
+ RETURN_UNGCPRO (string);
}
+
/* Number of bytes that STRING will occupy when put into the result.
MULTIBYTE is nonzero if the result should be multibyte. */
%g means print a number in exponential notation\n\
or decimal-point notation, whichever uses fewer characters.\n\
%c means print a number as a single character.\n\
-%S means print any object as an s-expression (using prin1).\n\
+%S means print any object as an s-expression (using `prin1').\n\
The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.\n\
Use %% to put a single % into the output.")
(nargs, args)
register int total; /* An estimate of the final length */
char *buf, *p;
register unsigned char *format, *end;
- int length, nchars;
+ int nchars;
/* Nonzero if the output should be a multibyte string,
which is true if any of the inputs is one. */
int multibyte = 0;
+ /* When we make a multibyte string, we must pay attention to the
+ byte combining problem, i.e., a byte may be combined with a
+ multibyte charcter of the previous string. This flag tells if we
+ must consider such a situation or not. */
+ int maybe_combine_byte;
unsigned char *this_format;
int longest_format;
Lisp_Object val;
+ struct info
+ {
+ int start, end;
+ } *info = 0;
extern char *index ();
if (format - this_format_start + 1 > longest_format)
longest_format = format - this_format_start + 1;
+ if (format == end)
+ error ("Format string ends in middle of format specifier");
if (*format == '%')
format++;
else if (++n >= nargs)
{
string:
if (*format != 's' && *format != 'S')
- error ("format specifier doesn't match argument type");
+ error ("Format specifier doesn't match argument type");
thissize = CONVERTED_BYTE_SIZE (multibyte, args[n]);
}
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
be a double. */
if (*format == 'e' || *format == 'f' || *format == 'g')
args[n] = Ffloat (args[n]);
+ else
#endif
+ if (*format != 'd' && *format != 'o' && *format != 'x'
+ && *format != 'i' && *format != 'X' && *format != 'c')
+ error ("Invalid format operation %%%c", *format);
+
thissize = 30;
if (*format == 'c'
&& (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
args[n] = Ftruncate (args[n], Qnil);
- thissize = 60;
+ thissize = 200;
}
#endif
else
/* Allocate the space for the result.
Note that TOTAL is an overestimate. */
if (total < 1000)
- buf = (unsigned char *) alloca (total + 1);
+ buf = (char *) alloca (total + 1);
else
- buf = (unsigned char *) xmalloc (total + 1);
+ buf = (char *) xmalloc (total + 1);
p = buf;
nchars = 0;
/* Scan the format and store result in BUF. */
format = XSTRING (args[0])->data;
+ maybe_combine_byte = 0;
while (format != end)
{
if (*format == '%')
int padding, nbytes;
int width = strwidth (XSTRING (args[n])->data,
STRING_BYTES (XSTRING (args[n])));
+ int start = nchars;
/* If spec requires it, pad on right with spaces. */
padding = minlen - width;
nchars++;
}
+ if (p > buf
+ && multibyte
+ && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && STRING_MULTIBYTE (args[n])
+ && !CHAR_HEAD_P (XSTRING (args[n])->data[0]))
+ maybe_combine_byte = 1;
nbytes = copy_text (XSTRING (args[n])->data, p,
STRING_BYTES (XSTRING (args[n])),
STRING_MULTIBYTE (args[n]), multibyte);
*p++ = ' ';
nchars++;
}
+
+ /* If this argument has text properties, record where
+ in the result string it appears. */
+ if (XSTRING (args[n])->intervals)
+ {
+ if (!info)
+ {
+ int nbytes = nargs * sizeof *info;
+ info = (struct info *) alloca (nbytes);
+ bzero (info, nbytes);
+ }
+
+ info[n].start = start;
+ info[n].end = nchars;
+ }
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
{
if (INTEGERP (args[n]))
sprintf (p, this_format, XINT (args[n]));
else
- sprintf (p, this_format, XFLOAT (args[n])->data);
+ sprintf (p, this_format, XFLOAT_DATA (args[n]));
+ if (p > buf
+ && multibyte
+ && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && !CHAR_HEAD_P (*((unsigned char *) p)))
+ maybe_combine_byte = 1;
this_nchars = strlen (p);
p += this_nchars;
nchars += this_nchars;
else if (STRING_MULTIBYTE (args[0]))
{
/* Copy a whole multibyte character. */
+ if (p > buf
+ && multibyte
+ && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && !CHAR_HEAD_P (*format))
+ maybe_combine_byte = 1;
*p++ = *format++;
while (! CHAR_HEAD_P (*format)) *p++ = *format++;
nchars++;
*p++ = *format++, nchars++;
}
- val = make_multibyte_string (buf, nchars, p - buf);
+ if (maybe_combine_byte)
+ nchars = multibyte_chars_in_text (buf, p - buf);
+ val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If we allocated BUF with malloc, free it too. */
if (total >= 1000)
xfree (buf);
+ /* If the format string has text properties, or any of the string
+ arguments has text properties, set up text properties of the
+ result string. */
+
+ if (XSTRING (args[0])->intervals || info)
+ {
+ Lisp_Object len, new_len, props;
+ struct gcpro gcpro1;
+
+ /* Add text properties from the format string. */
+ len = make_number (XSTRING (args[0])->size);
+ props = text_property_list (args[0], make_number (0), len, Qnil);
+ GCPRO1 (props);
+
+ if (CONSP (props))
+ {
+ new_len = make_number (XSTRING (val)->size);
+ extend_property_ranges (props, len, new_len);
+ add_text_properties_from_list (val, props, make_number (0));
+ }
+
+ /* Add text properties from arguments. */
+ if (info)
+ for (n = 1; n < nargs; ++n)
+ if (info[n].end)
+ {
+ len = make_number (XSTRING (args[n])->size);
+ new_len = make_number (info[n].end - info[n].start);
+ props = text_property_list (args[n], make_number (0), len, Qnil);
+ extend_property_ranges (props, len, new_len);
+ add_text_properties_from_list (val, props,
+ make_number (info[n].start));
+ }
+
+ UNGCPRO;
+ }
+
return val;
}
+
/* VARARGS 1 */
Lisp_Object
#ifdef NO_ARG_ARRAY
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;
cur_intv = BUF_INTERVALS (current_buffer);
-#endif /* USE_TEXT_PROPERTIES */
validate_region (&startr1, &endr1);
validate_region (&startr2, &endr2);
start1_byte, start1_byte + len1_byte,
start2_byte, start2_byte + len2_byte);
- replace_range (text1, start2, end2, 1, 0, 1);
- replace_range (text2, start1, end1, 1, 0, 1);
+ replace_range (start2, end2, text1, 1, 0, 0);
+ replace_range (start1, end1, text2, 1, 0, 0);
UNGCPRO;
return Qnil;
modify_region (current_buffer, start1, end2);
record_change (start1, len1 + len2);
-#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
Fset_text_properties (make_number (start1), make_number (end2),
Qnil, Qnil);
-#endif /* USE_TEXT_PROPERTIES */
/* First region smaller than second. */
if (len1_byte < len2_byte)
/* Don't precompute these addresses. We have to compute them
at the last minute, because the relocating allocator might
have moved the buffer around during the xmalloc. */
- start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1_byte);
- start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2_byte);
+ start1_addr = BYTE_POS_ADDR (start1_byte);
+ start2_addr = BYTE_POS_ADDR (start2_byte);
bcopy (start2_addr, temp, len2_byte);
bcopy (start1_addr, start1_addr + len2_byte, len1_byte);
temp = (unsigned char *) xmalloc (len1_byte);
else
temp = (unsigned char *) alloca (len1_byte);
- start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1_byte);
- start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2_byte);
+ start1_addr = BYTE_POS_ADDR (start1_byte);
+ start2_addr = BYTE_POS_ADDR (start2_byte);
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start1_addr + len2_byte, len1_byte);
if (len1_byte > 20000)
free (temp);
}
-#ifdef USE_TEXT_PROPERTIES
graft_intervals_into_buffer (tmp_interval1, start1 + len2,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
-#endif /* USE_TEXT_PROPERTIES */
+ update_compositions (start1, start1 + len2, CHECK_BORDER);
+ update_compositions (start1 + len2, end2, CHECK_TAIL);
}
/* Non-adjacent regions, because end1 != start2, bleagh... */
else
modify_region (current_buffer, start2, end2);
record_change (start1, len1);
record_change (start2, len2);
-#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
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_byte > 20000)
temp = (unsigned char *) xmalloc (len1_byte);
else
temp = (unsigned char *) alloca (len1_byte);
- start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1_byte);
- start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2_byte);
+ start1_addr = BYTE_POS_ADDR (start1_byte);
+ start2_addr = BYTE_POS_ADDR (start2_byte);
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start2_addr, len1_byte);
if (len1_byte > 20000)
free (temp);
-#ifdef USE_TEXT_PROPERTIES
graft_intervals_into_buffer (tmp_interval1, start2,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
-#endif /* USE_TEXT_PROPERTIES */
}
else if (len1_byte < len2_byte) /* Second region larger than first */
{
modify_region (current_buffer, start1, end2);
record_change (start1, (end2 - start1));
-#ifdef USE_TEXT_PROPERTIES
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 (make_number (start1), make_number (end2),
Qnil, Qnil);
-#endif /* USE_TEXT_PROPERTIES */
/* holds region 2 */
if (len2_byte > 20000)
temp = (unsigned char *) xmalloc (len2_byte);
else
temp = (unsigned char *) alloca (len2_byte);
- start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1_byte);
- start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2_byte);
+ start1_addr = BYTE_POS_ADDR (start1_byte);
+ start2_addr = BYTE_POS_ADDR (start2_byte);
bcopy (start2_addr, temp, len2_byte);
bcopy (start1_addr, start1_addr + len_mid + len2_byte, len1_byte);
safe_bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
bcopy (temp, start1_addr, len2_byte);
if (len2_byte > 20000)
free (temp);
-#ifdef USE_TEXT_PROPERTIES
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval_mid, start1 + len2,
len_mid, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
-#endif /* USE_TEXT_PROPERTIES */
}
else
/* Second region smaller than first. */
record_change (start1, (end2 - start1));
modify_region (current_buffer, start1, end2);
-#ifdef USE_TEXT_PROPERTIES
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 (make_number (start1), make_number (end2),
Qnil, Qnil);
-#endif /* USE_TEXT_PROPERTIES */
/* holds region 1 */
if (len1_byte > 20000)
temp = (unsigned char *) xmalloc (len1_byte);
else
temp = (unsigned char *) alloca (len1_byte);
- start1_addr = BUF_CHAR_ADDRESS (current_buffer, start1_byte);
- start2_addr = BUF_CHAR_ADDRESS (current_buffer, start2_byte);
+ start1_addr = BYTE_POS_ADDR (start1_byte);
+ start2_addr = BYTE_POS_ADDR (start2_byte);
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
bcopy (temp, start1_addr + len2_byte + len_mid, len1_byte);
if (len1_byte > 20000)
free (temp);
-#ifdef USE_TEXT_PROPERTIES
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval_mid, start1 + len2,
len_mid, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
-#endif /* USE_TEXT_PROPERTIES */
}
+
+ update_compositions (start1, start1 + len2, CHECK_BORDER);
+ update_compositions (end2 - len1, end2, CHECK_BORDER);
}
/* When doing multiple transpositions, it might be nice
= intern ("buffer-access-fontify-functions");
staticpro (&Qbuffer_access_fontify_functions);
+ DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion,
+ "Non-nil means.text motion commands don't notice fields.");
+ Vinhibit_field_text_motion = Qnil;
+
DEFVAR_LISP ("buffer-access-fontify-functions",
&Vbuffer_access_fontify_functions,
"List of functions called by `buffer-substring' to fontify if necessary.\n\
DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name,
"The user's name, based upon the real uid only.");
+ defsubr (&Spropertize);
defsubr (&Schar_equal);
defsubr (&Sgoto_char);
defsubr (&Sstring_to_char);
defsubr (&Sregion_beginning);
defsubr (&Sregion_end);
+ staticpro (&Qfield);
+ Qfield = intern ("field");
+ defsubr (&Sfield_beginning);
+ defsubr (&Sfield_end);
+ defsubr (&Sfield_string);
+ defsubr (&Sfield_string_no_properties);
+ defsubr (&Sdelete_field);
+ defsubr (&Sconstrain_to_field);
+
defsubr (&Sline_beginning_position);
defsubr (&Sline_end_position);
defsubr (&Spoint_min);
defsubr (&Spoint_min_marker);
defsubr (&Spoint_max_marker);
+ defsubr (&Sgap_position);
+ defsubr (&Sgap_size);
defsubr (&Sposition_bytes);
+ defsubr (&Sbyte_to_position);
defsubr (&Sbobp);
defsubr (&Seobp);
defsubr (&Ssubst_char_in_region);
defsubr (&Stranslate_region);
defsubr (&Sdelete_region);
+ defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);
defsubr (&Snarrow_to_region);
defsubr (&Ssave_restriction);
HCoop / bpt / emacs.git / blobdiff