1 /*** dynacat.c -- dynamic categories (`types' on top of types) for SXEmacs
3 * Copyright (C) 2005-2008 Sebastian Freundt <hroptatyr@sxemacs.org>
6 * This file is part of SXEmacs.
8 * Redistribution and use in source and binary forms, with or without
9 * modification, are permitted provided that the following conditions
12 * 1. Redistributions of source code must retain the above copyright
13 * notice, this list of conditions and the following disclaimer.
15 * 2. Redistributions in binary form must reproduce the above copyright
16 * notice, this list of conditions and the following disclaimer in the
17 * documentation and/or other materials provided with the distribution.
19 * 3. Neither the name of the author nor the names of any contributors
20 * may be used to endorse or promote products derived from this
21 * software without specific prior written permission.
23 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
24 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
27 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
28 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
29 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
30 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
32 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
33 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35 * Alternatively, for testing purposes, this file can be redistributed under
36 * the following licence:
37 * You can do whatever the fuck you want with this, except stop anyone else
38 * doing whatever the fuck they want.
46 #define __DYNACAT_DEBUG__(args...) fprintf(stderr, "DYNACAT " args)
47 #ifndef DYNACAT_DEBUG_FLAG
48 #define DYNACAT_DEBUG(args...)
50 #define DYNACAT_DEBUG(args...) __DYNACAT_DEBUG__(args)
53 Lisp_Object Qdynacatp, Qdynacat;
56 mark_dynacat(Lisp_Object obj)
58 dynacat_t emp = XDYNACAT(obj);
59 mark_object(emp->type);
60 mark_object(emp->plist);
69 print_dynacat(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
71 /* This function can GC */
72 dynacat_t emp = XDYNACAT(obj);
75 emp->prfun(obj, printcharfun, escapeflag);
79 write_c_string("#<dynacat object", printcharfun);
80 if (!NILP(emp->type)) {
81 write_c_string(" :type ", printcharfun);
82 print_internal(emp->type, printcharfun, escapeflag);
84 write_c_string(">", printcharfun);
88 finalise_dynacat(void *unused, int for_disksave)
92 "Can't dump an emacs containing "
93 "dynacat objects", Qt);
98 dynacat_fini(dynacat_t emp)
100 DYNACAT_DEBUG(stderr, "#emdptr:0x%016lx@0x%016lx will pass away\n",
101 (long unsigned int)emp->ptr, (long unsigned int)emp);
103 emp->finfun(wrap_object(emp), 0);
116 dynacat_getprop(Lisp_Object obj, Lisp_Object property)
118 return external_plist_get(&XDYNACAT_PLIST(obj), property, 0, ERROR_ME);
122 dynacat_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
124 external_plist_put(&XDYNACAT_PLIST(obj), property, value, 0, ERROR_ME);
129 dynacat_remprop(Lisp_Object obj, Lisp_Object property)
131 return external_remprop(&XDYNACAT_PLIST(obj), property, 0, ERROR_ME);
134 DEFUN("dynacat-plist", Fdynacat_plist, 1, 1, 0, /*
135 Return the property list of DYNACAT.
139 CHECK_DYNACAT(dynacat);
140 return XDYNACAT_PLIST(dynacat);
143 static const struct lrecord_description dynacat_description[] = {
144 {XD_LISP_OBJECT, offsetof(struct dynacat_s, type)},
145 {XD_LISP_OBJECT, offsetof(struct dynacat_s, plist)},
146 {XD_OPAQUE_DATA_PTR, offsetof(struct dynacat_s, ptr)},
147 {XD_OPAQUE_DATA_PTR, offsetof(struct dynacat_s, mrkfun)},
148 {XD_OPAQUE_DATA_PTR, offsetof(struct dynacat_s, finfun)},
149 {XD_OPAQUE_DATA_PTR, offsetof(struct dynacat_s, prfun)},
150 {XD_OPAQUE_DATA_PTR, offsetof(struct dynacat_s, intprfun)},
154 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(
156 mark_dynacat, print_dynacat, finalise_dynacat,
159 dynacat_getprop, dynacat_putprop, dynacat_remprop, Fdynacat_plist,
163 inline static dynacat_t
164 allocate_dynacat(void)
166 dynacat_t emp = alloc_lcrecord_type(struct dynacat_s, &lrecord_dynacat);
171 make_dynacat(void *ptr)
173 dynacat_t emp = allocate_dynacat();
177 emp->intprfun = NULL;
184 XSETDYNACAT(result, emp);
190 DEFUN("dynacatp", Fdynacatp, 1, 1, 0, /*
191 Return non-nil if OBJECT is an opaque emodule pointer.
195 if (DYNACATP(object))
202 void syms_of_dynacat(void)
204 INIT_LRECORD_IMPLEMENTATION(dynacat);
206 DEFSYMBOL(Qdynacatp);
210 DEFSUBR(Fdynacat_plist);
213 void reinit_vars_of_dynacat(void)
217 void vars_of_dynacat(void)
219 reinit_vars_of_dynacat();
220 Fprovide(intern("dynacat"));
223 /* dynacat.c ends here */