* src/alloc.c (allocate_string): Return a Lisp_Object. All callers changed.
(allocate_string_data): Take a Lisp_Object as first argument. All
callers changed.
* src/callint.c (Finteractive): Remove.
* src/data.c (Finteractive_form): Handle a nil interactive-form
correctly.
* src/emacs.c (main2): Set `lisp-string?'.
* src/eval.c (Fwhile): Remove.
(Fcommandp): Handle a nil interactive-form correctly.
* src/lisp.h (struct Lisp_String): Move definition.
/* Return a new Lisp_String. */
-static struct Lisp_String *
+static Lisp_Object
allocate_string (void)
{
- struct Lisp_String *p;
-
- p = xmalloc (sizeof *p);
- SCM_NEWSMOB (p->self, lisp_string_tag, p);
- return p;
+ return scm_make_smob (lisp_string_tag);
}
S->data if it was initially non-null. */
void
-allocate_string_data (struct Lisp_String *s,
+allocate_string_data (Lisp_Object string,
EMACS_INT nchars, EMACS_INT nbytes)
{
+ struct Lisp_String *s = (void *) SCM_SMOB_DATA (string);
unsigned char *data;
if (STRING_BYTES_BOUND < nbytes)
make_empty_string (int multibyte)
{
Lisp_Object string;
- struct Lisp_String *s;
- s = allocate_string ();
- allocate_string_data (s, 0, 0);
- XSETSTRING (string, s);
+ string = allocate_string ();
+ allocate_string_data (string, 0, 0);
if (! multibyte)
STRING_SET_UNIBYTE (string);
make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
{
Lisp_Object string;
- struct Lisp_String *s;
if (nchars < 0)
emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
- s = allocate_string ();
- s->intervals = NULL;
- allocate_string_data (s, nchars, nbytes);
- XSETSTRING (string, s);
+ string = allocate_string ();
+ ((struct Lisp_String *) SCM_SMOB_DATA (string))->intervals = NULL;
+ allocate_string_data (string, nchars, nbytes);
return string;
}
init_alloc_once (void)
{
lisp_misc_tag = scm_make_smob_type ("elisp-misc", 0);
- lisp_string_tag = scm_make_smob_type ("elisp-string", 0);
+ lisp_string_tag = scm_make_smob_type ("elisp-string",
+ sizeof (struct Lisp_String));
lisp_vectorlike_tag = scm_make_smob_type ("elisp-vectorlike", 0);
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
/* String for the prompt text used in Fcall_interactively. */
static Lisp_Object callint_message;
\f
-/* ARGSUSED */
-DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
- doc: /* Specify a way of parsing arguments for interactive use of a function.
-For example, write
- (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
- to make ARG be the raw prefix argument, and set BUF to an existing buffer,
- when `foo' is called as a command.
-The "call" to `interactive' is actually a declaration rather than a function;
- it tells `call-interactively' how to read arguments
- to pass to the function.
-When actually called, `interactive' just returns nil.
-
-Usually the argument of `interactive' is a string containing a code letter
- followed optionally by a prompt. (Some code letters do not use I/O to get
- the argument and do not use prompts.) To get several arguments, concatenate
- the individual strings, separating them by newline characters.
-Prompts are passed to format, and may use % escapes to print the
- arguments that have already been read.
-If the argument is not a string, it is evaluated to get a list of
- arguments to pass to the function.
-Just `(interactive)' means pass no args when calling interactively.
-
-Code letters available are:
-a -- Function name: symbol with a function definition.
-b -- Name of existing buffer.
-B -- Name of buffer, possibly nonexistent.
-c -- Character (no input method is used).
-C -- Command name: symbol with interactive function definition.
-d -- Value of point as number. Does not do I/O.
-D -- Directory name.
-e -- Parameterized event (i.e., one that's a list) that invoked this command.
- If used more than once, the Nth `e' returns the Nth parameterized event.
- This skips events that are integers or symbols.
-f -- Existing file name.
-F -- Possibly nonexistent file name.
-G -- Possibly nonexistent file name, defaulting to just directory name.
-i -- Ignored, i.e. always nil. Does not do I/O.
-k -- Key sequence (downcase the last event if needed to get a definition).
-K -- Key sequence to be redefined (do not downcase the last event).
-m -- Value of mark as number. Does not do I/O.
-M -- Any string. Inherits the current input method.
-n -- Number read using minibuffer.
-N -- Numeric prefix arg, or if none, do like code `n'.
-p -- Prefix arg converted to number. Does not do I/O.
-P -- Prefix arg in raw form. Does not do I/O.
-r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
-s -- Any string. Does not inherit the current input method.
-S -- Any symbol.
-U -- Mouse up event discarded by a previous k or K argument.
-v -- Variable name: symbol that is `custom-variable-p'.
-x -- Lisp expression read but not evaluated.
-X -- Lisp expression read and evaluated.
-z -- Coding system.
-Z -- Coding system, nil if no prefix arg.
-
-In addition, if the string begins with `*', an error is signaled if
- the buffer is read-only.
-If `@' appears at the beginning of the string, and if the key sequence
- used to invoke the command includes any mouse events, then the window
- associated with the first of those events is selected before the
- command is run.
-If the string begins with `^' and `shift-select-mode' is non-nil,
- Emacs first calls the function `handle-shift-selection'.
-You may use `@', `*', and `^' together. They are processed in the
- order that they appear, before reading any arguments.
-usage: (interactive &optional ARGS) */)
- (Lisp_Object args)
-{
- return Qnil;
-}
-
/* Quotify EXP: if EXP is constant, return it.
If EXP is not constant, return (quote EXP). */
static Lisp_Object
if (scm_is_true (scm_procedure_p (fun)))
{
- Lisp_Object tem = scm_procedure_property (fun, Qinteractive_form);
- if (scm_is_true (tem))
- return list2 (Qinteractive, tem);
+ Lisp_Object tem = scm_assq (Qinteractive_form,
+ scm_procedure_properties (fun));
+ if (scm_is_pair (tem))
+ return list2 (Qinteractive, scm_cdr (tem));
}
else if (COMPILEDP (fun))
{
unsigned char *str = SAFE_ALLOCA (nbytes);
memcpy (str, SDATA (array), nbytes);
- allocate_string_data (XSTRING (array), nchars,
+ allocate_string_data (array, nchars,
nbytes + new_bytes - prev_bytes);
memcpy (SDATA (array), str, idxval_byte);
p1 = SDATA (array) + idxval_byte;
scm_set_current_module (scm_c_resolve_module ("guile-user"));
init_alloc_once ();
- scm_c_module_define (scm_c_resolve_module ("language elisp lexer"),
+
+ scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
"make-lisp-string",
scm_c_make_gsubr ("make-lisp-string", 1, 0, 0,
string_from_scheme));
+ scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
+ "lisp-string?",
+ scm_c_make_gsubr ("stringp", 1, 0, 0, Fstringp));
+
init_guile ();
init_fns_once ();
init_obarray ();
return elt;
}
-DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
- doc: /* If TEST yields non-nil, eval BODY... and repeat.
-The order of execution is thus TEST, BODY, TEST, BODY and so on
-until TEST returns nil.
-usage: (while TEST BODY...) */)
- (Lisp_Object args)
-{
- Lisp_Object test, body;
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (test, body);
-
- test = XCAR (args);
- body = XCDR (args);
- while (!NILP (eval_sub (test)))
- {
- QUIT;
- Fprogn (body);
- }
-
- UNGCPRO;
- return Qnil;
-}
-
DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
doc: /* Return result of expanding macros at top level of FORM.
If FORM is not a macro call, it is returned unchanged.
}
if (scm_is_true (scm_procedure_p (fun)))
- return (scm_is_true (scm_procedure_property (fun, Qinteractive_form))
+ return (scm_is_pair (scm_assq (Qinteractive_form,
+ scm_procedure_properties (fun)))
? Qt : if_prop);
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
typedef struct interval *INTERVAL;
+struct Lisp_String
+ {
+ ptrdiff_t size;
+ ptrdiff_t size_byte;
+ INTERVAL intervals; /* Text properties in this string. */
+ unsigned char *data;
+ };
+
LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c))
LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
-struct Lisp_String
- {
- Lisp_Object self;
- ptrdiff_t size;
- ptrdiff_t size_byte;
- INTERVAL intervals; /* Text properties in this string. */
- unsigned char *data;
- };
-
/* True if STR is a multibyte string. */
INLINE bool
STRING_MULTIBYTE (Lisp_Object str)
/* Defined in alloc.c. */
extern void check_pure_size (void);
extern void free_misc (Lisp_Object);
-extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
+extern void allocate_string_data (Lisp_Object, EMACS_INT, EMACS_INT);
extern void malloc_warning (const char *);
extern _Noreturn void memory_full (size_t);
extern _Noreturn void buffer_memory_full (ptrdiff_t);
HCoop / bpt / emacs.git / commitdiff