src/abbrev.c

   1 /* Primitives for word-abbrev mode.
   2    Copyright (C) 1985, 1986, 1993, 1996, 1998, 2001, 2002, 2003, 2004,
   3                  2005, 2006, 2007 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 3, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 Boston, MA 02110-1301, USA.  */
  21
  22
  23 #include <config.h>
  24 #include <stdio.h>
  25
  26 #include "lisp.h"
  27 #include "commands.h"
  28 #include "buffer.h"
  29 #include "window.h"
  30 #include "charset.h"
  31 #include "syntax.h"
  32
  33 /* An abbrev table is an obarray.
  34  Each defined abbrev is represented by a symbol in that obarray
  35  whose print name is the abbreviation.
  36  The symbol's value is a string which is the expansion.
  37  If its function definition is non-nil, it is called
  38   after the expansion is done.
  39  The plist slot of the abbrev symbol is its usage count. */
  40
  41 /* List of all abbrev-table name symbols:
  42  symbols whose values are abbrev tables.  */
  43
  44 Lisp_Object Vabbrev_table_name_list;
  45
  46 /* The table of global abbrevs.  These are in effect
  47  in any buffer in which abbrev mode is turned on. */
  48
  49 Lisp_Object Vglobal_abbrev_table;
  50
  51 /* The local abbrev table used by default (in Fundamental Mode buffers) */
  52
  53 Lisp_Object Vfundamental_mode_abbrev_table;
  54
  55 /* Set nonzero when an abbrev definition is changed */
  56
  57 int abbrevs_changed;
  58
  59 int abbrev_all_caps;
  60
  61 /* Non-nil => use this location as the start of abbrev to expand
  62  (rather than taking the word before point as the abbrev) */
  63
  64 Lisp_Object Vabbrev_start_location;
  65
  66 /* Buffer that Vabbrev_start_location applies to */
  67 Lisp_Object Vabbrev_start_location_buffer;
  68
  69 /* The symbol representing the abbrev most recently expanded */
  70
  71 Lisp_Object Vlast_abbrev;
  72
  73 /* A string for the actual text of the abbrev most recently expanded.
  74    This has more info than Vlast_abbrev since case is significant.  */
  75
  76 Lisp_Object Vlast_abbrev_text;
  77
  78 /* Character address of start of last abbrev expanded */
  79
  80 EMACS_INT last_abbrev_point;
  81
  82 /* Hook to run before expanding any abbrev.  */
  83
  84 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
  85
  86 Lisp_Object Qsystem_type, Qcount, Qforce;
  87 \f
  88 DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
  89        doc: /* Create a new, empty abbrev table object.  */)
  90      ()
  91 {
  92   /* The value 59 is arbitrary chosen prime number.  */
  93   return Fmake_vector (make_number (59), make_number (0));
  94 }
  95
  96 DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
  97        doc: /* Undefine all abbrevs in abbrev table TABLE, leaving it empty.  */)
  98      (table)
  99      Lisp_Object table;
 100 {
 101   int i, size;
 102
 103   CHECK_VECTOR (table);
 104   size = XVECTOR (table)->size;
 105   abbrevs_changed = 1;
 106   for (i = 0; i < size; i++)
 107     XVECTOR (table)->contents[i] = make_number (0);
 108   return Qnil;
 109 }
 110
 111 DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 6, 0,
 112        doc: /* Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
 113 NAME must be a string, and should be lower-case.
 114 EXPANSION should usually be a string.
 115 To undefine an abbrev, define it with EXPANSION = nil.
 116 If HOOK is non-nil, it should be a function of no arguments;
 117 it is called after EXPANSION is inserted.
 118 If EXPANSION is not a string, the abbrev is a special one,
 119  which does not expand in the usual way but only runs HOOK.
 120
 121 COUNT, if specified, gives the initial value for the abbrev's
 122 usage-count, which is incremented each time the abbrev is used.
 123 \(The default is zero.)
 124
 125 SYSTEM-FLAG, if non-nil, says that this is a "system" abbreviation
 126 which should not be saved in the user's abbreviation file.
 127 Unless SYSTEM-FLAG is `force', a system abbreviation will not
 128 overwrite a non-system abbreviation of the same name.  */)
 129      (table, name, expansion, hook, count, system_flag)
 130      Lisp_Object table, name, expansion, hook, count, system_flag;
 131 {
 132   Lisp_Object sym, oexp, ohook, tem;
 133   CHECK_VECTOR (table);
 134   CHECK_STRING (name);
 135
 136   /* If defining a system abbrev, do not overwrite a non-system abbrev
 137      of the same name, unless 'force is used. */
 138   if (!NILP (system_flag) && !EQ (system_flag, Qforce))
 139     {
 140       sym = Fintern_soft (name, table);
 141
 142       if (!NILP (SYMBOL_VALUE (sym)) &&
 143           NILP (Fplist_get (XSYMBOL (sym)->plist, Qsystem_type))) return Qnil;
 144     }
 145
 146   if (NILP (count))
 147     count = make_number (0);
 148   else
 149     CHECK_NUMBER (count);
 150
 151   sym = Fintern (name, table);
 152
 153   oexp = SYMBOL_VALUE (sym);
 154   ohook = XSYMBOL (sym)->function;
 155   if (!((EQ (oexp, expansion)
 156          || (STRINGP (oexp) && STRINGP (expansion)
 157              && (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
 158         &&
 159         (EQ (ohook, hook)
 160          || (tem = Fequal (ohook, hook), !NILP (tem))))
 161       && NILP (system_flag))
 162     abbrevs_changed = 1;
 163
 164   Fset (sym, expansion);
 165   Ffset (sym, hook);
 166
 167   if (! NILP (system_flag))
 168     Fsetplist (sym, list4 (Qcount, count, Qsystem_type, system_flag));
 169   else
 170     Fsetplist (sym, count);
 171
 172   return name;
 173 }
 174
 175 /* Check if the characters in ABBREV have word syntax in either the
 176  * current (if global == 0) or standard syntax table. */
 177 static void
 178 abbrev_check_chars (abbrev, global)
 179      Lisp_Object abbrev;
 180      int global;
 181 {
 182   int i, i_byte, len, nbad = 0;
 183   int j, found, nuniq = 0;
 184   char *badchars, *baduniq;
 185
 186   CHECK_STRING (abbrev);
 187   len = SCHARS (abbrev);
 188
 189   badchars = (char *) alloca (len + 1);
 190
 191   for (i = 0, i_byte = 0; i < len; )
 192     {
 193       int c;
 194
 195       FETCH_STRING_CHAR_ADVANCE (c, abbrev, i, i_byte);
 196
 197       if (global)
 198         {
 199           /* Copied from SYNTAX in syntax.h, except using FOLLOW_PARENT. */
 200           Lisp_Object syntax_temp
 201             = SYNTAX_ENTRY_FOLLOW_PARENT (Vstandard_syntax_table, c);
 202           if ( (CONSP (syntax_temp)
 203                 ? (enum syntaxcode) (XINT (XCAR (syntax_temp)) & 0xff)
 204                 : Swhitespace) != Sword ) badchars[nbad++] = c;
 205         }
 206       else if (SYNTAX (c) != Sword)
 207         badchars[nbad++] = c;
 208     }
 209
 210   if (nbad == 0) return;
 211
 212   baduniq = (char *) alloca (nbad + 1);
 213
 214   for (i = 0; i < nbad; i++)
 215     {
 216       found = 0;
 217
 218       for (j = 0; j < nuniq; j++)
 219         {
 220           if (badchars[i] == baduniq[j])
 221             {
 222               found = 1;
 223               break;
 224             }
 225         }
 226
 227       if (found) continue ;
 228
 229       baduniq[nuniq++] = badchars[i];
 230     }
 231
 232   baduniq[nuniq] = '\0';
 233
 234   error ("Some abbrev characters (%s) are not word constituents %s",
 235          baduniq, global ? "in the standard syntax" : "in this mode" );
 236 }
 237
 238 DEFUN ("define-global-abbrev", Fdefine_global_abbrev, Sdefine_global_abbrev, 2, 2,
 239        "sDefine global abbrev: \nsExpansion for %s: ",
 240        doc: /* Define ABBREV as a global abbreviation for EXPANSION.
 241 The characters in ABBREV must all be word constituents in the standard
 242 syntax table.  */)
 243      (abbrev, expansion)
 244      Lisp_Object abbrev, expansion;
 245 {
 246   abbrev_check_chars (abbrev, 1);
 247
 248   Fdefine_abbrev (Vglobal_abbrev_table, Fdowncase (abbrev),
 249                   expansion, Qnil, make_number (0), Qnil);
 250   return abbrev;
 251 }
 252
 253 DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev, Sdefine_mode_abbrev, 2, 2,
 254        "sDefine mode abbrev: \nsExpansion for %s: ",
 255        doc: /* Define ABBREV as a mode-specific abbreviation for EXPANSION.
 256 The characters in ABBREV must all be word-constituents in the current mode.  */)
 257      (abbrev, expansion)
 258      Lisp_Object abbrev, expansion;
 259 {
 260   if (NILP (current_buffer->abbrev_table))
 261     error ("Major mode has no abbrev table");
 262
 263   abbrev_check_chars (abbrev, 0);
 264
 265   Fdefine_abbrev (current_buffer->abbrev_table, Fdowncase (abbrev),
 266                   expansion, Qnil, make_number (0), Qnil);
 267   return abbrev;
 268 }
 269
 270 DEFUN ("abbrev-symbol", Fabbrev_symbol, Sabbrev_symbol, 1, 2, 0,
 271        doc: /* Return the symbol representing abbrev named ABBREV.
 272 This symbol's name is ABBREV, but it is not the canonical symbol of that name;
 273 it is interned in an abbrev-table rather than the normal obarray.
 274 The value is nil if that abbrev is not defined.
 275 Optional second arg TABLE is abbrev table to look it up in.
 276 The default is to try buffer's mode-specific abbrev table, then global table.  */)
 277      (abbrev, table)
 278      Lisp_Object abbrev, table;
 279 {
 280   Lisp_Object sym;
 281   CHECK_STRING (abbrev);
 282   if (!NILP (table))
 283     sym = Fintern_soft (abbrev, table);
 284   else
 285     {
 286       sym = Qnil;
 287       if (!NILP (current_buffer->abbrev_table))
 288         sym = Fintern_soft (abbrev, current_buffer->abbrev_table);
 289       if (NILP (SYMBOL_VALUE (sym)))
 290         sym = Qnil;
 291       if (NILP (sym))
 292         sym = Fintern_soft (abbrev, Vglobal_abbrev_table);
 293     }
 294   if (NILP (SYMBOL_VALUE (sym)))
 295     return Qnil;
 296   return sym;
 297 }
 298
 299 DEFUN ("abbrev-expansion", Fabbrev_expansion, Sabbrev_expansion, 1, 2, 0,
 300        doc: /* Return the string that ABBREV expands into in the current buffer.
 301 Optionally specify an abbrev table as second arg;
 302 then ABBREV is looked up in that table only.  */)
 303      (abbrev, table)
 304      Lisp_Object abbrev, table;
 305 {
 306   Lisp_Object sym;
 307   sym = Fabbrev_symbol (abbrev, table);
 308   if (NILP (sym)) return sym;
 309   return Fsymbol_value (sym);
 310 }
 311 \f
 312 /* Expand the word before point, if it is an abbrev.
 313   Returns 1 if an expansion is done. */
 314
 315 DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
 316        doc: /* Expand the abbrev before point, if there is an abbrev there.
 317 Effective when explicitly called even when `abbrev-mode' is nil.
 318 Returns the abbrev symbol, if expansion took place.  */)
 319      ()
 320 {
 321   register char *buffer, *p;
 322   int wordstart, wordend;
 323   register int wordstart_byte, wordend_byte, idx, idx_byte;
 324   int whitecnt;
 325   int uccount = 0, lccount = 0;
 326   register Lisp_Object sym;
 327   Lisp_Object expansion, hook, tem;
 328   Lisp_Object value;
 329   int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
 330
 331   value = Qnil;
 332
 333   Frun_hooks (1, &Qpre_abbrev_expand_hook);
 334
 335   wordstart = 0;
 336   if (!(BUFFERP (Vabbrev_start_location_buffer)
 337         && XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
 338     Vabbrev_start_location = Qnil;
 339   if (!NILP (Vabbrev_start_location))
 340     {
 341       tem = Vabbrev_start_location;
 342       CHECK_NUMBER_COERCE_MARKER (tem);
 343       wordstart = XINT (tem);
 344       Vabbrev_start_location = Qnil;
 345       if (wordstart < BEGV || wordstart > ZV)
 346         wordstart = 0;
 347       if (wordstart && wordstart != ZV)
 348         {
 349           wordstart_byte = CHAR_TO_BYTE (wordstart);
 350           if (FETCH_BYTE (wordstart_byte) == '-')
 351             del_range (wordstart, wordstart + 1);
 352         }
 353     }
 354   if (!wordstart)
 355     wordstart = scan_words (PT, -1);
 356
 357   if (!wordstart)
 358     return value;
 359
 360   wordstart_byte = CHAR_TO_BYTE (wordstart);
 361   wordend = scan_words (wordstart, 1);
 362   if (!wordend)
 363     return value;
 364
 365   if (wordend > PT)
 366     wordend = PT;
 367
 368   wordend_byte = CHAR_TO_BYTE (wordend);
 369   whitecnt = PT - wordend;
 370   if (wordend <= wordstart)
 371     return value;
 372
 373   p = buffer = (char *) alloca (wordend_byte - wordstart_byte);
 374
 375   for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; )
 376     {
 377       register int c;
 378
 379       if (multibyte)
 380         {
 381           FETCH_CHAR_ADVANCE (c, idx, idx_byte);
 382         }
 383       else
 384         {
 385           c = FETCH_BYTE (idx_byte);
 386           idx++, idx_byte++;
 387         }
 388
 389       if (UPPERCASEP (c))
 390         c = DOWNCASE (c), uccount++;
 391       else if (! NOCASEP (c))
 392         lccount++;
 393       if (multibyte)
 394         p += CHAR_STRING (c, p);
 395       else
 396         *p++ = c;
 397     }
 398
 399   if (VECTORP (current_buffer->abbrev_table))
 400     sym = oblookup (current_buffer->abbrev_table, buffer,
 401                     wordend - wordstart, p - buffer);
 402   else
 403     XSETFASTINT (sym, 0);
 404
 405   if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
 406     sym = oblookup (Vglobal_abbrev_table, buffer,
 407                     wordend - wordstart, p - buffer);
 408   if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
 409     return value;
 410
 411   if (INTERACTIVE && !EQ (minibuf_window, selected_window))
 412     {
 413       /* Add an undo boundary, in case we are doing this for
 414          a self-inserting command which has avoided making one so far.  */
 415       SET_PT (wordend);
 416       Fundo_boundary ();
 417     }
 418
 419   Vlast_abbrev_text
 420     = Fbuffer_substring (make_number (wordstart), make_number (wordend));
 421
 422   /* Now sym is the abbrev symbol.  */
 423   Vlast_abbrev = sym;
 424   value = sym;
 425   last_abbrev_point = wordstart;
 426
 427   /* Increment use count.  */
 428   if (INTEGERP (XSYMBOL (sym)->plist))
 429     XSETINT (XSYMBOL (sym)->plist,
 430              XINT (XSYMBOL (sym)->plist) + 1);
 431   else if (INTEGERP (tem = Fget (sym, Qcount)))
 432     Fput (sym, Qcount, make_number (XINT (tem) + 1));
 433
 434   /* If this abbrev has an expansion, delete the abbrev
 435      and insert the expansion.  */
 436   expansion = SYMBOL_VALUE (sym);
 437   if (STRINGP (expansion))
 438     {
 439       SET_PT (wordstart);
 440
 441       insert_from_string (expansion, 0, 0, SCHARS (expansion),
 442                           SBYTES (expansion), 1);
 443       del_range_both (PT, PT_BYTE,
 444                       wordend + (PT - wordstart),
 445                       wordend_byte + (PT_BYTE - wordstart_byte),
 446                       1);
 447
 448       SET_PT (PT + whitecnt);
 449
 450       if (uccount && !lccount)
 451         {
 452           /* Abbrev was all caps */
 453           /* If expansion is multiple words, normally capitalize each word */
 454           /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
 455              but Megatest 68000 compiler can't handle that */
 456           if (!abbrev_all_caps)
 457             if (scan_words (PT, -1) > scan_words (wordstart, 1))
 458               {
 459                 Fupcase_initials_region (make_number (wordstart),
 460                                          make_number (PT));
 461                 goto caped;
 462               }
 463           /* If expansion is one word, or if user says so, upcase it all. */
 464           Fupcase_region (make_number (wordstart), make_number (PT));
 465         caped: ;
 466         }
 467       else if (uccount)
 468         {
 469           /* Abbrev included some caps.  Cap first initial of expansion */
 470           int pos = wordstart_byte;
 471
 472           /* Find the initial.  */
 473           while (pos < PT_BYTE
 474                  && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
 475             pos++;
 476
 477           /* Change just that.  */
 478           pos = BYTE_TO_CHAR (pos);
 479           Fupcase_initials_region (make_number (pos), make_number (pos + 1));
 480         }
 481     }
 482
 483   hook = XSYMBOL (sym)->function;
 484   if (!NILP (hook))
 485     {
 486       Lisp_Object expanded, prop;
 487
 488       /* If the abbrev has a hook function, run it.  */
 489       expanded = call0 (hook);
 490
 491       /* In addition, if the hook function is a symbol with
 492          a non-nil `no-self-insert' property, let the value it returned
 493          specify whether we consider that an expansion took place.  If
 494          it returns nil, no expansion has been done.  */
 495
 496       if (SYMBOLP (hook)
 497           && NILP (expanded)
 498           && (prop = Fget (hook, intern ("no-self-insert")),
 499               !NILP (prop)))
 500         value = Qnil;
 501     }
 502
 503   return value;
 504 }
 505
 506 DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexpand_abbrev, 0, 0, "",
 507        doc: /* Undo the expansion of the last abbrev that expanded.
 508 This differs from ordinary undo in that other editing done since then
 509 is not undone.  */)
 510      ()
 511 {
 512   int opoint = PT;
 513   int adjust = 0;
 514   if (last_abbrev_point < BEGV
 515       || last_abbrev_point > ZV)
 516     return Qnil;
 517   SET_PT (last_abbrev_point);
 518   if (STRINGP (Vlast_abbrev_text))
 519     {
 520       /* This isn't correct if Vlast_abbrev->function was used
 521          to do the expansion */
 522       Lisp_Object val;
 523       int zv_before;
 524
 525       val = SYMBOL_VALUE (Vlast_abbrev);
 526       if (!STRINGP (val))
 527         error ("Value of `abbrev-symbol' must be a string");
 528       zv_before = ZV;
 529       del_range_byte (PT_BYTE, PT_BYTE + SBYTES (val), 1);
 530       /* Don't inherit properties here; just copy from old contents.  */
 531       insert_from_string (Vlast_abbrev_text, 0, 0,
 532                           SCHARS (Vlast_abbrev_text),
 533                           SBYTES (Vlast_abbrev_text), 0);
 534       Vlast_abbrev_text = Qnil;
 535       /* Total number of characters deleted.  */
 536       adjust = ZV - zv_before;
 537     }
 538   SET_PT (last_abbrev_point < opoint ? opoint + adjust : opoint);
 539   return Qnil;
 540 }
 541 \f
 542 static void
 543 write_abbrev (sym, stream)
 544      Lisp_Object sym, stream;
 545 {
 546   Lisp_Object name, count, system_flag;
 547
 548   if (INTEGERP (XSYMBOL (sym)->plist))
 549     {
 550       count = XSYMBOL (sym)->plist;
 551       system_flag = Qnil;
 552     }
 553   else
 554     {
 555       count = Fget (sym, Qcount);
 556       system_flag = Fget (sym, Qsystem_type);
 557     }
 558
 559   if (NILP (SYMBOL_VALUE (sym)) || ! NILP (system_flag))
 560     return;
 561
 562   insert ("    (", 5);
 563   name = SYMBOL_NAME (sym);
 564   Fprin1 (name, stream);
 565   insert (" ", 1);
 566   Fprin1 (SYMBOL_VALUE (sym), stream);
 567   insert (" ", 1);
 568   Fprin1 (XSYMBOL (sym)->function, stream);
 569   insert (" ", 1);
 570   Fprin1 (count, stream);
 571   insert (")\n", 2);
 572 }
 573
 574 static void
 575 describe_abbrev (sym, stream)
 576      Lisp_Object sym, stream;
 577 {
 578   Lisp_Object one, count, system_flag;
 579
 580   if (INTEGERP (XSYMBOL (sym)->plist))
 581     {
 582       count = XSYMBOL (sym)->plist;
 583       system_flag = Qnil;
 584     }
 585   else
 586     {
 587       count = Fget (sym, Qcount);
 588       system_flag = Fget (sym, Qsystem_type);
 589     }
 590
 591   if (NILP (SYMBOL_VALUE (sym)))
 592     return;
 593
 594   one = make_number (1);
 595   Fprin1 (Fsymbol_name (sym), stream);
 596
 597   if (!NILP (system_flag))
 598     {
 599       insert_string (" (sys)");
 600       Findent_to (make_number (20), one);
 601     }
 602   else
 603     Findent_to (make_number (15), one);
 604
 605   Fprin1 (count, stream);
 606   Findent_to (make_number (20), one);
 607   Fprin1 (SYMBOL_VALUE (sym), stream);
 608   if (!NILP (XSYMBOL (sym)->function))
 609     {
 610       Findent_to (make_number (45), one);
 611       Fprin1 (XSYMBOL (sym)->function, stream);
 612     }
 613   Fterpri (stream);
 614 }
 615
 616 static void
 617 record_symbol (sym, list)
 618      Lisp_Object sym, list;
 619 {
 620   XSETCDR (list, Fcons (sym, XCDR (list)));
 621 }
 622
 623 DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,
 624        Sinsert_abbrev_table_description, 1, 2, 0,
 625        doc: /* Insert before point a full description of abbrev table named NAME.
 626 NAME is a symbol whose value is an abbrev table.
 627 If optional 2nd arg READABLE is non-nil, a human-readable description
 628 is inserted.  Otherwise the description is an expression,
 629 a call to `define-abbrev-table', which would
 630 define the abbrev table NAME exactly as it is currently defined.
 631
 632 Abbrevs marked as "system abbrevs" are normally omitted.  However, if
 633 READABLE is non-nil, they are listed.  */)
 634      (name, readable)
 635      Lisp_Object name, readable;
 636 {
 637   Lisp_Object table;
 638   Lisp_Object symbols;
 639   Lisp_Object stream;
 640
 641   CHECK_SYMBOL (name);
 642   table = Fsymbol_value (name);
 643   CHECK_VECTOR (table);
 644
 645   XSETBUFFER (stream, current_buffer);
 646
 647   symbols = Fcons (Qnil, Qnil);
 648   map_obarray (table, record_symbol, symbols);
 649   symbols = XCDR (symbols);
 650   symbols = Fsort (symbols, Qstring_lessp);
 651
 652   if (!NILP (readable))
 653     {
 654       insert_string ("(");
 655       Fprin1 (name, stream);
 656       insert_string (")\n\n");
 657       while (! NILP (symbols))
 658         {
 659           describe_abbrev (XCAR (symbols), stream);
 660           symbols = XCDR (symbols);
 661         }
 662
 663       insert_string ("\n\n");
 664     }
 665   else
 666     {
 667       insert_string ("(define-abbrev-table '");
 668       Fprin1 (name, stream);
 669       insert_string (" '(\n");
 670       while (! NILP (symbols))
 671         {
 672           write_abbrev (XCAR (symbols), stream);
 673           symbols = XCDR (symbols);
 674         }
 675       insert_string ("    ))\n\n");
 676     }
 677
 678   return Qnil;
 679 }
 680 \f
 681 DEFUN ("define-abbrev-table", Fdefine_abbrev_table, Sdefine_abbrev_table,
 682        2, 2, 0,
 683        doc: /* Define TABLENAME (a symbol) as an abbrev table name.
 684 Define abbrevs in it according to DEFINITIONS, which is a list of elements
 685 of the form (ABBREVNAME EXPANSION HOOK USECOUNT SYSTEMFLAG).
 686 \(If the list is shorter than that, omitted elements default to nil).  */)
 687      (tablename, definitions)
 688      Lisp_Object tablename, definitions;
 689 {
 690   Lisp_Object name, exp, hook, count;
 691   Lisp_Object table, elt, sys;
 692
 693   CHECK_SYMBOL (tablename);
 694   table = Fboundp (tablename);
 695   if (NILP (table) || (table = Fsymbol_value (tablename), NILP (table)))
 696     {
 697       table = Fmake_abbrev_table ();
 698       Fset (tablename, table);
 699       Vabbrev_table_name_list = Fcons (tablename, Vabbrev_table_name_list);
 700     }
 701   CHECK_VECTOR (table);
 702
 703   for (; CONSP (definitions); definitions = XCDR (definitions))
 704     {
 705       elt = XCAR (definitions);
 706       name  = Fcar (elt);       elt = Fcdr (elt);
 707       exp   = Fcar (elt);       elt = Fcdr (elt);
 708       hook  = Fcar (elt);       elt = Fcdr (elt);
 709       count = Fcar (elt);       elt = Fcdr (elt);
 710       sys   = Fcar (elt);
 711       Fdefine_abbrev (table, name, exp, hook, count, sys);
 712     }
 713   return Qnil;
 714 }
 715 \f
 716 void
 717 syms_of_abbrev ()
 718 {
 719   Qsystem_type = intern ("system-type");
 720   staticpro (&Qsystem_type);
 721
 722   Qcount = intern ("count");
 723   staticpro (&Qcount);
 724
 725   Qforce = intern ("force");
 726   staticpro (&Qforce);
 727
 728   DEFVAR_LISP ("abbrev-table-name-list", &Vabbrev_table_name_list,
 729                doc: /* List of symbols whose values are abbrev tables.  */);
 730   Vabbrev_table_name_list = Fcons (intern ("fundamental-mode-abbrev-table"),
 731                                    Fcons (intern ("global-abbrev-table"),
 732                                           Qnil));
 733
 734   DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table,
 735                doc: /* The abbrev table whose abbrevs affect all buffers.
 736 Each buffer may also have a local abbrev table.
 737 If it does, the local table overrides the global one
 738 for any particular abbrev defined in both.  */);
 739   Vglobal_abbrev_table = Fmake_abbrev_table ();
 740
 741   DEFVAR_LISP ("fundamental-mode-abbrev-table", &Vfundamental_mode_abbrev_table,
 742                doc: /* The abbrev table of mode-specific abbrevs for Fundamental Mode.  */);
 743   Vfundamental_mode_abbrev_table = Fmake_abbrev_table ();
 744   current_buffer->abbrev_table = Vfundamental_mode_abbrev_table;
 745   buffer_defaults.abbrev_table = Vfundamental_mode_abbrev_table;
 746
 747   DEFVAR_LISP ("last-abbrev", &Vlast_abbrev,
 748                doc: /* The abbrev-symbol of the last abbrev expanded.  See `abbrev-symbol'.  */);
 749
 750   DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text,
 751                doc: /* The exact text of the last abbrev expanded.
 752 A value of nil means the abbrev has already been unexpanded.  */);
 753
 754   DEFVAR_INT ("last-abbrev-location", &last_abbrev_point,
 755               doc: /* The location of the start of the last abbrev expanded.  */);
 756
 757   Vlast_abbrev = Qnil;
 758   Vlast_abbrev_text = Qnil;
 759   last_abbrev_point = 0;
 760
 761   DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
 762                doc: /* Buffer position for `expand-abbrev' to use as the start of the abbrev.
 763 When nil, use the word before point as the abbrev.
 764 Calling `expand-abbrev' sets this to nil.  */);
 765   Vabbrev_start_location = Qnil;
 766
 767   DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer,
 768                doc: /* Buffer that `abbrev-start-location' has been set for.
 769 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.  */);
 770   Vabbrev_start_location_buffer = Qnil;
 771
 772   DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
 773                      doc: /* Local (mode-specific) abbrev table of current buffer.  */);
 774
 775   DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed,
 776                doc: /* Set non-nil by defining or altering any word abbrevs.
 777 This causes `save-some-buffers' to offer to save the abbrevs.  */);
 778   abbrevs_changed = 0;
 779
 780   DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps,
 781                doc: /* *Set non-nil means expand multi-word abbrevs all caps if abbrev was so.  */);
 782   abbrev_all_caps = 0;
 783
 784   DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
 785                doc: /* Function or functions to be called before abbrev expansion is done.
 786 This is the first thing that `expand-abbrev' does, and so this may change
 787 the current abbrev table before abbrev lookup happens.  */);
 788   Vpre_abbrev_expand_hook = Qnil;
 789   Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
 790   staticpro (&Qpre_abbrev_expand_hook);
 791
 792   defsubr (&Smake_abbrev_table);
 793   defsubr (&Sclear_abbrev_table);
 794   defsubr (&Sdefine_abbrev);
 795   defsubr (&Sdefine_global_abbrev);
 796   defsubr (&Sdefine_mode_abbrev);
 797   defsubr (&Sabbrev_expansion);
 798   defsubr (&Sabbrev_symbol);
 799   defsubr (&Sexpand_abbrev);
 800   defsubr (&Sunexpand_abbrev);
 801   defsubr (&Sinsert_abbrev_table_description);
 802   defsubr (&Sdefine_abbrev_table);
 803 }
 804
 805 /* arch-tag: b721db69-f633-44a8-a361-c275acbdad7d
 806    (do not change this comment) */