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, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22 #include <stdio.h>
  23 #include "lisp.h"
  24 #include "commands.h"
  25 #include "buffer.h"
  26 #include "window.h"
  27 #include "syntax.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 /* Hook to run before expanding any abbrev.  */
  79
  80 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
  81 \f
  82 DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
  83   "Create a new, empty abbrev table object.")
  84   ()
  85 {
  86   return Fmake_vector (make_number (59), make_number (0));
  87 }
  88
  89 DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
  90   "Undefine all abbrevs in abbrev table TABLE, leaving it empty.")
  91   (table)
  92      Lisp_Object table;
  93 {
  94   int i, size;
  95
  96   CHECK_VECTOR (table, 0);
  97   size = XVECTOR (table)->size;
  98   abbrevs_changed = 1;
  99   for (i = 0; i < size; i++)
 100     XVECTOR (table)->contents[i] = make_number (0);
 101   return Qnil;
 102 }
 103 \f
 104 DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 5, 0,
 105   "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.\n\
 106 NAME and EXPANSION are strings.\n\
 107 To undefine an abbrev, define it with EXPANSION = nil.\n\
 108 If HOOK is non-nil, it should be a function of no arguments;\n\
 109 it is called after EXPANSION is inserted.")
 110   (table, name, expansion, hook, count)
 111      Lisp_Object table, name, expansion, hook, count;
 112 {
 113   Lisp_Object sym, oexp, ohook, tem;
 114   CHECK_VECTOR (table, 0);
 115   CHECK_STRING (name, 1);
 116   if (!NILP (expansion))
 117     CHECK_STRING (expansion, 2);
 118   if (NILP (count))
 119     count = make_number (0);
 120   else
 121     CHECK_NUMBER (count, 0);
 122
 123   sym = Fintern (name, table);
 124
 125   oexp = XSYMBOL (sym)->value;
 126   ohook = XSYMBOL (sym)->function;
 127   if (!((EQ (oexp, expansion)
 128          || (STRINGP (oexp) && STRINGP (expansion)
 129              && (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
 130         &&
 131         (EQ (ohook, hook)
 132          || (tem = Fequal (ohook, hook), !NILP (tem)))))
 133     abbrevs_changed = 1;
 134
 135   Fset (sym, expansion);
 136   Ffset (sym, hook);
 137   Fsetplist (sym, count);
 138
 139   return name;
 140 }
 141
 142 DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
 143   "sDefine global abbrev: \nsExpansion for %s: ",
 144   "Define ABBREV as a global abbreviation for EXPANSION.")
 145   (name, expansion)
 146      Lisp_Object name, expansion;
 147 {
 148   Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (name),
 149                   expansion, Qnil, make_number (0));
 150   return name;
 151 }
 152
 153 DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
 154   "sDefine mode abbrev: \nsExpansion for %s: ",
 155   "Define ABBREV as a mode-specific abbreviation for EXPANSION.")
 156   (name, expansion)
 157      Lisp_Object name, expansion;
 158 {
 159   if (NILP (current_buffer->abbrev_table))
 160     error ("Major mode has no abbrev table");
 161
 162   Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (name),
 163                   expansion, Qnil, make_number (0));
 164   return name;
 165 }
 166
 167 DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
 168   "Return the symbol representing abbrev named ABBREV.\n\
 169 This symbol's name is ABBREV, but it is not the canonical symbol of that name;\n\
 170 it is interned in an abbrev-table rather than the normal obarray.\n\
 171 The value is nil if that abbrev is not defined.\n\
 172 Optional second arg TABLE is abbrev table to look it up in.\n\
 173 The default is to try buffer's mode-specific abbrev table, then global table.")
 174   (abbrev, table)
 175      Lisp_Object abbrev, table;
 176 {
 177   Lisp_Object sym;
 178   CHECK_STRING (abbrev, 0);
 179   if (!NILP (table))
 180     sym = Fintern_soft (abbrev, table);
 181   else
 182     {
 183       sym = Qnil;
 184       if (!NILP (current_buffer->abbrev_table))
 185         sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
 186       if (NILP (XSYMBOL (sym)->value))
 187         sym = Qnil;
 188       if (NILP (sym))
 189         sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
 190     }
 191   if (NILP (XSYMBOL (sym)->value)) return Qnil;
 192   return sym;
 193 }
 194
 195 DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
 196   "Return the string that ABBREV expands into in the current buffer.\n\
 197 Optionally specify an abbrev table as second arg;\n\
 198 then ABBREV is looked up in that table only.")
 199   (abbrev, table)
 200      Lisp_Object abbrev, table;
 201 {
 202   Lisp_Object sym;
 203   sym = Fabbrev_symbol (abbrev, table);
 204   if (NILP (sym)) return sym;
 205   return Fsymbol_value (sym);
 206 }
 207 \f
 208 /* Expand the word before point, if it is an abbrev.
 209   Returns 1 if an expansion is done. */
 210
 211 DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
 212   "Expand the abbrev before point, if there is an abbrev there.\n\
 213 Effective when explicitly called even when `abbrev-mode' is nil.\n\
 214 Returns t if expansion took place.")
 215   ()
 216 {
 217   register char *buffer, *p;
 218   register int wordstart, wordend, idx;
 219   int whitecnt;
 220   int uccount = 0, lccount = 0;
 221   register Lisp_Object sym;
 222   Lisp_Object expansion, hook, tem;
 223   int oldmodiff = MODIFF;
 224   Lisp_Object value;
 225
 226   if (!NILP (Vrun_hooks))
 227     call1 (Vrun_hooks, Qpre_abbrev_expand_hook);
 228   /* If the hook changes the buffer, treat that as having "done an
 229      expansion".  */
 230   value = (MODIFF != oldmodiff ? Qt : Qnil);
 231
 232   wordstart = 0;
 233   if (!(BUFFERP (Vabbrev_start_location_buffer) &&
 234         XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
 235     Vabbrev_start_location = Qnil;
 236   if (!NILP (Vabbrev_start_location))
 237     {
 238       tem = Vabbrev_start_location;
 239       CHECK_NUMBER_COERCE_MARKER (tem, 0);
 240       wordstart = XINT (tem);
 241       Vabbrev_start_location = Qnil;
 242       if (wordstart < BEGV || wordstart > ZV)
 243         wordstart = 0;
 244       if (wordstart && wordstart != ZV && FETCH_CHAR (wordstart) == '-')
 245         del_range (wordstart, wordstart + 1);
 246     }
 247   if (!wordstart)
 248     wordstart = scan_words (point, -1);
 249
 250   if (!wordstart)
 251     return value;
 252
 253   wordend = scan_words (wordstart, 1);
 254   if (!wordend)
 255     return value;
 256
 257   if (wordend > point)
 258     wordend = point;
 259   whitecnt = point - wordend;
 260   if (wordend <= wordstart)
 261     return value;
 262
 263   p = buffer = (char *) alloca (wordend - wordstart);
 264
 265   for (idx = wordstart; idx < wordend; idx++)
 266     {
 267       register int c = FETCH_CHAR (idx);
 268       if (UPPERCASEP (c))
 269         c = DOWNCASE (c), uccount++;
 270       else if (! NOCASEP (c))
 271         lccount++;
 272       *p++ = c;
 273     }
 274
 275   if (VECTORP (current_buffer->abbrev_table))
 276     sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer);
 277   else
 278     XSETFASTINT (sym, 0);
 279   if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
 280     sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer);
 281   if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
 282     return value;
 283
 284   if (INTERACTIVE && !EQ (minibuf_window, selected_window))
 285     {
 286       /* Add an undo boundary, in case we are doing this for
 287          a self-inserting command which has avoided making one so far.  */
 288       SET_PT (wordend);
 289       Fundo_boundary ();
 290     }
 291   SET_PT (wordstart);
 292   Vlast_abbrev_text
 293     = Fbuffer_substring (make_number (wordstart), make_number (wordend));
 294   del_range (wordstart, wordend);
 295
 296   /* Now sym is the abbrev symbol. */
 297   Vlast_abbrev = sym;
 298   last_abbrev_point = wordstart;
 299
 300   if (INTEGERP (XSYMBOL (sym)->plist))
 301     XSETINT (XSYMBOL (sym)->plist,
 302              XINT (XSYMBOL (sym)->plist) + 1);  /* Increment use count */
 303
 304   expansion = XSYMBOL (sym)->value;
 305   insert_from_string (expansion, 0, XSTRING (expansion)->size, 1);
 306   SET_PT (point + whitecnt);
 307
 308   if (uccount && !lccount)
 309     {
 310       /* Abbrev was all caps */
 311       /* If expansion is multiple words, normally capitalize each word */
 312       /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
 313          but Megatest 68000 compiler can't handle that */
 314       if (!abbrev_all_caps)
 315         if (scan_words (point, -1) > scan_words (wordstart, 1))
 316           {
 317             Fupcase_initials_region (make_number (wordstart),
 318                                      make_number (point));
 319             goto caped;
 320           }
 321       /* If expansion is one word, or if user says so, upcase it all. */
 322       Fupcase_region (make_number (wordstart), make_number (point));
 323     caped: ;
 324     }
 325   else if (uccount)
 326     {
 327       /* Abbrev included some caps.  Cap first initial of expansion */
 328       int pos = wordstart;
 329
 330       /* Find the initial.  */
 331       while (pos < point
 332              && SYNTAX (*BUF_CHAR_ADDRESS (current_buffer, pos)) != Sword)
 333         pos++;
 334
 335       /* Change just that.  */
 336       Fupcase_initials_region (make_number (pos), make_number (pos + 1));
 337     }
 338
 339   hook = XSYMBOL (sym)->function;
 340   if (!NILP (hook))
 341     call0 (hook);
 342
 343   return Qt;
 344 }
 345
 346 DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
 347   "Undo the expansion of the last abbrev that expanded.\n\
 348 This differs from ordinary undo in that other editing done since then\n\
 349 is not undone.")
 350   ()
 351 {
 352   int opoint = point;
 353   int adjust = 0;
 354   if (last_abbrev_point < BEGV
 355       || last_abbrev_point > ZV)
 356     return Qnil;
 357   SET_PT (last_abbrev_point);
 358   if (STRINGP (Vlast_abbrev_text))
 359     {
 360       /* This isn't correct if Vlast_abbrev->function was used
 361          to do the expansion */
 362       Lisp_Object val;
 363       val = XSYMBOL (Vlast_abbrev)->value;
 364       if (!STRINGP (val))
 365         error ("value of abbrev-symbol must be a string");
 366       adjust = XSTRING (val)->size;
 367       del_range (point, point + adjust);
 368       /* Don't inherit properties here; just copy from old contents.  */
 369       insert_from_string (Vlast_abbrev_text, 0,
 370                           XSTRING (Vlast_abbrev_text)->size, 0);
 371       adjust -= XSTRING (Vlast_abbrev_text)->size;
 372       Vlast_abbrev_text = Qnil;
 373     }
 374   SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint);
 375   return Qnil;
 376 }
 377 \f
 378 static
 379 write_abbrev (sym, stream)
 380      Lisp_Object sym, stream;
 381 {
 382   Lisp_Object name;
 383   if (NILP (XSYMBOL (sym)->value))
 384     return;
 385   insert ("    (", 5);
 386   XSETSTRING (name, XSYMBOL (sym)->name);
 387   Fprin1 (name, stream);
 388   insert (" ", 1);
 389   Fprin1 (XSYMBOL (sym)->value, stream);
 390   insert (" ", 1);
 391   Fprin1 (XSYMBOL (sym)->function, stream);
 392   insert (" ", 1);
 393   Fprin1 (XSYMBOL (sym)->plist, stream);
 394   insert (")\n", 2);
 395 }
 396
 397 static
 398 describe_abbrev (sym, stream)
 399      Lisp_Object sym, stream;
 400 {
 401   Lisp_Object one;
 402
 403   if (NILP (XSYMBOL (sym)->value))
 404     return;
 405   one = make_number (1);
 406   Fprin1 (Fsymbol_name (sym), stream);
 407   Findent_to (make_number (15), one);
 408   Fprin1 (XSYMBOL (sym)->plist, stream);
 409   Findent_to (make_number (20), one);
 410   Fprin1 (XSYMBOL (sym)->value, stream);
 411   if (!NILP (XSYMBOL (sym)->function))
 412     {
 413       Findent_to (make_number (45), one);
 414       Fprin1 (XSYMBOL (sym)->function, stream);
 415     }
 416   Fterpri (stream);
 417 }
 418
 419 DEFUN ("insert-abbrev-table-description",
 420   Finsert_abbrev_table_description, Sinsert_abbrev_table_description,
 421   1, 2, 0,
 422   "Insert before point a full description of abbrev table named NAME.\n\
 423 NAME is a symbol whose value is an abbrev table.\n\
 424 If optional 2nd arg HUMAN is non-nil, a human-readable description is inserted.\n\
 425 Otherwise the description is an expression,\n\
 426 a call to `define-abbrev-table', which would\n\
 427 define the abbrev table NAME exactly as it is currently defined.")
 428   (name, readable)
 429      Lisp_Object name, readable;
 430 {
 431   Lisp_Object table;
 432   Lisp_Object stream;
 433
 434   CHECK_SYMBOL (name, 0);
 435   table = Fsymbol_value (name);
 436   CHECK_VECTOR (table, 0);
 437
 438   XSETBUFFER (stream, current_buffer);
 439
 440   if (!NILP (readable))
 441     {
 442       insert_string ("(");
 443       Fprin1 (name, stream);
 444       insert_string (")\n\n");
 445       map_obarray (table, describe_abbrev, stream);
 446       insert_string ("\n\n");
 447     }
 448   else
 449     {
 450       insert_string ("(define-abbrev-table '");
 451       Fprin1 (name, stream);
 452       insert_string (" '(\n");
 453       map_obarray (table, write_abbrev, stream);
 454       insert_string ("    ))\n\n");
 455     }
 456
 457   return Qnil;
 458 }
 459 \f
 460 DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
 461        2, 2, 0,
 462   "Define TABNAME (a symbol) as an abbrev table name.\n\
 463 Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\
 464 of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
 465   (tabname, defns)
 466      Lisp_Object tabname, defns;
 467 {
 468   Lisp_Object name, exp, hook, count;
 469   Lisp_Object table, elt;
 470
 471   CHECK_SYMBOL (tabname, 0);
 472   table = Fboundp (tabname);
 473   if (NILP (table) || (table = Fsymbol_value (tabname), NILP (table)))
 474     {
 475       table = Fmake_abbrev_table ();
 476       Fset (tabname, table);
 477       Vabbrev_table_name_list =
 478         Fcons (tabname, Vabbrev_table_name_list);
 479     }
 480   CHECK_VECTOR (table, 0);
 481
 482   for (;!NILP (defns); defns = Fcdr (defns))
 483     {
 484       elt = Fcar (defns);
 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 }