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