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
  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 < wordend; 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, 1);
 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       /* Don't inherit properties here; just copy from old contents.  */
 363       insert_from_string (Vlast_abbrev_text, 0,
 364                           XSTRING (Vlast_abbrev_text)->size, 0);
 365       adjust -= XSTRING (Vlast_abbrev_text)->size;
 366       Vlast_abbrev_text = Qnil;
 367     }
 368   SET_PT (last_abbrev_point < opoint ? opoint - adjust : opoint);
 369   return Qnil;
 370 }
 371 \f
 372 static
 373 write_abbrev (sym, stream)
 374      Lisp_Object sym, stream;
 375 {
 376   Lisp_Object name;
 377   if (NILP (XSYMBOL (sym)->value))
 378     return;
 379   insert ("    (", 5);
 380   XSET (name, Lisp_String, XSYMBOL (sym)->name);
 381   Fprin1 (name, stream);
 382   insert (" ", 1);
 383   Fprin1 (XSYMBOL (sym)->value, stream);
 384   insert (" ", 1);
 385   Fprin1 (XSYMBOL (sym)->function, stream);
 386   insert (" ", 1);
 387   Fprin1 (XSYMBOL (sym)->plist, stream);
 388   insert (")\n", 2);
 389 }
 390
 391 static
 392 describe_abbrev (sym, stream)
 393      Lisp_Object sym, stream;
 394 {
 395   Lisp_Object one;
 396
 397   if (NILP (XSYMBOL (sym)->value))
 398     return;
 399   one = make_number (1);
 400   Fprin1 (Fsymbol_name (sym), stream);
 401   Findent_to (make_number (15), one);
 402   Fprin1 (XSYMBOL (sym)->plist, stream);
 403   Findent_to (make_number (20), one);
 404   Fprin1 (XSYMBOL (sym)->value, stream);
 405   if (!NILP (XSYMBOL (sym)->function))
 406     {
 407       Findent_to (make_number (45), one);
 408       Fprin1 (XSYMBOL (sym)->function, stream);
 409     }
 410   Fterpri (stream);
 411 }
 412
 413 DEFUN ("insert-abbrev-table-description",
 414   Finsert_abbrev_table_description, Sinsert_abbrev_table_description,
 415   1, 2, 0,
 416   "Insert before point a full description of abbrev table named NAME.\n\
 417 NAME is a symbol whose value is an abbrev table.\n\
 418 If optional 2nd arg HUMAN is non-nil, a human-readable description is inserted.\n\
 419 Otherwise the description is an expression,\n\
 420 a call to `define-abbrev-table', which would\n\
 421 define the abbrev table NAME exactly as it is currently defined.")
 422   (name, readable)
 423      Lisp_Object name, readable;
 424 {
 425   Lisp_Object table;
 426   Lisp_Object stream;
 427
 428   CHECK_SYMBOL (name, 0);
 429   table = Fsymbol_value (name);
 430   CHECK_VECTOR (table, 0);
 431
 432   XSET (stream, Lisp_Buffer, current_buffer);
 433
 434   if (!NILP (readable))
 435     {
 436       insert_string ("(");
 437       Fprin1 (name, stream);
 438       insert_string (")\n\n");
 439       map_obarray (table, describe_abbrev, stream);
 440       insert_string ("\n\n");
 441     }
 442   else
 443     {
 444       insert_string ("(define-abbrev-table '");
 445       Fprin1 (name, stream);
 446       insert_string (" '(\n");
 447       map_obarray (table, write_abbrev, stream);
 448       insert_string ("    ))\n\n");
 449     }
 450
 451   return Qnil;
 452 }
 453 \f
 454 DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
 455        2, 2, 0,
 456   "Define TABNAME (a symbol) as an abbrev table name.\n\
 457 Define abbrevs in it according to DEFINITIONS, which is a list of elements\n\
 458 of the form (ABBREVNAME EXPANSION HOOK USECOUNT).")
 459   (tabname, defns)
 460      Lisp_Object tabname, defns;
 461 {
 462   Lisp_Object name, exp, hook, count;
 463   Lisp_Object table, elt;
 464
 465   CHECK_SYMBOL (tabname, 0);
 466   table = Fboundp (tabname);
 467   if (NILP (table) || (table = Fsymbol_value (tabname), NILP (table)))
 468     {
 469       table = Fmake_abbrev_table ();
 470       Fset (tabname, table);
 471       Vabbrev_table_name_list =
 472         Fcons (tabname, Vabbrev_table_name_list);
 473     }
 474   CHECK_VECTOR (table, 0);
 475
 476   for (;!NILP (defns); defns = Fcdr (defns))
 477     {
 478       elt = Fcar (defns);
 479       name  = Fcar (elt);       elt = Fcdr (elt);
 480       exp   = Fcar (elt);       elt = Fcdr (elt);
 481       hook  = Fcar (elt);       elt = Fcdr (elt);
 482       count = Fcar (elt);
 483       Fdefine_abbrev (table, name, exp, hook, count);
 484     }
 485   return Qnil;
 486 }
 487 \f
 488 syms_of_abbrev ()
 489 {
 490   DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
 491     "List of symbols whose values are abbrev tables.");
 492   Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
 493                                    Fcons (intern ("global-abbrev-table"),
 494                                           Qnil));
 495
 496   DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
 497     "The abbrev table whose abbrevs affect all buffers.\n\
 498 Each buffer may also have a local abbrev table.\n\
 499 If it does, the local table overrides the global one\n\
 500 for any particular abbrev defined in both.");
 501   Vglobal_abbrev_table = Fmake_abbrev_table ();
 502
 503   DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
 504     "The abbrev table of mode-specific abbrevs for Fundamental Mode.");
 505   Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
 506   current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
 507
 508   DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
 509     "The abbrev-symbol of the last abbrev expanded.  See `abbrev-symbol'.");
 510
 511   DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
 512     "The exact text of the last abbrev expanded.\n\
 513 nil if the abbrev has already been unexpanded.");
 514
 515   DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
 516     "The location of the start of the last abbrev expanded.");
 517
 518   Vlast_abbrev = Qnil;
 519   Vlast_abbrev_text = Qnil;
 520   last_abbrev_point = 0;
 521
 522   DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
 523     "Buffer position for `expand-abbrev' to use as the start of the abbrev.\n\
 524 nil means use the word before point as the abbrev.\n\
 525 Calling `expand-abbrev' sets this to nil.");
 526   Vabbrev_start_location = Qnil;
 527
 528   DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
 529     "Buffer that `abbrev-start-location' has been set for.\n\
 530 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.");
 531   Vabbrev_start_location_buffer = Qnil;
 532
 533   DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
 534     "Local (mode-specific) abbrev table of current buffer.");
 535
 536   DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
 537     "Set non-nil by defining or altering any word abbrevs.\n\
 538 This causes `save-some-buffers' to offer to save the abbrevs.");
 539   abbrevs_changed = 0;
 540
 541   DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
 542     "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
 543   abbrev_all_caps = 0;
 544
 545   DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
 546     "Function or functions to be called before abbrev expansion is done.\n\
 547 This is the first thing that `expand-abbrev' does, and so this may change\n\
 548 the current abbrev table before abbrev lookup happens.");
 549   Vpre_abbrev_expand_hook = Qnil;
 550   Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
 551   staticpro (&Qpre_abbrev_expand_hook);
 552
 553   defsubr (&Smake_abbrev_table);
 554   defsubr (&Sclear_abbrev_table);
 555   defsubr (&Sdefine_abbrev);
 556   defsubr (&Sdefine_global_abbrev);
 557   defsubr (&Sdefine_mode_abbrev);
 558   defsubr (&Sabbrev_expansion);
 559   defsubr (&Sabbrev_symbol);
 560   defsubr (&Sexpand_abbrev);
 561   defsubr (&Sunexpand_abbrev);
 562   defsubr (&Sinsert_abbrev_table_description);
 563   defsubr (&Sdefine_abbrev_table);
 564 }