/* Random utility Lisp functions.
- Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
- 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ Copyright (C) 1985-1987, 1993-1995, 1997-2011
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <time.h>
#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 *****
-
#include "lisp.h"
#include "commands.h"
#include "character.h"
#define NULL ((POINTER_TYPE *)0)
#endif
-Lisp_Object Qstring_lessp, Qprovide, Qrequire;
-Lisp_Object Qyes_or_no_p_history;
+Lisp_Object Qstring_lessp;
+static Lisp_Object Qprovide, Qrequire;
+static Lisp_Object Qyes_or_no_p_history;
Lisp_Object Qcursor_in_echo_area;
-Lisp_Object Qwidget_type;
-Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
+static Lisp_Object Qwidget_type;
+static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
static int internal_equal (Lisp_Object , Lisp_Object, int, int);
-extern long get_random (void);
-extern void seed_random (long);
-
#ifndef HAVE_UNISTD_H
extern long time ();
#endif
return i1 < SCHARS (s2) ? Qt : Qnil;
}
\f
-static Lisp_Object concat (int nargs, Lisp_Object *args,
+static Lisp_Object concat (size_t nargs, Lisp_Object *args,
enum Lisp_Type target_type, int last_special);
/* ARGSUSED */
Each argument may be a list, vector or string.
The last argument is not copied, just used as the tail of the new list.
usage: (append &rest SEQUENCES) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_Cons, 1);
}
The result is a string whose elements are the elements of all the arguments.
Each argument may be a string or a list or vector of characters (integers).
usage: (concat &rest SEQUENCES) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_String, 0);
}
The result is a vector whose elements are the elements of all the arguments.
Each argument may be a list, vector or string.
usage: (vconcat &rest SEQUENCES) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return concat (nargs, args, Lisp_Vectorlike, 0);
}
};
static Lisp_Object
-concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)
+concat (size_t nargs, Lisp_Object *args,
+ enum Lisp_Type target_type, int last_special)
{
Lisp_Object val;
register Lisp_Object tail;
EMACS_INT toindex_byte = 0;
register EMACS_INT result_len;
register EMACS_INT result_len_byte;
- register int argnum;
+ register size_t argnum;
Lisp_Object last_tail;
Lisp_Object prev;
int some_multibyte;
Lisp_Object ch;
EMACS_INT this_len_byte;
- if (VECTORP (this))
+ if (VECTORP (this) || COMPILEDP (this))
for (i = 0; i < len; i++)
{
ch = AREF (this, i);
copy_text (SDATA (string), buf, SBYTES (string),
0, 1);
- ret = make_multibyte_string (buf, SCHARS (string), nbytes);
+ ret = make_multibyte_string ((char *) buf, SCHARS (string), nbytes);
SAFE_FREE ();
return ret;
/* 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);
+ return make_multibyte_string (SSDATA (string), nbytes, nbytes);
SAFE_ALLOCA (buf, unsigned char *, nbytes);
memcpy (buf, SDATA (string), SBYTES (string));
str_to_multibyte (buf, nbytes, SBYTES (string));
- ret = make_multibyte_string (buf, SCHARS (string), nbytes);
+ ret = make_multibyte_string ((char *) buf, SCHARS (string), nbytes);
SAFE_FREE ();
return ret;
copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
- ret = make_unibyte_string (buf, nchars);
+ ret = make_unibyte_string ((char *) buf, nchars);
SAFE_FREE ();
return ret;
memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
- string = make_unibyte_string (str, bytes);
+ string = make_unibyte_string ((char *) str, bytes);
xfree (str);
}
return string;
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);
+ error ("Can't convert the %"pI"dth character to unibyte", converted);
+ string = make_unibyte_string ((char *) str, chars);
xfree (str);
}
return string;
if (STRINGP (string))
{
- res = make_specified_string (SDATA (string) + from_byte,
+ res = make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (from_char), make_number (to_char),
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
- return make_specified_string (SDATA (string) + from_byte,
+ return make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
}
{
Lisp_Object res;
EMACS_INT size;
- EMACS_INT size_byte;
CHECK_VECTOR_OR_STRING (string);
- if (STRINGP (string))
- {
- size = SCHARS (string);
- size_byte = SBYTES (string);
- }
- else
- size = ASIZE (string);
+ size = STRINGP (string) ? SCHARS (string) : ASIZE (string);
if (!(0 <= from && from <= to && to <= size))
args_out_of_range_3 (string, make_number (from), make_number (to));
if (STRINGP (string))
{
- res = make_specified_string (SDATA (string) + from_byte,
+ res = make_specified_string (SSDATA (string) + from_byte,
to - from, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (from), make_number (to),
/* Boolvectors are compared much like strings. */
if (BOOL_VECTOR_P (o1))
{
- int size_in_chars
- = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
-
if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
return 0;
if (memcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
- size_in_chars))
+ ((XBOOL_VECTOR (o1)->size
+ + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR)))
return 0;
return 1;
}
ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
- register EMACS_INT size, index;
+ register EMACS_INT size, idx;
int charval;
if (VECTORP (array))
{
register Lisp_Object *p = XVECTOR (array)->contents;
size = ASIZE (array);
- for (index = 0; index < size; index++)
- p[index] = item;
+ for (idx = 0; idx < size; idx++)
+ p[idx] = item;
}
else if (CHAR_TABLE_P (array))
{
*p++ = str[i % len];
}
else
- for (index = 0; index < size; index++)
- p[index] = charval;
+ for (idx = 0; idx < size; idx++)
+ p[idx] = charval;
}
else if (BOOL_VECTOR_P (array))
{
/ BOOL_VECTOR_BITS_PER_CHAR);
charval = (! NILP (item) ? -1 : 0);
- for (index = 0; index < size_in_chars - 1; index++)
- p[index] = charval;
- if (index < size_in_chars)
+ for (idx = 0; idx < size_in_chars - 1; idx++)
+ p[idx] = charval;
+ if (idx < size_in_chars)
{
/* Mask out bits beyond the vector size. */
if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
- p[index] = charval;
+ p[idx] = charval;
}
}
else
doc: /* Concatenate any number of lists by altering them.
Only the last argument is not altered, and need not be a list.
usage: (nconc &rest LISTS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
- register int argnum;
+ register size_t argnum;
register Lisp_Object tail, tem, val;
val = tail = Qnil;
1) lists are not relocated and 2) the list is marked via `seq' so will not
be freed */
- if (VECTORP (seq))
+ if (VECTORP (seq) || COMPILEDP (seq))
{
for (i = 0; i < leni; i++)
{
ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
Qyes_or_no_p_history, Qnil,
Qnil));
- if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
+ if (SCHARS (ans) == 3 && !strcmp (SSDATA (ans), "yes"))
{
UNGCPRO;
return Qt;
}
- if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
+ if (SCHARS (ans) == 2 && !strcmp (SSDATA (ans), "no"))
{
UNGCPRO;
return Qnil;
return ret;
}
\f
-Lisp_Object Qsubfeatures;
+static Lisp_Object Qsubfeatures;
DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,
doc: /* Return t if FEATURE is present in this Emacs.
/* List of features currently being require'd, innermost first. */
-Lisp_Object require_nesting_list;
+static Lisp_Object require_nesting_list;
-Lisp_Object
+static Lisp_Object
require_unwind (Lisp_Object old_value)
{
return require_nesting_list = old_value;
doc: /* Apply the value of WIDGET's PROPERTY to the widget itself.
ARGS are passed as extra arguments to the function.
usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
/* This function can GC. */
Lisp_Object newargs[3];
allength += allength / MIME_LINE_LENGTH + 1 + 6;
SAFE_ALLOCA (encoded, char *, allength);
- encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length,
- NILP (no_line_break),
- !NILP (current_buffer->enable_multibyte_characters));
+ encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
+ encoded, length, NILP (no_line_break),
+ !NILP (BVAR (current_buffer, enable_multibyte_characters)));
if (encoded_length > allength)
abort ();
/* We need to allocate enough room for decoding the text. */
SAFE_ALLOCA (encoded, char *, allength);
- encoded_length = base64_encode_1 (SDATA (string),
+ encoded_length = base64_encode_1 (SSDATA (string),
encoded, length, NILP (no_line_break),
STRING_MULTIBYTE (string));
if (encoded_length > allength)
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (from + i, bytes);
+ c = STRING_CHAR_AND_LENGTH ((unsigned char *) 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, bytes);
+ c = STRING_CHAR_AND_LENGTH ((unsigned char *) 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, bytes);
+ c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
EMACS_INT old_pos = PT;
EMACS_INT decoded_length;
EMACS_INT inserted_chars;
- int multibyte = !NILP (current_buffer->enable_multibyte_characters);
+ int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
SAFE_ALLOCA (decoded, char *, allength);
move_gap_both (XFASTINT (beg), ibeg);
- decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length,
+ decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
+ decoded, length,
multibyte, &inserted_chars);
if (decoded_length > allength)
abort ();
SAFE_ALLOCA (decoded, char *, length);
/* The decoded result should be unibyte. */
- decoded_length = base64_decode_1 (SDATA (string), decoded, length,
+ decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
0, NULL);
if (decoded_length > length)
abort ();
/* The list of all weak hash tables. Don't staticpro this one. */
-struct Lisp_Hash_Table *weak_hash_tables;
+static struct Lisp_Hash_Table *weak_hash_tables;
/* Various symbols. */
-Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue;
+static Lisp_Object Qhash_table_p, Qkey, Qvalue;
+Lisp_Object Qeq, Qeql, Qequal;
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
-Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
+static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
/* Function prototypes. */
static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
-static int get_key_arg (Lisp_Object, int, Lisp_Object *, char *);
+static size_t get_key_arg (Lisp_Object, size_t, 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);
/* Find KEY in ARGS which has size NARGS. Don't consider indices for
which USED[I] is non-zero. If found at index I in ARGS, set
USED[I] and USED[I + 1] to 1, and return I + 1. Otherwise return
- -1. This function is used to extract a keyword/argument pair from
+ 0. This function is used to extract a keyword/argument pair from
a DEFUN parameter list. */
-static int
-get_key_arg (Lisp_Object key, int nargs, Lisp_Object *args, char *used)
+static size_t
+get_key_arg (Lisp_Object key, size_t nargs, Lisp_Object *args, char *used)
{
- int i;
-
- for (i = 0; i < nargs - 1; ++i)
- if (!used[i] && EQ (args[i], key))
- break;
+ size_t i;
- if (i >= nargs - 1)
- i = -1;
- else
- {
- used[i++] = 1;
- used[i] = 1;
- }
+ for (i = 1; i < nargs; i++)
+ if (!used[i - 1] && EQ (args[i - 1], key))
+ {
+ used[i - 1] = 1;
+ used[i] = 1;
+ return i;
+ }
- return i;
+ return 0;
}
struct Lisp_Vector *next;
h2 = allocate_hash_table ();
- next = h2->vec_next;
+ next = h2->header.next.vector;
memcpy (h2, h1, sizeof *h2);
- h2->vec_next = next;
+ h2->header.next.vector = next;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
h2->next = Fcopy_sequence (h1->next);
marked = 0;
for (h = weak_hash_tables; h; h = h->next_weak)
{
- if (h->size & ARRAY_MARK_FLAG)
+ if (h->header.size & ARRAY_MARK_FLAG)
marked |= sweep_weak_table (h, 0);
}
}
{
next = h->next_weak;
- if (h->size & ARRAY_MARK_FLAG)
+ if (h->header.size & ARRAY_MARK_FLAG)
{
/* TABLE is marked as used. Sweep its contents. */
if (h->count > 0)
unsigned hash = XBOOL_VECTOR (vec)->size;
int i, n;
- n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size);
+ n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size);
for (i = 0; i < n; ++i)
hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
{
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);
+ size_t i;
+ for (hash = 0, i = 0; i < sizeof val; i++)
+ hash = SXHASH_COMBINE (hash, p[i]);
break;
}
is nil.
usage: (make-hash-table &rest KEYWORD-ARGS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
Lisp_Object test, size, rehash_size, rehash_threshold, weak;
Lisp_Object user_test, user_hash;
char *used;
- int i;
+ size_t i;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
/* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used);
- test = i < 0 ? Qeql : args[i];
+ test = i ? args[i] : Qeql;
if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
{
/* See if it is a user-defined test. */
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
- size = i < 0 ? Qnil : args[i];
+ size = i ? args[i] : Qnil;
if (NILP (size))
size = make_number (DEFAULT_HASH_SIZE);
else if (!INTEGERP (size) || XINT (size) < 0)
/* Look for `:rehash-size SIZE'. */
i = get_key_arg (QCrehash_size, nargs, args, used);
- rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i];
+ rehash_size = i ? args[i] : make_float (DEFAULT_REHASH_SIZE);
if (!NUMBERP (rehash_size)
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
|| XFLOATINT (rehash_size) <= 1.0)
/* Look for `:rehash-threshold THRESHOLD'. */
i = get_key_arg (QCrehash_threshold, nargs, args, used);
- rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i];
+ rehash_threshold = i ? args[i] : make_float (DEFAULT_REHASH_THRESHOLD);
if (!FLOATP (rehash_threshold)
|| XFLOATINT (rehash_threshold) <= 0.0
|| XFLOATINT (rehash_threshold) > 1.0)
/* Look for `:weakness WEAK'. */
i = get_key_arg (QCweakness, nargs, args, used);
- weak = i < 0 ? Qnil : args[i];
+ weak = i ? args[i] : Qnil;
if (EQ (weak, Qt))
weak = Qkey_and_value;
if (!NILP (weak)
(Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
{
unsigned char digest[16];
- unsigned char value[33];
+ char value[33];
int i;
EMACS_INT size;
EMACS_INT size_byte = 0;
{
int force_raw_text = 0;
- coding_system = XBUFFER (object)->buffer_file_coding_system;
+ coding_system = BVAR (XBUFFER (object), buffer_file_coding_system);
if (NILP (coding_system)
|| NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
{
coding_system = Qnil;
- if (NILP (current_buffer->enable_multibyte_characters))
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
force_raw_text = 1;
}
}
if (NILP (coding_system)
- && !NILP (XBUFFER (object)->buffer_file_coding_system))
+ && !NILP (BVAR (XBUFFER (object), buffer_file_coding_system)))
{
/* If we still have not decided a coding system, use the
default value of buffer-file-coding-system. */
- coding_system = XBUFFER (object)->buffer_file_coding_system;
+ coding_system = BVAR (XBUFFER (object), buffer_file_coding_system);
}
if (!force_raw_text
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
- md5_buffer (SDATA (object) + start_byte,
+ md5_buffer (SSDATA (object) + start_byte,
SBYTES (object) - (size_byte - end_byte),
digest);
init_fns (void)
{
}
-