/* Lisp functions pertaining to editing.
Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005 Free Software Foundation, Inc.
+ 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/utsname.h>
#endif
+#include "lisp.h"
+
/* systime.h includes <sys/time.h> which, on some systems, is required
for <sys/resource.h>; thus systime.h must be included before
<sys/resource.h> */
#include <ctype.h>
-#include "lisp.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>
extern char **environ;
#endif
-extern Lisp_Object make_time P_ ((time_t));
+#define TM_YEAR_BASE 1900
+
+/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
+ asctime to have well-defined behavior. */
+#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 *));
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
- Fsignal (Qmark_inactive, Qnil);
+ xsignal0 (Qmark_inactive);
m = Fmarker_position (current_buffer->mark);
if (NILP (m))
}
/* Find the field surrounding POS in *BEG and *END. If POS is nil,
- the value of point is used instead. If BEG or END null,
+ the value of point is used instead. If BEG or END is null,
means don't store the beginning or end of the field.
BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
= (XFASTINT (pos) > BEGV
? get_char_property_and_overlay (make_number (XINT (pos) - 1),
Qfield, Qnil, NULL)
- : Qnil);
+ /* Using nil here would be a more obvious choice, but it would
+ fail when the buffer starts with a non-sticky field. */
+ : after_field);
/* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
and POS is at beginning of a field, which can also be interpreted
{
/* If non-zero, then the original point, before re-positioning. */
int orig_point = 0;
+ int fwd;
+ Lisp_Object prev_old, prev_new;
if (NILP (new_pos))
/* Use the current point, and afterwards, set it. */
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)))
+ || !NILP (Fget_char_property (old_pos, Qfield, Qnil))
+ /* To recognize field boundaries, we must also look at the
+ previous positions; we could use `get_pos_property'
+ instead, but in itself that would fail inside non-sticky
+ fields (like comint prompts). */
+ || (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 (Fget_char_property(old_pos, inhibit_capture_property, Qnil))))
- /* NEW_POS is not within the same field as OLD_POS; try to
- move NEW_POS so that it is. */
+ /* Field boundaries are again a problem; but now we must
+ decide the case exactly, so we need to call
+ `get_pos_property' as well. */
+ || (NILP (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))))))
+ /* It is possible that NEW_POS is not within the same field as
+ OLD_POS; try to move NEW_POS so that it is. */
{
- int fwd, shortage;
+ int shortage;
Lisp_Object field_bound;
- CHECK_NUMBER_COERCE_MARKER (new_pos);
- CHECK_NUMBER_COERCE_MARKER (old_pos);
-
- fwd = (XFASTINT (new_pos) > XFASTINT (old_pos));
-
if (fwd)
field_bound = Ffield_end (old_pos, escape_from_edge, new_pos);
else
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
-The scan does not cross a field boundary unless doing so would move
-beyond there to a different line; if N is nil or 1, and scan starts at a
-field boundary, the scan stops as soon as it starts. To ignore field
+This function constrains the returned position to the current field
+unless that would be on a different line than the original,
+unconstrained result. If N is nil or 1, and a front-sticky field
+starts at point, the scan stops as soon as it starts. To ignore field
boundaries bind `inhibit-field-text-motion' to t.
This function does not move point. */)
Lisp_Object n;
{
int orig, orig_byte, end;
+ int count = SPECPDL_INDEX ();
+ specbind (Qinhibit_point_motion_hooks, Qt);
if (NILP (n))
XSETFASTINT (n, 1);
SET_PT_BOTH (orig, orig_byte);
+ unbind_to (count, Qnil);
+
/* Return END constrained to the current input field. */
return Fconstrain_to_field (make_number (end), make_number (orig),
XINT (n) != 1 ? Qt : Qnil,
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
-The scan does not cross a field boundary unless doing so would move
-beyond there to a different line; if N is nil or 1, and scan starts at a
-field boundary, the scan stops as soon as it starts. To ignore field
+This function constrains the returned position to the current field
+unless that would be on a different line than the original,
+unconstrained result. If N is nil or 1, and a rear-sticky field ends
+at point, the scan stops as soon as it starts. To ignore field
boundaries bind `inhibit-field-text-motion' to t.
This function does not move point. */)
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);
}
if (NILP (uid))
return Vuser_full_name;
else if (NUMBERP (uid))
- pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid));
+ {
+ BLOCK_INPUT;
+ pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid));
+ UNBLOCK_INPUT;
+ }
else if (STRINGP (uid))
- pw = (struct passwd *) getpwnam (SDATA (uid));
+ {
+ BLOCK_INPUT;
+ pw = (struct passwd *) getpwnam (SDATA (uid));
+ UNBLOCK_INPUT;
+ }
else
error ("Invalid UID specification");
}
DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0,
- doc: /* Return the name of the machine you are running on, as a string. */)
+ doc: /* Return the host name of the machine you are running on, as a string. */)
()
{
return Vsystem_name;
()
{
EMACS_TIME t;
- Lisp_Object result[3];
EMACS_GET_TIME (t);
- XSETINT (result[0], (EMACS_SECS (t) >> 16) & 0xffff);
- XSETINT (result[1], (EMACS_SECS (t) >> 0) & 0xffff);
- XSETINT (result[2], EMACS_USECS (t));
-
- return Flist (3, result);
+ 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,
{
#ifdef HAVE_GETRUSAGE
struct rusage usage;
- Lisp_Object result[3];
int secs, usecs;
if (getrusage (RUSAGE_SELF, &usage) < 0)
/* This shouldn't happen. What action is appropriate? */
- Fsignal (Qerror, Qnil);
+ xsignal0 (Qerror);
/* Sum up user time and system time. */
secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
secs++;
}
- XSETINT (result[0], (secs >> 16) & 0xffff);
- XSETINT (result[1], (secs >> 0) & 0xffff);
- XSETINT (result[2], usecs);
-
- return Flist (3, result);
+ return list3 (make_number ((secs >> 16) & 0xffff),
+ make_number ((secs >> 0) & 0xffff),
+ make_number (usecs));
#else
return Fcurrent_time ();
#endif
SBYTES (format_string),
tm, ut);
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
- return code_convert_string_norecord (make_string (buf, result),
+ return code_convert_string_norecord (make_unibyte_string (buf, result),
Vlocale_coding_system, 0);
/* If buffer was too small, make it bigger and try again. */
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], decoded_time->tm_year + 1900);
+ /* On 64-bit machines an int is narrower than EMACS_INT, thus the
+ cast below avoids overflow in int arithmetics. */
+ 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;
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]) - 1900;
+ tm.tm_year = XINT (args[5]) - TM_YEAR_BASE;
tm.tm_isdst = -1;
if (CONSP (zone))
DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 1, 0,
doc: /* Return the current time, as a human-readable string.
Programs can use this function to decode a time,
-since the number of columns in each field is fixed.
+since the number of columns in each field is fixed
+if the year is in the range 1000-9999.
The format is `Sun Sep 16 01:03:52 1973'.
However, see also the functions `decode-time' and `format-time-string'
which provide a much more powerful and general facility.
Lisp_Object specified_time;
{
time_t value;
- char buf[30];
+ struct tm *tm;
register char *tem;
if (! lisp_time_argument (specified_time, &value, NULL))
- value = -1;
- tem = (char *) ctime (&value);
+ error ("Invalid time specification");
- strncpy (buf, tem, 24);
- buf[24] = 0;
+ /* Convert to a string, checking for out-of-range time stamps.
+ Don't use 'ctime', as that might dump core if VALUE is out of
+ range. */
+ tm = localtime (&value);
+ if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
+ error ("Specified time is not representable");
- return build_string (buf);
-}
+ /* Remove the trailing newline. */
+ tem[strlen (tem) - 1] = '\0';
-#define TM_YEAR_BASE 1900
+ return build_string (tem);
+}
/* Yield A - B, measured in seconds.
This function is copied from the GNU C Library. */
for (argnum = 0; argnum < nargs; argnum++)
{
val = args[argnum];
- retry:
if (INTEGERP (val))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
inherit);
}
else
- {
- val = wrong_type_argument (Qchar_or_string_p, val);
- goto retry;
- }
+ wrong_type_argument (Qchar_or_string_p, val);
}
}
{
register int begp1, endp1, begp2, endp2, temp;
register struct buffer *bp1, *bp2;
- register Lisp_Object *trt
+ register Lisp_Object trt
= (!NILP (current_buffer->case_fold_search)
- ? XCHAR_TABLE (current_buffer->case_canon_table)->contents : 0);
+ ? current_buffer->case_canon_table : Qnil);
int chars = 0;
int i1, i2, i1_byte, i2_byte;
i2++;
}
- if (trt)
+ if (!NILP (trt))
{
- c1 = XINT (trt[c1]);
- c2 = XINT (trt[c2]);
+ c1 = CHAR_TABLE_TRANSLATE (trt, c1);
+ c2 = CHAR_TABLE_TRANSLATE (trt, c2);
}
if (c1 < c2)
return make_number (- 1 - chars);
Lisp_Object start, end, fromchar, tochar, noundo;
{
register int pos, pos_byte, stop, i, len, end_byte;
+ /* Keep track of the first change in the buffer:
+ if 0 we haven't found it yet.
+ if < 0 we've found it and we've run the before-change-function.
+ if > 0 we've actually performed it and the value is its position. */
int changed = 0;
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
unsigned char *p;
int last_changed = 0;
int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
+ restart:
+
validate_region (&start, &end);
CHECK_NUMBER (fromchar);
CHECK_NUMBER (tochar);
That's faster than getting rid of things,
and it prevents even the entry for a first change.
Also inhibit locking the file. */
- if (!NILP (noundo))
+ if (!changed && !NILP (noundo))
{
record_unwind_protect (subst_char_in_region_unwind,
current_buffer->undo_list);
&& (len == 2 || (p[2] == fromstr[2]
&& (len == 3 || p[3] == fromstr[3]))))))
{
- if (! changed)
+ if (changed < 0)
+ /* We've already seen this and run the before-change-function;
+ this time we only need to record the actual position. */
+ changed = pos;
+ else if (!changed)
{
- changed = pos;
- modify_region (current_buffer, changed, XINT (end));
+ changed = -1;
+ modify_region (current_buffer, pos, XINT (end), 0);
if (! NILP (noundo))
{
if (MODIFF - 1 == current_buffer->auto_save_modified)
current_buffer->auto_save_modified++;
}
+
+ /* The before-change-function may have moved the gap
+ or even modified the buffer so we should start over. */
+ goto restart;
}
/* Take care of the case where the new character
pos++;
}
- if (changed)
+ if (changed > 0)
{
signal_after_change (changed,
last_changed - changed, last_changed - changed);
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
end_pos = XINT (end);
- modify_region (current_buffer, pos, XINT (end));
+ modify_region (current_buffer, pos, XINT (end), 0);
cnt = 0;
for (; pos < end_pos; )
static int message_length;
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
- doc: /* Print a one-line message at the bottom of the screen.
+ doc: /* Display a message at the bottom of the screen.
The message also goes into the `*Messages*' buffer.
\(In keyboard macros, that's all it does.)
+Return the message.
The first argument is a format control string, and the rest are data
to be formatted under control of the string. See `format' for details.
+Note: Use (message "%s" VALUE) to print the value of expressions and
+variables to avoid accidentally interpreting `%' as format specifiers.
+
If the first argument is nil or the empty string, the function clears
any existing message; this lets the minibuffer contents show. See
also `current-message'.
-usage: (message STRING &rest ARGS) */)
+usage: (message FORMAT-STRING &rest ARGS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
-usage: (message-box STRING &rest ARGS) */)
+usage: (message-box FORMAT-STRING &rest ARGS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
If the first argument is nil or the empty string, clear any existing
message; let the minibuffer contents show.
-usage: (message-or-box STRING &rest ARGS) */)
+usage: (message-or-box FORMAT-STRING &rest ARGS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
: SBYTES (STRING))
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
- doc: /* Format a string out of a control-string and arguments.
-The first argument is a control string.
+ doc: /* Format a string out of a format-string and arguments.
+The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
It may contain %-sequences meaning to substitute the next argument.
%s means print a string argument. Actually, prints any object, with `princ'.
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- while (index ("-0# ", *format))
+ while (format != end
+ && (*format == '-' || *format == '0' || *format == '#'
+ || * format == ' '))
++format;
if (*format >= '0' && *format <= '9')
++nchars;
}
- start = nchars;
+ info[n].start = start = nchars;
nchars += nchars_string;
end = nchars;
nbytes,
STRING_MULTIBYTE (args[n]), multibyte);
+ info[n].end = nchars;
+
if (negative)
while (padding-- > 0)
{
this_format[format - this_format_start] = 0;
if (INTEGERP (args[n]))
- sprintf (p, this_format, XINT (args[n]));
+ {
+ if (format[-1] == 'd')
+ sprintf (p, this_format, XINT (args[n]));
+ /* Don't sign-extend for octal or hex printing. */
+ else
+ sprintf (p, this_format, XUINT (args[n]));
+ }
else
sprintf (p, this_format, XFLOAT_DATA (args[n]));
else
p += this_nchars;
nchars += this_nchars;
+ info[n].end = nchars;
}
- info[n].end = nchars;
}
else if (STRING_MULTIBYTE (args[0]))
{
/* Likewise adjust the property end position. */
pos = XINT (XCAR (XCDR (item)));
- for (; bytepos < pos; bytepos++)
+ for (; position < pos; bytepos++)
{
if (! discarded[bytepos])
position++, translated++;
if (end1 == start2) /* adjacent regions */
{
- modify_region (current_buffer, start1, end2);
+ modify_region (current_buffer, start1, end2, 0);
record_change (start1, len1 + len2);
tmp_interval1 = copy_intervals (cur_intv, start1, len1);
{
USE_SAFE_ALLOCA;
- modify_region (current_buffer, start1, end1);
- modify_region (current_buffer, start2, end2);
+ 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);
{
USE_SAFE_ALLOCA;
- modify_region (current_buffer, start1, end2);
+ 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);
USE_SAFE_ALLOCA;
record_change (start1, (end2 - start1));
- modify_region (current_buffer, start1, end2);
+ 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);
Vbuffer_access_fontified_property = Qnil;
DEFVAR_LISP ("system-name", &Vsystem_name,
- doc: /* The name of the machine Emacs is running on. */);
+ doc: /* The host name of the machine Emacs is running on. */);
DEFVAR_LISP ("user-full-name", &Vuser_full_name,
doc: /* The full name of the user logged in. */);