#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
+#ifndef NULL
+#define NULL 0
+#endif
+
extern char **environ;
extern Lisp_Object make_time ();
extern void insert_from_buffer ();
static int tm_diff ();
static void update_buffer_properties ();
+size_t emacs_strftime ();
void set_time_zone_rule ();
Lisp_Object Vbuffer_access_fontify_functions;
Lisp_Object character;
{
int len;
- char workbuf[4], *str;
+ unsigned char workbuf[4], *str;
CHECK_NUMBER (character, 0);
(str, idx)
Lisp_Object str, idx;
{
- register int idxval, len;
- register unsigned char *p;
+ register int idxval, len, i;
+ register unsigned char *p, *q;
register Lisp_Object val;
CHECK_STRING (str, 0);
idxval = XINT (idx);
if (idxval < 0 || idxval >= (len = XVECTOR (str)->size))
args_out_of_range (str, idx);
+
p = XSTRING (str)->data + idxval;
- if (!CHAR_HEAD_P (p))
- error ("Not character boundary");
+ if (!NILP (current_buffer->enable_multibyte_characters)
+ && !CHAR_HEAD_P (p)
+ && idxval > 0)
+ {
+ /* We must check if P points to a tailing byte of a multibyte
+ form. If so, we signal error. */
+ i = idxval - 1;
+ q = p - 1;
+ while (i > 0 && *q >= 0xA0) i--, q--;
+
+ if (*q == LEADING_CODE_COMPOSITION)
+ i = multibyte_form_length (XSTRING (str)->data + i, len - i);
+ else
+ i = BYTES_BY_CHAR_HEAD (*q);
+ if (q + i > p)
+ error ("Not character boundary");
+ }
len = XSTRING (str)->size - idxval;
XSETFASTINT (val, STRING_CHAR (p, len));
XSETFASTINT (temp, FETCH_CHAR (pos));
}
else
- XSETFASTINT (temp, FETCH_BYTE (point - 1));
+ XSETFASTINT (temp, FETCH_BYTE (PT - 1));
return temp;
}
return Qnil;
}
-DEFUN ("char-after", Fchar_after, Schar_after, 1, 1, 0,
+DEFUN ("char-after", Fchar_after, Schar_after, 0, 1, 0,
"Return character in current buffer at position POS.\n\
POS is an integer or a buffer pointer.\n\
If POS is out of range, the value is nil.\n\
register Lisp_Object val;
register int n;
- CHECK_NUMBER_COERCE_MARKER (pos, 0);
+ if (NILP (pos))
+ n = PT;
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
- n = XINT (pos);
- if (n < BEGV || n >= ZV) return Qnil;
+ n = XINT (pos);
+ if (n < BEGV || n >= ZV)
+ return Qnil;
+ }
XSETFASTINT (val, FETCH_CHAR (n));
return val;
}
-DEFUN ("char-before", Fchar_before, Schar_before, 1, 1, 0,
+DEFUN ("char-before", Fchar_before, Schar_before, 0, 1, 0,
"Return character in current buffer preceding position POS.\n\
POS is an integer or a buffer pointer.\n\
If POS is out of range, the value is nil.\n\
register Lisp_Object val;
register int n;
- CHECK_NUMBER_COERCE_MARKER (pos, 0);
+ if (NILP (pos))
+ n = PT;
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+ n = XINT (pos);
+ }
- n = XINT (pos);
- if (n <= BEGV || n > ZV) return Qnil;
+ if (n <= BEGV || n > ZV)
+ return Qnil;
if (!NILP (current_buffer->enable_multibyte_characters))
{
- DEC_POS (pos);
- XSETFASTINT (val, FETCH_CHAR (pos));
+ DEC_POS (n);
+ XSETFASTINT (val, FETCH_CHAR (n));
}
else
{
- pos--;
- XSETFASTINT (val, FETCH_BYTE (pos));
+ n--;
+ XSETFASTINT (val, FETCH_BYTE (n));
}
return val;
}
Lisp_Object uid;
{
struct passwd *pw;
- register char *p, *q;
+ register unsigned char *p, *q;
extern char *index ();
Lisp_Object full;
/* Substitute the login name for the &, upcasing the first character. */
if (q)
{
- register char *r;
+ register unsigned char *r;
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
char *
get_system_name ()
{
- return (char *) XSTRING (Vsystem_name)->data;
+ if (STRINGP (Vsystem_name))
+ return (char *) XSTRING (Vsystem_name)->data;
+ else
+ return "";
}
DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
}
}
+/*
DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
"Use FORMAT-STRING to format the time TIME, or now if omitted.\n\
TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by\n\
\n\
%Y is the year, %y within the century, %C the century.\n\
%G is the year corresponding to the ISO week, %g within the century.\n\
-%m is the numeric month, %b and %h the abbreviated name, %B the full name.\n\
+%m is the numeric month.\n\
+%b and %h are the locale's abbreviated month name, %B the full name.\n\
%d is the day of the month, zero-padded, %e is blank-padded.\n\
%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.\n\
-%a is the abbreviated name of the day of week, %A the full name.\n\
+%a is the locale's abbreviated name of the day of week, %A the full name.\n\
%U is the week number starting on Sunday, %W starting on Monday,\n\
%V according to ISO 8601.\n\
%j is the day of the year.\n\
\n\
%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H\n\
only blank-padded, %l is like %I blank-padded.\n\
-%p is AM or PM.\n\
+%p is the locale's equivalent of either AM or PM.\n\
%M is the minute.\n\
%S is the second.\n\
%Z is the time zone name, %z is the numeric form.\n\
%R is like \"%H:%M\", %T is like \"%H:%M:%S\", %r is like \"%I:%M:%S %p\".\n\
%X is the locale's \"preferred\" time format.\n\
\n\
-Finally, %n is like \n, %t is like \t, %% is a literal %.\n\
+Finally, %n is a newline, %t is a tab, %% is a literal %.\n\
\n\
-Certain flags and modifiers are available with some format controls.
+Certain flags and modifiers are available with some format controls.\n\
The flags are `_' and `-'. For certain characters X, %_X is like %X,\n\
but padded with blanks; %-X is like %X, but without padding.\n\
%NX (where N stands for an integer) is like %X,\n\
%OX is like %X, but uses the locale's number symbols.\n\
\n\
For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\".")
+ (format_string, time, universal)
+*/
+
+DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
+ 0 /* See immediately above */)
(format_string, time, universal)
Lisp_Object format_string, time, universal;
{
char *buf = (char *) alloca (size + 1);
int result;
+ buf[0] = '\1';
result = emacs_strftime (buf, size, XSTRING (format_string)->data,
(NILP (universal) ? localtime (&value)
: gmtime (&value)));
- if (result > 0 && result < size)
+ if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
return build_string (buf);
- if (result < 0)
- error ("Invalid time format specification");
/* If buffer was too small, make it bigger and try again. */
- result = emacs_strftime (buf, 0, XSTRING (format_string)->data,
+ result = emacs_strftime (NULL, 0x7fffffff, XSTRING (format_string)->data,
(NILP (universal) ? localtime (&value)
: gmtime (&value)));
size = result + 1;
char *tzstring;
char **oldenv = environ, **newenv;
- if (zone == Qt)
+ if (EQ (zone, Qt))
tzstring = "UTC0";
else if (STRINGP (zone))
tzstring = (char *) XSTRING (zone)->data;
Programs can use this function to decode a time,\n\
since the number of columns in each field is fixed.\n\
The format is `Sun Sep 16 01:03:52 1973'.\n\
+However, see also the functions `decode-time' and `format-time-string'\n\
+which provide a much more powerful and general facility.\n\
+\n\
If an argument is given, it specifies a time to format\n\
instead of the current time. The argument should have the form:\n\
(HIGH . LOW)\n\
return Fcons (make_number (offset), Fcons (build_string (s), Qnil));
}
else
- return Fmake_list (2, Qnil);
+ return Fmake_list (make_number (2), Qnil);
}
/* This holds the value of `environ' produced by the previous
if (NILP (tz))
tzstring = 0;
- else if (tz == Qt)
+ else if (EQ (tz, Qt))
tzstring = "UTC0";
else
{
type of object is Lisp_String). INHERIT is passed to
INSERT_FROM_STRING_FUNC as the last argument. */
+void
general_insert_function (insert_func, insert_from_string_func,
inherit, nargs, args)
- int (*insert_func)(), (*insert_from_string_func)();
+ void (*insert_func) P_ ((unsigned char *, int));
+ void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int));
int inherit, nargs;
register Lisp_Object *args;
{
retry:
if (INTEGERP (val))
{
- char workbuf[4], *str;
+ unsigned char workbuf[4], *str;
int len;
if (!NILP (current_buffer->enable_multibyte_characters))
string[i] = str[i % len];
while (n >= strlen)
{
+ QUIT;
if (!NILP (inherit))
insert_and_inherit (string, strlen);
else
int c2 = *BUF_CHAR_ADDRESS (bp2, begp2 + i);
if (trt)
{
- c1 = trt[c1];
- c2 = trt[c2];
+ c1 = XINT (trt[c1]);
+ c2 = XINT (trt[c2]);
}
if (c1 < c2)
return make_number (- 1 - i);
This allows the buffer's full text to be seen and edited.")
()
{
+ if (BEG != BEGV || Z != ZV)
+ current_buffer->clip_changed = 1;
BEGV = BEG;
SET_BUF_ZV (current_buffer, Z);
- current_buffer->clip_changed = 1;
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
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;
+
BEGV = 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));
- current_buffer->clip_changed = 1;
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
register struct buffer *buf;
register int newhead, newtail;
register Lisp_Object tem;
+ int obegv, ozv;
buf = XBUFFER (XCONS (data)->car);
newhead = 0;
newtail = 0;
}
+
+ obegv = BUF_BEGV (buf);
+ ozv = BUF_ZV (buf);
+
BUF_BEGV (buf) = BUF_BEG (buf) + newhead;
SET_BUF_ZV (buf, BUF_Z (buf) - newtail);
- current_buffer->clip_changed = 1;
+
+ if (obegv != BUF_BEGV (buf) || ozv != BUF_ZV (buf))
+ current_buffer->clip_changed = 1;
/* If point is outside the new visible range, move it inside. */
SET_BUF_PT (buf,
return Fmessage (nargs, args);
}
+DEFUN ("current-message", Fcurrent_message, Scurrent_message, 0, 0, 0,
+ "Return the string currently displayed in the echo area, or nil if none.")
+ ()
+{
+ return (echo_area_glyphs
+ ? make_string (echo_area_glyphs, echo_area_glyphs_length)
+ : Qnil);
+}
+
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
"Format a string out of a control-string and arguments.\n\
The first argument is a control string.\n\
else if (FLOATP (args[n]) && *format != 's')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
- args[n] = Ftruncate (args[n]);
+ args[n] = Ftruncate (args[n], Qnil);
total += 30;
/* We have to put an arbitrary limit on minlen
since otherwise it could make alloca fail. */
for (marker = BUF_MARKERS (current_buffer); !NILP (marker);
marker = XMARKER (marker)->chain)
{
- mpos = Fmarker_position (marker);
+ mpos = marker_position (marker);
if (mpos >= start1 && mpos < end2)
{
if (mpos < end1)
#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* First region smaller than second. */
#ifdef USE_TEXT_PROPERTIES
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
tmp_interval2 = copy_intervals (cur_intv, start2, len2);
- Fset_text_properties (start1, end1, Qnil, Qnil);
- Fset_text_properties (start2, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end1),
+ Qnil, Qnil);
+ Fset_text_properties (make_number (start2), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
if (len1 > 20000)
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);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* holds region 2 */
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);
- Fset_text_properties (start1, end2, Qnil, Qnil);
+ Fset_text_properties (make_number (start1), make_number (end2),
+ Qnil, Qnil);
#endif /* USE_TEXT_PROPERTIES */
/* holds region 1 */
defsubr (&Smessage);
defsubr (&Smessage_box);
defsubr (&Smessage_or_box);
+ defsubr (&Scurrent_message);
defsubr (&Sformat);
defsubr (&Sinsert_buffer_substring);