#endif
#include <ctype.h>
+#include <limits.h>
+#include <intprops.h>
#include <strftime.h>
#include "intervals.h"
extern Lisp_Object w32_get_internal_run_time (void);
#endif
+static void time_overflow (void) NO_RETURN;
static int tm_diff (struct tm *, struct tm *);
static void find_field (Lisp_Object, Lisp_Object, Lisp_Object,
EMACS_INT *, Lisp_Object, EMACS_INT *);
static void update_buffer_properties (EMACS_INT, EMACS_INT);
static Lisp_Object region_limit (int);
-static size_t emacs_memftimeu (char *, size_t, const char *,
- size_t, const struct tm *, int);
-static void general_insert_function (void (*) (const unsigned char *, EMACS_INT),
+static size_t emacs_nmemftime (char *, size_t, const char *,
+ size_t, const struct tm *, int, int);
+static void general_insert_function (void (*) (const char *, EMACS_INT),
void (*) (Lisp_Object, EMACS_INT,
EMACS_INT, EMACS_INT,
EMACS_INT, int),
- int, int, Lisp_Object *);
+ int, size_t, Lisp_Object *);
static Lisp_Object subst_char_in_region_unwind (Lisp_Object);
static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object);
static void transpose_markers (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT);
Lisp_Object Qbuffer_access_fontify_functions;
-Lisp_Object Fuser_full_name (Lisp_Object);
+INFUN (Fuser_full_name, 1);
/* Symbol for the text property used to mark fields. */
void
init_editfns (void)
{
- char *user_name;
- register unsigned char *p;
+ const char *user_name;
+ register char *p;
struct passwd *pw; /* password entry for the current user */
Lisp_Object tem;
return;
#endif /* not CANNOT_DUMP */
- pw = (struct passwd *) getpwuid (getuid ());
+ 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.
/* Get the effective user name, by consulting environment variables,
or the effective uid if those are unset. */
- user_name = (char *) getenv ("LOGNAME");
+ user_name = getenv ("LOGNAME");
if (!user_name)
#ifdef WINDOWSNT
- user_name = (char *) getenv ("USERNAME"); /* it's USERNAME on NT */
+ user_name = getenv ("USERNAME"); /* it's USERNAME on NT */
#else /* WINDOWSNT */
- user_name = (char *) getenv ("USER");
+ user_name = getenv ("USER");
#endif /* WINDOWSNT */
if (!user_name)
{
- pw = (struct passwd *) getpwuid (geteuid ());
- user_name = (char *) (pw ? pw->pw_name : "unknown");
+ pw = getpwuid (geteuid ());
+ user_name = pw ? pw->pw_name : "unknown";
}
Vuser_login_name = build_string (user_name);
Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid())
: Vuser_login_name);
- p = (unsigned char *) getenv ("NAME");
+ p = getenv ("NAME");
if (p)
Vuser_full_name = build_string (p);
else if (NILP (Vuser_full_name))
#endif
}
\f
-DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
+DEFUE ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
doc: /* Convert arg CHAR to a string containing that character.
usage: (char-to-string CHAR) */)
(Lisp_Object character)
CHECK_CHARACTER (character);
len = CHAR_STRING (XFASTINT (character), str);
- return make_string_from_bytes (str, 1, len);
+ return make_string_from_bytes ((char *) str, 1, len);
}
DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0,
if (XINT (byte) < 0 || XINT (byte) > 255)
error ("Invalid byte");
b = XINT (byte);
- return make_string_from_bytes (&b, 1, 1);
+ return make_string_from_bytes ((char *) &b, 1, 1);
}
DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0,
return mark;
}
-DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
+DEFUE ("point", Fpoint, Spoint, 0, 0, 0,
doc: /* Return value of point, as an integer.
Beginning of buffer is position (point-min). */)
(void)
return temp;
}
-DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
+DEFUE ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
doc: /* Return value of point, as a marker object. */)
(void)
{
return num;
}
-DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
+DEFUE ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
doc: /* Set point to POSITION, a number or marker.
Beginning of buffer is position (point-min), end is (point-max).
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
- && NILP (current_buffer->mark_active))
+ && NILP (BVAR (current_buffer, mark_active)))
xsignal0 (Qmark_inactive);
- m = Fmarker_position (current_buffer->mark);
+ m = Fmarker_position (BVAR (current_buffer, mark));
if (NILP (m))
error ("The mark is not set now, so there is no region");
If you set the marker not to point anywhere, the buffer will have no mark. */)
(void)
{
- return current_buffer->mark;
+ return BVAR (current_buffer, mark);
}
\f
return make_number (beg);
}
-DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0,
+DEFUE ("field-end", Ffield_end, Sfield_end, 0, 3, 0,
doc: /* Return the end of the field surrounding POS.
A field is a region of text with the same `field' property.
If POS is nil, the value of point is used for POS.
return make_number (end);
}
-DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
+DEFUE ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
doc: /* Return the position closest to NEW-POS that is in the same field as OLD-POS.
A field is a region of text with the same `field' property.
/* It is possible that NEW_POS is not within the same field as
OLD_POS; try to move NEW_POS so that it is. */
{
- int shortage;
+ EMACS_INT shortage;
Lisp_Object field_bound;
if (fwd)
}
\f
-DEFUN ("line-beginning-position",
+DEFUE ("line-beginning-position",
Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
doc: /* Return the character position of the first character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
Qt, Qnil);
}
-DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
+DEFUE ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
doc: /* Return the character position of the last character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
== current_buffer);
return Fcons (Fpoint_marker (),
- Fcons (Fcopy_marker (current_buffer->mark, Qnil),
+ Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
Fcons (visible ? Qt : Qnil,
- Fcons (current_buffer->mark_active,
+ Fcons (BVAR (current_buffer, mark_active),
selected_window))));
}
/* Mark marker. */
info = XCDR (info);
tem = XCAR (info);
- omark = Fmarker_position (current_buffer->mark);
- Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
+ omark = Fmarker_position (BVAR (current_buffer, mark));
+ Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
nmark = Fmarker_position (tem);
unchain_marker (XMARKER (tem));
/* Mark active */
info = XCDR (info);
tem = XCAR (info);
- tem1 = current_buffer->mark_active;
- current_buffer->mark_active = tem;
+ tem1 = BVAR (current_buffer, mark_active);
+ BVAR (current_buffer, mark_active) = tem;
- if (!NILP (Vrun_hooks))
+ /* If mark is active now, and either was not active
+ or was at a different place, run the activate hook. */
+ if (! NILP (tem))
{
- /* If mark is active now, and either was not active
- or was at a different place, run the activate hook. */
- if (! NILP (current_buffer->mark_active))
- {
- if (! EQ (omark, nmark))
- call1 (Vrun_hooks, intern ("activate-mark-hook"));
- }
- /* If mark has ceased to be active, run deactivate hook. */
- else if (! NILP (tem1))
- call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
+ if (! EQ (omark, nmark))
+ {
+ tem = intern ("activate-mark-hook");
+ Frun_hooks (1, &tem);
+ }
+ }
+ /* If mark has ceased to be active, run deactivate hook. */
+ else if (! NILP (tem1))
+ {
+ tem = intern ("deactivate-mark-hook");
+ Frun_hooks (1, &tem);
}
/* If buffer was visible in a window, and a different window was
return temp;
}
-DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
+DEFUE ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
doc: /* Return a marker to the maximum permissible value of point in this buffer.
This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
is in effect, in which case it is less. */)
return make_number (BYTE_TO_CHAR (XINT (bytepos)));
}
\f
-DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
+DEFUE ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
doc: /* Return the character following point, as a number.
At the end of the buffer or accessible region, return 0. */)
(void)
return temp;
}
-DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
+DEFUE ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
doc: /* Return the character preceding point, as a number.
At the beginning of the buffer or accessible region, return 0. */)
(void)
Lisp_Object temp;
if (PT <= BEGV)
XSETFASTINT (temp, 0);
- else if (!NILP (current_buffer->enable_multibyte_characters))
+ else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
EMACS_INT pos = PT_BYTE;
DEC_POS (pos);
return temp;
}
-DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0,
+DEFUE ("bobp", Fbobp, Sbobp, 0, 0, 0,
doc: /* Return t if point is at the beginning of the buffer.
If the buffer is narrowed, this means the beginning of the narrowed part. */)
(void)
return Qnil;
}
-DEFUN ("eobp", Feobp, Seobp, 0, 0, 0,
+DEFUE ("eobp", Feobp, Seobp, 0, 0, 0,
doc: /* Return t if point is at the end of the buffer.
If the buffer is narrowed, this means the end of the narrowed part. */)
(void)
return Qnil;
}
-DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0,
+DEFUE ("bolp", Fbolp, Sbolp, 0, 0, 0,
doc: /* Return t if point is at the beginning of a line. */)
(void)
{
return Qnil;
}
-DEFUN ("eolp", Feolp, Seolp, 0, 0, 0,
+DEFUE ("eolp", Feolp, Seolp, 0, 0, 0,
doc: /* Return t if point is at the end of a line.
`End of a line' includes point being at the end of the buffer. */)
(void)
return Qnil;
}
-DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0,
+DEFUE ("char-after", Fchar_after, Schar_after, 0, 1, 0,
doc: /* Return character in current buffer at position POS.
POS is an integer or a marker and defaults to point.
If POS is out of range, the value is nil. */)
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
- if (!NILP (current_buffer->enable_multibyte_characters))
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
DEC_POS (pos_byte);
XSETFASTINT (val, FETCH_CHAR (pos_byte));
return val;
}
\f
-DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0,
+DEFUE ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0,
doc: /* Return the name under which the user logged in, as a string.
This is based on the effective uid, not the real uid.
Also, if the environment variables LOGNAME or USER are set,
if (NILP (uid))
return Vuser_login_name;
- id = (uid_t)XFLOATINT (uid);
+ id = XFLOATINT (uid);
BLOCK_INPUT;
- pw = (struct passwd *) getpwuid (id);
+ pw = getpwuid (id);
UNBLOCK_INPUT;
return (pw ? build_string (pw->pw_name) : Qnil);
}
/* Make sure we don't produce a negative UID due to signed integer
overflow. */
if (euid < 0)
- return make_float ((double)geteuid ());
+ return make_float (geteuid ());
return make_fixnum_or_float (euid);
}
/* Make sure we don't produce a negative UID due to signed integer
overflow. */
if (uid < 0)
- return make_float ((double)getuid ());
+ return make_float (getuid ());
return make_fixnum_or_float (uid);
}
(Lisp_Object uid)
{
struct passwd *pw;
- register unsigned char *p, *q;
+ register char *p, *q;
Lisp_Object full;
if (NILP (uid))
return Vuser_full_name;
else if (NUMBERP (uid))
{
+ uid_t u = XFLOATINT (uid);
BLOCK_INPUT;
- pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid));
+ pw = getpwuid (u);
UNBLOCK_INPUT;
}
else if (STRINGP (uid))
{
BLOCK_INPUT;
- pw = (struct passwd *) getpwnam (SSDATA (uid));
+ pw = getpwnam (SSDATA (uid));
UNBLOCK_INPUT;
}
else
if (!pw)
return Qnil;
- p = (unsigned char *) USER_FULL_NAME;
+ p = USER_FULL_NAME;
/* Chop off everything after the first comma. */
- q = (unsigned char *) strchr (p, ',');
+ q = strchr (p, ',');
full = make_string (p, q ? q - p : strlen (p));
#ifdef AMPERSAND_FULL_NAME
- p = SDATA (full);
- q = (unsigned char *) strchr (p, '&');
+ p = SSDATA (full);
+ q = strchr (p, '&');
/* Substitute the login name for the &, upcasing the first character. */
if (q)
{
- register unsigned char *r;
+ register char *r;
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
- r = (unsigned char *) alloca (strlen (p) + SCHARS (login) + 1);
+ r = (char *) alloca (strlen (p) + SCHARS (login) + 1);
memcpy (r, p, q - p);
r[q - p] = 0;
strcat (r, SSDATA (login));
- r[q - p] = UPCASE (r[q - p]);
+ r[q - p] = upcase ((unsigned char) r[q - p]);
strcat (r, q + 1);
full = build_string (r);
}
return full;
}
-DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
+DEFUE ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
doc: /* Return the host name of the machine you are running on, as a string. */)
(void)
{
return Vsystem_name;
}
-/* For the benefit of callers who don't want to include lisp.h */
-
const char *
get_system_name (void)
{
return make_number (getpid ());
}
-DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
+\f
+
+#ifndef TIME_T_MIN
+# define TIME_T_MIN TYPE_MINIMUM (time_t)
+#endif
+#ifndef TIME_T_MAX
+# define TIME_T_MAX TYPE_MAXIMUM (time_t)
+#endif
+
+/* Report that a time value is out of range for Emacs. */
+static void
+time_overflow (void)
+{
+ error ("Specified time is not representable");
+}
+
+/* Return the upper part of the time T (everything but the bottom 16 bits),
+ making sure that it is representable. */
+static EMACS_INT
+hi_time (time_t t)
+{
+ time_t hi = t >> 16;
+
+ /* Check for overflow, helping the compiler for common cases where
+ no runtime check is needed, and taking care not to convert
+ negative numbers to unsigned before comparing them. */
+ if (! ((! TYPE_SIGNED (time_t)
+ || MOST_NEGATIVE_FIXNUM <= TIME_T_MIN >> 16
+ || MOST_NEGATIVE_FIXNUM <= hi)
+ && (TIME_T_MAX >> 16 <= MOST_POSITIVE_FIXNUM
+ || hi <= MOST_POSITIVE_FIXNUM)))
+ time_overflow ();
+
+ return hi;
+}
+
+/* Return the bottom 16 bits of the time T. */
+static EMACS_INT
+lo_time (time_t t)
+{
+ return t & ((1 << 16) - 1);
+}
+
+DEFUE ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
The time is returned as a list of three integers. The first has the
most significant 16 bits of the seconds, while the second has the
EMACS_TIME t;
EMACS_GET_TIME (t);
- return list3 (make_number ((EMACS_SECS (t) >> 16) & 0xffff),
- make_number ((EMACS_SECS (t) >> 0) & 0xffff),
+ return list3 (make_number (hi_time (EMACS_SECS (t))),
+ make_number (lo_time (EMACS_SECS (t))),
make_number (EMACS_USECS (t)));
}
-DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+DEFUE ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: /* Return the current run time used by Emacs.
The time is returned as a list of three integers. The first has the
{
#ifdef HAVE_GETRUSAGE
struct rusage usage;
- int secs, usecs;
+ time_t secs;
+ int usecs;
if (getrusage (RUSAGE_SELF, &usage) < 0)
/* This shouldn't happen. What action is appropriate? */
secs++;
}
- return list3 (make_number ((secs >> 16) & 0xffff),
- make_number ((secs >> 0) & 0xffff),
+ return list3 (make_number (hi_time (secs)),
+ make_number (lo_time (secs)),
make_number (usecs));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
}
\f
+/* Make a Lisp list that represents the time T. */
+Lisp_Object
+make_time (time_t t)
+{
+ return list2 (make_number (hi_time (t)),
+ make_number (lo_time (t)));
+}
+
+/* Decode a Lisp list SPECIFIED_TIME that represents a time.
+ If SPECIFIED_TIME is nil, use the current time.
+ Set *RESULT to seconds since the Epoch.
+ If USEC is not null, set *USEC to the microseconds component.
+ Return nonzero if successful. */
int
lisp_time_argument (Lisp_Object specified_time, time_t *result, int *usec)
{
else
{
Lisp_Object high, low;
+ EMACS_INT hi;
high = Fcar (specified_time);
CHECK_NUMBER (high);
low = Fcdr (specified_time);
else if (usec)
*usec = 0;
CHECK_NUMBER (low);
- *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
- return *result >> 16 == XINT (high);
+ hi = XINT (high);
+
+ /* Check for overflow, helping the compiler for common cases
+ where no runtime check is needed, and taking care not to
+ convert negative numbers to unsigned before comparing them. */
+ if (! ((TYPE_SIGNED (time_t)
+ ? (TIME_T_MIN >> 16 <= MOST_NEGATIVE_FIXNUM
+ || TIME_T_MIN >> 16 <= hi)
+ : 0 <= hi)
+ && (MOST_POSITIVE_FIXNUM <= TIME_T_MAX >> 16
+ || hi <= TIME_T_MAX >> 16)))
+ return 0;
+
+ *result = (hi << 16) + (XINT (low) & 0xffff);
+ return 1;
}
}
/* 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.
+ Use NS as the number of nanoseconds in the %N directive.
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
This function behaves like nstrftime, except it allows null
bytes in FORMAT and it does not support nanoseconds. */
static size_t
-emacs_memftimeu (char *s, size_t maxsize, const char *format, size_t format_len, const struct tm *tp, int ut)
+emacs_nmemftime (char *s, size_t maxsize, const char *format,
+ size_t format_len, const struct tm *tp, int ut, int ns)
{
size_t total = 0;
if (s)
s[0] = '\1';
- result = nstrftime (s, maxsize, format, tp, ut, 0);
+ result = nstrftime (s, maxsize, format, tp, ut, ns);
if (s)
{
%p is the locale's equivalent of either AM or PM.
%M is the minute.
%S is the second.
+%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
%Z is the time zone name, %z is the numeric form.
%s is the number of seconds since 1970-01-01 00:00:00 +0000.
%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". */)
- (Lisp_Object format_string, Lisp_Object time, Lisp_Object universal)
+ (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
time_t value;
int size;
+ int usec;
+ int ns;
struct tm *tm;
int ut = ! NILP (universal);
CHECK_STRING (format_string);
- if (! lisp_time_argument (time, &value, NULL))
+ if (! (lisp_time_argument (timeval, &value, &usec)
+ && 0 <= usec && usec < 1000000))
error ("Invalid time specification");
+ ns = usec * 1000;
format_string = code_convert_string_norecord (format_string,
Vlocale_coding_system, 1);
tm = ut ? gmtime (&value) : localtime (&value);
UNBLOCK_INPUT;
if (! tm)
- error ("Specified time is not representable");
+ time_overflow ();
synchronize_system_time_locale ();
buf[0] = '\1';
BLOCK_INPUT;
- result = emacs_memftimeu (buf, size, SSDATA (format_string),
+ result = emacs_nmemftime (buf, size, SSDATA (format_string),
SBYTES (format_string),
- tm, ut);
+ tm, ut, ns);
UNBLOCK_INPUT;
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
return code_convert_string_norecord (make_unibyte_string (buf, result),
/* If buffer was too small, make it bigger and try again. */
BLOCK_INPUT;
- result = emacs_memftimeu (NULL, (size_t) -1,
+ result = emacs_nmemftime (NULL, (size_t) -1,
SSDATA (format_string),
SBYTES (format_string),
- tm, ut);
+ tm, ut, ns);
UNBLOCK_INPUT;
size = result + 1;
}
BLOCK_INPUT;
decoded_time = localtime (&time_spec);
UNBLOCK_INPUT;
- if (! decoded_time)
- error ("Specified time is not representable");
+ if (! (decoded_time
+ && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= decoded_time->tm_year
+ && decoded_time->tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
+ time_overflow ();
XSETFASTINT (list_args[0], decoded_time->tm_sec);
XSETFASTINT (list_args[1], decoded_time->tm_min);
XSETFASTINT (list_args[2], decoded_time->tm_hour);
return Flist (9, list_args);
}
+/* Return OBJ - OFFSET, checking that OBJ is a valid fixnum and that
+ the result is representable as an int. Assume OFFSET is small and
+ nonnegative. */
+static int
+check_tm_member (Lisp_Object obj, int offset)
+{
+ EMACS_INT n;
+ CHECK_NUMBER (obj);
+ n = XINT (obj);
+ if (! (INT_MIN + offset <= n && n - offset <= INT_MAX))
+ time_overflow ();
+ return n - offset;
+}
+
DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
This is the reverse operation of `decode-time', which see.
year values as low as 1901 do work.
usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
- time_t time;
+ time_t value;
struct tm tm;
Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil);
- CHECK_NUMBER (args[0]); /* second */
- CHECK_NUMBER (args[1]); /* minute */
- CHECK_NUMBER (args[2]); /* hour */
- CHECK_NUMBER (args[3]); /* day */
- CHECK_NUMBER (args[4]); /* month */
- CHECK_NUMBER (args[5]); /* year */
-
- tm.tm_sec = XINT (args[0]);
- tm.tm_min = XINT (args[1]);
- tm.tm_hour = XINT (args[2]);
- tm.tm_mday = XINT (args[3]);
- tm.tm_mon = XINT (args[4]) - 1;
- tm.tm_year = XINT (args[5]) - TM_YEAR_BASE;
+ tm.tm_sec = check_tm_member (args[0], 0);
+ tm.tm_min = check_tm_member (args[1], 0);
+ tm.tm_hour = check_tm_member (args[2], 0);
+ tm.tm_mday = check_tm_member (args[3], 0);
+ tm.tm_mon = check_tm_member (args[4], 1);
+ tm.tm_year = check_tm_member (args[5], TM_YEAR_BASE);
tm.tm_isdst = -1;
if (CONSP (zone))
if (NILP (zone))
{
BLOCK_INPUT;
- time = mktime (&tm);
+ value = mktime (&tm);
UNBLOCK_INPUT;
}
else
set_time_zone_rule (tzstring);
BLOCK_INPUT;
- time = mktime (&tm);
+ value = mktime (&tm);
UNBLOCK_INPUT;
/* Restore TZ to previous value. */
#endif
}
- if (time == (time_t) -1)
- error ("Specified time is not representable");
+ if (value == (time_t) -1)
+ time_overflow ();
- return make_time (time);
+ return make_time (value);
}
DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
tm = localtime (&value);
UNBLOCK_INPUT;
if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
- error ("Specified time is not representable");
+ time_overflow ();
/* Remove the trailing newline. */
tem[strlen (tem) - 1] = '\0';
static void
general_insert_function (void (*insert_func)
- (const unsigned char *, EMACS_INT),
+ (const char *, EMACS_INT),
void (*insert_from_string_func)
(Lisp_Object, EMACS_INT, EMACS_INT,
EMACS_INT, EMACS_INT, int),
- int inherit, int nargs, Lisp_Object *args)
+ int inherit, size_t nargs, Lisp_Object *args)
{
- register int argnum;
+ register size_t argnum;
register Lisp_Object val;
for (argnum = 0; argnum < nargs; argnum++)
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
- if (!NILP (current_buffer->enable_multibyte_characters))
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
len = CHAR_STRING (XFASTINT (val), str);
else
{
str[0] = (ASCII_CHAR_P (XINT (val))
? XINT (val)
- : multibyte_char_to_unibyte (XINT (val), Qnil));
+ : multibyte_char_to_unibyte (XINT (val)));
len = 1;
}
- (*insert_func) (str, len);
+ (*insert_func) ((char *) str, len);
}
else if (STRINGP (val))
{
not be used after calling insert or insert_from_string, so
we don't care if it gets trashed. */
-DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
+DEFUE ("insert", Finsert, Sinsert, 0, MANY, 0,
doc: /* Insert the arguments, either strings or characters, at point.
Point and before-insertion markers move forward to end up
after the inserted text.
and insert the result.
usage: (insert &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
general_insert_function (insert, insert_from_string, 0, nargs, args);
return Qnil;
to unibyte for insertion.
usage: (insert-and-inherit &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
general_insert_function (insert_and_inherit, insert_from_string, 1,
nargs, args);
to unibyte for insertion.
usage: (insert-before-markers &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
general_insert_function (insert_before_markers,
insert_from_string_before_markers, 0,
to unibyte for insertion.
usage: (insert-before-markers-and-inherit &rest ARGS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
general_insert_function (insert_before_markers_and_inherit,
insert_from_string_before_markers, 1,
return Qnil;
}
\f
-DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
+DEFUE ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
doc: /* Insert COUNT copies of CHARACTER.
Point, and before-insertion markers, are relocated as in the function `insert'.
The optional third arg INHERIT, if non-nil, says to inherit text properties
from adjoining text, if those properties are sticky. */)
(Lisp_Object character, Lisp_Object count, Lisp_Object inherit)
{
- register unsigned char *string;
- register EMACS_INT strlen;
+ register char *string;
+ register EMACS_INT stringlen;
register int i;
register EMACS_INT n;
int len;
CHECK_NUMBER (character);
CHECK_NUMBER (count);
- if (!NILP (current_buffer->enable_multibyte_characters))
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
len = CHAR_STRING (XFASTINT (character), str);
else
str[0] = XFASTINT (character), len = 1;
n = XINT (count) * len;
if (n <= 0)
return Qnil;
- strlen = min (n, 256 * len);
- string = (unsigned char *) alloca (strlen);
- for (i = 0; i < strlen; i++)
+ stringlen = min (n, 256 * len);
+ string = (char *) alloca (stringlen);
+ for (i = 0; i < stringlen; i++)
string[i] = str[i % len];
- while (n >= strlen)
+ while (n >= stringlen)
{
QUIT;
if (!NILP (inherit))
- insert_and_inherit (string, strlen);
+ insert_and_inherit (string, stringlen);
else
- insert (string, strlen);
- n -= strlen;
+ insert (string, stringlen);
+ n -= stringlen;
}
if (n > 0)
{
if (XINT (byte) < 0 || XINT (byte) > 255)
args_out_of_range_3 (byte, make_number (0), make_number (255));
if (XINT (byte) >= 128
- && ! NILP (current_buffer->enable_multibyte_characters))
+ && ! NILP (BVAR (current_buffer, enable_multibyte_characters)))
XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte)));
return Finsert_char (byte, count, inherit);
}
if (start < GPT && GPT < end)
move_gap (start);
- if (! NILP (current_buffer->enable_multibyte_characters))
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
result = make_uninit_multibyte_string (end - start, end_byte - start_byte);
else
result = make_uninit_string (end - start);
}
}
-DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
+DEFUE ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
doc: /* Return the contents of part of the current buffer as a string.
The two arguments START and END are character positions;
they can be in either order.
return make_buffer_string (b, e, 0);
}
-DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
+DEFUE ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
doc: /* Return the contents of the current buffer as a string.
If narrowing is in effect, this function returns only the visible part
of the buffer. */)
if (NILP (buf))
nsberror (buffer);
bp = XBUFFER (buf);
- if (NILP (bp->name))
+ if (NILP (BVAR (bp, name)))
error ("Selecting deleted buffer");
if (NILP (start))
register EMACS_INT begp1, endp1, begp2, endp2, temp;
register struct buffer *bp1, *bp2;
register Lisp_Object trt
- = (!NILP (current_buffer->case_fold_search)
- ? current_buffer->case_canon_table : Qnil);
+ = (!NILP (BVAR (current_buffer, case_fold_search))
+ ? BVAR (current_buffer, case_canon_table) : Qnil);
EMACS_INT chars = 0;
EMACS_INT i1, i2, i1_byte, i2_byte;
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
- if (NILP (bp1->name))
+ if (NILP (BVAR (bp1, name)))
error ("Selecting deleted buffer");
}
if (NILP (buf2))
nsberror (buffer2);
bp2 = XBUFFER (buf2);
- if (NILP (bp2->name))
+ if (NILP (BVAR (bp2, name)))
error ("Selecting deleted buffer");
}
QUIT;
- if (! NILP (bp1->enable_multibyte_characters))
+ if (! NILP (BVAR (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
BUF_INC_POS (bp1, i1_byte);
i1++;
}
- if (! NILP (bp2->enable_multibyte_characters))
+ if (! NILP (BVAR (bp2, enable_multibyte_characters)))
{
c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte);
BUF_INC_POS (bp2, i2_byte);
static Lisp_Object
subst_char_in_region_unwind (Lisp_Object arg)
{
- return current_buffer->undo_list = arg;
+ return BVAR (current_buffer, undo_list) = arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
- return current_buffer->filename = arg;
+ return BVAR (current_buffer, filename) = arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
#define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
int maybe_byte_combining = COMBINING_NO;
EMACS_INT last_changed = 0;
- int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
+ int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
restart:
if (!changed && !NILP (noundo))
{
record_unwind_protect (subst_char_in_region_unwind,
- current_buffer->undo_list);
- current_buffer->undo_list = Qt;
+ BVAR (current_buffer, undo_list));
+ BVAR (current_buffer, undo_list) = Qt;
/* Don't do file-locking. */
record_unwind_protect (subst_char_in_region_unwind_1,
- current_buffer->filename);
- current_buffer->filename = Qnil;
+ BVAR (current_buffer, filename));
+ BVAR (current_buffer, filename) = Qnil;
}
if (pos_byte < GPT_BYTE)
struct gcpro gcpro1;
- tem = current_buffer->undo_list;
+ tem = BVAR (current_buffer, undo_list);
GCPRO1 (tem);
/* Make a multibyte string containing this single character. */
- string = make_multibyte_string (tostr, 1, len);
+ string = make_multibyte_string ((char *) tostr, 1, len);
/* replace_range is less efficient, because it moves the gap,
but it handles combining correctly. */
replace_range (pos, pos + 1, string,
INC_POS (pos_byte_next);
if (! NILP (noundo))
- current_buffer->undo_list = tem;
+ BVAR (current_buffer, undo_list) = tem;
UNGCPRO;
}
int cnt; /* Number of changes made. */
EMACS_INT size; /* Size of translate table. */
EMACS_INT pos, pos_byte, end_pos;
- int multibyte = !NILP (current_buffer->enable_multibyte_characters);
- int string_multibyte;
- Lisp_Object val;
+ int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ int string_multibyte IF_LINT (= 0);
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
/* This is less efficient, because it moves the gap,
but it should handle multibyte characters correctly. */
- string = make_multibyte_string (str, 1, str_len);
+ string = make_multibyte_string ((char *) str, 1, str_len);
replace_range (pos, pos + 1, string, 1, 0, 1);
len = str_len;
}
return make_number (cnt);
}
-DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
+DEFUE ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
doc: /* Delete the text between point and mark.
When called from a program, expects two arguments,
return del_range_1 (XINT (start), XINT (end), 1, 1);
}
\f
-DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
+DEFUE ("widen", Fwiden, Swiden, 0, 0, "",
doc: /* Remove restrictions (narrowing) from current buffer.
This allows the buffer's full text to be seen and edited. */)
(void)
return Qnil;
}
-DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
+DEFUE ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
doc: /* Restrict editing in this buffer to the current region.
The rest of the text becomes temporarily invisible and untouchable
but is not deleted; if you save the buffer in a file, the invisible
? XMARKER (XCAR (data))->buffer
: XBUFFER (data));
- if (buf && buf != current_buffer && !NILP (buf->pt_marker))
+ if (buf && buf != current_buffer && !NILP (BVAR (buf, pt_marker)))
{ /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
is the case if it is or has an indirect buffer), then make
sure it is current before we update BEGV, so
}
}
+ /* Changing the buffer bounds invalidates any recorded current column. */
+ invalidate_current_column ();
+
if (cur)
set_buffer_internal (cur);
/* Allocated length of that buffer. */
static int message_length;
-DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
+DEFUE ("message", Fmessage, Smessage, 1, MANY, 0,
doc: /* Display a message at the bottom of the screen.
The message also goes into the `*Messages*' buffer.
\(In keyboard macros, that's all it does.)
also `current-message'.
usage: (message FORMAT-STRING &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
if (NILP (args[0])
|| (STRINGP (args[0])
message; let the minibuffer contents show.
usage: (message-box FORMAT-STRING &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
if (NILP (args[0]))
{
if (FRAME_WINDOW_P (XFRAME (selected_frame))
|| FRAME_MSDOS_P (XFRAME (selected_frame)))
{
- Lisp_Object pane, menu, obj;
+ Lisp_Object pane, menu;
struct gcpro gcpro1;
pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
GCPRO1 (pane);
menu = Fcons (val, pane);
- obj = Fx_popup_dialog (Qt, menu, Qt);
+ Fx_popup_dialog (Qt, menu, Qt);
UNGCPRO;
return val;
}
message; let the minibuffer contents show.
usage: (message-or-box FORMAT-STRING &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
return Fmessage (nargs, args);
}
-DEFUN ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0,
+DEFUE ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0,
doc: /* Return the string currently displayed in the echo area, or nil if none. */)
(void)
{
Remaining arguments form a sequence of PROPERTY VALUE pairs for text
properties to add to the result.
usage: (propertize STRING &rest PROPERTIES) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
Lisp_Object properties, string;
struct gcpro gcpro1, gcpro2;
- int i;
+ size_t i;
/* Number of args must be odd. */
- if ((nargs & 1) == 0 || nargs < 1)
+ if ((nargs & 1) == 0)
error ("Wrong number of arguments");
properties = string = Qnil;
? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
: SBYTES (STRING))
-DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
+DEFUE ("format", Fformat, Sformat, 1, MANY, 0,
doc: /* Format a string out of a format-string and arguments.
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
specifier truncates the string to the given width.
usage: (format STRING &rest OBJECTS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
- register int n; /* The number of the next arg to substitute */
- register EMACS_INT total; /* An estimate of the final length */
+ register size_t n; /* The number of the next arg to substitute */
+ register size_t total; /* An estimate of the final length */
char *buf, *p;
- register unsigned char *format, *end, *format_start;
+ register 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. */
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
int maybe_combine_byte;
- unsigned char *this_format;
+ 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
+ was given in that spec. Element 0, corresponding 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. */
That can only happen from the first large while loop below. */
retry:
- format = SDATA (args[0]);
+ format = SSDATA (args[0]);
format_start = format;
end = format + SBYTES (args[0]);
longest_format = 0;
/* Allocate the info and discarded tables. */
{
- int nbytes = (nargs+1) * sizeof *info;
- int i;
+ size_t nbytes = (nargs+1) * sizeof *info;
+ size_t i;
if (!info)
info = (struct info *) alloca (nbytes);
memset (info, 0, nbytes);
- for (i = 0; i <= nargs; i++)
+ for (i = 0; i < nargs + 1; i++)
info[i].start = -1;
if (!discarded)
SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
{
EMACS_INT thissize = 0;
EMACS_INT actual_width = 0;
- unsigned char *this_format_start = format - 1;
+ char *this_format_start = format - 1;
int field_width = 0;
/* General format specifications look like
if (*format == 'c')
{
if (! ASCII_CHAR_P (XINT (args[n]))
- /* Note: No one can remeber why we have to treat
+ /* Note: No one can remember 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. */
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]);
- }
}
}
else if (FLOATP (args[n]) && *format != 's')
/* Now we can no longer jump to retry.
TOTAL and LONGEST_FORMAT are known for certain. */
- this_format = (unsigned char *) alloca (longest_format + 1);
+ this_format = (char *) alloca (longest_format + 1);
/* Allocate the space for the result.
Note that TOTAL is an overestimate. */
n = 0;
/* Scan the format and store result in BUF. */
- format = SDATA (args[0]);
+ format = SSDATA (args[0]);
format_start = format;
end = format + SBYTES (args[0]);
maybe_combine_byte = 0;
{
int minlen;
int negative = 0;
- unsigned char *this_format_start = format;
+ char *this_format_start = format;
discarded[format - format_start] = 1;
format++;
/* handle case (precision[n] >= 0) */
int width, padding;
- EMACS_INT nbytes, start, end;
+ EMACS_INT nbytes, start;
EMACS_INT nchars_string;
/* lisp_string_width ignores a precision of 0, but GNU
info[n].start = start = nchars;
nchars += nchars_string;
- end = nchars;
if (p > buf
&& multibyte
&& !CHAR_HEAD_P (SREF (args[n], 0)))
maybe_combine_byte = 1;
- p += copy_text (SDATA (args[n]), p,
+ p += copy_text (SDATA (args[n]), (unsigned char *) p,
nbytes,
STRING_MULTIBYTE (args[n]), multibyte);
maybe_combine_byte = 1;
this_nchars = strlen (p);
if (multibyte)
- p += str_to_multibyte (p, buf + total - 1 - p, this_nchars);
+ p += str_to_multibyte ((unsigned char *) p,
+ buf + total - 1 - p, this_nchars);
else
p += this_nchars;
nchars += this_nchars;
else if (multibyte)
{
/* Convert a single-byte character to multibyte. */
- int len = copy_text (format, p, 1, 0, 1);
+ int len = copy_text ((unsigned char *) format, (unsigned char *) p,
+ 1, 0, 1);
p += len;
format++;
abort ();
if (maybe_combine_byte)
- nchars = multibyte_chars_in_text (buf, p - buf);
+ nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If we allocated BUF with malloc, free it too. */
{
int i1, i2;
/* Check they're chars, not just integers, otherwise we could get array
- bounds violations in DOWNCASE. */
+ bounds violations in downcase. */
CHECK_CHARACTER (c1);
CHECK_CHARACTER (c2);
if (XINT (c1) == XINT (c2))
return Qt;
- if (NILP (current_buffer->case_fold_search))
+ if (NILP (BVAR (current_buffer, case_fold_search)))
return Qnil;
- /* Do these in separate statements,
- then compare the variables.
- because of the way DOWNCASE uses temp variables. */
i1 = XFASTINT (c1);
- if (NILP (current_buffer->enable_multibyte_characters)
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters))
&& ! ASCII_CHAR_P (i1))
{
MAKE_CHAR_MULTIBYTE (i1);
}
i2 = XFASTINT (c2);
- if (NILP (current_buffer->enable_multibyte_characters)
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters))
&& ! ASCII_CHAR_P (i2))
{
MAKE_CHAR_MULTIBYTE (i2);
}
- i1 = DOWNCASE (i1);
- i2 = DOWNCASE (i2);
- return (i1 == i2 ? Qt : Qnil);
+ return (downcase (i1) == downcase (i2) ? Qt : Qnil);
}
\f
/* Transpose the markers in two regions of the current buffer, and