#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 Qbuffer_access_fontify_functions;
Lisp_Object Vbuffer_access_fontified_property;
+Lisp_Object Fuser_full_name ();
+
/* Some static data, and a function to initialize it for each run */
Lisp_Object Vsystem_name;
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);
- if (n <= BEGV || n > ZV) return Qnil;
+ n = XINT (pos);
+ }
+
+ 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, 2, 0,
- "Use FORMAT-STRING to format the time TIME.\n\
-TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from\n\
-`current-time' and `file-attributes'.\n\
-FORMAT-STRING may contain %-sequences to substitute parts of the time.\n\
-%a is replaced by the abbreviated name of the day of week.\n\
-%A is replaced by the full name of the day of week.\n\
-%b is replaced by the abbreviated name of the month.\n\
-%B is replaced by the full name of the month.\n\
-%c stands for the preferred date/time format of the C locale.\n\
-%d is replaced by the day of month, zero-padded.\n\
-%D is a synonym for \"%m/%d/%y\".\n\
-%e is replaced by the day of month, blank-padded.\n\
-%h is a synonym for \"%b\".\n\
-%H is replaced by the hour (00-23).\n\
-%I is replaced by the hour (00-12).\n\
-%j is replaced by the day of the year (001-366).\n\
-%k is replaced by the hour (0-23), blank padded.\n\
-%l is replaced by the hour (1-12), blank padded.\n\
-%m is replaced by the month (01-12).\n\
-%M is replaced by the minute (00-59).\n\
-%n is a synonym for \"\\n\".\n\
-%p is replaced by AM or PM, as appropriate.\n\
-%r is a synonym for \"%I:%M:%S %p\".\n\
-%R is a synonym for \"%H:%M\".\n\
-%S is replaced by the second (00-60).\n\
-%t is a synonym for \"\\t\".\n\
-%T is a synonym for \"%H:%M:%S\".\n\
-%U is replaced by the week of the year (00-53), first day of week is Sunday.\n\
-%w is replaced by the day of week (0-6), Sunday is day 0.\n\
-%W is replaced by the week of the year (00-53), first day of week is Monday.\n\
-%x is a locale-specific synonym, which defaults to \"%D\" in the C locale.\n\
-%X is a locale-specific synonym, which defaults to \"%T\" in the C locale.\n\
-%y is replaced by the year without century (00-99).\n\
-%Y is replaced by the year with century.\n\
-%Z is replaced by the time zone abbreviation.\n\
+/*
+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\
+`current-time' or `file-attributes'.\n\
+The third, optional, argument UNIVERSAL, if non-nil, means describe TIME\n\
+as Universal Time; nil means describe TIME in the local time zone.\n\
+The value is a copy of FORMAT-STRING, but with certain constructs replaced\n\
+by text that describes the specified date and time in TIME:\n\
\n\
-The number of options reflects the `strftime' function.")
- (format_string, time)
- Lisp_Object format_string, time;
+%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.\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 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 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\
+%s is the number of seconds since 1970-01-01 00:00:00 +0000.\n\
+\n\
+%c is the locale's date and time format.\n\
+%x is the locale's \"preferred\" date format.\n\
+%D is like \"%m/%d/%y\".\n\
+\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 a newline, %t is a tab, %% is a literal %.\n\
+\n\
+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\
+but takes up at least N (a number) positions.\n\
+The modifiers are `E' and `O'. For certain characters X,\n\
+%EX is a locale's alternative version of %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;
{
time_t value;
int size;
while (1)
{
- char *buf = (char *) alloca (size);
- *buf = 1;
- if (emacs_strftime (buf, size, XSTRING (format_string)->data,
- localtime (&value))
- || !*buf)
+ 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) || (result == 0 && buf[0] == '\0'))
return build_string (buf);
- /* If buffer was too small, make it bigger. */
- size *= 2;
+
+ /* If buffer was too small, make it bigger and try again. */
+ 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. */
(c1, c2)
register Lisp_Object c1, c2;
{
- Lisp_Object *downcase = DOWNCASE_TABLE;
CHECK_NUMBER (c1, 0);
CHECK_NUMBER (c2, 1);
- if ((!NILP (current_buffer->case_fold_search)
- && SINGLE_BYTE_CHAR_P (c1) /* For the moment, downcase table is */
- && SINGLE_BYTE_CHAR_P (c2) /* implemented only for ASCII characters. */
- )
- ? ((XINT (downcase[0xff & XFASTINT (c1)])
- == XINT (downcase[0xff & XFASTINT (c2)]))
- && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff))
- : XINT (c1) == XINT (c2))
+ if (XINT (c1) == XINT (c2)
+ && (NILP (current_buffer->case_fold_search)
+ || DOWNCASE (XFASTINT (c1)) == DOWNCASE (XFASTINT (c2))))
return Qt;
return Qnil;
}
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);