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 /* Now in lisp code ("macrocode...")
29 * DEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0,
30 * "Define mocklisp functions")
36 * while (!NILP (args))
39 * Ffset (Fcar (elt), Fcons (Qmocklisp, Fcdr (elt)));
46 DEFUN ("ml-if", Fml_if
, Sml_if
, 0, UNEVALLED
, 0, "Mocklisp version of `if'.")
50 register Lisp_Object val
;
56 val
= Feval (Fcar (args
));
58 if (NILP (args
)) break;
61 val
= Feval (Fcar (args
));
70 #if 0 /* Now converted to regular "while" by hairier conversion code. */
71 /**/DEFUN ("ml-while", Fml_while
, Sml_while
, 1, UNEVALLED
, 0, "while for mocklisp programs")
75 Lisp_Object test
, body
, tem
;
76 struct gcpro gcpro1
, gcpro2
;
82 while (tem
= Feval (test
), XINT (tem
))
93 /* This is the main entry point to mocklisp execution.
94 When eval sees a mocklisp function being called, it calls here
95 with the unevaluated argument list */
98 ml_apply (function
, args
)
99 Lisp_Object function
, args
;
101 register int count
= specpdl_ptr
- specpdl
;
102 register Lisp_Object val
;
104 specbind (Qmocklisp_arguments
, args
);
105 val
= Fprogn (Fcdr (function
));
106 return unbind_to (count
, val
);
109 DEFUN ("ml-nargs", Fml_nargs
, Sml_nargs
, 0, 0, 0,
110 "Number of arguments to currently executing mocklisp function.")
113 if (EQ (Vmocklisp_arguments
, Qinteractive
))
114 return make_number (0);
115 return Flength (Vmocklisp_arguments
);
118 DEFUN ("ml-arg", Fml_arg
, Sml_arg
, 1, 2, 0,
119 "Argument number N to currently executing mocklisp function.")
121 Lisp_Object n
, prompt
;
123 if (EQ (Vmocklisp_arguments
, Qinteractive
))
124 return Fread_string (prompt
, Qnil
, Qnil
, Qnil
, Qnil
);
126 XSETINT (n
, XINT (n
) - 1); /* Mocklisp likes to be origin-1 */
127 return Fcar (Fnthcdr (n
, Vmocklisp_arguments
));
130 DEFUN ("ml-interactive", Fml_interactive
, Sml_interactive
, 0, 0, 0,
131 "True if currently executing mocklisp function was called interactively.")
134 return (EQ (Vmocklisp_arguments
, Qinteractive
)) ? Qt
: Qnil
;
137 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument
, Sml_provide_prefix_argument
,
139 "Evaluate second argument, using first argument as prefix arg value.")
145 Vcurrent_prefix_arg
= Feval (Fcar (args
));
147 return Feval (Fcar (Fcdr (args
)));
150 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop
, Sml_prefix_argument_loop
,
156 register Lisp_Object tem
;
160 /* Set `arg' in case we call a built-in function that looks at it. Still are a few. */
161 if (NILP (Vcurrent_prefix_arg
))
165 tem
= Vcurrent_prefix_arg
;
168 if (EQ (tem
, Qminus
))
180 #if 0 /* Now in mlsupport.el */
182 DEFUN ("ml-substr", Fml_substr
, Sml_substr
, 3, 3, 0,
183 "Return a substring of STRING, starting at index FROM and of length LENGTH.\n\
184 If either FROM or LENGTH is negative, the length of STRING is added to it.")
186 Lisp_Object string
, from
, to
;
188 CHECK_STRING (string
, 0);
189 CHECK_NUMBER (from
, 1);
190 CHECK_NUMBER (to
, 2);
193 XSETINT (from
, XINT (from
) + XSTRING (string
)->size
);
195 XSETINT (to
, XINT (to
) + XSTRING (string
)->size
);
196 XSETINT (to
, XINT (to
) + XINT (from
));
197 return Fsubstring (string
, from
, to
);
200 DEFUN ("insert-string", Finsert_string
, Sinsert_string
, 0, MANY
, 0,
201 "Mocklisp-compatibility insert function.\n\
202 Like the function `insert' except that any argument that is a number\n\
203 is converted into a string by expressing it in decimal.")
209 register Lisp_Object tem
;
211 for (argnum
= 0; argnum
< nargs
; argnum
++)
216 tem
= Fnumber_to_string (tem
);
221 tem
= wrong_type_argument (Qstringp
, tem
);
232 Qmocklisp
= intern ("mocklisp");
233 staticpro (&Qmocklisp
);
235 /*defsubr (&Sml_defun);*/
237 /*defsubr (&Sml_while);*/
239 defsubr (&Sml_nargs
);
240 defsubr (&Sml_interactive
);
241 defsubr (&Sml_provide_prefix_argument
);
242 defsubr (&Sml_prefix_argument_loop
);
243 /*defsubr (&Sml_substr);*/
244 defsubr (&Sinsert_string
);