1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 93, 94, 95, 96, 97, 1998, 2001, 02, 03
3 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 2, or (at your option)
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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
32 #include "dispextern.h"
34 Lisp_Object Qkill_forward_chars
, Qkill_backward_chars
, Vblink_paren_function
;
36 /* A possible value for a buffer's overwrite-mode variable. */
37 Lisp_Object Qoverwrite_mode_binary
;
39 /* Non-nil means put this face on the next self-inserting character. */
40 Lisp_Object Vself_insert_face
;
42 /* This is the command that set up Vself_insert_face. */
43 Lisp_Object Vself_insert_face_command
;
45 extern Lisp_Object Qface
;
46 extern Lisp_Object Vtranslation_table_for_input
;
48 DEFUN ("forward-point", Fforward_point
, Sforward_point
, 1, 1, 0,
49 doc
: /* Return buffer position N characters after (before if N negative) point. */)
55 return make_number (PT
+ XINT (n
));
58 DEFUN ("forward-char", Fforward_char
, Sforward_char
, 0, 1, "p",
59 doc
: /* Move point right N characters (left if N is negative).
60 On reaching end of buffer, stop and signal error. */)
69 /* This used to just set point to point + XINT (n), and then check
70 to see if it was within boundaries. But now that SET_PT can
71 potentially do a lot of stuff (calling entering and exiting
72 hooks, etcetera), that's not a good approach. So we validate the
73 proposed position, then set point. */
75 int new_point
= PT
+ XINT (n
);
80 Fsignal (Qbeginning_of_buffer
, Qnil
);
85 Fsignal (Qend_of_buffer
, Qnil
);
94 DEFUN ("backward-char", Fbackward_char
, Sbackward_char
, 0, 1, "p",
95 doc
: /* Move point left N characters (right if N is negative).
96 On attempt to pass beginning or end of buffer, stop and signal error. */)
105 XSETINT (n
, - XINT (n
));
106 return Fforward_char (n
);
109 DEFUN ("forward-line", Fforward_line
, Sforward_line
, 0, 1, "p",
110 doc
: /* Move N lines forward (backward if N is negative).
111 Precisely, if point is on line I, move to the start of line I + N.
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). */)
120 int opoint
= PT
, opoint_byte
= PT_BYTE
;
133 shortage
= scan_newline (PT
, PT_BYTE
, BEGV
, BEGV_BYTE
, count
- 1, 1);
135 shortage
= scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, count
, 1);
137 /* Since scan_newline does TEMP_SET_PT_BOTH,
138 and we want to set PT "for real",
139 go back to the old point and then come back here. */
142 TEMP_SET_PT_BOTH (opoint
, opoint_byte
);
143 SET_PT_BOTH (pos
, pos_byte
);
149 && (FETCH_BYTE (PT_BYTE
- 1) != '\n'))))
152 return make_number (count
<= 0 ? - shortage
: shortage
);
155 DEFUN ("beginning-of-line", Fbeginning_of_line
, Sbeginning_of_line
, 0, 1, "p",
156 doc
: /* Move point to beginning of current line.
157 With argument N not nil or 1, move forward N - 1 lines first.
158 If point reaches the beginning or end of buffer, it stops there.
160 This command does not move point across a field boundary unless doing so
161 would move beyond there to a different line; If N is nil or 1, and point
162 starts at a field boundary, point does not move. To ignore field
163 boundaries, either bind `inhibit-field-text-motion' to t, or use the
164 `forward-line' function instead. For instance, `(forward-line 0)' does
165 the same thing as `(beginning-of-line)', except that it ignores field
175 SET_PT (XINT (Fline_beginning_position (n
)));
180 DEFUN ("end-of-line", Fend_of_line
, Send_of_line
, 0, 1, "p",
181 doc
: /* Move point to end of current line.
182 With argument N not nil or 1, move forward N - 1 lines first.
183 If point reaches the beginning or end of buffer, it stops there.
184 To ignore intangibility, bind `inhibit-text-motion-hooks' to t.
186 This command does not move point across a field boundary unless doing so
187 would move beyond there to a different line; if N is nil or 1, and
188 point starts at a field boundary, point does not move. To ignore field
189 boundaries bind `inhibit-field-text-motion' to t. */)
202 newpos
= XINT (Fline_end_position (n
));
206 && FETCH_CHAR (PT
- 1) == '\n')
208 /* If we skipped over a newline that follows
209 an invisible intangible run,
210 move back to the last tangible position
216 else if (PT
> newpos
&& PT
< ZV
217 && FETCH_CHAR (PT
) != '\n')
218 /* If we skipped something intangible
219 and now we're not really at eol,
229 DEFUN ("delete-char", Fdelete_char
, Sdelete_char
, 1, 2, "p\nP",
230 doc
: /* Delete the following N characters (previous if N is negative).
231 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
232 Interactively, N is the prefix arg, and KILLFLAG is set if
233 N was explicitly specified. */)
235 Lisp_Object n
, killflag
;
247 Fsignal (Qbeginning_of_buffer
, Qnil
);
254 Fsignal (Qend_of_buffer
, Qnil
);
261 call1 (Qkill_forward_chars
, n
);
266 DEFUN ("delete-backward-char", Fdelete_backward_char
, Sdelete_backward_char
,
268 doc
: /* Delete the previous N characters (following if N is negative).
269 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
270 Interactively, N is the prefix arg, and KILLFLAG is set if
271 N was explicitly specified. */)
273 Lisp_Object n
, killflag
;
276 int deleted_special
= 0;
277 int pos
, pos_byte
, i
;
281 /* See if we are about to delete a tab or newline backwards. */
284 for (i
= 0; i
< XINT (n
) && pos_byte
> BEGV_BYTE
; i
++)
288 DEC_BOTH (pos
, pos_byte
);
289 c
= FETCH_BYTE (pos_byte
);
290 if (c
== '\t' || c
== '\n')
297 /* In overwrite mode, back over columns while clearing them out,
298 unless at end of line. */
300 && ! NILP (current_buffer
->overwrite_mode
)
302 && ! (PT
== ZV
|| FETCH_BYTE (PT_BYTE
) == '\n'))
304 int column
= (int) current_column (); /* iftc */
306 value
= Fdelete_char (make_number (-XINT (n
)), killflag
);
307 i
= column
- (int) current_column (); /* iftc */
308 Finsert_char (make_number (' '), make_number (i
), Qnil
);
309 /* Whitespace chars are ASCII chars, so we can simply subtract. */
310 SET_PT_BOTH (PT
- i
, PT_BYTE
- i
);
313 value
= Fdelete_char (make_number (-XINT (n
)), killflag
);
318 /* Note that there's code in command_loop_1 which typically avoids
320 DEFUN ("self-insert-command", Fself_insert_command
, Sself_insert_command
, 1, 1, "p",
321 doc
: /* Insert the character you type.
322 Whichever character you type to run this command is inserted. */)
328 /* Barf if the key that invoked this was not a character. */
329 if (!INTEGERP (last_command_char
))
332 int character
= translate_char (Vtranslation_table_for_input
,
333 XINT (last_command_char
), 0, 0, 0);
334 if (XINT (n
) >= 2 && NILP (current_buffer
->overwrite_mode
))
336 int modified_char
= character
;
337 /* Add the offset to the character, for Finsert_char.
338 We pass internal_self_insert the unmodified character
339 because it itself does this offsetting. */
340 if (! NILP (current_buffer
->enable_multibyte_characters
))
341 modified_char
= unibyte_char_to_multibyte (modified_char
);
343 XSETFASTINT (n
, XFASTINT (n
) - 2);
344 /* The first one might want to expand an abbrev. */
345 internal_self_insert (character
, 1);
346 /* The bulk of the copies of this char can be inserted simply.
347 We don't have to handle a user-specified face specially
348 because it will get inherited from the first char inserted. */
349 Finsert_char (make_number (modified_char
), n
, Qt
);
350 /* The last one might want to auto-fill. */
351 internal_self_insert (character
, 0);
356 /* Ok since old and new vals both nonneg */
357 XSETFASTINT (n
, XFASTINT (n
) - 1);
358 internal_self_insert (character
, XFASTINT (n
) != 0);
365 /* Insert character C. If NOAUTOFILL is nonzero, don't do autofill
366 even if it is enabled.
368 If this insertion is suitable for direct output (completely simple),
369 return 0. A value of 1 indicates this *might* not have been simple.
370 A value of 2 means this did things that call for an undo boundary. */
372 static Lisp_Object Qexpand_abbrev
;
375 internal_self_insert (c
, noautofill
)
381 register enum syntaxcode synt
;
382 Lisp_Object overwrite
, string
;
383 /* Length of multi-byte form of C. */
385 /* Working buffer and pointer for multi-byte form of C. */
386 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
387 int chars_to_delete
= 0;
388 int spaces_to_insert
= 0;
390 overwrite
= current_buffer
->overwrite_mode
;
391 if (!NILP (Vbefore_change_functions
) || !NILP (Vafter_change_functions
))
394 /* At first, get multi-byte form of C in STR. */
395 if (!NILP (current_buffer
->enable_multibyte_characters
))
397 c
= unibyte_char_to_multibyte (c
);
398 len
= CHAR_STRING (c
, str
);
400 /* If C has modifier bits, this makes C an appropriate
406 str
[0] = (SINGLE_BYTE_CHAR_P (c
)
408 : multibyte_char_to_unibyte (c
, Qnil
));
411 if (!NILP (overwrite
)
414 /* In overwrite-mode, we substitute a character at point (C2,
415 hereafter) by C. For that, we delete C2 in advance. But,
416 just substituting C2 by C may move a remaining text in the
417 line to the right or to the left, which is not preferable.
418 So we insert more spaces or delete more characters in the
419 following cases: if C is narrower than C2, after deleting C2,
420 we fill columns with spaces, if C is wider than C2, we delete
421 C2 and several characters following C2. */
423 /* This is the character after point. */
424 int c2
= FETCH_CHAR (PT_BYTE
);
426 /* Column the cursor should be placed at after this insertion.
427 The correct value should be calculated only when necessary. */
430 /* Overwriting in binary-mode always replaces C2 by C.
431 Overwriting in textual-mode doesn't always do that.
432 It inserts newlines in the usual way,
433 and inserts any character at end of line
434 or before a tab if it doesn't use the whole width of the tab. */
435 if (EQ (overwrite
, Qoverwrite_mode_binary
)
439 && XINT (current_buffer
->tab_width
) > 0
440 && XFASTINT (current_buffer
->tab_width
) < 20
441 && (target_clm
= ((int) current_column () /* iftc */
442 + XINT (Fchar_width (make_number (c
)))),
443 target_clm
% XFASTINT (current_buffer
->tab_width
)))))
446 int pos_byte
= PT_BYTE
;
452 /* The actual cursor position after the trial of moving
453 to column TARGET_CLM. It is greater than TARGET_CLM
454 if the TARGET_CLM is middle of multi-column
455 character. In that case, the new point is set after
458 = XFASTINT (Fmove_to_column (make_number (target_clm
), Qnil
));
460 chars_to_delete
= PT
- pos
;
462 if (actual_clm
> target_clm
)
464 /* We will delete too many columns. Let's fill columns
465 by spaces so that the remaining text won't move. */
466 spaces_to_insert
= actual_clm
- target_clm
;
469 SET_PT_BOTH (pos
, pos_byte
);
474 if (!NILP (current_buffer
->abbrev_mode
)
475 && SYNTAX (c
) != Sword
476 && NILP (current_buffer
->read_only
)
477 && PT
> BEGV
&& SYNTAX (XFASTINT (Fprevious_char ())) == Sword
)
482 sym
= call0 (Qexpand_abbrev
);
484 /* If we expanded an abbrev which has a hook,
485 and the hook has a non-nil `no-self-insert' property,
486 return right away--don't really self-insert. */
487 if (! NILP (sym
) && ! NILP (XSYMBOL (sym
)->function
)
488 && SYMBOLP (XSYMBOL (sym
)->function
))
491 prop
= Fget (XSYMBOL (sym
)->function
, intern ("no-self-insert"));
496 if (MODIFF
!= modiff
)
502 string
= make_string_from_bytes (str
, 1, len
);
503 if (spaces_to_insert
)
505 tem
= Fmake_string (make_number (spaces_to_insert
),
507 string
= concat2 (tem
, string
);
510 replace_range (PT
, PT
+ chars_to_delete
, string
, 1, 1, 1);
511 Fforward_char (make_number (1 + spaces_to_insert
));
514 insert_and_inherit (str
, len
);
516 if ((CHAR_TABLE_P (Vauto_fill_chars
)
517 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars
, c
))
518 : (c
== ' ' || c
== '\n'))
520 && !NILP (current_buffer
->auto_fill_function
))
525 /* After inserting a newline, move to previous line and fill
526 that. Must have the newline in place already so filling and
527 justification, if any, know where the end is going to be. */
528 SET_PT_BOTH (PT
- 1, PT_BYTE
- 1);
529 tem
= call0 (current_buffer
->auto_fill_function
);
531 SET_PT_BOTH (PT
+ 1, PT_BYTE
+ 1);
536 /* If previous command specified a face to use, use it. */
537 if (!NILP (Vself_insert_face
)
538 && EQ (current_kboard
->Vlast_command
, Vself_insert_face_command
))
540 Fput_text_property (make_number (PT
- 1), make_number (PT
),
541 Qface
, Vself_insert_face
, Qnil
);
542 Vself_insert_face
= Qnil
;
546 if ((synt
== Sclose
|| synt
== Smath
)
547 && !NILP (Vblink_paren_function
) && INTERACTIVE
550 call0 (Vblink_paren_function
);
556 /* module initialization */
561 Qkill_backward_chars
= intern ("kill-backward-chars");
562 staticpro (&Qkill_backward_chars
);
564 Qkill_forward_chars
= intern ("kill-forward-chars");
565 staticpro (&Qkill_forward_chars
);
567 Qoverwrite_mode_binary
= intern ("overwrite-mode-binary");
568 staticpro (&Qoverwrite_mode_binary
);
570 Qexpand_abbrev
= intern ("expand-abbrev");
571 staticpro (&Qexpand_abbrev
);
573 DEFVAR_LISP ("self-insert-face", &Vself_insert_face
,
574 doc
: /* If non-nil, set the face of the next self-inserting character to this.
575 See also `self-insert-face-command'. */);
576 Vself_insert_face
= Qnil
;
578 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command
,
579 doc
: /* This is the command that set up `self-insert-face'.
580 If `last-command' does not equal this value, we ignore `self-insert-face'. */);
581 Vself_insert_face_command
= Qnil
;
583 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function
,
584 doc
: /* Function called, if non-nil, whenever a close parenthesis is inserted.
585 More precisely, a char with closeparen syntax is self-inserted. */);
586 Vblink_paren_function
= Qnil
;
588 defsubr (&Sforward_point
);
589 defsubr (&Sforward_char
);
590 defsubr (&Sbackward_char
);
591 defsubr (&Sforward_line
);
592 defsubr (&Sbeginning_of_line
);
593 defsubr (&Send_of_line
);
595 defsubr (&Sdelete_char
);
596 defsubr (&Sdelete_backward_char
);
598 defsubr (&Sself_insert_command
);
606 initial_define_key (global_map
, Ctl ('I'), "self-insert-command");
607 for (n
= 040; n
< 0177; n
++)
608 initial_define_key (global_map
, n
, "self-insert-command");
610 for (n
= 0200; n
< 0240; n
++)
611 initial_define_key (global_map
, n
, "self-insert-command");
613 for (n
= 0240; n
< 0400; n
++)
614 initial_define_key (global_map
, n
, "self-insert-command");
616 initial_define_key (global_map
, Ctl ('A'), "beginning-of-line");
617 initial_define_key (global_map
, Ctl ('B'), "backward-char");
618 initial_define_key (global_map
, Ctl ('D'), "delete-char");
619 initial_define_key (global_map
, Ctl ('E'), "end-of-line");
620 initial_define_key (global_map
, Ctl ('F'), "forward-char");
621 initial_define_key (global_map
, 0177, "delete-backward-char");
624 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
625 (do not change this comment) */