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