src/cmds.c

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