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