*** empty log message ***
[emacs.git] / src / cmds.c
blob61458691174ce0b6e4cb79fb76f4451da564a74d
1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 93, 94, 95, 96, 97, 1998, 2001, 02 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "commands.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "syntax.h"
28 #include "window.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "dispextern.h"
33 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
35 /* A possible value for a buffer's overwrite-mode variable. */
36 Lisp_Object Qoverwrite_mode_binary;
38 /* Non-nil means put this face on the next self-inserting character. */
39 Lisp_Object Vself_insert_face;
41 /* This is the command that set up Vself_insert_face. */
42 Lisp_Object Vself_insert_face_command;
44 extern Lisp_Object Qface;
45 extern Lisp_Object Vtranslation_table_for_input;
47 DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
48 doc: /* Return buffer position N characters after (before if N negative) point. */)
49 (n)
50 Lisp_Object n;
52 CHECK_NUMBER (n);
54 return make_number (PT + XINT (n));
57 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
58 doc: /* Move point right N characters (left if N is negative).
59 On reaching end of buffer, stop and signal error. */)
60 (n)
61 Lisp_Object n;
63 if (NILP (n))
64 XSETFASTINT (n, 1);
65 else
66 CHECK_NUMBER (n);
68 /* This used to just set point to point + XINT (n), and then check
69 to see if it was within boundaries. But now that SET_PT can
70 potentially do a lot of stuff (calling entering and exiting
71 hooks, etcetera), that's not a good approach. So we validate the
72 proposed position, then set point. */
74 int new_point = PT + XINT (n);
76 if (new_point < BEGV)
78 SET_PT (BEGV);
79 Fsignal (Qbeginning_of_buffer, Qnil);
81 if (new_point > ZV)
83 SET_PT (ZV);
84 Fsignal (Qend_of_buffer, Qnil);
87 SET_PT (new_point);
90 return Qnil;
93 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
94 doc: /* Move point left N characters (right if N is negative).
95 On attempt to pass beginning or end of buffer, stop and signal error. */)
96 (n)
97 Lisp_Object n;
99 if (NILP (n))
100 XSETFASTINT (n, 1);
101 else
102 CHECK_NUMBER (n);
104 XSETINT (n, - XINT (n));
105 return Fforward_char (n);
108 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
109 doc: /* Move N lines forward (backward if N is negative).
110 Precisely, if point is on line I, move to the start of line I + N.
111 If there isn't room, go as far as possible (no error).
112 Returns the count of lines left to move. If moving forward,
113 that is N - number of lines moved; if backward, N + number moved.
114 With positive N, a non-empty line at the end counts as one line
115 successfully moved (for the return value). */)
117 Lisp_Object n;
119 int opoint = PT, opoint_byte = PT_BYTE;
120 int pos, pos_byte;
121 int count, shortage;
123 if (NILP (n))
124 count = 1;
125 else
127 CHECK_NUMBER (n);
128 count = XINT (n);
131 if (count <= 0)
132 shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
133 else
134 shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1);
136 /* Since scan_newline does TEMP_SET_PT_BOTH,
137 and we want to set PT "for real",
138 go back to the old point and then come back here. */
139 pos = PT;
140 pos_byte = PT_BYTE;
141 TEMP_SET_PT_BOTH (opoint, opoint_byte);
142 SET_PT_BOTH (pos, pos_byte);
144 if (shortage > 0
145 && (count <= 0
146 || (ZV > BEGV
147 && PT != opoint
148 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
149 shortage--;
151 return make_number (count <= 0 ? - shortage : shortage);
154 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "p",
155 doc: /* Move point to beginning of current line.
156 With argument N not nil or 1, move forward N - 1 lines first.
157 If point reaches the beginning or end of buffer, it stops there.
159 This command does not move point across a field boundary unless doing so
160 would move beyond there to a different line; If N is nil or 1, and point
161 starts at a field boundary, point does not move. To ignore field
162 boundaries, either bind `inhibit-field-text-motion' to t, or use the
163 `forward-line' function instead. For instance, `(forward-line 0)' does
164 the same thing as `(beginning-of-line)', except that it ignores field
165 boundaries. */)
167 Lisp_Object n;
169 if (NILP (n))
170 XSETFASTINT (n, 1);
171 else
172 CHECK_NUMBER (n);
174 SET_PT (XINT (Fline_beginning_position (n)));
176 return Qnil;
179 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "p",
180 doc: /* Move point to end of current line.
181 With argument N not nil or 1, move forward N - 1 lines first.
182 If point reaches the beginning or end of buffer, it stops there.
183 To ignore intangibility, bind `inhibit-text-motion-hooks' to t.
185 This command does not move point across a field boundary unless doing so
186 would move beyond there to a different line; if N is nil or 1, and
187 point starts at a field boundary, point does not move. To ignore field
188 boundaries bind `inhibit-field-text-motion' to t. */)
190 Lisp_Object n;
192 int newpos;
194 if (NILP (n))
195 XSETFASTINT (n, 1);
196 else
197 CHECK_NUMBER (n);
199 while (1)
201 newpos = XINT (Fline_end_position (n));
202 SET_PT (newpos);
204 if (PT > newpos
205 && FETCH_CHAR (PT - 1) == '\n')
207 /* If we skipped over a newline that follows
208 an invisible intangible run,
209 move back to the last tangible position
210 within the line. */
212 SET_PT (PT - 1);
213 break;
215 else if (PT > newpos && PT < ZV
216 && FETCH_CHAR (PT) != '\n')
217 /* If we skipped something intangible
218 and now we're not really at eol,
219 keep going. */
220 n = make_number (1);
221 else
222 break;
225 return Qnil;
228 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
229 doc: /* Delete the following N characters (previous if N is negative).
230 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
231 Interactively, N is the prefix arg, and KILLFLAG is set if
232 N was explicitly specified. */)
233 (n, killflag)
234 Lisp_Object n, killflag;
236 int pos;
238 CHECK_NUMBER (n);
240 pos = PT + XINT (n);
241 if (NILP (killflag))
243 if (XINT (n) < 0)
245 if (pos < BEGV)
246 Fsignal (Qbeginning_of_buffer, Qnil);
247 else
248 del_range (pos, PT);
250 else
252 if (pos > ZV)
253 Fsignal (Qend_of_buffer, Qnil);
254 else
255 del_range (PT, pos);
258 else
260 call1 (Qkill_forward_chars, n);
262 return Qnil;
265 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
266 1, 2, "p\nP",
267 doc: /* Delete the previous N characters (following if N is negative).
268 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
269 Interactively, N is the prefix arg, and KILLFLAG is set if
270 N was explicitly specified. */)
271 (n, killflag)
272 Lisp_Object n, killflag;
274 Lisp_Object value;
275 int deleted_special = 0;
276 int pos, pos_byte, i;
278 CHECK_NUMBER (n);
280 /* See if we are about to delete a tab or newline backwards. */
281 pos = PT;
282 pos_byte = PT_BYTE;
283 for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
285 int c;
287 DEC_BOTH (pos, pos_byte);
288 c = FETCH_BYTE (pos_byte);
289 if (c == '\t' || c == '\n')
291 deleted_special = 1;
292 break;
296 /* In overwrite mode, back over columns while clearing them out,
297 unless at end of line. */
298 if (XINT (n) > 0
299 && ! NILP (current_buffer->overwrite_mode)
300 && ! deleted_special
301 && ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
303 int column = (int) current_column (); /* iftc */
305 value = Fdelete_char (make_number (-XINT (n)), killflag);
306 i = column - (int) current_column (); /* iftc */
307 Finsert_char (make_number (' '), make_number (i), Qnil);
308 /* Whitespace chars are ASCII chars, so we can simply subtract. */
309 SET_PT_BOTH (PT - i, PT_BYTE - i);
311 else
312 value = Fdelete_char (make_number (-XINT (n)), killflag);
314 return value;
317 /* Note that there's code in command_loop_1 which typically avoids
318 calling this. */
319 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
320 doc: /* Insert the character you type.
321 Whichever character you type to run this command is inserted. */)
323 Lisp_Object n;
325 CHECK_NUMBER (n);
327 /* Barf if the key that invoked this was not a character. */
328 if (!INTEGERP (last_command_char))
329 bitch_at_user ();
331 int character = translate_char (Vtranslation_table_for_input,
332 XINT (last_command_char), 0, 0, 0);
333 if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
335 int modified_char = character;
336 /* Add the offset to the character, for Finsert_char.
337 We pass internal_self_insert the unmodified character
338 because it itself does this offsetting. */
339 if (! NILP (current_buffer->enable_multibyte_characters))
340 modified_char = unibyte_char_to_multibyte (modified_char);
342 XSETFASTINT (n, XFASTINT (n) - 2);
343 /* The first one might want to expand an abbrev. */
344 internal_self_insert (character, 1);
345 /* The bulk of the copies of this char can be inserted simply.
346 We don't have to handle a user-specified face specially
347 because it will get inherited from the first char inserted. */
348 Finsert_char (make_number (modified_char), n, Qt);
349 /* The last one might want to auto-fill. */
350 internal_self_insert (character, 0);
352 else
353 while (XINT (n) > 0)
355 /* Ok since old and new vals both nonneg */
356 XSETFASTINT (n, XFASTINT (n) - 1);
357 internal_self_insert (character, XFASTINT (n) != 0);
361 return Qnil;
364 /* Insert character C. If NOAUTOFILL is nonzero, don't do autofill
365 even if it is enabled.
367 If this insertion is suitable for direct output (completely simple),
368 return 0. A value of 1 indicates this *might* not have been simple.
369 A value of 2 means this did things that call for an undo boundary. */
372 internal_self_insert (c, noautofill)
373 int c;
374 int noautofill;
376 extern Lisp_Object Fexpand_abbrev ();
377 int hairy = 0;
378 Lisp_Object tem;
379 register enum syntaxcode synt;
380 Lisp_Object overwrite, string;
381 /* Length of multi-byte form of C. */
382 int len;
383 /* Working buffer and pointer for multi-byte form of C. */
384 unsigned char str[MAX_MULTIBYTE_LENGTH];
385 int chars_to_delete = 0;
386 int spaces_to_insert = 0;
388 overwrite = current_buffer->overwrite_mode;
389 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
390 hairy = 1;
392 /* At first, get multi-byte form of C in STR. */
393 if (!NILP (current_buffer->enable_multibyte_characters))
395 c = unibyte_char_to_multibyte (c);
396 len = CHAR_STRING (c, str);
397 if (len == 1)
398 /* If C has modifier bits, this makes C an appropriate
399 one-byte char. */
400 c = *str;
402 else
404 str[0] = (SINGLE_BYTE_CHAR_P (c)
406 : multibyte_char_to_unibyte (c, Qnil));
407 len = 1;
409 if (!NILP (overwrite)
410 && PT < ZV)
412 /* In overwrite-mode, we substitute a character at point (C2,
413 hereafter) by C. For that, we delete C2 in advance. But,
414 just substituting C2 by C may move a remaining text in the
415 line to the right or to the left, which is not preferable.
416 So we insert more spaces or delete more characters in the
417 following cases: if C is narrower than C2, after deleting C2,
418 we fill columns with spaces, if C is wider than C2, we delete
419 C2 and several characters following C2. */
421 /* This is the character after point. */
422 int c2 = FETCH_CHAR (PT_BYTE);
424 /* Column the cursor should be placed at after this insertion.
425 The correct value should be calculated only when necessary. */
426 int target_clm = 0;
428 /* Overwriting in binary-mode always replaces C2 by C.
429 Overwriting in textual-mode doesn't always do that.
430 It inserts newlines in the usual way,
431 and inserts any character at end of line
432 or before a tab if it doesn't use the whole width of the tab. */
433 if (EQ (overwrite, Qoverwrite_mode_binary)
434 || (c != '\n'
435 && c2 != '\n'
436 && ! (c2 == '\t'
437 && XINT (current_buffer->tab_width) > 0
438 && XFASTINT (current_buffer->tab_width) < 20
439 && (target_clm = ((int) current_column () /* iftc */
440 + XINT (Fchar_width (make_number (c)))),
441 target_clm % XFASTINT (current_buffer->tab_width)))))
443 int pos = PT;
444 int pos_byte = PT_BYTE;
446 if (target_clm == 0)
447 chars_to_delete = 1;
448 else
450 /* The actual cursor position after the trial of moving
451 to column TARGET_CLM. It is greater than TARGET_CLM
452 if the TARGET_CLM is middle of multi-column
453 character. In that case, the new point is set after
454 that character. */
455 int actual_clm
456 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
458 chars_to_delete = PT - pos;
460 if (actual_clm > target_clm)
462 /* We will delete too many columns. Let's fill columns
463 by spaces so that the remaining text won't move. */
464 spaces_to_insert = actual_clm - target_clm;
467 SET_PT_BOTH (pos, pos_byte);
468 hairy = 2;
470 hairy = 2;
472 if (!NILP (current_buffer->abbrev_mode)
473 && SYNTAX (c) != Sword
474 && NILP (current_buffer->read_only)
475 && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
477 int modiff = MODIFF;
478 Lisp_Object sym;
480 sym = Fexpand_abbrev ();
482 /* If we expanded an abbrev which has a hook,
483 and the hook has a non-nil `no-self-insert' property,
484 return right away--don't really self-insert. */
485 if (! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
486 && SYMBOLP (XSYMBOL (sym)->function))
488 Lisp_Object prop;
489 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
490 if (! NILP (prop))
491 return 1;
494 if (MODIFF != modiff)
495 hairy = 2;
498 if (chars_to_delete)
500 string = make_string_from_bytes (str, 1, len);
501 if (spaces_to_insert)
503 tem = Fmake_string (make_number (spaces_to_insert),
504 make_number (' '));
505 string = concat2 (tem, string);
508 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
509 Fforward_char (make_number (1 + spaces_to_insert));
511 else
512 insert_and_inherit (str, len);
514 if ((CHAR_TABLE_P (Vauto_fill_chars)
515 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
516 : (c == ' ' || c == '\n'))
517 && !noautofill
518 && !NILP (current_buffer->auto_fill_function))
520 Lisp_Object tem;
522 if (c == '\n')
523 /* After inserting a newline, move to previous line and fill
524 that. Must have the newline in place already so filling and
525 justification, if any, know where the end is going to be. */
526 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
527 tem = call0 (current_buffer->auto_fill_function);
528 if (c == '\n')
529 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
530 if (!NILP (tem))
531 hairy = 2;
534 /* If previous command specified a face to use, use it. */
535 if (!NILP (Vself_insert_face)
536 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
538 Fput_text_property (make_number (PT - 1), make_number (PT),
539 Qface, Vself_insert_face, Qnil);
540 Vself_insert_face = Qnil;
543 synt = SYNTAX (c);
544 if ((synt == Sclose || synt == Smath)
545 && !NILP (Vblink_paren_function) && INTERACTIVE
546 && !noautofill)
548 call0 (Vblink_paren_function);
549 hairy = 2;
551 return hairy;
554 /* module initialization */
556 void
557 syms_of_cmds ()
559 Qkill_backward_chars = intern ("kill-backward-chars");
560 staticpro (&Qkill_backward_chars);
562 Qkill_forward_chars = intern ("kill-forward-chars");
563 staticpro (&Qkill_forward_chars);
565 Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
566 staticpro (&Qoverwrite_mode_binary);
568 DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
569 doc: /* If non-nil, set the face of the next self-inserting character to this.
570 See also `self-insert-face-command'. */);
571 Vself_insert_face = Qnil;
573 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
574 doc: /* This is the command that set up `self-insert-face'.
575 If `last-command' does not equal this value, we ignore `self-insert-face'. */);
576 Vself_insert_face_command = Qnil;
578 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
579 doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
580 More precisely, a char with closeparen syntax is self-inserted. */);
581 Vblink_paren_function = Qnil;
583 defsubr (&Sforward_point);
584 defsubr (&Sforward_char);
585 defsubr (&Sbackward_char);
586 defsubr (&Sforward_line);
587 defsubr (&Sbeginning_of_line);
588 defsubr (&Send_of_line);
590 defsubr (&Sdelete_char);
591 defsubr (&Sdelete_backward_char);
593 defsubr (&Sself_insert_command);
596 void
597 keys_of_cmds ()
599 int n;
601 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
602 for (n = 040; n < 0177; n++)
603 initial_define_key (global_map, n, "self-insert-command");
604 #ifdef MSDOS
605 for (n = 0200; n < 0240; n++)
606 initial_define_key (global_map, n, "self-insert-command");
607 #endif
608 for (n = 0240; n < 0400; n++)
609 initial_define_key (global_map, n, "self-insert-command");
611 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
612 initial_define_key (global_map, Ctl ('B'), "backward-char");
613 initial_define_key (global_map, Ctl ('D'), "delete-char");
614 initial_define_key (global_map, Ctl ('E'), "end-of-line");
615 initial_define_key (global_map, Ctl ('F'), "forward-char");
616 initial_define_key (global_map, 0177, "delete-backward-char");