(make_lispy_event): Add string info to the event,
[emacs/old-mirror.git] / src / abbrev.c
blobf30986db3434544abf982c99bef37ee41d674eb5
1 /* Primitives for word-abbrev mode.
2 Copyright (C) 1985, 1986, 1993, 1996, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; 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. */
22 #include <config.h>
23 #include <stdio.h>
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "window.h"
28 #include "charset.h"
29 #include "syntax.h"
31 /* An abbrev table is an obarray.
32 Each defined abbrev is represented by a symbol in that obarray
33 whose print name is the abbreviation.
34 The symbol's value is a string which is the expansion.
35 If its function definition is non-nil, it is called
36 after the expansion is done.
37 The plist slot of the abbrev symbol is its usage count. */
39 /* List of all abbrev-table name symbols:
40 symbols whose values are abbrev tables. */
42 Lisp_Object Vabbrev_table_name_list;
44 /* The table of global abbrevs. These are in effect
45 in any buffer in which abbrev mode is turned on. */
47 Lisp_Object Vglobal_abbrev_table;
49 /* The local abbrev table used by default (in Fundamental Mode buffers) */
51 Lisp_Object Vfundamental_mode_abbrev_table;
53 /* Set nonzero when an abbrev definition is changed */
55 int abbrevs_changed;
57 int abbrev_all_caps;
59 /* Non-nil => use this location as the start of abbrev to expand
60 (rather than taking the word before point as the abbrev) */
62 Lisp_Object Vabbrev_start_location;
64 /* Buffer that Vabbrev_start_location applies to */
65 Lisp_Object Vabbrev_start_location_buffer;
67 /* The symbol representing the abbrev most recently expanded */
69 Lisp_Object Vlast_abbrev;
71 /* A string for the actual text of the abbrev most recently expanded.
72 This has more info than Vlast_abbrev since case is significant. */
74 Lisp_Object Vlast_abbrev_text;
76 /* Character address of start of last abbrev expanded */
78 int last_abbrev_point;
80 /* Hook to run before expanding any abbrev. */
82 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
84 DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
85 "Create a new, empty abbrev table object.")
88 return Fmake_vector (make_number (59), make_number (0));
91 DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
92 "Undefine all abbrevs in abbrev table TABLE, leaving it empty.")
93 (table)
94 Lisp_Object table;
96 int i, size;
98 CHECK_VECTOR (table, 0);
99 size = XVECTOR (table)->size;
100 abbrevs_changed = 1;
101 for (i = 0; i < size; i++)
102 XVECTOR (table)->contents[i] = make_number (0);
103 return Qnil;
106 DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 5, 0,
107 "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.\n\
108 NAME must be a string.\n\
109 EXPANSION should usually be a string.\n\
110 To undefine an abbrev, define it with EXPANSION = nil.\n\
111 If HOOK is non-nil, it should be a function of no arguments;\n\
112 it is called after EXPANSION is inserted.\n\
113 If EXPANSION is not a string, the abbrev is a special one,\n\
114 which does not expand in the usual way but only runs HOOK.\n\
115 COUNT, if specified, initializes the abbrev's usage-count\n\
116 which is incremented each time the abbrev is used.")
117 (table, name, expansion, hook, count)
118 Lisp_Object table, name, expansion, hook, count;
120 Lisp_Object sym, oexp, ohook, tem;
121 CHECK_VECTOR (table, 0);
122 CHECK_STRING (name, 1);
124 if (NILP (count))
125 count = make_number (0);
126 else
127 CHECK_NUMBER (count, 0);
129 sym = Fintern (name, table);
131 oexp = XSYMBOL (sym)->value;
132 ohook = XSYMBOL (sym)->function;
133 if (!((EQ (oexp, expansion)
134 || (STRINGP (oexp) && STRINGP (expansion)
135 && (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
137 (EQ (ohook, hook)
138 || (tem = Fequal (ohook, hook), !NILP (tem)))))
139 abbrevs_changed = 1;
141 Fset (sym, expansion);
142 Ffset (sym, hook);
143 Fsetplist (sym, count);
145 return name;
148 DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
149 "sDefine global abbrev: \nsExpansion for %s: ",
150 "Define ABBREV as a global abbreviation for EXPANSION.")
151 (abbrev, expansion)
152 Lisp_Object abbrev, expansion;
154 Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (abbrev),
155 expansion, Qnil, make_number (0));
156 return abbrev;
159 DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
160 "sDefine mode abbrev: \nsExpansion for %s: ",
161 "Define ABBREV as a mode-specific abbreviation for EXPANSION.")
162 (abbrev, expansion)
163 Lisp_Object abbrev, expansion;
165 if (NILP (current_buffer->abbrev_table))
166 error ("Major mode has no abbrev table");
168 Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (abbrev),
169 expansion, Qnil, make_number (0));
170 return abbrev;
173 DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
174 "Return the symbol representing abbrev named ABBREV.\n\
175 This symbol's name is ABBREV, but it is not the canonical symbol of that name;\n\
176 it is interned in an abbrev-table rather than the normal obarray.\n\
177 The value is nil if that abbrev is not defined.\n\
178 Optional second arg TABLE is abbrev table to look it up in.\n\
179 The default is to try buffer's mode-specific abbrev table, then global table.")
180 (abbrev, table)
181 Lisp_Object abbrev, table;
183 Lisp_Object sym;
184 CHECK_STRING (abbrev, 0);
185 if (!NILP (table))
186 sym = Fintern_soft (abbrev, table);
187 else
189 sym = Qnil;
190 if (!NILP (current_buffer->abbrev_table))
191 sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
192 if (NILP (XSYMBOL (sym)->value))
193 sym = Qnil;
194 if (NILP (sym))
195 sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
197 if (NILP (XSYMBOL (sym)->value)) return Qnil;
198 return sym;
201 DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
202 "Return the string that ABBREV expands into in the current buffer.\n\
203 Optionally specify an abbrev table as second arg;\n\
204 then ABBREV is looked up in that table only.")
205 (abbrev, table)
206 Lisp_Object abbrev, table;
208 Lisp_Object sym;
209 sym = Fabbrev_symbol (abbrev, table);
210 if (NILP (sym)) return sym;
211 return Fsymbol_value (sym);
214 /* Expand the word before point, if it is an abbrev.
215 Returns 1 if an expansion is done. */
217 DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
218 "Expand the abbrev before point, if there is an abbrev there.\n\
219 Effective when explicitly called even when `abbrev-mode' is nil.\n\
220 Returns the abbrev symbol, if expansion took place.")
223 register char *buffer, *p;
224 int wordstart, wordend;
225 register int wordstart_byte, wordend_byte, idx;
226 int whitecnt;
227 int uccount = 0, lccount = 0;
228 register Lisp_Object sym;
229 Lisp_Object expansion, hook, tem;
230 Lisp_Object value;
232 value = Qnil;
234 if (!NILP (Vrun_hooks))
235 call1 (Vrun_hooks, Qpre_abbrev_expand_hook);
237 wordstart = 0;
238 if (!(BUFFERP (Vabbrev_start_location_buffer)
239 && XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
240 Vabbrev_start_location = Qnil;
241 if (!NILP (Vabbrev_start_location))
243 tem = Vabbrev_start_location;
244 CHECK_NUMBER_COERCE_MARKER (tem, 0);
245 wordstart = XINT (tem);
246 Vabbrev_start_location = Qnil;
247 if (wordstart < BEGV || wordstart > ZV)
248 wordstart = 0;
249 if (wordstart && wordstart != ZV)
251 wordstart_byte = CHAR_TO_BYTE (wordstart);
252 if (FETCH_BYTE (wordstart_byte) == '-')
253 del_range (wordstart, wordstart + 1);
256 if (!wordstart)
257 wordstart = scan_words (PT, -1);
259 if (!wordstart)
260 return value;
262 wordstart_byte = CHAR_TO_BYTE (wordstart);
263 wordend = scan_words (wordstart, 1);
264 if (!wordend)
265 return value;
267 if (wordend > PT)
268 wordend = PT;
270 wordend_byte = CHAR_TO_BYTE (wordend);
271 whitecnt = PT - wordend;
272 if (wordend <= wordstart)
273 return value;
275 p = buffer = (char *) alloca (wordend_byte - wordstart_byte);
277 for (idx = wordstart_byte; idx < wordend_byte; idx++)
279 /* ??? This loop needs to go by characters! */
280 register int c = FETCH_BYTE (idx);
281 if (UPPERCASEP (c))
282 c = DOWNCASE (c), uccount++;
283 else if (! NOCASEP (c))
284 lccount++;
285 *p++ = c;
288 if (VECTORP (current_buffer->abbrev_table))
289 sym = oblookup (current_buffer->abbrev_table, buffer,
290 wordend - wordstart, wordend_byte - wordstart_byte);
291 else
292 XSETFASTINT (sym, 0);
293 if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
294 sym = oblookup (Vglobal_abbrev_table, buffer,
295 wordend - wordstart, wordend_byte - wordstart_byte);
296 if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
297 return value;
299 if (INTERACTIVE && !EQ (minibuf_window, selected_window))
301 /* Add an undo boundary, in case we are doing this for
302 a self-inserting command which has avoided making one so far. */
303 SET_PT (wordend);
304 Fundo_boundary ();
307 Vlast_abbrev_text
308 = Fbuffer_substring (make_number (wordstart), make_number (wordend));
310 /* Now sym is the abbrev symbol. */
311 Vlast_abbrev = sym;
312 value = sym;
313 last_abbrev_point = wordstart;
315 if (INTEGERP (XSYMBOL (sym)->plist))
316 XSETINT (XSYMBOL (sym)->plist,
317 XINT (XSYMBOL (sym)->plist) + 1); /* Increment use count */
319 /* If this abbrev has an expansion, delete the abbrev
320 and insert the expansion. */
321 expansion = XSYMBOL (sym)->value;
322 if (STRINGP (expansion))
324 SET_PT (wordstart);
326 del_range_both (wordstart, wordstart_byte, wordend, wordend_byte, 1);
328 insert_from_string (expansion, 0, 0, XSTRING (expansion)->size,
329 STRING_BYTES (XSTRING (expansion)), 1);
330 SET_PT (PT + whitecnt);
332 if (uccount && !lccount)
334 /* Abbrev was all caps */
335 /* If expansion is multiple words, normally capitalize each word */
336 /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
337 but Megatest 68000 compiler can't handle that */
338 if (!abbrev_all_caps)
339 if (scan_words (PT, -1) > scan_words (wordstart, 1))
341 Fupcase_initials_region (make_number (wordstart),
342 make_number (PT));
343 goto caped;
345 /* If expansion is one word, or if user says so, upcase it all. */
346 Fupcase_region (make_number (wordstart), make_number (PT));
347 caped: ;
349 else if (uccount)
351 /* Abbrev included some caps. Cap first initial of expansion */
352 int pos = wordstart_byte;
354 /* Find the initial. */
355 while (pos < PT_BYTE
356 && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
357 pos++;
359 /* Change just that. */
360 pos = BYTE_TO_CHAR (pos);
361 Fupcase_initials_region (make_number (pos), make_number (pos + 1));
365 hook = XSYMBOL (sym)->function;
366 if (!NILP (hook))
368 Lisp_Object expanded, prop;
370 /* If the abbrev has a hook function, run it. */
371 expanded = call0 (hook);
373 /* In addition, if the hook function is a symbol with a a
374 non-nil `no-self-insert' property, let the value it returned
375 specify whether we consider that an expansion took place. If
376 it returns nil, no expansion has been done. */
378 if (SYMBOLP (hook)
379 && NILP (expanded)
380 && (prop = Fget (hook, intern ("no-self-insert")),
381 !NILP (prop)))
382 value = Qnil;
385 return value;
388 DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
389 "Undo the expansion of the last abbrev that expanded.\n\
390 This differs from ordinary undo in that other editing done since then\n\
391 is not undone.")
394 int opoint = PT;
395 int adjust = 0;
396 if (last_abbrev_point < BEGV
397 || last_abbrev_point > ZV)
398 return Qnil;
399 SET_PT (last_abbrev_point);
400 if (STRINGP (Vlast_abbrev_text))
402 /* This isn't correct if Vlast_abbrev->function was used
403 to do the expansion */
404 Lisp_Object val;
405 int zv_before;
407 val = XSYMBOL (Vlast_abbrev)->value;
408 if (!STRINGP (val))
409 error ("value of abbrev-symbol must be a string");
410 zv_before = ZV;
411 del_range_byte (PT_BYTE, PT_BYTE + STRING_BYTES (XSTRING (val)), 1);
412 /* Don't inherit properties here; just copy from old contents. */
413 insert_from_string (Vlast_abbrev_text, 0, 0,
414 XSTRING (Vlast_abbrev_text)->size,
415 STRING_BYTES (XSTRING (Vlast_abbrev_text)), 0);
416 Vlast_abbrev_text = Qnil;
417 /* Total number of characters deleted. */
418 adjust = ZV - zv_before;
420 SET_PT (last_abbrev_point < opoint ? opoint + adjust : opoint);
421 return Qnil;
424 static void
425 write_abbrev (sym, stream)
426 Lisp_Object sym, stream;
428 Lisp_Object name;
429 if (NILP (XSYMBOL (sym)->value))
430 return;
431 insert (" (", 5);
432 XSETSTRING (name, XSYMBOL (sym)->name);
433 Fprin1 (name, stream);
434 insert (" ", 1);
435 Fprin1 (XSYMBOL (sym)->value, stream);
436 insert (" ", 1);
437 Fprin1 (XSYMBOL (sym)->function, stream);
438 insert (" ", 1);
439 Fprin1 (XSYMBOL (sym)->plist, stream);
440 insert (")\n", 2);
443 static void
444 describe_abbrev (sym, stream)
445 Lisp_Object sym, stream;
447 Lisp_Object one;
449 if (NILP (XSYMBOL (sym)->value))
450 return;
451 one = make_number (1);
452 Fprin1 (Fsymbol_name (sym), stream);
453 Findent_to (make_number (15), one);
454 Fprin1 (XSYMBOL (sym)->plist, stream);
455 Findent_to (make_number (20), one);
456 Fprin1 (XSYMBOL (sym)->value, stream);
457 if (!NILP (XSYMBOL (sym)->function))
459 Findent_to (make_number (45), one);
460 Fprin1 (XSYMBOL (sym)->function, stream);
462 Fterpri (stream);
465 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
466 Sinsert_abbrev_table_description, 1, 2, 0,
467 "Insert before point a full description of abbrev table named NAME.\n\
468 NAME is a symbol whose value is an abbrev table.\n\
469 If optional 2nd arg READABLE is non-nil, a human-readable description\n\
470 is inserted. Otherwise the description is an expression,\n\
471 a call to `define-abbrev-table', which would\n\
472 define the abbrev table NAME exactly as it is currently defined.")
473 (name, readable)
474 Lisp_Object name, readable;
476 Lisp_Object table;
477 Lisp_Object stream;
479 CHECK_SYMBOL (name, 0);
480 table = Fsymbol_value (name);
481 CHECK_VECTOR (table, 0);
483 XSETBUFFER (stream, current_buffer);
485 if (!NILP (readable))
487 insert_string ("(");
488 Fprin1 (name, stream);
489 insert_string (")\n\n");
490 map_obarray (table, describe_abbrev, stream);
491 insert_string ("\n\n");
493 else
495 insert_string ("(define-abbrev-table '");
496 Fprin1 (name, stream);
497 insert_string (" '(\n");
498 map_obarray (table, write_abbrev, stream);
499 insert_string (" ))\n\n");
502 return Qnil;
505 DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
506 2, 2, 0,
507 "Define TABLENAME (a symbol) as an abbrev table name.\n\
508 Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\
509 of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
510 (tablename, definitions)
511 Lisp_Object tablename, definitions;
513 Lisp_Object name, exp, hook, count;
514 Lisp_Object table, elt;
516 CHECK_SYMBOL (tablename, 0);
517 table = Fboundp (tablename);
518 if (NILP (table) || (table = Fsymbol_value (tablename), NILP (table)))
520 table = Fmake_abbrev_table ();
521 Fset (tablename, table);
522 Vabbrev_table_name_list = Fcons (tablename, Vabbrev_table_name_list);
524 CHECK_VECTOR (table, 0);
526 for (; !NILP (definitions); definitions = Fcdr (definitions))
528 elt = Fcar (definitions);
529 name = Fcar (elt); elt = Fcdr (elt);
530 exp = Fcar (elt); elt = Fcdr (elt);
531 hook = Fcar (elt); elt = Fcdr (elt);
532 count = Fcar (elt);
533 Fdefine_abbrev (table, name, exp, hook, count);
535 return Qnil;
538 void
539 syms_of_abbrev ()
541 DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
542 "List of symbols whose values are abbrev tables.");
543 Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
544 Fcons (intern ("global-abbrev-table"),
545 Qnil));
547 DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
548 "The abbrev table whose abbrevs affect all buffers.\n\
549 Each buffer may also have a local abbrev table.\n\
550 If it does, the local table overrides the global one\n\
551 for any particular abbrev defined in both.");
552 Vglobal_abbrev_table = Fmake_abbrev_table ();
554 DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
555 "The abbrev table of mode-specific abbrevs for Fundamental Mode.");
556 Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
557 current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
558 buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table;
560 DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
561 "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.");
563 DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
564 "The exact text of the last abbrev expanded.\n\
565 nil if the abbrev has already been unexpanded.");
567 DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
568 "The location of the start of the last abbrev expanded.");
570 Vlast_abbrev = Qnil;
571 Vlast_abbrev_text = Qnil;
572 last_abbrev_point = 0;
574 DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
575 "Buffer position for `expand-abbrev' to use as the start of the abbrev.\n\
576 nil means use the word before point as the abbrev.\n\
577 Calling `expand-abbrev' sets this to nil.");
578 Vabbrev_start_location = Qnil;
580 DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
581 "Buffer that `abbrev-start-location' has been set for.\n\
582 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.");
583 Vabbrev_start_location_buffer = Qnil;
585 DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
586 "Local (mode-specific) abbrev table of current buffer.");
588 DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
589 "Set non-nil by defining or altering any word abbrevs.\n\
590 This causes `save-some-buffers' to offer to save the abbrevs.");
591 abbrevs_changed = 0;
593 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
594 "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
595 abbrev_all_caps = 0;
597 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
598 "Function or functions to be called before abbrev expansion is done.\n\
599 This is the first thing that `expand-abbrev' does, and so this may change\n\
600 the current abbrev table before abbrev lookup happens.");
601 Vpre_abbrev_expand_hook = Qnil;
602 Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
603 staticpro (&Qpre_abbrev_expand_hook);
605 defsubr (&Smake_abbrev_table);
606 defsubr (&Sclear_abbrev_table);
607 defsubr (&Sdefine_abbrev);
608 defsubr (&Sdefine_global_abbrev);
609 defsubr (&Sdefine_mode_abbrev);
610 defsubr (&Sabbrev_expansion);
611 defsubr (&Sabbrev_symbol);
612 defsubr (&Sexpand_abbrev);
613 defsubr (&Sunexpand_abbrev);
614 defsubr (&Sinsert_abbrev_table_description);
615 defsubr (&Sdefine_abbrev_table);