#include <config.h>
#include <stdio.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "window.h"
#include "charset.h"
#include "syntax.h"
Lisp_Object Vabbrev_table_name_list;
Lisp_Object Vglobal_abbrev_table;
Lisp_Object Vfundamental_mode_abbrev_table;
int abbrevs_changed;
int abbrev_all_caps;
Lisp_Object Vabbrev_start_location;
Lisp_Object Vabbrev_start_location_buffer;
Lisp_Object Vlast_abbrev;
Lisp_Object Vlast_abbrev_text;
EMACS_INT last_abbrev_point;
Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
Lisp_Object Qsystem_type, Qcount, Qforce;
DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
doc: )
()
{
return Fmake_vector (make_number (59), make_number (0));
}
DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
doc: )
(table)
Lisp_Object table;
{
int i, size;
CHECK_VECTOR (table);
size = XVECTOR (table)->size;
abbrevs_changed = 1;
for (i = 0; i < size; i++)
XVECTOR (table)->contents[i] = make_number (0);
return Qnil;
}
DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 6, 0,
doc: )
(table, name, expansion, hook, count, system_flag)
Lisp_Object table, name, expansion, hook, count, system_flag;
{
Lisp_Object sym, oexp, ohook, tem;
CHECK_VECTOR (table);
CHECK_STRING (name);
if (!NILP (system_flag) && !EQ (system_flag, Qforce))
{
sym = Fintern_soft (name, table);
if (!NILP (SYMBOL_VALUE (sym)) &&
NILP (Fplist_get (XSYMBOL (sym)->plist, Qsystem_type))) return Qnil;
}
if (NILP (count))
count = make_number (0);
else
CHECK_NUMBER (count);
sym = Fintern (name, table);
oexp = SYMBOL_VALUE (sym);
ohook = XSYMBOL (sym)->function;
if (!((EQ (oexp, expansion)
|| (STRINGP (oexp) && STRINGP (expansion)
&& (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
&&
(EQ (ohook, hook)
|| (tem = Fequal (ohook, hook), !NILP (tem))))
&& NILP (system_flag))
abbrevs_changed = 1;
Fset (sym, expansion);
Ffset (sym, hook);
if (! NILP (system_flag))
Fsetplist (sym, list4 (Qcount, count, Qsystem_type, system_flag));
else
Fsetplist (sym, count);
return name;
}
DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
"sDefine global abbrev: \nsExpansion for %s: ",
doc: )
(abbrev, expansion)
Lisp_Object abbrev, expansion;
{
Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (abbrev),
expansion, Qnil, make_number (0), Qnil);
return abbrev;
}
DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
"sDefine mode abbrev: \nsExpansion for %s: ",
doc: )
(abbrev, expansion)
Lisp_Object abbrev, expansion;
{
if (NILP (current_buffer->abbrev_table))
error ("Major mode has no abbrev table");
Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (abbrev),
expansion, Qnil, make_number (0), Qnil);
return abbrev;
}
DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
doc: )
(abbrev, table)
Lisp_Object abbrev, table;
{
Lisp_Object sym;
CHECK_STRING (abbrev);
if (!NILP (table))
sym = Fintern_soft (abbrev, table);
else
{
sym = Qnil;
if (!NILP (current_buffer->abbrev_table))
sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
if (NILP (SYMBOL_VALUE (sym)))
sym = Qnil;
if (NILP (sym))
sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
}
if (NILP (SYMBOL_VALUE (sym)))
return Qnil;
return sym;
}
DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
doc: )
(abbrev, table)
Lisp_Object abbrev, table;
{
Lisp_Object sym;
sym = Fabbrev_symbol (abbrev, table);
if (NILP (sym)) return sym;
return Fsymbol_value (sym);
}
DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
doc: )
()
{
register char *buffer, *p;
int wordstart, wordend;
register int wordstart_byte, wordend_byte, idx, idx_byte;
int whitecnt;
int uccount = 0, lccount = 0;
register Lisp_Object sym;
Lisp_Object expansion, hook, tem;
Lisp_Object value;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
value = Qnil;
Frun_hooks (1, &Qpre_abbrev_expand_hook);
wordstart = 0;
if (!(BUFFERP (Vabbrev_start_location_buffer)
&& XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
Vabbrev_start_location = Qnil;
if (!NILP (Vabbrev_start_location))
{
tem = Vabbrev_start_location;
CHECK_NUMBER_COERCE_MARKER (tem);
wordstart = XINT (tem);
Vabbrev_start_location = Qnil;
if (wordstart < BEGV || wordstart > ZV)
wordstart = 0;
if (wordstart && wordstart != ZV)
{
wordstart_byte = CHAR_TO_BYTE (wordstart);
if (FETCH_BYTE (wordstart_byte) == '-')
del_range (wordstart, wordstart + 1);
}
}
if (!wordstart)
wordstart = scan_words (PT, -1);
if (!wordstart)
return value;
wordstart_byte = CHAR_TO_BYTE (wordstart);
wordend = scan_words (wordstart, 1);
if (!wordend)
return value;
if (wordend > PT)
wordend = PT;
wordend_byte = CHAR_TO_BYTE (wordend);
whitecnt = PT - wordend;
if (wordend <= wordstart)
return value;
p = buffer = (char *) alloca (wordend_byte - wordstart_byte);
for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; )
{
register int c;
if (multibyte)
{
FETCH_CHAR_ADVANCE (c, idx, idx_byte);
}
else
{
c = FETCH_BYTE (idx_byte);
idx++, idx_byte++;
}
if (UPPERCASEP (c))
c = DOWNCASE (c), uccount++;
else if (! NOCASEP (c))
lccount++;
if (multibyte)
p += CHAR_STRING (c, p);
else
*p++ = c;
}
if (VECTORP (current_buffer->abbrev_table))
sym = oblookup (current_buffer->abbrev_table, buffer,
wordend - wordstart, p - buffer);
else
XSETFASTINT (sym, 0);
if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
sym = oblookup (Vglobal_abbrev_table, buffer,
wordend - wordstart, p - buffer);
if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
return value;
if (INTERACTIVE && !EQ (minibuf_window, selected_window))
{
SET_PT (wordend);
Fundo_boundary ();
}
Vlast_abbrev_text
= Fbuffer_substring (make_number (wordstart), make_number (wordend));
Vlast_abbrev = sym;
value = sym;
last_abbrev_point = wordstart;
if (INTEGERP (XSYMBOL (sym)->plist))
XSETINT (XSYMBOL (sym)->plist,
XINT (XSYMBOL (sym)->plist) + 1);
else if (INTEGERP (tem = Fget (sym, Qcount)))
Fput (sym, Qcount, make_number (XINT (tem) + 1));
expansion = SYMBOL_VALUE (sym);
if (STRINGP (expansion))
{
SET_PT (wordstart);
insert_from_string (expansion, 0, 0, SCHARS (expansion),
SBYTES (expansion), 1);
del_range_both (PT, PT_BYTE,
wordend + (PT - wordstart),
wordend_byte + (PT_BYTE - wordstart_byte),
1);
SET_PT (PT + whitecnt);
if (uccount && !lccount)
{
if (!abbrev_all_caps)
if (scan_words (PT, -1) > scan_words (wordstart, 1))
{
Fupcase_initials_region (make_number (wordstart),
make_number (PT));
goto caped;
}
Fupcase_region (make_number (wordstart), make_number (PT));
caped: ;
}
else if (uccount)
{
int pos = wordstart_byte;
while (pos < PT_BYTE
&& SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
pos++;
pos = BYTE_TO_CHAR (pos);
Fupcase_initials_region (make_number (pos), make_number (pos + 1));
}
}
hook = XSYMBOL (sym)->function;
if (!NILP (hook))
{
Lisp_Object expanded, prop;
expanded = call0 (hook);
if (SYMBOLP (hook)
&& NILP (expanded)
&& (prop = Fget (hook, intern ("no-self-insert")),
!NILP (prop)))
value = Qnil;
}
return value;
}
DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
doc: )
()
{
int opoint = PT;
int adjust = 0;
if (last_abbrev_point < BEGV
|| last_abbrev_point > ZV)
return Qnil;
SET_PT (last_abbrev_point);
if (STRINGP (Vlast_abbrev_text))
{
Lisp_Object val;
int zv_before;
val = SYMBOL_VALUE (Vlast_abbrev);
if (!STRINGP (val))
error ("Value of `abbrev-symbol' must be a string");
zv_before = ZV;
del_range_byte (PT_BYTE, PT_BYTE + SBYTES (val), 1);
insert_from_string (Vlast_abbrev_text, 0, 0,
SCHARS (Vlast_abbrev_text),
SBYTES (Vlast_abbrev_text), 0);
Vlast_abbrev_text = Qnil;
adjust = ZV - zv_before;
}
SET_PT (last_abbrev_point < opoint ? opoint + adjust : opoint);
return Qnil;
}
static void
write_abbrev (sym, stream)
Lisp_Object sym, stream;
{
Lisp_Object name, count, system_flag;
if (INTEGERP (XSYMBOL (sym)->plist))
{
count = XSYMBOL (sym)->plist;
system_flag = Qnil;
}
else
{
count = Fget (sym, Qcount);
system_flag = Fget (sym, Qsystem_type);
}
if (NILP (SYMBOL_VALUE (sym)) || ! NILP (system_flag))
return;
insert (" (", 5);
name = SYMBOL_NAME (sym);
Fprin1 (name, stream);
insert (" ", 1);
Fprin1 (SYMBOL_VALUE (sym), stream);
insert (" ", 1);
Fprin1 (XSYMBOL (sym)->function, stream);
insert (" ", 1);
Fprin1 (count, stream);
insert (")\n", 2);
}
static void
describe_abbrev (sym, stream)
Lisp_Object sym, stream;
{
Lisp_Object one, count, system_flag;
if (INTEGERP (XSYMBOL (sym)->plist))
{
count = XSYMBOL (sym)->plist;
system_flag = Qnil;
}
else
{
count = Fget (sym, Qcount);
system_flag = Fget (sym, Qsystem_type);
}
if (NILP (SYMBOL_VALUE (sym)))
return;
one = make_number (1);
Fprin1 (Fsymbol_name (sym), stream);
if (!NILP (system_flag))
{
insert_string (" (sys)");
Findent_to (make_number (20), one);
}
else
Findent_to (make_number (15), one);
Fprin1 (count, stream);
Findent_to (make_number (20), one);
Fprin1 (SYMBOL_VALUE (sym), stream);
if (!NILP (XSYMBOL (sym)->function))
{
Findent_to (make_number (45), one);
Fprin1 (XSYMBOL (sym)->function, stream);
}
Fterpri (stream);
}
static void
record_symbol (sym, list)
Lisp_Object sym, list;
{
XSETCDR (list, Fcons (sym, XCDR (list)));
}
DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
Sinsert_abbrev_table_description, 1, 2, 0,
doc: )
(name, readable)
Lisp_Object name, readable;
{
Lisp_Object table;
Lisp_Object symbols;
Lisp_Object stream;
CHECK_SYMBOL (name);
table = Fsymbol_value (name);
CHECK_VECTOR (table);
XSETBUFFER (stream, current_buffer);
symbols = Fcons (Qnil, Qnil);
map_obarray (table, record_symbol, symbols);
symbols = XCDR (symbols);
symbols = Fsort (symbols, Qstring_lessp);
if (!NILP (readable))
{
insert_string ("(");
Fprin1 (name, stream);
insert_string (")\n\n");
while (! NILP (symbols))
{
describe_abbrev (XCAR (symbols), stream);
symbols = XCDR (symbols);
}
insert_string ("\n\n");
}
else
{
insert_string ("(define-abbrev-table '");
Fprin1 (name, stream);
insert_string (" '(\n");
while (! NILP (symbols))
{
write_abbrev (XCAR (symbols), stream);
symbols = XCDR (symbols);
}
insert_string (" ))\n\n");
}
return Qnil;
}
DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
2, 2, 0,
doc: )
(tablename, definitions)
Lisp_Object tablename, definitions;
{
Lisp_Object name, exp, hook, count;
Lisp_Object table, elt, sys;
CHECK_SYMBOL (tablename);
table = Fboundp (tablename);
if (NILP (table) || (table = Fsymbol_value (tablename), NILP (table)))
{
table = Fmake_abbrev_table ();
Fset (tablename, table);
Vabbrev_table_name_list = Fcons (tablename, Vabbrev_table_name_list);
}
CHECK_VECTOR (table);
for (; CONSP (definitions); definitions = XCDR (definitions))
{
elt = XCAR (definitions);
name = Fcar (elt); elt = Fcdr (elt);
exp = Fcar (elt); elt = Fcdr (elt);
hook = Fcar (elt); elt = Fcdr (elt);
count = Fcar (elt); elt = Fcdr (elt);
sys = Fcar (elt);
Fdefine_abbrev (table, name, exp, hook, count, sys);
}
return Qnil;
}
void
syms_of_abbrev ()
{
Qsystem_type = intern ("system-type");
staticpro (&Qsystem_type);
Qcount = intern ("count");
staticpro (&Qcount);
Qforce = intern ("force");
staticpro (&Qforce);
DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
doc: );
Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
Fcons (intern ("global-abbrev-table"),
Qnil));
DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
doc: );
Vglobal_abbrev_table = Fmake_abbrev_table ();
DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
doc: );
Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table;
DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
doc: );
DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
doc: );
DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
doc: );
Vlast_abbrev = Qnil;
Vlast_abbrev_text = Qnil;
last_abbrev_point = 0;
DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
doc: );
Vabbrev_start_location = Qnil;
DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
doc: );
Vabbrev_start_location_buffer = Qnil;
DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table, Qnil,
doc: );
DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
doc: );
abbrevs_changed = 0;
DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
doc: );
abbrev_all_caps = 0;
DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
doc: );
Vpre_abbrev_expand_hook = Qnil;
Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
staticpro (&Qpre_abbrev_expand_hook);
defsubr (&Smake_abbrev_table);
defsubr (&Sclear_abbrev_table);
defsubr (&Sdefine_abbrev);
defsubr (&Sdefine_global_abbrev);
defsubr (&Sdefine_mode_abbrev);
defsubr (&Sabbrev_expansion);
defsubr (&Sabbrev_symbol);
defsubr (&Sexpand_abbrev);
defsubr (&Sunexpand_abbrev);
defsubr (&Sinsert_abbrev_table_description);
defsubr (&Sdefine_abbrev_table);
}