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