CodeReading: EmacsLisp "abbrev"

DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
       doc: /* Create a new, empty abbrev table object.  */)
     ()
{
  /* The value 59 is arbitrary chosen prime number.  */
  return Fmake_vector (make_number (59), make_number (0));
}

DEFUN ("clear-abbrev-table", Fclear_abbrev_table, Sclear_abbrev_table, 1, 1, 0,
       doc: /* Undefine all abbrevs in abbrev table TABLE, leaving it empty.  */)
     (table)
     Lisp_Object table;
{
  int i, size;

  CHECK_VECTOR (table);
  size = XVECTOR (table)->size;
  abbrevs_changed = 1;
  for (i = 0; i < size; i++)
    XVECTOR (table)->contents[i] = make_number (0);
  return Qnil;
}

DEFUN ("define-abbrev", Fdefine_abbrev, Sdefine_abbrev, 3, 6, 0,
       doc: /* Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
NAME must be a string.
EXPANSION should usually be a string.
To undefine an abbrev, define it with EXPANSION = nil.
If HOOK is non-nil, it should be a function of no arguments;
it is called after EXPANSION is inserted.
If EXPANSION is not a string, the abbrev is a special one,
 which does not expand in the usual way but only runs HOOK.

COUNT, if specified, gives the initial value for the abbrev's
usage-count, which is incremented each time the abbrev is used.
\(The default is zero.)

SYSTEM-FLAG, if non-nil, says that this is a "system" abbreviation
which should not be saved in the user's abbreviation file.  */)
     (table, name, expansion, hook, count, system_flag)
     Lisp_Object table, name, expansion, hook, count, system_flag;
{
  Lisp_Object sym, oexp, ohook, tem;
  CHECK_VECTOR (table);
  CHECK_STRING (name);

  if (NILP (count))
    count = make_number (0);
  else
    CHECK_NUMBER (count);

  sym = Fintern (name, table);

  oexp = SYMBOL_VALUE (sym);
  ohook = XSYMBOL (sym)->function;
  if (!((EQ (oexp, expansion)
	 || (STRINGP (oexp) && STRINGP (expansion)
	     && (tem = Fstring_equal (oexp, expansion), !NILP (tem))))
	&&
	(EQ (ohook, hook)
	 || (tem = Fequal (ohook, hook), !NILP (tem))))
      && NILP (system_flag))
    abbrevs_changed = 1;

  Fset (sym, expansion);
  Ffset (sym, hook);

  if (! NILP (system_flag))
    Fsetplist (sym, list4 (Qcount, count, Qsystem_type, system_flag));
  else
    Fsetplist (sym, count);

  return name;
}

/* Expand the word before point, if it is an abbrev.
  Returns 1 if an expansion is done. */

DEFUN ("expand-abbrev", Fexpand_abbrev, Sexpand_abbrev, 0, 0, "",
       doc: /* Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
Returns the abbrev symbol, if expansion took place.  */)
     ()
{
  register char *buffer, *p;
  int wordstart, wordend;
  register int wordstart_byte, wordend_byte, idx, idx_byte;
  int whitecnt;
  int uccount = 0, lccount = 0;
  register Lisp_Object sym;
  Lisp_Object expansion, hook, tem;
  Lisp_Object value;
  int multibyte = ! NILP (current_buffer->enable_multibyte_characters);

  value = Qnil;

  Frun_hooks (1, &Qpre_abbrev_expand_hook);

  wordstart = 0;
  if (!(BUFFERP (Vabbrev_start_location_buffer)
	&& XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
    Vabbrev_start_location = Qnil;
  if (!NILP (Vabbrev_start_location))
    {
      tem = Vabbrev_start_location;
      CHECK_NUMBER_COERCE_MARKER (tem);
      wordstart = XINT (tem);
      Vabbrev_start_location = Qnil;
      if (wordstart < BEGV || wordstart > ZV)
	wordstart = 0;
      if (wordstart && wordstart != ZV)
	{
	  wordstart_byte = CHAR_TO_BYTE (wordstart);
	  if (FETCH_BYTE (wordstart_byte) == '-')
	    del_range (wordstart, wordstart + 1);
	}
    }
  if (!wordstart)
    wordstart = scan_words (PT, -1);

  if (!wordstart)
    return value;

/* Position of beginning of accessible range of buffer.  */
#define BEGV (current_buffer->begv)
#define BEGV_BYTE (current_buffer->begv_byte)

/* Position of point in buffer.  The "+ 0" makes this
   not an l-value, so you can't assign to it.  Use SET_PT instead.  */
#define PT (current_buffer->pt + 0)
#define PT_BYTE (current_buffer->pt_byte + 0)

/* Position of end of accessible range of buffer.  */
#define ZV (current_buffer->zv)
#define ZV_BYTE (current_buffer->zv_byte)

/* Position of end of buffer.  */
#define Z (current_buffer->text->z)
#define Z_BYTE (current_buffer->text->z_byte)

  wordstart_byte = CHAR_TO_BYTE (wordstart);
  wordend = scan_words (wordstart, 1);
  if (!wordend)
    return value;

  if (wordend > PT)
    wordend = PT;

  wordend_byte = CHAR_TO_BYTE (wordend);
  whitecnt = PT - wordend;
  if (wordend <= wordstart)
    return value;

  0  1  2  3  4  5  6  7
  a  b  b  r  e  v  

  p = buffer = (char *) alloca (wordend_byte - wordstart_byte);

  for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; )
    {
      register int c;

      if (multibyte)
	{
	  FETCH_CHAR_ADVANCE (c, idx, idx_byte);
	}
      else
	{
	  c = FETCH_BYTE (idx_byte);
	  idx++, idx_byte++;
	}

      if (UPPERCASEP (c))
	c = DOWNCASE (c), uccount++;
      else if (! NOCASEP (c))
	lccount++;
      if (multibyte)
	p += CHAR_STRING (c, p);
      else
	*p++ = c;
    }

/* 1 if CH is upper case.  */

#define UPPERCASEP(CH) (DOWNCASE (CH) != (CH))

/* 1 if CH is neither upper nor lower case.  */

#define NOCASEP(CH) (UPCASE1 (CH) == (CH))

  if (VECTORP (current_buffer->abbrev_table))
    sym = oblookup (current_buffer->abbrev_table, buffer,
                    wordend - wordstart, p - buffer);
  else
    XSETFASTINT (sym, 0);

  if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
    sym = oblookup (Vglobal_abbrev_table, buffer,
                    wordend - wordstart, p - buffer);
  if (INTEGERP (sym) || NILP (SYMBOL_VALUE (sym)))
    return value;

  if (INTERACTIVE && !EQ (minibuf_window, selected_window))
    {
      /* Add an undo boundary, in case we are doing this for                                                                                  
         a self-inserting command which has avoided making one so far.  */
      SET_PT (wordend);
      Fundo_boundary ();
    }

  Vlast_abbrev_text
    = Fbuffer_substring (make_number (wordstart), make_number (wordend));

  /* Now sym is the abbrev symbol.  */
  Vlast_abbrev = sym;
  value = sym;
  last_abbrev_point = wordstart;

  /* Increment use count.  */
  if (INTEGERP (XSYMBOL (sym)->plist))
    XSETINT (XSYMBOL (sym)->plist,
             XINT (XSYMBOL (sym)->plist) + 1);
  else if (INTEGERP (tem = Fget (sym, Qcount)))
    Fput (sym, Qcount, make_number (XINT (tem) + 1));

  /* If this abbrev has an expansion, delete the abbrev
     and insert the expansion.  */
  expansion = SYMBOL_VALUE (sym);
  if (STRINGP (expansion))
    {
      SET_PT (wordstart);

      insert_from_string (expansion, 0, 0, SCHARS (expansion),
			  SBYTES (expansion), 1);
      del_range_both (PT, PT_BYTE,
		      wordend + (PT - wordstart),
		      wordend_byte + (PT_BYTE - wordstart_byte),
		      1);

      SET_PT (PT + whitecnt);

      if (uccount && !lccount)
	{
	  /* Abbrev was all caps */
	  /* If expansion is multiple words, normally capitalize each word */
	  /* This used to be if (!... && ... >= ...) Fcapitalize; else Fupcase
	     but Megatest 68000 compiler can't handle that */
	  if (!abbrev_all_caps)
	    if (scan_words (PT, -1) > scan_words (wordstart, 1))
	      {
		Fupcase_initials_region (make_number (wordstart),
					 make_number (PT));
		goto caped;
	      }
	  /* If expansion is one word, or if user says so, upcase it all. */
	  Fupcase_region (make_number (wordstart), make_number (PT));
	caped: ;
	}
      else if (uccount)
	{
	  /* Abbrev included some caps.  Cap first initial of expansion */
	  int pos = wordstart_byte;

	  /* Find the initial.  */
	  while (pos < PT_BYTE
		 && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
	    pos++;

	  /* Change just that.  */
	  pos = BYTE_TO_CHAR (pos);
	  Fupcase_initials_region (make_number (pos), make_number (pos + 1));
	}
    }

  hook = XSYMBOL (sym)->function;
  if (!NILP (hook))
    {
      Lisp_Object expanded, prop;

      /* If the abbrev has a hook function, run it.  */
      expanded = call0 (hook);

      /* In addition, if the hook function is a symbol with
	 a non-nil `no-self-insert' property, let the value it returned
	 specify whether we consider that an expansion took place.  If
	 it returns nil, no expansion has been done.  */

      if (SYMBOLP (hook)
	  && NILP (expanded)
	  && (prop = Fget (hook, intern ("no-self-insert")),
	      !NILP (prop)))
	value = Qnil;
    }

  return value;