/* 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
+
+/* 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 "frame.h"
#include "window.h"
-#include "systime.h"
-
#ifdef STDC_HEADERS
#include <float.h>
#define MAX_10_EXP DBL_MAX_10_EXP
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,
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
{
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 (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table))
error ("Not a translation table");
+ size = MAX_CHAR;
tt = NULL;
}
else
{
CHECK_STRING (table);
- if (multibyte != (SCHARS (table) < SBYTES (table)))
- table = (multibyte
- ? string_make_multibyte (table)
- : string_make_unibyte (table));
+ if (! multibyte && (SCHARS (table) < SBYTES (table)))
+ table = string_make_unibyte (table);
string_multibyte = SCHARS (table) < SBYTES (table);
size = SBYTES (table);
tt = SDATA (table);
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
- end_pos = XINT (end);
+ end_pos = XINT (end);
modify_region (current_buffer, pos, end_pos);
cnt = 0;
Lisp_Object val;
if (multibyte)
- nc = oc = STRING_CHAR_AND_LENGTH (p, 0, len);
+ oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len);
else
- nc = oc = *p, len = 1;
- if (tt)
+ oc = *p, len = 1;
+ if (oc < size)
{
- if (oc < size)
+ 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);
- nc = STRING_CHAR_AND_LENGTH (str, 0, str_len);
+ nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH,
+ str_len);
}
else
{
- str = tt + oc;
- nc = tt[oc], str_len = 1;
+ nc = tt[oc];
+ if (! ASCII_BYTE_P (nc) && multibyte)
+ {
+ str_len = BYTE8_STRING (nc, buf);
+ str = buf;
+ }
+ else
+ {
+ str_len = 1;
+ str = tt + oc;
+ }
}
}
- }
- else
- {
- val = CHAR_TABLE_REF (table, oc);
- if (CHARACTERP (val))
- {
- nc = XFASTINT (val);
- str_len = CHAR_STRING (nc, buf);
- str = buf;
- }
- else if (VECTORP (val) || (CONSP (val)))
+ else
{
- /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
- where TO is TO-CHAR or [TO-CHAR ...]. */
- nc = -1;
+ int c;
+
+ nc = oc;
+ val = CHAR_TABLE_REF (table, oc);
+ if (CHARACTERP (val)
+ && (c = XINT (val), CHAR_VALID_P (c, 0)))
+ {
+ nc = c;
+ str_len = CHAR_STRING (nc, buf);
+ str = buf;
+ }
+ else if (VECTORP (val) || (CONSP (val)))
+ {
+ /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
+ where TO is TO-CHAR or [TO-CHAR ...]. */
+ nc = -1;
+ }
}
- }
- if (nc != oc)
- {
- if (nc >= 0)
+ if (nc != oc && nc >= 0)
{
/* Simple one char to one char translation. */
if (len != str_len)
}
++cnt;
}
- else
+ else if (nc < 0)
{
Lisp_Object string;
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);
}
\f
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
doc: /* Print a one-line message at the bottom of the screen.
+The message also goes into the `*Messages*' buffer.
+\(In keyboard macros, that's all it does.)
+
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, 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'.
/* discarded[I] is 1 if byte I of the format
string was not copied into the output.
It is 2 if byte I was not the first byte of its character. */
- char *discarded;
+ char *discarded = 0;
/* Each element records, for one argument,
the start and end bytepos in the output string,
/* Piggyback on this loop to initialize precision[N]. */
precision[n] = -1;
}
+ precision[nargs] = -1;
CHECK_STRING (args[0]);
/* We may have to change "%S" to "%s". */
/* Allocate the info and discarded tables. */
{
- int nbytes = nargs * sizeof *info;
+ int nbytes = (nargs+1) * sizeof *info;
int i;
- info = (struct info *) alloca (nbytes);
+ if (!info)
+ info = (struct info *) alloca (nbytes);
bzero (info, nbytes);
- for (i = 0; i < nargs; i++)
+ for (i = 0; i <= nargs; i++)
info[i].start = -1;
- discarded = (char *) alloca (SBYTES (args[0]));
+ if (!discarded)
+ SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
bzero (discarded, SBYTES (args[0]));
}
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')
val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If we allocated BUF with malloc, free it too. */
- SAFE_FREE (total);
+ SAFE_FREE ();
/* If the format string has text properties, or any of the string
arguments has text properties, set up text properties of the
/* Adjust the bounds of each text property
to the proper start and end in the output string. */
- /* We take advantage of the fact that the positions in PROPS
- are in increasing order, so that we can do (effectively)
- one scan through the position space of the format string.
- BYTEPOS is the byte position in the format string,
+ /* Put the positions in PROPS in increasing order, so that
+ we can do (effectively) one scan through the position
+ space of the format string. */
+ props = Fnreverse (props);
+
+ /* BYTEPOS is the byte position in the format string,
POSITION is the untranslated char position in it,
TRANSLATED is the translated char position in BUF,
and ARGN is the number of the next arg we will come to. */
bcopy (start2_addr, temp, len2_byte);
bcopy (start1_addr, start1_addr + len2_byte, len1_byte);
bcopy (temp, start1_addr, len2_byte);
- SAFE_FREE (len2_byte);
+ SAFE_FREE ();
}
else
/* First region not smaller than second. */
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start1_addr + len2_byte, len1_byte);
- SAFE_FREE (len1_byte);
+ SAFE_FREE ();
}
graft_intervals_into_buffer (tmp_interval1, start1 + len2,
len1, current_buffer, 0);
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start2_addr, len1_byte);
- SAFE_FREE (len1_byte);
+ SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, start2,
len1, current_buffer, 0);
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 (len2_byte);
+ SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 0);
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 (len1_byte);
+ SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 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);