code.delx.au - gnu-emacs/blob - 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   if (XBUFFER (Vabbrev_start_location_buffer) != current_buffer)
 233     Vabbrev_start_location = Qnil;
 234   if (!NILP (Vabbrev_start_location))
 235     {
 236       tem = Vabbrev_start_location;
 237       CHECK_NUMBER_COERCE_MARKER (tem, 0);
 238       wordstart = XINT (tem);
 239       Vabbrev_start_location = Qnil;
 240       if (FETCH_CHAR (wordstart) == '-')
 241         del_range (wordstart, wordstart + 1);
 242     }
 243   else
 244     wordstart = scan_words (point, -1);
 245
 246   if (!wordstart)
 247     return value;
 248
 249   wordend = scan_words (wordstart, 1);
 250   if (!wordend)
 251     return value;
 252
 253   if (wordend > point)
 254     wordend = point;
 255   whitecnt = point - wordend;
 256   if (wordend <= wordstart)
 257     return value;
 258
 259   p = buffer = (char *) alloca (wordend - wordstart);
 260
 261   for (idx = wordstart; idx < wordend; idx++)
 262     {
 263       register int c = FETCH_CHAR (idx);
 264       if (UPPERCASEP (c))
 265         c = DOWNCASE (c), uccount++;
 266       else if (! NOCASEP (c))
 267         lccount++;
 268       *p++ = c;
 269     }
 270
 271   if (VECTORP (current_buffer->abbrev_table))
 272     sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer);
 273   else
 274     XFASTINT (sym) = 0;
 275   if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
 276     sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer);
 277   if (INTEGERP (sym) || NILP (XSYMBOL (sym)->value))
 278     return value;
 279
 280   if (INTERACTIVE && !EQ (minibuf_window, selected_window))
 281     {
 282       SET_PT (wordend);
 283       Fundo_boundary ();
 284     }
 285   SET_PT (wordstart);
 286   Vlast_abbrev_text
 287     = Fbuffer_substring (make_number (wordstart), make_number (wordend));
 288   del_range (wordstart, wordend);
 289
 290   /* Now sym is the abbrev symbol. */
 291   Vlast_abbrev = sym;
 292   last_abbrev_point = wordstart;
 293
 294   if (INTEGERP (XSYMBOL (sym)->plist))
 295     XSETINT (XSYMBOL (sym)->plist,
 296              XINT (XSYMBOL (sym)->plist) + 1);  /* Increment use count */
 297
 298   expansion = XSYMBOL (sym)->value;
 299   insert_from_string (expansion, 0, XSTRING (expansion)->size, 1);
 300   SET_PT (point + whitecnt);
 301
 302   if (uccount && !lccount)
 303     {
 304       /* Abbrev was all caps */
 305       /* If expansion is multiple words, normally capitalize each word */
 306       /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
 307          but Megatest 68000 compiler can't handle that */
 308       if (!abbrev_all_caps)
 309         if (scan_words (point, -1) > scan_words (wordstart, 1))
 310           {
 311             upcase_initials_region (make_number (wordstart),
 312                                     make_number (point));
 313             goto caped;
 314           }
 315       /* If expansion is one word, or if user says so, upcase it all. */
 316       Fupcase_region (make_number (wordstart), make_number (point));
 317     caped: ;
 318     }
 319   else if (uccount)
 320     {
 321       /* Abbrev included some caps.  Cap first initial of expansion */
 322       int pos = wordstart;
 323
 324       /* Find the initial.  */
 325       while (pos < point
 326              && SYNTAX (*BUF_CHAR_ADDRESS (current_buffer, pos)) != Sword)
 327         pos++;
 328
 329       /* Change just that.  */
 330       Fupcase_initials_region (make_number (pos), make_number (pos + 1));
 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 (STRINGP (Vlast_abbrev_text))
 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 (!STRINGP (val))
 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 }