*** empty log message ***
[emacs.git] / src / cmds.c
blobb989bab46eee53ce7747295160f08eeb5aae0702
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)
10 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; 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. */
23 #include <config.h>
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "charset.h"
28 #include "syntax.h"
29 #include "window.h"
30 #include "keyboard.h"
31 #include "keymap.h"
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. */)
50 (n)
51 Lisp_Object n;
53 CHECK_NUMBER (n);
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. */)
61 (n)
62 Lisp_Object n;
64 if (NILP (n))
65 XSETFASTINT (n, 1);
66 else
67 CHECK_NUMBER (n);
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);
77 if (new_point < BEGV)
79 SET_PT (BEGV);
80 Fsignal (Qbeginning_of_buffer, Qnil);
82 if (new_point > ZV)
84 SET_PT (ZV);
85 Fsignal (Qend_of_buffer, Qnil);
88 SET_PT (new_point);
91 return 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. */)
97 (n)
98 Lisp_Object n;
100 if (NILP (n))
101 XSETFASTINT (n, 1);
102 else
103 CHECK_NUMBER (n);
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). */)
118 Lisp_Object n;
120 int opoint = PT, opoint_byte = PT_BYTE;
121 int pos, pos_byte;
122 int count, shortage;
124 if (NILP (n))
125 count = 1;
126 else
128 CHECK_NUMBER (n);
129 count = XINT (n);
132 if (count <= 0)
133 shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
134 else
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. */
140 pos = PT;
141 pos_byte = PT_BYTE;
142 TEMP_SET_PT_BOTH (opoint, opoint_byte);
143 SET_PT_BOTH (pos, pos_byte);
145 if (shortage > 0
146 && (count <= 0
147 || (ZV > BEGV
148 && PT != opoint
149 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
150 shortage--;
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
166 boundaries. */)
168 Lisp_Object n;
170 if (NILP (n))
171 XSETFASTINT (n, 1);
172 else
173 CHECK_NUMBER (n);
175 SET_PT (XINT (Fline_beginning_position (n)));
177 return Qnil;
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-point-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. */)
191 Lisp_Object n;
193 int newpos;
195 if (NILP (n))
196 XSETFASTINT (n, 1);
197 else
198 CHECK_NUMBER (n);
200 while (1)
202 newpos = XINT (Fline_end_position (n));
203 SET_PT (newpos);
205 if (PT > newpos
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
211 within the line. */
213 SET_PT (PT - 1);
214 break;
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,
220 keep going. */
221 n = make_number (1);
222 else
223 break;
226 return Qnil;
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. */)
234 (n, killflag)
235 Lisp_Object n, killflag;
237 int pos;
239 CHECK_NUMBER (n);
241 pos = PT + XINT (n);
242 if (NILP (killflag))
244 if (XINT (n) < 0)
246 if (pos < BEGV)
247 Fsignal (Qbeginning_of_buffer, Qnil);
248 else
249 del_range (pos, PT);
251 else
253 if (pos > ZV)
254 Fsignal (Qend_of_buffer, Qnil);
255 else
256 del_range (PT, pos);
259 else
261 call1 (Qkill_forward_chars, n);
263 return Qnil;
266 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
267 1, 2, "p\nP",
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. */)
272 (n, killflag)
273 Lisp_Object n, killflag;
275 Lisp_Object value;
276 int deleted_special = 0;
277 int pos, pos_byte, i;
279 CHECK_NUMBER (n);
281 /* See if we are about to delete a tab or newline backwards. */
282 pos = PT;
283 pos_byte = PT_BYTE;
284 for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
286 int c;
288 DEC_BOTH (pos, pos_byte);
289 c = FETCH_BYTE (pos_byte);
290 if (c == '\t' || c == '\n')
292 deleted_special = 1;
293 break;
297 /* In overwrite mode, back over columns while clearing them out,
298 unless at end of line. */
299 if (XINT (n) > 0
300 && ! NILP (current_buffer->overwrite_mode)
301 && ! deleted_special
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);
312 else
313 value = Fdelete_char (make_number (-XINT (n)), killflag);
315 return value;
318 /* Note that there's code in command_loop_1 which typically avoids
319 calling this. */
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. */)
324 Lisp_Object n;
326 CHECK_NUMBER (n);
328 /* Barf if the key that invoked this was not a character. */
329 if (!INTEGERP (last_command_char))
330 bitch_at_user ();
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);
353 else
354 while (XINT (n) > 0)
356 /* Ok since old and new vals both nonneg */
357 XSETFASTINT (n, XFASTINT (n) - 1);
358 internal_self_insert (character, XFASTINT (n) != 0);
362 return Qnil;
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)
376 int c;
377 int noautofill;
379 int hairy = 0;
380 Lisp_Object tem;
381 register enum syntaxcode synt;
382 Lisp_Object overwrite, string;
383 /* Length of multi-byte form of C. */
384 int len;
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))
392 hairy = 1;
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);
399 if (len == 1)
400 /* If C has modifier bits, this makes C an appropriate
401 one-byte char. */
402 c = *str;
404 else
406 str[0] = (SINGLE_BYTE_CHAR_P (c)
408 : multibyte_char_to_unibyte (c, Qnil));
409 len = 1;
411 if (!NILP (overwrite)
412 && PT < ZV)
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. */
428 int target_clm = 0;
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)
436 || (c != '\n'
437 && c2 != '\n'
438 && ! (c2 == '\t'
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)))))
445 int pos = PT;
446 int pos_byte = PT_BYTE;
448 if (target_clm == 0)
449 chars_to_delete = 1;
450 else
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
456 that character. */
457 int actual_clm
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);
470 hairy = 2;
472 hairy = 2;
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)
479 int modiff = MODIFF;
480 Lisp_Object sym;
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))
490 Lisp_Object prop;
491 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
492 if (! NILP (prop))
493 return 1;
496 if (MODIFF != modiff)
497 hairy = 2;
500 if (chars_to_delete)
502 string = make_string_from_bytes (str, 1, len);
503 if (spaces_to_insert)
505 tem = Fmake_string (make_number (spaces_to_insert),
506 make_number (' '));
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));
513 else
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'))
519 && !noautofill
520 && !NILP (current_buffer->auto_fill_function))
522 Lisp_Object tem;
524 if (c == '\n')
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);
530 if (c == '\n')
531 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
532 if (!NILP (tem))
533 hairy = 2;
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;
545 synt = SYNTAX (c);
546 if ((synt == Sclose || synt == Smath)
547 && !NILP (Vblink_paren_function) && INTERACTIVE
548 && !noautofill)
550 call0 (Vblink_paren_function);
551 hairy = 2;
553 return hairy;
556 /* module initialization */
558 void
559 syms_of_cmds ()
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);
601 void
602 keys_of_cmds ()
604 int n;
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");
609 #ifdef MSDOS
610 for (n = 0200; n < 0240; n++)
611 initial_define_key (global_map, n, "self-insert-command");
612 #endif
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) */