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 "syntax.h"
  27 #include "window.h"
  28 #include "keyboard.h"
  29
  30 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  31
  32 /* A possible value for a buffer's overwrite-mode variable.  */
  33 Lisp_Object Qoverwrite_mode_binary;
  34
  35 /* Non-nil means put this face on the next self-inserting character.  */
  36 Lisp_Object Vself_insert_face;
  37
  38 /* This is the command that set up Vself_insert_face.  */
  39 Lisp_Object Vself_insert_face_command;
  40
  41 extern Lisp_Object Qface;
  42 \f
  43 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  44   "Move point right N characters (left if N is negative).\n\
  45 On reaching end of buffer, stop and signal error.")
  46   (n)
  47      Lisp_Object n;
  48 {
  49   if (NILP (n))
  50     XSETFASTINT (n, 1);
  51   else
  52     CHECK_NUMBER (n, 0);
  53
  54   /* This used to just set point to point + XINT (n), and then check
  55      to see if it was within boundaries.  But now that SET_PT can
  56      potentially do a lot of stuff (calling entering and exiting
  57      hooks, etcetera), that's not a good approach.  So we validate the
  58      proposed position, then set point.  */
  59   {
  60     int new_point = PT + XINT (n);
  61
  62     if (new_point < BEGV)
  63       {
  64         SET_PT (BEGV);
  65         Fsignal (Qbeginning_of_buffer, Qnil);
  66       }
  67     if (new_point > ZV)
  68       {
  69         SET_PT (ZV);
  70         Fsignal (Qend_of_buffer, Qnil);
  71       }
  72
  73     SET_PT (new_point);
  74   }
  75
  76   return Qnil;
  77 }
  78
  79 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  80   "Move point left N characters (right if N is negative).\n\
  81 On attempt to pass beginning or end of buffer, stop and signal error.")
  82   (n)
  83      Lisp_Object n;
  84 {
  85   if (NILP (n))
  86     XSETFASTINT (n, 1);
  87   else
  88     CHECK_NUMBER (n, 0);
  89
  90   XSETINT (n, - XINT (n));
  91   return Fforward_char (n);
  92 }
  93
  94 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  95   "Move N lines forward (backward if N is negative).\n\
  96 Precisely, if point is on line I, move to the start of line I + N.\n\
  97 If there isn't room, go as far as possible (no error).\n\
  98 Returns the count of lines left to move.  If moving forward,\n\
  99 that is N - number of lines moved; if backward, N + number moved.\n\
 100 With positive N, a non-empty line at the end counts as one line\n\
 101   successfully moved (for the return value).")
 102   (n)
 103      Lisp_Object n;
 104 {
 105   int pos2 = PT;
 106   int pos;
 107   int count, shortage, negp;
 108
 109   if (NILP (n))
 110     count = 1;
 111   else
 112     {
 113       CHECK_NUMBER (n, 0);
 114       count = XINT (n);
 115     }
 116
 117   negp = count <= 0;
 118   pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1);
 119   if (shortage > 0
 120       && (negp
 121           || (ZV > BEGV
 122               && pos != pos2
 123               && FETCH_CHAR (pos - 1) != '\n')))
 124     shortage--;
 125   SET_PT (pos);
 126   return make_number (negp ? - shortage : shortage);
 127 }
 128
 129 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
 130   0, 1, "p",
 131   "Move point to beginning of current line.\n\
 132 With argument N not nil or 1, move forward N - 1 lines first.\n\
 133 If scan reaches end of buffer, stop there without error.")
 134   (n)
 135      Lisp_Object n;
 136 {
 137   if (NILP (n))
 138     XSETFASTINT (n, 1);
 139   else
 140     CHECK_NUMBER (n, 0);
 141
 142   SET_PT (XINT (Fline_beginning_position (n)));
 143   return Qnil;
 144 }
 145
 146 DEFUN ("end-of-line", Fend_of_line, Send_of_line,
 147   0, 1, "p",
 148   "Move point to end of current line.\n\
 149 With argument N not nil or 1, move forward N - 1 lines first.\n\
 150 If scan reaches end of buffer, stop there without error.")
 151   (n)
 152      Lisp_Object n;
 153 {
 154   register int pos;
 155   register int stop;
 156
 157   if (NILP (n))
 158     XSETFASTINT (n, 1);
 159   else
 160     CHECK_NUMBER (n, 0);
 161
 162   SET_PT (XINT (Fline_end_position (n)));
 163
 164   return Qnil;
 165 }
 166
 167 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 168   "Delete the following N characters (previous if N is negative).\n\
 169 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 170 Interactively, N is the prefix arg, and KILLFLAG is set if\n\
 171 N was explicitly specified.")
 172   (n, killflag)
 173      Lisp_Object n, killflag;
 174 {
 175   CHECK_NUMBER (n, 0);
 176
 177   if (NILP (killflag))
 178     {
 179       if (XINT (n) < 0)
 180         {
 181           if (PT + XINT (n) < BEGV)
 182             Fsignal (Qbeginning_of_buffer, Qnil);
 183           else
 184             del_range (PT + XINT (n), PT);
 185         }
 186       else
 187         {
 188           if (PT + XINT (n) > ZV)
 189             Fsignal (Qend_of_buffer, Qnil);
 190           else
 191             del_range (PT, PT + XINT (n));
 192         }
 193     }
 194   else
 195     {
 196       call1 (Qkill_forward_chars, n);
 197     }
 198   return Qnil;
 199 }
 200
 201 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
 202   1, 2, "p\nP",
 203   "Delete the previous N characters (following if N is negative).\n\
 204 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 205 Interactively, N is the prefix arg, and KILLFLAG is set if\n\
 206 N was explicitly specified.")
 207   (n, killflag)
 208      Lisp_Object n, killflag;
 209 {
 210   Lisp_Object value;
 211   int deleted_special = 0;
 212   int i;
 213
 214   CHECK_NUMBER (n, 0);
 215
 216   /* See if we are about to delete a tab or newline backwards.  */
 217   for (i = 1; i <= XINT (n); i++)
 218     {
 219       if (PT - i < BEGV)
 220         break;
 221       if (FETCH_CHAR (PT - i) == '\t' || FETCH_CHAR (PT - i) == '\n')
 222         {
 223           deleted_special = 1;
 224           break;
 225         }
 226     }
 227
 228   value = Fdelete_char (make_number (-XINT (n)), killflag);
 229
 230   /* In overwrite mode, back over columns while clearing them out,
 231      unless at end of line.  */
 232   if (XINT (n) > 0
 233       && ! NILP (current_buffer->overwrite_mode)
 234       && ! deleted_special
 235       && ! (PT == ZV || FETCH_CHAR (PT) == '\n'))
 236     {
 237       Finsert_char (make_number (' '), XINT (n));
 238       SET_PT (PT - XINT (n));
 239     }
 240
 241   return value;
 242 }
 243
 244 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 245   "Insert the character you type.\n\
 246 Whichever character you type to run this command is inserted.")
 247   (n)
 248      Lisp_Object n;
 249 {
 250   CHECK_NUMBER (n, 0);
 251
 252   /* Barf if the key that invoked this was not a character.  */
 253   if (!INTEGERP (last_command_char))
 254     bitch_at_user ();
 255   else if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
 256     {
 257       XSETFASTINT (n, XFASTINT (n) - 2);
 258       /* The first one might want to expand an abbrev.  */
 259       internal_self_insert (XINT (last_command_char), 1);
 260       /* The bulk of the copies of this char can be inserted simply.
 261          We don't have to handle a user-specified face specially
 262          because it will get inherited from the first char inserted.  */
 263       Finsert_char (last_command_char, n, Qt);
 264       /* The last one might want to auto-fill.  */
 265       internal_self_insert (XINT (last_command_char), 0);
 266     }
 267   else
 268     while (XINT (n) > 0)
 269       {
 270         /* Ok since old and new vals both nonneg */
 271         XSETFASTINT (n, XFASTINT (n) - 1);
 272         internal_self_insert (XINT (last_command_char), XFASTINT (n) != 0);
 273       }
 274
 275   return Qnil;
 276 }
 277
 278 /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
 279    even if it is enabled.
 280
 281    If this insertion is suitable for direct output (completely simple),
 282    return 0.  A value of 1 indicates this *might* not have been simple.
 283    A value of 2 means this did things that call for an undo boundary.  */
 284
 285 internal_self_insert (c1, noautofill)
 286      /* This has to be unsigned char; when it is char,
 287         some compilers sign-extend it in SYNTAX_ENTRY, despite
 288         the casts to unsigned char there.  */
 289      unsigned char c1;
 290      int noautofill;
 291 {
 292   extern Lisp_Object Fexpand_abbrev ();
 293   int hairy = 0;
 294   Lisp_Object tem;
 295   register enum syntaxcode synt;
 296   register int c = c1;
 297   Lisp_Object overwrite;
 298
 299   overwrite = current_buffer->overwrite_mode;
 300   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
 301       || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 302     hairy = 1;
 303
 304   if (!NILP (overwrite)
 305       && PT < ZV
 306       && (EQ (overwrite, Qoverwrite_mode_binary)
 307           || (c != '\n' && FETCH_CHAR (PT) != '\n'))
 308       && (EQ (overwrite, Qoverwrite_mode_binary)
 309           || FETCH_CHAR (PT) != '\t'
 310           || XINT (current_buffer->tab_width) <= 0
 311           || XFASTINT (current_buffer->tab_width) > 20
 312           || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
 313     {
 314       del_range (PT, PT + 1);
 315       hairy = 2;
 316     }
 317   if (!NILP (current_buffer->abbrev_mode)
 318       && SYNTAX (c) != Sword
 319       && NILP (current_buffer->read_only)
 320       && PT > BEGV && SYNTAX (FETCH_CHAR (PT - 1)) == Sword)
 321     {
 322       int modiff = MODIFF;
 323       Lisp_Object sym;
 324
 325       sym = Fexpand_abbrev ();
 326
 327       /* If we expanded an abbrev which has only a hook,
 328          return right away--don't really self-insert.  */
 329       if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function))
 330         {
 331           Lisp_Object prop;
 332           prop = Fget (sym, intern ("no-self-insert"));
 333           if (! NILP (prop))
 334             return Qnil;
 335         }
 336
 337       if (MODIFF != modiff)
 338         hairy = 2;
 339     }
 340   if ((c == ' ' || c == '\n')
 341       && !noautofill
 342       && !NILP (current_buffer->auto_fill_function))
 343     {
 344       Lisp_Object tem;
 345
 346       insert_and_inherit (&c1, 1);
 347       if (c1 == '\n')
 348         /* After inserting a newline, move to previous line and fill */
 349         /* that.  Must have the newline in place already so filling and */
 350         /* justification, if any, know where the end is going to be. */
 351         SET_PT (PT - 1);
 352       tem = call0 (current_buffer->auto_fill_function);
 353       if (c1 == '\n')
 354         SET_PT (PT + 1);
 355       if (!NILP (tem))
 356         hairy = 2;
 357     }
 358   else
 359     insert_and_inherit (&c1, 1);
 360
 361 #ifdef HAVE_FACES
 362   /* If previous command specified a face to use, use it.  */
 363   if (!NILP (Vself_insert_face)
 364       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 365     {
 366       Lisp_Object before, after;
 367       XSETINT (before, PT - 1);
 368       XSETINT (after, PT);
 369       Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
 370       Vself_insert_face = Qnil;
 371     }
 372 #endif
 373   synt = SYNTAX (c);
 374   if ((synt == Sclose || synt == Smath)
 375       && !NILP (Vblink_paren_function) && INTERACTIVE
 376       && !noautofill)
 377     {
 378       call0 (Vblink_paren_function);
 379       hairy = 2;
 380     }
 381   return hairy;
 382 }
 383 \f
 384 /* module initialization */
 385
 386 syms_of_cmds ()
 387 {
 388   Qkill_backward_chars = intern ("kill-backward-chars");
 389   staticpro (&Qkill_backward_chars);
 390
 391   Qkill_forward_chars = intern ("kill-forward-chars");
 392   staticpro (&Qkill_forward_chars);
 393
 394   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 395   staticpro (&Qoverwrite_mode_binary);
 396
 397   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 398     "If non-nil, set the face of the next self-inserting character to this.\n\
 399 See also `self-insert-face-command'.");
 400   Vself_insert_face = Qnil;
 401
 402   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 403     "This is the command that set up `self-insert-face'.\n\
 404 If `last-command' does not equal this value, we ignore `self-insert-face'.");
 405   Vself_insert_face_command = Qnil;
 406
 407   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 408     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
 409 More precisely, a char with closeparen syntax is self-inserted.");
 410   Vblink_paren_function = Qnil;
 411
 412   defsubr (&Sforward_char);
 413   defsubr (&Sbackward_char);
 414   defsubr (&Sforward_line);
 415   defsubr (&Sbeginning_of_line);
 416   defsubr (&Send_of_line);
 417
 418   defsubr (&Sdelete_char);
 419   defsubr (&Sdelete_backward_char);
 420
 421   defsubr (&Sself_insert_command);
 422 }
 423
 424 keys_of_cmds ()
 425 {
 426   int n;
 427
 428   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 429   for (n = 040; n < 0177; n++)
 430     initial_define_key (global_map, n, "self-insert-command");
 431 #ifdef MSDOS
 432   for (n = 0200; n < 0240; n++)
 433     initial_define_key (global_map, n, "self-insert-command");
 434 #endif
 435   for (n = 0240; n < 0400; n++)
 436     initial_define_key (global_map, n, "self-insert-command");
 437
 438   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 439   initial_define_key (global_map, Ctl ('B'), "backward-char");
 440   initial_define_key (global_map, Ctl ('D'), "delete-char");
 441   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 442   initial_define_key (global_map, Ctl ('F'), "forward-char");
 443   initial_define_key (global_map, 0177, "delete-backward-char");
 444 }