comparison src/mocklisp.c @ 20:859a2309aef8 r19-15b93

Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 376386a54a3c
children
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
33 Lisp_Object Qmocklisp; 33 Lisp_Object Qmocklisp;
34 Lisp_Object Qmocklisp_arguments; 34 Lisp_Object Qmocklisp_arguments;
35 Lisp_Object Vmocklisp_arguments; 35 Lisp_Object Vmocklisp_arguments;
36 36
37 #if 0 /* Now in lisp code ("macrocode...") */ 37 #if 0 /* Now in lisp code ("macrocode...") */
38 xxDEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0 /* 38 xxDEFUN ("ml-defun", ml_defun, 0, UNEVALLED, 0 /*
39 Define mocklisp functions 39 Define mocklisp functions
40 */ ) 40 */ )
41 (args) 41 (Lisp_Object args)
42 Lisp_Object args;
43 { 42 {
44 Lisp_Object elt; 43 Lisp_Object elt;
45 44
46 while (!NILP (args)) 45 while (!NILP (args))
47 { 46 {
52 return Qnil; 51 return Qnil;
53 } 52 }
54 #endif /* 0 */ 53 #endif /* 0 */
55 54
56 55
57 DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0 /* 56 DEFUN ("ml-if", Fml_if, 0, UNEVALLED, 0, /*
58 Mocklisp version of `if'. 57 Mocklisp version of `if'.
59 */ ) 58 */
60 (args) 59 (args))
61 Lisp_Object args;
62 { 60 {
63 /* This function can GC */ 61 /* This function can GC */
64 Lisp_Object val; 62 Lisp_Object val;
65 struct gcpro gcpro1; 63 struct gcpro gcpro1;
66 64
80 UNGCPRO; 78 UNGCPRO;
81 return val; 79 return val;
82 } 80 }
83 81
84 #if 0 /* Now converted to regular "while" by hairier conversion code. */ 82 #if 0 /* Now converted to regular "while" by hairier conversion code. */
85 xxDEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0 /* 83 xxDEFUN ("ml-while", ml_while, 1, UNEVALLED, 0 /*
86 while for mocklisp programs 84 while for mocklisp programs
87 */ ) 85 */ )
88 (args) 86 (Lisp_Object args)
89 Lisp_Object args;
90 { 87 {
91 Lisp_Object test, body, tem; 88 Lisp_Object test, body, tem;
92 struct gcpro gcpro1, gcpro2; 89 struct gcpro gcpro1, gcpro2;
93 90
94 GCPRO2 (test, body); 91 GCPRO2 (test, body);
161 158
162 #endif /* 0 */ 159 #endif /* 0 */
163 160
164 161
165 /* ??? Isn't this the same as `provide-prefix-arg' from mlsupport.el? */ 162 /* ??? Isn't this the same as `provide-prefix-arg' from mlsupport.el? */
166 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, 163 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, 2, UNEVALLED, 0, /*
167 2, UNEVALLED, 0 /*
168 Evaluate second argument, using first argument as prefix arg value. 164 Evaluate second argument, using first argument as prefix arg value.
169 */ ) 165 */
170 (args) 166 (args))
171 Lisp_Object args;
172 { 167 {
173 /* This function can GC */ 168 /* This function can GC */
174 struct gcpro gcpro1; 169 struct gcpro gcpro1;
175 GCPRO1 (args); 170 GCPRO1 (args);
176 Vcurrent_prefix_arg = Feval (Fcar (args)); 171 Vcurrent_prefix_arg = Feval (Fcar (args));
177 UNGCPRO; 172 UNGCPRO;
178 return Feval (Fcar (Fcdr (args))); 173 return Feval (Fcar (Fcdr (args)));
179 } 174 }
180 175
181 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, 176 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, 0, UNEVALLED, 0, /*
182 Sml_prefix_argument_loop, 177
183 0, UNEVALLED, 0 /* 178 */
184 179 (args))
185 */ )
186 (args)
187 Lisp_Object args;
188 { 180 {
189 /* This function can GC */ 181 /* This function can GC */
190 Lisp_Object tem; 182 Lisp_Object tem;
191 int i; 183 int i;
192 struct gcpro gcpro1; 184 struct gcpro gcpro1;
212 } 204 }
213 205
214 206
215 #if 0 207 #if 0
216 /* now in lisp code */ 208 /* now in lisp code */
217 DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0 /* 209 DEFUN ("ml-substr", Fml_substr, 3, 3, 0, /*
218 Return a substring of STRING, starting at index FROM and of length LENGTH. 210 Return a substring of STRING, starting at index FROM and of length LENGTH.
219 If either FROM or LENGTH is negative, the length of STRING is added to it. 211 If either FROM or LENGTH is negative, the length of STRING is added to it.
220 */ ) 212 */
221 (string, from, to) 213 (string, from, to))
222 Lisp_Object string, from, to;
223 { 214 {
224 CHECK_STRING (string); 215 CHECK_STRING (string);
225 CHECK_INT (from); 216 CHECK_INT (from);
226 CHECK_INT (to); 217 CHECK_INT (to);
227 218
233 return Fsubstring (string, from, to); 224 return Fsubstring (string, from, to);
234 } 225 }
235 226
236 227
237 /* now in lisp code */ 228 /* now in lisp code */
238 DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0 /* 229 DEFUN ("insert-string", Finsert_string, 0, MANY, 0, /*
239 Mocklisp-compatibility insert function. 230 Mocklisp-compatibility insert function.
240 Like the function `insert' except that any argument that is a number 231 Like the function `insert' except that any argument that is a number
241 is converted into a string by expressing it in decimal. 232 is converted into a string by expressing it in decimal.
242 */ ) 233 */
243 (nargs, args) 234 (int nargs, Lisp_Object *args))
244 int nargs;
245 Lisp_Object *args;
246 { 235 {
247 int argnum; 236 int argnum;
248 Lisp_Object tem; 237 Lisp_Object tem;
249 238
250 for (argnum = 0; argnum < nargs; argnum++) 239 for (argnum = 0; argnum < nargs; argnum++)
275 syms_of_mocklisp (void) 264 syms_of_mocklisp (void)
276 { 265 {
277 defsymbol (&Qmocklisp, "mocklisp"); 266 defsymbol (&Qmocklisp, "mocklisp");
278 defsymbol (&Qmocklisp_arguments, "mocklisp-arguments"); 267 defsymbol (&Qmocklisp_arguments, "mocklisp-arguments");
279 268
280 /*defsubr (&Sml_defun);*/ 269 /*DEFSUBR (Fml_defun);*/
281 defsubr (&Sml_if); 270 DEFSUBR (Fml_if);
282 /*defsubr (&Sml_while);*/ 271 /*DEFSUBR (Fml_while);*/
283 /*defsubr (&Sml_nargs);*/ 272 /*DEFSUBR (Fml_nargs);*/
284 /*defsubr (&Sml_arg);*/ 273 /*DEFSUBR (Fml_arg);*/
285 /*defsubr (&Sml_interactive);*/ 274 /*DEFSUBR (Fml_interactive);*/
286 defsubr (&Sml_provide_prefix_argument); 275 DEFSUBR (Fml_provide_prefix_argument);
287 defsubr (&Sml_prefix_argument_loop); 276 DEFSUBR (Fml_prefix_argument_loop);
288 /*defsubr (&Sml_substr);*/ 277 /*DEFSUBR (Fml_substr);*/
289 /*defsubr (&Sinsert_string);*/ 278 /*DEFSUBR (Finsert_string);*/
290 } 279 }
291 280
292 void 281 void
293 vars_of_mocklisp (void) 282 vars_of_mocklisp (void)
294 { 283 {