1 /* Simple built-in editing commands.
2
3 Copyright (C) 1985, 1993-1998, 2001-2023 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
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 (at
10 your option) any later version.
11
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.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20
21 #include <config.h>
22
23 #include "lisp.h"
24 #include "commands.h"
25 #include "character.h"
26 #include "buffer.h"
27 #include "syntax.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31
32 static int internal_self_insert (int, EMACS_INT);
33
34 /* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
35 Validate the new location. Return nil. */
36 static Lisp_Object
37 move_point (Lisp_Object n, bool forward)
38 {
39 /* This used to just set point to point + XFIXNUM (n), and then check
40 to see if it was within boundaries. But now that SET_PT can
41 potentially do a lot of stuff (calling entering and exiting
42 hooks, etcetera), that's not a good approach. So we validate the
43 proposed position, then set point. */
44
45 EMACS_INT new_point;
46
47 if (NILP (n))
48 XSETFASTINT (n, 1);
49 else
50 CHECK_FIXNUM (n);
51
52 new_point = PT + (forward ? XFIXNUM (n) : - XFIXNUM (n));
53
54 if (new_point < BEGV)
55 {
56 SET_PT (BEGV);
57 xsignal0 (Qbeginning_of_buffer);
58 }
59 if (new_point > ZV)
60 {
61 SET_PT (ZV);
62 xsignal0 (Qend_of_buffer);
63 }
64
65 SET_PT (new_point);
66 return Qnil;
67 }
68
69 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
70 doc: /* Move point N characters forward (backward if N is negative).
71 On reaching end or beginning of buffer, stop and signal error.
72 Interactively, N is the numeric prefix argument.
73 If N is omitted or nil, move point 1 character forward.
74
75 Depending on the bidirectional context, the movement may be to the
76 right or to the left on the screen. This is in contrast with
77 \\[right-char], which see. */)
78 (Lisp_Object n)
79 {
80 return move_point (n, 1);
81 }
82
83 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
84 doc: /* Move point N characters backward (forward if N is negative).
85 On attempt to pass beginning or end of buffer, stop and signal error.
86 Interactively, N is the numeric prefix argument.
87 If N is omitted or nil, move point 1 character backward.
88
89 Depending on the bidirectional context, the movement may be to the
90 right or to the left on the screen. This is in contrast with
91 \\[left-char], which see. */)
92 (Lisp_Object n)
93 {
94 return move_point (n, 0);
95 }
96
97 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
98 doc: /* Move N lines forward (backward if N is negative).
99 Precisely, if point is on line I, move to the start of line I + N
100 \("start of line" in the logical order).
101 If there isn't room, go as far as possible (no error).
102 Interactively, N is the numeric prefix argument and defaults to 1.
103
104 Returns the count of lines left to move. If moving forward,
105 that is N minus number of lines moved; if backward, N plus number
106 moved.
107
108 Exception: With positive N, a non-empty line at the end of the
109 buffer, or of its accessible portion, counts as one line
110 successfully moved (for the return value). This means that the
111 function will move point to the end of such a line and will count
112 it as a line moved across, even though there is no next line to
113 go to its beginning. */)
114 (Lisp_Object n)
115 {
116 ptrdiff_t opoint = PT, pos, pos_byte, count;
117 bool excessive = false;
118
119 if (NILP (n))
120 count = 1;
121 else
122 {
123 CHECK_INTEGER (n);
124 if (FIXNUMP (n)
125 && -BUF_BYTES_MAX <= XFIXNUM (n) && XFIXNUM (n) <= BUF_BYTES_MAX)
126 count = XFIXNUM (n);
127 else
128 {
129 count = !NILP (Fnatnump (n)) ? BUF_BYTES_MAX : -BUF_BYTES_MAX;
130 excessive = true;
131 }
132 }
133
134 ptrdiff_t counted = scan_newline_from_point (count, &pos, &pos_byte);
135
136 SET_PT_BOTH (pos, pos_byte);
137
138 ptrdiff_t shortage = count - (count <= 0) - counted;
139 if (shortage != 0)
140 shortage -= (count <= 0 ? -1
141 : (BEGV < ZV && PT != opoint
142 && FETCH_BYTE (PT_BYTE - 1) != '\n'));
143 return (excessive
144 ? CALLN (Fplus, make_fixnum (shortage - count), n)
145 : make_fixnum (shortage));
146 }
147
148 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
149 doc: /* Move point to beginning of current line (in the logical order).
150 With argument N not nil or 1, move forward N - 1 lines first.
151 If point reaches the beginning or end of buffer, it stops there.
152
153 This function constrains point to the current field unless this moves
154 point to a different line from the original, unconstrained result.
155 If N is nil or 1, and a front-sticky field starts at point, the point
156 does not move. To ignore field boundaries bind
157 `inhibit-field-text-motion' to t, or use the `forward-line' function
158 instead. For instance, `(forward-line 0)' does the same thing as
159 `(beginning-of-line)', except that it ignores field boundaries. */)
160 (Lisp_Object n)
161 {
162 if (NILP (n))
163 XSETFASTINT (n, 1);
164 else
165 CHECK_FIXNUM (n);
166
167 SET_PT (XFIXNUM (Fline_beginning_position (n)));
168
169 return Qnil;
170 }
171
172 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
173 doc: /* Move point to end of current line (in the logical order).
174 With argument N not nil or 1, move forward N - 1 lines first.
175 If point reaches the beginning or end of buffer, it stops there.
176 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
177
178 This function constrains point to the current field unless this moves
179 point to a different line from the original, unconstrained result. If
180 N is nil or 1, and a rear-sticky field ends at point, the point does
181 not move. To ignore field boundaries bind `inhibit-field-text-motion'
182 to t. */)
183 (Lisp_Object n)
184 {
185 ptrdiff_t newpos;
186
187 if (NILP (n))
188 XSETFASTINT (n, 1);
189 else
190 CHECK_FIXNUM (n);
191
192 while (1)
193 {
194 newpos = XFIXNUM (Fline_end_position (n));
195 SET_PT (newpos);
196
197 if (PT > newpos
198 && FETCH_BYTE (PT_BYTE - 1) == '\n')
199 {
200 /* If we skipped over a newline that follows
201 an invisible intangible run,
202 move back to the last tangible position
203 within the line. */
204
205 SET_PT (PT - 1);
206 break;
207 }
208 else if (PT > newpos && PT < ZV
209 && FETCH_BYTE (PT_BYTE) != '\n')
210 /* If we skipped something intangible
211 and now we're not really at eol,
212 keep going. */
213 n = make_fixnum (1);
214 else
215 break;
216 }
217
218 return Qnil;
219 }
220
221 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
222 doc: /* Delete the following N characters (previous if N is negative).
223 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
224 Interactively, N is the prefix arg, and KILLFLAG is set if
225 N was explicitly specified.
226
227 The command `delete-forward-char' is preferable for interactive use, e.g.
228 because it respects values of `delete-active-region' and `overwrite-mode'. */)
229 (Lisp_Object n, Lisp_Object killflag)
230 {
231 EMACS_INT pos;
232
233 CHECK_FIXNUM (n);
234
235 if (eabs (XFIXNUM (n)) < 2)
236 call0 (Qundo_auto_amalgamate);
237
238 pos = PT + XFIXNUM (n);
239 if (NILP (killflag))
240 {
241 if (XFIXNUM (n) < 0)
242 {
243 if (pos < BEGV)
244 xsignal0 (Qbeginning_of_buffer);
245 else
246 del_range (pos, PT);
247 }
248 else
249 {
250 if (pos > ZV)
251 xsignal0 (Qend_of_buffer);
252 else
253 del_range (PT, pos);
254 }
255 }
256 else
257 {
258 call1 (Qkill_forward_chars, n);
259 }
260 return Qnil;
261 }
262
263 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 2,
264 "(list (prefix-numeric-value current-prefix-arg) last-command-event)",
265 doc: /* Insert the character you type.
266 Whichever character C you type to run this command is inserted.
267 The numeric prefix argument N says how many times to repeat the insertion.
268 Before insertion, `expand-abbrev' is executed if the inserted character does
269 not have word syntax and the previous character in the buffer does.
270 After insertion, `internal-auto-fill' is called if
271 `auto-fill-function' is non-nil and if the `auto-fill-chars' table has
272 a non-nil value for the inserted character. At the end, it runs
273 `post-self-insert-hook'. */)
274 (Lisp_Object n, Lisp_Object c)
275 {
276 CHECK_FIXNUM (n);
277
278 /* Backward compatibility. */
279 if (NILP (c))
280 c = last_command_event;
281
282 if (XFIXNUM (n) < 0)
283 error ("Negative repetition argument %"pI"d", XFIXNUM (n));
284
285 if (XFIXNAT (n) < 2)
286 call0 (Qundo_auto_amalgamate);
287
288 /* Barf if the key that invoked this was not a character. */
289 if (!CHARACTERP (c))
290 bitch_at_user ();
291 else {
292 int character = translate_char (Vtranslation_table_for_input,
293 XFIXNUM (c));
294 int val = internal_self_insert (character, XFIXNAT (n));
295 if (val == 2)
296 Fset (Qundo_auto__this_command_amalgamating, Qnil);
297 frame_make_pointer_invisible (SELECTED_FRAME ());
298 }
299
300 return Qnil;
301 }
302
303 /* Insert N times character C
304
305 If this insertion is suitable for direct output (completely simple),
306 return 0. A value of 1 indicates this *might* not have been simple.
307 A value of 2 means this did things that call for an undo boundary. */
308
309 static int
310 internal_self_insert (int c, EMACS_INT n)
311 {
312 int hairy = 0;
313 Lisp_Object tem;
314 register enum syntaxcode synt;
315 Lisp_Object overwrite;
316 /* Length of multi-byte form of C. */
317 int len;
318 /* Working buffer and pointer for multi-byte form of C. */
319 unsigned char str[MAX_MULTIBYTE_LENGTH];
320 ptrdiff_t chars_to_delete = 0;
321 ptrdiff_t spaces_to_insert = 0;
322
323 overwrite = BVAR (current_buffer, overwrite_mode);
324 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
325 hairy = 1;
326
327 /* At first, get multi-byte form of C in STR. */
328 if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
329 {
330 len = CHAR_STRING (c, str);
331 if (len == 1)
332 /* If C has modifier bits, this makes C an appropriate
333 one-byte char. */
334 c = *str;
335 }
336 else
337 {
338 str[0] = SINGLE_BYTE_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
339 len = 1;
340 }
341 if (!NILP (overwrite)
342 && PT < ZV)
343 {
344 /* In overwrite-mode, we substitute a character at point (C2,
345 hereafter) by C. For that, we delete C2 in advance. But,
346 just substituting C2 by C may move a remaining text in the
347 line to the right or to the left, which is not preferable.
348 So we insert more spaces or delete more characters in the
349 following cases: if C is narrower than C2, after deleting C2,
350 we fill columns with spaces, if C is wider than C2, we delete
351 C2 and several characters following C2. */
352
353 /* This is the character after point. */
354 int c2 = FETCH_CHAR (PT_BYTE);
355
356 int cwidth;
357
358 /* Overwriting in binary-mode always replaces C2 by C.
359 Overwriting in textual-mode doesn't always do that.
360 It inserts newlines in the usual way,
361 and inserts any character at end of line
362 or before a tab if it doesn't use the whole width of the tab. */
363 if (EQ (overwrite, Qoverwrite_mode_binary))
364 chars_to_delete = min (n, PTRDIFF_MAX);
365 else if (c != '\n' && c2 != '\n'
366 && (cwidth = XFIXNAT (Fchar_width (make_fixnum (c)))) != 0)
367 {
368 ptrdiff_t pos = PT;
369 ptrdiff_t pos_byte = PT_BYTE;
370 ptrdiff_t curcol = current_column ();
371
372 if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
373 {
374 /* Column the cursor should be placed at after this insertion.
375 The value should be calculated only when necessary. */
376 ptrdiff_t target_clm = curcol + n * cwidth;
377
378 /* The actual cursor position after the trial of moving
379 to column TARGET_CLM. It is greater than TARGET_CLM
380 if the TARGET_CLM is middle of multi-column
381 character. In that case, the new point is set after
382 that character. */
383 ptrdiff_t actual_clm
384 = XFIXNAT (Fmove_to_column (make_fixnum (target_clm), Qnil));
385
386 chars_to_delete = PT - pos;
387
388 if (actual_clm > target_clm)
389 {
390 /* We will delete too many columns. Let's fill columns
391 by spaces so that the remaining text won't move. */
392 ptrdiff_t actual = PT_BYTE;
393 actual -= prev_char_len (actual);
394 if (FETCH_BYTE (actual) == '\t')
395 /* Rather than add spaces, let's just keep the tab. */
396 chars_to_delete--;
397 else
398 spaces_to_insert = actual_clm - target_clm;
399 }
400
401 SET_PT_BOTH (pos, pos_byte);
402 }
403 }
404 hairy = 2;
405 }
406
407 synt = SYNTAX (c);
408
409 if (!NILP (BVAR (current_buffer, abbrev_mode))
410 && synt != Sword
411 && NILP (BVAR (current_buffer, read_only))
412 && PT > BEGV
413 && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
414 ? XFIXNAT (Fprevious_char ())
415 : UNIBYTE_TO_CHAR (XFIXNAT (Fprevious_char ())))
416 == Sword))
417 {
418 modiff_count modiff = MODIFF;
419 Lisp_Object sym;
420
421 sym = call0 (Qexpand_abbrev);
422
423 /* If we expanded an abbrev which has a hook,
424 and the hook has a non-nil `no-self-insert' property,
425 return right away--don't really self-insert. */
426 if (SYMBOLP (sym) && ! NILP (sym)
427 && ! NILP (XSYMBOL (sym)->u.s.function)
428 && SYMBOLP (XSYMBOL (sym)->u.s.function))
429 {
430 Lisp_Object prop;
431 prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert"));
432 if (! NILP (prop))
433 return 1;
434 }
435
436 if (MODIFF != modiff)
437 hairy = 2;
438 }
439
440 if (chars_to_delete)
441 {
442 int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
443 && SINGLE_BYTE_CHAR_P (c))
444 ? UNIBYTE_TO_CHAR (c) : c);
445 Lisp_Object string = Fmake_string (make_fixnum (n), make_fixnum (mc),
446 Qnil);
447
448 if (spaces_to_insert)
449 {
450 tem = Fmake_string (make_fixnum (spaces_to_insert),
451 make_fixnum (' '), Qnil);
452 string = concat2 (string, tem);
453 }
454
455 ptrdiff_t to;
456 if (ckd_add (&to, PT, chars_to_delete))
457 to = PTRDIFF_MAX;
458 replace_range (PT, to, string, 1, 1, 1, 0, false);
459 Fforward_char (make_fixnum (n));
460 }
461 else if (n > 1)
462 {
463 USE_SAFE_ALLOCA;
464 char *strn, *p;
465 SAFE_NALLOCA (strn, len, n);
466 for (p = strn; n > 0; n--, p += len)
467 memcpy (p, str, len);
468 insert_and_inherit (strn, p - strn);
469 SAFE_FREE ();
470 }
471 else if (n > 0)
472 insert_and_inherit ((char *) str, len);
473
474 if ((CHAR_TABLE_P (Vauto_fill_chars)
475 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
476 : (c == ' ' || c == '\n'))
477 && !NILP (BVAR (current_buffer, auto_fill_function)))
478 {
479 Lisp_Object auto_fill_result;
480
481 if (c == '\n')
482 /* After inserting a newline, move to previous line and fill
483 that. Must have the newline in place already so filling and
484 justification, if any, know where the end is going to be. */
485 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
486 auto_fill_result = call0 (Qinternal_auto_fill);
487 /* Test PT < ZV in case the auto-fill-function is strange. */
488 if (c == '\n' && PT < ZV)
489 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
490 if (!NILP (auto_fill_result))
491 hairy = 2;
492 }
493
494 /* Run hooks for electric keys. */
495 run_hook (Qpost_self_insert_hook);
496
497 return hairy;
498 }
499
500 /* module initialization */
501
502 void
503 syms_of_cmds (void)
504 {
505 DEFSYM (Qinternal_auto_fill, "internal-auto-fill");
506
507 DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
508 DEFSYM (Qundo_auto__this_command_amalgamating,
509 "undo-auto--this-command-amalgamating");
510
511 DEFSYM (Qkill_forward_chars, "kill-forward-chars");
512
513 /* A possible value for a buffer's overwrite-mode variable. */
514 DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary");
515
516 DEFSYM (Qexpand_abbrev, "expand-abbrev");
517 DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook");
518
519 DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook,
520 doc: /* Hook run at the end of `self-insert-command'.
521 This is run after inserting a character.
522 The hook can access the inserted character via `last-command-event'. */);
523 Vpost_self_insert_hook = Qnil;
524
525 defsubr (&Sforward_char);
526 defsubr (&Sbackward_char);
527 defsubr (&Sforward_line);
528 defsubr (&Sbeginning_of_line);
529 defsubr (&Send_of_line);
530
531 defsubr (&Sdelete_char);
532 defsubr (&Sself_insert_command);
533 }