root/src/cmds.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. move_point
  2. DEFUN
  3. DEFUN
  4. DEFUN
  5. DEFUN
  6. DEFUN
  7. internal_self_insert
  8. syms_of_cmds

     1 /* Simple built-in editing commands.
     2 
     3 Copyright (C) 1985, 1993-1998, 2001-2023 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 of the License, or (at
    10 your option) 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.  If not, see <https://www.gnu.org/licenses/>.  */
    19 
    20 
    21 #include <config.h>
    22 
    23 #include "lisp.h"
    24 #include "commands.h"
    25 #include "character.h"
    26 #include "buffer.h"
    27 #include "syntax.h"
    28 #include "keyboard.h"
    29 #include "keymap.h"
    30 #include "frame.h"
    31 
    32 static int internal_self_insert (int, EMACS_INT);
    33 
    34 /* Add N to point; or subtract N if FORWARD is false.  N defaults to 1.
    35    Validate the new location.  Return nil.  */
    36 static Lisp_Object
    37 move_point (Lisp_Object n, bool forward)
    38 {
    39   /* This used to just set point to point + XFIXNUM (n), and then check
    40      to see if it was within boundaries.  But now that SET_PT can
    41      potentially do a lot of stuff (calling entering and exiting
    42      hooks, etcetera), that's not a good approach.  So we validate the
    43      proposed position, then set point.  */
    44 
    45   EMACS_INT new_point;
    46 
    47   if (NILP (n))
    48     XSETFASTINT (n, 1);
    49   else
    50     CHECK_FIXNUM (n);
    51 
    52   new_point = PT + (forward ? XFIXNUM (n) : - XFIXNUM (n));
    53 
    54   if (new_point < BEGV)
    55     {
    56       SET_PT (BEGV);
    57       xsignal0 (Qbeginning_of_buffer);
    58     }
    59   if (new_point > ZV)
    60     {
    61       SET_PT (ZV);
    62       xsignal0 (Qend_of_buffer);
    63     }
    64 
    65   SET_PT (new_point);
    66   return Qnil;
    67 }
    68 
    69 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
    70        doc: /* Move point N characters forward (backward if N is negative).
    71 On reaching end or beginning of buffer, stop and signal error.
    72 Interactively, N is the numeric prefix argument.
    73 If N is omitted or nil, move point 1 character forward.
    74 
    75 Depending on the bidirectional context, the movement may be to the
    76 right or to the left on the screen.  This is in contrast with
    77 \\[right-char], which see.  */)
    78   (Lisp_Object n)
    79 {
    80   return move_point (n, 1);
    81 }
    82 
    83 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
    84        doc: /* Move point N characters backward (forward if N is negative).
    85 On attempt to pass beginning or end of buffer, stop and signal error.
    86 Interactively, N is the numeric prefix argument.
    87 If N is omitted or nil, move point 1 character backward.
    88 
    89 Depending on the bidirectional context, the movement may be to the
    90 right or to the left on the screen.  This is in contrast with
    91 \\[left-char], which see.  */)
    92   (Lisp_Object n)
    93 {
    94   return move_point (n, 0);
    95 }
    96 
    97 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
    98        doc: /* Move N lines forward (backward if N is negative).
    99 Precisely, if point is on line I, move to the start of line I + N
   100 \("start of line" in the logical order).
   101 If there isn't room, go as far as possible (no error).
   102 Interactively, N is the numeric prefix argument and defaults to 1.
   103 
   104 Returns the count of lines left to move.  If moving forward,
   105 that is N minus number of lines moved; if backward, N plus number
   106 moved.
   107 
   108 Exception: With positive N, a non-empty line at the end of the
   109 buffer, or of its accessible portion, counts as one line
   110 successfully moved (for the return value).  This means that the
   111 function will move point to the end of such a line and will count
   112 it as a line moved across, even though there is no next line to
   113 go to its beginning.  */)
   114   (Lisp_Object n)
   115 {
   116   ptrdiff_t opoint = PT, pos, pos_byte, count;
   117   bool excessive = false;
   118 
   119   if (NILP (n))
   120     count = 1;
   121   else
   122     {
   123       CHECK_INTEGER (n);
   124       if (FIXNUMP (n)
   125           && -BUF_BYTES_MAX <= XFIXNUM (n) && XFIXNUM (n) <= BUF_BYTES_MAX)
   126         count = XFIXNUM (n);
   127       else
   128         {
   129           count = !NILP (Fnatnump (n)) ? BUF_BYTES_MAX : -BUF_BYTES_MAX;
   130           excessive = true;
   131         }
   132     }
   133 
   134   ptrdiff_t counted = scan_newline_from_point (count, &pos, &pos_byte);
   135 
   136   SET_PT_BOTH (pos, pos_byte);
   137 
   138   ptrdiff_t shortage = count - (count <= 0) - counted;
   139   if (shortage != 0)
   140     shortage -= (count <= 0 ? -1
   141                   : (BEGV < ZV && PT != opoint
   142                      && FETCH_BYTE (PT_BYTE - 1) != '\n'));
   143   return (excessive
   144           ? CALLN (Fplus, make_fixnum (shortage - count), n)
   145           : make_fixnum (shortage));
   146 }
   147 
   148 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
   149        doc: /* Move point to beginning of current line (in the logical order).
   150 With argument N not nil or 1, move forward N - 1 lines first.
   151 If point reaches the beginning or end of buffer, it stops there.
   152 
   153 This function constrains point to the current field unless this moves
   154 point to a different line from the original, unconstrained result.
   155 If N is nil or 1, and a front-sticky field starts at point, the point
   156 does not move.  To ignore field boundaries bind
   157 `inhibit-field-text-motion' to t, or use the `forward-line' function
   158 instead.  For instance, `(forward-line 0)' does the same thing as
   159 `(beginning-of-line)', except that it ignores field boundaries.  */)
   160   (Lisp_Object n)
   161 {
   162   if (NILP (n))
   163     XSETFASTINT (n, 1);
   164   else
   165     CHECK_FIXNUM (n);
   166 
   167   SET_PT (XFIXNUM (Fline_beginning_position (n)));
   168 
   169   return Qnil;
   170 }
   171 
   172 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
   173        doc: /* Move point to end of current line (in the logical order).
   174 With argument N not nil or 1, move forward N - 1 lines first.
   175 If point reaches the beginning or end of buffer, it stops there.
   176 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
   177 
   178 This function constrains point to the current field unless this moves
   179 point to a different line from the original, unconstrained result.  If
   180 N is nil or 1, and a rear-sticky field ends at point, the point does
   181 not move.  To ignore field boundaries bind `inhibit-field-text-motion'
   182 to t.  */)
   183   (Lisp_Object n)
   184 {
   185   ptrdiff_t newpos;
   186 
   187   if (NILP (n))
   188     XSETFASTINT (n, 1);
   189   else
   190     CHECK_FIXNUM (n);
   191 
   192   while (1)
   193     {
   194       newpos = XFIXNUM (Fline_end_position (n));
   195       SET_PT (newpos);
   196 
   197       if (PT > newpos
   198           && FETCH_BYTE (PT_BYTE - 1) == '\n')
   199         {
   200           /* If we skipped over a newline that follows
   201              an invisible intangible run,
   202              move back to the last tangible position
   203              within the line.  */
   204 
   205           SET_PT (PT - 1);
   206           break;
   207         }
   208       else if (PT > newpos && PT < ZV
   209                && FETCH_BYTE (PT_BYTE) != '\n')
   210         /* If we skipped something intangible
   211            and now we're not really at eol,
   212            keep going.  */
   213         n = make_fixnum (1);
   214       else
   215         break;
   216     }
   217 
   218   return Qnil;
   219 }
   220 
   221 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
   222        doc: /* Delete the following N characters (previous if N is negative).
   223 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
   224 Interactively, N is the prefix arg, and KILLFLAG is set if
   225 N was explicitly specified.
   226 
   227 The command `delete-forward-char' is preferable for interactive use, e.g.
   228 because it respects values of `delete-active-region' and `overwrite-mode'.  */)
   229   (Lisp_Object n, Lisp_Object killflag)
   230 {
   231   EMACS_INT pos;
   232 
   233   CHECK_FIXNUM (n);
   234 
   235   if (eabs (XFIXNUM (n)) < 2)
   236     call0 (Qundo_auto_amalgamate);
   237 
   238   pos = PT + XFIXNUM (n);
   239   if (NILP (killflag))
   240     {
   241       if (XFIXNUM (n) < 0)
   242         {
   243           if (pos < BEGV)
   244             xsignal0 (Qbeginning_of_buffer);
   245           else
   246             del_range (pos, PT);
   247         }
   248       else
   249         {
   250           if (pos > ZV)
   251             xsignal0 (Qend_of_buffer);
   252           else
   253             del_range (PT, pos);
   254         }
   255     }
   256   else
   257     {
   258       call1 (Qkill_forward_chars, n);
   259     }
   260   return Qnil;
   261 }
   262 
   263 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 2,
   264        "(list (prefix-numeric-value current-prefix-arg) last-command-event)",
   265        doc: /* Insert the character you type.
   266 Whichever character C you type to run this command is inserted.
   267 The numeric prefix argument N says how many times to repeat the insertion.
   268 Before insertion, `expand-abbrev' is executed if the inserted character does
   269 not have word syntax and the previous character in the buffer does.
   270 After insertion, `internal-auto-fill' is called if
   271 `auto-fill-function' is non-nil and if the `auto-fill-chars' table has
   272 a non-nil value for the inserted character.  At the end, it runs
   273 `post-self-insert-hook'.  */)
   274   (Lisp_Object n, Lisp_Object c)
   275 {
   276   CHECK_FIXNUM (n);
   277 
   278   /* Backward compatibility.  */
   279   if (NILP (c))
   280     c = last_command_event;
   281 
   282   if (XFIXNUM (n) < 0)
   283     error ("Negative repetition argument %"pI"d", XFIXNUM (n));
   284 
   285   if (XFIXNAT (n) < 2)
   286     call0 (Qundo_auto_amalgamate);
   287 
   288   /* Barf if the key that invoked this was not a character.  */
   289   if (!CHARACTERP (c))
   290     bitch_at_user ();
   291   else {
   292     int character = translate_char (Vtranslation_table_for_input,
   293                                     XFIXNUM (c));
   294     int val = internal_self_insert (character, XFIXNAT (n));
   295     if (val == 2)
   296       Fset (Qundo_auto__this_command_amalgamating, Qnil);
   297     frame_make_pointer_invisible (SELECTED_FRAME ());
   298   }
   299 
   300   return Qnil;
   301 }
   302 
   303 /* Insert N times character C
   304 
   305    If this insertion is suitable for direct output (completely simple),
   306    return 0.  A value of 1 indicates this *might* not have been simple.
   307    A value of 2 means this did things that call for an undo boundary.  */
   308 
   309 static int
   310 internal_self_insert (int c, EMACS_INT n)
   311 {
   312   int hairy = 0;
   313   Lisp_Object tem;
   314   register enum syntaxcode synt;
   315   Lisp_Object overwrite;
   316   /* Length of multi-byte form of C.  */
   317   int len;
   318   /* Working buffer and pointer for multi-byte form of C.  */
   319   unsigned char str[MAX_MULTIBYTE_LENGTH];
   320   ptrdiff_t chars_to_delete = 0;
   321   ptrdiff_t spaces_to_insert = 0;
   322 
   323   overwrite = BVAR (current_buffer, overwrite_mode);
   324   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
   325     hairy = 1;
   326 
   327   /* At first, get multi-byte form of C in STR.  */
   328   if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
   329     {
   330       len = CHAR_STRING (c, str);
   331       if (len == 1)
   332         /* If C has modifier bits, this makes C an appropriate
   333            one-byte char.  */
   334         c = *str;
   335     }
   336   else
   337     {
   338       str[0] = SINGLE_BYTE_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
   339       len = 1;
   340     }
   341   if (!NILP (overwrite)
   342       && PT < ZV)
   343     {
   344       /* In overwrite-mode, we substitute a character at point (C2,
   345          hereafter) by C.  For that, we delete C2 in advance.  But,
   346          just substituting C2 by C may move a remaining text in the
   347          line to the right or to the left, which is not preferable.
   348          So we insert more spaces or delete more characters in the
   349          following cases: if C is narrower than C2, after deleting C2,
   350          we fill columns with spaces, if C is wider than C2, we delete
   351          C2 and several characters following C2.  */
   352 
   353       /* This is the character after point.  */
   354       int c2 = FETCH_CHAR (PT_BYTE);
   355 
   356       int cwidth;
   357 
   358       /* Overwriting in binary-mode always replaces C2 by C.
   359          Overwriting in textual-mode doesn't always do that.
   360          It inserts newlines in the usual way,
   361          and inserts any character at end of line
   362          or before a tab if it doesn't use the whole width of the tab.  */
   363       if (EQ (overwrite, Qoverwrite_mode_binary))
   364         chars_to_delete = min (n, PTRDIFF_MAX);
   365       else if (c != '\n' && c2 != '\n'
   366                && (cwidth = XFIXNAT (Fchar_width (make_fixnum (c)))) != 0)
   367         {
   368           ptrdiff_t pos = PT;
   369           ptrdiff_t pos_byte = PT_BYTE;
   370           ptrdiff_t curcol = current_column ();
   371 
   372           if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
   373             {
   374               /* Column the cursor should be placed at after this insertion.
   375                  The value should be calculated only when necessary.  */
   376               ptrdiff_t target_clm = curcol + n * cwidth;
   377 
   378               /* The actual cursor position after the trial of moving
   379                  to column TARGET_CLM.  It is greater than TARGET_CLM
   380                  if the TARGET_CLM is middle of multi-column
   381                  character.  In that case, the new point is set after
   382                  that character.  */
   383               ptrdiff_t actual_clm
   384                 = XFIXNAT (Fmove_to_column (make_fixnum (target_clm), Qnil));
   385 
   386               chars_to_delete = PT - pos;
   387 
   388               if (actual_clm > target_clm)
   389                 {
   390                   /* We will delete too many columns.  Let's fill columns
   391                      by spaces so that the remaining text won't move.  */
   392                   ptrdiff_t actual = PT_BYTE;
   393                   actual -= prev_char_len (actual);
   394                   if (FETCH_BYTE (actual) == '\t')
   395                     /* Rather than add spaces, let's just keep the tab. */
   396                     chars_to_delete--;
   397                   else
   398                     spaces_to_insert = actual_clm - target_clm;
   399                 }
   400 
   401               SET_PT_BOTH (pos, pos_byte);
   402             }
   403         }
   404       hairy = 2;
   405     }
   406 
   407   synt = SYNTAX (c);
   408 
   409   if (!NILP (BVAR (current_buffer, abbrev_mode))
   410       && synt != Sword
   411       && NILP (BVAR (current_buffer, read_only))
   412       && PT > BEGV
   413       && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
   414                   ? XFIXNAT (Fprevious_char ())
   415                   : UNIBYTE_TO_CHAR (XFIXNAT (Fprevious_char ())))
   416           == Sword))
   417     {
   418       modiff_count modiff = MODIFF;
   419       Lisp_Object sym;
   420 
   421       sym = call0 (Qexpand_abbrev);
   422 
   423       /* If we expanded an abbrev which has a hook,
   424          and the hook has a non-nil `no-self-insert' property,
   425          return right away--don't really self-insert.  */
   426       if (SYMBOLP (sym) && ! NILP (sym)
   427           && ! NILP (XSYMBOL (sym)->u.s.function)
   428           && SYMBOLP (XSYMBOL (sym)->u.s.function))
   429         {
   430           Lisp_Object prop;
   431           prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert"));
   432           if (! NILP (prop))
   433             return 1;
   434         }
   435 
   436       if (MODIFF != modiff)
   437         hairy = 2;
   438     }
   439 
   440   if (chars_to_delete)
   441     {
   442       int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
   443                  && SINGLE_BYTE_CHAR_P (c))
   444                 ? UNIBYTE_TO_CHAR (c) : c);
   445       Lisp_Object string = Fmake_string (make_fixnum (n), make_fixnum (mc),
   446                                          Qnil);
   447 
   448       if (spaces_to_insert)
   449         {
   450           tem = Fmake_string (make_fixnum (spaces_to_insert),
   451                               make_fixnum (' '), Qnil);
   452           string = concat2 (string, tem);
   453         }
   454 
   455       ptrdiff_t to;
   456       if (ckd_add (&to, PT, chars_to_delete))
   457         to = PTRDIFF_MAX;
   458       replace_range (PT, to, string, 1, 1, 1, 0, false);
   459       Fforward_char (make_fixnum (n));
   460     }
   461   else if (n > 1)
   462     {
   463       USE_SAFE_ALLOCA;
   464       char *strn, *p;
   465       SAFE_NALLOCA (strn, len, n);
   466       for (p = strn; n > 0; n--, p += len)
   467         memcpy (p, str, len);
   468       insert_and_inherit (strn, p - strn);
   469       SAFE_FREE ();
   470     }
   471   else if (n > 0)
   472     insert_and_inherit ((char *) str, len);
   473 
   474   if ((CHAR_TABLE_P (Vauto_fill_chars)
   475        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
   476        : (c == ' ' || c == '\n'))
   477       && !NILP (BVAR (current_buffer, auto_fill_function)))
   478     {
   479       Lisp_Object auto_fill_result;
   480 
   481       if (c == '\n')
   482         /* After inserting a newline, move to previous line and fill
   483            that.  Must have the newline in place already so filling and
   484            justification, if any, know where the end is going to be.  */
   485         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
   486       auto_fill_result = call0 (Qinternal_auto_fill);
   487       /* Test PT < ZV in case the auto-fill-function is strange.  */
   488       if (c == '\n' && PT < ZV)
   489         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
   490       if (!NILP (auto_fill_result))
   491         hairy = 2;
   492     }
   493 
   494   /* Run hooks for electric keys.  */
   495   run_hook (Qpost_self_insert_hook);
   496 
   497   return hairy;
   498 }
   499 
   500 /* module initialization */
   501 
   502 void
   503 syms_of_cmds (void)
   504 {
   505   DEFSYM (Qinternal_auto_fill, "internal-auto-fill");
   506 
   507   DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
   508   DEFSYM (Qundo_auto__this_command_amalgamating,
   509           "undo-auto--this-command-amalgamating");
   510 
   511   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
   512 
   513   /* A possible value for a buffer's overwrite-mode variable.  */
   514   DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
   515 
   516   DEFSYM (Qexpand_abbrev, "expand-abbrev");
   517   DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
   518 
   519   DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
   520                doc: /* Hook run at the end of `self-insert-command'.
   521 This is run after inserting a character.
   522 The hook can access the inserted character via `last-command-event'.  */);
   523   Vpost_self_insert_hook = Qnil;
   524 
   525   defsubr (&Sforward_char);
   526   defsubr (&Sbackward_char);
   527   defsubr (&Sforward_line);
   528   defsubr (&Sbeginning_of_line);
   529   defsubr (&Send_of_line);
   530 
   531   defsubr (&Sdelete_char);
   532   defsubr (&Sself_insert_command);
   533 }

/* [<][>][^][v][top][bottom][index][help] */