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 (abs (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 (XFASTINT (n) < 0)
 311     error ("Negative repetition argument %"pI"d", XFASTINT (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     int character = translate_char (Vtranslation_table_for_input,
 321                                     XINT (last_command_event));
 322     int val = internal_self_insert (character, XFASTINT (n));
 323     if (val == 2)
 324       nonundocount = 0;
 325     frame_make_pointer_invisible (SELECTED_FRAME ());
 326   }
 327
 328   return Qnil;
 329 }
 330
 331 /* Insert N times character C
 332
 333    If this insertion is suitable for direct output (completely simple),
 334    return 0.  A value of 1 indicates this *might* not have been simple.
 335    A value of 2 means this did things that call for an undo boundary.  */
 336
 337 static int
 338 internal_self_insert (int c, EMACS_INT n)
 339 {
 340   int hairy = 0;
 341   Lisp_Object tem;
 342   register enum syntaxcode synt;
 343   Lisp_Object overwrite;
 344   /* Length of multi-byte form of C.  */
 345   int len;
 346   /* Working buffer and pointer for multi-byte form of C.  */
 347   unsigned char str[MAX_MULTIBYTE_LENGTH];
 348   ptrdiff_t chars_to_delete = 0;
 349   ptrdiff_t spaces_to_insert = 0;
 350
 351   overwrite = BVAR (current_buffer, overwrite_mode);
 352   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 353     hairy = 1;
 354
 355   /* At first, get multi-byte form of C in STR.  */
 356   if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
 357     {
 358       len = CHAR_STRING (c, str);
 359       if (len == 1)
 360         /* If C has modifier bits, this makes C an appropriate
 361            one-byte char.  */
 362         c = *str;
 363     }
 364   else
 365     {
 366       str[0] = SINGLE_BYTE_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
 367       len = 1;
 368     }
 369   if (!NILP (overwrite)
 370       && PT < ZV)
 371     {
 372       /* In overwrite-mode, we substitute a character at point (C2,
 373          hereafter) by C.  For that, we delete C2 in advance.  But,
 374          just substituting C2 by C may move a remaining text in the
 375          line to the right or to the left, which is not preferable.
 376          So we insert more spaces or delete more characters in the
 377          following cases: if C is narrower than C2, after deleting C2,
 378          we fill columns with spaces, if C is wider than C2, we delete
 379          C2 and several characters following C2.  */
 380
 381       /* This is the character after point.  */
 382       int c2 = FETCH_CHAR (PT_BYTE);
 383
 384       int cwidth;
 385
 386       /* Overwriting in binary-mode always replaces C2 by C.
 387          Overwriting in textual-mode doesn't always do that.
 388          It inserts newlines in the usual way,
 389          and inserts any character at end of line
 390          or before a tab if it doesn't use the whole width of the tab.  */
 391       if (EQ (overwrite, Qoverwrite_mode_binary))
 392         chars_to_delete = min (n, PTRDIFF_MAX);
 393       else if (c != '\n' && c2 != '\n'
 394                && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
 395         {
 396           ptrdiff_t pos = PT;
 397           ptrdiff_t pos_byte = PT_BYTE;
 398           ptrdiff_t curcol = current_column ();
 399
 400           if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
 401             {
 402               /* Column the cursor should be placed at after this insertion.
 403                  The value should be calculated only when necessary.  */
 404               ptrdiff_t target_clm = curcol + n * cwidth;
 405
 406               /* The actual cursor position after the trial of moving
 407                  to column TARGET_CLM.  It is greater than TARGET_CLM
 408                  if the TARGET_CLM is middle of multi-column
 409                  character.  In that case, the new point is set after
 410                  that character.  */
 411               ptrdiff_t actual_clm
 412                 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
 413
 414               chars_to_delete = PT - pos;
 415
 416               if (actual_clm > target_clm)
 417                 {
 418                   /* We will delete too many columns.  Let's fill columns
 419                      by spaces so that the remaining text won't move.  */
 420                   ptrdiff_t actual = PT_BYTE;
 421                   DEC_POS (actual);
 422                   if (FETCH_CHAR (actual) == '\t')
 423                     /* Rather than add spaces, let's just keep the tab. */
 424                     chars_to_delete--;
 425                   else
 426                     spaces_to_insert = actual_clm - target_clm;
 427                 }
 428
 429               SET_PT_BOTH (pos, pos_byte);
 430             }
 431         }
 432       hairy = 2;
 433     }
 434
 435   synt = SYNTAX (c);
 436
 437   if (!NILP (BVAR (current_buffer, abbrev_mode))
 438       && synt != Sword
 439       && NILP (BVAR (current_buffer, read_only))
 440       && PT > BEGV
 441       && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
 442                   ? XFASTINT (Fprevious_char ())
 443                   : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
 444           == Sword))
 445     {
 446       EMACS_INT modiff = MODIFF;
 447       Lisp_Object sym;
 448
 449       sym = call0 (Qexpand_abbrev);
 450
 451       /* If we expanded an abbrev which has a hook,
 452          and the hook has a non-nil `no-self-insert' property,
 453          return right away--don't really self-insert.  */
 454       if (SYMBOLP (sym) && ! NILP (sym)
 455           && ! NILP (XSYMBOL (sym)->function)
 456           && SYMBOLP (XSYMBOL (sym)->function))
 457         {
 458           Lisp_Object prop;
 459           prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
 460           if (! NILP (prop))
 461             return 1;
 462         }
 463
 464       if (MODIFF != modiff)
 465         hairy = 2;
 466     }
 467
 468   if (chars_to_delete)
 469     {
 470       int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
 471                  && SINGLE_BYTE_CHAR_P (c))
 472                 ? UNIBYTE_TO_CHAR (c) : c);
 473       Lisp_Object string = Fmake_string (make_number (n), make_number (mc));
 474
 475       if (spaces_to_insert)
 476         {
 477           tem = Fmake_string (make_number (spaces_to_insert),
 478                               make_number (' '));
 479           string = concat2 (string, tem);
 480         }
 481
 482       replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
 483       Fforward_char (make_number (n));
 484     }
 485   else if (n > 1)
 486     {
 487       USE_SAFE_ALLOCA;
 488       char *strn, *p;
 489       SAFE_NALLOCA (strn, len, n);
 490       for (p = strn; n > 0; n--, p += len)
 491         memcpy (p, str, len);
 492       insert_and_inherit (strn, p - strn);
 493       SAFE_FREE ();
 494     }
 495   else if (n > 0)
 496     insert_and_inherit ((char *) str, len);
 497
 498   if ((CHAR_TABLE_P (Vauto_fill_chars)
 499        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
 500        : (c == ' ' || c == '\n'))
 501       && !NILP (BVAR (current_buffer, auto_fill_function)))
 502     {
 503       Lisp_Object auto_fill_result;
 504
 505       if (c == '\n')
 506         /* After inserting a newline, move to previous line and fill
 507            that.  Must have the newline in place already so filling and
 508            justification, if any, know where the end is going to be.  */
 509         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
 510       auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
 511       /* Test PT < ZV in case the auto-fill-function is strange.  */
 512       if (c == '\n' && PT < ZV)
 513         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
 514       if (!NILP (auto_fill_result))
 515         hairy = 2;
 516     }
 517
 518   /* Run hooks for electric keys.  */
 519   run_hook (Qpost_self_insert_hook);
 520
 521   return hairy;
 522 }
 523 \f
 524 /* module initialization */
 525
 526 void
 527 syms_of_cmds (void)
 528 {
 529   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
 530
 531   /* A possible value for a buffer's overwrite-mode variable.  */
 532   DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
 533
 534   DEFSYM (Qexpand_abbrev, "expand-abbrev");
 535   DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
 536
 537   DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
 538                doc: /* Hook run at the end of `self-insert-command'.
 539 This is run after inserting the character.  */);
 540   Vpost_self_insert_hook = Qnil;
 541
 542   defsubr (&Sforward_point);
 543   defsubr (&Sforward_char);
 544   defsubr (&Sbackward_char);
 545   defsubr (&Sforward_line);
 546   defsubr (&Sbeginning_of_line);
 547   defsubr (&Send_of_line);
 548
 549   defsubr (&Sdelete_char);
 550   defsubr (&Sself_insert_command);
 551 }
 552
 553 void
 554 keys_of_cmds (void)
 555 {
 556   int n;
 557
 558   nonundocount = 0;
 559   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 560   for (n = 040; n < 0177; n++)
 561     initial_define_key (global_map, n, "self-insert-command");
 562 #ifdef MSDOS
 563   for (n = 0200; n < 0240; n++)
 564     initial_define_key (global_map, n, "self-insert-command");
 565 #endif
 566   for (n = 0240; n < 0400; n++)
 567     initial_define_key (global_map, n, "self-insert-command");
 568
 569   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 570   initial_define_key (global_map, Ctl ('B'), "backward-char");
 571   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 572   initial_define_key (global_map, Ctl ('F'), "forward-char");
 573 }