Mercurial > emacs
annotate src/mocklisp.c @ 40981:fee88c193206
(Fuser_real_login_name): Reindent.
(Finsert_buffer_substring): Likewise.
(Fcompare_buffer_substrings): Likewise.
(Fsubst_char_in_region): Likewise.
author | Pavel Janík <Pavel@Janik.cz> |
---|---|
date | Tue, 13 Nov 2001 06:58:58 +0000 |
parents | 7e3c616777d3 |
children |
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 | |
40133
471f00614030
(Finsert_string, Fml_if, Fml_provide_prefix_argument)
Miles Bader <miles@gnu.org>
parents:
21588
diff
changeset
|
28 DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0, |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
29 doc: /* Mocklisp version of `if'. |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
30 usage: (ml-if COND THEN ELSE...) */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
31 (args) |
153 | 32 Lisp_Object args; |
33 { | |
34 register Lisp_Object val; | |
35 struct gcpro gcpro1; | |
36 | |
21588
f269d9565635
(Fml_if): Initialize val.
Richard M. Stallman <rms@gnu.org>
parents:
21514
diff
changeset
|
37 val = Qnil; |
153 | 38 GCPRO1 (args); |
484 | 39 while (!NILP (args)) |
153 | 40 { |
41 val = Feval (Fcar (args)); | |
42 args = Fcdr (args); | |
484 | 43 if (NILP (args)) break; |
153 | 44 if (XINT (val)) |
45 { | |
46 val = Feval (Fcar (args)); | |
47 break; | |
48 } | |
49 args = Fcdr (args); | |
50 } | |
51 UNGCPRO; | |
52 return val; | |
53 } | |
54 | |
55 | |
56 /* This is the main entry point to mocklisp execution. | |
40659
7e3c616777d3
(Fml_defun, Fml_while, Fml_substr): Remove commented and #ifdef'd-out code.
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
57 When eval sees a mocklisp function being called, it calls here |
7e3c616777d3
(Fml_defun, Fml_while, Fml_substr): Remove commented and #ifdef'd-out code.
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
58 with the unevaluated argument list. */ |
153 | 59 |
60 Lisp_Object | |
61 ml_apply (function, args) | |
62 Lisp_Object function, args; | |
63 { | |
64 register int count = specpdl_ptr - specpdl; | |
65 register Lisp_Object val; | |
66 | |
67 specbind (Qmocklisp_arguments, args); | |
68 val = Fprogn (Fcdr (function)); | |
69 return unbind_to (count, val); | |
70 } | |
71 | |
72 DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
73 doc: /* Number of arguments to currently executing mocklisp function. */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
74 () |
153 | 75 { |
76 if (EQ (Vmocklisp_arguments, Qinteractive)) | |
77 return make_number (0); | |
78 return Flength (Vmocklisp_arguments); | |
79 } | |
80 | |
81 DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
82 doc: /* Argument number N to currently executing mocklisp function. */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
83 (n, prompt) |
153 | 84 Lisp_Object n, prompt; |
85 { | |
86 if (EQ (Vmocklisp_arguments, Qinteractive)) | |
19550
0e09a1cec19d
(Fml_arg): Call Fread_string with
Kenichi Handa <handa@m17n.org>
parents:
18741
diff
changeset
|
87 return Fread_string (prompt, Qnil, Qnil, Qnil, Qnil); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40565
diff
changeset
|
88 CHECK_NUMBER (n); |
153 | 89 XSETINT (n, XINT (n) - 1); /* Mocklisp likes to be origin-1 */ |
90 return Fcar (Fnthcdr (n, Vmocklisp_arguments)); | |
91 } | |
92 | |
93 DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
94 doc: /* True if currently executing mocklisp function was called interactively. */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
95 () |
153 | 96 { |
97 return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil; | |
98 } | |
99 | |
100 DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
101 2, UNEVALLED, 0, |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
102 doc: /* Evaluate second argument, using first argument as prefix arg value. |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
103 usage: (ml-provide-prefix-argument ARG1 ARG2) */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
104 (args) |
153 | 105 Lisp_Object args; |
106 { | |
107 struct gcpro gcpro1; | |
108 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
|
109 Vcurrent_prefix_arg = Feval (Fcar (args)); |
153 | 110 UNGCPRO; |
111 return Feval (Fcar (Fcdr (args))); | |
112 } | |
113 | |
114 DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop, | |
115 0, UNEVALLED, 0, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
116 doc: /* usage: (ml-prefix-argument-loop ...) */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
117 (args) |
153 | 118 Lisp_Object args; |
119 { | |
120 register Lisp_Object tem; | |
121 register int i; | |
122 struct gcpro gcpro1; | |
123 | |
124 /* 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
|
125 if (NILP (Vcurrent_prefix_arg)) |
153 | 126 i = 1; |
127 else | |
128 { | |
10858
415b568535de
(Fml_provide_prefix_argument, Fml_prefix_argument_loop): Undo Jan 31 change.
Karl Heuer <kwzh@gnu.org>
parents:
10618
diff
changeset
|
129 tem = Vcurrent_prefix_arg; |
153 | 130 if (CONSP (tem)) |
131 tem = Fcar (tem); | |
132 if (EQ (tem, Qminus)) | |
133 i = -1; | |
134 else i = XINT (tem); | |
135 } | |
136 | |
137 GCPRO1 (args); | |
138 while (i-- > 0) | |
139 Fprogn (args); | |
140 UNGCPRO; | |
141 return Qnil; | |
142 } | |
143 | |
144 DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0, | |
40565
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
145 doc: /* Mocklisp-compatibility insert function. |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
146 Like the function `insert' except that any argument that is a number |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
147 is converted into a string by expressing it in decimal. |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
148 usage: (insert-string &rest ARGS) */) |
2320f6ae3370
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40148
diff
changeset
|
149 (nargs, args) |
153 | 150 int nargs; |
151 Lisp_Object *args; | |
152 { | |
153 register int argnum; | |
154 register Lisp_Object tem; | |
155 | |
156 for (argnum = 0; argnum < nargs; argnum++) | |
157 { | |
158 tem = args[argnum]; | |
159 retry: | |
9119
0c3c25c2456e
(Finsert_string): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
160 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
|
161 tem = Fnumber_to_string (tem); |
9119
0c3c25c2456e
(Finsert_string): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
4696
diff
changeset
|
162 if (STRINGP (tem)) |
153 | 163 insert1 (tem); |
164 else | |
165 { | |
166 tem = wrong_type_argument (Qstringp, tem); | |
167 goto retry; | |
168 } | |
169 } | |
295 | 170 |
153 | 171 return Qnil; |
172 } | |
173 | |
174 | |
21514 | 175 void |
153 | 176 syms_of_mocklisp () |
177 { | |
178 Qmocklisp = intern ("mocklisp"); | |
179 staticpro (&Qmocklisp); | |
180 | |
181 defsubr (&Sml_if); | |
182 defsubr (&Sml_arg); | |
183 defsubr (&Sml_nargs); | |
184 defsubr (&Sml_interactive); | |
185 defsubr (&Sml_provide_prefix_argument); | |
186 defsubr (&Sml_prefix_argument_loop); | |
187 defsubr (&Sinsert_string); | |
188 } |