Mercurial > hg > xemacs-beta

comparison src/objects.c @ 5128:7be849cb8828 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 02:09:59 -0600
parents a9c41067dd88 5502045ec510
children f965e31a35f0
comparison
equal deleted inserted replaced
5127:a9c41067dd88 5128:7be849cb8828
1 /* Generic Objects and Functions. 1 /* Generic Objects and Functions.
2 Copyright (C) 1995 Free Software Foundation, Inc. 2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing. 4 Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
5 Copyright (C) 2010 Didier Verna
5 6
6 This file is part of XEmacs. 7 This file is part of XEmacs.
7 8
8 XEmacs is free software; you can redistribute it and/or modify it 9 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 10 under the terms of the GNU General Public License as published by the
1208 { 1209 {
1209 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; 1210 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
1210 } 1211 }
1211 1212
1212 1213
1214 /*****************************************************************************
1215 Face Background Placement Object
1216 ****************************************************************************/
1217 Lisp_Object Qabsolute, Qrelative;
1218
1219 static const struct memory_description
1220 face_background_placement_specifier_description[] = {
1221 { XD_LISP_OBJECT, offsetof (struct face_background_placement_specifier,
1222 face) },
1223 { XD_END }
1224 };
1225
1226 DEFINE_SPECIFIER_TYPE_WITH_DATA (face_background_placement);
1227 Lisp_Object Qface_background_placement;
1228
1229 static void
1230 face_background_placement_create (Lisp_Object obj)
1231 {
1232 Lisp_Specifier *face_background_placement
1233 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1234
1235 FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = Qnil;
1236 }
1237
1238 static void
1239 face_background_placement_mark (Lisp_Object obj)
1240 {
1241 Lisp_Specifier *face_background_placement
1242 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1243
1244 mark_object
1245 (FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement));
1246 }
1247
1248 /* No equal or hash methods; ignore the face the background-placement is based
1249 off of for `equal' */
1250
1251 extern Lisp_Object Qbackground_placement;
1252
1253 static Lisp_Object
1254 face_background_placement_instantiate (Lisp_Object UNUSED (specifier),
1255 Lisp_Object UNUSED (matchspec),
1256 Lisp_Object domain,
1257 Lisp_Object instantiator,
1258 Lisp_Object depth,
1259 int no_fallback)
1260 {
1261 /* When called, we're inside of call_with_suspended_errors(),
1262 so we can freely error. */
1263 if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
1264 return instantiator;
1265 else if (VECTORP (instantiator))
1266 {
1267 assert (XVECTOR_LENGTH (instantiator) == 1);
1268
1269 return FACE_PROPERTY_INSTANCE_1
1270 (Fget_face (XVECTOR_DATA (instantiator)[0]),
1271 Qbackground_placement, domain, ERROR_ME, no_fallback, depth);
1272 }
1273 else
1274 ABORT (); /* Eh? */
1275
1276 return Qunbound;
1277 }
1278
1279 static void
1280 face_background_placement_validate (Lisp_Object instantiator)
1281 {
1282 if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
1283 return;
1284 else if (VECTORP (instantiator) &&
1285 (XVECTOR_LENGTH (instantiator) == 1))
1286 {
1287 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
1288
1289 Fget_face (face); /* just to check that the face exists -- dvl */
1290 }
1291 else if (VECTORP (instantiator))
1292 sferror ("Wrong length for background-placement inheritance spec",
1293 instantiator);
1294 else
1295 invalid_argument
1296 ("\
1297 Background-placement instantiator must be absolute, relative or vector",
1298 instantiator);
1299 }
1300
1301 static void
1302 face_background_placement_after_change (Lisp_Object specifier,
1303 Lisp_Object locale)
1304 {
1305 Lisp_Object face
1306 = FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE
1307 (XFACE_BACKGROUND_PLACEMENT_SPECIFIER (specifier));
1308
1309 if (!NILP (face))
1310 {
1311 face_property_was_changed (face, Qbackground_placement, locale);
1312 if (BUFFERP (locale))
1313 XBUFFER (locale)->buffer_local_face_property = 1;
1314 }
1315 }
1316
1317 void
1318 set_face_background_placement_attached_to (Lisp_Object obj, Lisp_Object face)
1319 {
1320 Lisp_Specifier *face_background_placement
1321 = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
1322
1323 FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = face;
1324 }
1325
1326 DEFUN ("face-background-placement-specifier-p", Fface_background_placement_specifier_p, 1, 1, 0, /*
1327 Return non-nil if OBJECT is a face-background-placement specifier.
1328
1329 See `make-face-background-placement-specifier' for a description of possible
1330 face-background-placement instantiators.
1331 */
1332 (object))
1333 {
1334 return FACE_BACKGROUND_PLACEMENT_SPECIFIERP (object) ? Qt : Qnil;
1335 }
1336
1337
1213 /************************************************************************/ 1338 /************************************************************************/
1214 /* initialization */ 1339 /* initialization */
1215 /************************************************************************/ 1340 /************************************************************************/
1216 1341
1217 void 1342 void
1221 INIT_LISP_OBJECT (font_instance); 1346 INIT_LISP_OBJECT (font_instance);
1222 1347
1223 DEFSUBR (Fcolor_specifier_p); 1348 DEFSUBR (Fcolor_specifier_p);
1224 DEFSUBR (Ffont_specifier_p); 1349 DEFSUBR (Ffont_specifier_p);
1225 DEFSUBR (Fface_boolean_specifier_p); 1350 DEFSUBR (Fface_boolean_specifier_p);
1351 DEFSUBR (Fface_background_placement_specifier_p);
1226 1352
1227 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep); 1353 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
1228 DEFSUBR (Fmake_color_instance); 1354 DEFSUBR (Fmake_color_instance);
1229 DEFSUBR (Fcolor_instance_p); 1355 DEFSUBR (Fcolor_instance_p);
1230 DEFSUBR (Fcolor_instance_name); 1356 DEFSUBR (Fcolor_instance_name);
1245 DEFSUBR (Ffont_instance_properties); 1371 DEFSUBR (Ffont_instance_properties);
1246 DEFSUBR (Ffont_list); 1372 DEFSUBR (Ffont_list);
1247 1373
1248 /* Qcolor, Qfont defined in general.c */ 1374 /* Qcolor, Qfont defined in general.c */
1249 DEFSYMBOL (Qface_boolean); 1375 DEFSYMBOL (Qface_boolean);
1376
1377 DEFSYMBOL (Qface_background_placement);
1378 DEFSYMBOL (Qabsolute);
1379 DEFSYMBOL (Qrelative);
1250 } 1380 }
1251 1381
1252 void 1382 void
1253 specifier_type_create_objects (void) 1383 specifier_type_create_objects (void)
1254 { 1384 {
1255 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); 1385 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
1256 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); 1386 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
1257 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean", 1387 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
1258 "face-boolean-specifier-p"); 1388 "face-boolean-specifier-p");
1389 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_background_placement,
1390 "face-background-placement",
1391 "\
1392 face-background-placement-specifier-p");
1259 1393
1260 SPECIFIER_HAS_METHOD (color, instantiate); 1394 SPECIFIER_HAS_METHOD (color, instantiate);
1261 SPECIFIER_HAS_METHOD (font, instantiate); 1395 SPECIFIER_HAS_METHOD (font, instantiate);
1262 SPECIFIER_HAS_METHOD (face_boolean, instantiate); 1396 SPECIFIER_HAS_METHOD (face_boolean, instantiate);
1397 SPECIFIER_HAS_METHOD (face_background_placement, instantiate);
1263 1398
1264 SPECIFIER_HAS_METHOD (color, validate); 1399 SPECIFIER_HAS_METHOD (color, validate);
1265 SPECIFIER_HAS_METHOD (font, validate); 1400 SPECIFIER_HAS_METHOD (font, validate);
1266 SPECIFIER_HAS_METHOD (face_boolean, validate); 1401 SPECIFIER_HAS_METHOD (face_boolean, validate);
1402 SPECIFIER_HAS_METHOD (face_background_placement, validate);
1267 1403
1268 SPECIFIER_HAS_METHOD (color, create); 1404 SPECIFIER_HAS_METHOD (color, create);
1269 SPECIFIER_HAS_METHOD (font, create); 1405 SPECIFIER_HAS_METHOD (font, create);
1270 SPECIFIER_HAS_METHOD (face_boolean, create); 1406 SPECIFIER_HAS_METHOD (face_boolean, create);
1407 SPECIFIER_HAS_METHOD (face_background_placement, create);
1271 1408
1272 SPECIFIER_HAS_METHOD (color, mark); 1409 SPECIFIER_HAS_METHOD (color, mark);
1273 SPECIFIER_HAS_METHOD (font, mark); 1410 SPECIFIER_HAS_METHOD (font, mark);
1274 SPECIFIER_HAS_METHOD (face_boolean, mark); 1411 SPECIFIER_HAS_METHOD (face_boolean, mark);
1412 SPECIFIER_HAS_METHOD (face_background_placement, mark);
1275 1413
1276 SPECIFIER_HAS_METHOD (color, after_change); 1414 SPECIFIER_HAS_METHOD (color, after_change);
1277 SPECIFIER_HAS_METHOD (font, after_change); 1415 SPECIFIER_HAS_METHOD (font, after_change);
1278 SPECIFIER_HAS_METHOD (face_boolean, after_change); 1416 SPECIFIER_HAS_METHOD (face_boolean, after_change);
1417 SPECIFIER_HAS_METHOD (face_background_placement, after_change);
1279 1418
1280 #ifdef MULE 1419 #ifdef MULE
1281 SPECIFIER_HAS_METHOD (font, validate_matchspec); 1420 SPECIFIER_HAS_METHOD (font, validate_matchspec);
1282 #endif 1421 #endif
1283 } 1422 }
1286 reinit_specifier_type_create_objects (void) 1425 reinit_specifier_type_create_objects (void)
1287 { 1426 {
1288 REINITIALIZE_SPECIFIER_TYPE (color); 1427 REINITIALIZE_SPECIFIER_TYPE (color);
1289 REINITIALIZE_SPECIFIER_TYPE (font); 1428 REINITIALIZE_SPECIFIER_TYPE (font);
1290 REINITIALIZE_SPECIFIER_TYPE (face_boolean); 1429 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
1430 REINITIALIZE_SPECIFIER_TYPE (face_background_placement);
1291 } 1431 }
1292 1432
1293 void 1433 void
1294 reinit_vars_of_objects (void) 1434 reinit_vars_of_objects (void)
1295 { 1435 {