]> code.delx.au - gnu-emacs/blob - src/cmds.c
Remove extern declarations from .c files, and them to .h files.
[gnu-emacs] / src / cmds.c
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
4 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
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.
12
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.
17
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/>. */
20
21
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"
34
35 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
36
37 /* A possible value for a buffer's overwrite-mode variable. */
38 Lisp_Object Qoverwrite_mode_binary;
39
40 /* Non-nil means put this face on the next self-inserting character. */
41 Lisp_Object Vself_insert_face;
42
43 /* This is the command that set up Vself_insert_face. */
44 Lisp_Object Vself_insert_face_command;
45
46 static int internal_self_insert (int, int);
47 \f
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 (Lisp_Object n)
51 {
52 CHECK_NUMBER (n);
53
54 return make_number (PT + XINT (n));
55 }
56
57 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
58 doc: /* Move point N characters forward (backward if N is negative).
59 On reaching end or beginning of buffer, stop and signal error.
60
61 Depending on the bidirectional context, the movement may be to the
62 right or to the left on the screen. This is in contrast with
63 \\[right-char], which see. */)
64 (Lisp_Object n)
65 {
66 if (NILP (n))
67 XSETFASTINT (n, 1);
68 else
69 CHECK_NUMBER (n);
70
71 /* This used to just set point to point + XINT (n), and then check
72 to see if it was within boundaries. But now that SET_PT can
73 potentially do a lot of stuff (calling entering and exiting
74 hooks, etcetera), that's not a good approach. So we validate the
75 proposed position, then set point. */
76 {
77 int new_point = PT + XINT (n);
78
79 if (new_point < BEGV)
80 {
81 SET_PT (BEGV);
82 xsignal0 (Qbeginning_of_buffer);
83 }
84 if (new_point > ZV)
85 {
86 SET_PT (ZV);
87 xsignal0 (Qend_of_buffer);
88 }
89
90 SET_PT (new_point);
91 }
92
93 return Qnil;
94 }
95
96 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
97 doc: /* Move point N characters backward (forward if N is negative).
98 On attempt to pass beginning or end of buffer, stop and signal error.
99
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)
104 {
105 if (NILP (n))
106 XSETFASTINT (n, 1);
107 else
108 CHECK_NUMBER (n);
109
110 XSETINT (n, - XINT (n));
111 return Fforward_char (n);
112 }
113
114 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
115 doc: /* Move N lines forward (backward if N is negative).
116 Precisely, if point is on line I, move to the start of line I + N.
117 If there isn't room, go as far as possible (no error).
118 Returns the count of lines left to move. If moving forward,
119 that is N - number of lines moved; if backward, N + number moved.
120 With positive N, a non-empty line at the end counts as one line
121 successfully moved (for the return value). */)
122 (Lisp_Object n)
123 {
124 int opoint = PT, opoint_byte = PT_BYTE;
125 int pos, pos_byte;
126 int count, shortage;
127
128 if (NILP (n))
129 count = 1;
130 else
131 {
132 CHECK_NUMBER (n);
133 count = XINT (n);
134 }
135
136 if (count <= 0)
137 shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
138 else
139 shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1);
140
141 /* Since scan_newline does TEMP_SET_PT_BOTH,
142 and we want to set PT "for real",
143 go back to the old point and then come back here. */
144 pos = PT;
145 pos_byte = PT_BYTE;
146 TEMP_SET_PT_BOTH (opoint, opoint_byte);
147 SET_PT_BOTH (pos, pos_byte);
148
149 if (shortage > 0
150 && (count <= 0
151 || (ZV > BEGV
152 && PT != opoint
153 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
154 shortage--;
155
156 return make_number (count <= 0 ? - shortage : shortage);
157 }
158
159 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
160 doc: /* Move point to beginning of current line.
161 With argument N not nil or 1, move forward N - 1 lines first.
162 If point reaches the beginning or end of buffer, it stops there.
163
164 This function constrains point to the current field unless this moves
165 point to a different line than the original, unconstrained result.
166 If N is nil or 1, and a front-sticky field starts at point, the point
167 does not move. To ignore field boundaries bind
168 `inhibit-field-text-motion' to t, or use the `forward-line' function
169 instead. For instance, `(forward-line 0)' does the same thing as
170 `(beginning-of-line)', except that it ignores field boundaries. */)
171 (Lisp_Object n)
172 {
173 if (NILP (n))
174 XSETFASTINT (n, 1);
175 else
176 CHECK_NUMBER (n);
177
178 SET_PT (XINT (Fline_beginning_position (n)));
179
180 return Qnil;
181 }
182
183 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
184 doc: /* Move point to end of current line.
185 With argument N not nil or 1, move forward N - 1 lines first.
186 If point reaches the beginning or end of buffer, it stops there.
187 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
188
189 This function constrains point to the current field unless this moves
190 point to a different line than the original, unconstrained result. If
191 N is nil or 1, and a rear-sticky field ends at point, the point does
192 not move. To ignore field boundaries bind `inhibit-field-text-motion'
193 to t. */)
194 (Lisp_Object n)
195 {
196 int newpos;
197
198 if (NILP (n))
199 XSETFASTINT (n, 1);
200 else
201 CHECK_NUMBER (n);
202
203 while (1)
204 {
205 newpos = XINT (Fline_end_position (n));
206 SET_PT (newpos);
207
208 if (PT > newpos
209 && FETCH_CHAR (PT - 1) == '\n')
210 {
211 /* If we skipped over a newline that follows
212 an invisible intangible run,
213 move back to the last tangible position
214 within the line. */
215
216 SET_PT (PT - 1);
217 break;
218 }
219 else if (PT > newpos && PT < ZV
220 && FETCH_CHAR (PT) != '\n')
221 /* If we skipped something intangible
222 and now we're not really at eol,
223 keep going. */
224 n = make_number (1);
225 else
226 break;
227 }
228
229 return Qnil;
230 }
231
232 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
233 doc: /* Delete the following N characters (previous if N is negative).
234 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
235 Interactively, N is the prefix arg, and KILLFLAG is set if
236 N was explicitly specified.
237
238 The command `delete-forward' is preferable for interactive use. */)
239 (Lisp_Object n, Lisp_Object killflag)
240 {
241 int pos;
242
243 CHECK_NUMBER (n);
244
245 pos = PT + XINT (n);
246 if (NILP (killflag))
247 {
248 if (XINT (n) < 0)
249 {
250 if (pos < BEGV)
251 xsignal0 (Qbeginning_of_buffer);
252 else
253 del_range (pos, PT);
254 }
255 else
256 {
257 if (pos > ZV)
258 xsignal0 (Qend_of_buffer);
259 else
260 del_range (PT, pos);
261 }
262 }
263 else
264 {
265 call1 (Qkill_forward_chars, n);
266 }
267 return Qnil;
268 }
269
270 static int nonundocount;
271
272 /* Note that there's code in command_loop_1 which typically avoids
273 calling this. */
274 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
275 doc: /* Insert the character you type.
276 Whichever character you type to run this command is inserted.
277 Before insertion, `expand-abbrev' is executed if the inserted character does
278 not have word syntax and the previous character in the buffer does.
279 After insertion, the value of `auto-fill-function' is called if the
280 `auto-fill-chars' table has a non-nil value for the inserted character. */)
281 (Lisp_Object n)
282 {
283 int remove_boundary = 1;
284 CHECK_NUMBER (n);
285
286 if (!EQ (Vthis_command, current_kboard->Vlast_command))
287 nonundocount = 0;
288
289 if (NILP (Vexecuting_kbd_macro)
290 && !EQ (minibuf_window, selected_window))
291 {
292 if (nonundocount <= 0 || nonundocount >= 20)
293 {
294 remove_boundary = 0;
295 nonundocount = 0;
296 }
297 nonundocount++;
298 }
299
300 if (remove_boundary
301 && CONSP (current_buffer->undo_list)
302 && NILP (XCAR (current_buffer->undo_list)))
303 /* Remove the undo_boundary that was just pushed. */
304 current_buffer->undo_list = XCDR (current_buffer->undo_list);
305
306 /* Barf if the key that invoked this was not a character. */
307 if (!CHARACTERP (last_command_event))
308 bitch_at_user ();
309 {
310 int character = translate_char (Vtranslation_table_for_input,
311 XINT (last_command_event));
312 if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
313 {
314 XSETFASTINT (n, XFASTINT (n) - 2);
315 /* The first one might want to expand an abbrev. */
316 internal_self_insert (character, 1);
317 /* The bulk of the copies of this char can be inserted simply.
318 We don't have to handle a user-specified face specially
319 because it will get inherited from the first char inserted. */
320 Finsert_char (make_number (character), n, Qt);
321 /* The last one might want to auto-fill. */
322 internal_self_insert (character, 0);
323 }
324 else
325 while (XINT (n) > 0)
326 {
327 int val;
328 /* Ok since old and new vals both nonneg */
329 XSETFASTINT (n, XFASTINT (n) - 1);
330 val = internal_self_insert (character, XFASTINT (n) != 0);
331 if (val == 2)
332 nonundocount = 0;
333 frame_make_pointer_invisible ();
334 }
335 }
336
337 return Qnil;
338 }
339
340 /* Insert character C. If NOAUTOFILL is nonzero, don't do autofill
341 even if it is enabled.
342
343 If this insertion is suitable for direct output (completely simple),
344 return 0. A value of 1 indicates this *might* not have been simple.
345 A value of 2 means this did things that call for an undo boundary. */
346
347 static Lisp_Object Qexpand_abbrev;
348
349 static int
350 internal_self_insert (int c, int noautofill)
351 {
352 int hairy = 0;
353 Lisp_Object tem;
354 register enum syntaxcode synt;
355 Lisp_Object overwrite, string;
356 /* Length of multi-byte form of C. */
357 int len;
358 /* Working buffer and pointer for multi-byte form of C. */
359 unsigned char str[MAX_MULTIBYTE_LENGTH];
360 int chars_to_delete = 0;
361 int spaces_to_insert = 0;
362
363 overwrite = current_buffer->overwrite_mode;
364 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
365 hairy = 1;
366
367 /* At first, get multi-byte form of C in STR. */
368 if (!NILP (current_buffer->enable_multibyte_characters))
369 {
370 len = CHAR_STRING (c, str);
371 if (len == 1)
372 /* If C has modifier bits, this makes C an appropriate
373 one-byte char. */
374 c = *str;
375 }
376 else
377 {
378 str[0] = (SINGLE_BYTE_CHAR_P (c)
379 ? c
380 : multibyte_char_to_unibyte (c, Qnil));
381 len = 1;
382 }
383 if (!NILP (overwrite)
384 && PT < ZV)
385 {
386 /* In overwrite-mode, we substitute a character at point (C2,
387 hereafter) by C. For that, we delete C2 in advance. But,
388 just substituting C2 by C may move a remaining text in the
389 line to the right or to the left, which is not preferable.
390 So we insert more spaces or delete more characters in the
391 following cases: if C is narrower than C2, after deleting C2,
392 we fill columns with spaces, if C is wider than C2, we delete
393 C2 and several characters following C2. */
394
395 /* This is the character after point. */
396 int c2 = FETCH_CHAR (PT_BYTE);
397
398 /* Column the cursor should be placed at after this insertion.
399 The correct value should be calculated only when necessary. */
400 int target_clm = 0;
401
402 /* Overwriting in binary-mode always replaces C2 by C.
403 Overwriting in textual-mode doesn't always do that.
404 It inserts newlines in the usual way,
405 and inserts any character at end of line
406 or before a tab if it doesn't use the whole width of the tab. */
407 if (EQ (overwrite, Qoverwrite_mode_binary)
408 || (c != '\n'
409 && c2 != '\n'
410 && ! (c2 == '\t'
411 && XINT (current_buffer->tab_width) > 0
412 && XFASTINT (current_buffer->tab_width) < 20
413 && (target_clm = ((int) current_column () /* iftc */
414 + XINT (Fchar_width (make_number (c)))),
415 target_clm % XFASTINT (current_buffer->tab_width)))))
416 {
417 int pos = PT;
418 int pos_byte = PT_BYTE;
419
420 if (target_clm == 0)
421 chars_to_delete = 1;
422 else
423 {
424 /* The actual cursor position after the trial of moving
425 to column TARGET_CLM. It is greater than TARGET_CLM
426 if the TARGET_CLM is middle of multi-column
427 character. In that case, the new point is set after
428 that character. */
429 int actual_clm
430 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
431
432 chars_to_delete = PT - pos;
433
434 if (actual_clm > target_clm)
435 {
436 /* We will delete too many columns. Let's fill columns
437 by spaces so that the remaining text won't move. */
438 spaces_to_insert = actual_clm - target_clm;
439 }
440 }
441 SET_PT_BOTH (pos, pos_byte);
442 hairy = 2;
443 }
444 hairy = 2;
445 }
446
447 synt = SYNTAX (c);
448
449 if (!NILP (current_buffer->abbrev_mode)
450 && synt != Sword
451 && NILP (current_buffer->read_only)
452 && PT > BEGV
453 && (!NILP (current_buffer->enable_multibyte_characters)
454 ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
455 : (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
456 == Sword)))
457 {
458 int modiff = MODIFF;
459 Lisp_Object sym;
460
461 sym = call0 (Qexpand_abbrev);
462
463 /* If we expanded an abbrev which has a hook,
464 and the hook has a non-nil `no-self-insert' property,
465 return right away--don't really self-insert. */
466 if (SYMBOLP (sym) && ! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
467 && SYMBOLP (XSYMBOL (sym)->function))
468 {
469 Lisp_Object prop;
470 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
471 if (! NILP (prop))
472 return 1;
473 }
474
475 if (MODIFF != modiff)
476 hairy = 2;
477 }
478
479 if (chars_to_delete)
480 {
481 string = make_string_from_bytes (str, 1, len);
482 if (spaces_to_insert)
483 {
484 tem = Fmake_string (make_number (spaces_to_insert),
485 make_number (' '));
486 string = concat2 (tem, string);
487 }
488
489 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
490 Fforward_char (make_number (1 + spaces_to_insert));
491 }
492 else
493 insert_and_inherit (str, len);
494
495 if ((CHAR_TABLE_P (Vauto_fill_chars)
496 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
497 : (c == ' ' || c == '\n'))
498 && !noautofill
499 && !NILP (current_buffer->auto_fill_function))
500 {
501 Lisp_Object tem;
502
503 if (c == '\n')
504 /* After inserting a newline, move to previous line and fill
505 that. Must have the newline in place already so filling and
506 justification, if any, know where the end is going to be. */
507 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
508 tem = call0 (current_buffer->auto_fill_function);
509 /* Test PT < ZV in case the auto-fill-function is strange. */
510 if (c == '\n' && PT < ZV)
511 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
512 if (!NILP (tem))
513 hairy = 2;
514 }
515
516 /* If previous command specified a face to use, use it. */
517 if (!NILP (Vself_insert_face)
518 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
519 {
520 Fput_text_property (make_number (PT - 1), make_number (PT),
521 Qface, Vself_insert_face, Qnil);
522 Vself_insert_face = Qnil;
523 }
524
525 if ((synt == Sclose || synt == Smath)
526 && !NILP (Vblink_paren_function) && INTERACTIVE
527 && !noautofill)
528 {
529 call0 (Vblink_paren_function);
530 hairy = 2;
531 }
532 return hairy;
533 }
534 \f
535 /* module initialization */
536
537 void
538 syms_of_cmds (void)
539 {
540 Qkill_backward_chars = intern_c_string ("kill-backward-chars");
541 staticpro (&Qkill_backward_chars);
542
543 Qkill_forward_chars = intern_c_string ("kill-forward-chars");
544 staticpro (&Qkill_forward_chars);
545
546 Qoverwrite_mode_binary = intern_c_string ("overwrite-mode-binary");
547 staticpro (&Qoverwrite_mode_binary);
548
549 Qexpand_abbrev = intern_c_string ("expand-abbrev");
550 staticpro (&Qexpand_abbrev);
551
552 DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
553 doc: /* If non-nil, set the face of the next self-inserting character to this.
554 See also `self-insert-face-command'. */);
555 Vself_insert_face = Qnil;
556
557 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
558 doc: /* This is the command that set up `self-insert-face'.
559 If `last-command' does not equal this value, we ignore `self-insert-face'. */);
560 Vself_insert_face_command = Qnil;
561
562 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
563 doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
564 More precisely, a char with closeparen syntax is self-inserted. */);
565 Vblink_paren_function = Qnil;
566
567 defsubr (&Sforward_point);
568 defsubr (&Sforward_char);
569 defsubr (&Sbackward_char);
570 defsubr (&Sforward_line);
571 defsubr (&Sbeginning_of_line);
572 defsubr (&Send_of_line);
573
574 defsubr (&Sdelete_char);
575 defsubr (&Sself_insert_command);
576 }
577
578 void
579 keys_of_cmds (void)
580 {
581 int n;
582
583 nonundocount = 0;
584 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
585 for (n = 040; n < 0177; n++)
586 initial_define_key (global_map, n, "self-insert-command");
587 #ifdef MSDOS
588 for (n = 0200; n < 0240; n++)
589 initial_define_key (global_map, n, "self-insert-command");
590 #endif
591 for (n = 0240; n < 0400; n++)
592 initial_define_key (global_map, n, "self-insert-command");
593
594 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
595 initial_define_key (global_map, Ctl ('B'), "backward-char");
596 initial_define_key (global_map, Ctl ('E'), "end-of-line");
597 initial_define_key (global_map, Ctl ('F'), "forward-char");
598 }
599
600 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
601 (do not change this comment) */