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)
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. */
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 */
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.")
98 CHECK_VECTOR (table
, 0);
99 size
= XVECTOR (table
)->size
;
101 for (i
= 0; i
< size
; i
++)
102 XVECTOR (table
)->contents
[i
] = make_number (0);
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.")
115 (table
, name
, expansion
, hook
, count
)
116 Lisp_Object table
, name
, expansion
, hook
, count
;
118 Lisp_Object sym
, oexp
, ohook
, tem
;
119 CHECK_VECTOR (table
, 0);
120 CHECK_STRING (name
, 1);
123 count
= make_number (0);
125 CHECK_NUMBER (count
, 0);
127 sym
= Fintern (name
, table
);
129 oexp
= XSYMBOL (sym
)->value
;
130 ohook
= XSYMBOL (sym
)->function
;
131 if (!((EQ (oexp
, expansion
)
132 || (STRINGP (oexp
) && STRINGP (expansion
)
133 && (tem
= Fstring_equal (oexp
, expansion
), !NILP (tem
))))
136 || (tem
= Fequal (ohook
, hook
), !NILP (tem
)))))
139 Fset (sym
, expansion
);
141 Fsetplist (sym
, count
);
146 DEFUN ("define-global-abbrev", Fdefine_global_abbrev
, Sdefine_global_abbrev
, 2, 2,
147 "sDefine global abbrev: \nsExpansion for %s: ",
148 "Define ABBREV as a global abbreviation for EXPANSION.")
150 Lisp_Object abbrev
, expansion
;
152 Fdefine_abbrev (Vglobal_abbrev_table
, Fdowncase (abbrev
),
153 expansion
, Qnil
, make_number (0));
157 DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev
, Sdefine_mode_abbrev
, 2, 2,
158 "sDefine mode abbrev: \nsExpansion for %s: ",
159 "Define ABBREV as a mode-specific abbreviation for EXPANSION.")
161 Lisp_Object abbrev
, expansion
;
163 if (NILP (current_buffer
->abbrev_table
))
164 error ("Major mode has no abbrev table");
166 Fdefine_abbrev (current_buffer
->abbrev_table
, Fdowncase (abbrev
),
167 expansion
, Qnil
, make_number (0));
171 DEFUN ("abbrev-symbol", Fabbrev_symbol
, Sabbrev_symbol
, 1, 2, 0,
172 "Return the symbol representing abbrev named ABBREV.\n\
173 This symbol's name is ABBREV, but it is not the canonical symbol of that name;\n\
174 it is interned in an abbrev-table rather than the normal obarray.\n\
175 The value is nil if that abbrev is not defined.\n\
176 Optional second arg TABLE is abbrev table to look it up in.\n\
177 The default is to try buffer's mode-specific abbrev table, then global table.")
179 Lisp_Object abbrev
, table
;
182 CHECK_STRING (abbrev
, 0);
184 sym
= Fintern_soft (abbrev
, table
);
188 if (!NILP (current_buffer
->abbrev_table
))
189 sym
= Fintern_soft (abbrev
, current_buffer
->abbrev_table
);
190 if (NILP (XSYMBOL (sym
)->value
))
193 sym
= Fintern_soft (abbrev
, Vglobal_abbrev_table
);
195 if (NILP (XSYMBOL (sym
)->value
)) return Qnil
;
199 DEFUN ("abbrev-expansion", Fabbrev_expansion
, Sabbrev_expansion
, 1, 2, 0,
200 "Return the string that ABBREV expands into in the current buffer.\n\
201 Optionally specify an abbrev table as second arg;\n\
202 then ABBREV is looked up in that table only.")
204 Lisp_Object abbrev
, table
;
207 sym
= Fabbrev_symbol (abbrev
, table
);
208 if (NILP (sym
)) return sym
;
209 return Fsymbol_value (sym
);
212 /* Expand the word before point, if it is an abbrev.
213 Returns 1 if an expansion is done. */
215 DEFUN ("expand-abbrev", Fexpand_abbrev
, Sexpand_abbrev
, 0, 0, "",
216 "Expand the abbrev before point, if there is an abbrev there.\n\
217 Effective when explicitly called even when `abbrev-mode' is nil.\n\
218 Returns the abbrev symbol, if expansion took place.")
221 register char *buffer
, *p
;
222 int wordstart
, wordend
;
223 register int wordstart_byte
, wordend_byte
, idx
;
225 int uccount
= 0, lccount
= 0;
226 register Lisp_Object sym
;
227 Lisp_Object expansion
, hook
, tem
;
228 int oldmodiff
= MODIFF
;
233 if (!NILP (Vrun_hooks
))
234 call1 (Vrun_hooks
, Qpre_abbrev_expand_hook
);
237 if (!(BUFFERP (Vabbrev_start_location_buffer
)
238 && XBUFFER (Vabbrev_start_location_buffer
) == current_buffer
))
239 Vabbrev_start_location
= Qnil
;
240 if (!NILP (Vabbrev_start_location
))
242 tem
= Vabbrev_start_location
;
243 CHECK_NUMBER_COERCE_MARKER (tem
, 0);
244 wordstart
= XINT (tem
);
245 Vabbrev_start_location
= Qnil
;
246 if (wordstart
< BEGV
|| wordstart
> ZV
)
248 if (wordstart
&& wordstart
!= ZV
)
250 wordstart_byte
= CHAR_TO_BYTE (wordstart
);
251 if (FETCH_BYTE (wordstart_byte
) == '-')
252 del_range (wordstart
, wordstart
+ 1);
256 wordstart
= scan_words (PT
, -1);
261 wordstart_byte
= CHAR_TO_BYTE (wordstart
);
262 wordend
= scan_words (wordstart
, 1);
269 wordend_byte
= CHAR_TO_BYTE (wordend
);
270 whitecnt
= PT
- wordend
;
271 if (wordend
<= wordstart
)
274 p
= buffer
= (char *) alloca (wordend_byte
- wordstart_byte
);
276 for (idx
= wordstart_byte
; idx
< wordend_byte
; idx
++)
278 /* ??? This loop needs to go by characters! */
279 register int c
= FETCH_BYTE (idx
);
281 c
= DOWNCASE (c
), uccount
++;
282 else if (! NOCASEP (c
))
287 if (VECTORP (current_buffer
->abbrev_table
))
288 sym
= oblookup (current_buffer
->abbrev_table
, buffer
,
289 wordend
- wordstart
, wordend_byte
- wordstart_byte
);
291 XSETFASTINT (sym
, 0);
292 if (INTEGERP (sym
) || NILP (XSYMBOL (sym
)->value
))
293 sym
= oblookup (Vglobal_abbrev_table
, buffer
,
294 wordend
- wordstart
, wordend_byte
- wordstart_byte
);
295 if (INTEGERP (sym
) || NILP (XSYMBOL (sym
)->value
))
298 if (INTERACTIVE
&& !EQ (minibuf_window
, selected_window
))
300 /* Add an undo boundary, in case we are doing this for
301 a self-inserting command which has avoided making one so far. */
307 = Fbuffer_substring (make_number (wordstart
), make_number (wordend
));
309 /* Now sym is the abbrev symbol. */
312 last_abbrev_point
= wordstart
;
314 if (INTEGERP (XSYMBOL (sym
)->plist
))
315 XSETINT (XSYMBOL (sym
)->plist
,
316 XINT (XSYMBOL (sym
)->plist
) + 1); /* Increment use count */
318 /* If this abbrev has an expansion, delete the abbrev
319 and insert the expansion. */
320 expansion
= XSYMBOL (sym
)->value
;
321 if (STRINGP (expansion
))
325 del_range_both (wordstart
, wordstart_byte
, wordend
, wordend_byte
, 1);
327 insert_from_string (expansion
, 0, 0, XSTRING (expansion
)->size
,
328 STRING_BYTES (XSTRING (expansion
)), 1);
329 SET_PT (PT
+ whitecnt
);
331 if (uccount
&& !lccount
)
333 /* Abbrev was all caps */
334 /* If expansion is multiple words, normally capitalize each word */
335 /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
336 but Megatest 68000 compiler can't handle that */
337 if (!abbrev_all_caps
)
338 if (scan_words (PT
, -1) > scan_words (wordstart
, 1))
340 Fupcase_initials_region (make_number (wordstart
),
344 /* If expansion is one word, or if user says so, upcase it all. */
345 Fupcase_region (make_number (wordstart
), make_number (PT
));
350 /* Abbrev included some caps. Cap first initial of expansion */
351 int pos
= wordstart_byte
;
353 /* Find the initial. */
355 && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer
, pos
)) != Sword
)
358 /* Change just that. */
359 pos
= BYTE_TO_CHAR (pos
);
360 Fupcase_initials_region (make_number (pos
), make_number (pos
+ 1));
364 hook
= XSYMBOL (sym
)->function
;
371 DEFUN ("unexpand-abbrev", Funexpand_abbrev
, Sunexpand_abbrev
, 0, 0, "",
372 "Undo the expansion of the last abbrev that expanded.\n\
373 This differs from ordinary undo in that other editing done since then\n\
379 if (last_abbrev_point
< BEGV
380 || last_abbrev_point
> ZV
)
382 SET_PT (last_abbrev_point
);
383 if (STRINGP (Vlast_abbrev_text
))
385 /* This isn't correct if Vlast_abbrev->function was used
386 to do the expansion */
390 val
= XSYMBOL (Vlast_abbrev
)->value
;
392 error ("value of abbrev-symbol must be a string");
394 del_range_byte (PT_BYTE
, PT_BYTE
+ STRING_BYTES (XSTRING (val
)), 1);
395 /* Don't inherit properties here; just copy from old contents. */
396 insert_from_string (Vlast_abbrev_text
, 0, 0,
397 XSTRING (Vlast_abbrev_text
)->size
,
398 STRING_BYTES (XSTRING (Vlast_abbrev_text
)), 0);
399 Vlast_abbrev_text
= Qnil
;
400 /* Total number of characters deleted. */
401 adjust
= ZV
- zv_before
;
403 SET_PT (last_abbrev_point
< opoint
? opoint
+ adjust
: opoint
);
408 write_abbrev (sym
, stream
)
409 Lisp_Object sym
, stream
;
412 if (NILP (XSYMBOL (sym
)->value
))
415 XSETSTRING (name
, XSYMBOL (sym
)->name
);
416 Fprin1 (name
, stream
);
418 Fprin1 (XSYMBOL (sym
)->value
, stream
);
420 Fprin1 (XSYMBOL (sym
)->function
, stream
);
422 Fprin1 (XSYMBOL (sym
)->plist
, stream
);
427 describe_abbrev (sym
, stream
)
428 Lisp_Object sym
, stream
;
432 if (NILP (XSYMBOL (sym
)->value
))
434 one
= make_number (1);
435 Fprin1 (Fsymbol_name (sym
), stream
);
436 Findent_to (make_number (15), one
);
437 Fprin1 (XSYMBOL (sym
)->plist
, stream
);
438 Findent_to (make_number (20), one
);
439 Fprin1 (XSYMBOL (sym
)->value
, stream
);
440 if (!NILP (XSYMBOL (sym
)->function
))
442 Findent_to (make_number (45), one
);
443 Fprin1 (XSYMBOL (sym
)->function
, stream
);
448 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description
,
449 Sinsert_abbrev_table_description
, 1, 2, 0,
450 "Insert before point a full description of abbrev table named NAME.\n\
451 NAME is a symbol whose value is an abbrev table.\n\
452 If optional 2nd arg READABLE is non-nil, a human-readable description\n\
453 is inserted. Otherwise the description is an expression,\n\
454 a call to `define-abbrev-table', which would\n\
455 define the abbrev table NAME exactly as it is currently defined.")
457 Lisp_Object name
, readable
;
462 CHECK_SYMBOL (name
, 0);
463 table
= Fsymbol_value (name
);
464 CHECK_VECTOR (table
, 0);
466 XSETBUFFER (stream
, current_buffer
);
468 if (!NILP (readable
))
471 Fprin1 (name
, stream
);
472 insert_string (")\n\n");
473 map_obarray (table
, describe_abbrev
, stream
);
474 insert_string ("\n\n");
478 insert_string ("(define-abbrev-table '");
479 Fprin1 (name
, stream
);
480 insert_string (" '(\n");
481 map_obarray (table
, write_abbrev
, stream
);
482 insert_string (" ))\n\n");
488 DEFUN ("define-abbrev-table", Fdefine_abbrev_table
, Sdefine_abbrev_table
,
490 "Define TABLENAME (a symbol) as an abbrev table name.\n\
491 Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\
492 of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
493 (tablename
, definitions
)
494 Lisp_Object tablename
, definitions
;
496 Lisp_Object name
, exp
, hook
, count
;
497 Lisp_Object table
, elt
;
499 CHECK_SYMBOL (tablename
, 0);
500 table
= Fboundp (tablename
);
501 if (NILP (table
) || (table
= Fsymbol_value (tablename
), NILP (table
)))
503 table
= Fmake_abbrev_table ();
504 Fset (tablename
, table
);
505 Vabbrev_table_name_list
= Fcons (tablename
, Vabbrev_table_name_list
);
507 CHECK_VECTOR (table
, 0);
509 for (; !NILP (definitions
); definitions
= Fcdr (definitions
))
511 elt
= Fcar (definitions
);
512 name
= Fcar (elt
); elt
= Fcdr (elt
);
513 exp
= Fcar (elt
); elt
= Fcdr (elt
);
514 hook
= Fcar (elt
); elt
= Fcdr (elt
);
516 Fdefine_abbrev (table
, name
, exp
, hook
, count
);
524 DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list
,
525 "List of symbols whose values are abbrev tables.");
526 Vabbrev_table_name_list
= Fcons (intern ("fundamental-mode-abbrev-table"),
527 Fcons (intern ("global-abbrev-table"),
530 DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table
,
531 "The abbrev table whose abbrevs affect all buffers.\n\
532 Each buffer may also have a local abbrev table.\n\
533 If it does, the local table overrides the global one\n\
534 for any particular abbrev defined in both.");
535 Vglobal_abbrev_table
= Fmake_abbrev_table ();
537 DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table
,
538 "The abbrev table of mode-specific abbrevs for Fundamental Mode.");
539 Vfundamental_mode_abbrev_table
= Fmake_abbrev_table ();
540 current_buffer
->abbrev_table
= Vfundamental_mode_abbrev_table
;
542 DEFVAR_LISP ("last-abbrev", &Vlast_abbrev
,
543 "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.");
545 DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text
,
546 "The exact text of the last abbrev expanded.\n\
547 nil if the abbrev has already been unexpanded.");
549 DEFVAR_INT ("last-abbrev-location", &last_abbrev_point
,
550 "The location of the start of the last abbrev expanded.");
553 Vlast_abbrev_text
= Qnil
;
554 last_abbrev_point
= 0;
556 DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location
,
557 "Buffer position for `expand-abbrev' to use as the start of the abbrev.\n\
558 nil means use the word before point as the abbrev.\n\
559 Calling `expand-abbrev' sets this to nil.");
560 Vabbrev_start_location
= Qnil
;
562 DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer
,
563 "Buffer that `abbrev-start-location' has been set for.\n\
564 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.");
565 Vabbrev_start_location_buffer
= Qnil
;
567 DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer
->abbrev_table
, Qnil
,
568 "Local (mode-specific) abbrev table of current buffer.");
570 DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed
,
571 "Set non-nil by defining or altering any word abbrevs.\n\
572 This causes `save-some-buffers' to offer to save the abbrevs.");
575 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps
,
576 "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
579 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook
,
580 "Function or functions to be called before abbrev expansion is done.\n\
581 This is the first thing that `expand-abbrev' does, and so this may change\n\
582 the current abbrev table before abbrev lookup happens.");
583 Vpre_abbrev_expand_hook
= Qnil
;
584 Qpre_abbrev_expand_hook
= intern ("pre-abbrev-expand-hook");
585 staticpro (&Qpre_abbrev_expand_hook
);
587 defsubr (&Smake_abbrev_table
);
588 defsubr (&Sclear_abbrev_table
);
589 defsubr (&Sdefine_abbrev
);
590 defsubr (&Sdefine_global_abbrev
);
591 defsubr (&Sdefine_mode_abbrev
);
592 defsubr (&Sabbrev_expansion
);
593 defsubr (&Sabbrev_symbol
);
594 defsubr (&Sexpand_abbrev
);
595 defsubr (&Sunexpand_abbrev
);
596 defsubr (&Sinsert_abbrev_table_description
);
597 defsubr (&Sdefine_abbrev_table
);