src/cmds.c

   1 /* Simple built-in editing commands.
   2    Copyright (C) 1985, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002,
   3                  2003, 2004, 2005, 2006, 2007 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, or (at your option)
  10 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; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 Boston, MA 02110-1301, USA.  */
  21
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25 #include "commands.h"
  26 #include "buffer.h"
  27 #include "character.h"
  28 #include "syntax.h"
  29 #include "window.h"
  30 #include "keyboard.h"
  31 #include "keymap.h"
  32 #include "dispextern.h"
  33
  34 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  35
  36 /* A possible value for a buffer's overwrite-mode variable.  */
  37 Lisp_Object Qoverwrite_mode_binary;
  38
  39 /* Non-nil means put this face on the next self-inserting character.  */
  40 Lisp_Object Vself_insert_face;
  41
  42 /* This is the command that set up Vself_insert_face.  */
  43 Lisp_Object Vself_insert_face_command;
  44
  45 extern Lisp_Object Qface;
  46 extern Lisp_Object Vtranslation_table_for_input;
  47 \f
  48 DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
  49        doc: /* Return buffer position N characters after (before if N negative) point.  */)
  50      (n)
  51      Lisp_Object n;
  52 {
  53   CHECK_NUMBER (n);
  54
  55   return make_number (PT + XINT (n));
  56 }
  57
  58 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  59        doc: /* Move point right N characters (left if N is negative).
  60 On reaching end of buffer, stop and signal error.  */)
  61      (n)
  62      Lisp_Object n;
  63 {
  64   if (NILP (n))
  65     XSETFASTINT (n, 1);
  66   else
  67     CHECK_NUMBER (n);
  68
  69   /* This used to just set point to point + XINT (n), and then check
  70      to see if it was within boundaries.  But now that SET_PT can
  71      potentially do a lot of stuff (calling entering and exiting
  72      hooks, etcetera), that's not a good approach.  So we validate the
  73      proposed position, then set point.  */
  74   {
  75     int new_point = PT + XINT (n);
  76
  77     if (new_point < BEGV)
  78       {
  79         SET_PT (BEGV);
  80         xsignal0 (Qbeginning_of_buffer);
  81       }
  82     if (new_point > ZV)
  83       {
  84         SET_PT (ZV);
  85         xsignal0 (Qend_of_buffer);
  86       }
  87
  88     SET_PT (new_point);
  89   }
  90
  91   return Qnil;
  92 }
  93
  94 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  95        doc: /* Move point left N characters (right if N is negative).
  96 On attempt to pass beginning or end of buffer, stop and signal error.  */)
  97      (n)
  98      Lisp_Object n;
  99 {
 100   if (NILP (n))
 101     XSETFASTINT (n, 1);
 102   else
 103     CHECK_NUMBER (n);
 104
 105   XSETINT (n, - XINT (n));
 106   return Fforward_char (n);
 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 If there isn't room, go as far as possible (no error).
 113 Returns the count of lines left to move.  If moving forward,
 114 that is N - number of lines moved; if backward, N + number moved.
 115 With positive N, a non-empty line at the end counts as one line
 116   successfully moved (for the return value).  */)
 117      (n)
 118      Lisp_Object n;
 119 {
 120   int opoint = PT, opoint_byte = PT_BYTE;
 121   int pos, pos_byte;
 122   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.
 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.  If
 162 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      (n)
 168      Lisp_Object n;
 169 {
 170   if (NILP (n))
 171     XSETFASTINT (n, 1);
 172   else
 173     CHECK_NUMBER (n);
 174
 175   SET_PT (XINT (Fline_beginning_position (n)));
 176
 177   return Qnil;
 178 }
 179
 180 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "p",
 181        doc: /* Move point to end of current line.
 182 With argument N not nil or 1, move forward N - 1 lines first.
 183 If point reaches the beginning or end of buffer, it stops there.
 184 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
 185
 186 This function constrains point to the current field unless this moves
 187 point to a different line than the original, unconstrained result.  If
 188 N is nil or 1, and a rear-sticky field ends at point, the point does
 189 not move.  To ignore field boundaries bind `inhibit-field-text-motion'
 190 to t.  */)
 191      (n)
 192      Lisp_Object n;
 193 {
 194   int newpos;
 195
 196   if (NILP (n))
 197     XSETFASTINT (n, 1);
 198   else
 199     CHECK_NUMBER (n);
 200
 201   while (1)
 202     {
 203       newpos = XINT (Fline_end_position (n));
 204       SET_PT (newpos);
 205
 206       if (PT > newpos
 207           && FETCH_CHAR (PT - 1) == '\n')
 208         {
 209           /* If we skipped over a newline that follows
 210              an invisible intangible run,
 211              move back to the last tangible position
 212              within the line.  */
 213
 214           SET_PT (PT - 1);
 215           break;
 216         }
 217       else if (PT > newpos && PT < ZV
 218                && FETCH_CHAR (PT) != '\n')
 219         /* If we skipped something intangible
 220            and now we're not really at eol,
 221            keep going.  */
 222         n = make_number (1);
 223       else
 224         break;
 225     }
 226
 227   return Qnil;
 228 }
 229
 230 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 231        doc: /* Delete the following N characters (previous if N is negative).
 232 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 233 Interactively, N is the prefix arg, and KILLFLAG is set if
 234 N was explicitly specified.  */)
 235      (n, killflag)
 236      Lisp_Object n, killflag;
 237 {
 238   int pos;
 239
 240   CHECK_NUMBER (n);
 241
 242   pos = PT + XINT (n);
 243   if (NILP (killflag))
 244     {
 245       if (XINT (n) < 0)
 246         {
 247           if (pos < BEGV)
 248             xsignal0 (Qbeginning_of_buffer);
 249           else
 250             del_range (pos, PT);
 251         }
 252       else
 253         {
 254           if (pos > ZV)
 255             xsignal0 (Qend_of_buffer);
 256           else
 257             del_range (PT, pos);
 258         }
 259     }
 260   else
 261     {
 262       call1 (Qkill_forward_chars, n);
 263     }
 264   return Qnil;
 265 }
 266
 267 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
 268        1, 2, "p\nP",
 269        doc: /* Delete the previous N characters (following if N is negative).
 270 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 271 Interactively, N is the prefix arg, and KILLFLAG is set if
 272 N was explicitly specified.  */)
 273      (n, killflag)
 274      Lisp_Object n, killflag;
 275 {
 276   Lisp_Object value;
 277   int deleted_special = 0;
 278   int pos, pos_byte, i;
 279
 280   CHECK_NUMBER (n);
 281
 282   /* See if we are about to delete a tab or newline backwards.  */
 283   pos = PT;
 284   pos_byte = PT_BYTE;
 285   for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
 286     {
 287       int c;
 288
 289       DEC_BOTH (pos, pos_byte);
 290       c = FETCH_BYTE (pos_byte);
 291       if (c == '\t' || c == '\n')
 292         {
 293           deleted_special = 1;
 294           break;
 295         }
 296     }
 297
 298   /* In overwrite mode, back over columns while clearing them out,
 299      unless at end of line.  */
 300   if (XINT (n) > 0
 301       && ! NILP (current_buffer->overwrite_mode)
 302       && ! deleted_special
 303       && ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
 304     {
 305       int column = (int) current_column (); /* iftc */
 306
 307       value = Fdelete_char (make_number (-XINT (n)), killflag);
 308       i = column - (int) current_column (); /* iftc */
 309       Finsert_char (make_number (' '), make_number (i), Qnil);
 310       /* Whitespace chars are ASCII chars, so we can simply subtract.  */
 311       SET_PT_BOTH (PT - i, PT_BYTE - i);
 312     }
 313   else
 314     value = Fdelete_char (make_number (-XINT (n)), killflag);
 315
 316   return value;
 317 }
 318
 319 /* Note that there's code in command_loop_1 which typically avoids
 320    calling this.  */
 321 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 322        doc: /* Insert the character you type.
 323 Whichever character you type to run this command is inserted.  */)
 324      (n)
 325      Lisp_Object n;
 326 {
 327   CHECK_NUMBER (n);
 328
 329   /* Barf if the key that invoked this was not a character.  */
 330   if (!CHARACTERP (last_command_char))
 331     bitch_at_user ();
 332   {
 333     int character = translate_char (Vtranslation_table_for_input,
 334                                     XINT (last_command_char));
 335     if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
 336       {
 337         int modified_char = character;
 338         /* Add the offset to the character, for Finsert_char.
 339            We pass internal_self_insert the unmodified character
 340            because it itself does this offsetting.  */
 341         if (! NILP (current_buffer->enable_multibyte_characters))
 342           modified_char = unibyte_char_to_multibyte (modified_char);
 343
 344         XSETFASTINT (n, XFASTINT (n) - 2);
 345         /* The first one might want to expand an abbrev.  */
 346         internal_self_insert (character, 1);
 347         /* The bulk of the copies of this char can be inserted simply.
 348            We don't have to handle a user-specified face specially
 349            because it will get inherited from the first char inserted.  */
 350         Finsert_char (make_number (modified_char), n, Qt);
 351         /* The last one might want to auto-fill.  */
 352         internal_self_insert (character, 0);
 353       }
 354     else
 355       while (XINT (n) > 0)
 356         {
 357           /* Ok since old and new vals both nonneg */
 358           XSETFASTINT (n, XFASTINT (n) - 1);
 359           internal_self_insert (character, XFASTINT (n) != 0);
 360         }
 361   }
 362
 363   return Qnil;
 364 }
 365
 366 /* Insert character C.  If NOAUTOFILL is nonzero, don't do autofill
 367    even if it is enabled.
 368
 369    If this insertion is suitable for direct output (completely simple),
 370    return 0.  A value of 1 indicates this *might* not have been simple.
 371    A value of 2 means this did things that call for an undo boundary.  */
 372
 373 static Lisp_Object Qexpand_abbrev;
 374
 375 int
 376 internal_self_insert (c, noautofill)
 377      int c;
 378      int noautofill;
 379 {
 380   int hairy = 0;
 381   Lisp_Object tem;
 382   register enum syntaxcode synt;
 383   Lisp_Object overwrite, string;
 384   /* Length of multi-byte form of C.  */
 385   int len;
 386   /* Working buffer and pointer for multi-byte form of C.  */
 387   unsigned char str[MAX_MULTIBYTE_LENGTH];
 388   int chars_to_delete = 0;
 389   int spaces_to_insert = 0;
 390
 391   overwrite = current_buffer->overwrite_mode;
 392   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 393     hairy = 1;
 394
 395   /* At first, get multi-byte form of C in STR.  */
 396   if (!NILP (current_buffer->enable_multibyte_characters))
 397     {
 398       len = CHAR_STRING (c, str);
 399       if (len == 1)
 400         /* If C has modifier bits, this makes C an appropriate
 401            one-byte char.  */
 402         c = *str;
 403     }
 404   else
 405     {
 406       str[0] = (SINGLE_BYTE_CHAR_P (c)
 407                 ? c
 408                 : multibyte_char_to_unibyte (c, Qnil));
 409       len = 1;
 410     }
 411   if (!NILP (overwrite)
 412       && PT < ZV)
 413     {
 414       /* In overwrite-mode, we substitute a character at point (C2,
 415          hereafter) by C.  For that, we delete C2 in advance.  But,
 416          just substituting C2 by C may move a remaining text in the
 417          line to the right or to the left, which is not preferable.
 418          So we insert more spaces or delete more characters in the
 419          following cases: if C is narrower than C2, after deleting C2,
 420          we fill columns with spaces, if C is wider than C2, we delete
 421          C2 and several characters following C2.  */
 422
 423       /* This is the character after point.  */
 424       int c2 = FETCH_CHAR (PT_BYTE);
 425
 426       /* Column the cursor should be placed at after this insertion.
 427          The correct value should be calculated only when necessary.  */
 428       int target_clm = 0;
 429
 430       /* Overwriting in binary-mode always replaces C2 by C.
 431          Overwriting in textual-mode doesn't always do that.
 432          It inserts newlines in the usual way,
 433          and inserts any character at end of line
 434          or before a tab if it doesn't use the whole width of the tab.  */
 435       if (EQ (overwrite, Qoverwrite_mode_binary)
 436           || (c != '\n'
 437               && c2 != '\n'
 438               && ! (c2 == '\t'
 439                     && XINT (current_buffer->tab_width) > 0
 440                     && XFASTINT (current_buffer->tab_width) < 20
 441                     && (target_clm = ((int) current_column () /* iftc */
 442                                       + XINT (Fchar_width (make_number (c)))),
 443                         target_clm % XFASTINT (current_buffer->tab_width)))))
 444         {
 445           int pos = PT;
 446           int pos_byte = PT_BYTE;
 447
 448           if (target_clm == 0)
 449             chars_to_delete = 1;
 450           else
 451             {
 452               /* The actual cursor position after the trial of moving
 453                  to column TARGET_CLM.  It is greater than TARGET_CLM
 454                  if the TARGET_CLM is middle of multi-column
 455                  character.  In that case, the new point is set after
 456                  that character.  */
 457               int actual_clm
 458                 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
 459
 460               chars_to_delete = PT - pos;
 461
 462               if (actual_clm > target_clm)
 463                 {
 464                   /* We will delete too many columns.  Let's fill columns
 465                      by spaces so that the remaining text won't move.  */
 466                   spaces_to_insert = actual_clm - target_clm;
 467                 }
 468             }
 469           SET_PT_BOTH (pos, pos_byte);
 470           hairy = 2;
 471         }
 472       hairy = 2;
 473     }
 474
 475   if (NILP (current_buffer->enable_multibyte_characters))
 476     MAKE_CHAR_MULTIBYTE (c);
 477   synt = SYNTAX (c);
 478
 479   if (!NILP (current_buffer->abbrev_mode)
 480       && synt != Sword
 481       && NILP (current_buffer->read_only)
 482       && PT > BEGV
 483       && (!NILP (current_buffer->enable_multibyte_characters)
 484           ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
 485           : (SYNTAX (unibyte_char_to_multibyte (XFASTINT (Fprevious_char ())))
 486              == Sword)))
 487     {
 488       int modiff = MODIFF;
 489       Lisp_Object sym;
 490
 491       sym = call0 (Qexpand_abbrev);
 492
 493       /* If we expanded an abbrev which has a hook,
 494          and the hook has a non-nil `no-self-insert' property,
 495          return right away--don't really self-insert.  */
 496       if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
 497           && SYMBOLP (XSYMBOL (sym)->function))
 498         {
 499           Lisp_Object prop;
 500           prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
 501           if (! NILP (prop))
 502             return 1;
 503         }
 504
 505       if (MODIFF != modiff)
 506         hairy = 2;
 507     }
 508
 509   if (chars_to_delete)
 510     {
 511       string = make_string_from_bytes (str, 1, len);
 512       if (spaces_to_insert)
 513         {
 514           tem = Fmake_string (make_number (spaces_to_insert),
 515                               make_number (' '));
 516           string = concat2 (tem, string);
 517         }
 518
 519       replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
 520       Fforward_char (make_number (1 + spaces_to_insert));
 521     }
 522   else
 523     insert_and_inherit (str, len);
 524
 525   if ((CHAR_TABLE_P (Vauto_fill_chars)
 526        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
 527        : (c == ' ' || c == '\n'))
 528       && !noautofill
 529       && !NILP (current_buffer->auto_fill_function))
 530     {
 531       Lisp_Object tem;
 532
 533       if (c == '\n')
 534         /* After inserting a newline, move to previous line and fill
 535            that.  Must have the newline in place already so filling and
 536            justification, if any, know where the end is going to be.  */
 537         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
 538       tem = call0 (current_buffer->auto_fill_function);
 539       /* Test PT < ZV in case the auto-fill-function is strange.  */
 540       if (c == '\n' && PT < ZV)
 541         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
 542       if (!NILP (tem))
 543         hairy = 2;
 544     }
 545
 546   /* If previous command specified a face to use, use it.  */
 547   if (!NILP (Vself_insert_face)
 548       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 549     {
 550       Fput_text_property (make_number (PT - 1), make_number (PT),
 551                           Qface, Vself_insert_face, Qnil);
 552       Vself_insert_face = Qnil;
 553     }
 554
 555   if ((synt == Sclose || synt == Smath)
 556       && !NILP (Vblink_paren_function) && INTERACTIVE
 557       && !noautofill)
 558     {
 559       call0 (Vblink_paren_function);
 560       hairy = 2;
 561     }
 562   return hairy;
 563 }
 564 \f
 565 /* module initialization */
 566
 567 void
 568 syms_of_cmds ()
 569 {
 570   Qkill_backward_chars = intern ("kill-backward-chars");
 571   staticpro (&Qkill_backward_chars);
 572
 573   Qkill_forward_chars = intern ("kill-forward-chars");
 574   staticpro (&Qkill_forward_chars);
 575
 576   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 577   staticpro (&Qoverwrite_mode_binary);
 578
 579   Qexpand_abbrev = intern ("expand-abbrev");
 580   staticpro (&Qexpand_abbrev);
 581
 582   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 583                doc: /* If non-nil, set the face of the next self-inserting character to this.
 584 See also `self-insert-face-command'.  */);
 585   Vself_insert_face = Qnil;
 586
 587   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 588                doc: /* This is the command that set up `self-insert-face'.
 589 If `last-command' does not equal this value, we ignore `self-insert-face'.  */);
 590   Vself_insert_face_command = Qnil;
 591
 592   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 593                doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
 594 More precisely, a char with closeparen syntax is self-inserted.  */);
 595   Vblink_paren_function = Qnil;
 596
 597   defsubr (&Sforward_point);
 598   defsubr (&Sforward_char);
 599   defsubr (&Sbackward_char);
 600   defsubr (&Sforward_line);
 601   defsubr (&Sbeginning_of_line);
 602   defsubr (&Send_of_line);
 603
 604   defsubr (&Sdelete_char);
 605   defsubr (&Sdelete_backward_char);
 606
 607   defsubr (&Sself_insert_command);
 608 }
 609
 610 void
 611 keys_of_cmds ()
 612 {
 613   int n;
 614
 615   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 616   for (n = 040; n < 0177; n++)
 617     initial_define_key (global_map, n, "self-insert-command");
 618 #ifdef MSDOS
 619   for (n = 0200; n < 0240; n++)
 620     initial_define_key (global_map, n, "self-insert-command");
 621 #endif
 622   for (n = 0240; n < 0400; n++)
 623     initial_define_key (global_map, n, "self-insert-command");
 624
 625   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 626   initial_define_key (global_map, Ctl ('B'), "backward-char");
 627   initial_define_key (global_map, Ctl ('D'), "delete-char");
 628   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 629   initial_define_key (global_map, Ctl ('F'), "forward-char");
 630   initial_define_key (global_map, 0177, "delete-backward-char");
 631 }
 632
 633 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
 634    (do not change this comment) */