1 /* Mocklisp compatibility functions for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* Compatibility for mocklisp */
28 DEFUN ("ml-if", Fml_if
, Sml_if
, 0, UNEVALLED
, 0,
29 doc
: /* Mocklisp version of `if'.
30 usage: (ml-if COND THEN ELSE...) */)
34 register Lisp_Object val
;
41 val
= Feval (Fcar (args
));
43 if (NILP (args
)) break;
46 val
= Feval (Fcar (args
));
56 /* This is the main entry point to mocklisp execution.
57 When eval sees a mocklisp function being called, it calls here
58 with the unevaluated argument list. */
61 ml_apply (function
, args
)
62 Lisp_Object function
, args
;
64 register int count
= specpdl_ptr
- specpdl
;
65 register Lisp_Object val
;
67 specbind (Qmocklisp_arguments
, args
);
68 val
= Fprogn (Fcdr (function
));
69 return unbind_to (count
, val
);
72 DEFUN ("ml-nargs", Fml_nargs
, Sml_nargs
, 0, 0, 0,
73 doc
: /* Number of arguments to currently executing mocklisp function. */)
76 if (EQ (Vmocklisp_arguments
, Qinteractive
))
77 return make_number (0);
78 return Flength (Vmocklisp_arguments
);
81 DEFUN ("ml-arg", Fml_arg
, Sml_arg
, 1, 2, 0,
82 doc
: /* Argument number N to currently executing mocklisp function. */)
84 Lisp_Object n
, prompt
;
86 if (EQ (Vmocklisp_arguments
, Qinteractive
))
87 return Fread_string (prompt
, Qnil
, Qnil
, Qnil
, Qnil
);
89 XSETINT (n
, XINT (n
) - 1); /* Mocklisp likes to be origin-1 */
90 return Fcar (Fnthcdr (n
, Vmocklisp_arguments
));
93 DEFUN ("ml-interactive", Fml_interactive
, Sml_interactive
, 0, 0, 0,
94 doc
: /* True if currently executing mocklisp function was called interactively. */)
97 return (EQ (Vmocklisp_arguments
, Qinteractive
)) ? Qt
: Qnil
;
100 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument
, Sml_provide_prefix_argument
,
102 doc
: /* Evaluate second argument, using first argument as prefix arg value.
103 usage: (ml-provide-prefix-argument ARG1 ARG2) */)
109 Vcurrent_prefix_arg
= Feval (Fcar (args
));
111 return Feval (Fcar (Fcdr (args
)));
114 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop
, Sml_prefix_argument_loop
,
116 doc
: /* usage: (ml-prefix-argument-loop ...) */)
120 register Lisp_Object tem
;
124 /* Set `arg' in case we call a built-in function that looks at it. Still are a few. */
125 if (NILP (Vcurrent_prefix_arg
))
129 tem
= Vcurrent_prefix_arg
;
132 if (EQ (tem
, Qminus
))
144 DEFUN ("insert-string", Finsert_string
, Sinsert_string
, 0, MANY
, 0,
145 doc
: /* Mocklisp-compatibility insert function.
146 Like the function `insert' except that any argument that is a number
147 is converted into a string by expressing it in decimal.
148 usage: (insert-string &rest ARGS) */)
154 register Lisp_Object tem
;
156 for (argnum
= 0; argnum
< nargs
; argnum
++)
161 tem
= Fnumber_to_string (tem
);
166 tem
= wrong_type_argument (Qstringp
, tem
);
178 Qmocklisp
= intern ("mocklisp");
179 staticpro (&Qmocklisp
);
183 defsubr (&Sml_nargs
);
184 defsubr (&Sml_interactive
);
185 defsubr (&Sml_provide_prefix_argument
);
186 defsubr (&Sml_prefix_argument_loop
);
187 defsubr (&Sinsert_string
);