Mercurial > hg > xemacs-beta

comparison src/abbrev.c @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 69c43a181729
children 6ef8256a020a 304aebb79cd3
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
73 Fixnum last_abbrev_location; 73 Fixnum last_abbrev_location;
74 74
75 /* Hook to run before expanding any abbrev. */ 75 /* Hook to run before expanding any abbrev. */
76 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; 76 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
77 77
78 Lisp_Object Qsystem_type, Qcount;
78 79
79 struct abbrev_match_mapper_closure 80 struct abbrev_match_mapper_closure
80 { 81 {
81 struct buffer *buf; 82 struct buffer *buf;
82 Lisp_Object chartab; 83 Lisp_Object chartab;
400 call0 (hook); 401 call0 (hook);
401 402
402 return Vlast_abbrev; 403 return Vlast_abbrev;
403 } 404 }
404 405
406 static void
407 write_abbrev (Lisp_Object sym, Lisp_Object stream)
408 {
409 Lisp_Object name, count, system_flag;
410 /* This function can GC */
411 struct buffer *buf = current_buffer;
412
413 if (INTP (XSYMBOL (sym)->plist))
414 {
415 count = XSYMBOL (sym)->plist;
416 system_flag = Qnil;
417 }
418 else
419 {
420 count = Fget (sym, Qcount, Qunbound);
421 system_flag = Fget (sym, Qsystem_type, Qunbound);
422 }
423
424 if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag))
425 return;
426
427 buffer_insert_c_string (buf, " (");
428 name = Fsymbol_name (sym);
429 Fprin1 (name, stream);
430 buffer_insert_c_string (buf, " ");
431 Fprin1 (XSYMBOL_VALUE (sym), stream);
432 buffer_insert_c_string (buf, " ");
433 Fprin1 (XSYMBOL (sym)->function, stream);
434 buffer_insert_c_string (buf, " ");
435 Fprin1 (count, stream);
436 buffer_insert_c_string (buf, ")\n");
437 }
438
439 static void
440 describe_abbrev (Lisp_Object sym, Lisp_Object stream)
441 {
442 Lisp_Object one, count, system_flag;
443 /* This function can GC */
444 struct buffer *buf = current_buffer;
445
446 if (INTP (XSYMBOL (sym)->plist))
447 {
448 count = XSYMBOL (sym)->plist;
449 system_flag = Qnil;
450 }
451 else
452 {
453 count = Fget (sym, Qcount, Qunbound);
454 system_flag = Fget (sym, Qsystem_type, Qunbound);
455 }
456
457 if (NILP (XSYMBOL_VALUE (sym)))
458 return;
459
460 one = make_int (1);
461 Fprin1 (Fsymbol_name (sym), stream);
462
463 if (!NILP (system_flag))
464 {
465 buffer_insert_c_string (buf, " (sys)");
466 Findent_to (make_int (20), one, Qnil);
467 }
468 else
469 Findent_to (make_int (15), one, Qnil);
470
471 Fprin1 (count, stream);
472 Findent_to (make_int (20), one, Qnil);
473 Fprin1 (XSYMBOL_VALUE (sym), stream);
474 if (!NILP (XSYMBOL (sym)->function))
475 {
476 Findent_to (make_int (45), one, Qnil);
477 Fprin1 (XSYMBOL (sym)->function, stream);
478 }
479 buffer_insert_c_string (buf, "\n");
480 }
481
482 static int
483 record_symbol (Lisp_Object sym, void *arg)
484 {
485 Lisp_Object closure = * (Lisp_Object *) arg;
486 XSETCDR (closure, Fcons (sym, XCDR (closure)));
487 return 0; /* Never stop */
488 }
489
490 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
491 1, 2, 0, /*
492 Insert before point a full description of abbrev table named NAME.
493 NAME is a symbol whose value is an abbrev table.
494 If optional 2nd arg READABLE is non-nil, a human-readable description
495 is inserted. Otherwise the description is an expression,
496 a call to `define-abbrev-table', which would
497 define the abbrev table NAME exactly as it is currently defined.
498
499 Abbrevs marked as "system abbrevs" are normally omitted. However, if
500 READABLE is non-nil, they are listed. */
501 (name, readable))
502 {
503 Lisp_Object table;
504 Lisp_Object symbols;
505 Lisp_Object stream;
506 /* This function can GC */
507 struct buffer *buf = current_buffer;
508
509 CHECK_SYMBOL (name);
510 table = Fsymbol_value (name);
511 CHECK_VECTOR (table);
512
513 /* FIXME: what's the XEmacs equivalent? APA */
514 /* XSETBUFFER (stream, current_buffer); */
515 /* Does not seem to work: */
516 /* Fset_buffer (stream); */
517 stream = wrap_buffer (current_buffer);
518
519 symbols = Fcons (Qnil, Qnil);
520 /* Lisp_Object closure = Fcons (Qnil, Qnil); */
521 /* struct gcpro gcpro1; */
522 /* GCPRO1 (closure); */
523 /* map_obarray (table, record_symbol, symbols); */
524 map_obarray (table, record_symbol, &symbols);
525 /* map_obarray (table, record_symbol, &closure); */
526 symbols = XCDR (symbols);
527 symbols = Fsort (symbols, Qstring_lessp);
528
529 if (!NILP (readable))
530 {
531 buffer_insert_c_string (buf, "(");
532 Fprin1 (name, stream);
533 buffer_insert_c_string (buf, ")\n\n");
534 while (! NILP (symbols))
535 {
536 describe_abbrev (XCAR (symbols), stream);
537 symbols = XCDR (symbols);
538 }
539
540 buffer_insert_c_string (buf, "\n\n");
541 }
542 else
543 {
544 buffer_insert_c_string (buf, "(define-abbrev-table '");
545 Fprin1 (name, stream);
546 buffer_insert_c_string (buf, " '(\n");
547 while (! NILP (symbols))
548 {
549 write_abbrev (XCAR (symbols), stream);
550 symbols = XCDR (symbols);
551 }
552 buffer_insert_c_string (buf, " ))\n\n");
553 }
554
555 return Qnil;
556 }
405 557
406 void 558 void
407 syms_of_abbrev (void) 559 syms_of_abbrev (void)
408 { 560 {
561 DEFSYMBOL(Qcount);
562 Qcount = intern ("count");
563 staticpro (&Qcount);
564 DEFSYMBOL(Qsystem_type);
565 Qsystem_type = intern ("system-type");
409 DEFSYMBOL (Qpre_abbrev_expand_hook); 566 DEFSYMBOL (Qpre_abbrev_expand_hook);
410 DEFSUBR (Fexpand_abbrev); 567 DEFSUBR (Fexpand_abbrev);
568 DEFSUBR (Finsert_abbrev_table_description);
411 } 569 }
412 570
413 void 571 void
414 vars_of_abbrev (void) 572 vars_of_abbrev (void)
415 { 573 {