Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 227:0e522484dd2a r20-5b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b12
author cvs
date Mon, 13 Aug 2007 10:12:37 +0200
parents 78478c60bfcd
children 41f2f0e326e9
comparison
equal deleted inserted replaced
226:eea38c7ad7b4 227:0e522484dd2a
364 } 364 }
365 } 365 }
366 return hash & 07777777777; 366 return hash & 07777777777;
367 } 367 }
368 368
369 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
370 non-zero value. */
369 void 371 void
370 map_obarray (Lisp_Object obarray, 372 map_obarray (Lisp_Object obarray,
371 void (*fn) (Lisp_Object sym, Lisp_Object arg), 373 int (*fn) (Lisp_Object, void *), void *arg)
372 Lisp_Object arg)
373 { 374 {
374 REGISTER int i; 375 REGISTER int i;
375 Lisp_Object tail; 376 Lisp_Object tail;
377
376 CHECK_VECTOR (obarray); 378 CHECK_VECTOR (obarray);
377 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--) 379 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
378 { 380 {
379 tail = XVECTOR_DATA (obarray)[i]; 381 tail = XVECTOR_DATA (obarray)[i];
380 if (SYMBOLP (tail)) 382 if (SYMBOLP (tail))
381 while (1) 383 while (1)
382 { 384 {
383 struct Lisp_Symbol *next; 385 struct Lisp_Symbol *next;
384 (*fn) (tail, arg); 386 if ((*fn) (tail, arg))
387 return;
385 next = symbol_next (XSYMBOL (tail)); 388 next = symbol_next (XSYMBOL (tail));
386 if (!next) 389 if (!next)
387 break; 390 break;
388 XSETSYMBOL (tail, next); 391 XSETSYMBOL (tail, next);
389 } 392 }
390 } 393 }
391 } 394 }
392 395
393 static void 396 static int
394 mapatoms_1 (Lisp_Object sym, Lisp_Object function) 397 mapatoms_1 (Lisp_Object sym, void *arg)
395 { 398 {
396 call1 (function, sym); 399 call1 (*(Lisp_Object *)arg, sym);
400 return 0;
397 } 401 }
398 402
399 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /* 403 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
400 Call FUNCTION on every symbol in OBARRAY. 404 Call FUNCTION on every symbol in OBARRAY.
401 OBARRAY defaults to the value of `obarray'. 405 OBARRAY defaults to the value of `obarray'.
404 { 408 {
405 if (NILP (obarray)) 409 if (NILP (obarray))
406 obarray = Vobarray; 410 obarray = Vobarray;
407 obarray = check_obarray (obarray); 411 obarray = check_obarray (obarray);
408 412
409 map_obarray (obarray, mapatoms_1, function); 413 map_obarray (obarray, mapatoms_1, &function);
410 return Qnil; 414 return Qnil;
411 } 415 }
412 416
413 417
414 /**********************************************************************/ 418 /**********************************************************************/
415 /* Apropos */ 419 /* Apropos */
416 /**********************************************************************/ 420 /**********************************************************************/
417 421
418 static void 422 struct appropos_mapper_closure {
419 apropos_accum (Lisp_Object symbol, Lisp_Object arg) 423 Lisp_Object regexp;
420 { 424 Lisp_Object predicate;
421 Lisp_Object tem; 425 Lisp_Object accumulation;
422 Lisp_Object string = XCAR (arg); 426 };
423 Lisp_Object predicate = XCAR (XCDR (arg)); 427
424 Lisp_Object *accumulation = &(XCDR (XCDR (arg))); 428 static int
425 429 apropos_mapper (Lisp_Object symbol, void *arg)
426 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil, 430 {
427 /* #### current-buffer dependence is bogus. */ 431 struct appropos_mapper_closure *closure =
428 Fcurrent_buffer ()); 432 (struct appropos_mapper_closure *)arg;
429 if (!NILP (tem) && !NILP (predicate)) 433 Lisp_Object acceptp = Qt;
430 tem = call1 (predicate, symbol); 434 Bytecount match = fast_lisp_string_match (closure->regexp,
431 if (!NILP (tem)) 435 Fsymbol_name (symbol));
432 *accumulation = Fcons (symbol, *accumulation); 436 if (match < 0)
437 acceptp = Qnil;
438 else if (!NILP (closure->predicate))
439 acceptp = call1 (closure->predicate, symbol);
440
441 if (!NILP (acceptp))
442 closure->accumulation = Fcons (symbol, closure->accumulation);
443 return 0;
433 } 444 }
434 445
435 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /* 446 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
436 Show all symbols whose names contain match for REGEXP. 447 Show all symbols whose names contain match for REGEXP.
437 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done 448 If optional 2nd arg PREDICATE is non-nil, (funcall PRED SYM) is done
438 for each symbol and a symbol is mentioned only if that returns non-nil. 449 for each symbol and a symbol is mentioned only if that returns non-nil.
439 Return list of symbols found. 450 Return list of symbols found.
440 */ 451 */
441 (string, pred)) 452 (regexp, predicate))
442 { 453 {
443 struct gcpro gcpro1; 454 struct appropos_mapper_closure closure;
444 Lisp_Object accumulation; 455
445 456 CHECK_STRING (regexp);
446 CHECK_STRING (string); 457
447 accumulation = Fcons (string, Fcons (pred, Qnil)); 458 closure.regexp = regexp;
448 GCPRO1 (accumulation); 459 closure.predicate = predicate;
449 map_obarray (Vobarray, apropos_accum, accumulation); 460 closure.accumulation = Qnil;
450 accumulation = Fsort (Fcdr (Fcdr (accumulation)), Qstring_lessp); 461 map_obarray (Vobarray, apropos_mapper, &closure);
451 UNGCPRO; 462 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
452 return accumulation; 463 return closure.accumulation;
453 } 464 }
454 465
455 466
456 /* Extract and set components of symbols */ 467 /* Extract and set components of symbols */
457 468