git.chise.org Git - chise/xemacs-chise.git.1/blob - src/abbrev.c

   1 /* Primitives for word-abbrev mode.
   2    Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Synched up with: FSF 19.30.  Note that there are many more functions in
  22    FSF's abbrev.c.  These have been moved into Lisp in XEmacs. */
  23
  24 /* Authorship:
  25
  26    FSF: Original version; a long time ago.
  27    JWZ or Mly: Mostly moved into Lisp; maybe 1992.
  28    Ben Wing: Some changes for Mule for 19.12.
  29    Hrvoje Niksic: Largely rewritten in June 1997.
  30 */
  31
  32 /* This file has been Mule-ized. */
  33
  34 #include <config.h>
  35 #include "lisp.h"
  36
  37 #include "buffer.h"
  38 #include "commands.h"
  39 #include "insdel.h"
  40 #include "syntax.h"
  41 #include "window.h"
  42
  43 /* An abbrev table is an obarray.
  44    Each defined abbrev is represented by a symbol in that obarray
  45    whose print name is the abbreviation.
  46    The symbol's value is a string which is the expansion.
  47    If its function definition is non-nil, it is called
  48    after the expansion is done.
  49    The plist slot of the abbrev symbol is its usage count. */
  50
  51 /* The table of global abbrevs.  These are in effect
  52    in any buffer in which abbrev mode is turned on. */
  53 Lisp_Object Vglobal_abbrev_table;
  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 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 Lisp_Object Vlast_abbrev;
  66
  67 /* A string for the actual text of the abbrev most recently expanded.
  68    This has more info than Vlast_abbrev since case is significant.  */
  69 Lisp_Object Vlast_abbrev_text;
  70
  71 /* Character address of start of last abbrev expanded */
  72 int last_abbrev_location;
  73
  74 /* Hook to run before expanding any abbrev.  */
  75 Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
  76
  77 \f
  78 struct abbrev_match_mapper_closure {
  79   struct buffer *buf;
  80   struct Lisp_Char_Table *chartab;
  81   Charcount point, maxlen;
  82   struct Lisp_Symbol *found;
  83 };
  84
  85 /* For use by abbrev_match(): Match SYMBOL's name against buffer text
  86    before point, case-insensitively.  When found, return non-zero, so
  87    that map_obarray terminates mapping.  */
  88 static int
  89 abbrev_match_mapper (Lisp_Object symbol, void *arg)
  90 {
  91   struct abbrev_match_mapper_closure *closure =
  92     (struct abbrev_match_mapper_closure *)arg;
  93   Charcount abbrev_length;
  94   struct Lisp_Symbol *sym = XSYMBOL (symbol);
  95   struct Lisp_String *abbrev;
  96
  97   /* symbol_value should be OK here, because abbrevs are not expected
  98      to contain any SYMBOL_MAGIC stuff.  */
  99   if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym)))
 100     {
 101       /* The symbol value of nil means that abbrev got undefined. */
 102       return 0;
 103     }
 104   abbrev = symbol_name (sym);
 105   abbrev_length = string_char_length (abbrev);
 106   if (abbrev_length > closure->maxlen)
 107     {
 108       /* This abbrev is too large -- it wouldn't fit. */
 109       return 0;
 110     }
 111   /* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't
 112      normally want to expand it.  OTOH, if the abbrev begins with
 113      non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere.  */
 114   if (abbrev_length < closure->maxlen && abbrev_length > 0
 115       && (WORD_SYNTAX_P (closure->chartab, string_char (abbrev, 0)))
 116       && (WORD_SYNTAX_P (closure->chartab,
 117                          BUF_FETCH_CHAR (closure->buf,
 118                                          closure->point - (abbrev_length + 1)))))
 119     {
 120       return 0;
 121     }
 122   /* Match abbreviation string against buffer text.  */
 123   {
 124     Bufbyte *ptr = string_data (abbrev);
 125     Charcount idx;
 126
 127     for (idx = 0; idx < abbrev_length; idx++)
 128       {
 129         if (DOWNCASE (closure->buf,
 130                       BUF_FETCH_CHAR (closure->buf,
 131                                       closure->point - abbrev_length + idx))
 132             != DOWNCASE (closure->buf, charptr_emchar (ptr)))
 133           {
 134             break;
 135           }
 136         INC_CHARPTR (ptr);
 137       }
 138     if (idx == abbrev_length)
 139       {
 140         /* This is the one. */
 141         closure->found = sym;
 142         return 1;
 143       }
 144   }
 145   return 0;
 146 }
 147
 148 /* Match the buffer text against names of symbols in obarray.  Returns
 149    the matching symbol, or 0 if not found.  */
 150 static struct Lisp_Symbol *
 151 abbrev_match (struct buffer *buf, Lisp_Object obarray)
 152 {
 153   struct abbrev_match_mapper_closure closure;
 154
 155   /* Precalculate some stuff, so mapper function needn't to it in each
 156      iteration.  */
 157   closure.buf = buf;
 158   closure.point = BUF_PT (buf);
 159   closure.maxlen = closure.point - BUF_BEGV (buf);
 160   closure.chartab = XCHAR_TABLE (buf->mirror_syntax_table);
 161   closure.found = 0;
 162
 163   map_obarray (obarray, abbrev_match_mapper, &closure);
 164
 165   return closure.found;
 166 }
 167 \f
 168 /* Take the word before point (or Vabbrev_start_location, if non-nil),
 169    and look it up in OBARRAY, and return the symbol (or zero).  This
 170    used to be the default method of searching, with the obvious
 171    limitation that the abbrevs may consist only of word characters.
 172    It is an order of magnitude faster than the proper abbrev_match(),
 173    but then again, vi is an order of magnitude faster than Emacs.
 174
 175    This speed difference should be unnoticeable, though.  I have tested
 176    the degenerated cases of thousands of abbrevs being defined, and
 177    abbrev_match() was still fast enough for normal operation.  */
 178 static struct Lisp_Symbol *
 179 abbrev_oblookup (struct buffer *buf, Lisp_Object obarray)
 180 {
 181   Bufpos wordstart, wordend;
 182   Bufbyte *word, *p;
 183   Bytecount idx;
 184   Lisp_Object lookup;
 185
 186   CHECK_VECTOR (obarray);
 187
 188   if (!NILP (Vabbrev_start_location))
 189     {
 190       wordstart = get_buffer_pos_char (buf, Vabbrev_start_location,
 191                                        GB_COERCE_RANGE);
 192       Vabbrev_start_location = Qnil;
 193 #if 0
 194       /* Previously, abbrev-prefix-mark crockishly inserted a dash to
 195          indicate the abbrev start point.  It now uses an extent with
 196          a begin glyph so there's no dash to remove.  */
 197       if (wordstart != BUF_ZV (buf)
 198           && BUF_FETCH_CHAR (buf, wordstart) == '-')
 199         {
 200           buffer_delete_range (buf, wordstart, wordstart + 1, 0);
 201         }
 202 #endif
 203       wordend = BUF_PT (buf);
 204     }
 205   else
 206     {
 207       Bufpos point = BUF_PT (buf);
 208
 209       wordstart = scan_words (buf, point, -1);
 210       if (!wordstart)
 211         return 0;
 212
 213       wordend = scan_words (buf, wordstart, 1);
 214       if (!wordend)
 215         return 0;
 216       if (wordend > BUF_ZV (buf))
 217         wordend = BUF_ZV (buf);
 218       if (wordend > point)
 219         wordend = point;
 220       /* Unlike the original function, we allow expansion only after
 221          the abbrev, not preceded by a number of spaces.  This is
 222          because of consistency with abbrev_match. */
 223       if (wordend < point)
 224         return 0;
 225       if (wordend <= wordstart)
 226         return 0;
 227     }
 228
 229   p = word = (Bufbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart));
 230   for (idx = wordstart; idx < wordend; idx++)
 231     {
 232       Emchar c = BUF_FETCH_CHAR (buf, idx);
 233       if (UPPERCASEP (buf, c))
 234         c = DOWNCASE (buf, c);
 235       p += set_charptr_emchar (p, c);
 236     }
 237   lookup = oblookup (obarray, word, p - word);
 238   if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup))))
 239     return XSYMBOL (lookup);
 240   else
 241     return NULL;
 242 }
 243 \f
 244 /* Return non-zero if OBARRAY contains an interned symbol ` '. */
 245 static int
 246 obarray_has_blank_p (Lisp_Object obarray)
 247 {
 248   return !ZEROP (oblookup (obarray, (Bufbyte *)" ", 1));
 249 }
 250
 251 /* Analyze case in the buffer substring, and report it.  */
 252 static void
 253 abbrev_count_case (struct buffer *buf, Bufpos pos, Charcount length,
 254                    int *lccount, int *uccount)
 255 {
 256   *lccount = *uccount = 0;
 257   while (length--)
 258     {
 259       Emchar c = BUF_FETCH_CHAR (buf, pos);
 260       if (UPPERCASEP (buf, c))
 261         ++*uccount;
 262       else if (LOWERCASEP (buf, c))
 263         ++*lccount;
 264       ++pos;
 265     }
 266 }
 267 \f
 268 DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /*
 269 Expand the abbrev before point, if any.
 270 Effective when explicitly called even when `abbrev-mode' is nil.
 271 Returns the abbrev symbol, if expansion took place.
 272 If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer,
 273  returns t.
 274 */
 275        ())
 276 {
 277   /* This function can GC */
 278   struct buffer *buf = current_buffer;
 279   int oldmodiff = BUF_MODIFF (buf);
 280   Lisp_Object pre_modiff_p;
 281   Bufpos point;                 /* position of point */
 282   Bufpos abbrev_start;          /* position of abbreviation beginning */
 283
 284   struct Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object);
 285
 286   struct Lisp_Symbol *abbrev_symbol;
 287   struct Lisp_String *abbrev_string;
 288   Lisp_Object expansion, count, hook;
 289   Charcount abbrev_length;
 290   int lccount, uccount;
 291
 292   run_hook (Qpre_abbrev_expand_hook);
 293   /* If the hook changes the buffer, treat that as having "done an
 294      expansion".  */
 295   pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil);
 296
 297   abbrev_symbol = NULL;
 298   if (!BUFFERP (Vabbrev_start_location_buffer) ||
 299       XBUFFER (Vabbrev_start_location_buffer) != buf)
 300     Vabbrev_start_location = Qnil;
 301   /* We use the more general abbrev_match() if the obarray blank flag
 302      is not set, and Vabbrev_start_location is nil.  Otherwise, use
 303      abbrev_oblookup(). */
 304 #define MATCHFUN(tbl) ((obarray_has_blank_p (tbl)                \
 305                         && NILP (Vabbrev_start_location))        \
 306                        ? abbrev_match : abbrev_oblookup)
 307   if (!NILP (buf->abbrev_table))
 308     {
 309       fun = MATCHFUN (buf->abbrev_table);
 310       abbrev_symbol = fun (buf, buf->abbrev_table);
 311     }
 312   if (!abbrev_symbol && !NILP (Vglobal_abbrev_table))
 313     {
 314       fun = MATCHFUN (Vglobal_abbrev_table);
 315       abbrev_symbol = fun (buf, Vglobal_abbrev_table);
 316     }
 317   if (!abbrev_symbol)
 318     return pre_modiff_p;
 319
 320   /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something
 321      nasty, such as changed the buffer.  Here we protect against the
 322      buffer getting killed.  */
 323   if (! BUFFER_LIVE_P (buf))
 324     return Qnil;
 325   point = BUF_PT (buf);
 326
 327   /* OK, we're out of the must-be-fast part.  An abbreviation matched.
 328      Now find the parameters, insert the expansion, and make it all
 329      look pretty.  */
 330   abbrev_string = symbol_name (abbrev_symbol);
 331   abbrev_length = string_char_length (abbrev_string);
 332   abbrev_start = point - abbrev_length;
 333
 334   expansion = symbol_value (abbrev_symbol);
 335   CHECK_STRING (expansion);
 336
 337   count = symbol_plist (abbrev_symbol); /* Gag */
 338   if (NILP (count))
 339     count = Qzero;
 340   else
 341     CHECK_NATNUM (count);
 342   symbol_plist (abbrev_symbol) = make_int (1 + XINT (count));
 343
 344   /* Count the case in the original text. */
 345   abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
 346
 347   /* Remember the last abbrev text, location, etc. */
 348   XSETSYMBOL (Vlast_abbrev, abbrev_symbol);
 349   Vlast_abbrev_text =
 350     make_string_from_buffer (buf, abbrev_start, abbrev_length);
 351   last_abbrev_location = abbrev_start;
 352
 353   /* Add an undo boundary, in case we are doing this for a
 354      self-inserting command which has avoided making one so far.  */
 355   if (INTERACTIVE)
 356     Fundo_boundary ();
 357
 358   /* Remove the abbrev */
 359   buffer_delete_range (buf, abbrev_start, point, 0);
 360   /* And insert the expansion. */
 361   buffer_insert_lisp_string (buf, expansion);
 362   point = BUF_PT (buf);
 363
 364   /* Now fiddle with the case. */
 365   if (uccount && !lccount)
 366     {
 367       /* Abbrev was all caps */
 368       if (!abbrev_all_caps
 369           && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1))
 370         {
 371           Fupcase_initials_region (make_int (abbrev_start), make_int (point),
 372                                    make_buffer (buf));
 373         }
 374       else
 375         {
 376           /* If expansion is one word, or if user says so, upcase it all. */
 377           Fupcase_region (make_int (abbrev_start), make_int (point),
 378                           make_buffer (buf));
 379         }
 380     }
 381   else if (uccount)
 382     {
 383       /* Abbrev included some caps.  Cap first initial of expansion */
 384       Bufpos pos = abbrev_start;
 385       /* Find the initial.  */
 386       while (pos < point
 387              && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table),
 388                                 BUF_FETCH_CHAR (buf, pos)))
 389         pos++;
 390       /* Change just that.  */
 391       Fupcase_initials_region (make_int (pos), make_int (pos + 1),
 392                                make_buffer (buf));
 393     }
 394
 395   hook = symbol_function (abbrev_symbol);
 396   if (!NILP (hook) && !UNBOUNDP (hook))
 397     call0 (hook);
 398
 399   return Vlast_abbrev;
 400 }
 401
 402 \f
 403 void
 404 syms_of_abbrev (void)
 405 {
 406   defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook");
 407   DEFSUBR (Fexpand_abbrev);
 408 }
 409
 410 void
 411 vars_of_abbrev (void)
 412 {
 413   DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table /*
 414 The abbrev table whose abbrevs affect all buffers.
 415 Each buffer may also have a local abbrev table.
 416 If it does, the local table overrides the global one
 417 for any particular abbrev defined in both.
 418 */ );
 419   Vglobal_abbrev_table = Qnil;  /* setup by Lisp code */
 420
 421   DEFVAR_LISP ("last-abbrev", &Vlast_abbrev /*
 422 The abbrev-symbol of the last abbrev expanded.
 423 See the function `abbrev-symbol'.
 424 */ );
 425
 426   DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text /*
 427 The exact text of the last abbrev expanded.
 428 nil if the abbrev has already been unexpanded.
 429 */ );
 430
 431   DEFVAR_INT ("last-abbrev-location", &last_abbrev_location /*
 432 The location of the start of the last abbrev expanded.
 433 */ );
 434
 435   Vlast_abbrev = Qnil;
 436   Vlast_abbrev_text = Qnil;
 437   last_abbrev_location = 0;
 438
 439   DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location /*
 440 Buffer position for `expand-abbrev' to use as the start of the abbrev.
 441 nil means use the word before point as the abbrev.
 442 Calling `expand-abbrev' sets this to nil.
 443 */ );
 444   Vabbrev_start_location = Qnil;
 445
 446   DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer /*
 447 Buffer that `abbrev-start-location' has been set for.
 448 Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.
 449 */ );
 450   Vabbrev_start_location_buffer = Qnil;
 451
 452   DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /*
 453 *Non-nil means expand multi-word abbrevs all caps if abbrev was so.
 454 */ );
 455   abbrev_all_caps = 0;
 456
 457   DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /*
 458 Function or functions to be called before abbrev expansion is done.
 459 This is the first thing that `expand-abbrev' does, and so this may change
 460 the current abbrev table before abbrev lookup happens.
 461 */ );
 462   Vpre_abbrev_expand_hook = Qnil;
 463 }