Mercurial > emacs
annotate src/mocklisp.c @ 40153:ccd2ee0384ff
Fix formatting for new function.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Sun, 21 Oct 2001 18:35:35 +0000 |
parents | e6c3a4ad65ce |
children | 2320f6ae3370 |
rev | line source |
---|---|
153 | 1 /* Mocklisp compatibility functions for GNU Emacs Lisp interpreter. |
10618
e6c31b26a1b5
(Fml_provide_prefix_argument, Fml_prefix_argument_loop): Use perdisplay.
Karl Heuer <kwzh@gnu.org>
parents:
9119
diff
changeset
|
2 Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc. |
153 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
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 | |
12244 | 8 the Free Software Foundation; either version 2, or (at your option) |
153 | 9 any later version. |
10 | |
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. | |
15 | |
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 | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
12244
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
12244
diff
changeset
|
19 Boston, MA 02111-1307, USA. */ |
153 | 20 |
21 | |
22 /* Compatibility for mocklisp */ | |
23 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
2429
diff
changeset
|
24 #include <config.h> |
153 | 25 #include "lisp.h" |
26 #include "buffer.h" | |
27 | |
28 /* Now in lisp code ("macrocode...") | |
29 * DEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0, | |
30 * "Define mocklisp functions") | |
31 * (args) | |
32 * Lisp_Object args; | |
33 * { | |
34 * Lisp_Object elt; | |
35 * | |
484 | 36 * while (!NILP (args)) |
153 | 37 * { |
38 * elt = Fcar (args); | |
39 * Ffset (Fcar (elt), Fcons (Qmocklisp, Fcdr (elt))); | |
40 * args = Fcdr (args); | |
41 * } | |
42 * return Qnil; | |
43 * } | |
44 */ | |
45 | |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
46 DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0, |
40148
e6c3a4ad65ce
(Fml_if, Fml_provide_prefix_argument)
Eli Zaretskii <eliz@gnu.org>
parents:
40133
diff
changeset
|
47 "Mocklisp version of `if'.\n\ |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
48 usage: (ml-if COND THEN ELSE...)") |
153 | 49 (args) |
50 Lisp_Object args; | |
51 { | |
52 register Lisp_Object val; | |
53 struct gcpro gcpro1; | |
54 | |
21588
f269d9565635
(Fml_if): Initialize val.
Richard M. Stallman <rms@gnu.org>
parents:
21514
diff
changeset
|
55 val = Qnil; |
153 | 56 GCPRO1 (args); |
484 | 57 while (!NILP (args)) |
153 | 58 { |
59 val = Feval (Fcar (args)); | |
60 args = Fcdr (args); | |
484 | 61 if (NILP (args)) break; |
153 | 62 if (XINT (val)) |
63 { | |
64 val = Feval (Fcar (args)); | |
65 break; | |
66 } | |
67 args = Fcdr (args); | |
68 } | |
69 UNGCPRO; | |
70 return val; | |
71 } | |
72 | |
20392
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
73 #if 0 /* Now converted to regular "while" by hairier conversion code. */ |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
74 /**/DEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0, "while for mocklisp programs") |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
75 (args) |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
76 Lisp_Object args; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
77 { |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
78 Lisp_Object test, body, tem; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
79 struct gcpro gcpro1, gcpro2; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
80 |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
81 GCPRO2 (test, body); |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
82 |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
83 test = Fcar (args); |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
84 body = Fcdr (args); |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
85 while (tem = Feval (test), XINT (tem)) |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
86 { |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
87 QUIT; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
88 Fprogn (body); |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
89 } |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
90 |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
91 UNGCPRO; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
92 return Qnil; |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
93 } |
19ffabe93a2d
Fix comment (avoid spurious "unterminated comment" warning)
Karl Heuer <kwzh@gnu.org>
parents:
19550
diff
changeset
|
94 #endif |
153 | 95 |
96 /* This is the main entry point to mocklisp execution. | |
97 When eval sees a mocklisp function being called, it calls here | |
98 with the unevaluated argument list */ | |
99 | |
100 Lisp_Object | |
101 ml_apply (function, args) | |
102 Lisp_Object function, args; | |
103 { | |
104 register int count = specpdl_ptr - specpdl; | |
105 register Lisp_Object val; | |
106 | |
107 specbind (Qmocklisp_arguments, args); | |
108 val = Fprogn (Fcdr (function)); | |
109 return unbind_to (count, val); | |
110 } | |
111 | |
112 DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0, | |
113 "Number of arguments to currently executing mocklisp function.") | |
114 () | |
115 { | |
116 if (EQ (Vmocklisp_arguments, Qinteractive)) | |
117 return make_number (0); | |
118 return Flength (Vmocklisp_arguments); | |
119 } | |
120 | |
121 DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0, | |
122 "Argument number N to currently executing mocklisp function.") | |
123 (n, prompt) | |
124 Lisp_Object n, prompt; | |
125 { | |
126 if (EQ (Vmocklisp_arguments, Qinteractive)) | |
19550
0e09a1cec19d
(Fml_arg): Call Fread_string with
Kenichi Handa <handa@m17n.org>
parents:
18741
diff
changeset
|
127 return Fread_string (prompt, Qnil, Qnil, Qnil, Qnil); |
153 | 128 CHECK_NUMBER (n, 0); |
129 XSETINT (n, XINT (n) - 1); /* Mocklisp likes to be origin-1 */ | |
130 return Fcar (Fnthcdr (n, Vmocklisp_arguments)); | |
131 } | |
132 | |
133 DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0, | |
134 "True if currently executing mocklisp function was called interactively.") | |
135 () | |
136 { | |
137 return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil; | |
138 } | |
139 | |
140 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, | |
141 2, UNEVALLED, 0, | |
40148
e6c3a4ad65ce
(Fml_if, Fml_provide_prefix_argument)
Eli Zaretskii <eliz@gnu.org>
parents:
40133
diff
changeset
|
142 "Evaluate second argument, using first argument as prefix arg value.\n\ |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
143 usage: (ml-provide-prefix-argument ARG1 ARG2)") |
153 | 144 (args) |
145 Lisp_Object args; | |
146 { | |
147 struct gcpro gcpro1; | |
148 GCPRO1 (args); | |
10858
415b568535de
(Fml_provide_prefix_argument, Fml_prefix_argument_loop): Undo Jan 31 change.
Karl Heuer <kwzh@gnu.org>
parents:
10618
diff
changeset
|
149 Vcurrent_prefix_arg = Feval (Fcar (args)); |
153 | 150 UNGCPRO; |
151 return Feval (Fcar (Fcdr (args))); | |
152 } | |
153 | |
154 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop, | |
155 0, UNEVALLED, 0, | |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
156 "usage: (ml-prefix-argument-loop ...)") |
153 | 157 (args) |
158 Lisp_Object args; | |
159 { | |
160 register Lisp_Object tem; | |
161 register int i; | |
162 struct gcpro gcpro1; | |
163 | |
164 /* Set `arg' in case we call a built-in function that looks at it. Still are a few. */ | |
10858
415b568535de
(Fml_provide_prefix_argument, Fml_prefix_argument_loop): Undo Jan 31 change.
Karl Heuer <kwzh@gnu.org>
parents:
10618
diff
changeset
|
165 if (NILP (Vcurrent_prefix_arg)) |
153 | 166 i = 1; |
167 else | |
168 { | |
10858
415b568535de
(Fml_provide_prefix_argument, Fml_prefix_argument_loop): Undo Jan 31 change.
Karl Heuer <kwzh@gnu.org>
parents:
10618
diff
changeset
|
169 tem = Vcurrent_prefix_arg; |
153 | 170 if (CONSP (tem)) |
171 tem = Fcar (tem); | |
172 if (EQ (tem, Qminus)) | |
173 i = -1; | |
174 else i = XINT (tem); | |
175 } | |
176 | |
177 GCPRO1 (args); | |
178 while (i-- > 0) | |
179 Fprogn (args); | |
180 UNGCPRO; | |
181 return Qnil; | |
182 } | |
183 | |
184 #if 0 /* Now in mlsupport.el */ | |
185 | |
186 DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0, | |
187 "Return a substring of STRING, starting at index FROM and of length LENGTH.\n\ | |
188 If either FROM or LENGTH is negative, the length of STRING is added to it.") | |
189 (string, from, to) | |
190 Lisp_Object string, from, to; | |
191 { | |
192 CHECK_STRING (string, 0); | |
193 CHECK_NUMBER (from, 1); | |
194 CHECK_NUMBER (to, 2); | |
195 | |
196 if (XINT (from) < 0) | |
197 XSETINT (from, XINT (from) + XSTRING (string)->size); | |
198 if (XINT (to) < 0) | |
199 XSETINT (to, XINT (to) + XSTRING (string)->size); | |
200 XSETINT (to, XINT (to) + XINT (from)); | |
201 return Fsubstring (string, from, to); | |
202 } | |
1011
a7f08730f7ae
* mocklisp.c (Fml_substr): Put comments around text following #endif.
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
203 #endif /* 0 */ |
153 | 204 DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0, |
205 "Mocklisp-compatibility insert function.\n\ | |
206 Like the function `insert' except that any argument that is a number\n\ | |
40148
e6c3a4ad65ce
(Fml_if, Fml_provide_prefix_argument)
Eli Zaretskii <eliz@gnu.org>
parents:
40133
diff
changeset
|
207 is converted into a string by expressing it in decimal.\n\ |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
208 usage: (insert-string &rest ARGS)") |
153 | 209 (nargs, args) |
210 int nargs; | |
211 Lisp_Object *args; | |
212 { | |
213 register int argnum; | |
214 register Lisp_Object tem; | |
215 | |
216 for (argnum = 0; argnum < nargs; argnum++) | |
217 { | |
218 tem = args[argnum]; | |
219 retry: | |
9119
0c3c25c2456e
(Finsert_string): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
220 if (INTEGERP (tem)) |
2429
96b55f2f19cd
Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents:
1011
diff
changeset
|
221 tem = Fnumber_to_string (tem); |
9119
0c3c25c2456e
(Finsert_string): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
222 if (STRINGP (tem)) |
153 | 223 insert1 (tem); |
224 else | |
225 { | |
226 tem = wrong_type_argument (Qstringp, tem); | |
227 goto retry; | |
228 } | |
229 } | |
295 | 230 |
153 | 231 return Qnil; |
232 } | |
233 | |
234 | |
21514 | 235 void |
153 | 236 syms_of_mocklisp () |
237 { | |
238 Qmocklisp = intern ("mocklisp"); | |
239 staticpro (&Qmocklisp); | |
240 | |
241 /*defsubr (&Sml_defun);*/ | |
242 defsubr (&Sml_if); | |
243 /*defsubr (&Sml_while);*/ | |
244 defsubr (&Sml_arg); | |
245 defsubr (&Sml_nargs); | |
246 defsubr (&Sml_interactive); | |
247 defsubr (&Sml_provide_prefix_argument); | |
248 defsubr (&Sml_prefix_argument_loop); | |
249 /*defsubr (&Sml_substr);*/ | |
250 defsubr (&Sinsert_string); | |
251 } |