/* Lisp functions pertaining to editing.
-Copyright (C) 1985-1987, 1989, 1993-2013 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2014 Free Software Foundation, Inc.
This file is part of GNU Emacs.
pw = getpwuid (getuid ());
#ifdef MSDOS
/* We let the real user name default to "root" because that's quite
- accurate on MSDOG and because it lets Emacs find the init file.
+ accurate on MS-DOS and because it lets Emacs find the init file.
(The DVX libraries override the Djgpp libraries here.) */
Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
#else
return idx;
}
-/* Return the value of property PROP, in OBJECT at POSITION.
- It's the value of PROP that a char inserted at POSITION would get.
- OBJECT is optional and defaults to the current buffer.
- If OBJECT is a buffer, then overlay properties are considered as well as
- text properties.
- 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. */
-Lisp_Object
-get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object object)
+DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
+ doc: /* Return the value of POSITION's property PROP, in OBJECT.
+Almost identical to `get-char-property' except for the following difference:
+Whereas `get-char-property' returns the property of the char at (i.e. right
+after) POSITION, this pays attention to properties's stickiness and overlays's
+advancement settings, in order to find the property of POSITION itself,
+i.e. the property that a char would inherit if it were inserted
+at POSITION. */)
+ (Lisp_Object position, register Lisp_Object prop, Lisp_Object object)
{
CHECK_NUMBER_COERCE_MARKER (position);
set_buffer_temp (XBUFFER (object));
/* First try with room for 40 overlays. */
- noverlays = 40;
- overlay_vec = alloca (noverlays * sizeof *overlay_vec);
+ Lisp_Object overlay_vecbuf[40];
+ noverlays = ARRAYELTS (overlay_vecbuf);
+ overlay_vec = overlay_vecbuf;
noverlays = overlays_around (posn, overlay_vec, noverlays);
/* If there are more than 40,
make enough space for all, and try again. */
- if (noverlays > 40)
+ if (ARRAYELTS (overlay_vecbuf) < noverlays)
{
SAFE_ALLOCA_LISP (overlay_vec, noverlays);
noverlays = overlays_around (posn, overlay_vec, noverlays);
specially. */
if (NILP (merge_at_boundary))
{
- Lisp_Object field = get_pos_property (pos, Qfield, Qnil);
+ Lisp_Object field = Fget_pos_property (pos, Qfield, Qnil);
if (!EQ (field, after_field))
at_field_end = 1;
if (!EQ (field, before_field))
If the optional argument ONLY-IN-LINE is non-nil and constraining
NEW-POS would move it to a different line, NEW-POS is returned
-unconstrained. This useful for commands that move by line, like
+unconstrained. This is useful for commands that move by line, like
\\[next-line] or \\[beginning-of-line], which should generally respect field boundaries
only in the case where they can still move to the right line.
&& (!NILP (Fget_char_property (new_pos, Qfield, Qnil))
|| !NILP (Fget_char_property (old_pos, Qfield, Qnil))
/* To recognize field boundaries, we must also look at the
- previous positions; we could use `get_pos_property'
+ previous positions; we could use `Fget_pos_property'
instead, but in itself that would fail inside non-sticky
fields (like comint prompts). */
|| (XFASTINT (new_pos) > BEGV
/* Field boundaries are again a problem; but now we must
decide the case exactly, so we need to call
`get_pos_property' as well. */
- || (NILP (get_pos_property (old_pos, inhibit_capture_property, Qnil))
+ || (NILP (Fget_pos_property (old_pos, inhibit_capture_property, Qnil))
&& (XFASTINT (old_pos) <= BEGV
- || NILP (Fget_char_property (old_pos, inhibit_capture_property, Qnil))
- || NILP (Fget_char_property (prev_old, inhibit_capture_property, Qnil))))))
+ || NILP (Fget_char_property
+ (old_pos, inhibit_capture_property, Qnil))
+ || NILP (Fget_char_property
+ (prev_old, inhibit_capture_property, Qnil))))))
/* It is possible that NEW_POS is not within the same field as
OLD_POS; try to move NEW_POS so that it is. */
{
/* NEW_POS should be constrained, but only if either
ONLY_IN_LINE is nil (in which case any constraint is OK),
or NEW_POS and FIELD_BOUND are on the same line (in which
- case the constraint is OK even if ONLY_IN_LINE is non-nil). */
+ case the constraint is OK even if ONLY_IN_LINE is non-nil). */
&& (NILP (only_in_line)
/* This is the ONLY_IN_LINE case, check that NEW_POS and
FIELD_BOUND are on the same line by seeing whether
/* Substitute the login name for the &, upcasing the first character. */
if (q)
{
- register char *r;
- Lisp_Object login;
-
- login = Fuser_login_name (make_number (pw->pw_uid));
- r = alloca (strlen (p) + SCHARS (login) + 1);
+ Lisp_Object login = Fuser_login_name (make_number (pw->pw_uid));
+ USE_SAFE_ALLOCA;
+ char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1);
memcpy (r, p, q - p);
r[q - p] = 0;
strcat (r, SSDATA (login));
r[q - p] = upcase ((unsigned char) r[q - p]);
strcat (r, q + 1);
full = build_string (r);
+ SAFE_FREE ();
}
#endif /* AMPERSAND_FULL_NAME */
list, generate the corresponding time value.
If RESULT is not null, store into *RESULT the converted time;
- this can fail if the converted time does not fit into struct timespec.
+ if the converted time does not fit into struct timespec,
+ store an invalid timespec to indicate the overflow.
If *DRESULT is not null, store into *DRESULT the number of
seconds since the start of the POSIX Epoch.
EMACS_INT hi, lo, us, ps;
if (! (INTEGERP (high) && INTEGERP (low)
&& INTEGERP (usec) && INTEGERP (psec)))
- return 0;
+ return false;
hi = XINT (high);
lo = XINT (low);
us = XINT (usec);
*result = make_timespec ((sec << 16) + lo, us * 1000 + ps / 1000);
}
else
- {
- /* Overflow in the highest-order component. */
- return 0;
- }
+ *result = invalid_timespec ();
}
if (dresult)
*dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0;
- return 1;
+ return true;
}
/* Decode a Lisp list SPECIFIED_TIME that represents a time.
struct timespec
lisp_time_argument (Lisp_Object specified_time)
{
- struct timespec t;
if (NILP (specified_time))
- t = current_timespec ();
+ return current_timespec ();
else
{
Lisp_Object high, low, usec, psec;
+ struct timespec t;
if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
&& decode_time_components (high, low, usec, psec, &t, 0)))
error ("Invalid time specification");
+ if (! timespec_valid_p (t))
+ time_overflow ();
+ return t;
}
- return t;
}
/* Like lisp_time_argument, except decode only the seconds part,
- do not allow out-of-range time stamps, do not check the subseconds part,
- and always round down. */
+ and do not check the subseconds part. */
static time_t
lisp_seconds_argument (Lisp_Object specified_time)
{
&& decode_time_components (high, low, make_number (0),
make_number (0), &t, 0)))
error ("Invalid time specification");
+ if (! timespec_valid_p (t))
+ time_overflow ();
return t.tv_sec;
}
}
%G is the year corresponding to the ISO week, %g within the century.
%m is the numeric month.
%b and %h are the locale's abbreviated month name, %B the full name.
+ (%h is not supported on MS-Windows.)
%d is the day of the month, zero-padded, %e is blank-padded.
%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
%a is the locale's abbreviated name of the day of week, %A the full name.
%c is the locale's date and time format.
%x is the locale's "preferred" date format.
%D is like "%m/%d/%y".
+%F is the ISO 8601 date format (like "%Y-%m-%d").
%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
%X is the locale's "preferred" time format.
%EX is a locale's alternative version of %X;
%OX is like %X, but uses the locale's number symbols.
-For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".
+For example, to produce full ISO 8601 format, use "%FT%T%z".
usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
len = CHAR_STRING (c, str);
else
{
- str[0] = ASCII_CHAR_P (c) ? c : multibyte_char_to_unibyte (c);
+ str[0] = CHAR_TO_BYTE8 (c);
len = 1;
}
(*insert_func) ((char *) str, len);
len = CHAR_STRING (fromc, fromstr);
if (CHAR_STRING (toc, tostr) != len)
error ("Characters in `subst-char-in-region' have different byte-lengths");
- if (!ASCII_BYTE_P (*tostr))
+ if (!ASCII_CHAR_P (*tostr))
{
/* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
complete multibyte character, it may be combined with the
: ((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))))))
+ && ! ASCII_CHAR_P (FETCH_BYTE (pos_byte - 1))))))
{
Lisp_Object tem, string;
check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end,
Lisp_Object val)
{
- int buf_size = 16, buf_used = 0;
- int *buf = alloca (sizeof (int) * buf_size);
+ int initial_buf[16];
+ int *buf = initial_buf;
+ ptrdiff_t buf_size = ARRAYELTS (initial_buf);
+ int *bufalloc = 0;
+ ptrdiff_t buf_used = 0;
+ Lisp_Object result = Qnil;
for (; CONSP (val); val = XCDR (val))
{
if (buf_used == buf_size)
{
- int *newbuf;
-
- buf_size += 16;
- newbuf = alloca (sizeof (int) * buf_size);
- memcpy (newbuf, buf, sizeof (int) * buf_used);
- buf = newbuf;
+ bufalloc = xpalloc (bufalloc, &buf_size, 1, -1,
+ sizeof *bufalloc);
+ if (buf == initial_buf)
+ memcpy (bufalloc, buf, sizeof initial_buf);
+ buf = bufalloc;
}
buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1);
pos_byte += len1;
break;
}
if (i == len)
- return XCAR (val);
+ {
+ result = XCAR (val);
+ break;
+ }
}
}
- return Qnil;
+
+ xfree (bufalloc);
+ return result;
}
else
{
nc = tt[oc];
- if (! ASCII_BYTE_P (nc) && multibyte)
+ if (! ASCII_CHAR_P (nc) && multibyte)
{
str_len = BYTE8_STRING (nc, buf);
str = buf;
is non-nil. (In keyboard macros, that's all it does.)
Return the message.
+In batch mode, the message is printed to the standard error stream,
+followed by a newline.
+
The first argument is a format control string, and the rest are data
to be formatted under control of the string. See `format' for details.
else
{
Lisp_Object val = Fformat (nargs, args);
-#ifdef HAVE_MENUS
- /* The MS-DOS frames support popup menus even though they are
- not FRAME_WINDOW_P. */
- if (FRAME_WINDOW_P (XFRAME (selected_frame))
- || FRAME_MSDOS_P (XFRAME (selected_frame)))
- {
- Lisp_Object pane, menu;
- struct gcpro gcpro1;
- pane = list1 (Fcons (build_string ("OK"), Qt));
- GCPRO1 (pane);
- menu = Fcons (val, pane);
- Fx_popup_dialog (Qt, menu, Qt);
- UNGCPRO;
- return val;
- }
-#endif /* HAVE_MENUS */
- message3 (val);
+ Lisp_Object pane, menu;
+ struct gcpro gcpro1;
+
+ pane = list1 (Fcons (build_string ("OK"), Qt));
+ GCPRO1 (pane);
+ menu = Fcons (val, pane);
+ Fx_popup_dialog (Qt, menu, Qt);
+ UNGCPRO;
return val;
}
}
usage: (message-or-box FORMAT-STRING &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
-#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box)
return Fmessage_box (nargs, args);
-#endif
return Fmessage (nargs, args);
}
usage: (format STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t n; /* The number of the next arg to substitute */
+ ptrdiff_t n; /* The number of the next arg to substitute. */
char initial_buffer[4000];
char *buf = initial_buffer;
ptrdiff_t bufsize = sizeof initial_buffer;
struct info
{
ptrdiff_t start, end;
- unsigned converted_to_string : 1;
- unsigned intervals : 1;
+ bool_bf converted_to_string : 1;
+ bool_bf intervals : 1;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
if (p > buf
&& multibyte
- && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && !ASCII_CHAR_P (*((unsigned char *) p - 1))
&& STRING_MULTIBYTE (args[n])
&& !CHAR_HEAD_P (SREF (args[n], 0)))
maybe_combine_byte = 1;
{
/* Copy a whole multibyte character. */
if (p > buf
- && !ASCII_BYTE_P (*((unsigned char *) p - 1))
+ && !ASCII_CHAR_P (*((unsigned char *) p - 1))
&& !CHAR_HEAD_P (*format))
maybe_combine_byte = 1;
else
{
unsigned char uc = *format++;
- if (! multibyte || ASCII_BYTE_P (uc))
+ if (! multibyte || ASCII_CHAR_P (uc))
convbytes = 1;
else
{
if (buf == initial_buffer)
{
buf = xmalloc (bufsize);
- sa_must_free = 1;
+ sa_must_free = true;
buf_save_value_index = SPECPDL_INDEX ();
record_unwind_protect_ptr (xfree, buf);
memcpy (buf, initial_buffer, used);
Lisp_Object
format2 (const char *string1, Lisp_Object arg0, Lisp_Object arg1)
{
- Lisp_Object args[3];
- args[0] = build_string (string1);
- args[1] = arg0;
- args[2] = arg1;
- return Fformat (3, args);
+ AUTO_STRING (format, string1);
+ return Fformat (3, (Lisp_Object []) {format, arg0, arg1});
}
\f
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
return Qnil;
i1 = XFASTINT (c1);
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! ASCII_CHAR_P (i1))
- {
- MAKE_CHAR_MULTIBYTE (i1);
- }
i2 = XFASTINT (c2);
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! ASCII_CHAR_P (i2))
+
+ /* FIXME: It is possible to compare multibyte characters even when
+ the current buffer is unibyte. Unfortunately this is ambiguous
+ for characters between 128 and 255, as they could be either
+ eight-bit raw bytes or Latin-1 characters. Assume the former for
+ now. See Bug#17011, and also see casefiddle.c's casify_object,
+ which has a similar problem. */
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- MAKE_CHAR_MULTIBYTE (i2);
+ if (SINGLE_BYTE_CHAR_P (i1))
+ i1 = UNIBYTE_TO_CHAR (i1);
+ if (SINGLE_BYTE_CHAR_P (i2))
+ i2 = UNIBYTE_TO_CHAR (i2);
}
+
return (downcase (i1) == downcase (i2) ? Qt : Qnil);
}
\f
if (tmp_interval3)
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
+ USE_SAFE_ALLOCA;
+
/* First region smaller than second. */
if (len1_byte < len2_byte)
{
- USE_SAFE_ALLOCA;
-
temp = SAFE_ALLOCA (len2_byte);
/* Don't precompute these addresses. We have to compute them
memcpy (temp, start2_addr, len2_byte);
memcpy (start1_addr + len2_byte, start1_addr, len1_byte);
memcpy (start1_addr, temp, len2_byte);
- SAFE_FREE ();
}
else
/* First region not smaller than second. */
{
- USE_SAFE_ALLOCA;
-
temp = SAFE_ALLOCA (len1_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
memcpy (start1_addr, start2_addr, len2_byte);
memcpy (start1_addr + len2_byte, temp, len1_byte);
- SAFE_FREE ();
}
+
+ SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, start1 + len2,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
defsubr (&Sbuffer_substring);
defsubr (&Sbuffer_substring_no_properties);
defsubr (&Sbuffer_string);
+ defsubr (&Sget_pos_property);
defsubr (&Spoint_marker);
defsubr (&Smark_marker);