Mercurial > hg > xemacs-beta
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 } |