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 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         Fsignal (Qbeginning_of_buffer, Qnil);
  81       }
  82     if (new_point > ZV)
  83       {
  84         SET_PT (ZV);
  85         Fsignal (Qend_of_buffer, Qnil);
  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 command does not move point across a field boundary unless doing so
 161 would move beyond there to a different line; If N is nil or 1, and point
 162 starts at a field boundary, point does not move.  To ignore field
 163 boundaries, either bind `inhibit-field-text-motion' to t, or use the
 164 `forward-line' function instead.  For instance, `(forward-line 0)' does
 165 the same thing as `(beginning-of-line)', except that it ignores field
 166 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 command does not move point across a field boundary unless doing so
 187 would move beyond there to a different line; if N is nil or 1, and
 188 point starts at a field boundary, point does not move.  To ignore field
 189 boundaries bind `inhibit-field-text-motion' 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             Fsignal (Qbeginning_of_buffer, Qnil);
 248           else
 249             del_range (pos, PT);
 250         }
 251       else
 252         {
 253           if (pos > ZV)
 254             Fsignal (Qend_of_buffer, Qnil);
 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 (!INTEGERP (last_command_char))
 330     bitch_at_user ();
 331   {
 332     int character = translate_char (Vtranslation_table_for_input,
 333                                     XINT (last_command_char), 0, 0, 0);
 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       c = unibyte_char_to_multibyte (c);
 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   if (!NILP (current_buffer->abbrev_mode)
 475       && SYNTAX (c) != Sword
 476       && NILP (current_buffer->read_only)
 477       && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
 478     {
 479       int modiff = MODIFF;
 480       Lisp_Object sym;
 481
 482       sym = call0 (Qexpand_abbrev);
 483
 484       /* If we expanded an abbrev which has a hook,
 485          and the hook has a non-nil `no-self-insert' property,
 486          return right away--don't really self-insert.  */
 487       if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
 488           && SYMBOLP (XSYMBOL (sym)->function))
 489         {
 490           Lisp_Object prop;
 491           prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
 492           if (! NILP (prop))
 493             return 1;
 494         }
 495
 496       if (MODIFF != modiff)
 497         hairy = 2;
 498     }
 499
 500   if (chars_to_delete)
 501     {
 502       string = make_string_from_bytes (str, 1, len);
 503       if (spaces_to_insert)
 504         {
 505           tem = Fmake_string (make_number (spaces_to_insert),
 506                               make_number (' '));
 507           string = concat2 (tem, string);
 508         }
 509
 510       replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
 511       Fforward_char (make_number (1 + spaces_to_insert));
 512     }
 513   else
 514     insert_and_inherit (str, len);
 515
 516   if ((CHAR_TABLE_P (Vauto_fill_chars)
 517        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
 518        : (c == ' ' || c == '\n'))
 519       && !noautofill
 520       && !NILP (current_buffer->auto_fill_function))
 521     {
 522       Lisp_Object tem;
 523
 524       if (c == '\n')
 525         /* After inserting a newline, move to previous line and fill
 526            that.  Must have the newline in place already so filling and
 527            justification, if any, know where the end is going to be.  */
 528         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
 529       tem = call0 (current_buffer->auto_fill_function);
 530       if (c == '\n')
 531         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
 532       if (!NILP (tem))
 533         hairy = 2;
 534     }
 535
 536   /* If previous command specified a face to use, use it.  */
 537   if (!NILP (Vself_insert_face)
 538       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 539     {
 540       Fput_text_property (make_number (PT - 1), make_number (PT),
 541                           Qface, Vself_insert_face, Qnil);
 542       Vself_insert_face = Qnil;
 543     }
 544
 545   synt = SYNTAX (c);
 546   if ((synt == Sclose || synt == Smath)
 547       && !NILP (Vblink_paren_function) && INTERACTIVE
 548       && !noautofill)
 549     {
 550       call0 (Vblink_paren_function);
 551       hairy = 2;
 552     }
 553   return hairy;
 554 }
 555 \f
 556 /* module initialization */
 557
 558 void
 559 syms_of_cmds ()
 560 {
 561   Qkill_backward_chars = intern ("kill-backward-chars");
 562   staticpro (&Qkill_backward_chars);
 563
 564   Qkill_forward_chars = intern ("kill-forward-chars");
 565   staticpro (&Qkill_forward_chars);
 566
 567   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 568   staticpro (&Qoverwrite_mode_binary);
 569
 570   Qexpand_abbrev = intern ("expand-abbrev");
 571   staticpro (&Qexpand_abbrev);
 572
 573   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 574                doc: /* If non-nil, set the face of the next self-inserting character to this.
 575 See also `self-insert-face-command'.  */);
 576   Vself_insert_face = Qnil;
 577
 578   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 579                doc: /* This is the command that set up `self-insert-face'.
 580 If `last-command' does not equal this value, we ignore `self-insert-face'.  */);
 581   Vself_insert_face_command = Qnil;
 582
 583   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 584                doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
 585 More precisely, a char with closeparen syntax is self-inserted.  */);
 586   Vblink_paren_function = Qnil;
 587
 588   defsubr (&Sforward_point);
 589   defsubr (&Sforward_char);
 590   defsubr (&Sbackward_char);
 591   defsubr (&Sforward_line);
 592   defsubr (&Sbeginning_of_line);
 593   defsubr (&Send_of_line);
 594
 595   defsubr (&Sdelete_char);
 596   defsubr (&Sdelete_backward_char);
 597
 598   defsubr (&Sself_insert_command);
 599 }
 600
 601 void
 602 keys_of_cmds ()
 603 {
 604   int n;
 605
 606   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 607   for (n = 040; n < 0177; n++)
 608     initial_define_key (global_map, n, "self-insert-command");
 609 #ifdef MSDOS
 610   for (n = 0200; n < 0240; n++)
 611     initial_define_key (global_map, n, "self-insert-command");
 612 #endif
 613   for (n = 0240; n < 0400; n++)
 614     initial_define_key (global_map, n, "self-insert-command");
 615
 616   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 617   initial_define_key (global_map, Ctl ('B'), "backward-char");
 618   initial_define_key (global_map, Ctl ('D'), "delete-char");
 619   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 620   initial_define_key (global_map, Ctl ('F'), "forward-char");
 621   initial_define_key (global_map, 0177, "delete-backward-char");
 622 }
 623
 624 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
 625    (do not change this comment) */