src/abbrev.c

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