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