/* Random utility Lisp functions.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
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., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <unistd.h>
#endif
#include <time.h>
-
-#ifndef MAC_OS
-/* On Mac OS, defining this conflicts with precompiled headers. */
+#include <setjmp.h>
/* Note on some machines this defines `vector' as a typedef,
so make sure we don't use that name in this file. */
#undef vector
#define vector *****
-#endif /* ! MAC_OSX */
-
#include "lisp.h"
#include "commands.h"
#include "character.h"
#ifdef HAVE_MENUS
#if defined (HAVE_X_WINDOWS)
#include "xterm.h"
-#elif defined (MAC_OS)
-#include "macterm.h"
-#endif
#endif
+#endif /* HAVE_MENUS */
#ifndef NULL
#define NULL ((POINTER_TYPE *)0)
doc: /* Return a pseudo-random number.
All integers representable in Lisp are equally likely.
On most systems, this is 29 bits' worth.
-With positive integer argument N, return random number in interval [0,N).
-With argument t, set the random number seed from the current time and pid. */)
- (n)
- Lisp_Object n;
+With positive integer LIMIT, return random number in interval [0,LIMIT).
+With argument t, set the random number seed from the current time and pid.
+Other values of LIMIT are ignored. */)
+ (limit)
+ Lisp_Object limit;
{
EMACS_INT val;
Lisp_Object lispy_val;
unsigned long denominator;
- if (EQ (n, Qt))
+ if (EQ (limit, Qt))
seed_random (getpid () + time (NULL));
- if (NATNUMP (n) && XFASTINT (n) != 0)
+ if (NATNUMP (limit) && XFASTINT (limit) != 0)
{
/* Try to take our random number from the higher bits of VAL,
not the lower, since (says Gentzel) the low bits of `random'
it's possible to get a quotient larger than n; discarding
these values eliminates the bias that would otherwise appear
when using a large n. */
- denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
+ denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit);
do
val = get_random () / denominator;
- while (val >= XFASTINT (n));
+ while (val >= XFASTINT (limit));
}
else
val = get_random ();
else
{
c1 = SREF (str1, i1++);
- c1 = unibyte_char_to_multibyte (c1);
+ MAKE_CHAR_MULTIBYTE (c1);
}
if (STRING_MULTIBYTE (str2))
else
{
c2 = SREF (str2, i2++);
- c2 = unibyte_char_to_multibyte (c2);
+ MAKE_CHAR_MULTIBYTE (c2);
}
if (c1 == c2)
}
result_len += len;
+ if (result_len < 0)
+ error ("String overflow");
}
if (! some_multibyte)
}
toindex_byte += thislen_byte;
toindex += thisleni;
- STRING_SET_CHARS (val, SCHARS (val));
}
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
if (some_multibyte
- && XINT (elt) >= 0200
+ && !ASCII_CHAR_P (XINT (elt))
&& XINT (elt) < 0400)
{
- c = unibyte_char_to_multibyte (XINT (elt));
+ c = BYTE8_TO_CHAR (XINT (elt));
XSETINT (elt, c);
}
}
return string_to_multibyte (string);
}
+DEFUN ("string-to-unibyte", Fstring_to_unibyte, Sstring_to_unibyte,
+ 1, 1, 0,
+ doc: /* Return a unibyte string with the same individual chars as STRING.
+If STRING is unibyte, the result is STRING itself.
+Otherwise it is a newly created string, with no text properties,
+where each `eight-bit' character is converted to the corresponding byte.
+If STRING contains a non-ASCII, non-`eight-bit' character,
+an error is signaled. */)
+ (string)
+ Lisp_Object string;
+{
+ CHECK_STRING (string);
+
+ if (STRING_MULTIBYTE (string))
+ {
+ EMACS_INT chars = SCHARS (string);
+ unsigned char *str = (unsigned char *) xmalloc (chars);
+ EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
+
+ if (converted < chars)
+ error ("Can't convert the %dth character to unibyte", converted);
+ string = make_unibyte_string (str, chars);
+ xfree (str);
+ }
+ return string;
+}
+
\f
DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
doc: /* Return a copy of ALIST.
}
DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
- doc: /* Return a substring of STRING, starting at index FROM and ending before TO.
-TO may be nil or omitted; then the substring runs to the end of STRING.
-FROM and TO start at 0. If either is negative, it counts from the end.
-
-This function allows vectors as well as strings. */)
+ doc: /* Return a new string whose contents are a substring of STRING.
+The returned string consists of the characters between index FROM
+\(inclusive) and index TO (exclusive) of STRING. FROM and TO are
+zero-indexed: 0 means the first character of STRING. Negative values
+are counted from the end of STRING. If TO is nil, the substring runs
+to the end of STRING.
+
+The STRING argument may also be a vector. In that case, the return
+value is a new vector that contains the elements between index FROM
+\(inclusive) and index TO (exclusive) of that vector argument. */)
(string, from, to)
Lisp_Object string;
register Lisp_Object from, to;
{
if (STRING_MULTIBYTE (seq))
{
- c = STRING_CHAR (SDATA (seq) + ibyte,
- SBYTES (seq) - ibyte);
+ c = STRING_CHAR (SDATA (seq) + ibyte);
cbytes = CHAR_BYTES (c);
}
else
{
if (STRING_MULTIBYTE (seq))
{
- c = STRING_CHAR (SDATA (seq) + ibyte,
- SBYTES (seq) - ibyte);
+ c = STRING_CHAR (SDATA (seq) + ibyte);
cbytes = CHAR_BYTES (c);
}
else
}
\f
-#if 0 /* Unsafe version. */
-DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
- doc: /* Extract a value from a property list.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
-corresponding to the given PROP, or nil if PROP is not
-one of the properties on the list. */)
- (plist, prop)
- Lisp_Object plist;
- Lisp_Object prop;
-{
- Lisp_Object tail;
-
- for (tail = plist;
- CONSP (tail) && CONSP (XCDR (tail));
- tail = XCDR (XCDR (tail)))
- {
- if (EQ (prop, XCAR (tail)))
- return XCAR (XCDR (tail));
-
- /* This function can be called asynchronously
- (setup_coding_system). Don't QUIT in that case. */
- if (!interrupt_input_blocked)
- QUIT;
- }
-
- CHECK_LIST_END (tail, prop);
-
- return Qnil;
-}
-#endif
-
/* This does not check for quits. That is safe since it must terminate. */
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
halftail = XCDR (halftail);
if (EQ (tail, halftail))
break;
+
+#if 0 /* Unsafe version. */
+ /* This function can be called asynchronously
+ (setup_coding_system). Don't QUIT in that case. */
+ if (!interrupt_input_blocked)
+ QUIT;
+#endif
}
return Qnil;
if (WINDOW_CONFIGURATIONP (o1))
return compare_window_configurations (o1, o2, 0);
- /* Aside from them, only true vectors, char-tables, and compiled
- functions are sensible to compare, so eliminate the others now. */
+ /* Aside from them, only true vectors, char-tables, compiled
+ functions, and fonts (font-spec, font-entity, font-ojbect)
+ are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
if (!(size & (PVEC_COMPILED
- | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE)))
+ | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
return 0;
return 1;
- case Lisp_Int:
- case Lisp_Symbol:
- case Lisp_Type_Limit:
+ default:
break;
}
xprompt = prompt;
GCPRO2 (prompt, xprompt);
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */
{
Lisp_Object v = Fmake_vector (make_number (7), Qnil);
- int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
+ const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
int i;
+ struct gcpro gcpro1;
+ GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 7; i++)
{
code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
+ UNGCPRO;
return v;
}
#endif /* DAY_1 */
#ifdef MON_1
else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */
{
- struct Lisp_Vector *p = allocate_vector (12);
- int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
- MON_8, MON_9, MON_10, MON_11, MON_12};
+ Lisp_Object v = Fmake_vector (make_number (12), Qnil);
+ const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
+ MON_8, MON_9, MON_10, MON_11, MON_12};
int i;
+ struct gcpro gcpro1;
+ GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
val = make_unibyte_string (str, strlen (str));
- p->contents[i] =
- code_convert_string_norecord (val, Vlocale_coding_system, 0);
+ Faset (v, make_number (i),
+ code_convert_string_norecord (val, Vlocale_coding_system, 0));
}
- XSETVECTOR (val, p);
- return val;
+ UNGCPRO;
+ return v;
}
#endif /* MON_1 */
/* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1,
while (IS_BASE64_IGNORABLE (c))
/* Table of characters coding the 64 values. */
-static char base64_value_to_char[64] =
+static const char base64_value_to_char[64] =
{
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */
'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */
};
/* Table of base64 values for first 128 characters. */
-static short base64_char_to_value[128] =
+static const short base64_char_to_value[128] =
{
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
/* Remove the entry matching KEY from hash table H, if there is one. */
-void
-hash_remove (h, key)
+static void
+hash_remove_from_table (h, key)
struct Lisp_Hash_Table *h;
Lisp_Object key;
{
Weak Hash Tables
************************************************************************/
+void
+init_weak_hash_tables ()
+{
+ weak_hash_tables = NULL;
+}
+
/* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove
entries from the table that don't survive the current GC.
REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
switch (XTYPE (obj))
{
- case Lisp_Int:
+ case_Lisp_Int:
hash = XUINT (obj);
break;
case Lisp_Float:
{
- unsigned char *p = (unsigned char *) &XFLOAT_DATA (obj);
- unsigned char *e = p + sizeof XFLOAT_DATA (obj);
+ double val = XFLOAT_DATA (obj);
+ unsigned char *p = (unsigned char *) &val;
+ unsigned char *e = p + sizeof val;
for (hash = 0; p < e; ++p)
hash = SXHASH_COMBINE (hash, *p);
break;
Lisp_Object key, table;
{
struct Lisp_Hash_Table *h = check_hash_table (table);
- hash_remove (h, key);
+ hash_remove_from_table (h, key);
return Qnil;
}
syms_of_fns ()
{
/* Hash table stuff. */
- Qhash_table_p = intern ("hash-table-p");
+ Qhash_table_p = intern_c_string ("hash-table-p");
staticpro (&Qhash_table_p);
- Qeq = intern ("eq");
+ Qeq = intern_c_string ("eq");
staticpro (&Qeq);
- Qeql = intern ("eql");
+ Qeql = intern_c_string ("eql");
staticpro (&Qeql);
- Qequal = intern ("equal");
+ Qequal = intern_c_string ("equal");
staticpro (&Qequal);
- QCtest = intern (":test");
+ QCtest = intern_c_string (":test");
staticpro (&QCtest);
- QCsize = intern (":size");
+ QCsize = intern_c_string (":size");
staticpro (&QCsize);
- QCrehash_size = intern (":rehash-size");
+ QCrehash_size = intern_c_string (":rehash-size");
staticpro (&QCrehash_size);
- QCrehash_threshold = intern (":rehash-threshold");
+ QCrehash_threshold = intern_c_string (":rehash-threshold");
staticpro (&QCrehash_threshold);
- QCweakness = intern (":weakness");
+ QCweakness = intern_c_string (":weakness");
staticpro (&QCweakness);
- Qkey = intern ("key");
+ Qkey = intern_c_string ("key");
staticpro (&Qkey);
- Qvalue = intern ("value");
+ Qvalue = intern_c_string ("value");
staticpro (&Qvalue);
- Qhash_table_test = intern ("hash-table-test");
+ Qhash_table_test = intern_c_string ("hash-table-test");
staticpro (&Qhash_table_test);
- Qkey_or_value = intern ("key-or-value");
+ Qkey_or_value = intern_c_string ("key-or-value");
staticpro (&Qkey_or_value);
- Qkey_and_value = intern ("key-and-value");
+ Qkey_and_value = intern_c_string ("key-and-value");
staticpro (&Qkey_and_value);
defsubr (&Ssxhash);
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
- Qstring_lessp = intern ("string-lessp");
+ Qstring_lessp = intern_c_string ("string-lessp");
staticpro (&Qstring_lessp);
- Qprovide = intern ("provide");
+ Qprovide = intern_c_string ("provide");
staticpro (&Qprovide);
- Qrequire = intern ("require");
+ Qrequire = intern_c_string ("require");
staticpro (&Qrequire);
- Qyes_or_no_p_history = intern ("yes-or-no-p-history");
+ Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
staticpro (&Qyes_or_no_p_history);
- Qcursor_in_echo_area = intern ("cursor-in-echo-area");
+ Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
staticpro (&Qcursor_in_echo_area);
- Qwidget_type = intern ("widget-type");
+ Qwidget_type = intern_c_string ("widget-type");
staticpro (&Qwidget_type);
staticpro (&string_char_byte_cache_string);
DEFVAR_LISP ("features", &Vfeatures,
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
- Vfeatures = Fcons (intern ("emacs"), Qnil);
- Qsubfeatures = intern ("subfeatures");
+ Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
+ Qsubfeatures = intern_c_string ("subfeatures");
staticpro (&Qsubfeatures);
#ifdef HAVE_LANGINFO_CODESET
- Qcodeset = intern ("codeset");
+ Qcodeset = intern_c_string ("codeset");
staticpro (&Qcodeset);
- Qdays = intern ("days");
+ Qdays = intern_c_string ("days");
staticpro (&Qdays);
- Qmonths = intern ("months");
+ Qmonths = intern_c_string ("months");
staticpro (&Qmonths);
- Qpaper = intern ("paper");
+ Qpaper = intern_c_string ("paper");
staticpro (&Qpaper);
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
-invoked by mouse clicks and mouse menu items. */);
+invoked by mouse clicks and mouse menu items.
+
+On some platforms, file selection dialogs are also enabled if this is
+non-nil. */);
use_dialog_box = 1;
DEFVAR_BOOL ("use-file-dialog", &use_file_dialog,
doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
This applies to commands from menus and tool bar buttons even when
-they are initiated from the keyboard. The value of `use-dialog-box'
-takes precedence over this variable, so a file dialog is only used if
-both `use-dialog-box' and this variable are non-nil. */);
+they are initiated from the keyboard. If `use-dialog-box' is nil,
+that disables the use of a file dialog, regardless of the value of
+this variable. */);
use_file_dialog = 1;
defsubr (&Sidentity);
defsubr (&Sstring_as_multibyte);
defsubr (&Sstring_as_unibyte);
defsubr (&Sstring_to_multibyte);
+ defsubr (&Sstring_to_unibyte);
defsubr (&Scopy_alist);
defsubr (&Ssubstring);
defsubr (&Ssubstring_no_properties);
void
init_fns ()
{
- weak_hash_tables = NULL;
}
/* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31