help-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: self-insert-command source code?


From: Stefan Monnier
Subject: Re: self-insert-command source code?
Date: Thu, 04 Dec 2014 17:51:33 -0500
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux)

> 1. Why is that so?  Since this is an interactive function, performance
> should not be the issue.

I think it's largely historical: back when Emacs started, machine
resources were incredibly more limited, so while it was OK for some
commands to be "not quite immediate", it was important for
self-insert-command to be fast enough to be immediate, even when sharing
the machine with many other users at the same time.  Also it was
important not to slowdown other users too much either, so common
commands were optimized so that the average resource use was limited.

So there was a lot of special casing for self-insert-command and
forward/backward-char (the redisplay had special shortcuts just for
those commands).  While this was not 100% incompatible with an Elisp
implementation, it was much more natural to write it in the C given
those constraints.

> 2. What it might look like /if/ it was written in Elisp?

The important part of the code is quoted below.  We do not actually
distinguish between a return value of 0 and 1 any more, so only the
value 2 is relevant.

So, here's what it does, more or less:
- call expand-abbrev is applicable.
- insert N chars at point.
- if in overwrite-mode, remove the corresponding number of chars.
- perform auto-fill if applicable.
- run post_self_insert_hook.

Rewriting it in Elisp would probably be a good idea.


        Stefan


/* Insert N times character C

   If this insertion is suitable for direct output (completely simple),
   return 0.  A value of 1 indicates this *might* not have been simple.
   A value of 2 means this did things that call for an undo boundary.  */

internal_self_insert (int c, EMACS_INT n)
{
  int hairy = 0;
  Lisp_Object tem;
  register enum syntaxcode synt;
  Lisp_Object overwrite;
  /* Length of multi-byte form of C.  */
  int len;
  /* Working buffer and pointer for multi-byte form of C.  */
  unsigned char str[MAX_MULTIBYTE_LENGTH];
  ptrdiff_t chars_to_delete = 0;
  ptrdiff_t spaces_to_insert = 0;

  overwrite = BVAR (current_buffer, overwrite_mode);
  if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
    hairy = 1;

  /* At first, get multi-byte form of C in STR.  */
  if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
    {
      len = CHAR_STRING (c, str);
      if (len == 1)
        /* If C has modifier bits, this makes C an appropriate
           one-byte char.  */
        c = *str;
    }
  else
    {
      str[0] = SINGLE_BYTE_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
      len = 1;
    }
  if (!NILP (overwrite)
      && PT < ZV)
    {
      /* In overwrite-mode, we substitute a character at point (C2,
         hereafter) by C.  For that, we delete C2 in advance.  But,
         just substituting C2 by C may move a remaining text in the
         line to the right or to the left, which is not preferable.
         So we insert more spaces or delete more characters in the
         following cases: if C is narrower than C2, after deleting C2,
         we fill columns with spaces, if C is wider than C2, we delete
         C2 and several characters following C2.  */

      /* This is the character after point.  */
      int c2 = FETCH_CHAR (PT_BYTE);

      int cwidth;

      /* Overwriting in binary-mode always replaces C2 by C.
         Overwriting in textual-mode doesn't always do that.
         It inserts newlines in the usual way,
         and inserts any character at end of line
         or before a tab if it doesn't use the whole width of the tab.  */
      if (EQ (overwrite, Qoverwrite_mode_binary))
        chars_to_delete = min (n, PTRDIFF_MAX);
      else if (c != '\n' && c2 != '\n'
               && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
        {
          ptrdiff_t pos = PT;
          ptrdiff_t pos_byte = PT_BYTE;
          ptrdiff_t curcol = current_column ();

          if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
            {
              /* Column the cursor should be placed at after this insertion.
                 The value should be calculated only when necessary.  */
              ptrdiff_t target_clm = curcol + n * cwidth;

              /* The actual cursor position after the trial of moving
                 to column TARGET_CLM.  It is greater than TARGET_CLM
                 if the TARGET_CLM is middle of multi-column
                 character.  In that case, the new point is set after
                 that character.  */
              ptrdiff_t actual_clm
                = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));

              chars_to_delete = PT - pos;

              if (actual_clm > target_clm)
                {
                  /* We will delete too many columns.  Let's fill columns
                     by spaces so that the remaining text won't move.  */
                  ptrdiff_t actual = PT_BYTE;
                  DEC_POS (actual);
                  if (FETCH_CHAR (actual) == '\t')
                    /* Rather than add spaces, let's just keep the tab. */
                    chars_to_delete--;
                  else
                    spaces_to_insert = actual_clm - target_clm;
                }

              SET_PT_BOTH (pos, pos_byte);
            }
        }
      hairy = 2;
    }

  synt = SYNTAX (c);

  if (!NILP (BVAR (current_buffer, abbrev_mode))
      && synt != Sword
      && NILP (BVAR (current_buffer, read_only))
      && PT > BEGV
      && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
                  ? XFASTINT (Fprevious_char ())
                  : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
          == Sword))
    {
      EMACS_INT modiff = MODIFF;
      Lisp_Object sym;

      sym = call0 (Qexpand_abbrev);

      /* If we expanded an abbrev which has a hook,
         and the hook has a non-nil `no-self-insert' property,
         return right away--don't really self-insert.  */
      if (SYMBOLP (sym) && ! NILP (sym)
          && ! NILP (XSYMBOL (sym)->function)
          && SYMBOLP (XSYMBOL (sym)->function))
        {
          Lisp_Object prop;
          prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
          if (! NILP (prop))
            return 1;
        }

      if (MODIFF != modiff)
        hairy = 2;
    }

  if (chars_to_delete)
    {
      int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
                 && SINGLE_BYTE_CHAR_P (c))
                ? UNIBYTE_TO_CHAR (c) : c);
      Lisp_Object string = Fmake_string (make_number (n), make_number (mc));

      if (spaces_to_insert)
        {
          tem = Fmake_string (make_number (spaces_to_insert),
                              make_number (' '));
          string = concat2 (string, tem);
        }

      replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
      Fforward_char (make_number (n + spaces_to_insert));
    }
  else if (n > 1)
    {
      USE_SAFE_ALLOCA;
      char *strn, *p;
      SAFE_NALLOCA (strn, len, n);
      for (p = strn; n > 0; n--, p += len)
        memcpy (p, str, len);
      insert_and_inherit (strn, p - strn);
      SAFE_FREE ();
    }
  else if (n > 0)
    insert_and_inherit ((char *) str, len);

  if ((CHAR_TABLE_P (Vauto_fill_chars)
       ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
       : (c == ' ' || c == '\n'))
      && !NILP (BVAR (current_buffer, auto_fill_function)))
    {
      Lisp_Object auto_fill_result;

      if (c == '\n')
        /* After inserting a newline, move to previous line and fill
           that.  Must have the newline in place already so filling and
           justification, if any, know where the end is going to be.  */
        SET_PT_BOTH (PT - 1, PT_BYTE - 1);
      auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
      /* Test PT < ZV in case the auto-fill-function is strange.  */
      if (c == '\n' && PT < ZV)
        SET_PT_BOTH (PT + 1, PT_BYTE + 1);
      if (!NILP (auto_fill_result))
        hairy = 2;
    }

  /* Run hooks for electric keys.  */
  Frun_hooks (1, &Qpost_self_insert_hook);

  return hairy;
}




reply via email to

[Prev in Thread] Current Thread [Next in Thread]