/* 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, 2010
+ 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 "charset.h"
+#include "character.h"
#include "coding.h"
#include "buffer.h"
#include "keyboard.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)
extern Lisp_Object Qinput_method_function;
-static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int));
+static int internal_equal (Lisp_Object , Lisp_Object, int, int);
-extern long get_random ();
-extern void seed_random P_ ((long));
+extern long get_random (void);
+extern void seed_random (long);
#ifndef HAVE_UNISTD_H
extern long time ();
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 ();
XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
XSETFASTINT (val, ASIZE (sequence));
- else if (SUB_CHAR_TABLE_P (sequence))
- XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS);
else if (CHAR_TABLE_P (sequence))
XSETFASTINT (val, MAX_CHAR);
else if (BOOL_VECTOR_P (sequence))
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
doc: /* Return the number of bytes in STRING.
-If STRING is a multibyte string, this is greater than the length of STRING. */)
+If STRING is multibyte, this may be greater than the length of STRING. */)
(string)
Lisp_Object string;
{
if (SCHARS (s1) != SCHARS (s2)
|| SBYTES (s1) != SBYTES (s2)
- || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
+ || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
return Qnil;
return Qt;
}
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)
/* "gcc -O3" enables automatic function inlining, which optimizes out
the arguments for the invocations of this function, whereas it
expects these values on the stack. */
-static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)) __attribute__((noinline));
+static Lisp_Object concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special) __attribute__((noinline));
#else /* !__GNUC__ */
-static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special));
+static Lisp_Object concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special);
#endif
/* ARGSUSED */
Lisp_Object
-concat2 (s1, s2)
- Lisp_Object s1, s2;
+concat2 (Lisp_Object s1, Lisp_Object s2)
{
-#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
args[0] = s1;
args[1] = s2;
return concat (2, args, Lisp_String, 0);
-#else
- return concat (2, &s1, Lisp_String, 0);
-#endif /* NO_ARG_ARRAY */
}
/* ARGSUSED */
Lisp_Object
-concat3 (s1, s2, s3)
- Lisp_Object s1, s2, s3;
+concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
{
-#ifdef NO_ARG_ARRAY
Lisp_Object args[3];
args[0] = s1;
args[1] = s2;
args[2] = s3;
return concat (3, args, Lisp_String, 0);
-#else
- return concat (3, &s1, Lisp_String, 0);
-#endif /* NO_ARG_ARRAY */
}
DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
return concat (nargs, args, Lisp_Vectorlike, 0);
}
-/* Return a copy of a sub char table ARG. The elements except for a
- nested sub char table are not copied. */
-static Lisp_Object
-copy_sub_char_table (arg)
- Lisp_Object arg;
-{
- Lisp_Object copy = make_sub_char_table (Qnil);
- int i;
-
- XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt;
- /* Copy all the contents. */
- bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
- SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
- /* Recursively copy any sub char-tables in the ordinary slots. */
- for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
- XCHAR_TABLE (copy)->contents[i]
- = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
-
- return copy;
-}
-
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
doc: /* Return a copy of a list, vector, string or char-table.
if (CHAR_TABLE_P (arg))
{
- int i;
- Lisp_Object copy;
-
- copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
- /* Copy all the slots, including the extra ones. */
- bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
- ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
- * sizeof (Lisp_Object)));
-
- /* Recursively copy any sub char tables in the ordinary slots
- for multibyte characters. */
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
- i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
- XCHAR_TABLE (copy)->contents[i]
- = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
-
- return copy;
+ return copy_char_table (arg);
}
if (BOOL_VECTOR_P (arg))
/ BOOL_VECTOR_BITS_PER_CHAR);
val = Fmake_bool_vector (Flength (arg), Qnil);
- bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
- size_in_chars);
+ memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
+ size_in_chars);
return val;
}
};
static Lisp_Object
-concat (nargs, args, target_type, last_special)
- int nargs;
- Lisp_Object *args;
- enum Lisp_Type target_type;
- int last_special;
+concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)
{
Lisp_Object val;
register Lisp_Object tail;
So, we record strings that have text properties to be copied
here, and copy the text properties after the concatination. */
struct textprop_rec *textprops = NULL;
- /* Number of elments in textprops. */
+ /* Number of elements in textprops. */
int num_textprops = 0;
USE_SAFE_ALLOCA;
for (i = 0; i < len; i++)
{
ch = AREF (this, i);
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
- if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
+ if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
some_multibyte = 1;
}
else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
for (; CONSP (this); this = XCDR (this))
{
ch = XCAR (this);
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
- if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
+ if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
some_multibyte = 1;
}
else if (STRINGP (this))
}
result_len += len;
+ if (result_len < 0)
+ error ("String overflow");
}
if (! some_multibyte)
{
int thislen_byte = SBYTES (this);
- bcopy (SDATA (this), SDATA (val) + toindex_byte,
- SBYTES (this));
+ memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
{
textprops[num_textprops].argnum = argnum;
}
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) >= 0240
- || (XINT (elt) >= 0200
- && ! NILP (Vnonascii_translation_table)))
+ && !ASCII_CHAR_P (XINT (elt))
&& XINT (elt) < 0400)
{
- c = unibyte_char_to_multibyte (XINT (elt));
+ c = BYTE8_TO_CHAR (XINT (elt));
XSETINT (elt, c);
}
}
thisindex++;
}
else
- elt = AREF (this, thisindex++);
+ {
+ elt = AREF (this, thisindex);
+ thisindex++;
+ }
/* Store this element into the result. */
if (toindex < 0)
tail = XCDR (tail);
}
else if (VECTORP (val))
- AREF (val, toindex++) = elt;
+ {
+ ASET (val, toindex, elt);
+ toindex++;
+ }
else
{
CHECK_NUMBER (elt);
- if (SINGLE_BYTE_CHAR_P (XINT (elt)))
- {
- if (some_multibyte)
- toindex_byte
- += CHAR_STRING (XINT (elt),
- SDATA (val) + toindex_byte);
- else
- SSET (val, toindex_byte++, XINT (elt));
- toindex++;
- }
+ if (some_multibyte)
+ toindex_byte += CHAR_STRING (XINT (elt),
+ SDATA (val) + toindex_byte);
else
- /* If we have any multibyte characters,
- we already decided to make a multibyte string. */
- {
- int c = XINT (elt);
- /* P exists as a variable
- to avoid a bug on the Masscomp C compiler. */
- unsigned char *p = SDATA (val) + toindex_byte;
-
- toindex_byte += CHAR_STRING (c, p);
- toindex++;
- }
+ SSET (val, toindex_byte++, XINT (elt));
+ toindex++;
}
}
}
}
\f
static Lisp_Object string_char_byte_cache_string;
-static int string_char_byte_cache_charpos;
-static int string_char_byte_cache_bytepos;
+static EMACS_INT string_char_byte_cache_charpos;
+static EMACS_INT string_char_byte_cache_bytepos;
void
-clear_string_char_byte_cache ()
+clear_string_char_byte_cache (void)
{
string_char_byte_cache_string = Qnil;
}
-/* Return the character index corresponding to CHAR_INDEX in STRING. */
+/* Return the byte index corresponding to CHAR_INDEX in STRING. */
-int
-string_char_to_byte (string, char_index)
- Lisp_Object string;
- int char_index;
+EMACS_INT
+string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
{
- int i, i_byte;
- int best_below, best_below_byte;
- int best_above, best_above_byte;
+ EMACS_INT i_byte;
+ EMACS_INT best_below, best_below_byte;
+ EMACS_INT best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
if (char_index - best_below < best_above - char_index)
{
+ unsigned char *p = SDATA (string) + best_below_byte;
+
while (best_below < char_index)
{
- int c;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
- best_below, best_below_byte);
+ p += BYTES_BY_CHAR_HEAD (*p);
+ best_below++;
}
- i = best_below;
- i_byte = best_below_byte;
+ i_byte = p - SDATA (string);
}
else
{
+ unsigned char *p = SDATA (string) + best_above_byte;
+
while (best_above > char_index)
{
- unsigned char *pend = SDATA (string) + best_above_byte;
- unsigned char *pbeg = pend - best_above_byte;
- unsigned char *p = pend - 1;
- int bytes;
-
- while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
- PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
- if (bytes == pend - p)
- best_above_byte -= bytes;
- else if (bytes > pend - p)
- best_above_byte -= (pend - p);
- else
- best_above_byte--;
+ p--;
+ while (!CHAR_HEAD_P (*p)) p--;
best_above--;
}
- i = best_above;
- i_byte = best_above_byte;
+ i_byte = p - SDATA (string);
}
string_char_byte_cache_bytepos = i_byte;
- string_char_byte_cache_charpos = i;
+ string_char_byte_cache_charpos = char_index;
string_char_byte_cache_string = string;
return i_byte;
\f
/* Return the character index corresponding to BYTE_INDEX in STRING. */
-int
-string_byte_to_char (string, byte_index)
- Lisp_Object string;
- int byte_index;
+EMACS_INT
+string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
{
- int i, i_byte;
- int best_below, best_below_byte;
- int best_above, best_above_byte;
+ EMACS_INT i, i_byte;
+ EMACS_INT best_below, best_below_byte;
+ EMACS_INT best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
if (byte_index - best_below_byte < best_above_byte - byte_index)
{
- while (best_below_byte < byte_index)
+ unsigned char *p = SDATA (string) + best_below_byte;
+ unsigned char *pend = SDATA (string) + byte_index;
+
+ while (p < pend)
{
- int c;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
- best_below, best_below_byte);
+ p += BYTES_BY_CHAR_HEAD (*p);
+ best_below++;
}
i = best_below;
- i_byte = best_below_byte;
+ i_byte = p - SDATA (string);
}
else
{
- while (best_above_byte > byte_index)
+ unsigned char *p = SDATA (string) + best_above_byte;
+ unsigned char *pbeg = SDATA (string) + byte_index;
+
+ while (p > pbeg)
{
- unsigned char *pend = SDATA (string) + best_above_byte;
- unsigned char *pbeg = pend - best_above_byte;
- unsigned char *p = pend - 1;
- int bytes;
-
- while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
- PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
- if (bytes == pend - p)
- best_above_byte -= bytes;
- else if (bytes > pend - p)
- best_above_byte -= (pend - p);
- else
- best_above_byte--;
+ p--;
+ while (!CHAR_HEAD_P (*p)) p--;
best_above--;
}
i = best_above;
- i_byte = best_above_byte;
+ i_byte = p - SDATA (string);
}
string_char_byte_cache_bytepos = i_byte;
return i;
}
\f
-/* Convert STRING to a multibyte string.
- Single-byte characters 0240 through 0377 are converted
- by adding nonascii_insert_offset to each. */
+/* Convert STRING to a multibyte string. */
Lisp_Object
-string_make_multibyte (string)
- Lisp_Object string;
+string_make_multibyte (Lisp_Object string)
{
unsigned char *buf;
- int nbytes;
+ EMACS_INT nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
}
-/* Convert STRING to a multibyte string without changing each
- character codes. Thus, characters 0200 trough 0237 are converted
- to eight-bit-control characters, and characters 0240 through 0377
- are converted eight-bit-graphic characters. */
+/* Convert STRING (if unibyte) to a multibyte string without changing
+ the number of characters. Characters 0200 trough 0237 are
+ converted to eight-bit characters. */
Lisp_Object
-string_to_multibyte (string)
- Lisp_Object string;
+string_to_multibyte (Lisp_Object string)
{
unsigned char *buf;
- int nbytes;
+ EMACS_INT nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
return string;
nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
- /* If all the chars are ASCII or eight-bit-graphic, they won't need
- any more bytes once converted. */
+ /* If all the chars are ASCII, they won't need any more bytes once
+ converted. */
if (nbytes == SBYTES (string))
return make_multibyte_string (SDATA (string), nbytes, nbytes);
SAFE_ALLOCA (buf, unsigned char *, nbytes);
- bcopy (SDATA (string), buf, SBYTES (string));
+ memcpy (buf, SDATA (string), SBYTES (string));
str_to_multibyte (buf, nbytes, SBYTES (string));
ret = make_multibyte_string (buf, SCHARS (string), nbytes);
/* Convert STRING to a single-byte string. */
Lisp_Object
-string_make_unibyte (string)
- Lisp_Object string;
+string_make_unibyte (Lisp_Object string)
{
int nchars;
unsigned char *buf;
If STRING is unibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
If STRING is multibyte and contains a character of charset
-`eight-bit-control' or `eight-bit-graphic', it is converted to the
-corresponding single byte. */)
+`eight-bit', it is converted to the corresponding single byte. */)
(string)
Lisp_Object string;
{
int bytes = SBYTES (string);
unsigned char *str = (unsigned char *) xmalloc (bytes);
- bcopy (SDATA (string), str, bytes);
+ memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
string = make_unibyte_string (str, bytes);
xfree (str);
doc: /* Return a multibyte string with the same individual bytes as STRING.
If STRING is multibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
+
If STRING is unibyte and contains an individual 8-bit byte (i.e. not
-part of a multibyte form), it is converted to the corresponding
-multibyte character of charset `eight-bit-control' or `eight-bit-graphic'.
+part of a correct utf-8 sequence), it is converted to the corresponding
+multibyte character of charset `eight-bit'.
+See also `string-to-multibyte'.
+
Beware, this often doesn't really do what you think it does.
-It is similar to (decode-coding-string STRING 'emacs-mule-unix).
+It is similar to (decode-coding-string STRING 'utf-8-emacs).
If you're not sure, whether to use `string-as-multibyte' or
-`string-to-multibyte', use `string-to-multibyte'. Beware:
- (aref (string-as-multibyte "\\201") 0) -> 129 (aka ?\\201)
- (aref (string-as-multibyte "\\300") 0) -> 192 (aka ?\\300)
- (aref (string-as-multibyte "\\300\\201") 0) -> 192 (aka ?\\300)
- (aref (string-as-multibyte "\\300\\201") 1) -> 129 (aka ?\\201)
-but
- (aref (string-as-multibyte "\\201\\300") 0) -> 2240
- (aref (string-as-multibyte "\\201\\300") 1) -> <error> */)
+`string-to-multibyte', use `string-to-multibyte'. */)
(string)
Lisp_Object string;
{
SBYTES (string),
&nchars, &nbytes);
new_string = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (SDATA (string), SDATA (new_string),
- SBYTES (string));
+ memcpy (SDATA (new_string), SDATA (string), SBYTES (string));
if (nbytes != SBYTES (string))
str_as_multibyte (SDATA (new_string), nbytes,
SBYTES (string), NULL);
doc: /* Return a multibyte string with the same individual chars as STRING.
If STRING is multibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
-Characters 0200 through 0237 are converted to eight-bit-control
-characters of the same character code. Characters 0240 through 0377
-are converted to eight-bit-graphic characters of the same character
-codes.
-This is similar to (decode-coding-string STRING 'binary) */)
+
+If STRING is unibyte and contains an 8-bit byte, it is converted to
+the corresponding multibyte character of charset `eight-bit'.
+
+This differs from `string-as-multibyte' by converting each byte of a correct
+utf-8 sequence to an eight-bit character, not just bytes that don't form a
+correct sequence. */)
(string)
Lisp_Object string;
{
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;
both in characters and in bytes. */
Lisp_Object
-substring_both (string, from, from_byte, to, to_byte)
- Lisp_Object string;
- int from, from_byte, to, to_byte;
+substring_both (Lisp_Object string, int from, int from_byte, int to, int to_byte)
{
Lisp_Object res;
int size;
Use only on lists known never to be circular. */
Lisp_Object
-assq_no_quit (key, list)
- Lisp_Object key, list;
+assq_no_quit (Lisp_Object key, Lisp_Object list)
{
while (CONSP (list)
&& (!CONSP (XCAR (list))
return CAR (list);
}
+/* Like Fassoc but never report an error and do not allow quits.
+ Use only on lists known never to be circular. */
+
+Lisp_Object
+assoc_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ while (CONSP (list)
+ && (!CONSP (XCAR (list))
+ || (!EQ (XCAR (XCAR (list)), key)
+ && NILP (Fequal (XCAR (XCAR (list)), key)))))
+ list = XCDR (list);
+
+ return CONSP (list) ? XCAR (list) : Qnil;
+}
+
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
The value is actually the first element of LIST whose cdr is KEY. */)
{
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
return new;
}
\f
-Lisp_Object merge ();
+Lisp_Object merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred);
DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
doc: /* Sort LIST, stably, comparing elements using PREDICATE.
}
Lisp_Object
-merge (org_l1, org_l2, pred)
- Lisp_Object org_l1, org_l2;
- Lisp_Object pred;
+merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
{
Lisp_Object value;
register Lisp_Object tail;
}
\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;
PROPS, if non-nil, means compare string text properties too. */
static int
-internal_equal (o1, o2, depth, props)
- register Lisp_Object o1, o2;
- int depth, props;
+internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props)
{
if (depth > 200)
error ("Stack overflow in equal");
if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
return 0;
- if (bcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
- size_in_chars))
+ if (memcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
+ size_in_chars))
return 0;
return 1;
}
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)))
+ if (!(size & (PVEC_COMPILED
+ | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
return 0;
if (SBYTES (o1) != SBYTES (o2))
return 0;
- if (bcmp (SDATA (o1), SDATA (o2),
- SBYTES (o1)))
+ if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)))
return 0;
if (props && !compare_string_intervals (o1, o2))
return 0;
return 1;
- case Lisp_Int:
- case Lisp_Symbol:
- case Lisp_Type_Limit:
+ default:
break;
}
return 0;
}
\f
-extern Lisp_Object Fmake_char_internal ();
DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
doc: /* Store each element of ARRAY with ITEM.
}
else if (CHAR_TABLE_P (array))
{
- register Lisp_Object *p = XCHAR_TABLE (array)->contents;
- size = CHAR_TABLE_ORDINARY_SLOTS;
- for (index = 0; index < size; index++)
- p[index] = item;
- XCHAR_TABLE (array)->defalt = Qnil;
+ int i;
+
+ for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
+ XCHAR_TABLE (array)->contents[i] = item;
+ XCHAR_TABLE (array)->defalt = item;
}
else if (STRINGP (array))
{
if (size != size_byte)
while (p1 < endp)
{
- int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1);
+ int this_len = BYTES_BY_CHAR_HEAD (*p1);
if (len != this_len)
error ("Attempt to change byte length of a string");
p1 += this_len;
int len;
CHECK_STRING (string);
len = SBYTES (string);
- bzero (SDATA (string), len);
+ memset (SDATA (string), 0, len);
STRING_SET_CHARS (string, len);
STRING_SET_UNIBYTE (string);
return Qnil;
}
\f
-DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
- 1, 1, 0,
- doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
- (char_table)
- Lisp_Object char_table;
-{
- CHECK_CHAR_TABLE (char_table);
-
- return XCHAR_TABLE (char_table)->purpose;
-}
-
-DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
- 1, 1, 0,
- doc: /* Return the parent char-table of CHAR-TABLE.
-The value is either nil or another char-table.
-If CHAR-TABLE holds nil for a given character,
-then the actual applicable value is inherited from the parent char-table
-\(or from its parents, if necessary). */)
- (char_table)
- Lisp_Object char_table;
-{
- CHECK_CHAR_TABLE (char_table);
-
- return XCHAR_TABLE (char_table)->parent;
-}
-
-DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
- 2, 2, 0,
- doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
-Return PARENT. PARENT must be either nil or another char-table. */)
- (char_table, parent)
- Lisp_Object char_table, parent;
-{
- Lisp_Object temp;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (!NILP (parent))
- {
- CHECK_CHAR_TABLE (parent);
-
- for (temp = parent; CHAR_TABLE_P (temp);
- temp = XCHAR_TABLE (temp)->parent)
- if (EQ (temp, char_table))
- error ("Attempt to make a chartable be its own parent");
- }
-
- XCHAR_TABLE (char_table)->parent = parent;
-
- return parent;
-}
-
-DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
- 2, 2, 0,
- doc: /* Return the value of CHAR-TABLE's extra-slot number N. */)
- (char_table, n)
- Lisp_Object char_table, n;
-{
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (n);
- if (XINT (n) < 0
- || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
- args_out_of_range (char_table, n);
-
- return XCHAR_TABLE (char_table)->extras[XINT (n)];
-}
-
-DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
- Sset_char_table_extra_slot,
- 3, 3, 0,
- doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
- (char_table, n, value)
- Lisp_Object char_table, n, value;
-{
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (n);
- if (XINT (n) < 0
- || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
- args_out_of_range (char_table, n);
-
- return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
-}
-\f
-static Lisp_Object
-char_table_range (table, from, to, defalt)
- Lisp_Object table;
- int from, to;
- Lisp_Object defalt;
-{
- Lisp_Object val;
-
- if (! NILP (XCHAR_TABLE (table)->defalt))
- defalt = XCHAR_TABLE (table)->defalt;
- val = XCHAR_TABLE (table)->contents[from];
- if (SUB_CHAR_TABLE_P (val))
- val = char_table_range (val, 32, 127, defalt);
- else if (NILP (val))
- val = defalt;
- for (from++; from <= to; from++)
- {
- Lisp_Object this_val;
-
- this_val = XCHAR_TABLE (table)->contents[from];
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = char_table_range (this_val, 32, 127, defalt);
- else if (NILP (this_val))
- this_val = defalt;
- if (! EQ (val, this_val))
- error ("Characters in the range have inconsistent values");
- }
- return val;
-}
-
-
-DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
- 2, 2, 0,
- doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
-RANGE should be nil (for the default value),
-a vector which identifies a character set or a row of a character set,
-a character set name, or a character code.
-If the characters in the specified range have different values,
-an error is signaled.
-
-Note that this function doesn't check the parent of CHAR-TABLE. */)
- (char_table, range)
- Lisp_Object char_table, range;
-{
- int charset_id, c1 = 0, c2 = 0;
- int size;
- Lisp_Object ch, val, current_default;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (EQ (range, Qnil))
- return XCHAR_TABLE (char_table)->defalt;
- if (INTEGERP (range))
- {
- int c = XINT (range);
- if (! CHAR_VALID_P (c, 0))
- error ("Invalid character code: %d", c);
- ch = range;
- SPLIT_CHAR (c, charset_id, c1, c2);
- }
- else if (SYMBOLP (range))
- {
- Lisp_Object charset_info;
-
- charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info);
- charset_id = XINT (AREF (charset_info, 0));
- ch = Fmake_char_internal (make_number (charset_id),
- make_number (0), make_number (0));
- }
- else if (VECTORP (range))
- {
- size = ASIZE (range);
- if (size == 0)
- args_out_of_range (range, make_number (0));
- CHECK_NUMBER (AREF (range, 0));
- charset_id = XINT (AREF (range, 0));
- if (size > 1)
- {
- CHECK_NUMBER (AREF (range, 1));
- c1 = XINT (AREF (range, 1));
- if (size > 2)
- {
- CHECK_NUMBER (AREF (range, 2));
- c2 = XINT (AREF (range, 2));
- }
- }
-
- /* This checks if charset_id, c0, and c1 are all valid or not. */
- ch = Fmake_char_internal (make_number (charset_id),
- make_number (c1), make_number (c2));
- }
- else
- error ("Invalid RANGE argument to `char-table-range'");
-
- if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0))
- {
- /* Fully specified character. */
- Lisp_Object parent = XCHAR_TABLE (char_table)->parent;
-
- XCHAR_TABLE (char_table)->parent = Qnil;
- val = Faref (char_table, ch);
- XCHAR_TABLE (char_table)->parent = parent;
- return val;
- }
-
- current_default = XCHAR_TABLE (char_table)->defalt;
- if (charset_id == CHARSET_ASCII
- || charset_id == CHARSET_8_BIT_CONTROL
- || charset_id == CHARSET_8_BIT_GRAPHIC)
- {
- int from, to, defalt;
-
- if (charset_id == CHARSET_ASCII)
- from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII;
- else if (charset_id == CHARSET_8_BIT_CONTROL)
- from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL;
- else
- from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC;
- if (! NILP (XCHAR_TABLE (char_table)->contents[defalt]))
- current_default = XCHAR_TABLE (char_table)->contents[defalt];
- return char_table_range (char_table, from, to, current_default);
- }
-
- val = XCHAR_TABLE (char_table)->contents[128 + charset_id];
- if (! SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? current_default : val);
- if (! NILP (XCHAR_TABLE (val)->defalt))
- current_default = XCHAR_TABLE (val)->defalt;
- if (c1 == 0)
- return char_table_range (val, 32, 127, current_default);
- val = XCHAR_TABLE (val)->contents[c1];
- if (! SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? current_default : val);
- if (! NILP (XCHAR_TABLE (val)->defalt))
- current_default = XCHAR_TABLE (val)->defalt;
- return char_table_range (val, 32, 127, current_default);
-}
-
-DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
- 3, 3, 0,
- doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
-RANGE should be t (for all characters), nil (for the default value),
-a character set, a vector which identifies a character set, a row of a
-character set, or a character code. Return VALUE. */)
- (char_table, range, value)
- Lisp_Object char_table, range, value;
-{
- int i;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (EQ (range, Qt))
- for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- {
- /* Don't set these special slots used for default values of
- ascii, eight-bit-control, and eight-bit-graphic. */
- if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII
- && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
- && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC)
- XCHAR_TABLE (char_table)->contents[i] = value;
- }
- else if (EQ (range, Qnil))
- XCHAR_TABLE (char_table)->defalt = value;
- else if (SYMBOLP (range))
- {
- Lisp_Object charset_info;
- int charset_id;
-
- charset_info = Fget (range, Qcharset);
- if (! VECTORP (charset_info)
- || ! NATNUMP (AREF (charset_info, 0))
- || (charset_id = XINT (AREF (charset_info, 0)),
- ! CHARSET_DEFINED_P (charset_id)))
- error ("Invalid charset: %s", SDATA (SYMBOL_NAME (range)));
-
- if (charset_id == CHARSET_ASCII)
- for (i = 0; i < 128; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else if (charset_id == CHARSET_8_BIT_CONTROL)
- for (i = 128; i < 160; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else if (charset_id == CHARSET_8_BIT_GRAPHIC)
- for (i = 160; i < 256; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else
- XCHAR_TABLE (char_table)->contents[charset_id + 128] = value;
- }
- else if (INTEGERP (range))
- Faset (char_table, range, value);
- else if (VECTORP (range))
- {
- int size = ASIZE (range);
- Lisp_Object *val = XVECTOR (range)->contents;
- Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
- size <= 1 ? Qnil : val[1],
- size <= 2 ? Qnil : val[2]);
- Faset (char_table, ch, value);
- }
- else
- error ("Invalid RANGE argument to `set-char-table-range'");
-
- return value;
-}
-
-DEFUN ("set-char-table-default", Fset_char_table_default,
- Sset_char_table_default, 3, 3, 0,
- doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE.
-The generic character specifies the group of characters.
-If CH is a normal character, set the default value for a group of
-characters to which CH belongs.
-See also the documentation of `make-char'. */)
- (char_table, ch, value)
- Lisp_Object char_table, ch, value;
-{
- int c, charset, code1, code2;
- Lisp_Object temp;
-
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (ch);
-
- c = XINT (ch);
- SPLIT_CHAR (c, charset, code1, code2);
-
- /* Since we may want to set the default value for a character set
- not yet defined, we check only if the character set is in the
- valid range or not, instead of it is already defined or not. */
- if (! CHARSET_VALID_P (charset))
- invalid_character (c);
-
- if (SINGLE_BYTE_CHAR_P (c))
- {
- /* We use special slots for the default values of single byte
- characters. */
- int default_slot
- = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
- : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
- : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
-
- return (XCHAR_TABLE (char_table)->contents[default_slot] = value);
- }
-
- /* Even if C is not a generic char, we had better behave as if a
- generic char is specified. */
- if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1)
- code1 = 0;
- temp = XCHAR_TABLE (char_table)->contents[charset + 128];
- if (! SUB_CHAR_TABLE_P (temp))
- {
- temp = make_sub_char_table (temp);
- XCHAR_TABLE (char_table)->contents[charset + 128] = temp;
- }
- if (!code1)
- {
- XCHAR_TABLE (temp)->defalt = value;
- return value;
- }
- char_table = temp;
- temp = XCHAR_TABLE (char_table)->contents[code1];
- if (SUB_CHAR_TABLE_P (temp))
- XCHAR_TABLE (temp)->defalt = value;
- else
- XCHAR_TABLE (char_table)->contents[code1] = value;
- return value;
-}
-
-/* Look up the element in TABLE at index CH,
- and return it as an integer.
- If the element is nil, return CH itself.
- (Actually we do that for any non-integer.) */
-
-int
-char_table_translate (table, ch)
- Lisp_Object table;
- int ch;
-{
- Lisp_Object value;
- value = Faref (table, make_number (ch));
- if (! INTEGERP (value))
- return ch;
- return XINT (value);
-}
-
-static void
-optimize_sub_char_table (table, chars)
- Lisp_Object *table;
- int chars;
-{
- Lisp_Object elt;
- int from, to;
-
- if (chars == 94)
- from = 33, to = 127;
- else
- from = 32, to = 128;
-
- if (!SUB_CHAR_TABLE_P (*table)
- || ! NILP (XCHAR_TABLE (*table)->defalt))
- return;
- elt = XCHAR_TABLE (*table)->contents[from++];
- for (; from < to; from++)
- if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from])))
- return;
- *table = elt;
-}
-
-DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
- 1, 1, 0, doc: /* Optimize char table TABLE. */)
- (table)
- Lisp_Object table;
-{
- Lisp_Object elt;
- int dim, chars;
- int i, j;
-
- CHECK_CHAR_TABLE (table);
-
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- {
- elt = XCHAR_TABLE (table)->contents[i];
- if (!SUB_CHAR_TABLE_P (elt))
- continue;
- dim = CHARSET_DIMENSION (i - 128);
- chars = CHARSET_CHARS (i - 128);
- if (dim == 2)
- for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
- optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, chars);
- optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, chars);
- }
- return Qnil;
-}
-
-\f
-/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
- character or group of characters that share a value.
- DEPTH is the current depth in the originally specified
- chartable, and INDICES contains the vector indices
- for the levels our callers have descended.
-
- ARG is passed to C_FUNCTION when that is called. */
-
-void
-map_char_table (c_function, function, table, subtable, arg, depth, indices)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- Lisp_Object function, table, subtable, arg;
- int depth, *indices;
-{
- int i, to;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- GCPRO4 (arg, table, subtable, function);
-
- if (depth == 0)
- {
- /* At first, handle ASCII and 8-bit European characters. */
- for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
- {
- Lisp_Object elt= XCHAR_TABLE (subtable)->contents[i];
- if (NILP (elt))
- elt = XCHAR_TABLE (subtable)->defalt;
- if (NILP (elt))
- elt = Faref (subtable, make_number (i));
- if (c_function)
- (*c_function) (arg, make_number (i), elt);
- else
- call2 (function, make_number (i), elt);
- }
-#if 0 /* If the char table has entries for higher characters,
- we should report them. */
- if (NILP (current_buffer->enable_multibyte_characters))
- {
- UNGCPRO;
- return;
- }
-#endif
- to = CHAR_TABLE_ORDINARY_SLOTS;
- }
- else
- {
- int charset = indices[0] - 128;
-
- i = 32;
- to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
- if (CHARSET_CHARS (charset) == 94)
- i++, to--;
- }
-
- for (; i < to; i++)
- {
- Lisp_Object elt;
- int charset;
-
- elt = XCHAR_TABLE (subtable)->contents[i];
- indices[depth] = i;
- charset = indices[0] - 128;
- if (depth == 0
- && (!CHARSET_DEFINED_P (charset)
- || charset == CHARSET_8_BIT_CONTROL
- || charset == CHARSET_8_BIT_GRAPHIC))
- continue;
-
- if (SUB_CHAR_TABLE_P (elt))
- {
- if (depth >= 3)
- error ("Too deep char table");
- map_char_table (c_function, function, table, elt, arg, depth + 1, indices);
- }
- else
- {
- int c1, c2, c;
-
- c1 = depth >= 1 ? indices[1] : 0;
- c2 = depth >= 2 ? indices[2] : 0;
- c = MAKE_CHAR (charset, c1, c2);
-
- if (NILP (elt))
- elt = XCHAR_TABLE (subtable)->defalt;
- if (NILP (elt))
- elt = Faref (table, make_number (c));
-
- if (c_function)
- (*c_function) (arg, make_number (c), elt);
- else
- call2 (function, make_number (c), elt);
- }
- }
- UNGCPRO;
-}
-
-static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
-static void
-void_call2 (a, b, c)
- Lisp_Object a, b, c;
-{
- call2 (a, b, c);
-}
-
-DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
- 2, 2, 0,
- doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
-FUNCTION is called with two arguments--a key and a value.
-The key is always a possible IDX argument to `aref'. */)
- (function, char_table)
- Lisp_Object function, char_table;
-{
- /* The depth of char table is at most 3. */
- int indices[3];
-
- CHECK_CHAR_TABLE (char_table);
-
- /* When Lisp_Object is represented as a union, `call2' cannot directly
- be passed to map_char_table because it returns a Lisp_Object rather
- than returning nothing.
- Casting leads to crashes on some architectures. --Stef */
- map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices);
- return Qnil;
-}
-
-/* Return a value for character C in char-table TABLE. Store the
- actual index for that value in *IDX. Ignore the default value of
- TABLE. */
-
-Lisp_Object
-char_table_ref_and_index (table, c, idx)
- Lisp_Object table;
- int c, *idx;
-{
- int charset, c1, c2;
- Lisp_Object elt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- {
- *idx = c;
- return XCHAR_TABLE (table)->contents[c];
- }
- SPLIT_CHAR (c, charset, c1, c2);
- elt = XCHAR_TABLE (table)->contents[charset + 128];
- *idx = MAKE_CHAR (charset, 0, 0);
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1]))
- return XCHAR_TABLE (elt)->defalt;
- elt = XCHAR_TABLE (elt)->contents[c1];
- *idx = MAKE_CHAR (charset, c1, 0);
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2]))
- return XCHAR_TABLE (elt)->defalt;
- *idx = c;
- return XCHAR_TABLE (elt)->contents[c2];
-}
-
-\f
/* ARGSUSED */
Lisp_Object
-nconc2 (s1, s2)
- Lisp_Object s1, s2;
+nconc2 (Lisp_Object s1, Lisp_Object s2)
{
-#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
args[0] = s1;
args[1] = s2;
return Fnconc (2, args);
-#else
- return Fnconc (2, &s1);
-#endif /* NO_ARG_ARRAY */
}
DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
LENI is the length of VALS, which should also be the length of SEQ. */
static void
-mapcar1 (leni, vals, fn, seq)
- int leni;
- Lisp_Object *vals;
- Lisp_Object fn, seq;
+mapcar1 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
register Lisp_Object tail;
Lisp_Object dummy;
USE_SAFE_ALLOCA;
len = Flength (sequence);
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
leni = XINT (len);
nargs = leni + leni - 1;
if (nargs < 0) return empty_unibyte_string;
USE_SAFE_ALLOCA;
len = Flength (sequence);
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
leni = XFASTINT (len);
SAFE_ALLOCA_LISP (args, leni);
register int leni;
leni = XFASTINT (Flength (sequence));
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
mapcar1 (leni, 0, function, sequence);
return sequence;
xprompt = prompt;
GCPRO2 (prompt, xprompt);
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
Anything that calls this function must protect from GC! */
Lisp_Object
-do_yes_or_no_p (prompt)
- Lisp_Object prompt;
+do_yes_or_no_p (Lisp_Object prompt)
{
return call1 (intern ("yes-or-no-p"), prompt);
}
Lisp_Object require_nesting_list;
Lisp_Object
-require_unwind (old_value)
- Lisp_Object old_value;
+require_unwind (Lisp_Object old_value)
{
return require_nesting_list = old_value;
}
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 */
base64 characters. */
-static int base64_encode_1 P_ ((const char *, char *, int, int, int));
-static int base64_decode_1 P_ ((const char *, char *, int, int, int *));
+static int base64_encode_1 (const char *, char *, int, int, int);
+static int base64_decode_1 (const char *, char *, int, int, int *);
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
2, 3, "r",
}
static int
-base64_encode_1 (from, to, length, line_break, multibyte)
- const char *from;
- char *to;
- int length;
- int line_break;
- int multibyte;
+base64_encode_1 (const char *from, char *to, int length, int line_break, int multibyte)
{
int counter = 0, i = 0;
char *e = to;
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ c = STRING_CHAR_AND_LENGTH (from + i, bytes);
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
characters in *NCHARS_RETURN. */
static int
-base64_decode_1 (from, to, length, multibyte, nchars_return)
- const char *from;
- char *to;
- int length;
- int multibyte;
- int *nchars_return;
+base64_decode_1 (const char *from, char *to, int length, int multibyte, int *nchars_return)
{
int i = 0;
char *e = to;
value |= base64_char_to_value[c] << 12;
c = (unsigned char) (value >> 16);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
value |= base64_char_to_value[c] << 6;
c = (unsigned char) (0xff & value >> 8);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
value |= base64_char_to_value[c];
c = (unsigned char) (0xff & value);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
/* Function prototypes. */
-static struct Lisp_Hash_Table *check_hash_table P_ ((Lisp_Object));
-static int get_key_arg P_ ((Lisp_Object, int, Lisp_Object *, char *));
-static void maybe_resize_hash_table P_ ((struct Lisp_Hash_Table *));
-static int cmpfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
- Lisp_Object, unsigned));
-static int cmpfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
- Lisp_Object, unsigned));
-static int cmpfn_user_defined P_ ((struct Lisp_Hash_Table *, Lisp_Object,
- unsigned, Lisp_Object, unsigned));
-static unsigned hashfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object));
-static unsigned hashfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object));
-static unsigned hashfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object));
-static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *,
- Lisp_Object));
-static unsigned sxhash_string P_ ((unsigned char *, int));
-static unsigned sxhash_list P_ ((Lisp_Object, int));
-static unsigned sxhash_vector P_ ((Lisp_Object, int));
-static unsigned sxhash_bool_vector P_ ((Lisp_Object));
-static int sweep_weak_table P_ ((struct Lisp_Hash_Table *, int));
+static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
+static int get_key_arg (Lisp_Object, int, Lisp_Object *, char *);
+static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
+static int cmpfn_eql (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
+ Lisp_Object, unsigned);
+static int cmpfn_equal (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
+ Lisp_Object, unsigned);
+static int cmpfn_user_defined (struct Lisp_Hash_Table *, Lisp_Object,
+ unsigned, Lisp_Object, unsigned);
+static unsigned hashfn_eq (struct Lisp_Hash_Table *, Lisp_Object);
+static unsigned hashfn_eql (struct Lisp_Hash_Table *, Lisp_Object);
+static unsigned hashfn_equal (struct Lisp_Hash_Table *, Lisp_Object);
+static unsigned hashfn_user_defined (struct Lisp_Hash_Table *,
+ Lisp_Object);
+static unsigned sxhash_string (unsigned char *, int);
+static unsigned sxhash_list (Lisp_Object, int);
+static unsigned sxhash_vector (Lisp_Object, int);
+static unsigned sxhash_bool_vector (Lisp_Object);
+static int sweep_weak_table (struct Lisp_Hash_Table *, int);
\f
Lisp_Hash_Table. Otherwise, signal an error. */
static struct Lisp_Hash_Table *
-check_hash_table (obj)
- Lisp_Object obj;
+check_hash_table (Lisp_Object obj)
{
CHECK_HASH_TABLE (obj);
return XHASH_TABLE (obj);
number. */
int
-next_almost_prime (n)
- int n;
+next_almost_prime (int n)
{
if (n % 2 == 0)
n += 1;
a DEFUN parameter list. */
static int
-get_key_arg (key, nargs, args, used)
- Lisp_Object key;
- int nargs;
- Lisp_Object *args;
- char *used;
+get_key_arg (Lisp_Object key, int nargs, Lisp_Object *args, char *used)
{
int i;
vector that are not copied from VEC are set to INIT. */
Lisp_Object
-larger_vector (vec, new_size, init)
- Lisp_Object vec;
- int new_size;
- Lisp_Object init;
+larger_vector (Lisp_Object vec, int new_size, Lisp_Object init)
{
struct Lisp_Vector *v;
int i, old_size;
xassert (new_size >= old_size);
v = allocate_vector (new_size);
- bcopy (XVECTOR (vec)->contents, v->contents,
- old_size * sizeof *v->contents);
+ memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
for (i = old_size; i < new_size; ++i)
v->contents[i] = init;
XSETVECTOR (vec, v);
KEY2 are the same. */
static int
-cmpfn_eql (h, key1, hash1, key2, hash2)
- struct Lisp_Hash_Table *h;
- Lisp_Object key1, key2;
- unsigned hash1, hash2;
+cmpfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
{
return (FLOATP (key1)
&& FLOATP (key2)
KEY2 are the same. */
static int
-cmpfn_equal (h, key1, hash1, key2, hash2)
- struct Lisp_Hash_Table *h;
- Lisp_Object key1, key2;
- unsigned hash1, hash2;
+cmpfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
{
return hash1 == hash2 && !NILP (Fequal (key1, key2));
}
if KEY1 and KEY2 are the same. */
static int
-cmpfn_user_defined (h, key1, hash1, key2, hash2)
- struct Lisp_Hash_Table *h;
- Lisp_Object key1, key2;
- unsigned hash1, hash2;
+cmpfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
{
if (hash1 == hash2)
{
in a Lisp integer. */
static unsigned
-hashfn_eq (h, key)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
+hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- unsigned hash = XUINT (key) ^ XGCTYPE (key);
+ unsigned hash = XUINT (key) ^ XTYPE (key);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
in a Lisp integer. */
static unsigned
-hashfn_eql (h, key)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
+hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
{
unsigned hash;
if (FLOATP (key))
hash = sxhash (key, 0);
else
- hash = XUINT (key) ^ XGCTYPE (key);
+ hash = XUINT (key) ^ XTYPE (key);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
in a Lisp integer. */
static unsigned
-hashfn_equal (h, key)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
+hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
{
unsigned hash = sxhash (key, 0);
xassert ((hash & ~INTMASK) == 0);
guaranteed to fit in a Lisp integer. */
static unsigned
-hashfn_user_defined (h, key)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
+hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
{
Lisp_Object args[2], hash;
only the table itself is. */
Lisp_Object
-copy_hash_table (h1)
- struct Lisp_Hash_Table *h1;
+copy_hash_table (struct Lisp_Hash_Table *h1)
{
Lisp_Object table;
struct Lisp_Hash_Table *h2;
h2 = allocate_hash_table ();
next = h2->vec_next;
- bcopy (h1, h2, sizeof *h2);
+ memcpy (h2, h1, sizeof *h2);
h2->vec_next = next;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
because it's already too large, throw an error. */
static INLINE void
-maybe_resize_hash_table (h)
- struct Lisp_Hash_Table *h;
+maybe_resize_hash_table (struct Lisp_Hash_Table *h)
{
if (NILP (h->next_free))
{
matching KEY, or -1 if not found. */
int
-hash_lookup (h, key, hash)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
- unsigned *hash;
+hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, unsigned int *hash)
{
unsigned hash_code;
int start_of_bucket;
Value is the index of the entry in H matching KEY. */
int
-hash_put (h, key, value, hash)
- struct Lisp_Hash_Table *h;
- Lisp_Object key, value;
- unsigned hash;
+hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, unsigned int hash)
{
int start_of_bucket, i;
/* Remove the entry matching KEY from hash table H, if there is one. */
-void
-hash_remove (h, key)
- struct Lisp_Hash_Table *h;
- Lisp_Object key;
+static void
+hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
unsigned hash_code;
int start_of_bucket;
/* Clear hash table H. */
void
-hash_clear (h)
- struct Lisp_Hash_Table *h;
+hash_clear (struct Lisp_Hash_Table *h)
{
if (h->count > 0)
{
}
for (i = 0; i < ASIZE (h->index); ++i)
- AREF (h->index, i) = Qnil;
+ ASET (h->index, i, Qnil);
h->next_free = make_number (0);
h->count = 0;
Weak Hash Tables
************************************************************************/
+void
+init_weak_hash_tables (void)
+{
+ 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
non-zero if anything was marked. */
static int
-sweep_weak_table (h, remove_entries_p)
- struct Lisp_Hash_Table *h;
- int remove_entries_p;
+sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
{
int bucket, n, marked;
/* Follow collision chain, removing entries that
don't survive this garbage collection. */
prev = Qnil;
- for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next)
+ for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
int i = XFASTINT (idx);
int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
if (remove_p)
{
/* Take out of collision chain. */
- if (GC_NILP (prev))
+ if (NILP (prev))
HASH_INDEX (h, bucket) = next;
else
HASH_NEXT (h, XFASTINT (prev)) = next;
/* Remove elements from weak hash tables that don't survive the
current garbage collection. Remove weak tables that don't survive
- from weak_hash_tables. Called from gc_sweep. */
+ from Vweak_hash_tables. Called from gc_sweep. */
void
-sweep_weak_hash_tables ()
+sweep_weak_hash_tables (void)
{
struct Lisp_Hash_Table *h, *used, *next;
int marked;
code returned is guaranteed to fit in a Lisp integer. */
static unsigned
-sxhash_string (ptr, len)
- unsigned char *ptr;
- int len;
+sxhash_string (unsigned char *ptr, int len)
{
unsigned char *p = ptr;
unsigned char *end = p + len;
list. We don't recurse deeper than SXHASH_MAX_DEPTH in it. */
static unsigned
-sxhash_list (list, depth)
- Lisp_Object list;
- int depth;
+sxhash_list (Lisp_Object list, int depth)
{
unsigned hash = 0;
int i;
the Lisp structure. */
static unsigned
-sxhash_vector (vec, depth)
- Lisp_Object vec;
- int depth;
+sxhash_vector (Lisp_Object vec, int depth)
{
unsigned hash = ASIZE (vec);
int i, n;
/* Return a hash for bool-vector VECTOR. */
static unsigned
-sxhash_bool_vector (vec)
- Lisp_Object vec;
+sxhash_bool_vector (Lisp_Object vec)
{
unsigned hash = XBOOL_VECTOR (vec)->size;
int i, n;
structure. Value is an unsigned integer clipped to INTMASK. */
unsigned
-sxhash (obj, depth)
- Lisp_Object obj;
- int depth;
+sxhash (Lisp_Object obj, int depth)
{
unsigned hash;
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;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
used = (char *) alloca (nargs * sizeof *used);
- bzero (used, nargs * sizeof *used);
+ memset (used, 0, nargs * sizeof *used);
/* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used);
DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
- doc: /* Clear hash table TABLE. */)
+ doc: /* Clear hash table TABLE and return it. */)
(table)
Lisp_Object table;
{
hash_clear (check_hash_table (table));
- return Qnil;
+ /* Be compatible with XEmacs. */
+ return table;
}
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;
}
************************************************************************/
#include "md5.h"
-#include "coding.h"
DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
doc: /* Return MD5 message digest of OBJECT, a buffer or string.
if (STRING_MULTIBYTE (object))
/* use default, we can't guess correct value */
- coding_system = find_symbol_value (XCAR (Vcoding_category_list));
+ coding_system = preferred_coding_system ();
else
coding_system = Qraw_text;
}
}
if (STRING_MULTIBYTE (object))
- object = code_convert_string1 (object, coding_system, Qnil, 1);
+ object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
size = SCHARS (object);
size_byte = SBYTES (object);
specpdl_ptr--;
if (STRING_MULTIBYTE (object))
- object = code_convert_string1 (object, coding_system, Qnil, 1);
+ object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
md5_buffer (SDATA (object) + start_byte,
\f
void
-syms_of_fns ()
+syms_of_fns (void)
{
/* 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. 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. */);
+This applies to commands from menus and tool bar buttons even when
+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);
defsubr (&Sequal_including_properties);
defsubr (&Sfillarray);
defsubr (&Sclear_string);
- defsubr (&Schar_table_subtype);
- defsubr (&Schar_table_parent);
- defsubr (&Sset_char_table_parent);
- defsubr (&Schar_table_extra_slot);
- defsubr (&Sset_char_table_extra_slot);
- defsubr (&Schar_table_range);
- defsubr (&Sset_char_table_range);
- defsubr (&Sset_char_table_default);
- defsubr (&Soptimize_char_table);
- defsubr (&Smap_char_table);
defsubr (&Snconc);
defsubr (&Smapcar);
defsubr (&Smapc);
void
-init_fns ()
+init_fns (void)
{
- weak_hash_tables = NULL;
}
/* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31
HCoop / bpt / emacs.git / blobdiff