/* 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 "lisp.h"
#include "intervals.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.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,
CHECK_NUMBER (character);
- len = (SINGLE_BYTE_CHAR_P (XFASTINT (character))
- ? (*str = (unsigned char)(XFASTINT (character)), 1)
- : char_to_string (XFASTINT (character), str));
+ len = CHAR_STRING (XFASTINT (character), str);
return make_string_from_bytes (str, 1, len);
}
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;
{
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 (val), str);
else
{
- str[0] = (SINGLE_BYTE_CHAR_P (XINT (val))
+ str[0] = (ASCII_CHAR_P (XINT (val))
? XINT (val)
: multibyte_char_to_unibyte (XINT (val), Qnil));
len = 1;
return Qnil;
}
+DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0,
+ doc: /* Insert COUNT (second arg) copies of BYTE (first arg).
+Both arguments are required.
+BYTE is a number of the range 0..255.
+
+If BYTE is 128..255 and the current buffer is multibyte, the
+corresponding eight-bit character is inserted.
+
+Point, and before-insertion markers, are relocated as in the function `insert'.
+The optional third arg INHERIT, if non-nil, says to inherit text properties
+from adjoining text, if those properties are sticky. */)
+ (byte, count, inherit)
+ Lisp_Object byte, count, inherit;
+{
+ CHECK_NUMBER (byte);
+ if (XINT (byte) < 0 || XINT (byte) > 255)
+ args_out_of_range_3 (byte, make_number (0), make_number (255));
+ if (XINT (byte) >= 128
+ && ! NILP (current_buffer->enable_multibyte_characters))
+ XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte)));
+ return Finsert_char (byte, count, inherit);
+}
+
\f
/* Making strings from buffer contents. */
{
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
return Qnil;
}
-DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0,
- doc: /* From START to END, translate characters according to TABLE.
-TABLE is a string; the Nth character in it is the mapping
-for the character with code N.
+
+static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object));
+
+/* Helper function for Ftranslate_region_internal.
+
+ Check if a character sequence at POS (POS_BYTE) matches an element
+ of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
+ element is found, return it. Otherwise return Qnil. */
+
+static Lisp_Object
+check_translation (pos, pos_byte, end, val)
+ int pos, pos_byte, end;
+ Lisp_Object val;
+{
+ int buf_size = 16, buf_used = 0;
+ int *buf = alloca (sizeof (int) * buf_size);
+
+ for (; CONSP (val); val = XCDR (val))
+ {
+ Lisp_Object elt;
+ int len, i;
+
+ elt = XCAR (val);
+ if (! CONSP (elt))
+ continue;
+ elt = XCAR (elt);
+ if (! VECTORP (elt))
+ continue;
+ len = ASIZE (elt);
+ if (len <= end - pos)
+ {
+ for (i = 0; i < len; i++)
+ {
+ if (buf_used <= i)
+ {
+ unsigned char *p = BYTE_POS_ADDR (pos_byte);
+ int len;
+
+ if (buf_used == buf_size)
+ {
+ int *newbuf;
+
+ buf_size += 16;
+ newbuf = alloca (sizeof (int) * buf_size);
+ memcpy (newbuf, buf, sizeof (int) * buf_used);
+ buf = newbuf;
+ }
+ buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len);
+ pos_byte += len;
+ }
+ if (XINT (AREF (elt, i)) != buf[i])
+ break;
+ }
+ if (i == len)
+ return XCAR (val);
+ }
+ }
+ return Qnil;
+}
+
+
+DEFUN ("translate-region-internal", Ftranslate_region_internal,
+ Stranslate_region_internal, 3, 3, 0,
+ doc: /* Internal use only.
+From START to END, translate characters according to TABLE.
+TABLE is a string or a char-table; the Nth character in it is the
+mapping for the character with code N.
It returns the number of characters changed. */)
(start, end, table)
Lisp_Object start;
register int nc; /* New character. */
int cnt; /* Number of changes made. */
int size; /* Size of translate table. */
- int pos, pos_byte;
+ int pos, pos_byte, end_pos;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int string_multibyte;
+ Lisp_Object val;
validate_region (&start, &end);
- CHECK_STRING (table);
-
- if (multibyte != (SCHARS (table) < SBYTES (table)))
- table = (multibyte
- ? string_make_multibyte (table)
- : string_make_unibyte (table));
- string_multibyte = SCHARS (table) < SBYTES (table);
+ if (CHAR_TABLE_P (table))
+ {
+ if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table))
+ error ("Not a translation table");
+ size = MAX_CHAR;
+ tt = NULL;
+ }
+ else
+ {
+ CHECK_STRING (table);
- size = SCHARS (table);
- tt = SDATA (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);
- modify_region (current_buffer, pos, XINT (end));
+ end_pos = XINT (end);
+ modify_region (current_buffer, pos, end_pos);
cnt = 0;
- for (; pos < XINT (end); )
+ for (; pos < end_pos; )
{
register unsigned char *p = BYTE_POS_ADDR (pos_byte);
- unsigned char *str;
+ unsigned char *str, buf[MAX_MULTIBYTE_LENGTH];
int len, str_len;
int oc;
+ Lisp_Object val;
if (multibyte)
oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len);
oc = *p, len = 1;
if (oc < size)
{
- if (string_multibyte)
+ if (tt)
{
- str = tt + string_char_to_byte (table, oc);
- nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, str_len);
+ /* 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, MAX_MULTIBYTE_LENGTH,
+ str_len);
+ }
+ else
+ {
+ 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
{
- str = tt + oc;
- nc = tt[oc], str_len = 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 != oc && nc >= 0)
{
+ /* Simple one char to one char translation. */
if (len != str_len)
{
Lisp_Object string;
/* This is less efficient, because it moves the gap,
- but it should multibyte characters correctly. */
+ but it should handle multibyte characters correctly. */
string = make_multibyte_string (str, 1, str_len);
replace_range (pos, pos + 1, string, 1, 0, 1);
len = str_len;
}
++cnt;
}
+ else if (nc < 0)
+ {
+ Lisp_Object string;
+
+ if (CONSP (val))
+ {
+ val = check_translation (pos, pos_byte, end_pos, val);
+ if (NILP (val))
+ {
+ pos_byte += len;
+ pos++;
+ continue;
+ }
+ /* VAL is ([FROM-CHAR ...] . TO). */
+ len = ASIZE (XCAR (val));
+ val = XCDR (val);
+ }
+ else
+ len = 1;
+
+ if (VECTORP (val))
+ {
+ int i;
+
+ string = Fmake_string (make_number (ASIZE (val)),
+ AREF (val, 0));
+ for (i = 1; i < ASIZE (val); i++)
+ Faset (string, make_number (i), AREF (val, i));
+ }
+ else
+ {
+ string = Fmake_string (make_number (1), val);
+ }
+ replace_range (pos, pos + len, string, 1, 0, 1);
+ pos_byte += SBYTES (string);
+ pos += SCHARS (string);
+ cnt += SCHARS (string);
+ end_pos += SCHARS (string) - len;
+ continue;
+ }
}
pos_byte += len;
pos++;
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')
thissize = 30;
if (*format == 'c')
{
- if (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
- /* Note: No one can remember why we have to treat
+ if (! ASCII_CHAR_P (XINT (args[n]))
+ /* Note: No one can remeber why we have to treat
the character 0 as a multibyte character here.
But, until it causes a real problem, let's
don't change it. */
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
/* Do these in separate statements,
then compare the variables.
because of the way DOWNCASE uses temp variables. */
- i1 = DOWNCASE (XFASTINT (c1));
- i2 = DOWNCASE (XFASTINT (c2));
+ i1 = XFASTINT (c1);
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! ASCII_CHAR_P (i1))
+ {
+ MAKE_CHAR_MULTIBYTE (i1);
+ }
+ i2 = XFASTINT (c2);
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! ASCII_CHAR_P (i2))
+ {
+ MAKE_CHAR_MULTIBYTE (i2);
+ }
+ i1 = DOWNCASE (i1);
+ i2 = DOWNCASE (i2);
return (i1 == i2 ? Qt : Qnil);
}
\f
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 (&Sinsert_and_inherit);
defsubr (&Sinsert_and_inherit_before_markers);
defsubr (&Sinsert_char);
+ defsubr (&Sinsert_byte);
defsubr (&Suser_login_name);
defsubr (&Suser_real_login_name);
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);
defsubr (&Sinsert_buffer_substring);
defsubr (&Scompare_buffer_substrings);
defsubr (&Ssubst_char_in_region);
- defsubr (&Stranslate_region);
+ defsubr (&Stranslate_region_internal);
defsubr (&Sdelete_region);
defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);