#include "lisp.h"

#include <float.h>

#include <limits.h>

#include <c-ctype.h>

#include <intprops.h>

#include <stdlib.h>

#include <verify.h>

#include "composite.h"

#include "intervals.h"

#include "character.h"

#include "buffer.h"

#include "window.h"

#include "blockinput.h"

static void update_buffer_properties (ptrdiff_t, ptrdiff_t);

static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);

/* The cached value of Vsystem_name. This is used only to compare it

to Vsystem_name, so it need not be visible to the GC. */

static Lisp_Object cached_system_name;

cached_system_name = Vsystem_name;

}

void

{

const char *user_name;

register char *p;

struct passwd *pw; /* password entry for the current user */

/* Set up system_name even when dumping. */

init_and_cache_system_name ();

pw = getpwuid (getuid ());

#ifdef MSDOS

/* We let the real user name default to "root" because that's quite

else

{

uid_t euid = geteuid ();

}

Vuser_full_name = Fuser_full_name (tem);

unsigned char str[MAX_MULTIBYTE_LENGTH];

CHECK_CHARACTER (character);

len = CHAR_STRING (c, str);

return make_string_from_bytes ((char *) str, 1, len);

(Lisp_Object byte)

{

unsigned char b;

error ("Invalid byte");

return make_string_from_bytes ((char *) &b, 1, 1);

}

{

if (MARKERP (position))

set_point_from_marker (position);

else

wrong_type_argument (Qinteger_or_marker_p, position);

return position;

error ("The mark is not set now, so there is no region");

/* Clip to the current narrowing (bug#11770). */

? PT

}

DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,

static ptrdiff_t

overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)

{

ptrdiff_t idx = 0;

{

if (endpos < pos)

break;

if (startpos <= pos)

{

if (idx < len)

}

}

{

if (pos < startpos)

break;

if (pos <= endpos)

{

if (idx < len)

at POSITION. */)

(Lisp_Object position, register Lisp_Object prop, Lisp_Object object)

{

if (NILP (object))

XSETBUFFER (object, current_buffer);

return Fget_text_property (position, prop, object);

else

{

ptrdiff_t noverlays;

Lisp_Object *overlay_vec, tem;

struct buffer *obuf = current_buffer;

if (stickiness > 0)

return Fget_text_property (position, prop, object);

else if (stickiness < 0

prop, object);

else

return Qnil;

if (NILP (pos))

XSETFASTINT (pos, PT);

else

after_field

= get_char_property_and_overlay (pos, Qfield, Qnil, NULL);

before_field

Qfield, Qnil, NULL)

/* Using nil here would be a more obvious choice, but it would

fail when the buffer starts with a non-sticky field. */

if (at_field_start)

/* POS is at the edge of a field, and we should consider it as

the beginning of the following field. */

else

/* Find the previous field boundary. */

{

p = Fprevious_single_char_property_change (p, Qfield, Qnil,

beg_limit);

}

}

if (at_field_end)

/* POS is at the edge of a field, and we should consider it as

the end of the previous field. */

else

/* Find the next field boundary. */

{

pos = Fnext_single_char_property_change (pos, Qfield, Qnil,

end_limit);

}

}

}

{

ptrdiff_t beg;

find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);

}

DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0,

{

ptrdiff_t end;

find_field (pos, escape_from_edge, Qnil, 0, limit, &end);

}

DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,

XSETFASTINT (new_pos, PT);

}

if (NILP (Vinhibit_field_text_motion)

&& !EQ (new_pos, old_pos)

previous positions; we could use `Fget_pos_property'

instead, but in itself that would fail inside non-sticky

fields (like comint prompts). */

&& !NILP (Fget_char_property (prev_new, Qfield, Qnil)))

&& !NILP (Fget_char_property (prev_old, Qfield, Qnil))))

&& (NILP (inhibit_capture_property)

/* 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 (Fget_pos_property (old_pos, inhibit_capture_property, Qnil))

|| NILP (Fget_char_property

(old_pos, inhibit_capture_property, Qnil))

|| NILP (Fget_char_property

other side of NEW_POS, which would mean that NEW_POS is

already acceptable, and it's not necessary to constrain it

to FIELD_BOUND. */

/* 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

/* This is the ONLY_IN_LINE case, check that NEW_POS and

FIELD_BOUND are on the same line by seeing whether

there's an intervening newline or not. */

fwd ? -1 : 1, &shortage, NULL, 1),

shortage != 0)))

/* Constrain NEW_POS to FIELD_BOUND. */

new_pos = field_bound;

/* The NEW_POS argument was originally nil, so automatically set PT. */

}

return new_pos;

if (NILP (n))

XSETFASTINT (n, 1);

else

/* Return END constrained to the current input field. */

Qt, Qnil);

}

if (NILP (n))

XSETFASTINT (n, 1);

else

end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),

NULL);

/* Return END_POS constrained to the current input field. */

Qnil, Qt, Qnil);

}

{

}

/* Restore saved buffer before leaving `save-excursion' special form. */

void

{

/* If we're unwinding to top level, saved buffer may be deleted. This

/* Point marker. */

/* If buffer was visible in a window, and a different window was

selected, and the old selected window is still showing this

buffer, restore point in that window. */

}

DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,

register Lisp_Object val;

ptrdiff_t count = SPECPDL_INDEX ();

val = Fprogn (args);

return unbind_to (count, val);

(Lisp_Object buffer)

{

if (NILP (buffer))

else

{

CHECK_BUFFER (buffer);

- BUF_BEG (XBUFFER (buffer)));

}

}

If POSITION is out of range, the value is nil. */)

(Lisp_Object position)

{

return Qnil;

}

DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0,

{

ptrdiff_t pos_byte;

if (pos_byte < BEG_BYTE || pos_byte > Z_BYTE)

return Qnil;

if (Z != Z_BYTE)

character. */

while (!CHAR_HEAD_P (FETCH_BYTE (pos_byte)))

pos_byte--;

}



DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,

if (NILP (pos))

{

pos_byte = PT_BYTE;

}

{

pos_byte = marker_byte_position (pos);

if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)

}

else

{

return Qnil;

}

}

DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0,

}

else

{

return Qnil;

}

if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))

Also, if the environment variables LOGNAME or USER are set,

that determines the value of this function.

of the user with that uid, or nil if there is no such user. */)

(Lisp_Object uid)

{

(That can happen if Emacs is dumpable

but you decide to run `temacs -l loadup' and not dump. */

if (NILP (Vuser_login_name))

if (NILP (uid))

return Vuser_login_name;

(That can happen if Emacs is dumpable

but you decide to run `temacs -l loadup' and not dump. */

if (NILP (Vuser_login_name))

return Vuser_real_login_name;

}

DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,

doc: /* Return the effective uid of Emacs.

(void)

{

uid_t euid = geteuid ();

}

DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,

doc: /* Return the real uid of Emacs.

(void)

{

uid_t uid = getuid ();

}

DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0,

doc: /* Return the effective gid of Emacs.

(void)

{

gid_t egid = getegid ();

}

DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0,

doc: /* Return the real gid of Emacs.

(void)

{

gid_t gid = getgid ();

}

DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0,

If the full name corresponding to Emacs's userid is not known,

return "unknown".

of the user with that uid, or nil if there is no such user.

If UID is a string, return the full name of the user with that login

name, or nil if there is no such user. */)

/* Substitute the login name for the &, upcasing the first character. */

if (q)

{

USE_SAFE_ALLOCA;

char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1);

memcpy (r, p, q - p);

}

DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,

(void)

{

pid_t pid = getpid ();

}



/* Insert NARGS Lisp objects in the array ARGS by calling INSERT_FUNC

(if a type of object is Lisp_Int) or INSERT_FROM_STRING_FUNC (if a

val = args[argnum];

if (CHARACTERP (val))

{

unsigned char str[MAX_MULTIBYTE_LENGTH];

int len;

CHECK_CHARACTER (character);

if (NILP (count))

XSETFASTINT (count, 1);

if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))

len = CHAR_STRING (c, str);

else

str[0] = c, len = 1;

return Qnil;

buffer_overflow ();

stringlen = min (n, sizeof string - sizeof string % len);

for (i = 0; i < stringlen; i++)

string[i] = str[i % len];

from adjoining text, if those properties are sticky. */)

(Lisp_Object byte, Lisp_Object count, Lisp_Object inherit)

{

&& ! NILP (BVAR (current_buffer, enable_multibyte_characters)))

return Finsert_char (byte, count, inherit);

}

{

update_buffer_properties (start, end);

copy_intervals_to_string (result, current_buffer, start,

end - start);

}

if (!NILP (Vbuffer_access_fontified_property))

{

Lisp_Object tem

Vbuffer_access_fontified_property,

Qnil, Qnil);

if (NILP (tem))

}

CALLN (Frun_hook_with_args, Qbuffer_access_fontify_functions,

}

}

register ptrdiff_t b, e;

validate_region (&start, &end);

return make_buffer_string (b, e, 1);

}

register ptrdiff_t b, e;

validate_region (&start, &end);

return make_buffer_string (b, e, 0);

}

b = BUF_BEGV (bp);

else

{

}

if (NILP (end))

e = BUF_ZV (bp);

else

{

}

if (b > e)

begp1 = BUF_BEGV (bp1);

else

{

}

if (NILP (end1))

endp1 = BUF_ZV (bp1);

else

{

}

if (begp1 > endp1)

begp2 = BUF_BEGV (bp2);

else

{

}

if (NILP (end2))

endp2 = BUF_ZV (bp2);

else

{

}

if (begp2 > endp2)

}

if (c1 != c2)

chars++;

rarely_quit (chars);

/* The strings match as far as they go.

If one is shorter, that one is less. */

if (chars < endp1 - begp1)

else if (chars < endp2 - begp2)

/* Same length too => they are equal. */

}



return Qnil;

}

/* FIXME: It is not documented how to initialize the contents of the

context structure. This code cargo-cults from the existing

caller in src/analyze.c of GNU Diffutils, which appears to

Fundo_boundary ();

bool modification_hooks_inhibited = false;

/* We are going to make a lot of small modifications, and having the

modification hooks called for each of them will slow us down.

if (beg_b < end_b)

{

SET_PT (beg_a);

}

}

--i;

--j;

}

rbc_quitcounter = 0;

if (modification_hooks_inhibited)

validate_region (&start, &end);

CHECK_CHARACTER (fromchar);

CHECK_CHARACTER (tochar);

if (multibyte_p)

{

tostr[0] = toc;

}

pos_byte = CHAR_TO_BYTE (pos);

end_byte = stop;

/* If we don't want undo, turn off putting stuff on the list.

else if (!changed)

{

changed = -1;

if (! NILP (noundo))

{

update_compositions (changed, last_changed, CHECK_ALL);

}

}

buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1);

pos_byte += len1;

}

break;

}

if (i == len)

tt = SDATA (table);

}

pos_byte = CHAR_TO_BYTE (pos);

modify_text (pos, end_pos);

cnt = 0;

val = CHAR_TABLE_REF (table, oc);

if (CHARACTERP (val))

{

str_len = CHAR_STRING (nc, buf);

str = buf;

}

}

else

{

}

replace_range (pos, pos + len, string, 1, 0, 1, 0);

pos_byte += SBYTES (string);

pos++;

}

}

DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",

(Lisp_Object start, Lisp_Object end)

{

validate_region (&start, &end);

return Qnil;

}

(Lisp_Object start, Lisp_Object end)

{

validate_region (&start, &end);

return empty_unibyte_string;

}



DEFUN ("widen", Fwiden, Swiden, 0, 0, "",

or markers) bounding the text that should remain visible. */)

(register Lisp_Object start, Lisp_Object end)

{

{

Lisp_Object tem;

tem = start; start = end; end = tem;

}

args_out_of_range (start, end);

current_buffer->clip_changed = 1;

/* Changing the buffer bounds invalidates any recorded current column. */

invalidate_current_column ();

return Qnil;

for (i = 1; i < nargs; i += 2)

properties = Fcons (args[i], Fcons (args[i + 1], properties));

properties, string);

return string;

}

contain either numbered or unnumbered %-sequences but not both, except

that %% can be mixed with numbered %-sequences.

The - and 0 flags affect the width specifier, as described below.

The # flag means to use an alternate display form for %o, %x, %X, %e,

%f, and %g sequences: for %o, it ensures that the result begins with

for %e and %f, it causes a decimal point to be included even if the

precision is zero; for %g, it causes a decimal point to be

included even if the precision is zero, and also forces trailing

static Lisp_Object

styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)

{

ptrdiff_t n; /* The number of the next arg to substitute. */

char *buf = initial_buffer;

ptrdiff_t bufsize = sizeof initial_buffer;

ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;

ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;

/* Allocate the info and discarded tables. */

|| SIZE_MAX < alloca_size)

memory_full (SIZE_MAX);

info = SAFE_ALLOCA (alloca_size);

string was not copied into the output.

It is 2 if byte I was not the first byte of its character. */

char *discarded = (char *) &info[nspec_bound];

memset (discarded, 0, formatlen);

/* Try to determine whether the result should be multibyte.

char const *convsrc = format;

unsigned char format_char = *format++;

ptrdiff_t convbytes = 1;

if (format_char == '%')

{

}

else if (conversion == 'c')

{

{

if (!multibyte)

{

spec->intervals = arg_intervals = true;

new_result = true;

}

}

else if (! (conversion == 'c' || conversion == 'd'

|| conversion == 'X'))

error ("Invalid format operation %%%c",

STRING_CHAR ((unsigned char *) format - 1));

error ("Format specifier doesn't match argument type");

else

{

/* Avoid undefined behavior in underlying sprintf. */

if (conversion == 'd' || conversion == 'i')

with "L" possibly inserted for floating-point formats,

and with pM inserted for integer formats.

At most two flags F can be specified at once. */

int prec = -1;

if (precision_given)

prec = min (precision, USEFUL_PRECISION_MAX);

padding and excess precision, though, because sprintf limits

char (passed as int), wide signed int, and wide

unsigned int. Treat them separately because the

sprintf ABI is sensitive to which type is passed. Be

careful about integer overflow, NaNs, infinities, and

conversions; for example, the min and max macros are

not suitable here. */

ptrdiff_t sprintf_bytes;

if (float_conversion)

{

{

}

else

}

else if (conversion == 'c')

{

/* Don't use sprintf here, as it might mishandle prec. */

sprintf_bytes = prec != 0;

}

else if (conversion == 'd' || conversion == 'i')

{

else

{

}

}

else

{

uprintmax_t x;

{

else

{

}

}

}

/* Now the length of the formatted item is known, except it omits

padding and excess precision. Deal with excess precision

ptrdiff_t excess_precision

= precision_given ? precision - prec : 0;

{

}

/* Compute the total bytes needed for this item, including

excess precision and padding. */

ptrdiff_t numwidth;

numwidth = PTRDIFF_MAX;

ptrdiff_t padding

= numwidth < field_width ? field_width - numwidth : 0;

|| max_bufsize - padding <= numwidth)

string_overflow ();

convbytes = numwidth + padding;

if (convbytes <= buf + bufsize - p)

{

{

leading_zeros += padding;

padding = 0;

}

&& (conversion == 'e' || conversion == 'g'))

{

if (e)

}

{

}

new_result = true;

}

}

}

}

copy_char:

}

ptrdiff_t used = p - buf;

string_overflow ();

{

}

if (bufsize < p - buf)

if (string_intervals (args[0]) || arg_intervals)

{

/* Add text properties from the format string. */

len, Qnil);

if (CONSP (props))

{

Lisp_Object item = XCAR (list);

/* First adjust the property start position. */

/* Advance BYTEPOS, POSITION, TRANSLATED and ARGN

up to this position. */

}

}

/* Likewise adjust the property end position. */

for (; position < pos; bytepos++)

{

}

}

}

}

/* Add text properties from arguments. */

for (ptrdiff_t i = 0; i < nspec; i++)

if (info[i].intervals)

{

props = text_property_list (info[i].argument,

props = extend_property_ranges (props, len, new_len);

/* If successive arguments have properties, be sure that

the value of `composition' property be the copy. */

if (1 < i && info[i - 1].end)

make_composition_value_copy (props);

add_text_properties_from_list (val, props,

}

}

CHECK_CHARACTER (c1);

CHECK_CHARACTER (c2);

return Qt;

if (NILP (BVAR (current_buffer, case_fold_search)))

return Qnil;

/* FIXME: It is possible to compare multibyte characters even when

the current buffer is unibyte. Unfortunately this is ambiguous

}

}

doc: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.

The regions should not be overlapping, because the size of the buffer is

never changed in a transposition.

Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update

any markers that happen to be located in the regions.

(Lisp_Object startr1, Lisp_Object endr1, Lisp_Object startr2, Lisp_Object endr2, Lisp_Object leave_markers)

{

register ptrdiff_t start1, end1, start2, end2;

validate_region (&startr1, &endr1);

validate_region (&startr2, &endr2);

gap = GPT;

/* Swap the regions if they're reversed. */

{

USE_SAFE_ALLOCA;

record_change (start1, len1);

record_change (start2, len2);

tmp_interval1 = copy_intervals (cur_intv, start1, len1);

DEFVAR_LISP ("operating-system-release", Voperating_system_release,

doc: /* The release of the operating system Emacs is running on. */);

defsubr (&Spropertize);

defsubr (&Schar_equal);

defsubr (&Sgoto_char);

defsubr (&Sinsert_byte);

defsubr (&Suser_login_name);

defsubr (&Suser_real_login_name);

defsubr (&Suser_uid);

defsubr (&Suser_real_uid);

defsubr (&Sgroup_real_gid);

defsubr (&Suser_full_name);

defsubr (&Semacs_pid);

defsubr (&Ssystem_name);

defsubr (&Smessage);

defsubr (&Smessage_box);