src/cmds.c

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