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