src/cmds.c

   1 /* Simple built-in editing commands.
   2    Copyright (C) 1985, 93, 94, 95, 96, 97, 1998, 2001, 02 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24 #include "commands.h"
  25 #include "buffer.h"
  26 #include "charset.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         Fsignal (Qbeginning_of_buffer, Qnil);
  80       }
  81     if (new_point > ZV)
  82       {
  83         SET_PT (ZV);
  84         Fsignal (Qend_of_buffer, Qnil);
  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 command does not move point across a field boundary unless doing so
 160 would move beyond there to a different line; If N is nil or 1, and point
 161 starts at a field boundary, point does not move.  To ignore field
 162 boundaries, either bind `inhibit-field-text-motion' to t, or use the
 163 `forward-line' function instead.  For instance, `(forward-line 0)' does
 164 the same thing as `(beginning-of-line)', except that it ignores field
 165 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-text-motion-hooks' to t.
 184
 185 This command does not move point across a field boundary unless doing so
 186 would move beyond there to a different line; if N is nil or 1, and
 187 point starts at a field boundary, point does not move.  To ignore field
 188 boundaries bind `inhibit-field-text-motion' to t.  */)
 189      (n)
 190      Lisp_Object n;
 191 {
 192   int newpos;
 193
 194   if (NILP (n))
 195     XSETFASTINT (n, 1);
 196   else
 197     CHECK_NUMBER (n);
 198
 199   while (1)
 200     {
 201       newpos = XINT (Fline_end_position (n));
 202       SET_PT (newpos);
 203
 204       if (PT > newpos
 205           && FETCH_CHAR (PT - 1) == '\n')
 206         {
 207           /* If we skipped over a newline that follows
 208              an invisible intangible run,
 209              move back to the last tangible position
 210              within the line.  */
 211
 212           SET_PT (PT - 1);
 213           break;
 214         }
 215       else if (PT > newpos && PT < ZV
 216                && FETCH_CHAR (PT) != '\n')
 217         /* If we skipped something intangible
 218            and now we're not really at eol,
 219            keep going.  */
 220         n = make_number (1);
 221       else
 222         break;
 223     }
 224
 225   return Qnil;
 226 }
 227
 228 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 229        doc: /* Delete the following N characters (previous if N is negative).
 230 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 231 Interactively, N is the prefix arg, and KILLFLAG is set if
 232 N was explicitly specified.  */)
 233      (n, killflag)
 234      Lisp_Object n, killflag;
 235 {
 236   int pos;
 237
 238   CHECK_NUMBER (n);
 239
 240   pos = PT + XINT (n);
 241   if (NILP (killflag))
 242     {
 243       if (XINT (n) < 0)
 244         {
 245           if (pos < BEGV)
 246             Fsignal (Qbeginning_of_buffer, Qnil);
 247           else
 248             del_range (pos, PT);
 249         }
 250       else
 251         {
 252           if (pos > ZV)
 253             Fsignal (Qend_of_buffer, Qnil);
 254           else
 255             del_range (PT, pos);
 256         }
 257     }
 258   else
 259     {
 260       call1 (Qkill_forward_chars, n);
 261     }
 262   return Qnil;
 263 }
 264
 265 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
 266        1, 2, "p\nP",
 267        doc: /* Delete the previous N characters (following if N is negative).
 268 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
 269 Interactively, N is the prefix arg, and KILLFLAG is set if
 270 N was explicitly specified.  */)
 271      (n, killflag)
 272      Lisp_Object n, killflag;
 273 {
 274   Lisp_Object value;
 275   int deleted_special = 0;
 276   int pos, pos_byte, i;
 277
 278   CHECK_NUMBER (n);
 279
 280   /* See if we are about to delete a tab or newline backwards.  */
 281   pos = PT;
 282   pos_byte = PT_BYTE;
 283   for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
 284     {
 285       int c;
 286
 287       DEC_BOTH (pos, pos_byte);
 288       c = FETCH_BYTE (pos_byte);
 289       if (c == '\t' || c == '\n')
 290         {
 291           deleted_special = 1;
 292           break;
 293         }
 294     }
 295
 296   /* In overwrite mode, back over columns while clearing them out,
 297      unless at end of line.  */
 298   if (XINT (n) > 0
 299       && ! NILP (current_buffer->overwrite_mode)
 300       && ! deleted_special
 301       && ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
 302     {
 303       int column = (int) current_column (); /* iftc */
 304
 305       value = Fdelete_char (make_number (-XINT (n)), killflag);
 306       i = column - (int) current_column (); /* iftc */
 307       Finsert_char (make_number (' '), make_number (i), Qnil);
 308       /* Whitespace chars are ASCII chars, so we can simply subtract.  */
 309       SET_PT_BOTH (PT - i, PT_BYTE - i);
 310     }
 311   else
 312     value = Fdelete_char (make_number (-XINT (n)), killflag);
 313
 314   return value;
 315 }
 316
 317 /* Note that there's code in command_loop_1 which typically avoids
 318    calling this.  */
 319 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 320        doc: /* Insert the character you type.
 321 Whichever character you type to run this command is inserted.  */)
 322      (n)
 323      Lisp_Object n;
 324 {
 325   CHECK_NUMBER (n);
 326
 327   /* Barf if the key that invoked this was not a character.  */
 328   if (!INTEGERP (last_command_char))
 329     bitch_at_user ();
 330   {
 331     int character = translate_char (Vtranslation_table_for_input,
 332                                     XINT (last_command_char), 0, 0, 0);
 333     if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
 334       {
 335         int modified_char = character;
 336         /* Add the offset to the character, for Finsert_char.
 337            We pass internal_self_insert the unmodified character
 338            because it itself does this offsetting.  */
 339         if (! NILP (current_buffer->enable_multibyte_characters))
 340           modified_char = unibyte_char_to_multibyte (modified_char);
 341
 342         XSETFASTINT (n, XFASTINT (n) - 2);
 343         /* The first one might want to expand an abbrev.  */
 344         internal_self_insert (character, 1);
 345         /* The bulk of the copies of this char can be inserted simply.
 346            We don't have to handle a user-specified face specially
 347            because it will get inherited from the first char inserted.  */
 348         Finsert_char (make_number (modified_char), n, Qt);
 349         /* The last one might want to auto-fill.  */
 350         internal_self_insert (character, 0);
 351       }
 352     else
 353       while (XINT (n) > 0)
 354         {
 355           /* Ok since old and new vals both nonneg */
 356           XSETFASTINT (n, XFASTINT (n) - 1);
 357           internal_self_insert (character, XFASTINT (n) != 0);
 358         }
 359   }
 360
 361   return Qnil;
 362 }
 363
 364 /* Insert character C.  If NOAUTOFILL is nonzero, don't do autofill
 365    even if it is enabled.
 366
 367    If this insertion is suitable for direct output (completely simple),
 368    return 0.  A value of 1 indicates this *might* not have been simple.
 369    A value of 2 means this did things that call for an undo boundary.  */
 370
 371 int
 372 internal_self_insert (c, noautofill)
 373      int c;
 374      int noautofill;
 375 {
 376   extern Lisp_Object Fexpand_abbrev ();
 377   int hairy = 0;
 378   Lisp_Object tem;
 379   register enum syntaxcode synt;
 380   Lisp_Object overwrite, string;
 381   /* Length of multi-byte form of C.  */
 382   int len;
 383   /* Working buffer and pointer for multi-byte form of C.  */
 384   unsigned char str[MAX_MULTIBYTE_LENGTH];
 385   int chars_to_delete = 0;
 386   int spaces_to_insert = 0;
 387
 388   overwrite = current_buffer->overwrite_mode;
 389   if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 390     hairy = 1;
 391
 392   /* At first, get multi-byte form of C in STR.  */
 393   if (!NILP (current_buffer->enable_multibyte_characters))
 394     {
 395       c = unibyte_char_to_multibyte (c);
 396       len = CHAR_STRING (c, str);
 397       if (len == 1)
 398         /* If C has modifier bits, this makes C an appropriate
 399            one-byte char.  */
 400         c = *str;
 401     }
 402   else
 403     {
 404       str[0] = (SINGLE_BYTE_CHAR_P (c)
 405                 ? c
 406                 : multibyte_char_to_unibyte (c, Qnil));
 407       len = 1;
 408     }
 409   if (!NILP (overwrite)
 410       && PT < ZV)
 411     {
 412       /* In overwrite-mode, we substitute a character at point (C2,
 413          hereafter) by C.  For that, we delete C2 in advance.  But,
 414          just substituting C2 by C may move a remaining text in the
 415          line to the right or to the left, which is not preferable.
 416          So we insert more spaces or delete more characters in the
 417          following cases: if C is narrower than C2, after deleting C2,
 418          we fill columns with spaces, if C is wider than C2, we delete
 419          C2 and several characters following C2.  */
 420
 421       /* This is the character after point.  */
 422       int c2 = FETCH_CHAR (PT_BYTE);
 423
 424       /* Column the cursor should be placed at after this insertion.
 425          The correct value should be calculated only when necessary.  */
 426       int target_clm = 0;
 427
 428       /* Overwriting in binary-mode always replaces C2 by C.
 429          Overwriting in textual-mode doesn't always do that.
 430          It inserts newlines in the usual way,
 431          and inserts any character at end of line
 432          or before a tab if it doesn't use the whole width of the tab.  */
 433       if (EQ (overwrite, Qoverwrite_mode_binary)
 434           || (c != '\n'
 435               && c2 != '\n'
 436               && ! (c2 == '\t'
 437                     && XINT (current_buffer->tab_width) > 0
 438                     && XFASTINT (current_buffer->tab_width) < 20
 439                     && (target_clm = ((int) current_column () /* iftc */
 440                                       + XINT (Fchar_width (make_number (c)))),
 441                         target_clm % XFASTINT (current_buffer->tab_width)))))
 442         {
 443           int pos = PT;
 444           int pos_byte = PT_BYTE;
 445
 446           if (target_clm == 0)
 447             chars_to_delete = 1;
 448           else
 449             {
 450               /* The actual cursor position after the trial of moving
 451                  to column TARGET_CLM.  It is greater than TARGET_CLM
 452                  if the TARGET_CLM is middle of multi-column
 453                  character.  In that case, the new point is set after
 454                  that character.  */
 455               int actual_clm
 456                 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
 457
 458               chars_to_delete = PT - pos;
 459
 460               if (actual_clm > target_clm)
 461                 {
 462                   /* We will delete too many columns.  Let's fill columns
 463                      by spaces so that the remaining text won't move.  */
 464                   spaces_to_insert = actual_clm - target_clm;
 465                 }
 466             }
 467           SET_PT_BOTH (pos, pos_byte);
 468           hairy = 2;
 469         }
 470       hairy = 2;
 471     }
 472   if (!NILP (current_buffer->abbrev_mode)
 473       && SYNTAX (c) != Sword
 474       && NILP (current_buffer->read_only)
 475       && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
 476     {
 477       int modiff = MODIFF;
 478       Lisp_Object sym;
 479
 480       sym = Fexpand_abbrev ();
 481
 482       /* If we expanded an abbrev which has a hook,
 483          and the hook has a non-nil `no-self-insert' property,
 484          return right away--don't really self-insert.  */
 485       if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
 486           && SYMBOLP (XSYMBOL (sym)->function))
 487         {
 488           Lisp_Object prop;
 489           prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
 490           if (! NILP (prop))
 491             return 1;
 492         }
 493
 494       if (MODIFF != modiff)
 495         hairy = 2;
 496     }
 497
 498   if (chars_to_delete)
 499     {
 500       string = make_string_from_bytes (str, 1, len);
 501       if (spaces_to_insert)
 502         {
 503           tem = Fmake_string (make_number (spaces_to_insert),
 504                               make_number (' '));
 505           string = concat2 (tem, string);
 506         }
 507
 508       replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
 509       Fforward_char (make_number (1 + spaces_to_insert));
 510     }
 511   else
 512     insert_and_inherit (str, len);
 513
 514   if ((CHAR_TABLE_P (Vauto_fill_chars)
 515        ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
 516        : (c == ' ' || c == '\n'))
 517       && !noautofill
 518       && !NILP (current_buffer->auto_fill_function))
 519     {
 520       Lisp_Object tem;
 521
 522       if (c == '\n')
 523         /* After inserting a newline, move to previous line and fill
 524            that.  Must have the newline in place already so filling and
 525            justification, if any, know where the end is going to be.  */
 526         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
 527       tem = call0 (current_buffer->auto_fill_function);
 528       if (c == '\n')
 529         SET_PT_BOTH (PT + 1, PT_BYTE + 1);
 530       if (!NILP (tem))
 531         hairy = 2;
 532     }
 533
 534   /* If previous command specified a face to use, use it.  */
 535   if (!NILP (Vself_insert_face)
 536       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 537     {
 538       Fput_text_property (make_number (PT - 1), make_number (PT),
 539                           Qface, Vself_insert_face, Qnil);
 540       Vself_insert_face = Qnil;
 541     }
 542
 543   synt = SYNTAX (c);
 544   if ((synt == Sclose || synt == Smath)
 545       && !NILP (Vblink_paren_function) && INTERACTIVE
 546       && !noautofill)
 547     {
 548       call0 (Vblink_paren_function);
 549       hairy = 2;
 550     }
 551   return hairy;
 552 }
 553 \f
 554 /* module initialization */
 555
 556 void
 557 syms_of_cmds ()
 558 {
 559   Qkill_backward_chars = intern ("kill-backward-chars");
 560   staticpro (&Qkill_backward_chars);
 561
 562   Qkill_forward_chars = intern ("kill-forward-chars");
 563   staticpro (&Qkill_forward_chars);
 564
 565   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 566   staticpro (&Qoverwrite_mode_binary);
 567
 568   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 569                doc: /* If non-nil, set the face of the next self-inserting character to this.
 570 See also `self-insert-face-command'.  */);
 571   Vself_insert_face = Qnil;
 572
 573   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 574                doc: /* This is the command that set up `self-insert-face'.
 575 If `last-command' does not equal this value, we ignore `self-insert-face'.  */);
 576   Vself_insert_face_command = Qnil;
 577
 578   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 579                doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
 580 More precisely, a char with closeparen syntax is self-inserted.  */);
 581   Vblink_paren_function = Qnil;
 582
 583   defsubr (&Sforward_point);
 584   defsubr (&Sforward_char);
 585   defsubr (&Sbackward_char);
 586   defsubr (&Sforward_line);
 587   defsubr (&Sbeginning_of_line);
 588   defsubr (&Send_of_line);
 589
 590   defsubr (&Sdelete_char);
 591   defsubr (&Sdelete_backward_char);
 592
 593   defsubr (&Sself_insert_command);
 594 }
 595
 596 void
 597 keys_of_cmds ()
 598 {
 599   int n;
 600
 601   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 602   for (n = 040; n < 0177; n++)
 603     initial_define_key (global_map, n, "self-insert-command");
 604 #ifdef MSDOS
 605   for (n = 0200; n < 0240; n++)
 606     initial_define_key (global_map, n, "self-insert-command");
 607 #endif
 608   for (n = 0240; n < 0400; n++)
 609     initial_define_key (global_map, n, "self-insert-command");
 610
 611   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 612   initial_define_key (global_map, Ctl ('B'), "backward-char");
 613   initial_define_key (global_map, Ctl ('D'), "delete-char");
 614   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 615   initial_define_key (global_map, Ctl ('F'), "forward-char");
 616   initial_define_key (global_map, 0177, "delete-backward-char");
 617 }