Mercurial > hg > xemacs-beta

comparison src/abbrev.c @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents 131b0175ea99
children 8eaf7971accc
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
24 /* Authorship: 24 /* Authorship:
25 25
26 FSF: Original version; a long time ago. 26 FSF: Original version; a long time ago.
27 JWZ or Mly: Mostly moved into Lisp; maybe 1992. 27 JWZ or Mly: Mostly moved into Lisp; maybe 1992.
28 Ben Wing: Some changes for Mule for 19.12. 28 Ben Wing: Some changes for Mule for 19.12.
29 Hrvoje Niksic: Largely rewritten in June 1997.
29 */ 30 */
30 31
31 /* This file has been Mule-ized. */ 32 /* This file has been Mule-ized. */
32 33
33 #include <config.h> 34 #include <config.h>
68 Lisp_Object Vlast_abbrev_text; 69 Lisp_Object Vlast_abbrev_text;
69 70
70 /* Character address of start of last abbrev expanded */ 71 /* Character address of start of last abbrev expanded */
71 int last_abbrev_point; 72 int last_abbrev_point;
72 73
74 Lisp_Object oblookup (Lisp_Object, CONST Bufbyte *, Bytecount);
75
73 /* Hook to run before expanding any abbrev. */ 76 /* Hook to run before expanding any abbrev. */
74 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; 77 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
75 78
76 79
77 /* Expand the word before point, if it is an abbrev. 80 /* Match the buffer text against names of symbols in obarray. Returns
78 Returns Qt if an expansion is done. */ 81 the matching symbol, or 0 if not found. */
82
83 static struct Lisp_Symbol *
84 abbrev_match (struct buffer *buf, Lisp_Object obarray)
85 {
86 Bufpos point = BUF_PT (buf);
87 Bufpos maxlen = point - BUF_BEGV (buf);
88 Charcount idx;
89
90 struct Lisp_Char_Table *chartab = XCHAR_TABLE (buf->mirror_syntax_table);
91 struct Lisp_String *abbrev;
92 struct Lisp_Vector *obvec;
93 struct Lisp_Symbol *sym;
94 Charcount abbrev_length;
95 Lisp_Object tail;
96 int i, found;
97
98 CHECK_VECTOR (obarray);
99 obvec = XVECTOR (obarray);
100
101 /* The obarray-traversing code is copied from `map_obarray'. */
102 found = 0;
103 for (i = vector_length (obvec) - 1; i >= 0; i--)
104 {
105 tail = vector_data (obvec)[i];
106 if (SYMBOLP (tail))
107 while (1)
108 {
109 sym = XSYMBOL (tail);
110 if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym)))
111 {
112 /* The symbol value of nil means that abbrev got
113 undefined. */
114 goto next;
115 }
116 abbrev = symbol_name (sym);
117 abbrev_length = string_char_length (abbrev);
118 if (abbrev_length > maxlen)
119 {
120 /* This abbrev is too large -- it wouldn't fit. */
121 goto next;
122 }
123 /* If `bar' is an abbrev, and a user presses `fubar<SPC>',
124 we don't normally want to expand it. OTOH, if the
125 abbrev begins with non-word syntax, it is OK to
126 abbreviate it anywhere. */
127 if (abbrev_length < maxlen && abbrev_length > 0
128 && (WORD_SYNTAX_P (chartab, string_char (abbrev, 0)))
129 && (WORD_SYNTAX_P (chartab,
130 BUF_FETCH_CHAR (buf, point
131 - (abbrev_length + 1)))))
132 {
133 goto next;
134 }
135 /* Match abbreviation string against buffer text. */
136 for (idx = abbrev_length - 1; idx >= 0; idx--)
137 {
138 if (DOWNCASE (buf, BUF_FETCH_CHAR (buf, point -
139 (abbrev_length - idx)))
140 != DOWNCASE (buf, string_char (abbrev, idx)))
141 break;
142 }
143 if (idx < 0)
144 {
145 found = 1;
146 break;
147 }
148 next:
149 sym = symbol_next (XSYMBOL (tail));
150 if (!sym)
151 break;
152 XSETSYMBOL (tail, sym);
153 } /* while */
154 if (found)
155 break;
156 } /* for */
157
158 return found ? sym : 0;
159 }
160
161 /* Take the word before point, and look it up in OBARRAY, and return
162 the symbol (or nil). This used to be the default method of
163 searching, with the obvious limitation that the abbrevs may consist
164 only of word characters. It is an order of magnitued faster than
165 the proper `abbrev_match', but then again, vi is an order of
166 magnitude faster than Emacs. */
167 static struct Lisp_Symbol *
168 abbrev_oblookup (struct buffer *buf, Lisp_Object obarray)
169 {
170 Bufpos wordstart, wordend;
171 Bufbyte *word, *p;
172 Bytecount idx;
173 Lisp_Object lookup;
174
175 CHECK_VECTOR (obarray);
176
177 if (!NILP (Vabbrev_start_location))
178 {
179 wordstart = get_buffer_pos_char (buf, Vabbrev_start_location,
180 GB_COERCE_RANGE);
181 Vabbrev_start_location = Qnil;
182 if (wordstart != BUF_ZV (buf)
183 && BUF_FETCH_CHAR (buf, wordstart) == '-')
184 {
185 buffer_delete_range (buf, wordstart, wordstart + 1, 0);
186 }
187 wordend = BUF_PT (buf);
188 }
189 else
190 {
191 Bufpos point = BUF_PT (buf);
192
193 wordstart = scan_words (buf, point, -1);
194 if (!wordstart)
195 return 0;
196
197 wordend = scan_words (buf, wordstart, 1);
198 if (!wordend)
199 return 0;
200 if (wordend > BUF_ZV (buf))
201 wordend = BUF_ZV (buf);
202 if (wordend > point)
203 wordend = point;
204 /* Unlike the original function, we allow expansion only after
205 the abbrev, not preceded by a number of spaces. This is
206 because of consistency with abbrev_match. */
207 if (wordend < point)
208 return 0;
209 if (wordend <= wordstart)
210 return 0;
211 }
212
213 p = word = (Bufbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart));
214 for (idx = wordstart; idx < wordend; idx++)
215 {
216 Emchar c = BUF_FETCH_CHAR (buf, idx);
217 if (UPPERCASEP (buf, c))
218 c = DOWNCASE (buf, c);
219 p += set_charptr_emchar (p, c);
220 }
221 lookup = oblookup (obarray, word, p - word);
222 if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup))))
223 return XSYMBOL (lookup);
224 else
225 return NULL;
226 }
227
228 /* Return non-zero if OBARRAY contains an interned symbol ` '. */
229 static int
230 obarray_has_blank_p (Lisp_Object obarray)
231 {
232 Lisp_Object lookup;
233
234 lookup = oblookup (obarray, (Bufbyte *)" ", 1);
235 return SYMBOLP (lookup);
236 }
237
238 /* Analyze case in the buffer substring, and report it. */
239 static void
240 abbrev_count_case (struct buffer *buf, Bufpos pos, Charcount length,
241 int *lccount, int *uccount)
242 {
243 Emchar c;
244
245 *lccount = *uccount = 0;
246 while (length--)
247 {
248 c = BUF_FETCH_CHAR (buf, pos);
249 if (UPPERCASEP (buf, c))
250 ++*uccount;
251 else if (LOWERCASEP (buf, c))
252 ++*lccount;
253 ++pos;
254 }
255 }
79 256
80 DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /* 257 DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /*
81 Expand the abbrev before point, if there is an abbrev there. 258 Expand the abbrev before point, if any.
82 Effective when explicitly called even when `abbrev-mode' is nil. 259 Effective when explicitly called even when `abbrev-mode' is nil.
83 Returns t if expansion took place. 260 Returns t if expansion took place.
84 */ 261 */
85 ()) 262 ())
86 { 263 {
87 /* This function can GC */ 264 /* This function can GC */
88 REGISTER Bufbyte *buffer, *p;
89 REGISTER Bufpos wordstart, wordend, idx;
90 Charcount whitecnt;
91 Charcount uccount = 0, lccount = 0;
92 REGISTER Lisp_Object sym;
93 Lisp_Object expansion, hook, value;
94 struct buffer *buf = current_buffer; 265 struct buffer *buf = current_buffer;
95 Lisp_Object lbuf;
96 int oldmodiff = BUF_MODIFF (buf); 266 int oldmodiff = BUF_MODIFF (buf);
97 267 Lisp_Object pre_modiff_p;
98 XSETBUFFER (lbuf, buf); 268 Bufpos point; /* position of point */
269 Bufpos abbrev_start; /* position of abbreviation beginning */
270
271 struct Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object);
272
273 struct Lisp_Symbol *abbrev_symbol;
274 struct Lisp_String *abbrev_string;
275 Lisp_Object expansion, count, hook;
276 Charcount abbrev_length, idx;
277 int lccount, uccount;
278
99 run_hook (Qpre_abbrev_expand_hook); 279 run_hook (Qpre_abbrev_expand_hook);
100 /* If the hook changes the buffer, treat that as having "done an 280 /* If the hook changes the buffer, treat that as having "done an
101 expansion". */ 281 expansion". */
102 value = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil); 282 pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil);
103 283
104 wordstart = 0; 284 abbrev_symbol = NULL;
105 if (!BUFFERP (Vabbrev_start_location_buffer) || 285 if (!BUFFERP (Vabbrev_start_location_buffer) ||
106 XBUFFER (Vabbrev_start_location_buffer) != buf) 286 XBUFFER (Vabbrev_start_location_buffer) != buf)
107 Vabbrev_start_location = Qnil; 287 Vabbrev_start_location = Qnil;
108 if (!NILP (Vabbrev_start_location)) 288 /* We use the more general `abbrev_match' if the obarray blank flag
109 { 289 is not set, and Vabbrev_start_location is nil. Otherwise, use
110 wordstart = get_buffer_pos_char (buf, Vabbrev_start_location, GB_COERCE_RANGE); 290 `abbrev_oblookup'. */
111 Vabbrev_start_location = Qnil; 291 #define MATCHFUN(tbl) ((obarray_has_blank_p (tbl) \
112 if (wordstart < BUF_BEGV (buf) || wordstart > BUF_ZV (buf)) 292 && NILP (Vabbrev_start_location)) \
113 wordstart = 0; 293 ? abbrev_match : abbrev_oblookup)
114 if (wordstart && wordstart != BUF_ZV (buf) && 294 if (!NILP (buf->abbrev_table))
115 BUF_FETCH_CHAR (buf, wordstart) == '-') 295 {
116 buffer_delete_range (buf, wordstart, wordstart + 1, 0); 296 fun = MATCHFUN (buf->abbrev_table);
117 } 297 abbrev_symbol = fun (buf, buf->abbrev_table);
118 if (!wordstart) 298 }
119 wordstart = scan_words (buf, BUF_PT (buf), -1); 299 if (!abbrev_symbol && !NILP (Vglobal_abbrev_table))
120 300 {
121 if (!wordstart) 301 fun = MATCHFUN (Vglobal_abbrev_table);
122 return value; 302 abbrev_symbol = fun (buf, Vglobal_abbrev_table);
123 303 }
124 wordend = scan_words (buf, wordstart, 1); 304 if (!abbrev_symbol)
125 if (!wordend) 305 return pre_modiff_p;
126 return value; 306
127 307 /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something
128 if (wordend > BUF_PT (buf)) 308 nasty, such as changed (or killed) the buffer. */
129 wordend = BUF_PT (buf); 309 point = BUF_PT (buf);
130 whitecnt = BUF_PT (buf) - wordend; 310
131 if (wordend <= wordstart) 311 /* OK, we're out of the must-be-fast part. An abbreviation matched.
132 return value; 312 Now find the parameters, insert the expansion, and make it all
133 313 look pretty. */
134 p = buffer = (Bufbyte *) alloca (MAX_EMCHAR_LEN*(wordend - wordstart)); 314 abbrev_string = symbol_name (abbrev_symbol);
135 315 abbrev_length = string_char_length (abbrev_string);
136 for (idx = wordstart; idx < wordend; idx++) 316 abbrev_start = point - abbrev_length;
137 { 317
138 REGISTER Emchar c = BUF_FETCH_CHAR (buf, idx); 318 expansion = symbol_value (abbrev_symbol);
139 if (UPPERCASEP (buf, c)) 319 CHECK_STRING (expansion);
140 c = DOWNCASE (buf, c), uccount++; 320
141 else if (! NOCASEP (buf, c)) 321 count = symbol_plist (abbrev_symbol); /* Gag */
142 lccount++; 322 if (NILP (count))
143 p += set_charptr_emchar (p, c); 323 count = make_int (0);
144 }
145
146 if (VECTORP (buf->abbrev_table))
147 sym = oblookup (buf->abbrev_table,
148 buffer,
149 p - buffer);
150 else 324 else
151 sym = Qzero; 325 CHECK_NATNUM (count);
152 if (INTP (sym) || NILP (XSYMBOL (sym)->value)) 326 symbol_plist (abbrev_symbol) = make_int (1 + XINT (count));
153 sym = oblookup (Vglobal_abbrev_table, 327
154 buffer, 328 /* Count the case in the original text. */
155 p - buffer); 329 abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
156 if (INTP (sym) || NILP (XSYMBOL (sym)->value)) 330
157 return value; 331 /* Remember the last abbrev text, location, etc. */
158 332 XSETSYMBOL (Vlast_abbrev, abbrev_symbol);
159 if (INTERACTIVE && !EQ (minibuf_window, Fselected_window (Qnil)))
160 {
161 /* Add an undo boundary, in case we are doing this for
162 a self-inserting command which has avoided making one so far. */
163 BUF_SET_PT (buf, wordend);
164 Fundo_boundary ();
165 }
166 BUF_SET_PT (buf, wordstart);
167 Vlast_abbrev_text = 333 Vlast_abbrev_text =
168 make_string_from_buffer (buf, wordstart, wordend - wordstart); 334 make_string_from_buffer (buf, abbrev_start, abbrev_length);
169 buffer_delete_range (buf, wordstart, wordend, 0); 335 last_abbrev_point = abbrev_start;
170 336
171 /* Now sym is the abbrev symbol. */ 337 /* Add an undo boundary, in case we are doing this for a
172 Vlast_abbrev = sym; 338 self-inserting command which has avoided making one so far. */
173 last_abbrev_point = wordstart; 339 if (INTERACTIVE)
174 340 Fundo_boundary ();
175 if (INTP (XSYMBOL (sym)->plist)) 341
176 XSETINT (XSYMBOL (sym)->plist, 342 /* Remove the abbrev */
177 XINT (XSYMBOL (sym)->plist) + 1); /* Increment use count */ 343 buffer_delete_range (buf, abbrev_start, point, 0);
178 344 /* And insert the expansion. */
179 expansion = XSYMBOL (sym)->value;
180 buffer_insert_lisp_string (buf, expansion); 345 buffer_insert_lisp_string (buf, expansion);
181 BUF_SET_PT (buf, BUF_PT (buf) + whitecnt); 346 point = BUF_PT (buf);
182 347
348 /* Now fiddle with the case. */
183 if (uccount && !lccount) 349 if (uccount && !lccount)
184 { 350 {
185 /* Abbrev was all caps */ 351 /* Abbrev was all caps */
186 /* If expansion is multiple words, normally capitalize each word */ 352 if (!abbrev_all_caps
187 /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase 353 && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1))
188 but Megatest 68000 compiler can't handle that */ 354 {
189 if (!abbrev_all_caps) 355 Fupcase_initials_region (make_int (abbrev_start), make_int (point),
190 if (scan_words (buf, BUF_PT (buf), -1) > 356 make_buffer (buf));
191 scan_words (buf, wordstart, 1)) 357 }
192 { 358 else
193 Fupcase_initials_region (make_int (wordstart), 359 {
194 make_int (BUF_PT (buf)), 360 /* If expansion is one word, or if user says so, upcase it all. */
195 lbuf); 361 Fupcase_region (make_int (abbrev_start), make_int (point),
196 goto caped; 362 make_buffer (buf));
197 } 363 }
198 /* If expansion is one word, or if user says so, upcase it all. */
199 Fupcase_region (make_int (wordstart), make_int (BUF_PT (buf)),
200 lbuf);
201 caped: ;
202 } 364 }
203 else if (uccount) 365 else if (uccount)
204 { 366 {
205 /* Abbrev included some caps. Cap first initial of expansion */ 367 /* Abbrev included some caps. Cap first initial of expansion */
206 Bufpos pos = wordstart; 368 Bufpos pos = abbrev_start;
207
208 /* Find the initial. */ 369 /* Find the initial. */
209 while (pos < BUF_PT (buf) 370 while (pos < point
210 && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table), 371 && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table),
211 BUF_FETCH_CHAR (buf, pos))) 372 BUF_FETCH_CHAR (buf, pos)))
212 pos++; 373 pos++;
213
214 /* Change just that. */ 374 /* Change just that. */
215 Fupcase_initials_region (make_int (pos), make_int (pos + 1), lbuf); 375 Fupcase_initials_region (make_int (pos), make_int (pos + 1),
216 } 376 make_buffer (buf));
217 377 }
218 hook = XSYMBOL (sym)->function; 378
379 hook = symbol_function (abbrev_symbol);
219 if (!NILP (hook) && !UNBOUNDP (hook)) 380 if (!NILP (hook) && !UNBOUNDP (hook))
220 call0 (hook); 381 call0 (hook);
221 382
222 return Qt; 383 return Qt;
223 } 384 }
385
224 386
225 void 387 void
226 syms_of_abbrev (void) 388 syms_of_abbrev (void)
227 { 389 {
228 defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook"); 390 defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook");
270 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. 432 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.
271 */ ); 433 */ );
272 Vabbrev_start_location_buffer = Qnil; 434 Vabbrev_start_location_buffer = Qnil;
273 435
274 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /* 436 DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /*
275 *Set non-nil means expand multi-word abbrevs all caps if abbrev was so. 437 *Non-nil means expand multi-word abbrevs all caps if abbrev was so.
276 */ ); 438 */ );
277 abbrev_all_caps = 0; 439 abbrev_all_caps = 0;
278 440
279 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /* 441 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /*
280 Function or functions to be called before abbrev expansion is done. 442 Function or functions to be called before abbrev expansion is done.