comparison src/abbrev.c @ 428:3ecd8885ac67 r21-2-22

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