#include "window.h"
#include "blockinput.h"
-#ifndef USER_FULL_NAME
-#define USER_FULL_NAME pw->pw_gecos
-#endif
-
#ifndef USE_CRT_DLL
extern char **environ;
#endif
XSETFASTINT (val, 0);
return val;
}
-\f
-static Lisp_Object
-buildmark (ptrdiff_t charpos, ptrdiff_t bytepos)
-{
- register Lisp_Object mark;
- mark = Fmake_marker ();
- set_marker_both (mark, Qnil, charpos, bytepos);
- return mark;
-}
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
doc: /* Return value of point, as an integer.
doc: /* Return value of point, as a marker object. */)
(void)
{
- return buildmark (PT, PT_BYTE);
+ return build_marker (current_buffer, PT, PT_BYTE);
}
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
if (NILP (object))
XSETBUFFER (object, current_buffer);
else if (WINDOWP (object))
- object = XWINDOW (object)->buffer;
+ object = WGET (XWINDOW (object), buffer);
if (!BUFFERP (object))
/* pos-property only makes sense in buffers right now, since strings
Lisp_Object
save_excursion_save (void)
{
- int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
+ int visible = (XBUFFER (WGET (XWINDOW (selected_window), buffer))
== current_buffer);
return Fcons (Fpoint_marker (),
and cleaner never to alter the window/buffer connections. */
tem1 = Fcar (tem);
if (!NILP (tem1)
- && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
+ && current_buffer != XBUFFER (WGET (XWINDOW (selected_window), buffer)))
Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
#endif /* 0 */
tem = XCDR (info);
if (visible_p
&& !EQ (tem, selected_window)
- && (tem1 = XWINDOW (tem)->buffer,
+ && (tem1 = WGET (XWINDOW (tem), buffer),
(/* Window is live... */
BUFFERP (tem1)
/* ...and it shows the current buffer. */
This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
(void)
{
- return buildmark (BEGV, BEGV_BYTE);
+ return build_marker (current_buffer, BEGV, BEGV_BYTE);
}
DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
is in effect, in which case it is less. */)
(void)
{
- return buildmark (ZV, ZV_BYTE);
+ return build_marker (current_buffer, ZV, ZV_BYTE);
}
DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
picosecond counts. */)
(void)
{
- EMACS_TIME t;
-
- EMACS_GET_TIME (t);
- return make_lisp_time (t);
+ return make_lisp_time (current_emacs_time ());
}
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
struct rusage usage;
time_t secs;
int usecs;
- EMACS_TIME t;
if (getrusage (RUSAGE_SELF, &usage) < 0)
/* This shouldn't happen. What action is appropriate? */
usecs -= 1000000;
secs++;
}
- EMACS_SET_SECS_USECS (t, secs, usecs);
- return make_lisp_time (t);
+ return make_lisp_time (make_emacs_time (secs, usecs * 1000));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
}
/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
- list, generate the corresponding EMACS_TIME value *RESULT, and
- if RESULT_PSEC is not null store into *RESULT_PSEC the
- (nonnegative) difference in picoseconds between the input time and
- the returned time. Return nonzero if successful. */
+ 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 EMACS_TIME.
+ If *DRESULT is not null, store into *DRESULT the number of
+ seconds since the start of the POSIX Epoch.
+
+ Return nonzero if successful. */
int
decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
- Lisp_Object psec, EMACS_TIME *result, int *result_psec)
+ Lisp_Object psec,
+ EMACS_TIME *result, double *dresult)
{
EMACS_INT hi, lo, us, ps;
- time_t sec;
if (! (INTEGERP (high) && INTEGERP (low)
&& INTEGERP (usec) && INTEGERP (psec)))
return 0;
us = us % 1000000 + 1000000 * (us % 1000000 < 0);
lo &= (1 << 16) - 1;
- /* Check for overflow in the highest-order component. */
- if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi)
- && hi <= TIME_T_MAX >> 16))
- return 0;
+ if (result)
+ {
+ if ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi)
+ && hi <= TIME_T_MAX >> 16)
+ {
+ /* Return the greatest representable time that is not greater
+ than the requested time. */
+ time_t sec = hi;
+ *result = make_emacs_time ((sec << 16) + lo, us * 1000 + ps / 1000);
+ }
+ else
+ {
+ /* Overflow in the highest-order component. */
+ return 0;
+ }
+ }
+
+ if (dresult)
+ *dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0;
- sec = hi;
- EMACS_SET_SECS_NSECS (*result, (sec << 16) + lo, us * 1000 + ps / 1000);
- if (result_psec)
- *result_psec = ps % 1000;
return 1;
}
/* Decode a Lisp list SPECIFIED_TIME that represents a time.
If SPECIFIED_TIME is nil, use the current time.
- Round the time down to the nearest EMACS_TIME value, and
- if PPSEC is not null store into *PPSEC the (nonnegative) difference in
- picoseconds between the input time and the returned time.
+
+ Round the time down to the nearest EMACS_TIME value.
Return seconds since the Epoch.
Signal an error if unsuccessful. */
EMACS_TIME
-lisp_time_argument (Lisp_Object specified_time, int *ppsec)
+lisp_time_argument (Lisp_Object specified_time)
{
EMACS_TIME t;
if (NILP (specified_time))
- EMACS_GET_TIME (t);
+ t = current_emacs_time ();
else
{
Lisp_Object high, low, usec, psec;
if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
- && decode_time_components (high, low, usec, psec, &t, ppsec)))
+ && decode_time_components (high, low, usec, psec, &t, 0)))
error ("Invalid time specification");
}
return t;
}
/* Like lisp_time_argument, except decode only the seconds part,
- and do not check the subseconds part, and always round down. */
+ do not allow out-of-range time stamps, do not check the subseconds part,
+ and always round down. */
static time_t
lisp_seconds_argument (Lisp_Object specified_time)
{
or (if you need time as a string) `format-time-string'. */)
(Lisp_Object specified_time)
{
- int psec;
- EMACS_TIME t = lisp_time_argument (specified_time, &psec);
- double ps = (1000 * 1000 * 1000 <= INTMAX_MAX / 1000
- ? EMACS_NSECS (t) * (intmax_t) 1000 + psec
- : EMACS_NSECS (t) * 1e3 + psec);
- return make_float (EMACS_SECS (t) + ps / 1e12);
+ double t;
+ if (NILP (specified_time))
+ {
+ EMACS_TIME now = current_emacs_time ();
+ t = EMACS_SECS (now) + EMACS_NSECS (now) / 1e9;
+ }
+ else
+ {
+ Lisp_Object high, low, usec, psec;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, usec, psec, 0, &t)))
+ error ("Invalid time specification");
+ }
+ return make_float (t);
}
/* Write information into buffer S of size MAXSIZE, according to the
usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
- EMACS_TIME t = lisp_time_argument (timeval, 0);
+ EMACS_TIME t = lisp_time_argument (timeval);
struct tm tm;
CHECK_STRING (format_string);
while (1)
{
+ time_t *taddr = emacs_secs_addr (&t);
BLOCK_INPUT;
synchronize_system_time_locale ();
- tm = ut ? gmtime (EMACS_SECS_ADDR (t)) : localtime (EMACS_SECS_ADDR (t));
+ tm = ut ? gmtime (taddr) : localtime (taddr);
if (! tm)
{
UNBLOCK_INPUT;
if (STRING_BYTES_BOUND <= len)
string_overflow ();
size = len + 1;
- SAFE_ALLOCA (buf, char *, size);
+ buf = SAFE_ALLOCA (size);
}
UNBLOCK_INPUT;
tm.tm_isdst = -1;
if (CONSP (zone))
- zone = Fcar (zone);
+ zone = XCAR (zone);
if (NILP (zone))
{
BLOCK_INPUT;
Lisp_Object zone_offset, zone_name;
zone_offset = Qnil;
- EMACS_SET_SECS_NSECS (value, lisp_seconds_argument (specified_time), 0);
+ value = make_emacs_time (lisp_seconds_argument (specified_time), 0);
zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm);
BLOCK_INPUT;
- t = gmtime (EMACS_SECS_ADDR (value));
+ t = gmtime (emacs_secs_addr (&value));
if (t)
offset = tm_diff (&localtm, t);
UNBLOCK_INPUT;
int m = offset / 60;
int am = offset < 0 ? - m : m;
char buf[sizeof "+00" + INT_STRLEN_BOUND (int)];
- sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
- zone_name = build_string (buf);
+ zone_name = make_formatted_string (buf, "%c%02d%02d",
+ (offset < 0 ? '-' : '+'),
+ am / 60, am % 60);
}
}
return Qnil;
}
\f
-DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
+DEFUN ("insert-char", Finsert_char, Sinsert_char, 1, 3,
+ "(list (read-char-by-name \"Insert character (Unicode name or hex): \")\
+ (prefix-numeric-value current-prefix-arg)\
+ t))",
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. */)
+Interactively, prompt for CHARACTER. You can specify CHARACTER in one
+of these ways:
+
+ - As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
+ Completion is available; if you type a substring of the name
+ preceded by an asterisk `*', Emacs shows all names which include
+ that substring, not necessarily at the beginning of the name.
+
+ - As a hexadecimal code point, e.g. 263A. Note that code points in
+ Emacs are equivalent to Unicode up to 10FFFF (which is the limit of
+ the Unicode code space).
+
+ - As a code point with a radix specified with #, e.g. #o21430
+ (octal), #x2318 (hex), or #10r8984 (decimal).
+
+If called interactively, COUNT is given by the prefix argument. If
+omitted or nil, it defaults to 1.
+
+Inserting the character(s) relocates point and before-insertion
+markers in the same ways as the function `insert'.
+
+The optional third argument INHERIT, if non-nil, says to inherit text
+properties from adjoining text, if those properties are sticky. If
+called interactively, INHERIT is t. */)
(Lisp_Object character, Lisp_Object count, Lisp_Object inherit)
{
int i, stringlen;
char string[4000];
CHECK_CHARACTER (character);
+ if (NILP (count))
+ XSETFASTINT (count, 1);
CHECK_NUMBER (count);
c = XFASTINT (character);
{
Lisp_Object beg, end;
- beg = buildmark (BEGV, BEGV_BYTE);
- end = buildmark (ZV, ZV_BYTE);
+ beg = build_marker (current_buffer, BEGV, BEGV_BYTE);
+ end = build_marker (current_buffer, ZV, ZV_BYTE);
/* END must move forward if text is inserted at its exact location. */
XMARKER (end)->insertion_type = 1;
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
+ /* These aren't needed anymore, so don't wait for GC. */
+ free_marker (XCAR (data));
+ free_marker (XCDR (data));
+ free_cons (XCONS (data));
}
else
/* A buffer, which means that there was no old restriction. */
ptrdiff_t i;
if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs)
memory_full (SIZE_MAX);
- SAFE_ALLOCA (info, struct info *, (nargs + 1) * sizeof *info + formatlen);
+ info = SAFE_ALLOCA ((nargs + 1) * sizeof *info + formatlen);
discarded = (char *) &info[nargs + 1];
for (i = 0; i < nargs + 1; i++)
{
{
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (temp, unsigned char *, len2_byte);
+ temp = SAFE_ALLOCA (len2_byte);
/* Don't precompute these addresses. We have to compute them
at the last minute, because the relocating allocator might
{
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ 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);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3);
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ 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);
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
/* holds region 2 */
- SAFE_ALLOCA (temp, unsigned char *, len2_byte);
+ temp = SAFE_ALLOCA (len2_byte);
start1_addr = BYTE_POS_ADDR (start1_byte);
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start2_addr, len2_byte);
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
/* holds region 1 */
- SAFE_ALLOCA (temp, unsigned char *, len1_byte);
+ 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);