src/cmds.c

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