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