src/abbrev.c

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