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