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