src/cmds.c

   1 /* Simple built-in editing commands.
   2    Copyright (C) 1985, 1993, 1994, 1995 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   CHECK_NUMBER (n, 0);
 211   return Fdelete_char (make_number (-XINT (n)), killflag);
 212 }
 213
 214 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 215   "Insert the character you type.\n\
 216 Whichever character you type to run this command is inserted.")
 217   (n)
 218      Lisp_Object n;
 219 {
 220   CHECK_NUMBER (n, 0);
 221
 222   /* Barf if the key that invoked this was not a character.  */
 223   if (!INTEGERP (last_command_char))
 224     bitch_at_user ();
 225   else if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
 226     {
 227       XSETFASTINT (n, XFASTINT (n) - 2);
 228       /* The first one might want to expand an abbrev.  */
 229       internal_self_insert (XINT (last_command_char), 1);
 230       /* The bulk of the copies of this char can be inserted simply.
 231          We don't have to handle a user-specified face specially
 232          because it will get inherited from the first char inserted.  */
 233       Finsert_char (last_command_char, n, Qt);
 234       /* The last one might want to auto-fill.  */
 235       internal_self_insert (XINT (last_command_char), 0);
 236     }
 237   else
 238     while (XINT (n) > 0)
 239       {
 240         /* Ok since old and new vals both nonneg */
 241         XSETFASTINT (n, XFASTINT (n) - 1);
 242         internal_self_insert (XINT (last_command_char), XFASTINT (n) != 0);
 243       }
 244
 245   return Qnil;
 246 }
 247
 248 /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
 249    even if it is enabled.
 250
 251    If this insertion is suitable for direct output (completely simple),
 252    return 0.  A value of 1 indicates this *might* not have been simple.
 253    A value of 2 means this did things that call for an undo boundary.  */
 254
 255 internal_self_insert (c1, noautofill)
 256      /* This has to be unsigned char; when it is char,
 257         some compilers sign-extend it in SYNTAX_ENTRY, despite
 258         the casts to unsigned char there.  */
 259      unsigned char c1;
 260      int noautofill;
 261 {
 262   extern Lisp_Object Fexpand_abbrev ();
 263   int hairy = 0;
 264   Lisp_Object tem;
 265   register enum syntaxcode synt;
 266   register int c = c1;
 267   Lisp_Object overwrite;
 268
 269   overwrite = current_buffer->overwrite_mode;
 270   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
 271       || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 272     hairy = 1;
 273
 274   if (!NILP (overwrite)
 275       && point < ZV
 276       && (EQ (overwrite, Qoverwrite_mode_binary)
 277           || (c != '\n' && FETCH_CHAR (point) != '\n'))
 278       && (EQ (overwrite, Qoverwrite_mode_binary)
 279           || FETCH_CHAR (point) != '\t'
 280           || XINT (current_buffer->tab_width) <= 0
 281           || XFASTINT (current_buffer->tab_width) > 20
 282           || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
 283     {
 284       del_range (point, point + 1);
 285       hairy = 2;
 286     }
 287   if (!NILP (current_buffer->abbrev_mode)
 288       && SYNTAX (c) != Sword
 289       && NILP (current_buffer->read_only)
 290       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
 291     {
 292       int modiff = MODIFF;
 293       Fexpand_abbrev ();
 294       /* We can't trust the value of Fexpand_abbrev,
 295          but if Fexpand_abbrev changed the buffer,
 296          assume it expanded something.  */
 297       if (MODIFF != modiff)
 298         hairy = 2;
 299     }
 300   if ((c == ' ' || c == '\n')
 301       && !noautofill
 302       && !NILP (current_buffer->auto_fill_function))
 303     {
 304       insert_and_inherit (&c1, 1);
 305       if (c1 == '\n')
 306         /* After inserting a newline, move to previous line and fill */
 307         /* that.  Must have the newline in place already so filling and */
 308         /* justification, if any, know where the end is going to be. */
 309         SET_PT (point - 1);
 310       call0 (current_buffer->auto_fill_function);
 311       if (c1 == '\n')
 312         SET_PT (point + 1);
 313       hairy = 2;
 314     }
 315   else
 316     insert_and_inherit (&c1, 1);
 317
 318 #ifdef HAVE_FACES
 319   /* If previous command specified a face to use, use it.  */
 320   if (!NILP (Vself_insert_face)
 321       && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
 322     {
 323       Lisp_Object before, after;
 324       XSETINT (before, PT - 1);
 325       XSETINT (after, PT);
 326       Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
 327       Vself_insert_face = Qnil;
 328     }
 329 #endif
 330   synt = SYNTAX (c);
 331   if ((synt == Sclose || synt == Smath)
 332       && !NILP (Vblink_paren_function) && INTERACTIVE
 333       && !noautofill)
 334     {
 335       call0 (Vblink_paren_function);
 336       hairy = 2;
 337     }
 338   return hairy;
 339 }
 340 \f
 341 /* module initialization */
 342
 343 syms_of_cmds ()
 344 {
 345   Qkill_backward_chars = intern ("kill-backward-chars");
 346   staticpro (&Qkill_backward_chars);
 347
 348   Qkill_forward_chars = intern ("kill-forward-chars");
 349   staticpro (&Qkill_forward_chars);
 350
 351   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 352   staticpro (&Qoverwrite_mode_binary);
 353
 354   DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
 355     "If non-nil, set the face of the next self-inserting character to this.\n\
 356 See also `self-insert-face-command'.");
 357   Vself_insert_face = Qnil;
 358
 359   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
 360     "This is the command that set up `self-insert-face'.\n\
 361 If `last-command' does not equal this value, we ignore `self-insert-face'.");
 362   Vself_insert_face_command = Qnil;
 363
 364   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 365     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
 366 More precisely, a char with closeparen syntax is self-inserted.");
 367   Vblink_paren_function = Qnil;
 368
 369   defsubr (&Sforward_char);
 370   defsubr (&Sbackward_char);
 371   defsubr (&Sforward_line);
 372   defsubr (&Sbeginning_of_line);
 373   defsubr (&Send_of_line);
 374
 375   defsubr (&Sdelete_char);
 376   defsubr (&Sdelete_backward_char);
 377
 378   defsubr (&Sself_insert_command);
 379 }
 380
 381 keys_of_cmds ()
 382 {
 383   int n;
 384
 385   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 386   for (n = 040; n < 0177; n++)
 387     initial_define_key (global_map, n, "self-insert-command");
 388 #ifdef MSDOS
 389   for (n = 0200; n < 0240; n++)
 390     initial_define_key (global_map, n, "self-insert-command");
 391 #endif
 392   for (n = 0240; n < 0400; n++)
 393     initial_define_key (global_map, n, "self-insert-command");
 394
 395   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 396   initial_define_key (global_map, Ctl ('B'), "backward-char");
 397   initial_define_key (global_map, Ctl ('D'), "delete-char");
 398   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 399   initial_define_key (global_map, Ctl ('F'), "forward-char");
 400   initial_define_key (global_map, 0177, "delete-backward-char");
 401 }