src/concord.c

   1 /* XEmacs routines to deal with CONCORD.
   2    Copyright (C) 2005 MORIOKA Tomohiko
   3
   4 This file is part of XEmacs.
   5
   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
   9 later version.
  10
  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
  14 for more details.
  15
  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.  */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 /* Written by MORIOKA Tomohiko */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27 #include "sysfile.h"
  28 #include "buffer.h"
  29 #include <errno.h>
  30 #include <concord.h>
  31
  32
  33 EXFUN (Fread_from_string, 3);
  34
  35
  36 Lisp_Object Qconcord;
  37
  38
  39 typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
  40 DECLARE_LRECORD (concord_ds, Lisp_CONCORD_DS);
  41
  42 Lisp_Object Qconcord_dsp;
  43
  44 struct Lisp_CONCORD_DS
  45 {
  46   struct lcrecord_header header;
  47   CONCORD_DS ds;
  48 };
  49
  50 #define XCONCORD_DS(x) XRECORD (x, concord_ds, Lisp_CONCORD_DS)
  51 #define XSET_CONCORD_DS(x, p) XSETRECORD (x, p, concord_ds)
  52 #define CONCORD_DS_P(x) RECORDP (x, concord_ds)
  53 #define CHECK_CONCORD_DS(x) CHECK_RECORD (x, concord_ds)
  54 #define CONCHECK_CONCORD_DS(x) CONCHECK_RECORD (x, concord_ds)
  55
  56 static Lisp_CONCORD_DS*
  57 allocate_concord_ds (void)
  58 {
  59   Lisp_CONCORD_DS* lds
  60     = alloc_lcrecord_type (Lisp_CONCORD_DS, &lrecord_concord_ds);
  61
  62   lds->ds = NULL;
  63   return lds;
  64 }
  65
  66 static Lisp_Object
  67 mark_concord_ds (Lisp_Object object)
  68 {
  69   return Qnil;
  70 }
  71
  72 static void
  73 print_concord_ds (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  74 {
  75   Lisp_CONCORD_DS* lds = XCONCORD_DS (obj);
  76
  77   if (print_readably)
  78     error ("printing unreadable object #<concord_ds 0x%x>", lds->header.uid);
  79
  80   write_c_string ("#<concord_ds \"", printcharfun);
  81   write_c_string (concord_ds_location (lds->ds), printcharfun);
  82   write_c_string ("\">", printcharfun);
  83 }
  84
  85 static void
  86 finalize_concord_ds (void *header, int for_disksave)
  87 {
  88   Lisp_CONCORD_DS *lds = (Lisp_CONCORD_DS *) header;
  89
  90   if (for_disksave)
  91     {
  92       Lisp_Object object;
  93       XSET_CONCORD_DS (object, lds);
  94
  95       signal_simple_error
  96         ("Can't dump an emacs containing concord_ds objects", object);
  97     }
  98   if ( lds->ds != NULL)
  99     concord_close_ds (lds->ds);
 100 }
 101
 102 DEFINE_LRECORD_IMPLEMENTATION ("concord_ds", concord_ds,
 103                                mark_concord_ds, print_concord_ds,
 104                                finalize_concord_ds, 0, 0, 0,
 105                                Lisp_CONCORD_DS);
 106
 107 DEFUN ("concord-close-ds", Fconcord_close_ds, 1, 1, 0, /*
 108 Close concord-ds CONCORD-DS.
 109 */
 110        (concord_ds))
 111 {
 112   Lisp_CONCORD_DS* lds;
 113   lds = XCONCORD_DS (concord_ds);
 114   if ( lds->ds != NULL)
 115     concord_close_ds (lds->ds);
 116   lds->ds = NULL;
 117   return Qnil;
 118 }
 119
 120 DEFUN ("concord-ds-p", Fconcord_ds_p, 1, 1, 0, /*
 121 Return t if OBJECT is a concord-ds.
 122 */
 123        (object))
 124 {
 125   return CONCORD_DS_P (object) ? Qt : Qnil;
 126 }
 127
 128 DEFUN ("concord-open-ds", Fconcord_open_ds, 1, 4, 0, /*
 129 Return a new concord_ds object opened on PATH.
 130 Optional arguments TYPE and SUBTYPE specify the concord_ds type.
 131 Optional argument MODE gives the permissions to use when opening PATH,
 132 and defaults to 0755.
 133 */
 134        (path, type, subtype, mode))
 135 {
 136   Lisp_Object retval;
 137   Lisp_CONCORD_DS* lds = NULL;
 138   CONCORD_DS ds;
 139   int modemask;
 140   char *pathname;
 141   struct gcpro gcpro1;
 142
 143   CHECK_STRING (path);
 144   GCPRO1 (path);
 145   path = Fexpand_file_name (path, Qnil);
 146   UNGCPRO;
 147
 148   TO_EXTERNAL_FORMAT (LISP_STRING, path,
 149                       C_STRING_ALLOCA, pathname,
 150                       Qfile_name);
 151
 152   if (NILP (mode))
 153     {
 154       modemask = 0755;          /* rwxr-xr-x */
 155     }
 156   else
 157     {
 158       CHECK_INT (mode);
 159       modemask = XINT (mode);
 160     }
 161
 162   ds = concord_open_ds (CONCORD_Backend_Berkeley_DB,
 163                         pathname, 0, modemask);
 164   if ( ds == NULL )
 165     return Qnil;
 166
 167   lds = allocate_concord_ds ();
 168   lds->ds = ds;
 169   XSET_CONCORD_DS (retval, lds);
 170   return retval;
 171 }
 172
 173
 174 struct closure_to_list_feature
 175 {
 176   Lisp_Object feature_list;
 177 } *concord_feature_list_closure;
 178
 179 static int
 180 add_feature_to_list_mapper (CONCORD_Genre genre, unsigned char* name)
 181 {
 182   /* This function can GC */
 183   concord_feature_list_closure->feature_list
 184     = Fcons (intern (name), concord_feature_list_closure->feature_list);
 185   return 0;
 186 }
 187
 188 DEFUN ("concord-feature-list", Fconcord_feature_list, 1, 2, 0, /*
 189 Return the list of all existing features in GENRE.
 190 */
 191        (genre, ds))
 192 {
 193   Lisp_CONCORD_DS* lds;
 194   unsigned char* genre_name;
 195   CONCORD_Genre c_genre;
 196   struct gcpro gcpro1;
 197
 198   if ( !STRINGP(genre) )
 199     genre = Fsymbol_name (genre);
 200   CHECK_CONCORD_DS (ds);
 201   lds = XCONCORD_DS (ds);
 202   if (lds->ds == NULL)
 203     return Qnil;
 204   TO_EXTERNAL_FORMAT (LISP_STRING, genre,
 205                       C_STRING_ALLOCA, genre_name,
 206                       Qfile_name);
 207   c_genre = concord_ds_get_genre (lds->ds, genre_name);
 208   if (c_genre == NULL)
 209     return Qnil;
 210   concord_feature_list_closure
 211     = alloca (sizeof (struct closure_to_list_feature));
 212   concord_feature_list_closure->feature_list = Qnil;
 213   GCPRO1 (concord_feature_list_closure->feature_list);
 214   concord_genre_foreach_feature_name (c_genre,
 215                                       add_feature_to_list_mapper);
 216   UNGCPRO;
 217   return concord_feature_list_closure->feature_list;
 218 }
 219
 220
 221 typedef struct Lisp_CONCORD_Object Lisp_CONCORD_Object;
 222 DECLARE_LRECORD (concord_object, Lisp_CONCORD_Object);
 223
 224 Lisp_Object Qconcord_objectp;
 225
 226 struct Lisp_CONCORD_Object
 227 {
 228   struct lcrecord_header header;
 229   CONCORD_Genre genre;
 230   Lisp_Object id;
 231 };
 232
 233 #define XCONCORD_OBJECT(x) XRECORD (x, concord_object, Lisp_CONCORD_Object)
 234 #define XSET_CONCORD_OBJECT(x, p) XSETRECORD (x, p, concord_object)
 235 #define CONCORD_OBJECT_P(x) RECORDP (x, concord_object)
 236 #define CHECK_CONCORD_OBJECT(x) CHECK_RECORD (x, concord_object)
 237 #define CONCHECK_CONCORD_OBJECT(x) CONCHECK_RECORD (x, concord_object)
 238 #define CONCORD_OBJECT_GENRE(x) ((x)->genre)
 239 #define CONCORD_OBJECT_ID(x)    ((x)->id)
 240 #define XCONCORD_OBJECT_ID(x)   CONCORD_OBJECT_ID (XCONCORD_OBJECT(x))
 241 #define XCONCORD_OBJECT_GENRE(x) CONCORD_OBJECT_GENRE (XCONCORD_OBJECT(x))
 242
 243 static Lisp_CONCORD_Object*
 244 allocate_concord_object (void)
 245 {
 246   Lisp_CONCORD_Object* lcobj
 247     = alloc_lcrecord_type (Lisp_CONCORD_Object, &lrecord_concord_object);
 248
 249   lcobj->genre = NULL;
 250   lcobj->id = Qunbound;
 251   return lcobj;
 252 }
 253
 254 static Lisp_Object
 255 mark_concord_object (Lisp_Object object)
 256 {
 257   mark_object (XCONCORD_OBJECT_ID(object));
 258   return Qnil;
 259 }
 260
 261 static void
 262 print_concord_object (Lisp_Object obj,
 263                       Lisp_Object printcharfun, int escapeflag)
 264 {
 265   Lisp_CONCORD_Object* lcobj = XCONCORD_OBJECT (obj);
 266   struct gcpro gcpro1, gcpro2;
 267
 268   if (print_readably)
 269     error ("printing unreadable object #<concord_object 0x%x>",
 270            lcobj->header.uid);
 271
 272   write_c_string ("#<concord_object \"", printcharfun);
 273   write_c_string (concord_ds_location
 274                   (concord_genre_get_data_source (lcobj->genre)),
 275                   printcharfun);
 276   write_c_string (":", printcharfun);
 277   write_c_string (concord_genre_get_name (lcobj->genre), printcharfun);
 278   write_c_string (";", printcharfun);
 279   GCPRO2 (obj, printcharfun);
 280   print_internal (lcobj->id, printcharfun, escapeflag);
 281   UNGCPRO;
 282   write_c_string ("\">", printcharfun);
 283 }
 284
 285 static void
 286 finalize_concord_object (void *header, int for_disksave)
 287 {
 288   Lisp_CONCORD_Object* lcobj = (Lisp_CONCORD_Object *) header;
 289
 290   if (for_disksave)
 291     {
 292       Lisp_Object object;
 293       XSET_CONCORD_OBJECT (object, lcobj);
 294
 295       signal_simple_error
 296         ("Can't dump an emacs containing concord_object objects", object);
 297     }
 298 }
 299
 300 static const struct lrecord_description concord_object_description[] = {
 301   { XD_LISP_OBJECT, offsetof (Lisp_CONCORD_Object, id) },
 302   { XD_END }
 303 };
 304
 305 DEFINE_LRECORD_IMPLEMENTATION ("concord_object", concord_object,
 306                                mark_concord_object, print_concord_object,
 307                                finalize_concord_object, 0, 0,
 308                                concord_object_description,
 309                                Lisp_CONCORD_Object);
 310
 311 DEFUN ("concord-make-object",
 312        Fconcord_make_object, 1, 3, 0, /*
 313 Make and return a Concord-object from ID and GENRE.
 314 Optional argument DS specifies the data-source of the GENRE.
 315 */
 316        (id, genre, ds))
 317 {
 318   Lisp_CONCORD_DS* lds;
 319   unsigned char* genre_name;
 320   CONCORD_Genre c_genre;
 321   Lisp_CONCORD_Object* lcobj;
 322   Lisp_Object retval;
 323
 324   if ( !STRINGP(genre) )
 325     genre = Fsymbol_name (genre);
 326   CHECK_CONCORD_DS (ds);
 327   lds = XCONCORD_DS (ds);
 328   if (lds->ds == NULL)
 329     return Qnil;
 330   TO_EXTERNAL_FORMAT (LISP_STRING, genre,
 331                       C_STRING_ALLOCA, genre_name,
 332                       Qfile_name);
 333   c_genre = concord_ds_get_genre (lds->ds, genre_name);
 334   if (c_genre == NULL)
 335     return Qnil;
 336   lcobj = allocate_concord_object ();
 337   lcobj->genre = c_genre;
 338   lcobj->id = id;
 339   XSET_CONCORD_OBJECT (retval, lcobj);
 340   return retval;
 341 }
 342
 343 DEFUN ("concord-object-p",
 344        Fconcord_object_p, 1, 1, 0, /*
 345 Return t if OBJECT is a concord-object.
 346 */
 347        (object))
 348 {
 349   return CONCORD_OBJECT_P (object) ? Qt : Qnil;
 350 }
 351
 352 DEFUN ("concord-object-id",
 353        Fconcord_object_id, 1, 1, 0, /*
 354 Return an id of Concord-object OBJECT.
 355 */
 356        (object))
 357 {
 358   CHECK_CONCORD_OBJECT (object);
 359   return XCONCORD_OBJECT_ID (object);
 360 }
 361
 362 DEFUN ("concord-decode-object",
 363        Fconcord_decode_object, 2, 4, 0, /*
 364 Make and return a Concord-object from FEATURE and VALUE.
 365 Optional argument GENRE specifies the GENRE of the object.
 366 Optional argument DS specifies the data-source of the GENRE.
 367 */
 368        (feature, value, genre, ds))
 369 {
 370   Lisp_CONCORD_DS* lds;
 371   unsigned char* genre_name;
 372   CONCORD_Genre c_genre;
 373   unsigned char* feature_name;
 374   CONCORD_INDEX c_index;
 375   Lisp_Object value_string;
 376   unsigned char* strid;
 377   CONCORD_String_Tank st_id;
 378   int status;
 379   Lisp_Object obj;
 380   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 381
 382   if ( !STRINGP(feature) )
 383     feature = Fsymbol_name (feature);
 384   if ( !STRINGP(genre) )
 385     genre = Fsymbol_name (genre);
 386   CHECK_CONCORD_DS (ds);
 387   lds = XCONCORD_DS (ds);
 388   if (lds->ds == NULL)
 389     return Qnil;
 390
 391   TO_EXTERNAL_FORMAT (LISP_STRING, genre,
 392                       C_STRING_ALLOCA, genre_name,
 393                       Qfile_name);
 394   c_genre = concord_ds_get_genre (lds->ds, genre_name);
 395   if (c_genre == NULL)
 396     {
 397       return Qnil;
 398     }
 399
 400   TO_EXTERNAL_FORMAT (LISP_STRING, feature,
 401                       C_STRING_ALLOCA, feature_name,
 402                       Qfile_name);
 403   c_index = concord_genre_get_index (c_genre, feature_name);
 404   if (c_index == NULL)
 405     {
 406       return Qnil;
 407     }
 408
 409   GCPRO5 (feature, value, genre, ds, value_string);
 410   value_string = Fprin1_to_string (value, Qnil);
 411   UNGCPRO;
 412   TO_EXTERNAL_FORMAT (LISP_STRING,
 413                       value_string, C_STRING_ALLOCA, strid,
 414                       Qfile_name);
 415   status = concord_index_strid_get_obj_string (c_index, strid, &st_id);
 416   if (!status)
 417     {
 418       GCPRO3 (genre, ds, obj);
 419 #if 0
 420       obj = read_from_c_string (CONCORD_String_data (&st_id),
 421                                 CONCORD_String_size (&st_id) );
 422 #else
 423       obj = Fcar (Fread_from_string (make_ext_string
 424                                      (CONCORD_String_data (&st_id),
 425                                       CONCORD_String_size (&st_id),
 426                                       Qfile_name),
 427                                      Qnil, Qnil));
 428 #endif
 429       UNGCPRO;
 430       return Fconcord_make_object (obj, genre, ds);
 431     }
 432   return Qnil;
 433 }
 434
 435 DEFUN ("concord-object-get",
 436        Fconcord_object_get, 2, 2, 0, /*
 437 Return the value of OBJECT's FEATURE.
 438 */
 439        (object, feature))
 440 {
 441   struct gcpro gcpro1, gcpro2;
 442   Lisp_Object obj_string;
 443   unsigned char* c_obj;
 444   CONCORD_Genre c_genre;
 445   unsigned char* feature_name;
 446   CONCORD_Feature c_feature;
 447   int status;
 448   CONCORD_String_Tank st_value;
 449
 450   CHECK_CONCORD_OBJECT (object);
 451   if ( !STRINGP(feature) )
 452     feature = Fsymbol_name (feature);
 453   GCPRO2 (object, feature);
 454   obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
 455   UNGCPRO;
 456   TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
 457                       C_STRING_ALLOCA, c_obj, Qfile_name);
 458   c_genre = XCONCORD_OBJECT_GENRE(object);
 459   TO_EXTERNAL_FORMAT (LISP_STRING, feature,
 460                       C_STRING_ALLOCA, feature_name,
 461                       Qfile_name);
 462   c_feature = concord_genre_get_feature (c_genre, feature_name);
 463   if (c_feature == NULL)
 464     {
 465       return Qnil;
 466     }
 467   status = concord_obj_get_feature_value_string (c_obj, c_feature,
 468                                                  &st_value);
 469   if (!status)
 470     {
 471       return
 472         Fcar (Fread_from_string (make_ext_string
 473                                  (CONCORD_String_data (&st_value),
 474                                   CONCORD_String_size (&st_value),
 475                                   Qfile_name),
 476                                  Qnil, Qnil));
 477     }
 478   return Qnil;
 479 }
 480
 481 DEFUN ("concord-object-put",
 482        Fconcord_object_put, 3, 3, 0, /*
 483 Store a VALUE of OBJECT's FEATURE.
 484 */
 485        (object, feature, value))
 486 {
 487   struct gcpro gcpro1, gcpro2, gcpro3;
 488   Lisp_Object obj_string;
 489   unsigned char* c_obj;
 490   CONCORD_Genre c_genre;
 491   unsigned char* feature_name;
 492   CONCORD_Feature c_feature;
 493   int status;
 494   Lisp_Object value_string;
 495   unsigned char* c_value;
 496
 497   CHECK_CONCORD_OBJECT (object);
 498   if ( !STRINGP(feature) )
 499     feature = Fsymbol_name (feature);
 500   GCPRO3 (object, feature, value);
 501   obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
 502   UNGCPRO;
 503   TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
 504                       C_STRING_ALLOCA, c_obj, Qfile_name);
 505   c_genre = XCONCORD_OBJECT_GENRE(object);
 506   TO_EXTERNAL_FORMAT (LISP_STRING, feature,
 507                       C_STRING_ALLOCA, feature_name,
 508                       Qfile_name);
 509   c_feature = concord_genre_get_feature (c_genre, feature_name);
 510   if (c_feature == NULL)
 511     {
 512       return Qnil;
 513     }
 514   GCPRO3 (object, feature, value);
 515   value_string = Fprin1_to_string (value, Qnil);
 516   UNGCPRO;
 517   TO_EXTERNAL_FORMAT (LISP_STRING, value_string,
 518                       C_STRING_ALLOCA, c_value,
 519                       Qfile_name);
 520   status = concord_obj_put_feature_value_str (c_obj, c_feature, c_value);
 521   if (status)
 522     return Qnil;
 523   status = chise_feature_sync (c_feature);
 524   if (status)
 525     return Qnil;
 526   return Qt;
 527 }
 528
 529 struct closure_for_object_spec
 530 {
 531   unsigned char* object_id;
 532   Lisp_Object spec;
 533 } *concord_object_spec_closure;
 534
 535 static int
 536 add_feature_to_spec_mapper (CONCORD_Genre genre, unsigned char* name)
 537 {
 538   /* This function can GC */
 539   CONCORD_String_Tank st_value;
 540   CONCORD_Feature c_feature;
 541   int status;
 542
 543   c_feature = concord_genre_get_feature (genre, name);
 544   if (c_feature == NULL)
 545     return 0;
 546
 547   status =
 548     concord_obj_get_feature_value_string
 549     (concord_object_spec_closure->object_id, c_feature, &st_value);
 550   if (!status)
 551     {
 552       concord_object_spec_closure->spec
 553         = Fcons (Fcons (intern (name),
 554                         Fcar (Fread_from_string
 555                               (make_ext_string
 556                                (CONCORD_String_data (&st_value),
 557                                 CONCORD_String_size (&st_value),
 558                                 Qfile_name),
 559                                Qnil, Qnil))),
 560                  concord_object_spec_closure->spec);
 561     }
 562   return 0;
 563 }
 564
 565 DEFUN ("concord-object-spec", Fconcord_object_spec, 1, 1, 0, /*
 566 Return the spec of OBJECT.
 567 */
 568        (object))
 569 {
 570   Lisp_Object obj_string;
 571   unsigned char* c_obj;
 572   CONCORD_Genre c_genre;
 573   struct gcpro gcpro1, gcpro2;
 574
 575   CHECK_CONCORD_OBJECT (object);
 576   GCPRO1 (object);
 577   obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
 578   UNGCPRO;
 579   TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
 580                       C_STRING_ALLOCA, c_obj, Qfile_name);
 581   c_genre = XCONCORD_OBJECT_GENRE(object);
 582   concord_object_spec_closure
 583     = alloca (sizeof (struct closure_for_object_spec));
 584   concord_object_spec_closure->object_id = c_obj;
 585   concord_object_spec_closure->spec = Qnil;
 586   GCPRO2 (object, concord_object_spec_closure->spec);
 587   concord_genre_foreach_feature_name (c_genre,
 588                                       add_feature_to_spec_mapper);
 589   UNGCPRO;
 590   return concord_object_spec_closure->spec;
 591 }
 592
 593 struct closure_for_each_object
 594 {
 595   Lisp_Object function;
 596   Lisp_Object genre;
 597   Lisp_Object ds;
 598   Lisp_Object ret;
 599 } *for_each_object_closure;
 600
 601 static int
 602 func_for_each_object (CONCORD_String object_id,
 603                       CONCORD_Feature feature,
 604                       CONCORD_String value)
 605 {
 606   Lisp_Object obj, val, ret;
 607
 608 #if 0
 609   obj = read_from_c_string (CONCORD_String_data (object_id),
 610                             CONCORD_String_size (object_id) );
 611 #else
 612   obj = Fcar (Fread_from_string (make_ext_string
 613                                  (CONCORD_String_data (object_id),
 614                                   CONCORD_String_size (object_id),
 615                                   Qfile_name),
 616                                  Qnil, Qnil));
 617 #endif
 618   obj = Fconcord_make_object (obj,
 619                               for_each_object_closure->genre,
 620                               for_each_object_closure->ds);
 621 #if 0
 622   val = read_from_c_string (CONCORD_String_data (value),
 623                             CONCORD_String_size (value) );
 624 #else
 625   val = Fcar (Fread_from_string (make_ext_string
 626                                  (CONCORD_String_data (value),
 627                                   CONCORD_String_size (value),
 628                                   Qfile_name),
 629                                  Qnil, Qnil));
 630 #endif
 631   ret = call2 (for_each_object_closure->function, obj, val);
 632   for_each_object_closure->ret = ret;
 633   return !NILP (ret);
 634 }
 635
 636 DEFUN ("concord-for-each-object-in-feature",
 637        Fconcord_foreach_object_in_feature, 2, 4, 0, /*
 638 Do FUNCTION over objects in FEATURE, calling it with two args,
 639 each key and value in the FEATURE table.
 640 Optional argument GENRE specifies the genre of the FEATURE.
 641 When the FUNCTION returns non-nil, it breaks the repeat.
 642 */
 643        (function, feature, genre, ds))
 644 {
 645   Lisp_CONCORD_DS* lds;
 646   unsigned char* genre_name;
 647   CONCORD_Genre c_genre;
 648   unsigned char* feature_name;
 649   CONCORD_Feature c_feature;
 650
 651   if ( !STRINGP(feature) )
 652     feature = Fsymbol_name (feature);
 653   if ( !STRINGP(genre) )
 654     genre = Fsymbol_name (genre);
 655   CHECK_CONCORD_DS (ds);
 656   lds = XCONCORD_DS (ds);
 657   if (lds->ds == NULL)
 658     return Qnil;
 659   TO_EXTERNAL_FORMAT (LISP_STRING, genre,
 660                       C_STRING_ALLOCA, genre_name,
 661                       Qfile_name);
 662   c_genre = concord_ds_get_genre (lds->ds, genre_name);
 663   if (c_genre == NULL)
 664     return Qnil;
 665
 666   CHECK_STRING (feature);
 667   TO_EXTERNAL_FORMAT (LISP_STRING, feature,
 668                       C_STRING_ALLOCA, feature_name,
 669                       Qfile_name);
 670   c_feature = concord_genre_get_feature (c_genre, feature_name);
 671   if (c_feature == NULL)
 672     return Qnil;
 673   for_each_object_closure
 674     = alloca (sizeof (struct closure_for_each_object));
 675   for_each_object_closure->function = function;
 676   for_each_object_closure->genre = genre;
 677   for_each_object_closure->ds = ds;
 678   for_each_object_closure->ret = Qnil;
 679   concord_feature_foreach_obj_string (c_feature, func_for_each_object);
 680   /* return Qt; */
 681   return for_each_object_closure->ret;
 682 }
 683
 684 void
 685 syms_of_concord (void)
 686 {
 687   INIT_LRECORD_IMPLEMENTATION (concord_ds);
 688   INIT_LRECORD_IMPLEMENTATION (concord_object);
 689
 690   defsymbol (&Qconcord, "concord");
 691   defsymbol (&Qconcord_dsp, "concord-dsp");
 692   defsymbol (&Qconcord_objectp, "concord-objectp");
 693
 694   DEFSUBR (Fconcord_open_ds);
 695   DEFSUBR (Fconcord_ds_p);
 696   DEFSUBR (Fconcord_close_ds);
 697   DEFSUBR (Fconcord_feature_list);
 698   DEFSUBR (Fconcord_make_object);
 699   DEFSUBR (Fconcord_object_p);
 700   DEFSUBR (Fconcord_object_id);
 701   DEFSUBR (Fconcord_decode_object);
 702   DEFSUBR (Fconcord_object_get);
 703   DEFSUBR (Fconcord_object_put);
 704   DEFSUBR (Fconcord_object_spec);
 705   DEFSUBR (Fconcord_foreach_object_in_feature);
 706 }
 707
 708 void
 709 vars_of_concord (void)
 710 {
 711   Fprovide (Qconcord);
 712 }