src/cmds.c

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