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