src/cmds.c

   1 /* Simple built-in editing commands.
   2
   3 Copyright (C) 1985, 1993-1998, 2001-2012  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 #include <setjmp.h>
  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 zero.  N defaults to 1.
  51    Validate the new location.  Return nil.  */
  52 static Lisp_Object
  53 move_point (Lisp_Object n, int 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
  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 \\[right-char], which see.  */)
  92   (Lisp_Object n)
  93 {
  94   return move_point (n, 1);
  95 }
  96
  97 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
  98        doc: /* Move point N characters backward (forward if N is negative).
  99 On attempt to pass beginning or end of buffer, stop and signal error.
 100
 101 Depending on the bidirectional context, the movement may be to the
 102 right or to the left on the screen.  This is in contrast with
 103 \\[left-char], which see.  */)
 104   (Lisp_Object n)
 105 {
 106   return move_point (n, 0);
 107 }
 108
 109 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
 110        doc: /* Move N lines forward (backward if N is negative).
 111 Precisely, if point is on line I, move to the start of line I + N
 112 \("start of line" in the logical order).
 113 If there isn't room, go as far as possible (no error).
 114 Returns the count of lines left to move.  If moving forward,
 115 that is N - number of lines moved; if backward, N + number moved.
 116 With positive N, a non-empty line at the end counts as one line
 117 successfully moved (for the return value).  */)
 118   (Lisp_Object n)
 119 {
 120   ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
 121   ptrdiff_t pos, pos_byte;
 122   EMACS_INT count, shortage;
 123
 124   if (NILP (n))
 125     count = 1;
 126   else
 127     {
 128       CHECK_NUMBER (n);
 129       count = XINT (n);
 130     }
 131
 132   if (count <= 0)
 133     shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
 134   else
 135     shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1);
 136
 137   /* Since scan_newline does TEMP_SET_PT_BOTH,
 138      and we want to set PT "for real",
 139      go back to the old point and then come back here.  */
 140   pos = PT;
 141   pos_byte = PT_BYTE;
 142   TEMP_SET_PT_BOTH (opoint, opoint_byte);
 143   SET_PT_BOTH (pos, pos_byte);
 144
 145   if (shortage > 0
 146       && (count <= 0
 147           || (ZV > BEGV
 148               && PT != opoint
 149               && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
 150     shortage--;
 151
 152   return make_number (count <= 0 ? - shortage : shortage);
 153 }
 154
 155 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
 156        doc: /* Move point to beginning of current line (in the logical order).
 157 With argument N not nil or 1, move forward N - 1 lines first.
 158 If point reaches the beginning or end of buffer, it stops there.
 159
 160 This function constrains point to the current field unless this moves
 161 point to a different line than the original, unconstrained result.
 162 If N is nil or 1, and a front-sticky field starts at point, the point
 163 does not move.  To ignore field boundaries bind
 164 `inhibit-field-text-motion' to t, or use the `forward-line' function
 165 instead.  For instance, `(forward-line 0)' does the same thing as
 166 `(beginning-of-line)', except that it ignores field boundaries.  */)
 167   (Lisp_Object n)
 168 {
 169   if (NILP (n))
 170     XSETFASTINT (n, 1);
 171   else
 172     CHECK_NUMBER (n);
 173
 174   SET_PT (XINT (Fline_beginning_position (n)));
 175
 176   return Qnil;
 177 }
 178
 179 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
 180        doc: /* Move point to end of current line (in the logical order).
 181 With argument N not nil or 1, move forward N - 1 lines first.
 182 If point reaches the beginning or end of buffer, it stops there.
 183 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
 184
 185 This function constrains point to the current field unless this moves
 186 point to a different line than the original, unconstrained result.  If
 187 N is nil or 1, and a rear-sticky field ends at point, the point does
 188 not move.  To ignore field boundaries bind `inhibit-field-text-motion'
 189 to t.  */)
 190   (Lisp_Object n)
 191 {
 192   ptrdiff_t newpos;
 193
 194   if (NILP (n))
 195     XSETFASTINT (n, 1);
 196   else
 197     CHECK_NUMBER (n);
 198
 199   while (1)
 200     {
 201       newpos = XINT (Fline_end_position (n));
 202       SET_PT (newpos);
 203
 204       if (PT > newpos
 205           && FETCH_CHAR (PT - 1) == '\n')
 206         {
 207           /* If we skipped over a newline that follows
 208              an invisible intangible run,
 209              move back to the last tangible position
 210              within the line.  */
 211
 212           SET_PT (PT - 1);
 213           break;
 214         }
 215       else if (PT > newpos && PT < ZV
 216                && FETCH_CHAR (PT) != '\n')
 217         /* If we skipped something intangible
 218            and now we're not really at eol,
 219            keep going.  */
 220         n = make_number (1);
 221       else
 222         break;
 223     }
 224
 225   return Qnil;
 226 }
 227
 228 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 229        doc: /* Delete the following N characters (previous if N is negative).
 230 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 231 Interactively, N is the prefix arg, and KILLFLAG is set if
 232 N was explicitly specified.
 233
 234 The command `delete-forward-char' is preferable for interactive use.  */)
 235   (Lisp_Object n, Lisp_Object killflag)
 236 {
 237   EMACS_INT pos;
 238
 239   CHECK_NUMBER (n);
 240
 241   pos = PT + XINT (n);
 242   if (NILP (killflag))
 243     {
 244       if (XINT (n) < 0)
 245         {
 246           if (pos < BEGV)
 247             xsignal0 (Qbeginning_of_buffer);
 248           else
 249             del_range (pos, PT);
 250         }
 251       else
 252         {
 253           if (pos > ZV)
 254             xsignal0 (Qend_of_buffer);
 255           else
 256             del_range (PT, pos);
 257         }
 258     }
 259   else
 260     {
 261       call1 (Qkill_forward_chars, n);
 262     }
 263   return Qnil;
 264 }
 265
 266 static int nonundocount;
 267
 268 /* Note that there's code in command_loop_1 which typically avoids
 269    calling this.  */
 270 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 271        doc: /* Insert the character you type.
 272 Whichever character you type to run this command is inserted.
 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   int remove_boundary = 1;
 281   CHECK_NATNUM (n);
 282
 283   if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
 284     nonundocount = 0;
 285
 286   if (NILP (Vexecuting_kbd_macro)
 287       && !EQ (minibuf_window, selected_window))
 288     {
 289       if (nonundocount <= 0 || nonundocount >= 20)
 290         {
 291           remove_boundary = 0;
 292           nonundocount = 0;
 293         }
 294       nonundocount++;
 295     }
 296
 297   if (remove_boundary
 298       && CONSP (BVAR (current_buffer, undo_list))
 299       && NILP (XCAR (BVAR (current_buffer, undo_list)))
 300       /* Only remove auto-added boundaries, not boundaries
 301          added be explicit calls to undo-boundary.  */
 302       && EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
 303     /* Remove the undo_boundary that was just pushed.  */
 304     BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list));
 305
 306   /* Barf if the key that invoked this was not a character.  */
 307   if (!CHARACTERP (last_command_event))
 308     bitch_at_user ();
 309   {
 310     int character = translate_char (Vtranslation_table_for_input,
 311                                     XINT (last_command_event));
 312     int val = internal_self_insert (character, XFASTINT (n));
 313     if (val == 2)
 314       nonundocount = 0;
 315     frame_make_pointer_invisible ();
 316   }
 317
 318   return Qnil;
 319 }
 320
 321 /* Insert N times character C
 322
 323    If this insertion is suitable for direct output (completely simple),
 324    return 0.  A value of 1 indicates this *might* not have been simple.
 325    A value of 2 means this did things that call for an undo boundary.  */
 326
 327 static Lisp_Object Qexpand_abbrev;
 328 static Lisp_Object Qpost_self_insert_hook;
 329
 330 static int
 331 internal_self_insert (int c, EMACS_INT n)
 332 {
 333   int hairy = 0;
 334   Lisp_Object tem;
 335   register enum syntaxcode synt;
 336   Lisp_Object overwrite;
 337   /* Length of multi-byte form of C.  */
 338   int len;
 339   /* Working buffer and pointer for multi-byte form of C.  */
 340   unsigned char str[MAX_MULTIBYTE_LENGTH];
 341   ptrdiff_t chars_to_delete = 0;
 342   ptrdiff_t spaces_to_insert = 0;
 343
 344   overwrite = BVAR (current_buffer, overwrite_mode);
 345   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 346     hairy = 1;
 347
 348   /* At first, get multi-byte form of C in STR.  */
 349   if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
 350     {
 351       len = CHAR_STRING (c, str);
 352       if (len == 1)
 353         /* If C has modifier bits, this makes C an appropriate
 354            one-byte char.  */
 355         c = *str;
 356     }
 357   else
 358     {
 359       str[0] = (SINGLE_BYTE_CHAR_P (c)
 360                 ? c
 361                 : multibyte_char_to_unibyte (c));
 362       len = 1;
 363     }
 364   if (!NILP (overwrite)
 365       && PT < ZV)
 366     {
 367       /* In overwrite-mode, we substitute a character at point (C2,
 368          hereafter) by C.  For that, we delete C2 in advance.  But,
 369          just substituting C2 by C may move a remaining text in the
 370          line to the right or to the left, which is not preferable.
 371          So we insert more spaces or delete more characters in the
 372          following cases: if C is narrower than C2, after deleting C2,
 373          we fill columns with spaces, if C is wider than C2, we delete
 374          C2 and several characters following C2.  */
 375
 376       /* This is the character after point.  */
 377       int c2 = FETCH_CHAR (PT_BYTE);
 378
 379       int cwidth;
 380
 381       /* Overwriting in binary-mode always replaces C2 by C.
 382          Overwriting in textual-mode doesn't always do that.
 383          It inserts newlines in the usual way,
 384          and inserts any character at end of line
 385          or before a tab if it doesn't use the whole width of the tab.  */
 386       if (EQ (overwrite, Qoverwrite_mode_binary))
 387         chars_to_delete = min (n, PTRDIFF_MAX);
 388       else if (c != '\n' && c2 != '\n'
 389                && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
 390         {
 391           ptrdiff_t pos = PT;
 392           ptrdiff_t pos_byte = PT_BYTE;
 393           ptrdiff_t curcol = current_column ();
 394
 395           if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
 396             {
 397               /* Column the cursor should be placed at after this insertion.
 398                  The value should be calculated only when necessary.  */
 399               ptrdiff_t target_clm = curcol + n * cwidth;
 400
 401               /* The actual cursor position after the trial of moving
 402                  to column TARGET_CLM.  It is greater than TARGET_CLM
 403                  if the TARGET_CLM is middle of multi-column
 404                  character.  In that case, the new point is set after
 405                  that character.  */
 406               ptrdiff_t actual_clm
 407                 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
 408
 409               chars_to_delete = PT - pos;
 410
 411               if (actual_clm > target_clm)
 412                 {
 413                   /* We will delete too many columns.  Let's fill columns
 414                      by spaces so that the remaining text won't move.  */
 415                   ptrdiff_t actual = PT_BYTE;
 416                   DEC_POS (actual);
 417                   if (FETCH_CHAR (actual) == '\t')
 418                     /* Rather than add spaces, let's just keep the tab. */
 419                     chars_to_delete--;
 420                   else
 421                     spaces_to_insert = actual_clm - target_clm;
 422                 }
 423
 424               SET_PT_BOTH (pos, pos_byte);
 425             }
 426         }
 427       hairy = 2;
 428     }
 429
 430   synt = SYNTAX (c);
 431
 432   if (!NILP (BVAR (current_buffer, abbrev_mode))
 433       && synt != Sword
 434       && NILP (BVAR (current_buffer, read_only))
 435       && PT > BEGV
 436       && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
 437                   ? XFASTINT (Fprevious_char ())
 438                   : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
 439           == Sword))
 440     {
 441       int modiff = MODIFF;
 442       Lisp_Object sym;
 443
 444       sym = call0 (Qexpand_abbrev);
 445
 446       /* If we expanded an abbrev which has a hook,
 447          and the hook has a non-nil `no-self-insert' property,
 448          return right away--don't really self-insert.  */
 449       if (SYMBOLP (sym) && ! NILP (sym)
 450           && ! NILP (SVAR (XSYMBOL (sym), function))
 451           && SYMBOLP (SVAR (XSYMBOL (sym), function)))
 452         {
 453           Lisp_Object prop;
 454           prop = Fget (SVAR (XSYMBOL (sym), function),
 455                        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   DEFSYM (Qkill_backward_chars, "kill-backward-chars");
 526   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
 527   DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
 528   DEFSYM (Qexpand_abbrev, "expand-abbrev");
 529   DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
 530
 531   DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
 532                doc: /* Hook run at the end of `self-insert-command'.
 533 This is run after inserting the character.  */);
 534   Vpost_self_insert_hook = Qnil;
 535
 536   defsubr (&Sforward_point);
 537   defsubr (&Sforward_char);
 538   defsubr (&Sbackward_char);
 539   defsubr (&Sforward_line);
 540   defsubr (&Sbeginning_of_line);
 541   defsubr (&Send_of_line);
 542
 543   defsubr (&Sdelete_char);
 544   defsubr (&Sself_insert_command);
 545 }
 546
 547 void
 548 keys_of_cmds (void)
 549 {
 550   int n;
 551
 552   nonundocount = 0;
 553   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 554   for (n = 040; n < 0177; n++)
 555     initial_define_key (global_map, n, "self-insert-command");
 556 #ifdef MSDOS
 557   for (n = 0200; n < 0240; n++)
 558     initial_define_key (global_map, n, "self-insert-command");
 559 #endif
 560   for (n = 0240; n < 0400; n++)
 561     initial_define_key (global_map, n, "self-insert-command");
 562
 563   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 564   initial_define_key (global_map, Ctl ('B'), "backward-char");
 565   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 566   initial_define_key (global_map, Ctl ('F'), "forward-char");
 567 }