/* 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.
#define NULL ((POINTER_TYPE *)0)
#endif
-/* Nonzero enables use of dialog boxes for questions
- asked by mouse commands. */
-int use_dialog_box;
-
-/* Nonzero enables use of a file dialog for file name
- questions asked by mouse commands. */
-int use_file_dialog;
-
Lisp_Object Qstring_lessp, Qprovide, Qrequire;
Lisp_Object Qyes_or_no_p_history;
Lisp_Object Qcursor_in_echo_area;
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;
if (converted < chars)
error ("Can't convert the %dth character to unibyte", converted);
- string = make_unibyte_string (str, chars);
+ 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));
}
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),
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++)
{
/* Anything that calls this function must protect from GC! */
-DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, MANY, 0,
+DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
doc: /* Ask user a yes-or-no question. Return t if answer is yes.
-The string to display to ask the question is obtained by
-formatting the string PROMPT with arguments ARGS (see `format').
-The result should end in a space; `yes-or-no-p' adds
-\"(yes or no) \" to it.
+PROMPT is the string to display to ask the question. It should end in
+a space; `yes-or-no-p' adds \"(yes or no) \" to it.
The user must confirm the answer with RET, and can edit it until it
has been confirmed.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
-is nil, and `use-dialog-box' is non-nil.
-usage: (yes-or-no-p PROMPT &rest ARGS) */)
- (int nargs, Lisp_Object *args)
+is nil, and `use-dialog-box' is non-nil. */)
+ (Lisp_Object prompt)
{
register Lisp_Object ans;
+ Lisp_Object args[2];
struct gcpro gcpro1;
- Lisp_Object prompt = Fformat (nargs, args);
+
+ CHECK_STRING (prompt);
#ifdef HAVE_MENUS
if (FRAME_WINDOW_P (SELECTED_FRAME ())
}
#endif /* HAVE_MENUS */
- prompt = concat2 (prompt, build_string ("(yes or no) "));
+ args[0] = prompt;
+ args[1] = build_string ("(yes or no) ");
+ prompt = Fconcat (2, args);
+
GCPRO1 (prompt);
while (1)
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 Vfeatures, Qsubfeatures;
+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 ();
/* 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;
+ size_t i;
- for (i = 0; i < nargs - 1; ++i)
- if (!used[i] && EQ (args[i], key))
- break;
-
- 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;
}
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);
Fset (Qyes_or_no_p_history, Qnil);
- DEFVAR_LISP ("features", &Vfeatures,
+ 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_c_string ("emacs"), Qnil);
staticpro (&Qpaper);
#endif /* HAVE_LANGINFO_CODESET */
- DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
+ 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.
non-nil. */);
use_dialog_box = 1;
- DEFVAR_BOOL ("use-file-dialog", &use_file_dialog,
+ 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. If `use-dialog-box' is nil,
init_fns (void)
{
}
-
-/* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31
- (do not change this comment) */