src/abbrev.c

   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 #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
 223   if (!NILP (Vrun_hooks))
 224     call1 (Vrun_hooks, Qpre_abbrev_expand_hook);
 225
 226   if (XBUFFER (Vabbrev_start_location_buffer) != current_buffer)
 227     Vabbrev_start_location = Qnil;
 228   if (!NILP (Vabbrev_start_location))
 229     {
 230       tem = Vabbrev_start_location;
 231       CHECK_NUMBER_COERCE_MARKER (tem, 0);
 232       wordstart = XINT (tem);
 233       Vabbrev_start_location = Qnil;
 234       if (FETCH_CHAR (wordstart) == '-')
 235         del_range (wordstart, wordstart + 1);
 236     }
 237   else
 238     wordstart = scan_words (point, -1);
 239
 240   if (!wordstart)
 241     return Qnil;
 242
 243   wordend = scan_words (wordstart, 1);
 244   if (!wordend)
 245     return Qnil;
 246
 247   if (wordend > point)
 248     wordend = point;
 249   whitecnt = point - wordend;
 250   if (wordend <= wordstart)
 251     return Qnil;
 252
 253   p = buffer = (char *) alloca (wordend - wordstart);
 254
 255   for (idx = wordstart; idx < point; idx++)
 256     {
 257       register int c = FETCH_CHAR (idx);
 258       if (UPPERCASEP (c))
 259         c = DOWNCASE (c), uccount++;
 260       else if (! NOCASEP (c))
 261         lccount++;
 262       *p++ = c;
 263     }
 264
 265   if (XTYPE (current_buffer->abbrev_table) == Lisp_Vector)
 266     sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer);
 267   else
 268     XFASTINT (sym) = 0;
 269   if (XTYPE (sym) == Lisp_Int || NILP (XSYMBOL (sym)->value))
 270     sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer);
 271   if (XTYPE (sym) == Lisp_Int || NILP (XSYMBOL (sym)->value))
 272     return Qnil;
 273
 274   if (INTERACTIVE && !EQ (minibuf_window, selected_window))
 275     {
 276       SET_PT (wordend);
 277       Fundo_boundary ();
 278     }
 279   SET_PT (wordstart);
 280   Vlast_abbrev_text
 281     = Fbuffer_substring (make_number (wordstart), make_number (wordend));
 282   del_range (wordstart, wordend);
 283
 284   /* Now sym is the abbrev symbol. */
 285   Vlast_abbrev = sym;
 286   last_abbrev_point = wordstart;
 287
 288   if (XTYPE (XSYMBOL (sym)->plist) == Lisp_Int)
 289     XSETINT (XSYMBOL (sym)->plist,
 290              XINT (XSYMBOL (sym)->plist) + 1);  /* Increment use count */
 291
 292   expansion = XSYMBOL (sym)->value;
 293   insert_from_string (expansion, 0, XSTRING (expansion)->size);
 294   SET_PT (point + whitecnt);
 295
 296   if (uccount && !lccount)
 297     {
 298       /* Abbrev was all caps */
 299       /* If expansion is multiple words, normally capitalize each word */
 300       /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
 301          but Megatest 68000 compiler can't handle that */
 302       if (!abbrev_all_caps)
 303         if (scan_words (point, -1) > scan_words (wordstart, 1))
 304           {
 305             upcase_initials_region (make_number (wordstart),
 306                                     make_number (point));
 307             goto caped;
 308           }
 309       /* If expansion is one word, or if user says so, upcase it all. */
 310       Fupcase_region (make_number (wordstart), make_number (point));
 311     caped: ;
 312     }
 313   else if (uccount)
 314     {
 315       /* Abbrev included some caps.  Cap first initial of expansion */
 316       int old_zv = ZV;
 317       int old_pt = point;
 318
 319       /* Don't let Fcapitalize_word operate on text after point.  */
 320       ZV = point;
 321       SET_PT (wordstart);
 322       Fcapitalize_word (make_number (1));
 323
 324       SET_PT (old_pt);
 325       ZV = old_zv;
 326     }
 327
 328   hook = XSYMBOL (sym)->function;
 329   if (!NILP (hook))
 330     call0 (hook);
 331
 332   return Qt;
 333 }
 334
 335 DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
 336   "Undo the expansion of the last abbrev that expanded.\n\
 337 This differs from ordinary undo in that other editing done since then\n\
 338 is not undone.")
 339   ()
 340 {
 341   int opoint = point;
 342   int adjust = 0;
 343   if (last_abbrev_point < BEGV
 344       || last_abbrev_point > ZV)
 345     return Qnil;
 346   SET_PT (last_abbrev_point);
 347   if (XTYPE (Vlast_abbrev_text) == Lisp_String)
 348     {
 349       /* This isn't correct if Vlast_abbrev->function was used
 350          to do the expansion */
 351       Lisp_Object val;
 352       XSET (val, Lisp_String, XSYMBOL (Vlast_abbrev)->value);
 353       adjust = XSTRING (val)->size;
 354       del_range (point, point + adjust);
 355       insert_from_string (Vlast_abbrev_text, 0,
 356                           XSTRING (Vlast_abbrev_text)->size);
 357       adjust -= XSTRING (Vlast_abbrev_text)->size;
 358       Vlast_abbrev_text = Qnil;
 359     }
 360   SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint);
 361   return Qnil;
 362 }
 363 \f
 364 static
 365 write_abbrev (sym, stream)
 366      Lisp_Object sym, stream;
 367 {
 368   Lisp_Object name;
 369   if (NILP (XSYMBOL (sym)->value))
 370     return;
 371   insert ("    (", 5);
 372   XSET (name, Lisp_String, XSYMBOL (sym)->name);
 373   Fprin1 (name, stream);
 374   insert (" ", 1);
 375   Fprin1 (XSYMBOL (sym)->value, stream);
 376   insert (" ", 1);
 377   Fprin1 (XSYMBOL (sym)->function, stream);
 378   insert (" ", 1);
 379   Fprin1 (XSYMBOL (sym)->plist, stream);
 380   insert (")\n", 2);
 381 }
 382
 383 static
 384 describe_abbrev (sym, stream)
 385      Lisp_Object sym, stream;
 386 {
 387   Lisp_Object one;
 388
 389   if (NILP (XSYMBOL (sym)->value))
 390     return;
 391   one = make_number (1);
 392   Fprin1 (Fsymbol_name (sym), stream);
 393   Findent_to (make_number (15), one);
 394   Fprin1 (XSYMBOL (sym)->plist, stream);
 395   Findent_to (make_number (20), one);
 396   Fprin1 (XSYMBOL (sym)->value, stream);
 397   if (!NILP (XSYMBOL (sym)->function))
 398     {
 399       Findent_to (make_number (45), one);
 400       Fprin1 (XSYMBOL (sym)->function, stream);
 401     }
 402   Fterpri (stream);
 403 }
 404
 405 DEFUN ("insert-abbrev-table-description",
 406   Finsert_abbrev_table_description, Sinsert_abbrev_table_description,
 407   1, 2, 0,
 408   "Insert before point a full description of abbrev table named NAME.\n\
 409 NAME is a symbol whose value is an abbrev table.\n\
 410 If optional 2nd arg HUMAN is non-nil, a human-readable description is inserted.\n\
 411 Otherwise the description is an expression,\n\
 412 a call to `define-abbrev-table', which would\n\
 413 define the abbrev table NAME exactly as it is currently defined.")
 414   (name, readable)
 415      Lisp_Object name, readable;
 416 {
 417   Lisp_Object table;
 418   Lisp_Object stream;
 419
 420   CHECK_SYMBOL (name, 0);
 421   table = Fsymbol_value (name);
 422   CHECK_VECTOR (table, 0);
 423
 424   XSET (stream, Lisp_Buffer, current_buffer);
 425
 426   if (!NILP (readable))
 427     {
 428       insert_string ("(");
 429       Fprin1 (name, stream);
 430       insert_string (")\n\n");
 431       map_obarray (table, describe_abbrev, stream);
 432       insert_string ("\n\n");
 433     }
 434   else
 435     {
 436       insert_string ("(define-abbrev-table '");
 437       Fprin1 (name, stream);
 438       insert_string (" '(\n");
 439       map_obarray (table, write_abbrev, stream);
 440       insert_string ("    ))\n\n");
 441     }
 442
 443   return Qnil;
 444 }
 445 \f
 446 DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
 447        2, 2, 0,
 448   "Define TABNAME (a symbol) as an abbrev table name.\n\
 449 Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\
 450 of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
 451   (tabname, defns)
 452      Lisp_Object tabname, defns;
 453 {
 454   Lisp_Object name, exp, hook, count;
 455   Lisp_Object table, elt;
 456
 457   CHECK_SYMBOL (tabname, 0);
 458   table = Fboundp (tabname);
 459   if (NILP (table) || (table = Fsymbol_value (tabname), NILP (table)))
 460     {
 461       table = Fmake_abbrev_table ();
 462       Fset (tabname, table);
 463       Vabbrev_table_name_list =
 464         Fcons (tabname, Vabbrev_table_name_list);
 465     }
 466   CHECK_VECTOR (table, 0);
 467
 468   for (;!NILP (defns); defns = Fcdr (defns))
 469     {
 470       elt = Fcar (defns);
 471       name = Fcar (elt);
 472       elt = Fcdr (elt);
 473       exp = Fcar (elt);
 474       elt = Fcdr (elt);
 475       hook = Fcar (elt);
 476       elt = Fcdr (elt);
 477       count = Fcar (elt);
 478       Fdefine_abbrev (table, name, exp, hook, count);
 479     }
 480   return Qnil;
 481 }
 482 \f
 483 syms_of_abbrev ()
 484 {
 485   DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
 486     "List of symbols whose values are abbrev tables.");
 487   Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
 488                                    Fcons (intern ("global-abbrev-table"),
 489                                           Qnil));
 490
 491   DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
 492     "The abbrev table whose abbrevs affect all buffers.\n\
 493 Each buffer may also have a local abbrev table.\n\
 494 If it does, the local table overrides the global one\n\
 495 for any particular abbrev defined in both.");
 496   Vglobal_abbrev_table = Fmake_abbrev_table ();
 497
 498   DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
 499     "The abbrev table of mode-specific abbrevs for Fundamental Mode.");
 500   Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
 501   current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
 502
 503   DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
 504     "The abbrev-symbol of the last abbrev expanded.  See `abbrev-symbol'.");
 505
 506   DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
 507     "The exact text of the last abbrev expanded.\n\
 508 nil if the abbrev has already been unexpanded.");
 509
 510   DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
 511     "The location of the start of the last abbrev expanded.");
 512
 513   Vlast_abbrev = Qnil;
 514   Vlast_abbrev_text = Qnil;
 515   last_abbrev_point = 0;
 516
 517   DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
 518     "Buffer position for `expand-abbrev' to use as the start of the abbrev.\n\
 519 nil means use the word before point as the abbrev.\n\
 520 Calling `expand-abbrev' sets this to nil.");
 521   Vabbrev_start_location = Qnil;
 522
 523   DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
 524     "Buffer that `abbrev-start-location' has been set for.\n\
 525 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.");
 526   Vabbrev_start_location_buffer = Qnil;
 527
 528   DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table,
 529     "Local (mode-specific) abbrev table of current buffer.");
 530
 531   DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
 532     "Set non-nil by defining or altering any word abbrevs.\n\
 533 This causes `save-some-buffers' to offer to save the abbrevs.");
 534   abbrevs_changed = 0;
 535
 536   DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
 537     "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
 538   abbrev_all_caps = 0;
 539
 540   DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
 541     "Function or functions to be called before abbrev expansion is done.\n\
 542 This is the first thing that `expand-abbrev' does, and so this may change\n\
 543 the current abbrev table before abbrev lookup happens.");
 544   Vpre_abbrev_expand_hook = Qnil;
 545   Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
 546   staticpro (&Qpre_abbrev_expand_hook);
 547
 548   defsubr (&Smake_abbrev_table);
 549   defsubr (&Sclear_abbrev_table);
 550   defsubr (&Sdefine_abbrev);
 551   defsubr (&Sdefine_global_abbrev);
 552   defsubr (&Sdefine_mode_abbrev);
 553   defsubr (&Sabbrev_expansion);
 554   defsubr (&Sabbrev_symbol);
 555   defsubr (&Sexpand_abbrev);
 556   defsubr (&Sunexpand_abbrev);
 557   defsubr (&Sinsert_abbrev_table_description);
 558   defsubr (&Sdefine_abbrev_table);
 559 }