cmds.c 11.6 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Simple built-in editing commands.
Karl Heuer's avatar
Karl Heuer committed
2
   Copyright (C) 1985, 1993, 1994, 1995 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Jim Blandy's avatar
Jim Blandy committed
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23 24 25 26
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "syntax.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
27
#include "window.h"
28
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
29 30 31

Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;

32 33 34
/* A possible value for a buffer's overwrite-mode variable.  */
Lisp_Object Qoverwrite_mode_binary;

35 36 37 38 39 40 41
/* Non-nil means put this face on the next self-inserting character.  */
Lisp_Object Vself_insert_face;

/* This is the command that set up Vself_insert_face.  */
Lisp_Object Vself_insert_face_command;

extern Lisp_Object Qface;
Jim Blandy's avatar
Jim Blandy committed
42 43

DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
44
  "Move point right N characters (left if N is negative).\n\
Jim Blandy's avatar
Jim Blandy committed
45
On reaching end of buffer, stop and signal error.")
46 47
  (n)
     Lisp_Object n;
Jim Blandy's avatar
Jim Blandy committed
48
{
49 50
  if (NILP (n))
    XSETFASTINT (n, 1);
Jim Blandy's avatar
Jim Blandy committed
51
  else
52
    CHECK_NUMBER (n, 0);
Jim Blandy's avatar
Jim Blandy committed
53

54
  /* This used to just set point to point + XINT (n), and then check
55 56 57 58 59
     to see if it was within boundaries.  But now that SET_PT can
     potentially do a lot of stuff (calling entering and exiting
     hooks, etcetera), that's not a good approach.  So we validate the
     proposed position, then set point.  */
  {
60
    int new_point = point + XINT (n);
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

    if (new_point < BEGV)
      {
	SET_PT (BEGV);
	Fsignal (Qbeginning_of_buffer, Qnil);
      }
    if (new_point > ZV)
      {
	SET_PT (ZV);
	Fsignal (Qend_of_buffer, Qnil);
      }

    SET_PT (new_point);
  }

Jim Blandy's avatar
Jim Blandy committed
76 77 78 79
  return Qnil;
}

DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
80
  "Move point left N characters (right if N is negative).\n\
Jim Blandy's avatar
Jim Blandy committed
81
On attempt to pass beginning or end of buffer, stop and signal error.")
82 83
  (n)
     Lisp_Object n;
Jim Blandy's avatar
Jim Blandy committed
84
{
85 86
  if (NILP (n))
    XSETFASTINT (n, 1);
Jim Blandy's avatar
Jim Blandy committed
87
  else
88
    CHECK_NUMBER (n, 0);
Jim Blandy's avatar
Jim Blandy committed
89

90 91
  XSETINT (n, - XINT (n));
  return Fforward_char (n);
Jim Blandy's avatar
Jim Blandy committed
92 93 94
}

DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
95 96
  "Move N lines forward (backward if N is negative).\n\
Precisely, if point is on line I, move to the start of line I + N.\n\
Jim Blandy's avatar
Jim Blandy committed
97 98
If there isn't room, go as far as possible (no error).\n\
Returns the count of lines left to move.  If moving forward,\n\
99 100
that is N - number of lines moved; if backward, N + number moved.\n\
With positive N, a non-empty line at the end counts as one line\n\
Jim Blandy's avatar
Jim Blandy committed
101 102 103 104 105 106 107 108
  successfully moved (for the return value).")
  (n)
     Lisp_Object n;
{
  int pos2 = point;
  int pos;
  int count, shortage, negp;

Jim Blandy's avatar
Jim Blandy committed
109
  if (NILP (n))
Jim Blandy's avatar
Jim Blandy committed
110 111 112 113 114 115 116 117
    count = 1;
  else
    {
      CHECK_NUMBER (n, 0);
      count = XINT (n);
    }

  negp = count <= 0;
118
  pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1);
Jim Blandy's avatar
Jim Blandy committed
119 120
  if (shortage > 0
      && (negp
Jim Blandy's avatar
Jim Blandy committed
121 122
	  || (ZV > BEGV
	      && pos != pos2
Jim Blandy's avatar
Jim Blandy committed
123 124 125 126 127 128 129 130 131
	      && FETCH_CHAR (pos - 1) != '\n')))
    shortage--;
  SET_PT (pos);
  return make_number (negp ? - shortage : shortage);
}

DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  0, 1, "p",
  "Move point to beginning of current line.\n\
132
With argument N not nil or 1, move forward N - 1 lines first.\n\
Jim Blandy's avatar
Jim Blandy committed
133 134 135 136
If scan reaches end of buffer, stop there without error.")
  (n)
     Lisp_Object n;
{
Jim Blandy's avatar
Jim Blandy committed
137
  if (NILP (n))
138
    XSETFASTINT (n, 1);
Jim Blandy's avatar
Jim Blandy committed
139 140 141 142 143 144 145 146 147 148
  else
    CHECK_NUMBER (n, 0);

  Fforward_line (make_number (XINT (n) - 1));
  return Qnil;
}

DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  0, 1, "p",
  "Move point to end of current line.\n\
149
With argument N not nil or 1, move forward N - 1 lines first.\n\
Jim Blandy's avatar
Jim Blandy committed
150 151 152 153 154 155 156
If scan reaches end of buffer, stop there without error.")
  (n)
     Lisp_Object n;
{
  register int pos;
  register int stop;

Jim Blandy's avatar
Jim Blandy committed
157
  if (NILP (n))
158
    XSETFASTINT (n, 1);
Jim Blandy's avatar
Jim Blandy committed
159 160 161
  else
    CHECK_NUMBER (n, 0);

162
  SET_PT (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0)));
Jim Blandy's avatar
Jim Blandy committed
163 164 165 166 167

  return Qnil;
}

DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
168
  "Delete the following N characters (previous if N is negative).\n\
Jim Blandy's avatar
Jim Blandy committed
169
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
170 171
Interactively, N is the prefix arg, and KILLFLAG is set if\n\
N was explicitly specified.")
Jim Blandy's avatar
Jim Blandy committed
172 173 174 175 176
  (n, killflag)
     Lisp_Object n, killflag;
{
  CHECK_NUMBER (n, 0);

Jim Blandy's avatar
Jim Blandy committed
177
  if (NILP (killflag))
Jim Blandy's avatar
Jim Blandy committed
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
    {
      if (XINT (n) < 0)
	{
	  if (point + XINT (n) < BEGV)
	    Fsignal (Qbeginning_of_buffer, Qnil);
	  else
	    del_range (point + XINT (n), point);
	}
      else
	{
	  if (point + XINT (n) > ZV)
	    Fsignal (Qend_of_buffer, Qnil);
	  else
	    del_range (point, point + XINT (n));
	}
    }
  else
    {
      call1 (Qkill_forward_chars, n);
    }
  return Qnil;
}

DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  1, 2, "p\nP",
203
  "Delete the previous N characters (following if N is negative).\n\
Jim Blandy's avatar
Jim Blandy committed
204
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
205 206
Interactively, N is the prefix arg, and KILLFLAG is set if\n\
N was explicitly specified.")
Jim Blandy's avatar
Jim Blandy committed
207 208 209 210 211 212 213 214 215 216
  (n, killflag)
     Lisp_Object n, killflag;
{
  CHECK_NUMBER (n, 0);
  return Fdelete_char (make_number (-XINT (n)), killflag);
}

DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  "Insert the character you type.\n\
Whichever character you type to run this command is inserted.")
217 218
  (n)
     Lisp_Object n;
Jim Blandy's avatar
Jim Blandy committed
219
{
220
  CHECK_NUMBER (n, 0);
Jim Blandy's avatar
Jim Blandy committed
221 222

  /* Barf if the key that invoked this was not a character.  */
223
  if (!INTEGERP (last_command_char))
Jim Blandy's avatar
Jim Blandy committed
224
    bitch_at_user ();
225
  else if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
226
    {
227
      XSETFASTINT (n, XFASTINT (n) - 2);
228 229 230 231 232
      /* The first one might want to expand an abbrev.  */
      internal_self_insert (XINT (last_command_char), 1);
      /* The bulk of the copies of this char can be inserted simply.
	 We don't have to handle a user-specified face specially
	 because it will get inherited from the first char inserted.  */
233
      Finsert_char (last_command_char, n, Qt);
234 235 236
      /* The last one might want to auto-fill.  */
      internal_self_insert (XINT (last_command_char), 0);
    }
Jim Blandy's avatar
Jim Blandy committed
237
  else
238
    while (XINT (n) > 0)
Jim Blandy's avatar
Jim Blandy committed
239
      {
240
	/* Ok since old and new vals both nonneg */
241 242
	XSETFASTINT (n, XFASTINT (n) - 1);
	internal_self_insert (XINT (last_command_char), XFASTINT (n) != 0);
Jim Blandy's avatar
Jim Blandy committed
243 244 245 246 247
      }

  return Qnil;
}

248 249 250 251
/* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
   even if it is enabled.

   If this insertion is suitable for direct output (completely simple),
252 253
   return 0.  A value of 1 indicates this *might* not have been simple.
   A value of 2 means this did things that call for an undo boundary.  */
254

Jim Blandy's avatar
Jim Blandy committed
255
internal_self_insert (c1, noautofill)
256 257 258 259
     /* This has to be unsigned char; when it is char,
	some compilers sign-extend it in SYNTAX_ENTRY, despite
	the casts to unsigned char there.  */
     unsigned char c1;
Jim Blandy's avatar
Jim Blandy committed
260 261 262 263 264 265 266
     int noautofill;
{
  extern Lisp_Object Fexpand_abbrev ();
  int hairy = 0;
  Lisp_Object tem;
  register enum syntaxcode synt;
  register int c = c1;
267
  Lisp_Object overwrite;
Jim Blandy's avatar
Jim Blandy committed
268

269
  overwrite = current_buffer->overwrite_mode;
270 271
  if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
      || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
Jim Blandy's avatar
Jim Blandy committed
272 273
    hairy = 1;

274
  if (!NILP (overwrite)
Jim Blandy's avatar
Jim Blandy committed
275
      && point < ZV
276 277 278
      && (EQ (overwrite, Qoverwrite_mode_binary)
	  || (c != '\n' && FETCH_CHAR (point) != '\n'))
      && (EQ (overwrite, Qoverwrite_mode_binary)
279
	  || FETCH_CHAR (point) != '\t'
Jim Blandy's avatar
Jim Blandy committed
280
	  || XINT (current_buffer->tab_width) <= 0
281
	  || XFASTINT (current_buffer->tab_width) > 20
Jim Blandy's avatar
Jim Blandy committed
282 283 284
	  || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
    {
      del_range (point, point + 1);
285
      hairy = 2;
Jim Blandy's avatar
Jim Blandy committed
286
    }
Jim Blandy's avatar
Jim Blandy committed
287
  if (!NILP (current_buffer->abbrev_mode)
Jim Blandy's avatar
Jim Blandy committed
288
      && SYNTAX (c) != Sword
Jim Blandy's avatar
Jim Blandy committed
289
      && NILP (current_buffer->read_only)
Jim Blandy's avatar
Jim Blandy committed
290 291
      && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
    {
292
      int modiff = MODIFF;
293 294
      Fexpand_abbrev ();
      /* We can't trust the value of Fexpand_abbrev,
295 296 297
	 but if Fexpand_abbrev changed the buffer,
	 assume it expanded something.  */
      if (MODIFF != modiff)
298
	hairy = 2;
Jim Blandy's avatar
Jim Blandy committed
299 300 301
    }
  if ((c == ' ' || c == '\n')
      && !noautofill
302
      && !NILP (current_buffer->auto_fill_function))
Jim Blandy's avatar
Jim Blandy committed
303
    {
304 305 306 307 308 309
      insert_and_inherit (&c1, 1);
      if (c1 == '\n')
	/* After inserting a newline, move to previous line and fill */
	/* that.  Must have the newline in place already so filling and */
	/* justification, if any, know where the end is going to be. */
	SET_PT (point - 1);
Jim Blandy's avatar
Jim Blandy committed
310 311
      call0 (current_buffer->auto_fill_function);
      if (c1 == '\n')
312
	SET_PT (point + 1);
313
      hairy = 2;
Jim Blandy's avatar
Jim Blandy committed
314 315
    }
  else
316
    insert_and_inherit (&c1, 1);
317

318
#ifdef HAVE_FACES
319 320
  /* If previous command specified a face to use, use it.  */
  if (!NILP (Vself_insert_face)
321
      && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
322 323 324 325 326 327 328
    {
      Lisp_Object before, after;
      XSETINT (before, PT - 1);
      XSETINT (after, PT);
      Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
      Vself_insert_face = Qnil;
    }
329
#endif
Jim Blandy's avatar
Jim Blandy committed
330 331
  synt = SYNTAX (c);
  if ((synt == Sclose || synt == Smath)
332 333
      && !NILP (Vblink_paren_function) && INTERACTIVE
      && !noautofill)
Jim Blandy's avatar
Jim Blandy committed
334 335
    {
      call0 (Vblink_paren_function);
336
      hairy = 2;
Jim Blandy's avatar
Jim Blandy committed
337 338 339 340 341 342 343 344 345 346 347 348 349 350
    }
  return hairy;
}

/* module initialization */

syms_of_cmds ()
{
  Qkill_backward_chars = intern ("kill-backward-chars");
  staticpro (&Qkill_backward_chars);

  Qkill_forward_chars = intern ("kill-forward-chars");
  staticpro (&Qkill_forward_chars);

351 352
  Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
  staticpro (&Qoverwrite_mode_binary);
353

354 355 356 357 358 359 360 361 362 363
  DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
    "If non-nil, set the face of the next self-inserting character to this.\n\
See also `self-insert-face-command'.");
  Vself_insert_face = Qnil;

  DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
    "This is the command that set up `self-insert-face'.\n\
If `last-command' does not equal this value, we ignore `self-insert-face'.");
  Vself_insert_face_command = Qnil;

Jim Blandy's avatar
Jim Blandy committed
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384
  DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
    "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
More precisely, a char with closeparen syntax is self-inserted.");
  Vblink_paren_function = Qnil;

  defsubr (&Sforward_char);
  defsubr (&Sbackward_char);
  defsubr (&Sforward_line);
  defsubr (&Sbeginning_of_line);
  defsubr (&Send_of_line);

  defsubr (&Sdelete_char);
  defsubr (&Sdelete_backward_char);

  defsubr (&Sself_insert_command);
}

keys_of_cmds ()
{
  int n;

385
  initial_define_key (global_map, Ctl ('I'), "self-insert-command");
Jim Blandy's avatar
Jim Blandy committed
386 387
  for (n = 040; n < 0177; n++)
    initial_define_key (global_map, n, "self-insert-command");
388 389 390 391
#ifdef MSDOS
  for (n = 0200; n < 0240; n++)
    initial_define_key (global_map, n, "self-insert-command");
#endif
392
  for (n = 0240; n < 0400; n++)
393
    initial_define_key (global_map, n, "self-insert-command");
Jim Blandy's avatar
Jim Blandy committed
394 395 396 397 398 399 400 401

  initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
  initial_define_key (global_map, Ctl ('B'), "backward-char");
  initial_define_key (global_map, Ctl ('D'), "delete-char");
  initial_define_key (global_map, Ctl ('E'), "end-of-line");
  initial_define_key (global_map, Ctl ('F'), "forward-char");
  initial_define_key (global_map, 0177, "delete-backward-char");
}