Mercurial > hg > xemacs-beta
diff src/abbrev.c @ 5118:e0db3c197671 ben-lisp-object
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 |
line wrap: on
line diff
--- a/src/abbrev.c Sat Dec 26 00:20:27 2009 -0600 +++ b/src/abbrev.c Sat Dec 26 21:18:49 2009 -0600 @@ -75,6 +75,7 @@ /* Hook to run before expanding any abbrev. */ Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; +Lisp_Object Qsystem_type, Qcount; struct abbrev_match_mapper_closure { @@ -402,12 +403,169 @@ return Vlast_abbrev; } +static void +write_abbrev (Lisp_Object sym, Lisp_Object stream) +{ + Lisp_Object name, count, system_flag; + /* This function can GC */ + struct buffer *buf = current_buffer; + + if (INTP (XSYMBOL (sym)->plist)) + { + count = XSYMBOL (sym)->plist; + system_flag = Qnil; + } + else + { + count = Fget (sym, Qcount, Qunbound); + system_flag = Fget (sym, Qsystem_type, Qunbound); + } + + if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag)) + return; + + buffer_insert_c_string (buf, " ("); + name = Fsymbol_name (sym); + Fprin1 (name, stream); + buffer_insert_c_string (buf, " "); + Fprin1 (XSYMBOL_VALUE (sym), stream); + buffer_insert_c_string (buf, " "); + Fprin1 (XSYMBOL (sym)->function, stream); + buffer_insert_c_string (buf, " "); + Fprin1 (count, stream); + buffer_insert_c_string (buf, ")\n"); +} + +static void +describe_abbrev (Lisp_Object sym, Lisp_Object stream) +{ + Lisp_Object one, count, system_flag; + /* This function can GC */ + struct buffer *buf = current_buffer; + + if (INTP (XSYMBOL (sym)->plist)) + { + count = XSYMBOL (sym)->plist; + system_flag = Qnil; + } + else + { + count = Fget (sym, Qcount, Qunbound); + system_flag = Fget (sym, Qsystem_type, Qunbound); + } + + if (NILP (XSYMBOL_VALUE (sym))) + return; + + one = make_int (1); + Fprin1 (Fsymbol_name (sym), stream); + + if (!NILP (system_flag)) + { + buffer_insert_c_string (buf, " (sys)"); + Findent_to (make_int (20), one, Qnil); + } + else + Findent_to (make_int (15), one, Qnil); + + Fprin1 (count, stream); + Findent_to (make_int (20), one, Qnil); + Fprin1 (XSYMBOL_VALUE (sym), stream); + if (!NILP (XSYMBOL (sym)->function)) + { + Findent_to (make_int (45), one, Qnil); + Fprin1 (XSYMBOL (sym)->function, stream); + } + buffer_insert_c_string (buf, "\n"); +} + +static int +record_symbol (Lisp_Object sym, void *arg) +{ + Lisp_Object closure = * (Lisp_Object *) arg; + XSETCDR (closure, Fcons (sym, XCDR (closure))); + return 0; /* Never stop */ +} + +DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, + 1, 2, 0, /* +Insert before point a full description of abbrev table named NAME. +NAME is a symbol whose value is an abbrev table. +If optional 2nd arg READABLE is non-nil, a human-readable description +is inserted. Otherwise the description is an expression, +a call to `define-abbrev-table', which would +define the abbrev table NAME exactly as it is currently defined. + +Abbrevs marked as "system abbrevs" are normally omitted. However, if +READABLE is non-nil, they are listed. */ + (name, readable)) +{ + Lisp_Object table; + Lisp_Object symbols; + Lisp_Object stream; + /* This function can GC */ + struct buffer *buf = current_buffer; + + CHECK_SYMBOL (name); + table = Fsymbol_value (name); + CHECK_VECTOR (table); + + /* FIXME: what's the XEmacs equivalent? APA */ + /* XSETBUFFER (stream, current_buffer); */ + /* Does not seem to work: */ + /* Fset_buffer (stream); */ + stream = wrap_buffer (current_buffer); + + symbols = Fcons (Qnil, Qnil); + /* Lisp_Object closure = Fcons (Qnil, Qnil); */ + /* struct gcpro gcpro1; */ + /* GCPRO1 (closure); */ + /* map_obarray (table, record_symbol, symbols); */ + map_obarray (table, record_symbol, &symbols); + /* map_obarray (table, record_symbol, &closure); */ + symbols = XCDR (symbols); + symbols = Fsort (symbols, Qstring_lessp); + + if (!NILP (readable)) + { + buffer_insert_c_string (buf, "("); + Fprin1 (name, stream); + buffer_insert_c_string (buf, ")\n\n"); + while (! NILP (symbols)) + { + describe_abbrev (XCAR (symbols), stream); + symbols = XCDR (symbols); + } + + buffer_insert_c_string (buf, "\n\n"); + } + else + { + buffer_insert_c_string (buf, "(define-abbrev-table '"); + Fprin1 (name, stream); + buffer_insert_c_string (buf, " '(\n"); + while (! NILP (symbols)) + { + write_abbrev (XCAR (symbols), stream); + symbols = XCDR (symbols); + } + buffer_insert_c_string (buf, " ))\n\n"); + } + + return Qnil; +} void syms_of_abbrev (void) { + DEFSYMBOL(Qcount); + Qcount = intern ("count"); + staticpro (&Qcount); + DEFSYMBOL(Qsystem_type); + Qsystem_type = intern ("system-type"); DEFSYMBOL (Qpre_abbrev_expand_hook); DEFSUBR (Fexpand_abbrev); + DEFSUBR (Finsert_abbrev_table_description); } void