Fixup assert definitions.
[sxemacs] / src / abbrev.c
1 /* Primitives for word-abbrev mode.
2    Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
3
4 This file is part of SXEmacs
5
6 SXEmacs 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 3 of the License, or
9 (at your option) any later version.
10
11 SXEmacs 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.
15
16 You should have received a copy of the GNU General Public License
17 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
18
19
20 /* Synched up with: FSF 19.30.  Note that there are many more functions in
21    FSF's abbrev.c.  These have been moved into Lisp in SXEmacs. */
22
23 /* Authorship:
24
25    FSF: Original version; a long time ago.
26    JWZ or Mly: Mostly moved into Lisp; maybe 1992.
27    Ben Wing: Some changes for Mule for 19.12.
28    Hrvoje Niksic: Largely rewritten in June 1997.
29 */
30
31 /* This file has been Mule-ized. */
32
33 #include <config.h>
34 #include "lisp.h"
35
36 #include "buffer.h"
37 #include "commands.h"
38 #include "ui/insdel.h"
39 #include "syntax.h"
40 #include "ui/window.h"
41
42 /* An abbrev table is an obarray.
43    Each defined abbrev is represented by a symbol in that obarray
44    whose print name is the abbreviation.
45    The symbol's value is a string which is the expansion.
46    If its function definition is non-nil, it is called
47    after the expansion is done.
48    The plist slot of the abbrev symbol is its usage count. */
49
50 /* The table of global abbrevs.  These are in effect
51    in any buffer in which abbrev mode is turned on. */
52 Lisp_Object Vglobal_abbrev_table;
53
54 int abbrev_all_caps;
55
56 /* Non-nil => use this location as the start of abbrev to expand
57  (rather than taking the word before point as the abbrev) */
58 Lisp_Object Vabbrev_start_location;
59
60 /* Buffer that Vabbrev_start_location applies to */
61 Lisp_Object Vabbrev_start_location_buffer;
62
63 /* The symbol representing the abbrev most recently expanded */
64 Lisp_Object Vlast_abbrev;
65
66 /* A string for the actual text of the abbrev most recently expanded.
67    This has more info than Vlast_abbrev since case is significant.  */
68 Lisp_Object Vlast_abbrev_text;
69
70 /* Character address of start of last abbrev expanded */
71 Fixnum last_abbrev_location;
72
73 /* Hook to run before expanding any abbrev.  */
74 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
75 \f
76 struct abbrev_match_mapper_closure {
77         struct buffer *buf;
78         Lisp_Char_Table *chartab;
79         Charcount point, maxlen;
80         Lisp_Symbol *found;
81 };
82
83 /* For use by abbrev_match(): Match SYMBOL's name against buffer text
84    before point, case-insensitively.  When found, return non-zero, so
85    that map_obarray terminates mapping.  */
86 static int abbrev_match_mapper(Lisp_Object symbol, void *arg)
87 {
88         struct abbrev_match_mapper_closure *closure =
89             (struct abbrev_match_mapper_closure *)arg;
90         Charcount abbrev_length;
91         Lisp_Symbol *sym = XSYMBOL(symbol);
92         Lisp_String *abbrev;
93
94         /* symbol_value should be OK here, because abbrevs are not expected
95            to contain any SYMBOL_MAGIC stuff.  */
96         if (UNBOUNDP(symbol_value(sym)) || NILP(symbol_value(sym))) {
97                 /* The symbol value of nil means that abbrev got undefined. */
98                 return 0;
99         }
100         abbrev = symbol_name(sym);
101         abbrev_length = string_char_length(abbrev);
102         if (abbrev_length > closure->maxlen) {
103                 /* This abbrev is too large -- it wouldn't fit. */
104                 return 0;
105         }
106         /* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't
107            normally want to expand it.  OTOH, if the abbrev begins with
108            non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere.  */
109         if (abbrev_length < closure->maxlen && abbrev_length > 0
110             && (WORD_SYNTAX_P(closure->chartab, string_char(abbrev, 0)))
111             && (WORD_SYNTAX_P(closure->chartab,
112                               BUF_FETCH_CHAR(closure->buf,
113                                              closure->point - (abbrev_length +
114                                                                1))))) {
115                 return 0;
116         }
117         /* Match abbreviation string against buffer text.  */
118         {
119                 Bufbyte *ptr = string_data(abbrev);
120                 Charcount idx;
121
122                 for (idx = 0; idx < abbrev_length; idx++) {
123                         if (DOWNCASE(closure->buf,
124                                      BUF_FETCH_CHAR(closure->buf,
125                                                     closure->point -
126                                                     abbrev_length + idx))
127                             != DOWNCASE(closure->buf, charptr_emchar(ptr))) {
128                                 break;
129                         }
130                         INC_CHARPTR(ptr);
131                 }
132                 if (idx == abbrev_length) {
133                         /* This is the one. */
134                         closure->found = sym;
135                         return 1;
136                 }
137         }
138         return 0;
139 }
140
141 /* Match the buffer text against names of symbols in obarray.  Returns
142    the matching symbol, or 0 if not found.  */
143 static Lisp_Symbol *abbrev_match(struct buffer *buf, Lisp_Object obarray)
144 {
145         struct abbrev_match_mapper_closure closure;
146
147         /* Precalculate some stuff, so mapper function needn't to it in each
148            iteration.  */
149         closure.buf = buf;
150         closure.point = BUF_PT(buf);
151         closure.maxlen = closure.point - BUF_BEGV(buf);
152         closure.chartab = XCHAR_TABLE(buf->mirror_syntax_table);
153         closure.found = 0;
154
155         map_obarray(obarray, abbrev_match_mapper, &closure);
156
157         return closure.found;
158 }
159 \f
160 /* Take the word before point (or Vabbrev_start_location, if non-nil),
161    and look it up in OBARRAY, and return the symbol (or zero).  This
162    used to be the default method of searching, with the obvious
163    limitation that the abbrevs may consist only of word characters.
164    It is an order of magnitude faster than the proper abbrev_match(),
165    but then again, vi is an order of magnitude faster than Emacs.
166
167    This speed difference should be unnoticeable, though.  I have tested
168    the degenerated cases of thousands of abbrevs being defined, and
169    abbrev_match() was still fast enough for normal operation.  */
170 static Lisp_Symbol *abbrev_oblookup(struct buffer *buf, Lisp_Object obarray)
171 {
172         Bufpos wordstart, wordend;
173         Bufbyte *word, *p;
174         Bytecount idx;
175         Lisp_Object lookup;
176
177         CHECK_VECTOR(obarray);
178
179         if (!NILP(Vabbrev_start_location)) {
180                 wordstart = get_buffer_pos_char(buf, Vabbrev_start_location,
181                                                 GB_COERCE_RANGE);
182                 Vabbrev_start_location = Qnil;
183 #if 0
184                 /* Previously, abbrev-prefix-mark crockishly inserted a dash to
185                    indicate the abbrev start point.  It now uses an extent with
186                    a begin glyph so there's no dash to remove.  */
187                 if (wordstart != BUF_ZV(buf)
188                     && BUF_FETCH_CHAR(buf, wordstart) == '-') {
189                         buffer_delete_range(buf, wordstart, wordstart + 1, 0);
190                 }
191 #endif
192                 wordend = BUF_PT(buf);
193         } else {
194                 Bufpos point = BUF_PT(buf);
195
196                 wordstart = scan_words(buf, point, -1);
197                 if (!wordstart)
198                         return 0;
199
200                 wordend = scan_words(buf, wordstart, 1);
201                 if (!wordend)
202                         return 0;
203                 if (wordend > BUF_ZV(buf))
204                         wordend = BUF_ZV(buf);
205                 if (wordend > point)
206                         wordend = point;
207                 /* Unlike the original function, we allow expansion only after
208                    the abbrev, not preceded by a number of spaces.  This is
209                    because of consistency with abbrev_match. */
210                 if (wordend < point)
211                         return 0;
212         }
213
214         if (wordend <= wordstart)
215                 return 0;
216
217         p = word = (Bufbyte *) alloca(MAX_EMCHAR_LEN * (wordend - wordstart));
218         for (idx = wordstart; idx < wordend; idx++) {
219                 Emchar c = BUF_FETCH_CHAR(buf, idx);
220                 if (UPPERCASEP(buf, c))
221                         c = DOWNCASE(buf, c);
222                 p += set_charptr_emchar(p, c);
223         }
224         lookup = oblookup(obarray, word, p - word);
225         if (SYMBOLP(lookup) && !NILP(symbol_value(XSYMBOL(lookup))))
226                 return XSYMBOL(lookup);
227         else
228                 return NULL;
229 }
230 \f
231 /* Return non-zero if OBARRAY contains an interned symbol ` '. */
232 static int obarray_has_blank_p(Lisp_Object obarray)
233 {
234         return !ZEROP(oblookup(obarray, (Bufbyte *) " ", 1));
235 }
236
237 /* Analyze case in the buffer substring, and report it.  */
238 static void
239 abbrev_count_case(struct buffer *buf, Bufpos pos, Charcount length,
240                   int *lccount, int *uccount)
241 {
242         *lccount = *uccount = 0;
243         while (length--) {
244                 Emchar c = BUF_FETCH_CHAR(buf, pos);
245                 if (UPPERCASEP(buf, c))
246                         ++ * uccount;
247                 else if (LOWERCASEP(buf, c))
248                         ++ * lccount;
249                 ++pos;
250         }
251 }
252 \f
253 DEFUN("expand-abbrev", Fexpand_abbrev, 0, 0, "",        /*
254 Expand the abbrev before point, if any.
255 Effective when explicitly called even when `abbrev-mode' is nil.
256 Returns the abbrev symbol, if expansion took place.
257 If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer,
258 returns t.
259 */
260       ())
261 {
262         /* This function can GC */
263         struct buffer *buf = current_buffer;
264         int oldmodiff = BUF_MODIFF(buf);
265         Lisp_Object pre_modiff_p;
266         Bufpos point;           /* position of point */
267         Bufpos abbrev_start;    /* position of abbreviation beginning */
268
269         Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object);
270
271         Lisp_Symbol *abbrev_symbol;
272         Lisp_String *abbrev_string;
273         Lisp_Object expansion, count, hook;
274         Charcount abbrev_length;
275         int lccount, uccount;
276
277         run_hook(Qpre_abbrev_expand_hook);
278         /* If the hook changes the buffer, treat that as having "done an
279            expansion".  */
280         pre_modiff_p = (BUF_MODIFF(buf) != oldmodiff ? Qt : Qnil);
281
282         abbrev_symbol = NULL;
283         if (!BUFFERP(Vabbrev_start_location_buffer) ||
284             XBUFFER(Vabbrev_start_location_buffer) != buf)
285                 Vabbrev_start_location = Qnil;
286         /* We use the more general abbrev_match() if the obarray blank flag
287            is not set, and Vabbrev_start_location is nil.  Otherwise, use
288            abbrev_oblookup(). */
289 #define MATCHFUN(tbl) ((obarray_has_blank_p (tbl)                \
290                         && NILP (Vabbrev_start_location))        \
291                        ? abbrev_match : abbrev_oblookup)
292         if (!NILP(buf->abbrev_table)) {
293                 fun = MATCHFUN(buf->abbrev_table);
294                 abbrev_symbol = fun(buf, buf->abbrev_table);
295         }
296         if (!abbrev_symbol && !NILP(Vglobal_abbrev_table)) {
297                 fun = MATCHFUN(Vglobal_abbrev_table);
298                 abbrev_symbol = fun(buf, Vglobal_abbrev_table);
299         }
300         if (!abbrev_symbol)
301                 return pre_modiff_p;
302
303         /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something
304            nasty, such as changed the buffer.  Here we protect against the
305            buffer getting killed.  */
306         if (!BUFFER_LIVE_P(buf))
307                 return Qnil;
308         point = BUF_PT(buf);
309
310         /* OK, we're out of the must-be-fast part.  An abbreviation matched.
311            Now find the parameters, insert the expansion, and make it all
312            look pretty.  */
313         abbrev_string = symbol_name(abbrev_symbol);
314         abbrev_length = string_char_length(abbrev_string);
315         abbrev_start = point - abbrev_length;
316
317         expansion = symbol_value(abbrev_symbol);
318         CHECK_STRING(expansion);
319
320         count = symbol_plist(abbrev_symbol);    /* Gag */
321         if (NILP(count))
322                 count = Qzero;
323         else
324                 CHECK_NATNUM(count);
325         symbol_plist(abbrev_symbol) = make_int(1 + XINT(count));
326
327         /* Count the case in the original text. */
328         abbrev_count_case(buf, abbrev_start, abbrev_length, &lccount, &uccount);
329
330         /* Remember the last abbrev text, location, etc. */
331         XSETSYMBOL(Vlast_abbrev, abbrev_symbol);
332         Vlast_abbrev_text =
333             make_string_from_buffer(buf, abbrev_start, abbrev_length);
334         last_abbrev_location = abbrev_start;
335
336         /* Add an undo boundary, in case we are doing this for a
337            self-inserting command which has avoided making one so far.  */
338         if (INTERACTIVE)
339                 Fundo_boundary();
340
341         /* Remove the abbrev */
342         buffer_delete_range(buf, abbrev_start, point, 0);
343         /* And insert the expansion. */
344         buffer_insert_lisp_string(buf, expansion);
345         point = BUF_PT(buf);
346
347         /* Now fiddle with the case. */
348         if (uccount && !lccount) {
349                 /* Abbrev was all caps */
350                 if (!abbrev_all_caps
351                     && scan_words(buf, point, -1) > scan_words(buf,
352                                                                abbrev_start,
353                                                                1)) {
354                         Fupcase_initials_region(make_int(abbrev_start),
355                                                 make_int(point),
356                                                 make_buffer(buf));
357                 } else {
358                         /* If expansion is one word, or if user says so, upcase it all. */
359                         Fupcase_region(make_int(abbrev_start), make_int(point),
360                                        make_buffer(buf));
361                 }
362         } else if (uccount) {
363                 /* Abbrev included some caps.  Cap first initial of expansion */
364                 Bufpos pos = abbrev_start;
365                 /* Find the initial.  */
366                 while (pos < point
367                        && !WORD_SYNTAX_P(XCHAR_TABLE(buf->mirror_syntax_table),
368                                          BUF_FETCH_CHAR(buf, pos)))
369                         pos++;
370                 /* Change just that.  */
371                 Fupcase_initials_region(make_int(pos), make_int(pos + 1),
372                                         make_buffer(buf));
373         }
374
375         hook = symbol_function(abbrev_symbol);
376         if (!NILP(hook) && !UNBOUNDP(hook))
377                 call0(hook);
378
379         return Vlast_abbrev;
380 }
381 \f
382 void syms_of_abbrev(void)
383 {
384         defsymbol(&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook");
385         DEFSUBR(Fexpand_abbrev);
386 }
387
388 void vars_of_abbrev(void)
389 {
390         DEFVAR_LISP("global-abbrev-table", &Vglobal_abbrev_table        /*
391 The abbrev table whose abbrevs affect all buffers.
392 Each buffer may also have a local abbrev table.
393 If it does, the local table overrides the global one
394 for any particular abbrev defined in both.
395                                                                          */ );
396         Vglobal_abbrev_table = Qnil;    /* setup by Lisp code */
397
398         DEFVAR_LISP("last-abbrev", &Vlast_abbrev        /*
399 The abbrev-symbol of the last abbrev expanded.
400 See the function `abbrev-symbol'.
401                                                          */ );
402
403         DEFVAR_LISP("last-abbrev-text", &Vlast_abbrev_text      /*
404 The exact text of the last abbrev expanded.
405 nil if the abbrev has already been unexpanded.
406                                                                  */ );
407
408         DEFVAR_INT("last-abbrev-location", &last_abbrev_location        /*
409 The location of the start of the last abbrev expanded.
410                                                                          */ );
411
412         Vlast_abbrev = Qnil;
413         Vlast_abbrev_text = Qnil;
414         last_abbrev_location = 0;
415
416         DEFVAR_LISP("abbrev-start-location", &Vabbrev_start_location    /*
417 Buffer position for `expand-abbrev' to use as the start of the abbrev.
418 nil means use the word before point as the abbrev.
419 Calling `expand-abbrev' sets this to nil.
420                                                                          */ );
421         Vabbrev_start_location = Qnil;
422
423         DEFVAR_LISP("abbrev-start-location-buffer", &Vabbrev_start_location_buffer      /*
424 Buffer that `abbrev-start-location' has been set for.
425 Trying to expand an abbrev in any other buffer clears
426 `abbrev-start-location'.
427                                                                                          */ );
428         Vabbrev_start_location_buffer = Qnil;
429
430         DEFVAR_BOOL("abbrev-all-caps", &abbrev_all_caps /*
431 *Non-nil means expand multi-word abbrevs all caps if abbrev was so.
432                                                          */ );
433         abbrev_all_caps = 0;
434
435         DEFVAR_LISP("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook  /*
436 Function or functions to be called before abbrev expansion is done.
437 This is the first thing that `expand-abbrev' does, and so this may change
438 the current abbrev table before abbrev lookup happens.
439                                                                          */ );
440         Vpre_abbrev_expand_hook = Qnil;
441 }