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

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