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 = point + 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 = point;
 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   Fforward_line (make_number (XINT (n) - 1));
 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 (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0)));
 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 (point + XINT (n) < BEGV)
 182             Fsignal (Qbeginning_of_buffer, Qnil);
 183           else
 184             del_range (point + XINT (n), point);
 185         }
 186       else
 187         {
 188           if (point + XINT (n) > ZV)
 189             Fsignal (Qend_of_buffer, Qnil);
 190           else
 191             del_range (point, point + 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 (point - i < BEGV)
 220         break;
 221       if (FETCH_CHAR (point - i) == '\t' || FETCH_CHAR (point - 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       && ! (point == ZV || FETCH_CHAR (point) == '\n'))
 236     {
 237       Finsert_char (make_number (' '), XINT (n));
 238       SET_PT (point - 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       && point < ZV
 306       && (EQ (overwrite, Qoverwrite_mode_binary)
 307           || (c != '\n' && FETCH_CHAR (point) != '\n'))
 308       && (EQ (overwrite, Qoverwrite_mode_binary)
 309           || FETCH_CHAR (point) != '\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 (point, point + 1);
 315       hairy = 2;
 316     }
 317   if (!NILP (current_buffer->abbrev_mode)
 318       && SYNTAX (c) != Sword
 319       && NILP (current_buffer->read_only)
 320       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
 321     {
 322       int modiff = MODIFF;
 323       Fexpand_abbrev ();
 324       /* We can't trust the value of Fexpand_abbrev,
 325          but if Fexpand_abbrev changed the buffer,
 326          assume it expanded something.  */
 327       if (MODIFF != modiff)
 328         hairy = 2;
 329     }
 330   if ((c == ' ' || c == '\n')
 331       && !noautofill
 332       && !NILP (current_buffer->auto_fill_function))
 333     {
 334       Lisp_Object tem;
 335
 336       insert_and_inherit (&c1, 1);
 337       if (c1 == '\n')
 338         /* After inserting a newline, move to previous line and fill */
 339         /* that.  Must have the newline in place already so filling and */
 340         /* justification, if any, know where the end is going to be. */
 341         SET_PT (point - 1);
 342       tem = call0 (current_buffer->auto_fill_function);
 343       if (c1 == '\n')
 344         SET_PT (point + 1);
 345       if (!NILP (tem))
 346         hairy = 2;
 347     }
 348   else
 349     insert_and_inherit (&c1, 1);
 350
 351 #ifdef HAVE_FACES
 352   /* If previous command specified a face to use, use it.  */
 353   if (!NILP (Vself_insert_face)
 354       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 355     {
 356       Lisp_Object before, after;
 357       XSETINT (before, PT - 1);
 358       XSETINT (after, PT);
 359       Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
 360       Vself_insert_face = Qnil;
 361     }
 362 #endif
 363   synt = SYNTAX (c);
 364   if ((synt == Sclose || synt == Smath)
 365       && !NILP (Vblink_paren_function) && INTERACTIVE
 366       && !noautofill)
 367     {
 368       call0 (Vblink_paren_function);
 369       hairy = 2;
 370     }
 371   return hairy;
 372 }
 373 \f
 374 /* module initialization */
 375
 376 syms_of_cmds ()
 377 {
 378   Qkill_backward_chars = intern ("kill-backward-chars");
 379   staticpro (&Qkill_backward_chars);
 380
 381   Qkill_forward_chars = intern ("kill-forward-chars");
 382   staticpro (&Qkill_forward_chars);
 383
 384   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 385   staticpro (&Qoverwrite_mode_binary);
 386
 387   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 388     "If non-nil, set the face of the next self-inserting character to this.\n\
 389 See also `self-insert-face-command'.");
 390   Vself_insert_face = Qnil;
 391
 392   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 393     "This is the command that set up `self-insert-face'.\n\
 394 If `last-command' does not equal this value, we ignore `self-insert-face'.");
 395   Vself_insert_face_command = Qnil;
 396
 397   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 398     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
 399 More precisely, a char with closeparen syntax is self-inserted.");
 400   Vblink_paren_function = Qnil;
 401
 402   defsubr (&Sforward_char);
 403   defsubr (&Sbackward_char);
 404   defsubr (&Sforward_line);
 405   defsubr (&Sbeginning_of_line);
 406   defsubr (&Send_of_line);
 407
 408   defsubr (&Sdelete_char);
 409   defsubr (&Sdelete_backward_char);
 410
 411   defsubr (&Sself_insert_command);
 412 }
 413
 414 keys_of_cmds ()
 415 {
 416   int n;
 417
 418   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 419   for (n = 040; n < 0177; n++)
 420     initial_define_key (global_map, n, "self-insert-command");
 421 #ifdef MSDOS
 422   for (n = 0200; n < 0240; n++)
 423     initial_define_key (global_map, n, "self-insert-command");
 424 #endif
 425   for (n = 0240; n < 0400; n++)
 426     initial_define_key (global_map, n, "self-insert-command");
 427
 428   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 429   initial_define_key (global_map, Ctl ('B'), "backward-char");
 430   initial_define_key (global_map, Ctl ('D'), "delete-char");
 431   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 432   initial_define_key (global_map, Ctl ('F'), "forward-char");
 433   initial_define_key (global_map, 0177, "delete-backward-char");
 434 }