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 2, 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 "charset.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 (!INTEGERP (last_command_char))
 331     bitch_at_user ();
 332   {
 333     int character = translate_char (Vtranslation_table_for_input,
 334                                     XINT (last_command_char), 0, 0, 0);
 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       c = unibyte_char_to_multibyte (c);
 399       len = CHAR_STRING (c, str);
 400       if (len == 1)
 401         /* If C has modifier bits, this makes C an appropriate
 402            one-byte char.  */
 403         c = *str;
 404     }
 405   else
 406     {
 407       str[0] = (SINGLE_BYTE_CHAR_P (c)
 408                 ? c
 409                 : multibyte_char_to_unibyte (c, Qnil));
 410       len = 1;
 411     }
 412   if (!NILP (overwrite)
 413       && PT < ZV)
 414     {
 415       /* In overwrite-mode, we substitute a character at point (C2,
 416          hereafter) by C.  For that, we delete C2 in advance.  But,
 417          just substituting C2 by C may move a remaining text in the
 418          line to the right or to the left, which is not preferable.
 419          So we insert more spaces or delete more characters in the
 420          following cases: if C is narrower than C2, after deleting C2,
 421          we fill columns with spaces, if C is wider than C2, we delete
 422          C2 and several characters following C2.  */
 423
 424       /* This is the character after point.  */
 425       int c2 = FETCH_CHAR (PT_BYTE);
 426
 427       /* Column the cursor should be placed at after this insertion.
 428          The correct value should be calculated only when necessary.  */
 429       int target_clm = 0;
 430
 431       /* Overwriting in binary-mode always replaces C2 by C.
 432          Overwriting in textual-mode doesn't always do that.
 433          It inserts newlines in the usual way,
 434          and inserts any character at end of line
 435          or before a tab if it doesn't use the whole width of the tab.  */
 436       if (EQ (overwrite, Qoverwrite_mode_binary)
 437           || (c != '\n'
 438               && c2 != '\n'
 439               && ! (c2 == '\t'
 440                     && XINT (current_buffer->tab_width) > 0
 441                     && XFASTINT (current_buffer->tab_width) < 20
 442                     && (target_clm = ((int) current_column () /* iftc */
 443                                       + XINT (Fchar_width (make_number (c)))),
 444                         target_clm % XFASTINT (current_buffer->tab_width)))))
 445         {
 446           int pos = PT;
 447           int pos_byte = PT_BYTE;
 448
 449           if (target_clm == 0)
 450             chars_to_delete = 1;
 451           else
 452             {
 453               /* The actual cursor position after the trial of moving
 454                  to column TARGET_CLM.  It is greater than TARGET_CLM
 455                  if the TARGET_CLM is middle of multi-column
 456                  character.  In that case, the new point is set after
 457                  that character.  */
 458               int actual_clm
 459                 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
 460
 461               chars_to_delete = PT - pos;
 462
 463               if (actual_clm > target_clm)
 464                 {
 465                   /* We will delete too many columns.  Let's fill columns
 466                      by spaces so that the remaining text won't move.  */
 467                   spaces_to_insert = actual_clm - target_clm;
 468                 }
 469             }
 470           SET_PT_BOTH (pos, pos_byte);
 471           hairy = 2;
 472         }
 473       hairy = 2;
 474     }
 475   if (!NILP (current_buffer->abbrev_mode)
 476       && SYNTAX (c) != Sword
 477       && NILP (current_buffer->read_only)
 478       && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
 479     {
 480       int modiff = MODIFF;
 481       Lisp_Object sym;
 482
 483       sym = call0 (Qexpand_abbrev);
 484
 485       /* If we expanded an abbrev which has a hook,
 486          and the hook has a non-nil `no-self-insert' property,
 487          return right away--don't really self-insert.  */
 488       if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
 489           && SYMBOLP (XSYMBOL (sym)->function))
 490         {
 491           Lisp_Object prop;
 492           prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
 493           if (! NILP (prop))
 494             return 1;
 495         }
 496
 497       if (MODIFF != modiff)
 498         hairy = 2;
 499     }
 500
 501   if (chars_to_delete)
 502     {
 503       string = make_string_from_bytes (str, 1, len);
 504       if (spaces_to_insert)
 505         {
 506           tem = Fmake_string (make_number (spaces_to_insert),
 507                               make_number (' '));
 508           string = concat2 (tem, string);
 509         }
 510
 511       replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
 512       Fforward_char (make_number (1 + spaces_to_insert));
 513     }
 514   else
 515     insert_and_inherit (str, len);
 516
 517   if ((CHAR_TABLE_P (Vauto_fill_chars)
 518        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
 519        : (c == ' ' || c == '\n'))
 520       && !noautofill
 521       && !NILP (current_buffer->auto_fill_function))
 522     {
 523       Lisp_Object tem;
 524
 525       if (c == '\n')
 526         /* After inserting a newline, move to previous line and fill
 527            that.  Must have the newline in place already so filling and
 528            justification, if any, know where the end is going to be.  */
 529         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
 530       tem = call0 (current_buffer->auto_fill_function);
 531       /* Test PT < ZV in case the auto-fill-function is strange.  */
 532       if (c == '\n' && PT < ZV)
 533         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
 534       if (!NILP (tem))
 535         hairy = 2;
 536     }
 537
 538   /* If previous command specified a face to use, use it.  */
 539   if (!NILP (Vself_insert_face)
 540       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 541     {
 542       Fput_text_property (make_number (PT - 1), make_number (PT),
 543                           Qface, Vself_insert_face, Qnil);
 544       Vself_insert_face = Qnil;
 545     }
 546
 547   synt = SYNTAX (c);
 548   if ((synt == Sclose || synt == Smath)
 549       && !NILP (Vblink_paren_function) && INTERACTIVE
 550       && !noautofill)
 551     {
 552       call0 (Vblink_paren_function);
 553       hairy = 2;
 554     }
 555   return hairy;
 556 }
 557 \f
 558 /* module initialization */
 559
 560 void
 561 syms_of_cmds ()
 562 {
 563   Qkill_backward_chars = intern ("kill-backward-chars");
 564   staticpro (&Qkill_backward_chars);
 565
 566   Qkill_forward_chars = intern ("kill-forward-chars");
 567   staticpro (&Qkill_forward_chars);
 568
 569   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 570   staticpro (&Qoverwrite_mode_binary);
 571
 572   Qexpand_abbrev = intern ("expand-abbrev");
 573   staticpro (&Qexpand_abbrev);
 574
 575   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 576                doc: /* If non-nil, set the face of the next self-inserting character to this.
 577 See also `self-insert-face-command'.  */);
 578   Vself_insert_face = Qnil;
 579
 580   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 581                doc: /* This is the command that set up `self-insert-face'.
 582 If `last-command' does not equal this value, we ignore `self-insert-face'.  */);
 583   Vself_insert_face_command = Qnil;
 584
 585   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 586                doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
 587 More precisely, a char with closeparen syntax is self-inserted.  */);
 588   Vblink_paren_function = Qnil;
 589
 590   defsubr (&Sforward_point);
 591   defsubr (&Sforward_char);
 592   defsubr (&Sbackward_char);
 593   defsubr (&Sforward_line);
 594   defsubr (&Sbeginning_of_line);
 595   defsubr (&Send_of_line);
 596
 597   defsubr (&Sdelete_char);
 598   defsubr (&Sdelete_backward_char);
 599
 600   defsubr (&Sself_insert_command);
 601 }
 602
 603 void
 604 keys_of_cmds ()
 605 {
 606   int n;
 607
 608   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 609   for (n = 040; n < 0177; n++)
 610     initial_define_key (global_map, n, "self-insert-command");
 611 #ifdef MSDOS
 612   for (n = 0200; n < 0240; n++)
 613     initial_define_key (global_map, n, "self-insert-command");
 614 #endif
 615   for (n = 0240; n < 0400; n++)
 616     initial_define_key (global_map, n, "self-insert-command");
 617
 618   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 619   initial_define_key (global_map, Ctl ('B'), "backward-char");
 620   initial_define_key (global_map, Ctl ('D'), "delete-char");
 621   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 622   initial_define_key (global_map, Ctl ('F'), "forward-char");
 623   initial_define_key (global_map, 0177, "delete-backward-char");
 624 }
 625
 626 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
 627    (do not change this comment) */