|
|
1.1 root 1: /* Primitives for word-abbrev mode.
2: Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
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 1, or (at your option)
9: any later version.
10:
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.
15:
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include <stdio.h>
23: #undef NULL
24: #include "lisp.h"
25: #include "commands.h"
26: #include "buffer.h"
27: #include "window.h"
28:
29: /* An abbrev table is an obarray.
30: Each defined abbrev is represented by a symbol in that obarray
31: whose print name is the abbreviation.
32: The symbol's value is a string which is the expansion.
33: If its function definition is non-nil, it is called
34: after the expansion is done.
35: The plist slot of the abbrev symbol is its usage count. */
36:
37: /* List of all abbrev-table name symbols:
38: symbols whose values are abbrev tables. */
39:
40: Lisp_Object Vabbrev_table_name_list;
41:
42: /* The table of global abbrevs. These are in effect
43: in any buffer in which abbrev mode is turned on. */
44:
45: Lisp_Object Vglobal_abbrev_table;
46:
47: /* The local abbrev table used by default (in Fundamental Mode buffers) */
48:
49: Lisp_Object Vfundamental_mode_abbrev_table;
50:
51: /* Set nonzero when an abbrev definition is changed */
52:
53: int abbrevs_changed;
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:
60: Lisp_Object Vabbrev_start_location;
61:
62: /* Buffer that Vabbrev_start_location applies to */
63: Lisp_Object Vabbrev_start_location_buffer;
64:
65: /* The symbol representing the abbrev most recently expanded */
66:
67: Lisp_Object Vlast_abbrev;
68:
69: /* A string for the actual text of the abbrev most recently expanded.
70: This has more info than Vlast_abbrev since case is significant. */
71:
72: Lisp_Object Vlast_abbrev_text;
73:
74: /* Character address of start of last abbrev expanded */
75:
76: int last_abbrev_point;
77:
78: extern Lisp_Object oblookup ();
79:
80: DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
81: "Create a new, empty abbrev table object.")
82: ()
83: {
84: return Fmake_vector (make_number (59), make_number (0));
85: }
86:
87: DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
88: "Undefine all abbrevs in abbrev table TABLE, leaving it empty.")
89: (table)
90: Lisp_Object table;
91: {
92: int i, size;
93:
94: CHECK_VECTOR (table, 0);
95: size = XVECTOR (table)->size;
96: abbrevs_changed = 1;
97: for (i = 0; i < size; i++)
98: XVECTOR (table)->contents[i] = make_number (0);
99: return Qnil;
100: }
101:
102: DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 5, 0,
103: "Define an abbrev in TABLE named NAME, to expand to EXPANSION or call HOOK.\n\
104: NAME and EXPANSION are strings. HOOK is a function or nil.\n\
105: To undefine an abbrev, define it with EXPANSION = nil")
106: (table, name, expansion, hook, count)
107: Lisp_Object table, name, expansion, hook, count;
108: {
109: Lisp_Object sym, oexp, ohook, tem;
110: CHECK_VECTOR (table, 0);
111: CHECK_STRING (name, 1);
112: if (! NULL (expansion))
113: CHECK_STRING (expansion, 2);
114: if (NULL (count))
115: count = make_number (0);
116: else
117: CHECK_NUMBER (count, 0);
118:
119: sym = Fintern (name, table);
120:
121: oexp = XSYMBOL (sym)->value;
122: ohook = XSYMBOL (sym)->function;
123: if (!((EQ (oexp, expansion)
124: || (XTYPE (oexp) == Lisp_String && XTYPE (expansion) == Lisp_String
125: && (tem = Fstring_equal (oexp, expansion), !NULL (tem))))
126: &&
127: (EQ (ohook, hook)
128: || (tem = Fequal (ohook, hook), !NULL (tem)))))
129: abbrevs_changed = 1;
130:
131: Fset (sym, expansion);
132: Ffset (sym, hook);
133: Fsetplist (sym, count);
134:
135: return name;
136: }
137:
138: DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
139: "sDefine global abbrev: \nsExpansion for %s: ",
140: "Define ABBREV as a global abbreviation for EXPANSION.")
141: (name, expansion)
142: Lisp_Object name, expansion;
143: {
144: Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (name),
145: expansion, Qnil, make_number (0));
146: return name;
147: }
148:
149: DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
150: "sDefine mode abbrev: \nsExpansion for %s: ",
151: "Define ABBREV as a mode-specific abbreviation for EXPANSION.")
152: (name, expansion)
153: Lisp_Object name, expansion;
154: {
155: if (NULL (current_buffer->abbrev_table))
156: error ("Major mode has no abbrev table");
157:
158: Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (name),
159: expansion, Qnil, make_number (0));
160: return name;
161: }
162:
163: DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
164: "Return the symbol representing abbrev named ABBREV.\n\
165: Value is nil if that abbrev is not defined.\n\
166: Optional second arg TABLE is abbrev table to look it up in.\n\
167: Default is try buffer's mode-specific abbrev table, then global table.")
168: (abbrev, table)
169: Lisp_Object abbrev, table;
170: {
171: Lisp_Object sym;
172: CHECK_STRING (abbrev, 0);
173: if (!NULL (table))
174: sym = Fintern_soft (abbrev, table);
175: else
176: {
177: sym = Qnil;
178: if (!NULL (current_buffer->abbrev_table))
179: sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
180: if (NULL (XSYMBOL (sym)->value))
181: sym = Qnil;
182: if (NULL (sym))
183: sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
184: }
185: if (NULL (XSYMBOL (sym)->value)) return Qnil;
186: return sym;
187: }
188:
189: DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
190: "Return the string that ABBREV expands into in the current buffer.\n\
191: Optionally specify an abbrev table; then ABBREV is looked up in that table only.")
192: (abbrev, table)
193: Lisp_Object abbrev, table;
194: {
195: Lisp_Object sym;
196: sym = Fabbrev_symbol (abbrev, table);
197: if (NULL (sym)) return sym;
198: return Fsymbol_value (sym);
199: }
200:
201: /* Expand the word before point, if it is an abbrev.
202: Returns 1 if an expansion is done. */
203:
204: DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
205: "Expand the abbrev before point, if it is an abbrev.\n\
206: Effective when explicitly called even when abbrev-mode is not enabled.\n\
207: Returns t if expansion took place.")
208: ()
209: {
210: char buffer[200];
211: register char *p = buffer;
212: register int wordstart, idx;
213: int uccount = 0, lccount = 0;
214: register Lisp_Object sym;
215: Lisp_Object expansion, hook, tem;
216:
217: if (XBUFFER (Vabbrev_start_location_buffer) != current_buffer)
218: Vabbrev_start_location = Qnil;
219: if (!NULL (Vabbrev_start_location))
220: {
221: tem = Vabbrev_start_location;
222: CHECK_NUMBER_COERCE_MARKER (tem, 0);
223: wordstart = XINT (tem);
224: Vabbrev_start_location = Qnil;
225: if (FETCH_CHAR (wordstart) == '-')
226: del_range (wordstart, wordstart + 1);
227: }
228: else
229: wordstart = scan_words (point, -1);
230:
231: if (!wordstart || point - wordstart >= sizeof buffer || point <= wordstart)
232: return Qnil;
233:
234: for (idx = wordstart; idx < point; idx++)
235: {
236: register int c = FETCH_CHAR (idx);
237: if (UPPERCASEP (c))
238: c = DOWNCASE (c), uccount++;
239: else if (! NOCASEP (c))
240: lccount++;
241: *p++ = c;
242: }
243:
244: if (XTYPE (current_buffer->abbrev_table) == Lisp_Vector)
245: sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer);
246: else
247: XFASTINT (sym) = 0;
248: if (XTYPE (sym) == Lisp_Int ||
249: NULL (XSYMBOL (sym)->value))
250: sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer);
251: if (XTYPE (sym) == Lisp_Int ||
252: NULL (XSYMBOL (sym)->value))
253: return Qnil;
254:
255: if (FROM_KBD && !EQ (minibuf_window, selected_window))
256: {
257: SET_PT (wordstart + p - buffer);
258: Fundo_boundary ();
259: }
260: SET_PT (wordstart);
261: Vlast_abbrev_text
262: = Fbuffer_substring (make_number (point),
263: make_number (point + (p - buffer)));
264: del_range (point, point + (p - buffer));
265:
266: /* Now sym is the abbrev symbol. */
267: Vlast_abbrev = sym;
268: last_abbrev_point = point;
269:
270: if (XTYPE (XSYMBOL (sym)->plist) == Lisp_Int)
271: XSETINT (XSYMBOL (sym)->plist,
272: XINT (XSYMBOL (sym)->plist) + 1); /* Increment use count */
273:
274: expansion = XSYMBOL (sym)->value;
275: insert (XSTRING (expansion)->data, XSTRING (expansion)->size);
276:
277: if (uccount && !lccount)
278: {
279: /* Abbrev was all caps */
280: /* If expansion is multiple words, normally capitalize each word */
281: /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
282: but Megatest 68000 compiler can't handle that */
283: if (!abbrev_all_caps)
284: if (scan_words (point, -1) > scan_words (wordstart, 1))
285: {
286: upcase_initials_region (make_number (wordstart),
287: make_number (point));
288: goto caped;
289: }
290: /* If expansion is one word, or if user says so, upcase it all. */
291: Fupcase_region (make_number (wordstart), make_number (point));
292: caped: ;
293: }
294: else if (uccount)
295: {
296: /* Abbrev included some caps. Cap first initial of expansion */
297: int old_zv = ZV;
298: idx = point;
299: /* Don't let Fcapitalize_word operate on text after point. */
300: ZV = point;
301: SET_PT (wordstart);
302: Fcapitalize_word (make_number (1));
303: SET_PT (idx);
304: ZV = old_zv;
305: }
306:
307: hook = XSYMBOL (sym)->function;
308: if (!NULL (hook))
309: call0 (hook);
310:
311: return Qt;
312: }
313:
314: DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
315: "Undo the expansion of the last abbrev that expanded.")
316: ()
317: {
318: int opoint = point;
319: int adjust = 0;
320: if (last_abbrev_point < BEGV
321: || last_abbrev_point >= ZV)
322: return Qnil;
323: SET_PT (last_abbrev_point);
324: if (XTYPE (Vlast_abbrev_text) == Lisp_String)
325: {
326: /* This isn't correct if Vlast_abbrev->function was used
327: to do the expansion */
328: Lisp_Object val;
329: XSET (val, Lisp_String, XSYMBOL (Vlast_abbrev)->value);
330: adjust = XSTRING (val)->size;
331: del_range (point, point + adjust);
332: insert (XSTRING (Vlast_abbrev_text)->data,
333: XSTRING (Vlast_abbrev_text)->size);
334: adjust -= XSTRING (Vlast_abbrev_text)->size;
335: Vlast_abbrev_text = Qnil;
336: }
337: SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint);
338: return Qnil;
339: }
340:
341: static
342: write_abbrev (sym, stream)
343: Lisp_Object sym, stream;
344: {
345: Lisp_Object name;
346: if (NULL (XSYMBOL (sym)->value))
347: return;
348: insert (" (", 5);
349: XSET (name, Lisp_String, XSYMBOL (sym)->name);
350: Fprin1 (name, stream);
351: insert (" ", 1);
352: Fprin1 (XSYMBOL (sym)->value, stream);
353: insert (" ", 1);
354: Fprin1 (XSYMBOL (sym)->function, stream);
355: insert (" ", 1);
356: Fprin1 (XSYMBOL (sym)->plist, stream);
357: insert (")\n", 2);
358: }
359:
360: static
361: describe_abbrev (sym, stream)
362: Lisp_Object sym, stream;
363: {
364: Lisp_Object one;
365:
366: if (NULL (XSYMBOL (sym)->value))
367: return;
368: one = make_number (1);
369: Fprin1 (Fsymbol_name (sym), stream);
370: Findent_to (make_number (15), one);
371: Fprin1 (XSYMBOL (sym)->plist, stream);
372: Findent_to (make_number (20), one);
373: Fprin1 (XSYMBOL (sym)->value, stream);
374: if (!NULL (XSYMBOL (sym)->function))
375: {
376: Findent_to (make_number (45), one);
377: Fprin1 (XSYMBOL (sym)->function, stream);
378: }
379: Fterpri (stream);
380: }
381:
382: DEFUN ("insert-abbrev-table-description",
383: Finsert_abbrev_table_description, Sinsert_abbrev_table_description,
384: 2, 2, 0,
385: "Insert before point a description of abbrev table named NAME.\n\
386: NAME is a symbol whose value is an abbrev table.\n\
387: If 2nd arg READABLE is non-nil, a readable description is inserted.\n\
388: Otherwise description is an expression,\n\
389: a call to define-abbrev-table which would\n\
390: define NAME exactly as it is currently defined.")
391: (name, readable)
392: Lisp_Object name, readable;
393: {
394: Lisp_Object table;
395: Lisp_Object stream;
396:
397: CHECK_SYMBOL (name, 0);
398: table = Fsymbol_value (name);
399: CHECK_VECTOR (table, 0);
400:
401: XSET (stream, Lisp_Buffer, current_buffer);
402:
403: if (!NULL (readable))
404: {
405: InsStr ("(");
406: Fprin1 (name, stream);
407: InsStr (")\n\n");
408: map_obarray (table, describe_abbrev, stream);
409: InsStr ("\n\n");
410: }
411: else
412: {
413: InsStr ("(define-abbrev-table '");
414: Fprin1 (name, stream);
415: InsStr (" '(\n");
416: map_obarray (table, write_abbrev, stream);
417: InsStr (" ))\n\n");
418: }
419:
420: return Qnil;
421: }
422:
423: DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
424: 2, 2, 0,
425: "Define TABNAME (a symbol) as an abbrev table name.\n\
426: Define abbrevs in it according to DEFINITIONS, a list of elements\n\
427: of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
428: (tabname, defns)
429: Lisp_Object tabname, defns;
430: {
431: Lisp_Object name, exp, hook, count;
432: Lisp_Object table, elt;
433:
434: CHECK_SYMBOL (tabname, 0);
435: table = Fboundp (tabname);
436: if (NULL (table) || (table = Fsymbol_value (tabname), NULL (table)))
437: {
438: table = Fmake_abbrev_table ();
439: Fset (tabname, table);
440: Vabbrev_table_name_list =
441: Fcons (tabname, Vabbrev_table_name_list);
442: }
443: CHECK_VECTOR (table, 0);
444:
445: for (;!NULL (defns); defns = Fcdr (defns))
446: {
447: elt = Fcar (defns);
448: name = Fcar (elt);
449: elt = Fcdr (elt);
450: exp = Fcar (elt);
451: elt = Fcdr (elt);
452: hook = Fcar (elt);
453: elt = Fcdr (elt);
454: count = Fcar (elt);
455: Fdefine_abbrev (table, name, exp, hook, count);
456: }
457: return Qnil;
458: }
459:
460: syms_of_abbrev ()
461: {
462: DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
463: "List of symbols whose values are abbrev tables.");
464: Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
465: Fcons (intern ("global-abbrev-table"),
466: Qnil));
467:
468: DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
469: "The abbrev table whose abbrevs affect all buffers.\n\
470: Each buffer may also have a local abbrev table.\n\
471: If it does, the local table overrides the global one\n\
472: for any particular abbrev defined in both.");
473: Vglobal_abbrev_table = Fmake_abbrev_table ();
474:
475: DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
476: "The abbrev table of mode-specific abbrevs for Fundamental Mode.");
477: Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
478: current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
479:
480: DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
481: "The abbrev-symbol of the last abbrev expanded.");
482:
483: DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
484: "The exact text of the last abbrev expanded.\n\
485: nil if the abbrev has already been unexpanded.");
486:
487: DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
488: "The location of the last abbrev expanded.");
489:
490: Vlast_abbrev = Qnil;
491: Vlast_abbrev_text = Qnil;
492: last_abbrev_point = 0;
493:
494: DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
495: "Buffer position for expand-abbrev to use as the start of the abbrev.\n\
496: nil means use the word before point as the abbrev.\n\
497: Set to nil each time expand-abbrev is called.");
498: Vabbrev_start_location = Qnil;
499:
500: DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
501: "Buffer that abbrev-start-location has been set for.\n\
502: Trying to expand an abbrev in any other buffer clears abbrev-start-location.");
503: Vabbrev_start_location_buffer = Qnil;
504:
505: DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table,
506: "Local (mode-specific) abbrev table of current buffer.");
507:
508: DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
509: "Set non-nil by defining or altering any word abbrevs.");
510: abbrevs_changed = 0;
511:
512: DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
513: "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
514: abbrev_all_caps = 0;
515:
516: defsubr (&Smake_abbrev_table);
517: defsubr (&Sclear_abbrev_table);
518: defsubr (&Sdefine_abbrev);
519: defsubr (&Sdefine_global_abbrev);
520: defsubr (&Sdefine_mode_abbrev);
521: defsubr (&Sabbrev_expansion);
522: defsubr (&Sabbrev_symbol);
523: defsubr (&Sexpand_abbrev);
524: defsubr (&Sunexpand_abbrev);
525: defsubr (&Sinsert_abbrev_table_description);
526: defsubr (&Sdefine_abbrev_table);
527: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.