1 /* XEmacs routines to deal with CONCORD.
2 Copyright (C) 2005,2006 MORIOKA Tomohiko
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not in FSF. */
23 /* Written by MORIOKA Tomohiko */
33 EXFUN (Fread_from_string, 3);
36 EXFUN (Fconcord_decode_object, 4);
37 EXFUN (Fconcord_object_put, 3);
38 EXFUN (Fconcord_object_get, 2);
41 Lisp_Object Qconcord_object;
42 Lisp_Object Qgenre, Q_id;
44 Lisp_Object Vconcord_ds_hash_table;
45 Lisp_Object Vconcord_genre_hash_table;
46 Lisp_Object Vconcord_genre_object_hash_table;
49 typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
50 DECLARE_LRECORD (concord_ds, Lisp_CONCORD_DS);
52 Lisp_Object Qconcord_dsp;
54 struct Lisp_CONCORD_DS
56 struct lcrecord_header header;
60 #define XCONCORD_DS(x) XRECORD (x, concord_ds, Lisp_CONCORD_DS)
61 #define XSET_CONCORD_DS(x, p) XSETRECORD (x, p, concord_ds)
62 #define CONCORD_DS_P(x) RECORDP (x, concord_ds)
63 #define CHECK_CONCORD_DS(x) CHECK_RECORD (x, concord_ds)
64 #define CONCHECK_CONCORD_DS(x) CONCHECK_RECORD (x, concord_ds)
66 static Lisp_CONCORD_DS*
67 allocate_concord_ds (void)
70 = alloc_lcrecord_type (Lisp_CONCORD_DS, &lrecord_concord_ds);
77 mark_concord_ds (Lisp_Object object)
83 print_concord_ds (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
85 Lisp_CONCORD_DS* lds = XCONCORD_DS (obj);
88 error ("printing unreadable object #<concord_ds 0x%x>", lds->header.uid);
90 write_c_string ("#<concord_ds \"", printcharfun);
91 write_c_string (concord_ds_location (lds->ds), printcharfun);
92 write_c_string ("\">", printcharfun);
96 finalize_concord_ds (void *header, int for_disksave)
98 Lisp_CONCORD_DS *lds = (Lisp_CONCORD_DS *) header;
103 XSET_CONCORD_DS (object, lds);
106 ("Can't dump an emacs containing concord_ds objects", object);
108 if ( lds->ds != NULL)
109 concord_close_ds (lds->ds);
112 DEFINE_LRECORD_IMPLEMENTATION ("concord_ds", concord_ds,
113 mark_concord_ds, print_concord_ds,
114 finalize_concord_ds, 0, 0, 0,
117 DEFUN ("concord-close-ds", Fconcord_close_ds, 1, 1, 0, /*
118 Close concord-ds CONCORD-DS.
122 Lisp_CONCORD_DS* lds;
123 lds = XCONCORD_DS (concord_ds);
124 if ( lds->ds != NULL)
125 concord_close_ds (lds->ds);
130 DEFUN ("concord-ds-p", Fconcord_ds_p, 1, 1, 0, /*
131 Return t if OBJECT is a concord-ds.
135 return CONCORD_DS_P (object) ? Qt : Qnil;
138 DEFUN ("concord-open-ds", Fconcord_open_ds, 1, 4, 0, /*
139 Return a new concord-ds object opened on DIRECTORY.
140 Optional arguments TYPE and SUBTYPE specify the concord_ds type.
141 Optional argument MODE gives the permissions to use when opening DIRECTORY,
142 and defaults to 0755.
144 (directory, type, subtype, mode))
147 Lisp_CONCORD_DS* lds = NULL;
153 CHECK_STRING (directory);
155 directory = Ffile_name_as_directory (Fexpand_file_name (directory, Qnil));
158 retval = Fgethash (directory, Vconcord_ds_hash_table, Qunbound);
159 if (!UNBOUNDP (retval))
164 TO_EXTERNAL_FORMAT (LISP_STRING, directory,
165 C_STRING_ALLOCA, pathname,
170 modemask = 0755; /* rwxr-xr-x */
175 modemask = XINT (mode);
178 ds = concord_open_ds (CONCORD_Backend_Berkeley_DB,
179 pathname, 0, modemask);
183 lds = allocate_concord_ds ();
185 XSET_CONCORD_DS (retval, lds);
186 Fputhash (directory, retval, Vconcord_ds_hash_table);
190 DEFUN ("concord-ds-directory", Fconcord_ds_directory, 1, 1, 0, /*
191 Return directory of concord-ds DS.
195 Lisp_CONCORD_DS* lds;
198 CHECK_CONCORD_DS (ds);
199 lds = XCONCORD_DS (ds);
203 directory = concord_ds_location (lds->ds);
204 if (directory == NULL)
207 return build_ext_string (directory, Qfile_name);
211 DEFUN ("concord-assign-genre", Fconcord_assign_genre, 2, 2, 0, /*
212 Assign data-source DIRECTORY to GENRE.
218 CHECK_SYMBOL (genre);
219 if ( CONCORD_DS_P (directory) )
224 CHECK_STRING (directory);
227 = Ffile_name_as_directory (Fexpand_file_name (directory, Qnil));
230 Fputhash (genre, directory, Vconcord_genre_hash_table);
234 DEFUN ("concord-genre-directory", Fconcord_genre_directory, 1, 1, 0, /*
235 Return pathname of GENRE.
240 CHECK_SYMBOL (genre);
242 retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
243 if ( STRINGP (retval) )
245 else if ( CONCORD_DS_P (retval) )
246 return Fconcord_ds_directory (retval);
250 DEFUN ("concord-genre-ds", Fconcord_genre_ds, 1, 1, 0, /*
251 Return concord-ds of GENRE.
257 CHECK_SYMBOL (genre);
259 retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
260 if ( STRINGP (retval) )
262 retval = Fconcord_open_ds (retval, Qnil, Qnil, Qnil);
263 if ( !NILP (retval) )
264 Fputhash (genre, retval, Vconcord_genre_hash_table);
267 else if ( CONCORD_DS_P (retval) )
273 struct closure_to_list_feature
275 Lisp_Object feature_list;
276 } *concord_feature_list_closure;
279 add_feature_to_list_mapper (CONCORD_Genre genre, char* name)
281 /* This function can GC */
282 concord_feature_list_closure->feature_list
283 = Fcons (intern (name), concord_feature_list_closure->feature_list);
287 DEFUN ("concord-feature-list", Fconcord_feature_list, 1, 2, 0, /*
288 Return the list of all existing features in GENRE.
292 Lisp_CONCORD_DS* lds;
294 CONCORD_Genre c_genre;
297 CHECK_SYMBOL (genre);
299 ds = Fconcord_genre_ds (genre);
300 CHECK_CONCORD_DS (ds);
301 lds = XCONCORD_DS (ds);
304 genre = Fsymbol_name (genre);
305 TO_EXTERNAL_FORMAT (LISP_STRING, genre,
306 C_STRING_ALLOCA, genre_name,
308 c_genre = concord_ds_get_genre (lds->ds, genre_name);
311 concord_feature_list_closure
312 = alloca (sizeof (struct closure_to_list_feature));
313 concord_feature_list_closure->feature_list = Qnil;
314 GCPRO1 (concord_feature_list_closure->feature_list);
315 concord_genre_foreach_feature_name (c_genre,
316 add_feature_to_list_mapper);
318 return concord_feature_list_closure->feature_list;
322 typedef struct Lisp_CONCORD_Object Lisp_CONCORD_Object;
323 DECLARE_LRECORD (concord_object, Lisp_CONCORD_Object);
325 Lisp_Object Qconcord_objectp;
327 struct Lisp_CONCORD_Object
329 struct lcrecord_header header;
334 #define XCONCORD_OBJECT(x) XRECORD (x, concord_object, Lisp_CONCORD_Object)
335 #define XSET_CONCORD_OBJECT(x, p) XSETRECORD (x, p, concord_object)
336 #define CONCORD_OBJECT_P(x) RECORDP (x, concord_object)
337 #define CHECK_CONCORD_OBJECT(x) CHECK_RECORD (x, concord_object)
338 #define CONCHECK_CONCORD_OBJECT(x) CONCHECK_RECORD (x, concord_object)
339 #define CONCORD_OBJECT_GENRE(x) ((x)->genre)
340 #define CONCORD_OBJECT_ID(x) ((x)->id)
341 #define XCONCORD_OBJECT_ID(x) CONCORD_OBJECT_ID (XCONCORD_OBJECT(x))
342 #define XCONCORD_OBJECT_GENRE(x) CONCORD_OBJECT_GENRE (XCONCORD_OBJECT(x))
344 static Lisp_CONCORD_Object*
345 allocate_concord_object (void)
347 Lisp_CONCORD_Object* lcobj
348 = alloc_lcrecord_type (Lisp_CONCORD_Object, &lrecord_concord_object);
351 lcobj->id = Qunbound;
356 mark_concord_object (Lisp_Object object)
358 mark_object (XCONCORD_OBJECT_ID(object));
363 print_concord_object (Lisp_Object obj,
364 Lisp_Object printcharfun, int escapeflag)
366 Lisp_CONCORD_Object* lcobj = XCONCORD_OBJECT (obj);
367 struct gcpro gcpro1, gcpro2;
371 write_c_string ("#s(concord-object", printcharfun);
372 write_c_string (" genre ", printcharfun);
373 write_c_string (concord_genre_get_name (lcobj->genre), printcharfun);
374 write_c_string (" =id ", printcharfun);
375 GCPRO2 (obj, printcharfun);
376 print_internal (lcobj->id, printcharfun, escapeflag);
378 write_c_string (")", printcharfun);
382 write_c_string ("#<concord-object \"", printcharfun);
383 write_c_string (concord_ds_location
384 (concord_genre_get_data_source (lcobj->genre)),
386 write_c_string (":", printcharfun);
387 write_c_string (concord_genre_get_name (lcobj->genre), printcharfun);
388 write_c_string (";", printcharfun);
389 GCPRO2 (obj, printcharfun);
390 print_internal (lcobj->id, printcharfun, escapeflag);
392 write_c_string ("\">", printcharfun);
397 finalize_concord_object (void *header, int for_disksave)
399 Lisp_CONCORD_Object* lcobj = (Lisp_CONCORD_Object *) header;
404 XSET_CONCORD_OBJECT (object, lcobj);
407 ("Can't dump an emacs containing concord_object objects", object);
411 static const struct lrecord_description concord_object_description[] = {
412 { XD_LISP_OBJECT, offsetof (Lisp_CONCORD_Object, id) },
416 DEFINE_LRECORD_IMPLEMENTATION ("concord_object", concord_object,
417 mark_concord_object, print_concord_object,
418 finalize_concord_object, 0, 0,
419 concord_object_description,
420 Lisp_CONCORD_Object);
423 concord_genre_cache_get_object (Lisp_Object genre, Lisp_Object id)
425 Lisp_Object obj_hash;
427 obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
428 if (UNBOUNDP (obj_hash))
430 return Fgethash (id, obj_hash, Qunbound);
434 concord_genre_cache_put_object (Lisp_Object genre, Lisp_Object id,
437 Lisp_Object obj_hash;
439 obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
440 if (UNBOUNDP (obj_hash))
443 = make_lisp_hash_table (256, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
444 Fputhash (genre, obj_hash, Vconcord_genre_object_hash_table);
446 return Fputhash (id, object, obj_hash);
449 DEFUN ("concord-make-object", Fconcord_make_object, 1, 3, 0, /*
450 Make and return a Concord-object from ID and GENRE.
451 Optional argument DS specifies the data-source of the GENRE.
455 Lisp_CONCORD_DS* lds;
456 Lisp_Object genre_string;
457 char* genre_name_str;
458 CONCORD_Genre c_genre;
459 Lisp_CONCORD_Object* lcobj;
464 retval = concord_genre_cache_get_object (genre, id);
465 if (!UNBOUNDP (retval))
471 ds = Fconcord_genre_ds (genre);
472 CHECK_CONCORD_DS (ds);
473 lds = XCONCORD_DS (ds);
476 if ( STRINGP(genre) )
477 genre_string = genre;
479 genre_string = Fsymbol_name (genre);
480 TO_EXTERNAL_FORMAT (LISP_STRING, genre_string,
481 C_STRING_ALLOCA, genre_name_str,
483 c_genre = concord_ds_get_genre (lds->ds, genre_name_str);
486 lcobj = allocate_concord_object ();
487 lcobj->genre = c_genre;
489 XSET_CONCORD_OBJECT (retval, lcobj);
492 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
494 GCPRO4 (retval, id, genre, ds);
495 concord_genre_cache_put_object (genre, id, retval);
497 if (!EQ (Fconcord_object_get (retval, Q_id), id))
498 Fconcord_object_put (retval, Q_id, id);
505 DEFUN ("concord-object-p", Fconcord_object_p, 1, 1, 0, /*
506 Return t if OBJECT is a concord-object.
510 return CONCORD_OBJECT_P (object) ? Qt : Qnil;
513 DEFUN ("concord-object-id", Fconcord_object_id, 1, 1, 0, /*
514 Return an id of Concord-object OBJECT.
518 CHECK_CONCORD_OBJECT (object);
519 return XCONCORD_OBJECT_ID (object);
522 DEFUN ("concord-decode-object", Fconcord_decode_object, 2, 4, 0, /*
523 Make and return a Concord-object from FEATURE and VALUE.
524 Optional argument GENRE specifies the GENRE of the object.
525 Optional argument DS specifies the data-source of the GENRE.
527 (feature, value, genre, ds))
529 Lisp_CONCORD_DS* lds;
531 CONCORD_Genre c_genre;
533 CONCORD_INDEX c_index;
534 Lisp_Object value_string;
536 CONCORD_String_Tank st_id;
539 int previous_print_readably;
540 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
543 ds = Fconcord_genre_ds (genre);
544 CHECK_CONCORD_DS (ds);
545 lds = XCONCORD_DS (ds);
548 if ( !STRINGP(feature) )
549 feature = Fsymbol_name (feature);
550 if ( !STRINGP(genre) )
551 genre = Fsymbol_name (genre);
552 TO_EXTERNAL_FORMAT (LISP_STRING, genre,
553 C_STRING_ALLOCA, genre_name,
555 c_genre = concord_ds_get_genre (lds->ds, genre_name);
561 TO_EXTERNAL_FORMAT (LISP_STRING, feature,
562 C_STRING_ALLOCA, feature_name,
564 c_index = concord_genre_get_index (c_genre, feature_name);
570 previous_print_readably = print_readably;
572 GCPRO5 (feature, value, genre, ds, value_string);
573 value_string = Fprin1_to_string (value, Qnil);
575 print_readably = previous_print_readably;
576 TO_EXTERNAL_FORMAT (LISP_STRING,
577 value_string, C_STRING_ALLOCA, strid,
579 status = concord_index_strid_get_obj_string (c_index, strid, &st_id);
584 GCPRO4 (genre, ds, obj, retval);
586 obj = read_from_c_string (CONCORD_String_data (&st_id),
587 CONCORD_String_size (&st_id) );
589 obj = Fcar (Fread_from_string (make_ext_string
590 ((char*)CONCORD_String_data (&st_id),
591 CONCORD_String_size (&st_id),
595 retval = Fconcord_make_object (genre, obj, ds);
602 DEFUN ("concord-object-get", Fconcord_object_get, 2, 2, 0, /*
603 Return the value of OBJECT's FEATURE.
607 struct gcpro gcpro1, gcpro2;
608 int previous_print_readably;
609 Lisp_Object obj_string;
611 CONCORD_Genre c_genre;
613 CONCORD_Feature c_feature;
615 CONCORD_String_Tank st_value;
617 CHECK_CONCORD_OBJECT (object);
618 if ( !STRINGP(feature) )
619 feature = Fsymbol_name (feature);
620 previous_print_readably = print_readably;
622 GCPRO2 (object, feature);
623 obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
625 print_readably = previous_print_readably;
626 TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
627 C_STRING_ALLOCA, c_obj, Qfile_name);
628 c_genre = XCONCORD_OBJECT_GENRE(object);
629 TO_EXTERNAL_FORMAT (LISP_STRING, feature,
630 C_STRING_ALLOCA, feature_name,
632 c_feature = concord_genre_get_feature (c_genre, feature_name);
633 if (c_feature == NULL)
637 status = concord_obj_get_feature_value_string (c_obj, c_feature,
642 Fcar (Fread_from_string (make_ext_string
643 ((char*)CONCORD_String_data (&st_value),
644 CONCORD_String_size (&st_value),
651 DEFUN ("concord-object-put", Fconcord_object_put, 3, 3, 0, /*
652 Store a VALUE of OBJECT's FEATURE.
654 (object, feature, value))
656 struct gcpro gcpro1, gcpro2, gcpro3;
657 int previous_print_readably;
658 Lisp_Object obj_string;
660 CONCORD_Genre c_genre;
662 CONCORD_Feature c_feature;
664 Lisp_Object value_string;
667 CHECK_CONCORD_OBJECT (object);
668 if ( !STRINGP(feature) )
669 feature = Fsymbol_name (feature);
670 previous_print_readably = print_readably;
672 GCPRO3 (object, feature, value);
673 obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
675 print_readably = previous_print_readably;
676 TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
677 C_STRING_ALLOCA, c_obj, Qfile_name);
678 c_genre = XCONCORD_OBJECT_GENRE(object);
679 TO_EXTERNAL_FORMAT (LISP_STRING, feature,
680 C_STRING_ALLOCA, feature_name,
682 c_feature = concord_genre_get_feature (c_genre, feature_name);
683 if (c_feature == NULL)
687 previous_print_readably = print_readably;
689 GCPRO3 (object, feature, value);
690 value_string = Fprin1_to_string (value, Qnil);
692 print_readably = previous_print_readably;
693 TO_EXTERNAL_FORMAT (LISP_STRING, value_string,
694 C_STRING_ALLOCA, c_value,
696 status = concord_obj_put_feature_value_str (c_obj, c_feature,
697 (unsigned char*)c_value);
700 status = chise_feature_sync (c_feature);
703 if (feature_name[0] == '=')
705 CONCORD_INDEX c_index
706 = concord_genre_get_index (c_genre, feature_name);
708 concord_index_strid_put_obj (c_index, c_value, c_obj);
709 concord_index_sync (c_index);
714 struct closure_for_object_spec
718 } *concord_object_spec_closure;
721 add_feature_to_spec_mapper (CONCORD_Genre genre, char* name)
723 /* This function can GC */
724 CONCORD_String_Tank st_value;
725 CONCORD_Feature c_feature;
728 c_feature = concord_genre_get_feature (genre, name);
729 if (c_feature == NULL)
733 concord_obj_get_feature_value_string
734 (concord_object_spec_closure->object_id, c_feature, &st_value);
737 concord_object_spec_closure->spec
738 = Fcons (Fcons (intern (name),
739 Fcar (Fread_from_string
741 ((char*)CONCORD_String_data (&st_value),
742 CONCORD_String_size (&st_value),
745 concord_object_spec_closure->spec);
750 DEFUN ("concord-object-spec", Fconcord_object_spec, 1, 1, 0, /*
751 Return the spec of OBJECT.
755 Lisp_Object obj_string;
757 CONCORD_Genre c_genre;
758 struct gcpro gcpro1, gcpro2;
759 int previous_print_readably;
761 CHECK_CONCORD_OBJECT (object);
762 previous_print_readably = print_readably;
765 obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
767 print_readably = previous_print_readably;
768 TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
769 C_STRING_ALLOCA, c_obj, Qfile_name);
770 c_genre = XCONCORD_OBJECT_GENRE(object);
771 concord_object_spec_closure
772 = alloca (sizeof (struct closure_for_object_spec));
773 concord_object_spec_closure->object_id = c_obj;
774 concord_object_spec_closure->spec = Qnil;
775 GCPRO2 (object, concord_object_spec_closure->spec);
776 concord_genre_foreach_feature_name (c_genre,
777 add_feature_to_spec_mapper);
779 return concord_object_spec_closure->spec;
782 struct closure_for_each_object
784 Lisp_Object function;
788 } *for_each_object_closure;
791 func_for_each_object (CONCORD_String object_id,
792 CONCORD_Feature feature,
793 CONCORD_String value)
795 struct gcpro gcpro1, gcpro2, gcpro3;
796 Lisp_Object obj, val, ret;
799 obj = read_from_c_string (CONCORD_String_data (object_id),
800 CONCORD_String_size (object_id) );
802 obj = Fcar (Fread_from_string (make_ext_string
803 ((char*)CONCORD_String_data (object_id),
804 CONCORD_String_size (object_id),
809 obj = Fconcord_make_object (for_each_object_closure->genre,
811 for_each_object_closure->ds);
814 val = read_from_c_string (CONCORD_String_data (value),
815 CONCORD_String_size (value) );
817 val = Fcar (Fread_from_string (make_ext_string
818 ((char*)CONCORD_String_data (value),
819 CONCORD_String_size (value),
823 GCPRO3 (obj, val, ret);
824 ret = call2 (for_each_object_closure->function, obj, val);
826 for_each_object_closure->ret = ret;
830 DEFUN ("concord-for-each-object-in-feature",
831 Fconcord_foreach_object_in_feature, 2, 4, 0, /*
832 Do FUNCTION over objects in FEATURE, calling it with two args,
833 each key and value in the FEATURE table.
834 Optional argument GENRE specifies the genre of the FEATURE.
835 When the FUNCTION returns non-nil, it breaks the repeat.
837 (function, feature, genre, ds))
839 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
840 Lisp_CONCORD_DS* lds;
842 CONCORD_Genre c_genre;
844 CONCORD_Feature c_feature;
847 ds = Fconcord_genre_ds (genre);
848 CHECK_CONCORD_DS (ds);
849 lds = XCONCORD_DS (ds);
852 if ( !STRINGP(feature) )
853 feature = Fsymbol_name (feature);
854 if ( !STRINGP(genre) )
855 genre = Fsymbol_name (genre);
856 TO_EXTERNAL_FORMAT (LISP_STRING, genre,
857 C_STRING_ALLOCA, genre_name,
859 c_genre = concord_ds_get_genre (lds->ds, genre_name);
863 CHECK_STRING (feature);
864 TO_EXTERNAL_FORMAT (LISP_STRING, feature,
865 C_STRING_ALLOCA, feature_name,
867 c_feature = concord_genre_get_feature (c_genre, feature_name);
868 if (c_feature == NULL)
870 for_each_object_closure
871 = alloca (sizeof (struct closure_for_each_object));
872 for_each_object_closure->function = function;
873 for_each_object_closure->genre = genre;
874 for_each_object_closure->ds = ds;
875 for_each_object_closure->ret = Qnil;
876 GCPRO4 (for_each_object_closure->function,
877 for_each_object_closure->genre,
878 for_each_object_closure->ds,
879 for_each_object_closure->ret);
880 concord_feature_foreach_obj_string (c_feature, func_for_each_object);
883 return for_each_object_closure->ret;
888 concord_name_validate (Lisp_Object keyword, Lisp_Object value,
891 if (ERRB_EQ (errb, ERROR_ME))
893 CHECK_SYMBOL (value);
897 return SYMBOLP (value);
901 concord_object_validate (Lisp_Object data, Error_behavior errb)
903 struct gcpro gcpro1, gcpro2, gcpro3;
905 Lisp_Object valw = Qnil;
906 Lisp_Object genre = Qnil;
907 Lisp_Object oid = Qnil;
909 data = Fcdr (data); /* skip over Qconcord_object */
912 Lisp_Object keyw = Fcar (data);
917 if (EQ (keyw, Qgenre))
919 else if (EQ (keyw, Q_id))
927 maybe_error (Qconcord_object, errb, "No genre given");
932 maybe_error (Qconcord_object, errb, "No object-id given");
936 GCPRO3 (genre, oid, retval);
937 retval = Fconcord_make_object (genre, oid, Qnil);
941 maybe_signal_simple_error_2 ("No such Concord-object",
942 oid, genre, Qconcord_object, errb);
950 concord_object_instantiate (Lisp_Object data)
952 struct gcpro gcpro1, gcpro2;
955 GCPRO2 (data, retval);
956 retval = Fconcord_make_object (Fplist_get (data, Qgenre, Qnil),
957 Fplist_get (data, Q_id, Qnil),
965 syms_of_concord (void)
967 INIT_LRECORD_IMPLEMENTATION (concord_ds);
968 INIT_LRECORD_IMPLEMENTATION (concord_object);
970 defsymbol (&Qconcord, "concord");
971 defsymbol (&Qconcord_dsp, "concord-dsp");
972 defsymbol (&Qconcord_objectp, "concord-objectp");
973 defsymbol (&Qconcord_object, "concord-object");
974 defsymbol (&Qgenre, "genre");
975 defsymbol (&Q_id, "=id");
977 DEFSUBR (Fconcord_open_ds);
978 DEFSUBR (Fconcord_ds_p);
979 DEFSUBR (Fconcord_close_ds);
980 DEFSUBR (Fconcord_ds_directory);
982 DEFSUBR (Fconcord_assign_genre);
983 DEFSUBR (Fconcord_genre_directory);
984 DEFSUBR (Fconcord_genre_ds);
985 DEFSUBR (Fconcord_feature_list);
987 DEFSUBR (Fconcord_make_object);
988 DEFSUBR (Fconcord_object_p);
989 DEFSUBR (Fconcord_object_id);
990 DEFSUBR (Fconcord_decode_object);
991 DEFSUBR (Fconcord_object_get);
992 DEFSUBR (Fconcord_object_put);
993 DEFSUBR (Fconcord_object_spec);
994 DEFSUBR (Fconcord_foreach_object_in_feature);
998 structure_type_create_concord (void)
1000 struct structure_type *st;
1002 st = define_structure_type (Qconcord_object,
1003 concord_object_validate,
1004 concord_object_instantiate);
1006 define_structure_type_keyword (st, Qgenre, concord_name_validate);
1007 define_structure_type_keyword (st, Q_id, concord_name_validate);
1011 vars_of_concord (void)
1013 Fprovide (Qconcord);
1015 staticpro (&Vconcord_ds_hash_table);
1016 Vconcord_ds_hash_table
1017 = make_lisp_hash_table (8, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
1019 staticpro (&Vconcord_genre_hash_table);
1020 Vconcord_genre_hash_table
1021 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1023 staticpro (&Vconcord_genre_object_hash_table);
1024 Vconcord_genre_object_hash_table
1025 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);