#include <config.h>
#include <sys/types.h>
#include <stdio.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_SYS_UTSNAME_H
#include <sys/utsname.h>
#endif
#include "lisp.h"
#include "systime.h"
#if defined HAVE_SYS_RESOURCE_H
#include <sys/resource.h>
#endif
#include <ctype.h>
#include "intervals.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "frame.h"
#include "window.h"
#include "blockinput.h"
#ifdef STDC_HEADERS
#include <float.h>
#define MAX_10_EXP DBL_MAX_10_EXP
#else
#define MAX_10_EXP 310
#endif
#ifndef NULL
#define NULL 0
#endif
#ifndef USE_CRT_DLL
extern char **environ;
#endif
#define TM_YEAR_BASE 1900
#ifndef TM_YEAR_IN_ASCTIME_RANGE
# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
(1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
#endif
extern size_t emacs_strftimeu P_ ((char *, size_t, const char *,
const struct tm *, int));
static int tm_diff P_ ((struct tm *, struct tm *));
static void find_field P_ ((Lisp_Object, Lisp_Object, Lisp_Object, int *, Lisp_Object, int *));
static void update_buffer_properties P_ ((int, int));
static Lisp_Object region_limit P_ ((int));
int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
static size_t emacs_memftimeu P_ ((char *, size_t, const char *,
size_t, const struct tm *, int));
static void general_insert_function P_ ((void (*) (const unsigned char *, int),
void (*) (Lisp_Object, int, int, int,
int, int),
int, int, Lisp_Object *));
static Lisp_Object subst_char_in_region_unwind P_ ((Lisp_Object));
static Lisp_Object subst_char_in_region_unwind_1 P_ ((Lisp_Object));
static void transpose_markers P_ ((int, int, int, int, int, int, int, int));
#ifdef HAVE_INDEX
extern char *index P_ ((const char *, int));
#endif
Lisp_Object Vbuffer_access_fontify_functions;
Lisp_Object Qbuffer_access_fontify_functions;
Lisp_Object Vbuffer_access_fontified_property;
Lisp_Object Fuser_full_name P_ ((Lisp_Object));
Lisp_Object Vinhibit_field_text_motion;
Lisp_Object Vsystem_name;
Lisp_Object Vuser_real_login_name;
Lisp_Object Vuser_full_name;
Lisp_Object Vuser_login_name;
Lisp_Object Voperating_system_release;
Lisp_Object Qfield;
Lisp_Object Qboundary;
void
init_editfns ()
{
char *user_name;
register unsigned char *p;
struct passwd *pw;
Lisp_Object tem;
init_system_name ();
#ifndef CANNOT_DUMP
if (!initialized)
return;
#endif
pw = (struct passwd *) getpwuid (getuid ());
#ifdef MSDOS
Vuser_real_login_name = build_string (pw ? pw->pw_name : "root");
#else
Vuser_real_login_name = build_string (pw ? pw->pw_name : "unknown");
#endif
user_name = (char *) getenv ("LOGNAME");
if (!user_name)
#ifdef WINDOWSNT
user_name = (char *) getenv ("USERNAME");
#else
user_name = (char *) getenv ("USER");
#endif
if (!user_name)
{
pw = (struct passwd *) getpwuid (geteuid ());
user_name = (char *) (pw ? pw->pw_name : "unknown");
}
Vuser_login_name = build_string (user_name);
tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid())
: Vuser_login_name);
p = (unsigned char *) getenv ("NAME");
if (p)
Vuser_full_name = build_string (p);
else if (NILP (Vuser_full_name))
Vuser_full_name = build_string ("unknown");
#ifdef HAVE_SYS_UTSNAME_H
{
struct utsname uts;
uname (&uts);
Voperating_system_release = build_string (uts.release);
}
#else
Voperating_system_release = Qnil;
#endif
}
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
doc: )
(character)
Lisp_Object character;
{
int len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
CHECK_NUMBER (character);
len = (SINGLE_BYTE_CHAR_P (XFASTINT (character))
? (*str = (unsigned char)(XFASTINT (character)), 1)
: char_to_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,
doc: )
(string)
register Lisp_Object string;
{
register Lisp_Object val;
CHECK_STRING (string);
if (SCHARS (string))
{
if (STRING_MULTIBYTE (string))
XSETFASTINT (val, STRING_CHAR (SDATA (string), SBYTES (string)));
else
XSETFASTINT (val, SREF (string, 0));
}
else
XSETFASTINT (val, 0);
return val;
}
static Lisp_Object
buildmark (charpos, bytepos)
int charpos, 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: )
()
{
Lisp_Object temp;
XSETFASTINT (temp, PT);
return temp;
}
DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
doc: )
()
{
return buildmark (PT, PT_BYTE);
}
int
clip_to_bounds (lower, num, upper)
int lower, num, upper;
{
if (num < lower)
return lower;
else if (num > upper)
return upper;
else
return num;
}
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
doc: )
(position)
register Lisp_Object position;
{
int pos;
if (MARKERP (position)
&& current_buffer == XMARKER (position)->buffer)
{
pos = marker_position (position);
if (pos < BEGV)
SET_PT_BOTH (BEGV, BEGV_BYTE);
else if (pos > ZV)
SET_PT_BOTH (ZV, ZV_BYTE);
else
SET_PT_BOTH (pos, marker_byte_position (position));
return position;
}
CHECK_NUMBER_COERCE_MARKER (position);
pos = clip_to_bounds (BEGV, XINT (position), ZV);
SET_PT (pos);
return position;
}
static Lisp_Object
region_limit (beginningp)
int beginningp;
{
extern Lisp_Object Vmark_even_if_inactive;
Lisp_Object m;
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
xsignal0 (Qmark_inactive);
m = Fmarker_position (current_buffer->mark);
if (NILP (m))
error ("The mark is not set now, so there is no region");
if ((PT < XFASTINT (m)) == (beginningp != 0))
m = make_number (PT);
return m;
}
DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
doc: )
()
{
return region_limit (1);
}
DEFUN ("region-end", Fregion_end, Sregion_end, 0, 0, 0,
doc: )
()
{
return region_limit (0);
}
DEFUN ("mark-marker", Fmark_marker, Smark_marker, 0, 0, 0,
doc: )
()
{
return current_buffer->mark;
}
static int
overlays_around (pos, vec, len)
int pos;
Lisp_Object *vec;
int len;
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
int startpos, endpos;
int idx = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
XSETMISC (overlay, tail);
end = OVERLAY_END (overlay);
endpos = OVERLAY_POSITION (end);
if (endpos < pos)
break;
start = OVERLAY_START (overlay);
startpos = OVERLAY_POSITION (start);
if (startpos <= pos)
{
if (idx < len)
vec[idx] = overlay;
idx++;
}
}
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
XSETMISC (overlay, tail);
start = OVERLAY_START (overlay);
startpos = OVERLAY_POSITION (start);
if (pos < startpos)
break;
end = OVERLAY_END (overlay);
endpos = OVERLAY_POSITION (end);
if (pos <= endpos)
{
if (idx < len)
vec[idx] = overlay;
idx++;
}
}
return idx;
}
Lisp_Object
get_pos_property (position, prop, object)
Lisp_Object position, object;
register Lisp_Object prop;
{
CHECK_NUMBER_COERCE_MARKER (position);
if (NILP (object))
XSETBUFFER (object, current_buffer);
else if (WINDOWP (object))
object = XWINDOW (object)->buffer;
if (!BUFFERP (object))
return Fget_text_property (position, prop, object);
else
{
int posn = XINT (position);
int noverlays;
Lisp_Object *overlay_vec, tem;
struct buffer *obuf = current_buffer;
set_buffer_temp (XBUFFER (object));
noverlays = 40;
overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
noverlays = overlays_around (posn, overlay_vec, noverlays);
if (noverlays > 40)
{
overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
noverlays = overlays_around (posn, overlay_vec, noverlays);
}
noverlays = sort_overlays (overlay_vec, noverlays, NULL);
set_buffer_temp (obuf);
while (--noverlays >= 0)
{
Lisp_Object ol = overlay_vec[noverlays];
tem = Foverlay_get (ol, prop);
if (!NILP (tem))
{
Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
if ((OVERLAY_POSITION (start) == posn
&& XMARKER (start)->insertion_type == 1)
|| (OVERLAY_POSITION (finish) == posn
&& XMARKER (finish)->insertion_type == 0))
;
else
{
return tem;
}
}
}
{
int stickiness = text_property_stickiness (prop, position, object);
if (stickiness > 0)
return Fget_text_property (position, prop, object);
else if (stickiness < 0
&& XINT (position) > BUF_BEGV (XBUFFER (object)))
return Fget_text_property (make_number (XINT (position) - 1),
prop, object);
else
return Qnil;
}
}
}
static void
find_field (pos, merge_at_boundary, beg_limit, beg, end_limit, end)
Lisp_Object pos;
Lisp_Object merge_at_boundary;
Lisp_Object beg_limit, end_limit;
int *beg, *end;
{
Lisp_Object before_field, after_field;
int at_field_start = 0;
int at_field_end = 0;
if (NILP (pos))
XSETFASTINT (pos, PT);
else
CHECK_NUMBER_COERCE_MARKER (pos);
after_field
= get_char_property_and_overlay (pos, Qfield, Qnil, NULL);
before_field
= (XFASTINT (pos) > BEGV
? get_char_property_and_overlay (make_number (XINT (pos) - 1),
Qfield, Qnil, NULL)
: after_field);
if (NILP (merge_at_boundary))
{
Lisp_Object field = get_pos_property (pos, Qfield, Qnil);
if (!EQ (field, after_field))
at_field_end = 1;
if (!EQ (field, before_field))
at_field_start = 1;
if (NILP (field) && at_field_start && at_field_end)
at_field_end = at_field_start = 0;
}
if (beg)
{
if (at_field_start)
*beg = XFASTINT (pos);
else
{
Lisp_Object p = pos;
if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
p = Fprevious_single_char_property_change (p, Qfield, Qnil,
beg_limit);
p = Fprevious_single_char_property_change (p, Qfield, Qnil,
beg_limit);
*beg = NILP (p) ? BEGV : XFASTINT (p);
}
}
if (end)
{
if (at_field_end)
*end = XFASTINT (pos);
else
{
if (!NILP (merge_at_boundary) && EQ (after_field, Qboundary))
pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
end_limit);
pos = Fnext_single_char_property_change (pos, Qfield, Qnil,
end_limit);
*end = NILP (pos) ? ZV : XFASTINT (pos);
}
}
}
DEFUN ("delete-field", Fdelete_field, Sdelete_field, 0, 1, 0,
doc: )
(pos)
Lisp_Object pos;
{
int beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
if (beg != end)
del_range (beg, end);
return Qnil;
}
DEFUN ("field-string", Ffield_string, Sfield_string, 0, 1, 0,
doc: )
(pos)
Lisp_Object pos;
{
int beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 1);
}
DEFUN ("field-string-no-properties", Ffield_string_no_properties, Sfield_string_no_properties, 0, 1, 0,
doc: )
(pos)
Lisp_Object pos;
{
int beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 0);
}
DEFUN ("field-beginning", Ffield_beginning, Sfield_beginning, 0, 3, 0,
doc: )
(pos, escape_from_edge, limit)
Lisp_Object pos, escape_from_edge, limit;
{
int beg;
find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);
return make_number (beg);
}
DEFUN ("field-end", Ffield_end, Sfield_end, 0, 3, 0,
doc: )
(pos, escape_from_edge, limit)
Lisp_Object pos, escape_from_edge, limit;
{
int end;
find_field (pos, escape_from_edge, Qnil, 0, limit, &end);
return make_number (end);
}
DEFUN ("constrain-to-field", Fconstrain_to_field, Sconstrain_to_field, 2, 5, 0,
doc: )
(new_pos, old_pos, escape_from_edge, only_in_line, inhibit_capture_property)
Lisp_Object new_pos, old_pos;
Lisp_Object escape_from_edge, only_in_line, inhibit_capture_property;
{
int orig_point = 0;
int fwd;
Lisp_Object prev_old, prev_new;
if (NILP (new_pos))
{
orig_point = PT;
XSETFASTINT (new_pos, PT);
}
CHECK_NUMBER_COERCE_MARKER (new_pos);
CHECK_NUMBER_COERCE_MARKER (old_pos);
fwd = (XFASTINT (new_pos) > XFASTINT (old_pos));
prev_old = make_number (XFASTINT (old_pos) - 1);
prev_new = make_number (XFASTINT (new_pos) - 1);
if (NILP (Vinhibit_field_text_motion)
&& !EQ (new_pos, old_pos)
&& (!NILP (Fget_char_property (new_pos, Qfield, Qnil))
|| !NILP (Fget_char_property (old_pos, Qfield, Qnil))
|| (XFASTINT (new_pos) > BEGV
&& !NILP (Fget_char_property (prev_new, Qfield, Qnil)))
|| (XFASTINT (old_pos) > BEGV
&& !NILP (Fget_char_property (prev_old, Qfield, Qnil))))
&& (NILP (inhibit_capture_property)
|| (NILP (get_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))))))
{
int shortage;
Lisp_Object field_bound;
if (fwd)
field_bound = Ffield_end (old_pos, escape_from_edge, new_pos);
else
field_bound = Ffield_beginning (old_pos, escape_from_edge, new_pos);
if (
((XFASTINT (field_bound) < XFASTINT (new_pos)) ? fwd : !fwd)
&& (NILP (only_in_line)
|| (scan_buffer ('\n',
XFASTINT (new_pos), XFASTINT (field_bound),
fwd ? -1 : 1, &shortage, 1),
shortage != 0)))
new_pos = field_bound;
if (orig_point && XFASTINT (new_pos) != orig_point)
SET_PT (XFASTINT (new_pos));
}
return new_pos;
}
DEFUN ("line-beginning-position",
Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
doc: )
(n)
Lisp_Object n;
{
int orig, orig_byte, end;
int count = SPECPDL_INDEX ();
specbind (Qinhibit_point_motion_hooks, Qt);
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
orig = PT;
orig_byte = PT_BYTE;
Fforward_line (make_number (XINT (n) - 1));
end = PT;
SET_PT_BOTH (orig, orig_byte);
unbind_to (count, Qnil);
return Fconstrain_to_field (make_number (end), make_number (orig),
XINT (n) != 1 ? Qt : Qnil,
Qt, Qnil);
}
DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0,
doc: )
(n)
Lisp_Object n;
{
int end_pos;
int orig = PT;
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
end_pos = find_before_next_newline (orig, 0, XINT (n) - (XINT (n) <= 0));
return Fconstrain_to_field (make_number (end_pos), make_number (orig),
Qnil, Qt, Qnil);
}
Lisp_Object
save_excursion_save ()
{
int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
== current_buffer);
return Fcons (Fpoint_marker (),
Fcons (Fcopy_marker (current_buffer->mark, Qnil),
Fcons (visible ? Qt : Qnil,
Fcons (current_buffer->mark_active,
selected_window))));
}
Lisp_Object
save_excursion_restore (info)
Lisp_Object info;
{
Lisp_Object tem, tem1, omark, nmark;
struct gcpro gcpro1, gcpro2, gcpro3;
int visible_p;
tem = Fmarker_buffer (XCAR (info));
if (NILP (tem))
return Qnil;
omark = nmark = Qnil;
GCPRO3 (info, omark, nmark);
Fset_buffer (tem);
tem = XCAR (info);
Fgoto_char (tem);
unchain_marker (XMARKER (tem));
info = XCDR (info);
tem = XCAR (info);
omark = Fmarker_position (current_buffer->mark);
Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
nmark = Fmarker_position (tem);
unchain_marker (XMARKER (tem));
info = XCDR (info);
visible_p = !NILP (XCAR (info));
#if 0
tem1 = Fcar (tem);
if (!NILP (tem1)
&& current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
Fswitch_to_buffer (Fcurrent_buffer (), Qnil);
#endif
info = XCDR (info);
tem = XCAR (info);
tem1 = current_buffer->mark_active;
current_buffer->mark_active = tem;
if (!NILP (Vrun_hooks))
{
if (! NILP (current_buffer->mark_active))
{
if (! EQ (omark, nmark))
call1 (Vrun_hooks, intern ("activate-mark-hook"));
}
else if (! NILP (tem1))
call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
}
tem = XCDR (info);
if (visible_p
&& !EQ (tem, selected_window)
&& (tem1 = XWINDOW (tem)->buffer,
(
BUFFERP (tem1)
&& XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
UNGCPRO;
return Qnil;
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object val;
int count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
val = Fprogn (args);
return unbind_to (count, val);
}
DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object val;
int count = SPECPDL_INDEX ();
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
val = Fprogn (args);
return unbind_to (count, val);
}
DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0,
doc: )
(buffer)
Lisp_Object buffer;
{
if (NILP (buffer))
return make_number (Z - BEG);
else
{
CHECK_BUFFER (buffer);
return make_number (BUF_Z (XBUFFER (buffer))
- BUF_BEG (XBUFFER (buffer)));
}
}
DEFUN ("point-min", Fpoint_min, Spoint_min, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
XSETFASTINT (temp, BEGV);
return temp;
}
DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
doc: )
()
{
return buildmark (BEGV, BEGV_BYTE);
}
DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
XSETFASTINT (temp, ZV);
return temp;
}
DEFUN ("point-max-marker", Fpoint_max_marker, Spoint_max_marker, 0, 0, 0,
doc: )
()
{
return buildmark (ZV, ZV_BYTE);
}
DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
XSETFASTINT (temp, GPT);
return temp;
}
DEFUN ("gap-size", Fgap_size, Sgap_size, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
XSETFASTINT (temp, GAP_SIZE);
return temp;
}
DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
doc: )
(position)
Lisp_Object position;
{
CHECK_NUMBER_COERCE_MARKER (position);
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,
doc: )
(bytepos)
Lisp_Object bytepos;
{
CHECK_NUMBER (bytepos);
if (XINT (bytepos) < BEG_BYTE || XINT (bytepos) > Z_BYTE)
return Qnil;
return make_number (BYTE_TO_CHAR (XINT (bytepos)));
}
DEFUN ("following-char", Ffollowing_char, Sfollowing_char, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
if (PT >= ZV)
XSETFASTINT (temp, 0);
else
XSETFASTINT (temp, FETCH_CHAR (PT_BYTE));
return temp;
}
DEFUN ("preceding-char", Fprevious_char, Sprevious_char, 0, 0, 0,
doc: )
()
{
Lisp_Object temp;
if (PT <= BEGV)
XSETFASTINT (temp, 0);
else if (!NILP (current_buffer->enable_multibyte_characters))
{
int pos = PT_BYTE;
DEC_POS (pos);
XSETFASTINT (temp, FETCH_CHAR (pos));
}
else
XSETFASTINT (temp, FETCH_BYTE (PT_BYTE - 1));
return temp;
}
DEFUN ("bobp", Fbobp, Sbobp, 0, 0, 0,
doc: )
()
{
if (PT == BEGV)
return Qt;
return Qnil;
}
DEFUN ("eobp", Feobp, Seobp, 0, 0, 0,
doc: )
()
{
if (PT == ZV)
return Qt;
return Qnil;
}
DEFUN ("bolp", Fbolp, Sbolp, 0, 0, 0,
doc: )
()
{
if (PT == BEGV || FETCH_BYTE (PT_BYTE - 1) == '\n')
return Qt;
return Qnil;
}
DEFUN ("eolp", Feolp, Seolp, 0, 0, 0,
doc: )
()
{
if (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n')
return Qt;
return Qnil;
}
DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0,
doc: )
(pos)
Lisp_Object pos;
{
register int pos_byte;
if (NILP (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)
return Qnil;
}
else
{
CHECK_NUMBER_COERCE_MARKER (pos);
if (XINT (pos) < BEGV || XINT (pos) >= ZV)
return Qnil;
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
return make_number (FETCH_CHAR (pos_byte));
}
DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0,
doc: )
(pos)
Lisp_Object pos;
{
register Lisp_Object val;
register int pos_byte;
if (NILP (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)
return Qnil;
}
else
{
CHECK_NUMBER_COERCE_MARKER (pos);
if (XINT (pos) <= BEGV || XINT (pos) > ZV)
return Qnil;
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
if (!NILP (current_buffer->enable_multibyte_characters))
{
DEC_POS (pos_byte);
XSETFASTINT (val, FETCH_CHAR (pos_byte));
}
else
{
pos_byte--;
XSETFASTINT (val, FETCH_BYTE (pos_byte));
}
return val;
}
DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 1, 0,
doc: )
(uid)
Lisp_Object uid;
{
struct passwd *pw;
if (INTEGERP (Vuser_login_name))
init_editfns ();
if (NILP (uid))
return Vuser_login_name;
CHECK_NUMBER (uid);
BLOCK_INPUT;
pw = (struct passwd *) getpwuid (XINT (uid));
UNBLOCK_INPUT;
return (pw ? build_string (pw->pw_name) : Qnil);
}
DEFUN ("user-real-login-name", Fuser_real_login_name, Suser_real_login_name,
0, 0, 0,
doc: )
()
{
if (INTEGERP (Vuser_login_name))
init_editfns ();
return Vuser_real_login_name;
}
DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
doc: )
()
{
EMACS_INT euid = geteuid ();
return make_fixnum_or_float (euid);
}
DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
doc: )
()
{
EMACS_INT uid = getuid ();
return make_fixnum_or_float (uid);
}
DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0,
doc: )
(uid)
Lisp_Object uid;
{
struct passwd *pw;
register unsigned char *p, *q;
Lisp_Object full;
if (NILP (uid))
return Vuser_full_name;
else if (NUMBERP (uid))
{
BLOCK_INPUT;
pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid));
UNBLOCK_INPUT;
}
else if (STRINGP (uid))
{
BLOCK_INPUT;
pw = (struct passwd *) getpwnam (SDATA (uid));
UNBLOCK_INPUT;
}
else
error ("Invalid UID specification");
if (!pw)
return Qnil;
p = (unsigned char *) USER_FULL_NAME;
q = (unsigned char *) index (p, ',');
full = make_string (p, q ? q - p : strlen (p));
#ifdef AMPERSAND_FULL_NAME
p = SDATA (full);
q = (unsigned char *) index (p, '&');
if (q)
{
register unsigned char *r;
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
r = (unsigned char *) alloca (strlen (p) + SCHARS (login) + 1);
bcopy (p, r, q - p);
r[q - p] = 0;
strcat (r, SDATA (login));
r[q - p] = UPCASE (r[q - p]);
strcat (r, q + 1);
full = build_string (r);
}
#endif
return full;
}
DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
doc: )
()
{
return Vsystem_name;
}
char *
get_system_name ()
{
if (STRINGP (Vsystem_name))
return (char *) SDATA (Vsystem_name);
else
return "";
}
char *
get_operating_system_release()
{
if (STRINGP (Voperating_system_release))
return (char *) SDATA (Voperating_system_release);
else
return "";
}
DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
doc: )
()
{
return make_number (getpid ());
}
DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
doc: )
()
{
EMACS_TIME t;
EMACS_GET_TIME (t);
return list3 (make_number ((EMACS_SECS (t) >> 16) & 0xffff),
make_number ((EMACS_SECS (t) >> 0) & 0xffff),
make_number (EMACS_USECS (t)));
}
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: )
()
{
#ifdef HAVE_GETRUSAGE
struct rusage usage;
int secs, usecs;
if (getrusage (RUSAGE_SELF, &usage) < 0)
xsignal0 (Qerror);
secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
if (usecs >= 1000000)
{
usecs -= 1000000;
secs++;
}
return list3 (make_number ((secs >> 16) & 0xffff),
make_number ((secs >> 0) & 0xffff),
make_number (usecs));
#else
return Fcurrent_time ();
#endif
}
int
lisp_time_argument (specified_time, result, usec)
Lisp_Object specified_time;
time_t *result;
int *usec;
{
if (NILP (specified_time))
{
if (usec)
{
EMACS_TIME t;
EMACS_GET_TIME (t);
*usec = EMACS_USECS (t);
*result = EMACS_SECS (t);
return 1;
}
else
return time (result) != -1;
}
else
{
Lisp_Object high, low;
high = Fcar (specified_time);
CHECK_NUMBER (high);
low = Fcdr (specified_time);
if (CONSP (low))
{
if (usec)
{
Lisp_Object usec_l = Fcdr (low);
if (CONSP (usec_l))
usec_l = Fcar (usec_l);
if (NILP (usec_l))
*usec = 0;
else
{
CHECK_NUMBER (usec_l);
*usec = XINT (usec_l);
}
}
low = Fcar (low);
}
else if (usec)
*usec = 0;
CHECK_NUMBER (low);
*result = (XINT (high) << 16) + (XINT (low) & 0xffff);
return *result >> 16 == XINT (high);
}
}
DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
doc: )
(specified_time)
Lisp_Object specified_time;
{
time_t sec;
int usec;
if (! lisp_time_argument (specified_time, &sec, &usec))
error ("Invalid time specification");
return make_float ((sec * 1e6 + usec) / 1e6);
}
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;
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,
doc: )
(format_string, time, universal)
Lisp_Object format_string, time, universal;
{
time_t value;
int size;
struct tm *tm;
int ut = ! NILP (universal);
CHECK_STRING (format_string);
if (! lisp_time_argument (time, &value, NULL))
error ("Invalid time specification");
format_string = code_convert_string_norecord (format_string,
Vlocale_coding_system, 1);
size = SBYTES (format_string) * 6 + 50;
BLOCK_INPUT;
tm = ut ? gmtime (&value) : localtime (&value);
UNBLOCK_INPUT;
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';
BLOCK_INPUT;
result = emacs_memftimeu (buf, size, SDATA (format_string),
SBYTES (format_string),
tm, ut);
UNBLOCK_INPUT;
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
return code_convert_string_norecord (make_unibyte_string (buf, result),
Vlocale_coding_system, 0);
BLOCK_INPUT;
result = emacs_memftimeu (NULL, (size_t) -1,
SDATA (format_string),
SBYTES (format_string),
tm, ut);
UNBLOCK_INPUT;
size = result + 1;
}
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0,
doc: )
(specified_time)
Lisp_Object specified_time;
{
time_t time_spec;
struct tm save_tm;
struct tm *decoded_time;
Lisp_Object list_args[9];
if (! lisp_time_argument (specified_time, &time_spec, NULL))
error ("Invalid time specification");
BLOCK_INPUT;
decoded_time = localtime (&time_spec);
UNBLOCK_INPUT;
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);
XSETFASTINT (list_args[3], decoded_time->tm_mday);
XSETFASTINT (list_args[4], decoded_time->tm_mon + 1);
XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year);
XSETFASTINT (list_args[6], decoded_time->tm_wday);
list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
save_tm = *decoded_time;
BLOCK_INPUT;
decoded_time = gmtime (&time_spec);
UNBLOCK_INPUT;
if (decoded_time == 0)
list_args[8] = Qnil;
else
XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
return Flist (9, list_args);
}
DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
time_t time;
struct tm tm;
Lisp_Object zone = (nargs > 6 ? args[nargs - 1] : Qnil);
CHECK_NUMBER (args[0]);
CHECK_NUMBER (args[1]);
CHECK_NUMBER (args[2]);
CHECK_NUMBER (args[3]);
CHECK_NUMBER (args[4]);
CHECK_NUMBER (args[5]);
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_isdst = -1;
if (CONSP (zone))
zone = Fcar (zone);
if (NILP (zone))
{
BLOCK_INPUT;
time = mktime (&tm);
UNBLOCK_INPUT;
}
else
{
char tzbuf[100];
char *tzstring;
char **oldenv = environ, **newenv;
if (EQ (zone, Qt))
tzstring = "UTC0";
else if (STRINGP (zone))
tzstring = (char *) SDATA (zone);
else if (INTEGERP (zone))
{
int abszone = abs (XINT (zone));
sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
abszone / (60*60), (abszone/60) % 60, abszone % 60);
tzstring = tzbuf;
}
else
error ("Invalid time zone specification");
set_time_zone_rule (tzstring);
BLOCK_INPUT;
time = mktime (&tm);
UNBLOCK_INPUT;
newenv = environ;
environ = oldenv;
xfree (newenv);
#ifdef LOCALTIME_CACHE
tzset ();
#endif
}
if (time == (time_t) -1)
error ("Specified time is not representable");
return make_time (time);
}
DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
doc: )
(specified_time)
Lisp_Object specified_time;
{
time_t value;
struct tm *tm;
register char *tem;
if (! lisp_time_argument (specified_time, &value, NULL))
error ("Invalid time specification");
BLOCK_INPUT;
tm = localtime (&value);
UNBLOCK_INPUT;
if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
error ("Specified time is not representable");
tem[strlen (tem) - 1] = '\0';
return build_string (tem);
}
static int
tm_diff (a, b)
struct tm *a, *b;
{
int a4 = (a->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (a->tm_year & 3);
int b4 = (b->tm_year >> 2) + (TM_YEAR_BASE >> 2) - ! (b->tm_year & 3);
int a100 = a4 / 25 - (a4 % 25 < 0);
int b100 = b4 / 25 - (b4 % 25 < 0);
int a400 = a100 >> 2;
int b400 = b100 >> 2;
int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400);
int years = a->tm_year - b->tm_year;
int days = (365 * years + intervening_leap_days
+ (a->tm_yday - b->tm_yday));
return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour))
+ (a->tm_min - b->tm_min))
+ (a->tm_sec - b->tm_sec));
}
DEFUN ("current-time-zone", Fcurrent_time_zone, Scurrent_time_zone, 0, 1, 0,
doc: )
(specified_time)
Lisp_Object specified_time;
{
time_t value;
struct tm *t;
struct tm gmt;
if (!lisp_time_argument (specified_time, &value, NULL))
t = NULL;
else
{
BLOCK_INPUT;
t = gmtime (&value);
if (t)
{
gmt = *t;
t = localtime (&value);
}
UNBLOCK_INPUT;
}
if (t)
{
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;
#else
#ifdef HAVE_TZNAME
if (t->tm_isdst == 0 || t->tm_isdst == 1)
s = tzname[t->tm_isdst];
#endif
#endif
#if defined HAVE_TM_ZONE || defined HAVE_TZNAME
if (s)
{
char *p;
for (p = s; *p && (isalnum ((unsigned char)*p) || *p == ' '); ++p)
;
if (p == s || *p)
s = NULL;
}
#endif
if (!s)
{
int am = (offset < 0 ? -offset : offset) / 60;
sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
s = buf;
}
return Fcons (make_number (offset), Fcons (build_string (s), Qnil));
}
else
return Fmake_list (make_number (2), Qnil);
}
static char **environbuf;
DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0,
doc: )
(tz)
Lisp_Object tz;
{
char *tzstring;
if (NILP (tz))
tzstring = 0;
else if (EQ (tz, Qt))
tzstring = "UTC0";
else
{
CHECK_STRING (tz);
tzstring = (char *) SDATA (tz);
}
set_time_zone_rule (tzstring);
if (environbuf)
free (environbuf);
environbuf = environ;
return Qnil;
}
#ifdef LOCALTIME_CACHE
static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
#endif
void
set_time_zone_rule (tzstring)
char *tzstring;
{
int envptrs;
char **from, **to, **newenv;
for (from = environ; *from; from++)
continue;
envptrs = from - environ + 2;
newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
+ (tzstring ? strlen (tzstring) + 4 : 0));
if (tzstring)
{
char *t = (char *) (to + envptrs);
strcpy (t, "TZ=");
strcat (t, tzstring);
*to++ = t;
}
for (from = environ; *from; from++)
if (strncmp (*from, "TZ=", 3) != 0)
*to++ = *from;
*to = 0;
environ = newenv;
#ifdef LOCALTIME_CACHE
{
if (tzstring)
{
char *tz = *newenv;
*newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
tzset ();
*newenv = tz;
}
else
{
*to = set_time_zone_rule_tz1;
to[1] = 0;
tzset ();
*to = set_time_zone_rule_tz2;
tzset ();
*to = 0;
}
}
tzset ();
#endif
}
static void
general_insert_function (insert_func, insert_from_string_func,
inherit, nargs, args)
void (*insert_func) P_ ((const unsigned char *, int));
void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int));
int inherit, nargs;
register Lisp_Object *args;
{
register int argnum;
register Lisp_Object val;
for (argnum = 0; argnum < nargs; argnum++)
{
val = args[argnum];
if (INTEGERP (val))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
if (!NILP (current_buffer->enable_multibyte_characters))
len = CHAR_STRING (XFASTINT (val), str);
else
{
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))
{
(*insert_from_string_func) (val, 0, 0,
SCHARS (val),
SBYTES (val),
inherit);
}
else
wrong_type_argument (Qchar_or_string_p, val);
}
}
void
insert1 (arg)
Lisp_Object arg;
{
Finsert (1, &arg);
}
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
general_insert_function (insert, insert_from_string, 0, nargs, args);
return Qnil;
}
DEFUN ("insert-and-inherit", Finsert_and_inherit, Sinsert_and_inherit,
0, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
general_insert_function (insert_and_inherit, insert_from_string, 1,
nargs, args);
return Qnil;
}
DEFUN ("insert-before-markers", Finsert_before_markers, Sinsert_before_markers, 0, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
general_insert_function (insert_before_markers,
insert_from_string_before_markers, 0,
nargs, args);
return Qnil;
}
DEFUN ("insert-before-markers-and-inherit", Finsert_and_inherit_before_markers,
Sinsert_and_inherit_before_markers, 0, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
general_insert_function (insert_before_markers_and_inherit,
insert_from_string_before_markers, 1,
nargs, args);
return Qnil;
}
DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
doc: )
(character, count, inherit)
Lisp_Object character, count, inherit;
{
register unsigned char *string;
register int strlen;
register int i, n;
int len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
CHECK_NUMBER (character);
CHECK_NUMBER (count);
if (!NILP (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++)
string[i] = str[i % len];
while (n >= strlen)
{
QUIT;
if (!NILP (inherit))
insert_and_inherit (string, strlen);
else
insert (string, strlen);
n -= strlen;
}
if (n > 0)
{
if (!NILP (inherit))
insert_and_inherit (string, n);
else
insert (string, n);
}
return Qnil;
}
Lisp_Object
make_buffer_string (start, end, props)
int start, end;
int props;
{
int start_byte = CHAR_TO_BYTE (start);
int end_byte = CHAR_TO_BYTE (end);
return make_buffer_string_both (start, start_byte, end, end_byte, props);
}
Lisp_Object
make_buffer_string_both (start, start_byte, end, end_byte, props)
int start, start_byte, end, end_byte;
int props;
{
Lisp_Object result, tem, tem1;
if (start < GPT && GPT < end)
move_gap (start);
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), SDATA (result),
end_byte - start_byte);
if (props)
{
update_buffer_properties (start, end);
tem = Fnext_property_change (make_number (start), Qnil, make_number (end));
tem1 = Ftext_properties_at (make_number (start), Qnil);
if (XINT (tem) != end || !NILP (tem1))
copy_intervals_to_string (result, current_buffer, start,
end - start);
}
return result;
}
static void
update_buffer_properties (start, end)
int start, end;
{
if (!NILP (Vbuffer_access_fontify_functions))
{
Lisp_Object args[3];
Lisp_Object tem;
args[0] = Qbuffer_access_fontify_functions;
XSETINT (args[1], start);
XSETINT (args[2], end);
if (!NILP (Vbuffer_access_fontified_property))
{
tem = Ftext_property_any (args[1], args[2],
Vbuffer_access_fontified_property,
Qnil, Qnil);
if (! NILP (tem))
Frun_hook_with_args (3, args);
}
else
Frun_hook_with_args (3, args);
}
}
DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
doc: )
(start, end)
Lisp_Object start, end;
{
register int b, e;
validate_region (&start, &end);
b = XINT (start);
e = XINT (end);
return make_buffer_string (b, e, 1);
}
DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties,
Sbuffer_substring_no_properties, 2, 2, 0,
doc: )
(start, end)
Lisp_Object start, end;
{
register int b, e;
validate_region (&start, &end);
b = XINT (start);
e = XINT (end);
return make_buffer_string (b, e, 0);
}
DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
doc: )
()
{
return make_buffer_string (BEGV, ZV, 1);
}
DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
1, 3, 0,
doc: )
(buffer, start, end)
Lisp_Object buffer, start, end;
{
register int b, e, temp;
register struct buffer *bp, *obuf;
Lisp_Object buf;
buf = Fget_buffer (buffer);
if (NILP (buf))
nsberror (buffer);
bp = XBUFFER (buf);
if (NILP (bp->name))
error ("Selecting deleted buffer");
if (NILP (start))
b = BUF_BEGV (bp);
else
{
CHECK_NUMBER_COERCE_MARKER (start);
b = XINT (start);
}
if (NILP (end))
e = BUF_ZV (bp);
else
{
CHECK_NUMBER_COERCE_MARKER (end);
e = XINT (end);
}
if (b > e)
temp = b, b = e, e = temp;
if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp)))
args_out_of_range (start, end);
obuf = current_buffer;
set_buffer_internal_1 (bp);
update_buffer_properties (b, e);
set_buffer_internal_1 (obuf);
insert_from_buffer (bp, b, e - b, 0);
return Qnil;
}
DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, Scompare_buffer_substrings,
6, 6, 0,
doc: )
(buffer1, start1, end1, buffer2, start2, end2)
Lisp_Object buffer1, start1, end1, buffer2, start2, end2;
{
register 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);
int chars = 0;
int i1, i2, i1_byte, i2_byte;
if (NILP (buffer1))
bp1 = current_buffer;
else
{
Lisp_Object buf1;
buf1 = Fget_buffer (buffer1);
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
if (NILP (bp1->name))
error ("Selecting deleted buffer");
}
if (NILP (start1))
begp1 = BUF_BEGV (bp1);
else
{
CHECK_NUMBER_COERCE_MARKER (start1);
begp1 = XINT (start1);
}
if (NILP (end1))
endp1 = BUF_ZV (bp1);
else
{
CHECK_NUMBER_COERCE_MARKER (end1);
endp1 = XINT (end1);
}
if (begp1 > endp1)
temp = begp1, begp1 = endp1, endp1 = temp;
if (!(BUF_BEGV (bp1) <= begp1
&& begp1 <= endp1
&& endp1 <= BUF_ZV (bp1)))
args_out_of_range (start1, end1);
if (NILP (buffer2))
bp2 = current_buffer;
else
{
Lisp_Object buf2;
buf2 = Fget_buffer (buffer2);
if (NILP (buf2))
nsberror (buffer2);
bp2 = XBUFFER (buf2);
if (NILP (bp2->name))
error ("Selecting deleted buffer");
}
if (NILP (start2))
begp2 = BUF_BEGV (bp2);
else
{
CHECK_NUMBER_COERCE_MARKER (start2);
begp2 = XINT (start2);
}
if (NILP (end2))
endp2 = BUF_ZV (bp2);
else
{
CHECK_NUMBER_COERCE_MARKER (end2);
endp2 = XINT (end2);
}
if (begp2 > endp2)
temp = begp2, begp2 = endp2, endp2 = temp;
if (!(BUF_BEGV (bp2) <= begp2
&& begp2 <= endp2
&& endp2 <= BUF_ZV (bp2)))
args_out_of_range (start2, end2);
i1 = begp1;
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
while (i1 < endp1 && i2 < endp2)
{
int c1, c2;
QUIT;
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 (!NILP (trt))
{
c1 = CHAR_TABLE_TRANSLATE (trt, c1);
c2 = CHAR_TABLE_TRANSLATE (trt, c2);
}
if (c1 < c2)
return make_number (- 1 - chars);
if (c1 > c2)
return make_number (chars + 1);
chars++;
}
if (chars < endp1 - begp1)
return make_number (chars + 1);
else if (chars < endp2 - begp2)
return make_number (- chars - 1);
return make_number (0);
}
static Lisp_Object
subst_char_in_region_unwind (arg)
Lisp_Object arg;
{
return current_buffer->undo_list = arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (arg)
Lisp_Object arg;
{
return current_buffer->filename = arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
Ssubst_char_in_region, 4, 5, 0,
doc: )
(start, end, fromchar, tochar, noundo)
Lisp_Object start, end, fromchar, tochar, noundo;
{
register int pos, pos_byte, stop, i, len, end_byte;
int changed = 0;
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
unsigned char *p;
int count = SPECPDL_INDEX ();
#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 = 0;
int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
restart:
validate_region (&start, &end);
CHECK_NUMBER (fromchar);
CHECK_NUMBER (tochar);
if (multibyte_p)
{
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 (!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;
fromstr[0] = XFASTINT (fromchar);
tostr[0] = XFASTINT (tochar);
}
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
stop = CHAR_TO_BYTE (XINT (end));
end_byte = stop;
if (!changed && !NILP (noundo))
{
record_unwind_protect (subst_char_in_region_unwind,
current_buffer->undo_list);
current_buffer->undo_list = Qt;
record_unwind_protect (subst_char_in_region_unwind_1,
current_buffer->filename);
current_buffer->filename = Qnil;
}
if (pos_byte < GPT_BYTE)
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 (multibyte_p)
INC_POS (pos_byte_next);
else
++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]
&& (len == 3 || p[3] == fromstr[3]))))))
{
if (changed < 0)
changed = pos;
else if (!changed)
{
changed = -1;
modify_region (current_buffer, pos, XINT (end), 0);
if (! NILP (noundo))
{
if (MODIFF - 1 == SAVE_MODIFF)
SAVE_MODIFF++;
if (MODIFF - 1 == current_buffer->auto_save_modified)
current_buffer->auto_save_modified++;
}
goto restart;
}
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);
string = make_multibyte_string (tostr, 1, len);
replace_range (pos, pos + 1, string,
0, 0, 1);
pos_byte_next = CHAR_TO_BYTE (pos);
if (pos_byte_next > pos_byte)
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;
}
pos_byte = pos_byte_next;
pos++;
}
if (changed > 0)
{
signal_after_change (changed,
last_changed - changed, last_changed - changed);
update_compositions (changed, last_changed, CHECK_ALL);
}
unbind_to (count, Qnil);
return Qnil;
}
DEFUN ("translate-region-internal", Ftranslate_region_internal,
Stranslate_region_internal, 3, 3, 0,
doc: )
(start, end, table)
Lisp_Object start;
Lisp_Object end;
register Lisp_Object table;
{
register unsigned char *tt;
register int nc;
int cnt;
int size;
int pos, pos_byte, end_pos;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int string_multibyte;
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
{
size = MAX_CHAR;
tt = NULL;
}
else
{
CHECK_STRING (table);
if (! multibyte && (SCHARS (table) < SBYTES (table)))
table = string_make_unibyte (table);
string_multibyte = SCHARS (table) < SBYTES (table);
size = SCHARS (table);
tt = SDATA (table);
}
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
end_pos = XINT (end);
modify_region (current_buffer, pos, XINT (end), 0);
cnt = 0;
for (; pos < end_pos; )
{
register unsigned char *p = BYTE_POS_ADDR (pos_byte);
unsigned char *str, buf[MAX_MULTIBYTE_LENGTH];
int len, str_len;
int oc;
if (multibyte)
oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len);
else
oc = *p, len = 1;
if (oc < size)
{
if (tt)
{
tt = SDATA (table);
if (string_multibyte)
{
str = tt + string_char_to_byte (table, oc);
nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH,
str_len);
}
else
{
nc = tt[oc];
if (! ASCII_BYTE_P (nc) && multibyte)
{
str_len = CHAR_STRING (nc, buf);
str = buf;
}
else
{
str_len = 1;
str = tt + oc;
}
}
}
else
{
Lisp_Object val;
int c;
nc = oc;
val = CHAR_TABLE_REF (table, oc);
if (INTEGERP (val)
&& (c = XINT (val), CHAR_VALID_P (c, 0)))
{
nc = c;
str_len = CHAR_STRING (nc, buf);
str = buf;
}
}
if (nc != oc)
{
if (len != str_len)
{
Lisp_Object string;
string = make_multibyte_string (str, 1, str_len);
replace_range (pos, pos + 1, string, 1, 0, 1);
len = str_len;
}
else
{
record_change (pos, 1);
while (str_len-- > 0)
*p++ = *str++;
signal_after_change (pos, 1, 1);
update_compositions (pos, pos + 1, CHECK_BORDER);
}
++cnt;
}
}
pos_byte += len;
pos++;
}
return make_number (cnt);
}
DEFUN ("delete-region", Fdelete_region, Sdelete_region, 2, 2, "r",
doc: )
(start, end)
Lisp_Object start, end;
{
validate_region (&start, &end);
del_range (XINT (start), XINT (end));
return Qnil;
}
DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
Sdelete_and_extract_region, 2, 2, 0,
doc: )
(start, end)
Lisp_Object start, end;
{
validate_region (&start, &end);
if (XINT (start) == XINT (end))
return build_string ("");
return del_range_1 (XINT (start), XINT (end), 1, 1);
}
DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
doc: )
()
{
if (BEG != BEGV || Z != ZV)
current_buffer->clip_changed = 1;
BEGV = BEG;
BEGV_BYTE = BEG_BYTE;
SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE);
invalidate_current_column ();
return Qnil;
}
DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r",
doc: )
(start, end)
register Lisp_Object start, end;
{
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
if (XINT (start) > XINT (end))
{
Lisp_Object tem;
tem = start; start = end; end = tem;
}
if (!(BEG <= XINT (start) && XINT (start) <= XINT (end) && XINT (end) <= Z))
args_out_of_range (start, end);
if (BEGV != XFASTINT (start) || ZV != XFASTINT (end))
current_buffer->clip_changed = 1;
SET_BUF_BEGV (current_buffer, XFASTINT (start));
SET_BUF_ZV (current_buffer, XFASTINT (end));
if (PT < XFASTINT (start))
SET_PT (XFASTINT (start));
if (PT > XFASTINT (end))
SET_PT (XFASTINT (end));
invalidate_current_column ();
return Qnil;
}
Lisp_Object
save_restriction_save ()
{
if (BEGV == BEG && ZV == Z)
return Fcurrent_buffer ();
else
{
Lisp_Object beg, end;
beg = buildmark (BEGV, BEGV_BYTE);
end = buildmark (ZV, ZV_BYTE);
XMARKER(end)->insertion_type = 1;
return Fcons (beg, end);
}
}
Lisp_Object
save_restriction_restore (data)
Lisp_Object data;
{
if (CONSP (data))
{
struct Lisp_Marker *beg = XMARKER (XCAR (data));
struct Lisp_Marker *end = XMARKER (XCDR (data));
struct buffer *buf = beg->buffer;
if (buf
&& (beg->charpos != BUF_BEGV (buf) || end->charpos != BUF_ZV (buf)))
{
int pt = BUF_PT (buf);
SET_BUF_BEGV_BOTH (buf, beg->charpos, beg->bytepos);
SET_BUF_ZV_BOTH (buf, end->charpos, end->bytepos);
if (pt < beg->charpos || pt > end->charpos)
SET_BUF_PT_BOTH (buf,
clip_to_bounds (beg->charpos, pt, end->charpos),
clip_to_bounds (beg->bytepos, BUF_PT_BYTE (buf),
end->bytepos));
buf->clip_changed = 1;
}
}
else
{
struct buffer *buf = XBUFFER (data);
if (buf
&& (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf)))
{
SET_BUF_BEGV_BOTH (buf, BUF_BEG (buf), BUF_BEG_BYTE (buf));
SET_BUF_ZV_BOTH (buf, BUF_Z (buf), BUF_Z_BYTE (buf));
buf->clip_changed = 1;
}
}
return Qnil;
}
DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
doc: )
(body)
Lisp_Object body;
{
register Lisp_Object val;
int count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
val = Fprogn (body);
return unbind_to (count, val);
}
static char *message_text;
static int message_length;
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
if (NILP (args[0])
|| (STRINGP (args[0])
&& SBYTES (args[0]) == 0))
{
message (0);
return args[0];
}
else
{
register Lisp_Object val;
val = Fformat (nargs, args);
message3 (val, SBYTES (val), STRING_MULTIBYTE (val));
return val;
}
}
DEFUN ("message-box", Fmessage_box, Smessage_box, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
if (NILP (args[0]))
{
message (0);
return Qnil;
}
else
{
register Lisp_Object val;
val = Fformat (nargs, args);
#ifdef HAVE_MENUS
if (FRAME_WINDOW_P (XFRAME (selected_frame))
|| FRAME_MSDOS_P (XFRAME (selected_frame)))
{
Lisp_Object pane, menu, obj;
struct gcpro gcpro1;
pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
GCPRO1 (pane);
menu = Fcons (val, pane);
obj = Fx_popup_dialog (Qt, menu, Qt);
UNGCPRO;
return val;
}
#endif
if (! message_text)
{
message_text = (char *)xmalloc (80);
message_length = 80;
}
if (SBYTES (val) > message_length)
{
message_length = SBYTES (val);
message_text = (char *)xrealloc (message_text, message_length);
}
bcopy (SDATA (val), message_text, SBYTES (val));
message2 (message_text, SBYTES (val),
STRING_MULTIBYTE (val));
return val;
}
}
#ifdef HAVE_MENUS
extern Lisp_Object last_nonmenu_event;
#endif
DEFUN ("message-or-box", Fmessage_or_box, Smessage_or_box, 1, MANY, 0,
doc: )
(nargs, args)
int 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);
}
DEFUN ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0,
doc: )
()
{
return current_message ();
}
DEFUN ("propertize", Fpropertize, Spropertize, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object properties, string;
struct gcpro gcpro1, gcpro2;
int i;
if ((nargs & 1) == 0 || nargs < 1)
error ("Wrong number of arguments");
properties = string = Qnil;
GCPRO2 (properties, string);
CHECK_STRING (args[0]);
string = Fcopy_sequence (args[0]);
for (i = 1; i < nargs; i += 2)
properties = Fcons (args[i], Fcons (args[i + 1], properties));
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
properties, string);
RETURN_UNGCPRO (string);
}
#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
(((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
: SBYTES (STRING))
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
register int n;
register int total;
char *buf, *p;
register unsigned char *format, *end, *format_start;
int nchars;
int multibyte = 0;
int maybe_combine_byte;
unsigned char *this_format;
int *precision = (int *) (alloca((nargs + 1) * sizeof (int)));
int longest_format;
Lisp_Object val;
int arg_intervals = 0;
USE_SAFE_ALLOCA;
char *discarded = 0;
struct info
{
int start, end, intervals;
} *info = 0;
for (n = 0; n < nargs; n++)
{
if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
multibyte = 1;
precision[n] = -1;
}
precision[nargs] = -1;
CHECK_STRING (args[0]);
args[0] = Fcopy_sequence (args[0]);
abort_on_gc++;
retry:
format = SDATA (args[0]);
format_start = format;
end = format + SBYTES (args[0]);
longest_format = 0;
total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]) + 1;
{
int nbytes = (nargs+1) * sizeof *info;
int i;
if (!info)
info = (struct info *) alloca (nbytes);
bzero (info, nbytes);
for (i = 0; i <= nargs; i++)
info[i].start = -1;
if (!discarded)
SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
bzero (discarded, SBYTES (args[0]));
}
n = 0;
while (format != end)
if (*format++ == '%')
{
int thissize = 0;
int actual_width = 0;
unsigned char *this_format_start = format - 1;
int field_width = 0;
while (format != end
&& (*format == '-' || *format == '0' || *format == '#'
|| * format == ' ' || *format == '+'))
++format;
if (*format >= '0' && *format <= '9')
{
for (field_width = 0; *format >= '0' && *format <= '9'; ++format)
field_width = 10 * field_width + *format - '0';
}
if (*format == '.')
{
++format;
for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format)
precision[n+1] = 10 * precision[n+1] + *format - '0';
}
if (format - this_format_start + 2 > longest_format)
longest_format = format - this_format_start + 2;
if (format == end)
error ("Format string ends in middle of format specifier");
if (*format == '%')
format++;
else if (++n >= nargs)
error ("Not enough arguments for format string");
else if (*format == 'S')
{
register Lisp_Object tem;
tem = Fprin1_to_string (args[n], Qnil);
if (STRING_MULTIBYTE (tem) && ! multibyte)
{
multibyte = 1;
goto retry;
}
args[n] = tem;
*format = 's';
goto string;
}
else if (SYMBOLP (args[n]))
{
args[n] = SYMBOL_NAME (args[n]);
if (STRING_MULTIBYTE (args[n]) && ! multibyte)
{
multibyte = 1;
goto retry;
}
goto string;
}
else if (STRINGP (args[n]))
{
string:
if (*format != 's' && *format != 'S')
error ("Format specifier doesn't match argument type");
thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0;
actual_width = lisp_string_width (args[n], -1, NULL, NULL);
}
else if (INTEGERP (args[n]) && *format != 's')
{
if (*format == 'e' || *format == 'f' || *format == 'g')
args[n] = Ffloat (args[n]);
else
if (*format != 'd' && *format != 'o' && *format != 'x'
&& *format != 'i' && *format != 'X' && *format != 'c')
error ("Invalid format operation %%%c", *format);
thissize = 30 + (precision[n] > 0 ? precision[n] : 0);
if (*format == 'c')
{
if (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
|| XINT (args[n]) == 0)
{
if (! multibyte)
{
multibyte = 1;
goto retry;
}
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')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
{
if (*format != 'd' && *format != 'o' && *format != 'x'
&& *format != 'i' && *format != 'X' && *format != 'c')
error ("Invalid format operation %%%c", *format);
}
thissize = (MAX_10_EXP + 100
+ (precision[n] > 0 ? precision[n] : 0));
}
else
{
register Lisp_Object tem;
tem = Fprin1_to_string (args[n], Qt);
if (STRING_MULTIBYTE (tem) && ! multibyte)
{
multibyte = 1;
goto retry;
}
args[n] = tem;
goto string;
}
thissize += max (0, field_width - actual_width);
total += thissize + 4;
}
abort_on_gc--;
this_format = (unsigned char *) alloca (longest_format + 1);
SAFE_ALLOCA (buf, char *, total);
p = buf;
nchars = 0;
n = 0;
format = SDATA (args[0]);
format_start = format;
end = format + SBYTES (args[0]);
maybe_combine_byte = 0;
while (format != end)
{
if (*format == '%')
{
int minlen;
int negative = 0;
unsigned char *this_format_start = format;
discarded[format - format_start] = 1;
format++;
while (index("-+0# ", *format))
{
if (*format == '-')
{
negative = 1;
}
discarded[format - format_start] = 1;
++format;
}
minlen = atoi (format);
while ((*format >= '0' && *format <= '9') || *format == '.')
{
discarded[format - format_start] = 1;
format++;
}
if (*format++ == '%')
{
*p++ = '%';
nchars++;
continue;
}
++n;
discarded[format - format_start - 1] = 1;
info[n].start = nchars;
if (STRINGP (args[n]))
{
int width, padding;
int nbytes, start, end;
int nchars_string;
if (precision[n] == 0)
width = nchars_string = nbytes = 0;
else if (precision[n] > 0)
width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes);
else
{
width = lisp_string_width (args[n], -1, NULL, NULL);
nbytes = SBYTES (args[n]);
nchars_string = SCHARS (args[n]);
}
padding = minlen - width;
if (! negative)
while (padding-- > 0)
{
*p++ = ' ';
++nchars;
}
info[n].start = start = nchars;
nchars += nchars_string;
end = nchars;
if (p > buf
&& multibyte
&& !ASCII_BYTE_P (*((unsigned char *) p - 1))
&& STRING_MULTIBYTE (args[n])
&& !CHAR_HEAD_P (SREF (args[n], 0)))
maybe_combine_byte = 1;
p += copy_text (SDATA (args[n]), p,
nbytes,
STRING_MULTIBYTE (args[n]), multibyte);
info[n].end = nchars;
if (negative)
while (padding-- > 0)
{
*p++ = ' ';
nchars++;
}
if (STRING_INTERVALS (args[n]))
info[n].intervals = arg_intervals = 1;
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
{
int this_nchars;
bcopy (this_format_start, this_format,
format - this_format_start);
this_format[format - this_format_start] = 0;
if (format[-1] == 'e' || format[-1] == 'f' || format[-1] == 'g')
sprintf (p, this_format, XFLOAT_DATA (args[n]));
else
{
if (sizeof (EMACS_INT) > sizeof (int)
&& format[-1] != 'c')
{
this_format[format - this_format_start]
= this_format[format - this_format_start - 1];
this_format[format - this_format_start - 1] = 'l';
this_format[format - this_format_start + 1] = 0;
}
if (INTEGERP (args[n]))
{
if (format[-1] == 'c')
sprintf (p, this_format, (int) XINT (args[n]));
else if (format[-1] == 'd')
sprintf (p, this_format, XINT (args[n]));
else
sprintf (p, this_format, XUINT (args[n]));
}
else if (format[-1] == 'c')
sprintf (p, this_format, (int) XFLOAT_DATA (args[n]));
else if (format[-1] == 'd')
sprintf (p, this_format, (EMACS_INT) XFLOAT_DATA (args[n]));
else
sprintf (p, this_format, (EMACS_UINT) 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);
if (multibyte)
p += str_to_multibyte (p, buf + total - 1 - p, this_nchars);
else
p += this_nchars;
nchars += this_nchars;
info[n].end = nchars;
}
}
else if (STRING_MULTIBYTE (args[0]))
{
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))
{
discarded[format - format_start] = 2;
*p++ = *format++;
}
nchars++;
}
else if (multibyte)
{
int len = copy_text (format, p, 1, 0, 1);
p += len;
format++;
nchars++;
}
else
*p++ = *format++, nchars++;
}
if (p > buf + total)
abort ();
if (maybe_combine_byte)
nchars = multibyte_chars_in_text (buf, p - buf);
val = make_specified_string (buf, nchars, p - buf, multibyte);
SAFE_FREE ();
if (STRING_INTERVALS (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
len = make_number (SCHARS (args[0]));
props = text_property_list (args[0], make_number (0), len, Qnil);
GCPRO1 (props);
if (CONSP (props))
{
int bytepos = 0, position = 0, translated = 0, argn = 1;
Lisp_Object list;
props = Fnreverse (props);
for (list = props; CONSP (list); list = XCDR (list))
{
Lisp_Object item;
int pos;
item = XCAR (list);
pos = XINT (XCAR (item));
for (; position < pos; bytepos++)
{
if (! discarded[bytepos])
position++, translated++;
else if (discarded[bytepos] == 1)
{
position++;
if (translated == info[argn].start)
{
translated += info[argn].end - info[argn].start;
argn++;
}
}
}
XSETCAR (item, make_number (translated));
pos = XINT (XCAR (XCDR (item)));
for (; position < pos; bytepos++)
{
if (! discarded[bytepos])
position++, translated++;
else if (discarded[bytepos] == 1)
{
position++;
if (translated == info[argn].start)
{
translated += info[argn].end - info[argn].start;
argn++;
}
}
}
XSETCAR (XCDR (item), make_number (translated));
}
add_text_properties_from_list (val, props, make_number (0));
}
if (arg_intervals)
for (n = 1; n < nargs; ++n)
if (info[n].intervals)
{
len = make_number (SCHARS (args[n]));
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);
if (n > 1 && info[n - 1].end)
make_composition_value_copy (props);
add_text_properties_from_list (val, props,
make_number (info[n].start));
}
UNGCPRO;
}
return val;
}
Lisp_Object
format2 (string1, arg0, arg1)
char *string1;
Lisp_Object arg0, arg1;
{
Lisp_Object args[3];
args[0] = build_string (string1);
args[1] = arg0;
args[2] = arg1;
return Fformat (3, args);
}
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
doc: )
(c1, c2)
register Lisp_Object c1, c2;
{
int i1, i2;
CHECK_NUMBER (c1);
CHECK_NUMBER (c2);
if (XINT (c1) == XINT (c2))
return Qt;
if (NILP (current_buffer->case_fold_search))
return Qnil;
i1 = DOWNCASE (XFASTINT (c1));
i2 = DOWNCASE (XFASTINT (c2));
return (i1 == i2 ? Qt : Qnil);
}
static void
transpose_markers (start1, end1, start2, end2,
start1_byte, end1_byte, start2_byte, end2_byte)
register int start1, end1, start2, end2;
register int start1_byte, end1_byte, start2_byte, end2_byte;
{
register int amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
register struct Lisp_Marker *marker;
if (PT < start1)
;
else if (PT < end1)
TEMP_SET_PT_BOTH (PT + (end2 - end1),
PT_BYTE + (end2_byte - end1_byte));
else if (PT < start2)
TEMP_SET_PT_BOTH (PT + (end2 - start2) - (end1 - start1),
(PT_BYTE + (end2_byte - start2_byte)
- (end1_byte - start1_byte)));
else if (PT < end2)
TEMP_SET_PT_BOTH (PT - (start2 - start1),
PT_BYTE - (start2_byte - start1_byte));
diff = (end2 - start2) - (end1 - start1);
diff_byte = (end2_byte - start2_byte) - (end1_byte - start1_byte);
amt1 = (end2 - start2) + (start2 - end1);
amt2 = (end1 - start1) + (start2 - end1);
amt1_byte = (end2_byte - start2_byte) + (start2_byte - end1_byte);
amt2_byte = (end1_byte - start1_byte) + (start2_byte - end1_byte);
for (marker = BUF_MARKERS (current_buffer); marker; marker = marker->next)
{
mpos = marker->bytepos;
if (mpos >= start1_byte && mpos < end2_byte)
{
if (mpos < end1_byte)
mpos += amt1_byte;
else if (mpos < start2_byte)
mpos += diff_byte;
else
mpos -= amt2_byte;
marker->bytepos = mpos;
}
mpos = marker->charpos;
if (mpos >= start1 && mpos < end2)
{
if (mpos < end1)
mpos += amt1;
else if (mpos < start2)
mpos += diff;
else
mpos -= amt2;
}
marker->charpos = mpos;
}
}
DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0,
doc: )
(startr1, endr1, startr2, endr2, leave_markers)
Lisp_Object startr1, endr1, startr2, endr2, leave_markers;
{
register int start1, end1, start2, end2;
int start1_byte, start2_byte, len1_byte, len2_byte;
int gap, len1, len_mid, len2;
unsigned char *start1_addr, *start2_addr, *temp;
INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3;
Lisp_Object buf;
XSETBUFFER (buf, current_buffer);
cur_intv = BUF_INTERVALS (current_buffer);
validate_region (&startr1, &endr1);
validate_region (&startr2, &endr2);
start1 = XFASTINT (startr1);
end1 = XFASTINT (endr1);
start2 = XFASTINT (startr2);
end2 = XFASTINT (endr2);
gap = GPT;
if (start2 < end1)
{
register int glumph = start1;
start1 = start2;
start2 = glumph;
glumph = end1;
end1 = end2;
end2 = glumph;
}
len1 = end1 - start1;
len2 = end2 - start2;
if (start2 < end1)
error ("Transposed regions overlap");
else if (start1 == end1 || start2 == end2)
error ("Transposed region has length 0");
if (start1 < gap && gap < end2)
{
if (gap - start1 < end2 - gap)
move_gap (start1);
else
move_gap (end2);
}
start1_byte = CHAR_TO_BYTE (start1);
start2_byte = CHAR_TO_BYTE (start2);
len1_byte = CHAR_TO_BYTE (end1) - start1_byte;
len2_byte = CHAR_TO_BYTE (end2) - start2_byte;
#ifdef BYTE_COMBINING_DEBUG
if (end1 == start2)
{
if (count_combining_before (BYTE_POS_ADDR (start2_byte),
len2_byte, start1, start1_byte)
|| count_combining_before (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
abort ();
}
else
{
if (count_combining_before (BYTE_POS_ADDR (start2_byte),
len2_byte, start1, start1_byte)
|| count_combining_before (BYTE_POS_ADDR (start1_byte),
len1_byte, start2, start2_byte)
|| count_combining_after (BYTE_POS_ADDR (start2_byte),
len2_byte, end1, start1_byte + len1_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
abort ();
}
#endif
if (end1 == start2)
{
modify_region (current_buffer, start1, end2, 0);
record_change (start1, len1 + len2);
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
if (len1_byte < len2_byte)
{
USE_SAFE_ALLOCA;
SAFE_ALLOCA (temp, unsigned char *, len2_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);
bcopy (temp, start1_addr, len2_byte);
SAFE_FREE ();
}
else
{
USE_SAFE_ALLOCA;
SAFE_ALLOCA (temp, unsigned char *, len1_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);
SAFE_FREE ();
}
graft_intervals_into_buffer (tmp_interval1, start1 + len2,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
update_compositions (start1, start1 + len2, CHECK_BORDER);
update_compositions (start1 + len2, end2, CHECK_TAIL);
}
else
{
len_mid = start2_byte - (start1_byte + len1_byte);
if (len1_byte == len2_byte)
{
USE_SAFE_ALLOCA;
modify_region (current_buffer, start1, end1, 0);
modify_region (current_buffer, start2, end2, 0);
record_change (start1, len1);
record_change (start2, len2);
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3);
tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3);
SAFE_ALLOCA (temp, unsigned char *, len1_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);
SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, start2,
len1, current_buffer, 0);
graft_intervals_into_buffer (tmp_interval2, start1,
len2, current_buffer, 0);
}
else if (len1_byte < len2_byte)
{
USE_SAFE_ALLOCA;
modify_region (current_buffer, start1, end2, 0);
record_change (start1, (end2 - start1));
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);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
SAFE_ALLOCA (temp, unsigned char *, len2_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);
SAFE_FREE ();
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);
}
else
{
USE_SAFE_ALLOCA;
record_change (start1, (end2 - start1));
modify_region (current_buffer, start1, end2, 0);
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);
tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0);
if (!NULL_INTERVAL_P (tmp_interval3))
set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3);
SAFE_ALLOCA (temp, unsigned char *, len1_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);
SAFE_FREE ();
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);
}
update_compositions (start1, start1 + len2, CHECK_BORDER);
update_compositions (end2 - len1, end2, CHECK_BORDER);
}
if (NILP (leave_markers))
{
transpose_markers (start1, end1, start2, end2,
start1_byte, start1_byte + len1_byte,
start2_byte, start2_byte + len2_byte);
fix_start_end_in_overlays (start1, end2);
}
signal_after_change (start1, end2 - start1, end2 - start1);
return Qnil;
}
void
syms_of_editfns ()
{
environbuf = 0;
Qbuffer_access_fontify_functions
= intern ("buffer-access-fontify-functions");
staticpro (&Qbuffer_access_fontify_functions);
DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion,
doc: );
Vinhibit_field_text_motion = Qnil;
DEFVAR_LISP ("buffer-access-fontify-functions",
&Vbuffer_access_fontify_functions,
doc: );
Vbuffer_access_fontify_functions = Qnil;
{
Lisp_Object obuf;
extern Lisp_Object Vprin1_to_string_buffer;
obuf = Fcurrent_buffer ();
Fset_buffer (Vprin1_to_string_buffer);
Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
Qnil);
Fset_buffer (obuf);
}
DEFVAR_LISP ("buffer-access-fontified-property",
&Vbuffer_access_fontified_property,
doc: );
Vbuffer_access_fontified_property = Qnil;
DEFVAR_LISP ("system-name", &Vsystem_name,
doc: );
DEFVAR_LISP ("user-full-name", &Vuser_full_name,
doc: );
DEFVAR_LISP ("user-login-name", &Vuser_login_name,
doc: );
DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name,
doc: );
DEFVAR_LISP ("operating-system-release", &Voperating_system_release,
doc: );
defsubr (&Spropertize);
defsubr (&Schar_equal);
defsubr (&Sgoto_char);
defsubr (&Sstring_to_char);
defsubr (&Schar_to_string);
defsubr (&Sbuffer_substring);
defsubr (&Sbuffer_substring_no_properties);
defsubr (&Sbuffer_string);
defsubr (&Spoint_marker);
defsubr (&Smark_marker);
defsubr (&Spoint);
defsubr (&Sregion_beginning);
defsubr (&Sregion_end);
staticpro (&Qfield);
Qfield = intern ("field");
staticpro (&Qboundary);
Qboundary = intern ("boundary");
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 (&Ssave_excursion);
defsubr (&Ssave_current_buffer);
defsubr (&Sbufsize);
defsubr (&Spoint_max);
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 (&Sbolp);
defsubr (&Seolp);
defsubr (&Sfollowing_char);
defsubr (&Sprevious_char);
defsubr (&Schar_after);
defsubr (&Schar_before);
defsubr (&Sinsert);
defsubr (&Sinsert_before_markers);
defsubr (&Sinsert_and_inherit);
defsubr (&Sinsert_and_inherit_before_markers);
defsubr (&Sinsert_char);
defsubr (&Suser_login_name);
defsubr (&Suser_real_login_name);
defsubr (&Suser_uid);
defsubr (&Suser_real_uid);
defsubr (&Suser_full_name);
defsubr (&Semacs_pid);
defsubr (&Scurrent_time);
defsubr (&Sget_internal_run_time);
defsubr (&Sformat_time_string);
defsubr (&Sfloat_time);
defsubr (&Sdecode_time);
defsubr (&Sencode_time);
defsubr (&Scurrent_time_string);
defsubr (&Scurrent_time_zone);
defsubr (&Sset_time_zone_rule);
defsubr (&Ssystem_name);
defsubr (&Smessage);
defsubr (&Smessage_box);
defsubr (&Smessage_or_box);
defsubr (&Scurrent_message);
defsubr (&Sformat);
defsubr (&Sinsert_buffer_substring);
defsubr (&Scompare_buffer_substrings);
defsubr (&Ssubst_char_in_region);
defsubr (&Stranslate_region_internal);
defsubr (&Sdelete_region);
defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);
defsubr (&Snarrow_to_region);
defsubr (&Ssave_restriction);
defsubr (&Stranspose_regions);
}