Merge from origin/emacs-24
[emacs.git] / src / cmds.c
blob270fc39cabcbaafb4a79faccd86fa191cd198c74
1 /* Simple built-in editing commands.
3 Copyright (C) 1985, 1993-1998, 2001-2015 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include "lisp.h"
24 #include "commands.h"
25 #include "character.h"
26 #include "buffer.h"
27 #include "syntax.h"
28 #include "window.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "dispextern.h"
32 #include "frame.h"
34 static int internal_self_insert (int, EMACS_INT);
36 DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
37 doc: /* Return buffer position N characters after (before if N negative) point. */)
38 (Lisp_Object n)
40 CHECK_NUMBER (n);
42 return make_number (PT + XINT (n));
45 /* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
46 Validate the new location. Return nil. */
47 static Lisp_Object
48 move_point (Lisp_Object n, bool forward)
50 /* This used to just set point to point + XINT (n), and then check
51 to see if it was within boundaries. But now that SET_PT can
52 potentially do a lot of stuff (calling entering and exiting
53 hooks, etcetera), that's not a good approach. So we validate the
54 proposed position, then set point. */
56 EMACS_INT new_point;
58 if (NILP (n))
59 XSETFASTINT (n, 1);
60 else
61 CHECK_NUMBER (n);
63 new_point = PT + (forward ? XINT (n) : - XINT (n));
65 if (new_point < BEGV)
67 SET_PT (BEGV);
68 xsignal0 (Qbeginning_of_buffer);
70 if (new_point > ZV)
72 SET_PT (ZV);
73 xsignal0 (Qend_of_buffer);
76 SET_PT (new_point);
77 return Qnil;
80 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
81 doc: /* Move point N characters forward (backward if N is negative).
82 On reaching end or beginning of buffer, stop and signal error.
83 Interactively, N is the numeric prefix argument.
84 If N is omitted or nil, move point 1 character forward.
86 Depending on the bidirectional context, the movement may be to the
87 right or to the left on the screen. This is in contrast with
88 \\[right-char], which see. */)
89 (Lisp_Object n)
91 return move_point (n, 1);
94 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
95 doc: /* Move point N characters backward (forward if N is negative).
96 On attempt to pass beginning or end of buffer, stop and signal error.
97 Interactively, N is the numeric prefix argument.
98 If N is omitted or nil, move point 1 character backward.
100 Depending on the bidirectional context, the movement may be to the
101 right or to the left on the screen. This is in contrast with
102 \\[left-char], which see. */)
103 (Lisp_Object n)
105 return move_point (n, 0);
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 \("start of line" in the logical order).
112 If there isn't room, go as far as possible (no error).
113 Returns the count of lines left to move. If moving forward,
114 that is N - number of lines moved; if backward, N + number moved.
115 With positive N, a non-empty line at the end counts as one line
116 successfully moved (for the return value). */)
117 (Lisp_Object n)
119 ptrdiff_t opoint = PT, pos, pos_byte, shortage, count;
121 if (NILP (n))
122 count = 1;
123 else
125 CHECK_NUMBER (n);
126 count = XINT (n);
129 shortage = scan_newline_from_point (count, &pos, &pos_byte);
131 SET_PT_BOTH (pos, pos_byte);
133 if (shortage > 0
134 && (count <= 0
135 || (ZV > BEGV
136 && PT != opoint
137 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
138 shortage--;
140 return make_number (count <= 0 ? - shortage : shortage);
143 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
144 doc: /* Move point to beginning of current line (in the logical order).
145 With argument N not nil or 1, move forward N - 1 lines first.
146 If point reaches the beginning or end of buffer, it stops there.
148 This function constrains point to the current field unless this moves
149 point to a different line than the original, unconstrained result.
150 If N is nil or 1, and a front-sticky field starts at point, the point
151 does not move. To ignore field boundaries bind
152 `inhibit-field-text-motion' to t, or use the `forward-line' function
153 instead. For instance, `(forward-line 0)' does the same thing as
154 `(beginning-of-line)', except that it ignores field boundaries. */)
155 (Lisp_Object n)
157 if (NILP (n))
158 XSETFASTINT (n, 1);
159 else
160 CHECK_NUMBER (n);
162 SET_PT (XINT (Fline_beginning_position (n)));
164 return Qnil;
167 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
168 doc: /* Move point to end of current line (in the logical order).
169 With argument N not nil or 1, move forward N - 1 lines first.
170 If point reaches the beginning or end of buffer, it stops there.
171 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
173 This function constrains point to the current field unless this moves
174 point to a different line than the original, unconstrained result. If
175 N is nil or 1, and a rear-sticky field ends at point, the point does
176 not move. To ignore field boundaries bind `inhibit-field-text-motion'
177 to t. */)
178 (Lisp_Object n)
180 ptrdiff_t newpos;
182 if (NILP (n))
183 XSETFASTINT (n, 1);
184 else
185 CHECK_NUMBER (n);
187 while (1)
189 newpos = XINT (Fline_end_position (n));
190 SET_PT (newpos);
192 if (PT > newpos
193 && FETCH_CHAR (PT - 1) == '\n')
195 /* If we skipped over a newline that follows
196 an invisible intangible run,
197 move back to the last tangible position
198 within the line. */
200 SET_PT (PT - 1);
201 break;
203 else if (PT > newpos && PT < ZV
204 && FETCH_CHAR (PT) != '\n')
205 /* If we skipped something intangible
206 and now we're not really at eol,
207 keep going. */
208 n = make_number (1);
209 else
210 break;
213 return Qnil;
216 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
217 doc: /* Delete the following N characters (previous if N is negative).
218 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
219 Interactively, N is the prefix arg, and KILLFLAG is set if
220 N was explicitly specified.
222 The command `delete-forward-char' is preferable for interactive use, e.g.
223 because it respects values of `delete-active-region' and `overwrite-mode'. */)
224 (Lisp_Object n, Lisp_Object killflag)
226 EMACS_INT pos;
228 CHECK_NUMBER (n);
230 pos = PT + XINT (n);
231 if (NILP (killflag))
233 if (XINT (n) < 0)
235 if (pos < BEGV)
236 xsignal0 (Qbeginning_of_buffer);
237 else
238 del_range (pos, PT);
240 else
242 if (pos > ZV)
243 xsignal0 (Qend_of_buffer);
244 else
245 del_range (PT, pos);
248 else
250 call1 (Qkill_forward_chars, n);
252 return Qnil;
255 static int nonundocount;
257 /* Note that there's code in command_loop_1 which typically avoids
258 calling this. */
259 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
260 doc: /* Insert the character you type.
261 Whichever character you type to run this command is inserted.
262 The numeric prefix argument N says how many times to repeat the insertion.
263 Before insertion, `expand-abbrev' is executed if the inserted character does
264 not have word syntax and the previous character in the buffer does.
265 After insertion, the value of `auto-fill-function' is called if the
266 `auto-fill-chars' table has a non-nil value for the inserted character.
267 At the end, it runs `post-self-insert-hook'. */)
268 (Lisp_Object n)
270 bool remove_boundary = 1;
271 CHECK_NUMBER (n);
273 if (XFASTINT (n) < 0)
274 error ("Negative repetition argument %"pI"d", XFASTINT (n));
276 if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
277 nonundocount = 0;
279 if (NILP (Vexecuting_kbd_macro)
280 && !EQ (minibuf_window, selected_window))
282 if (nonundocount <= 0 || nonundocount >= 20)
284 remove_boundary = 0;
285 nonundocount = 0;
287 nonundocount++;
290 if (remove_boundary
291 && CONSP (BVAR (current_buffer, undo_list))
292 && NILP (XCAR (BVAR (current_buffer, undo_list)))
293 /* Only remove auto-added boundaries, not boundaries
294 added be explicit calls to undo-boundary. */
295 && EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
296 /* Remove the undo_boundary that was just pushed. */
297 bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
299 /* Barf if the key that invoked this was not a character. */
300 if (!CHARACTERP (last_command_event))
301 bitch_at_user ();
302 else {
303 int character = translate_char (Vtranslation_table_for_input,
304 XINT (last_command_event));
305 int val = internal_self_insert (character, XFASTINT (n));
306 if (val == 2)
307 nonundocount = 0;
308 frame_make_pointer_invisible (SELECTED_FRAME ());
311 return Qnil;
314 /* Insert N times character C
316 If this insertion is suitable for direct output (completely simple),
317 return 0. A value of 1 indicates this *might* not have been simple.
318 A value of 2 means this did things that call for an undo boundary. */
320 static int
321 internal_self_insert (int c, EMACS_INT n)
323 int hairy = 0;
324 Lisp_Object tem;
325 register enum syntaxcode synt;
326 Lisp_Object overwrite;
327 /* Length of multi-byte form of C. */
328 int len;
329 /* Working buffer and pointer for multi-byte form of C. */
330 unsigned char str[MAX_MULTIBYTE_LENGTH];
331 ptrdiff_t chars_to_delete = 0;
332 ptrdiff_t spaces_to_insert = 0;
334 overwrite = BVAR (current_buffer, overwrite_mode);
335 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
336 hairy = 1;
338 /* At first, get multi-byte form of C in STR. */
339 if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
341 len = CHAR_STRING (c, str);
342 if (len == 1)
343 /* If C has modifier bits, this makes C an appropriate
344 one-byte char. */
345 c = *str;
347 else
349 str[0] = SINGLE_BYTE_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
350 len = 1;
352 if (!NILP (overwrite)
353 && PT < ZV)
355 /* In overwrite-mode, we substitute a character at point (C2,
356 hereafter) by C. For that, we delete C2 in advance. But,
357 just substituting C2 by C may move a remaining text in the
358 line to the right or to the left, which is not preferable.
359 So we insert more spaces or delete more characters in the
360 following cases: if C is narrower than C2, after deleting C2,
361 we fill columns with spaces, if C is wider than C2, we delete
362 C2 and several characters following C2. */
364 /* This is the character after point. */
365 int c2 = FETCH_CHAR (PT_BYTE);
367 int cwidth;
369 /* Overwriting in binary-mode always replaces C2 by C.
370 Overwriting in textual-mode doesn't always do that.
371 It inserts newlines in the usual way,
372 and inserts any character at end of line
373 or before a tab if it doesn't use the whole width of the tab. */
374 if (EQ (overwrite, Qoverwrite_mode_binary))
375 chars_to_delete = min (n, PTRDIFF_MAX);
376 else if (c != '\n' && c2 != '\n'
377 && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
379 ptrdiff_t pos = PT;
380 ptrdiff_t pos_byte = PT_BYTE;
381 ptrdiff_t curcol = current_column ();
383 if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
385 /* Column the cursor should be placed at after this insertion.
386 The value should be calculated only when necessary. */
387 ptrdiff_t target_clm = curcol + n * cwidth;
389 /* The actual cursor position after the trial of moving
390 to column TARGET_CLM. It is greater than TARGET_CLM
391 if the TARGET_CLM is middle of multi-column
392 character. In that case, the new point is set after
393 that character. */
394 ptrdiff_t actual_clm
395 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
397 chars_to_delete = PT - pos;
399 if (actual_clm > target_clm)
401 /* We will delete too many columns. Let's fill columns
402 by spaces so that the remaining text won't move. */
403 ptrdiff_t actual = PT_BYTE;
404 DEC_POS (actual);
405 if (FETCH_CHAR (actual) == '\t')
406 /* Rather than add spaces, let's just keep the tab. */
407 chars_to_delete--;
408 else
409 spaces_to_insert = actual_clm - target_clm;
412 SET_PT_BOTH (pos, pos_byte);
415 hairy = 2;
418 synt = SYNTAX (c);
420 if (!NILP (BVAR (current_buffer, abbrev_mode))
421 && synt != Sword
422 && NILP (BVAR (current_buffer, read_only))
423 && PT > BEGV
424 && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
425 ? XFASTINT (Fprevious_char ())
426 : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
427 == Sword))
429 EMACS_INT modiff = MODIFF;
430 Lisp_Object sym;
432 sym = call0 (Qexpand_abbrev);
434 /* If we expanded an abbrev which has a hook,
435 and the hook has a non-nil `no-self-insert' property,
436 return right away--don't really self-insert. */
437 if (SYMBOLP (sym) && ! NILP (sym)
438 && ! NILP (XSYMBOL (sym)->function)
439 && SYMBOLP (XSYMBOL (sym)->function))
441 Lisp_Object prop;
442 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
443 if (! NILP (prop))
444 return 1;
447 if (MODIFF != modiff)
448 hairy = 2;
451 if (chars_to_delete)
453 int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
454 && SINGLE_BYTE_CHAR_P (c))
455 ? UNIBYTE_TO_CHAR (c) : c);
456 Lisp_Object string = Fmake_string (make_number (n), make_number (mc));
458 if (spaces_to_insert)
460 tem = Fmake_string (make_number (spaces_to_insert),
461 make_number (' '));
462 string = concat2 (string, tem);
465 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
466 Fforward_char (make_number (n + spaces_to_insert));
468 else if (n > 1)
470 USE_SAFE_ALLOCA;
471 char *strn, *p;
472 SAFE_NALLOCA (strn, len, n);
473 for (p = strn; n > 0; n--, p += len)
474 memcpy (p, str, len);
475 insert_and_inherit (strn, p - strn);
476 SAFE_FREE ();
478 else if (n > 0)
479 insert_and_inherit ((char *) str, len);
481 if ((CHAR_TABLE_P (Vauto_fill_chars)
482 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
483 : (c == ' ' || c == '\n'))
484 && !NILP (BVAR (current_buffer, auto_fill_function)))
486 Lisp_Object auto_fill_result;
488 if (c == '\n')
489 /* After inserting a newline, move to previous line and fill
490 that. Must have the newline in place already so filling and
491 justification, if any, know where the end is going to be. */
492 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
493 auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
494 /* Test PT < ZV in case the auto-fill-function is strange. */
495 if (c == '\n' && PT < ZV)
496 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
497 if (!NILP (auto_fill_result))
498 hairy = 2;
501 /* Run hooks for electric keys. */
502 run_hook (Qpost_self_insert_hook);
504 return hairy;
507 /* module initialization */
509 void
510 syms_of_cmds (void)
512 DEFSYM (Qkill_backward_chars, "kill-backward-chars");
513 DEFSYM (Qkill_forward_chars, "kill-forward-chars");
515 /* A possible value for a buffer's overwrite-mode variable. */
516 DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
518 DEFSYM (Qexpand_abbrev, "expand-abbrev");
519 DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
521 DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
522 doc: /* Hook run at the end of `self-insert-command'.
523 This is run after inserting the character. */);
524 Vpost_self_insert_hook = Qnil;
526 defsubr (&Sforward_point);
527 defsubr (&Sforward_char);
528 defsubr (&Sbackward_char);
529 defsubr (&Sforward_line);
530 defsubr (&Sbeginning_of_line);
531 defsubr (&Send_of_line);
533 defsubr (&Sdelete_char);
534 defsubr (&Sself_insert_command);
537 void
538 keys_of_cmds (void)
540 int n;
542 nonundocount = 0;
543 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
544 for (n = 040; n < 0177; n++)
545 initial_define_key (global_map, n, "self-insert-command");
546 #ifdef MSDOS
547 for (n = 0200; n < 0240; n++)
548 initial_define_key (global_map, n, "self-insert-command");
549 #endif
550 for (n = 0240; n < 0400; n++)
551 initial_define_key (global_map, n, "self-insert-command");
553 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
554 initial_define_key (global_map, Ctl ('B'), "backward-char");
555 initial_define_key (global_map, Ctl ('E'), "end-of-line");
556 initial_define_key (global_map, Ctl ('F'), "forward-char");