2
* Copyright (c) 2001 by The XFree86 Project, Inc.
4
* Permission is hereby granted, free of charge, to any person obtaining a
5
* copy of this software and associated documentation files (the "Software"),
6
* to deal in the Software without restriction, including without limitation
7
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
8
* and/or sell copies of the Software, and to permit persons to whom the
9
* Software is furnished to do so, subject to the following conditions:
11
* The above copyright notice and this permission notice shall be included in
12
* all copies or substantial portions of the Software.
14
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
17
* THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18
* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19
* OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
22
* Except as contained in this notice, the name of the XFree86 Project shall
23
* not be used in advertising or otherwise to promote the sale, use or other
24
* dealings in this Software without prior written authorization from the
27
* Author: Paulo César Pereira de Andrade
30
/* $XFree86: xc/programs/xedit/lisp/struct.c,v 1.22tsi Exp $ */
32
#include "lisp/struct.h"
37
static LispObj *LispStructAccessOrStore(LispBuiltin*, int);
42
LispObj *Omake_struct, *Ostruct_access, *Ostruct_store, *Ostruct_type;
44
Atom_id Smake_struct, Sstruct_access, Sstruct_store, Sstruct_type;
50
Lisp_Defstruct(LispBuiltin *builtin)
52
defstruct name &rest description
57
int i, size, length, slength;
58
char *name, *strname, *sname;
59
LispObj *list, *cons, *object, *definition, *documentation;
61
LispObj *oname, *description;
63
description = ARGUMENT(1);
68
strname = ATOMID(oname);
69
length = strlen(strname);
73
name = LispMalloc(size);
75
sprintf(name, "MAKE-%s", strname);
76
atom = (object = ATOM(name))->data.atom;
79
LispDestroy("%s: %s cannot be a structure name",
80
STRFUN(builtin), STROBJ(oname));
84
if (CONSP(description) && STRINGP(CAR(description))) {
85
documentation = CAR(description);
86
description = CDR(description);
91
/* get structure fields and default values */
92
for (list = description; CONSP(list); list = CDR(list)) {
97
if ((CONSP(CDR(object)) && CDR(CDR(object)) != NIL) ||
98
(!CONSP(CDR(object)) && CDR(object) != NIL))
99
LispDestroy("%s: bad initialization %s",
100
STRFUN(builtin), STROBJ(object));
102
object = CAR(object);
104
if (!SYMBOLP(object) || strcmp(ATOMID(object), "P") == 0)
105
/* p is invalid as a field name due to `type'-p */
106
LispDestroy("%s: %s cannot be a field for %s",
107
STRFUN(builtin), STROBJ(object), ATOMID(oname));
109
if (!KEYWORDP(object))
110
CAR(cons) = KEYWORD(ATOMID(object));
112
/* check for repeated field names */
113
for (object = description; object != list; object = CDR(object)) {
114
LispObj *left = CAR(object), *right = CAR(list);
121
if (ATOMID(left) == ATOMID(right))
122
LispDestroy("%s: only one slot named %s allowed",
123
STRFUN(builtin), STROBJ(left));
127
/* atom should not have been modified */
128
definition = CONS(oname, description);
129
LispSetAtomStructProperty(atom, definition, STRUCT_CONSTRUCTOR);
131
LispExportSymbol(object);
133
atom = oname->data.atom;
134
if (atom->a_defstruct)
135
LispWarning("%s: structure %s is being redefined",
136
STRFUN(builtin), strname);
137
LispSetAtomStructProperty(atom, definition, STRUCT_NAME);
139
sprintf(name, "%s-P", strname);
140
atom = (object = ATOM(name))->data.atom;
141
LispSetAtomStructProperty(atom, definition, STRUCT_CHECK);
143
LispExportSymbol(object);
145
for (i = 0, list = description; CONSP(list); i++, list = CDR(list)) {
146
if (CONSP(CAR(list)))
147
sname = ATOMID(CAR(CAR(list)));
149
sname = ATOMID(CAR(list));
150
slength = strlen(sname);
151
if (length + slength + 2 > size) {
152
size = length + slength + 2;
153
name = LispRealloc(name, size);
155
sprintf(name, "%s-%s", strname, sname);
156
atom = (object = ATOM(name))->data.atom;
157
LispSetAtomStructProperty(atom, definition, i);
159
LispExportSymbol(object);
164
if (documentation != NIL)
165
LispAddDocumentation(oname, documentation, LispDocStructure);
171
* DONT explicitly call them. Non standard functions.
174
Lisp_XeditMakeStruct(LispBuiltin *builtin)
176
lisp::make-struct atom &rest init
179
int nfld, ncvt, length = lisp__data.protect.length;
180
LispAtom *atom = NULL;
182
LispObj *definition, *object, *field, *fields, *value = NIL, *cons, *list;
183
LispObj *struc, *init;
189
if (!POINTERP(struc) ||
190
!(XSYMBOLP(struc) || XFUNCTIONP(struc)) ||
191
(atom = struc->data.atom)->a_defstruct == 0 ||
192
atom->property->structure.function != STRUCT_CONSTRUCTOR)
193
LispDestroy("%s: invalid constructor %s",
194
STRFUN(builtin), STROBJ(struc));
195
definition = atom->property->structure.definition;
200
/* check for errors in argument list */
201
for (list = init, nfld = 0; CONSP(list); list = CDR(list)) {
202
CHECK_KEYWORD(CAR(list));
203
if (!CONSP(CDR(list)))
204
LispDestroy("%s: values must be provided as pairs",
210
/* create structure, CAR(definition) is structure name */
211
for (list = CDR(definition); CONSP(list); list = CDR(list)) {
213
LispObj *defvalue = NIL;
218
/* if default value provided */
219
if (CONSP(CDR(field)))
220
defvalue = CAR(CDR(field));
225
for (object = init; CONSP(object); object = CDR(object)) {
226
/* field is a keyword, test above checked it */
228
if (id == ATOMID(field)) {
230
value = CAR(CDR(object));
234
object = CDR(object);
237
/* if no initialization given */
238
if (!CONSP(object)) {
239
/* if default value in structure definition */
241
value = EVAL(defvalue);
247
fields = cons = CONS(value, NIL);
248
if (length + 1 >= lisp__data.protect.space)
250
lisp__data.protect.objects[lisp__data.protect.length++] = fields;
253
RPLACD(cons, CONS(value, NIL));
258
/* if not enough arguments were converted, need to check because
259
* it is acceptable to set a field more than once, but in that case,
260
* only the first value will be used. */
262
for (list = init; CONSP(list); list = CDR(list)) {
263
Atom_id id = ATOMID(CAR(list));
265
for (object = CDR(definition); CONSP(object);
266
object = CDR(object)) {
270
if (ATOMID(field) == id)
274
LispDestroy("%s: %s is not a field for %s",
275
ATOMID(struc), STROBJ(CAR(list)),
276
ATOMID(CAR(definition)));
281
lisp__data.protect.length = length;
283
return (STRUCT(fields, definition));
287
LispStructAccessOrStore(LispBuiltin *builtin, int store)
289
lisp::struct-access atom struct
290
lisp::struct-store atom struct value
295
LispObj *definition, *list;
297
LispObj *name, *struc, *value = NIL;
304
if (!POINTERP(name) ||
305
!(XSYMBOLP(name) || XFUNCTIONP(name)) ||
306
(atom = name->data.atom)->a_defstruct == 0 ||
307
(offset = atom->property->structure.function) < 0) {
308
LispDestroy("%s: invalid argument %s",
309
STRFUN(builtin), STROBJ(name));
314
definition = atom->property->structure.definition;
316
/* check if the object is of the required type */
317
if (!STRUCTP(struc) || struc->data.struc.def != definition)
318
LispDestroy("%s: %s is not a %s",
319
ATOMID(name), STROBJ(struc), ATOMID(CAR(definition)));
321
for (list = struc->data.struc.fields; offset; list = CDR(list), offset--)
324
return (store ? RPLACA(list, value) : CAR(list));
328
Lisp_XeditStructAccess(LispBuiltin *builtin)
330
lisp::struct-access atom struct
333
return (LispStructAccessOrStore(builtin, 0));
337
Lisp_XeditStructStore(LispBuiltin *builtin)
339
lisp::struct-store atom struct value
342
return (LispStructAccessOrStore(builtin, 1));
346
Lisp_XeditStructType(LispBuiltin *builtin)
348
lisp::struct-type atom struct
351
LispAtom *atom = NULL;
353
LispObj *definition, *struc, *name;
358
if (!POINTERP(name) ||
359
!(XSYMBOLP(name) || XFUNCTIONP(name)) ||
360
(atom = name->data.atom)->a_defstruct == 0 ||
361
(atom->property->structure.function != STRUCT_CHECK))
362
LispDestroy("%s: invalid argument %s",
363
STRFUN(builtin), STROBJ(name));
364
definition = atom->property->structure.definition;
366
/* check if the object is of the required type */
367
if (STRUCTP(struc) && struc->data.struc.def == definition)
added
removed
xedit/lisp/struct.c
