/* 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,
{
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++)
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
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);