* info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833).
[emacs.git] / src / cmds.c
blob8a17a8e9817976a193af23db91a91f5c2a494b03
1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <setjmp.h>
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "character.h"
28 #include "syntax.h"
29 #include "window.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "dispextern.h"
33 #include "frame.h"
35 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
37 /* A possible value for a buffer's overwrite-mode variable. */
38 Lisp_Object Qoverwrite_mode_binary;
40 /* Non-nil means put this face on the next self-inserting character. */
41 Lisp_Object Vself_insert_face;
43 /* This is the command that set up Vself_insert_face. */
44 Lisp_Object Vself_insert_face_command;
46 extern Lisp_Object Qface;
47 extern Lisp_Object Vtranslation_table_for_input;
49 DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
50 doc: /* Return buffer position N characters after (before if N negative) point. */)
51 (n)
52 Lisp_Object n;
54 CHECK_NUMBER (n);
56 return make_number (PT + XINT (n));
59 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
60 doc: /* Move point right N characters (left if N is negative).
61 On reaching end of buffer, stop and signal error. */)
62 (n)
63 Lisp_Object n;
65 if (NILP (n))
66 XSETFASTINT (n, 1);
67 else
68 CHECK_NUMBER (n);
70 /* This used to just set point to point + XINT (n), and then check
71 to see if it was within boundaries. But now that SET_PT can
72 potentially do a lot of stuff (calling entering and exiting
73 hooks, etcetera), that's not a good approach. So we validate the
74 proposed position, then set point. */
76 int new_point = PT + XINT (n);
78 if (new_point < BEGV)
80 SET_PT (BEGV);
81 xsignal0 (Qbeginning_of_buffer);
83 if (new_point > ZV)
85 SET_PT (ZV);
86 xsignal0 (Qend_of_buffer);
89 SET_PT (new_point);
92 return Qnil;
95 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
96 doc: /* Move point left N characters (right if N is negative).
97 On attempt to pass beginning or end of buffer, stop and signal error. */)
98 (n)
99 Lisp_Object n;
101 if (NILP (n))
102 XSETFASTINT (n, 1);
103 else
104 CHECK_NUMBER (n);
106 XSETINT (n, - XINT (n));
107 return Fforward_char (n);
110 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
111 doc: /* Move N lines forward (backward if N is negative).
112 Precisely, if point is on line I, move to the start of line I + N.
113 If there isn't room, go as far as possible (no error).
114 Returns the count of lines left to move. If moving forward,
115 that is N - number of lines moved; if backward, N + number moved.
116 With positive N, a non-empty line at the end counts as one line
117 successfully moved (for the return value). */)
119 Lisp_Object n;
121 int opoint = PT, opoint_byte = PT_BYTE;
122 int pos, pos_byte;
123 int count, shortage;
125 if (NILP (n))
126 count = 1;
127 else
129 CHECK_NUMBER (n);
130 count = XINT (n);
133 if (count <= 0)
134 shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
135 else
136 shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1);
138 /* Since scan_newline does TEMP_SET_PT_BOTH,
139 and we want to set PT "for real",
140 go back to the old point and then come back here. */
141 pos = PT;
142 pos_byte = PT_BYTE;
143 TEMP_SET_PT_BOTH (opoint, opoint_byte);
144 SET_PT_BOTH (pos, pos_byte);
146 if (shortage > 0
147 && (count <= 0
148 || (ZV > BEGV
149 && PT != opoint
150 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
151 shortage--;
153 return make_number (count <= 0 ? - shortage : shortage);
156 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
157 doc: /* Move point to beginning of current line.
158 With argument N not nil or 1, move forward N - 1 lines first.
159 If point reaches the beginning or end of buffer, it stops there.
161 This function constrains point to the current field unless this moves
162 point to a different line than the original, unconstrained result. If
163 N is nil or 1, and a front-sticky field starts at point, the point
164 does not move. To ignore field boundaries bind
165 `inhibit-field-text-motion' to t, or use the `forward-line' function
166 instead. For instance, `(forward-line 0)' does the same thing as
167 `(beginning-of-line)', except that it ignores field boundaries. */)
169 Lisp_Object n;
171 if (NILP (n))
172 XSETFASTINT (n, 1);
173 else
174 CHECK_NUMBER (n);
176 SET_PT (XINT (Fline_beginning_position (n)));
178 return Qnil;
181 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
182 doc: /* Move point to end of current line.
183 With argument N not nil or 1, move forward N - 1 lines first.
184 If point reaches the beginning or end of buffer, it stops there.
185 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
187 This function constrains point to the current field unless this moves
188 point to a different line than the original, unconstrained result. If
189 N is nil or 1, and a rear-sticky field ends at point, the point does
190 not move. To ignore field boundaries bind `inhibit-field-text-motion'
191 to t. */)
193 Lisp_Object n;
195 int newpos;
197 if (NILP (n))
198 XSETFASTINT (n, 1);
199 else
200 CHECK_NUMBER (n);
202 while (1)
204 newpos = XINT (Fline_end_position (n));
205 SET_PT (newpos);
207 if (PT > newpos
208 && FETCH_CHAR (PT - 1) == '\n')
210 /* If we skipped over a newline that follows
211 an invisible intangible run,
212 move back to the last tangible position
213 within the line. */
215 SET_PT (PT - 1);
216 break;
218 else if (PT > newpos && PT < ZV
219 && FETCH_CHAR (PT) != '\n')
220 /* If we skipped something intangible
221 and now we're not really at eol,
222 keep going. */
223 n = make_number (1);
224 else
225 break;
228 return Qnil;
231 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
232 doc: /* Delete the following N characters (previous if N is negative).
233 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
234 Interactively, N is the prefix arg, and KILLFLAG is set if
235 N was explicitly specified. */)
236 (n, killflag)
237 Lisp_Object n, killflag;
239 int pos;
241 CHECK_NUMBER (n);
243 pos = PT + XINT (n);
244 if (NILP (killflag))
246 if (XINT (n) < 0)
248 if (pos < BEGV)
249 xsignal0 (Qbeginning_of_buffer);
250 else
251 del_range (pos, PT);
253 else
255 if (pos > ZV)
256 xsignal0 (Qend_of_buffer);
257 else
258 del_range (PT, pos);
261 else
263 call1 (Qkill_forward_chars, n);
265 return Qnil;
268 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
269 1, 2, "p\nP",
270 doc: /* Delete the previous N characters (following if N is negative).
271 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
272 Interactively, N is the prefix arg, and KILLFLAG is set if
273 N was explicitly specified.
274 This is meant for interactive use only; from Lisp, better use `delete-char'
275 with a negated argument. */)
276 (n, killflag)
277 Lisp_Object n, killflag;
279 Lisp_Object value;
280 int deleted_special = 0;
281 int pos, pos_byte, i;
283 CHECK_NUMBER (n);
285 /* See if we are about to delete a tab or newline backwards. */
286 pos = PT;
287 pos_byte = PT_BYTE;
288 for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
290 int c;
292 DEC_BOTH (pos, pos_byte);
293 c = FETCH_BYTE (pos_byte);
294 if (c == '\t' || c == '\n')
296 deleted_special = 1;
297 break;
301 /* In overwrite mode, back over columns while clearing them out,
302 unless at end of line. */
303 if (XINT (n) > 0
304 && ! NILP (current_buffer->overwrite_mode)
305 && ! deleted_special
306 && ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
308 int column = (int) current_column (); /* iftc */
310 value = Fdelete_char (make_number (-XINT (n)), killflag);
311 i = column - (int) current_column (); /* iftc */
312 Finsert_char (make_number (' '), make_number (i), Qnil);
313 /* Whitespace chars are ASCII chars, so we can simply subtract. */
314 SET_PT_BOTH (PT - i, PT_BYTE - i);
316 else
317 value = Fdelete_char (make_number (-XINT (n)), killflag);
319 return value;
322 int nonundocount;
324 /* Note that there's code in command_loop_1 which typically avoids
325 calling this. */
326 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
327 doc: /* Insert the character you type.
328 Whichever character you type to run this command is inserted.
329 Before insertion, `expand-abbrev' is executed if the inserted character does
330 not have word syntax and the previous character in the buffer does.
331 After insertion, the value of `auto-fill-function' is called if the
332 `auto-fill-chars' table has a non-nil value for the inserted character. */)
334 Lisp_Object n;
336 int remove_boundary = 1;
337 CHECK_NUMBER (n);
339 if (!EQ (Vthis_command, current_kboard->Vlast_command))
340 nonundocount = 0;
342 if (NILP (Vexecuting_kbd_macro)
343 && !EQ (minibuf_window, selected_window))
345 if (nonundocount <= 0 || nonundocount >= 20)
347 remove_boundary = 0;
348 nonundocount = 0;
350 nonundocount++;
353 if (remove_boundary
354 && CONSP (current_buffer->undo_list)
355 && NILP (XCAR (current_buffer->undo_list)))
356 /* Remove the undo_boundary that was just pushed. */
357 current_buffer->undo_list = XCDR (current_buffer->undo_list);
359 /* Barf if the key that invoked this was not a character. */
360 if (!CHARACTERP (last_command_event))
361 bitch_at_user ();
363 int character = translate_char (Vtranslation_table_for_input,
364 XINT (last_command_event));
365 if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
367 XSETFASTINT (n, XFASTINT (n) - 2);
368 /* The first one might want to expand an abbrev. */
369 internal_self_insert (character, 1);
370 /* The bulk of the copies of this char can be inserted simply.
371 We don't have to handle a user-specified face specially
372 because it will get inherited from the first char inserted. */
373 Finsert_char (make_number (character), n, Qt);
374 /* The last one might want to auto-fill. */
375 internal_self_insert (character, 0);
377 else
378 while (XINT (n) > 0)
380 int val;
381 /* Ok since old and new vals both nonneg */
382 XSETFASTINT (n, XFASTINT (n) - 1);
383 val = internal_self_insert (character, XFASTINT (n) != 0);
384 if (val == 2)
385 nonundocount = 0;
386 frame_make_pointer_invisible ();
390 return Qnil;
393 /* Insert character C. If NOAUTOFILL is nonzero, don't do autofill
394 even if it is enabled.
396 If this insertion is suitable for direct output (completely simple),
397 return 0. A value of 1 indicates this *might* not have been simple.
398 A value of 2 means this did things that call for an undo boundary. */
400 static Lisp_Object Qexpand_abbrev;
403 internal_self_insert (c, noautofill)
404 int c;
405 int noautofill;
407 int hairy = 0;
408 Lisp_Object tem;
409 register enum syntaxcode synt;
410 Lisp_Object overwrite, string;
411 /* Length of multi-byte form of C. */
412 int len;
413 /* Working buffer and pointer for multi-byte form of C. */
414 unsigned char str[MAX_MULTIBYTE_LENGTH];
415 int chars_to_delete = 0;
416 int spaces_to_insert = 0;
418 overwrite = current_buffer->overwrite_mode;
419 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
420 hairy = 1;
422 /* At first, get multi-byte form of C in STR. */
423 if (!NILP (current_buffer->enable_multibyte_characters))
425 len = CHAR_STRING (c, str);
426 if (len == 1)
427 /* If C has modifier bits, this makes C an appropriate
428 one-byte char. */
429 c = *str;
431 else
433 str[0] = (SINGLE_BYTE_CHAR_P (c)
435 : multibyte_char_to_unibyte (c, Qnil));
436 len = 1;
438 if (!NILP (overwrite)
439 && PT < ZV)
441 /* In overwrite-mode, we substitute a character at point (C2,
442 hereafter) by C. For that, we delete C2 in advance. But,
443 just substituting C2 by C may move a remaining text in the
444 line to the right or to the left, which is not preferable.
445 So we insert more spaces or delete more characters in the
446 following cases: if C is narrower than C2, after deleting C2,
447 we fill columns with spaces, if C is wider than C2, we delete
448 C2 and several characters following C2. */
450 /* This is the character after point. */
451 int c2 = FETCH_CHAR (PT_BYTE);
453 /* Column the cursor should be placed at after this insertion.
454 The correct value should be calculated only when necessary. */
455 int target_clm = 0;
457 /* Overwriting in binary-mode always replaces C2 by C.
458 Overwriting in textual-mode doesn't always do that.
459 It inserts newlines in the usual way,
460 and inserts any character at end of line
461 or before a tab if it doesn't use the whole width of the tab. */
462 if (EQ (overwrite, Qoverwrite_mode_binary)
463 || (c != '\n'
464 && c2 != '\n'
465 && ! (c2 == '\t'
466 && XINT (current_buffer->tab_width) > 0
467 && XFASTINT (current_buffer->tab_width) < 20
468 && (target_clm = ((int) current_column () /* iftc */
469 + XINT (Fchar_width (make_number (c)))),
470 target_clm % XFASTINT (current_buffer->tab_width)))))
472 int pos = PT;
473 int pos_byte = PT_BYTE;
475 if (target_clm == 0)
476 chars_to_delete = 1;
477 else
479 /* The actual cursor position after the trial of moving
480 to column TARGET_CLM. It is greater than TARGET_CLM
481 if the TARGET_CLM is middle of multi-column
482 character. In that case, the new point is set after
483 that character. */
484 int actual_clm
485 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
487 chars_to_delete = PT - pos;
489 if (actual_clm > target_clm)
491 /* We will delete too many columns. Let's fill columns
492 by spaces so that the remaining text won't move. */
493 spaces_to_insert = actual_clm - target_clm;
496 SET_PT_BOTH (pos, pos_byte);
497 hairy = 2;
499 hairy = 2;
502 synt = SYNTAX (c);
504 if (!NILP (current_buffer->abbrev_mode)
505 && synt != Sword
506 && NILP (current_buffer->read_only)
507 && PT > BEGV
508 && (!NILP (current_buffer->enable_multibyte_characters)
509 ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
510 : (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
511 == Sword)))
513 int modiff = MODIFF;
514 Lisp_Object sym;
516 sym = call0 (Qexpand_abbrev);
518 /* If we expanded an abbrev which has a hook,
519 and the hook has a non-nil `no-self-insert' property,
520 return right away--don't really self-insert. */
521 if (SYMBOLP (sym) && ! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
522 && SYMBOLP (XSYMBOL (sym)->function))
524 Lisp_Object prop;
525 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
526 if (! NILP (prop))
527 return 1;
530 if (MODIFF != modiff)
531 hairy = 2;
534 if (chars_to_delete)
536 string = make_string_from_bytes (str, 1, len);
537 if (spaces_to_insert)
539 tem = Fmake_string (make_number (spaces_to_insert),
540 make_number (' '));
541 string = concat2 (tem, string);
544 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
545 Fforward_char (make_number (1 + spaces_to_insert));
547 else
548 insert_and_inherit (str, len);
550 if ((CHAR_TABLE_P (Vauto_fill_chars)
551 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
552 : (c == ' ' || c == '\n'))
553 && !noautofill
554 && !NILP (current_buffer->auto_fill_function))
556 Lisp_Object tem;
558 if (c == '\n')
559 /* After inserting a newline, move to previous line and fill
560 that. Must have the newline in place already so filling and
561 justification, if any, know where the end is going to be. */
562 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
563 tem = call0 (current_buffer->auto_fill_function);
564 /* Test PT < ZV in case the auto-fill-function is strange. */
565 if (c == '\n' && PT < ZV)
566 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
567 if (!NILP (tem))
568 hairy = 2;
571 /* If previous command specified a face to use, use it. */
572 if (!NILP (Vself_insert_face)
573 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
575 Fput_text_property (make_number (PT - 1), make_number (PT),
576 Qface, Vself_insert_face, Qnil);
577 Vself_insert_face = Qnil;
580 if ((synt == Sclose || synt == Smath)
581 && !NILP (Vblink_paren_function) && INTERACTIVE
582 && !noautofill)
584 call0 (Vblink_paren_function);
585 hairy = 2;
587 return hairy;
590 /* module initialization */
592 void
593 syms_of_cmds ()
595 Qkill_backward_chars = intern_c_string ("kill-backward-chars");
596 staticpro (&Qkill_backward_chars);
598 Qkill_forward_chars = intern_c_string ("kill-forward-chars");
599 staticpro (&Qkill_forward_chars);
601 Qoverwrite_mode_binary = intern_c_string ("overwrite-mode-binary");
602 staticpro (&Qoverwrite_mode_binary);
604 Qexpand_abbrev = intern_c_string ("expand-abbrev");
605 staticpro (&Qexpand_abbrev);
607 DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
608 doc: /* If non-nil, set the face of the next self-inserting character to this.
609 See also `self-insert-face-command'. */);
610 Vself_insert_face = Qnil;
612 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
613 doc: /* This is the command that set up `self-insert-face'.
614 If `last-command' does not equal this value, we ignore `self-insert-face'. */);
615 Vself_insert_face_command = Qnil;
617 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
618 doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
619 More precisely, a char with closeparen syntax is self-inserted. */);
620 Vblink_paren_function = Qnil;
622 defsubr (&Sforward_point);
623 defsubr (&Sforward_char);
624 defsubr (&Sbackward_char);
625 defsubr (&Sforward_line);
626 defsubr (&Sbeginning_of_line);
627 defsubr (&Send_of_line);
629 defsubr (&Sdelete_char);
630 defsubr (&Sdelete_backward_char);
632 defsubr (&Sself_insert_command);
635 void
636 keys_of_cmds ()
638 int n;
640 nonundocount = 0;
641 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
642 for (n = 040; n < 0177; n++)
643 initial_define_key (global_map, n, "self-insert-command");
644 #ifdef MSDOS
645 for (n = 0200; n < 0240; n++)
646 initial_define_key (global_map, n, "self-insert-command");
647 #endif
648 for (n = 0240; n < 0400; n++)
649 initial_define_key (global_map, n, "self-insert-command");
651 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
652 initial_define_key (global_map, Ctl ('B'), "backward-char");
653 initial_define_key (global_map, Ctl ('D'), "delete-char");
654 initial_define_key (global_map, Ctl ('E'), "end-of-line");
655 initial_define_key (global_map, Ctl ('F'), "forward-char");
656 initial_define_key (global_map, 0177, "delete-backward-char");
659 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
660 (do not change this comment) */