/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95,96,97,98,1999,2000,01,02,03,2004
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
+ 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include <sys/types.h>
+#include <stdio.h>
-#ifdef VMS
-#include "vms-pwd.h"
-#else
+#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#include <unistd.h>
#endif
-/* Without this, sprintf on Mac OS Classic will produce wrong
- result. */
-#ifdef MAC_OS8
-#include <stdio.h>
+#ifdef HAVE_SYS_UTSNAME_H
+#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 "systime.h"
+
+#if defined HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
#endif
#include <ctype.h>
-#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "charset.h"
#include "frame.h"
#include "window.h"
-#include "systime.h"
-
#ifdef STDC_HEADERS
#include <float.h>
#define MAX_10_EXP DBL_MAX_10_EXP
extern char **environ;
#endif
-extern Lisp_Object make_time P_ ((time_t));
extern size_t emacs_strftimeu P_ ((char *, size_t, const char *,
const struct tm *, int));
static int tm_diff P_ ((struct tm *, struct tm *));
Lisp_Object Vuser_real_login_name; /* login name of current user ID */
Lisp_Object Vuser_full_name; /* full name of current user */
Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER */
+Lisp_Object Voperating_system_release; /* Operating System Release */
/* Symbol for the text property used to mark fields. */
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
}
\f
DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
doc: /* Set point to POSITION, a number or marker.
-Beginning of buffer is position (point-min), end is (point-max).
-If the position is in the middle of a multibyte form,
-the actual point is set at the head of the multibyte form
-except in the case that `enable-multibyte-characters' is nil. */)
+Beginning of buffer is position (point-min), end is (point-max). */)
(position)
register Lisp_Object position;
{
= (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_text_property (new_pos, Qfield, Qnil))
+ || !NILP (Fget_text_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_text_property (prev_new, Qfield, Qnil)))
+ || (XFASTINT (old_pos) > BEGV
+ && !NILP (Fget_text_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_text_property (old_pos, inhibit_capture_property, Qnil))
+ || NILP (Fget_text_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. */)
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 "";
}
+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 the process ID of Emacs, as an integer. */)
()
return Flist (3, result);
}
+
+DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+ 0, 0, 0,
+ doc: /* Return the current run time used by Emacs.
+The time is returned as a list of three integers. The first has the
+most significant 16 bits of the seconds, while the second has the
+least significant 16 bits. The third integer gives the microsecond
+count.
+
+On systems that can't determine the run time, get-internal-run-time
+does the same thing as current-time. The microsecond count is zero on
+systems that do not provide resolution finer than a second. */)
+ ()
+{
+#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);
+
+ /* Sum up user time and system time. */
+ 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++;
+ }
+
+ XSETINT (result[0], (secs >> 16) & 0xffff);
+ XSETINT (result[1], (secs >> 0) & 0xffff);
+ XSETINT (result[2], usecs);
+
+ return Flist (3, result);
+#else
+ return Fcurrent_time ();
+#endif
+}
\f
int
{
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);
{
len = CHAR_STRING (XFASTINT (fromchar), fromstr);
if (CHAR_STRING (XFASTINT (tochar), tostr) != len)
- error ("Characters in subst-char-in-region have different byte-lengths");
+ error ("Characters in `subst-char-in-region' have different byte-lengths");
if (!ASCII_BYTE_P (*tostr))
{
/* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
{
if (tt)
{
+ /* Reload as signal_after_change in last iteration may GC. */
+ tt = SDATA (table);
if (string_multibyte)
{
str = tt + string_char_to_byte (table, oc);
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.
-If the first argument is nil, the function clears any existing message;
-this lets the minibuffer contents show. See also `current-message'.
+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;
&& SBYTES (args[0]) == 0))
{
message (0);
- return Qnil;
+ return args[0];
}
else
{
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.
-If the first argument is nil, clear any existing message; let the
-minibuffer contents show.
+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;
pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
GCPRO1 (pane);
menu = Fcons (val, pane);
- obj = Fx_popup_dialog (Qt, menu);
+ obj = Fx_popup_dialog (Qt, menu, Qt);
UNGCPRO;
return val;
}
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.
-If the first argument is nil, clear any existing message; let the
-minibuffer contents show.
+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;
string = Fcopy_sequence (args[0]);
for (i = 1; i < nargs; i += 2)
- {
- CHECK_SYMBOL (args[i]);
- properties = Fcons (args[i], Fcons (args[i + 1], properties));
- }
+ properties = Fcons (args[i], Fcons (args[i + 1], properties));
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
: 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)
{
else
p += this_nchars;
nchars += this_nchars;
+ info[n].end = nchars;
}
- info[n].end = nchars;
}
else if (STRING_MULTIBYTE (args[0]))
{
DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name,
doc: /* The user's name, based upon the real uid only. */);
+ DEFVAR_LISP ("operating-system-release", &Voperating_system_release,
+ doc: /* The release of the operating system Emacs is running on. */);
+
defsubr (&Spropertize);
defsubr (&Schar_equal);
defsubr (&Sgoto_char);
defsubr (&Suser_full_name);
defsubr (&Semacs_pid);
defsubr (&Scurrent_time);
+ defsubr (&Sget_internal_run_time);
defsubr (&Sformat_time_string);
defsubr (&Sfloat_time);
defsubr (&Sdecode_time);
HCoop / bpt / emacs.git / blobdiff