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