src/cmds.c

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