aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPavel Janík2001-12-22 14:13:11 +0000
committerPavel Janík2001-12-22 14:13:11 +0000
commite32abc829f0d236139942e41da64091c86a193a3 (patch)
treed39a9fa2a7ab0fe44132af9a8c8dbc176614ec74 /src
parent44eec52586a0679e8de0bcb49b4361f16041dd58 (diff)
downloademacs-e32abc829f0d236139942e41da64091c86a193a3.tar.gz
emacs-e32abc829f0d236139942e41da64091c86a193a3.zip
Files removed.
Diffstat (limited to 'src')
-rw-r--r--src/mocklisp.c188
-rw-r--r--src/mocklisp.h28
2 files changed, 0 insertions, 216 deletions
diff --git a/src/mocklisp.c b/src/mocklisp.c
deleted file mode 100644
index be98692c423..00000000000
--- a/src/mocklisp.c
+++ /dev/null
@@ -1,188 +0,0 @@
1/* Mocklisp compatibility functions for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
20
21
22/* Compatibility for mocklisp */
23
24#include <config.h>
25#include "lisp.h"
26#include "buffer.h"
27
28DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0,
29 doc: /* Mocklisp version of `if'.
30usage: (ml-if COND THEN ELSE...) */)
31 (args)
32 Lisp_Object args;
33{
34 register Lisp_Object val;
35 struct gcpro gcpro1;
36
37 val = Qnil;
38 GCPRO1 (args);
39 while (!NILP (args))
40 {
41 val = Feval (Fcar (args));
42 args = Fcdr (args);
43 if (NILP (args)) break;
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.
57 When eval sees a mocklisp function being called, it calls here
58 with the unevaluated argument list. */
59
60Lisp_Object
61ml_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
72DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0,
73 doc: /* Number of arguments to currently executing mocklisp function. */)
74 ()
75{
76 if (EQ (Vmocklisp_arguments, Qinteractive))
77 return make_number (0);
78 return Flength (Vmocklisp_arguments);
79}
80
81DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0,
82 doc: /* Argument number N to currently executing mocklisp function. */)
83 (n, prompt)
84 Lisp_Object n, prompt;
85{
86 if (EQ (Vmocklisp_arguments, Qinteractive))
87 return Fread_string (prompt, Qnil, Qnil, Qnil, Qnil);
88 CHECK_NUMBER (n);
89 XSETINT (n, XINT (n) - 1); /* Mocklisp likes to be origin-1 */
90 return Fcar (Fnthcdr (n, Vmocklisp_arguments));
91}
92
93DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0,
94 doc: /* True if currently executing mocklisp function was called interactively. */)
95 ()
96{
97 return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil;
98}
99
100DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument,
101 2, UNEVALLED, 0,
102 doc: /* Evaluate second argument, using first argument as prefix arg value.
103usage: (ml-provide-prefix-argument ARG1 ARG2) */)
104 (args)
105 Lisp_Object args;
106{
107 struct gcpro gcpro1;
108 GCPRO1 (args);
109 Vcurrent_prefix_arg = Feval (Fcar (args));
110 UNGCPRO;
111 return Feval (Fcar (Fcdr (args)));
112}
113
114DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop,
115 0, UNEVALLED, 0,
116 doc: /* usage: (ml-prefix-argument-loop ...) */)
117 (args)
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. */
125 if (NILP (Vcurrent_prefix_arg))
126 i = 1;
127 else
128 {
129 tem = Vcurrent_prefix_arg;
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
144DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0,
145 doc: /* Mocklisp-compatibility insert function.
146Like the function `insert' except that any argument that is a number
147is converted into a string by expressing it in decimal.
148usage: (insert-string &rest ARGS) */)
149 (nargs, args)
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:
160 if (INTEGERP (tem))
161 tem = Fnumber_to_string (tem);
162 if (STRINGP (tem))
163 insert1 (tem);
164 else
165 {
166 tem = wrong_type_argument (Qstringp, tem);
167 goto retry;
168 }
169 }
170
171 return Qnil;
172}
173
174
175void
176syms_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}
diff --git a/src/mocklisp.h b/src/mocklisp.h
deleted file mode 100644
index 0675415a33e..00000000000
--- a/src/mocklisp.h
+++ /dev/null
@@ -1,28 +0,0 @@
1/* Fundamental definitions for emulating mocklisp.
2 Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
20
21extern Lisp_Object ml_apply ();
22extern Lisp_Object Fml_if ();
23extern Lisp_Object Fml_nargs ();
24extern Lisp_Object Fml_arg ();
25extern Lisp_Object Fml_interactive ();
26extern Lisp_Object Fml_provide_prefix_argument ();
27extern Lisp_Object Fml_prefix_argument_loop ();
28extern Lisp_Object Finsert_string ();