1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: Mule 2.0, FSF 19.30. */
27 #include "ui/insdel.h"
29 Lisp_Object Qkill_forward_chars;
30 Lisp_Object Qself_insert_command;
31 Lisp_Object Qno_self_insert;
33 Lisp_Object Vblink_paren_function;
35 /* A possible value for a buffer's overwrite-mode variable. */
36 Lisp_Object Qoverwrite_mode_binary;
38 /* Non-nil means put this face on the next self-inserting character. */
39 Lisp_Object Vself_insert_face;
41 /* This is the command that set up Vself_insert_face. */
42 Lisp_Object Vself_insert_face_command;
44 /* A char-table for characters which may invoke auto-filling. */
45 Lisp_Object Vauto_fill_chars;
47 DEFUN("forward-char", Fforward_char, 0, 2, "_p", /*
48 Move point right COUNT characters (left if COUNT is negative).
49 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
50 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
51 On reaching end of buffer, stop and signal error.
53 The characters that are moved over may be added to the current selection
54 \(i.e. active region) if the Shift key is held down, a motion key is used
55 to invoke this command, and `shifted-motion-keys-select-region' is t; see
56 the documentation for this variable for more details.
60 struct buffer *buf = decode_buffer(buffer, 1);
70 /* This used to just set point to point + XINT (count), and then check
71 to see if it was within boundaries. But now that SET_PT can
72 potentially do a lot of stuff (calling entering and exiting
73 hooks, etcetera), that's not a good approach. So we validate the
74 proposed position, then set point. */
76 Bufpos new_point = BUF_PT(buf) + n;
78 if (new_point < BUF_BEGV(buf)) {
79 BUF_SET_PT(buf, BUF_BEGV(buf));
80 Fsignal(Qbeginning_of_buffer, Qnil);
83 if (new_point > BUF_ZV(buf)) {
84 BUF_SET_PT(buf, BUF_ZV(buf));
85 Fsignal(Qend_of_buffer, Qnil);
89 BUF_SET_PT(buf, new_point);
95 DEFUN("backward-char", Fbackward_char, 0, 2, "_p", /*
96 Move point left COUNT characters (right if COUNT is negative).
97 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
98 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
100 The characters that are moved over may be added to the current selection
101 \(i.e. active region) if the Shift key is held down, a motion key is used
102 to invoke this command, and `shifted-motion-keys-select-region' is t; see
103 the documentation for this variable for more details.
108 count = make_int(-1);
111 count = make_int(-XINT(count));
113 return Fforward_char(count, buffer);
116 DEFUN("forward-line", Fforward_line, 0, 2, "_p", /*
117 Move COUNT lines forward (backward if COUNT is negative).
118 Precisely, if point is on line I, move to the start of line I + COUNT.
119 If there isn't room, go as far as possible (no error).
120 Returns the count of lines left to move. If moving forward,
121 that is COUNT - number of lines moved; if backward, COUNT + number moved.
122 With positive COUNT, a non-empty line at the end counts as one line
123 successfully moved (for the return value).
124 If BUFFER is nil, the current buffer is assumed.
126 The characters that are moved over may be added to the current selection
127 \(i.e. active region) if the Shift key is held down, a motion key is used
128 to invoke this command, and `shifted-motion-keys-select-region' is t; see
129 the documentation for this variable for more details.
133 struct buffer *buf = decode_buffer(buffer, 1);
134 Bufpos pos2 = BUF_PT(buf);
136 EMACS_INT n, shortage, negp;
146 pos = scan_buffer(buf, '\n', pos2, 0, n - negp, &shortage, 1);
147 if (shortage > 0 && (negp || (BUF_ZV(buf) > BUF_BEGV(buf)
149 && BUF_FETCH_CHAR(buf, pos - 1) != '\n')))
151 BUF_SET_PT(buf, pos);
152 return make_int(negp ? -shortage : shortage);
155 DEFUN("point-at-bol", Fpoint_at_bol, 0, 2, 0, /*
156 Return the character position of the first character on the current line.
157 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
158 If scan reaches end of buffer, return that position.
159 This function does not move point.
163 struct buffer *b = decode_buffer(buffer, 1);
164 REGISTER int orig, end;
166 XSETBUFFER(buffer, b);
171 count = make_int(XINT(count) - 1);
175 Fforward_line(count, buffer);
179 return make_int(end);
182 DEFUN("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /*
183 Move point to beginning of current line.
184 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
185 If scan reaches end of buffer, stop there without error.
186 If BUFFER is nil, the current buffer is assumed.
188 The characters that are moved over may be added to the current selection
189 \(i.e. active region) if the Shift key is held down, a motion key is used
190 to invoke this command, and `shifted-motion-keys-select-region' is t; see
191 the documentation for this variable for more details.
195 struct buffer *b = decode_buffer(buffer, 1);
197 BUF_SET_PT(b, XINT(Fpoint_at_bol(count, buffer)));
201 DEFUN("point-at-eol", Fpoint_at_eol, 0, 2, 0, /*
202 Return the character position of the last character on the current line.
203 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
204 If scan reaches end of buffer, return that position.
205 This function does not move point.
209 struct buffer *buf = decode_buffer(buffer, 1);
219 return make_int(find_before_next_newline(buf, BUF_PT(buf), 0,
223 DEFUN("end-of-line", Fend_of_line, 0, 2, "_p", /*
224 Move point to end of current line.
225 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
226 If scan reaches end of buffer, stop there without error.
227 If BUFFER is nil, the current buffer is assumed.
229 The characters that are moved over may be added to the current selection
230 \(i.e. active region) if the Shift key is held down, a motion key is used
231 to invoke this command, and `shifted-motion-keys-select-region' is t; see
232 the documentation for this variable for more details.
236 struct buffer *b = decode_buffer(buffer, 1);
238 BUF_SET_PT(b, XINT(Fpoint_at_eol(count, buffer)));
242 DEFUN("delete-char", Fdelete_char, 0, 2, "*p\nP", /*
243 Delete the following COUNT characters (previous, with negative COUNT).
244 Optional second arg KILLP non-nil means kill instead (save in kill ring).
245 Interactively, COUNT is the prefix arg, and KILLP is set if
246 COUNT was explicitly specified.
250 /* This function can GC */
252 struct buffer *buf = current_buffer;
262 pos = BUF_PT(buf) + n;
265 if (pos < BUF_BEGV(buf))
266 signal_error(Qbeginning_of_buffer, Qnil);
268 buffer_delete_range(buf, pos, BUF_PT(buf), 0);
270 if (pos > BUF_ZV(buf))
271 signal_error(Qend_of_buffer, Qnil);
273 buffer_delete_range(buf, BUF_PT(buf), pos, 0);
276 call1(Qkill_forward_chars, count);
281 DEFUN("delete-backward-char", Fdelete_backward_char, 0, 2, "*p\nP", /*
282 Delete the previous COUNT characters (following, with negative COUNT).
283 Optional second arg KILLP non-nil means kill instead (save in kill ring).
284 Interactively, COUNT is the prefix arg, and KILLP is set if
285 COUNT was explicitly specified.
289 /* This function can GC */
299 return Fdelete_char(make_int(-n), killp);
302 static void internal_self_insert(Emchar ch, int noautofill);
304 DEFUN("self-insert-command", Fself_insert_command, 1, 1, "*p", /*
305 Insert the character you type.
306 Whichever character you type to run this command is inserted.
307 If a prefix arg COUNT is specified, the character is inserted COUNT times.
311 /* This function can GC */
319 if (CHAR_OR_CHAR_INTP(Vlast_command_char))
320 c = Vlast_command_char;
322 c = Fevent_to_character(Vlast_command_event, Qnil, Qnil, Qt);
326 ("Last typed character has no ASCII equivalent",
327 Fcopy_event(Vlast_command_event, Qnil));
329 CHECK_CHAR_COERCE_INT(c);
334 internal_self_insert(ch, (n != 0));
339 /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill
340 even if it is enabled.
344 If this insertion is suitable for direct output (completely simple),
345 return 0. A value of 1 indicates this *might* not have been simple.
346 A value of 2 means this did things that call for an undo boundary. */
348 static void internal_self_insert(Emchar c1, int noautofill)
350 /* This function can GC */
351 /* int hairy = 0; -- unused */
352 REGISTER enum syntaxcode synt;
354 Lisp_Object overwrite;
355 Lisp_Char_Table *syntax_table;
356 struct buffer *buf = current_buffer;
359 overwrite = buf->overwrite_mode;
360 syntax_table = XCHAR_TABLE(buf->mirror_syntax_table);
363 /* No, this is very bad, it makes undo *always* undo a character at a time
364 instead of grouping consecutive self-inserts together. Nasty nasty.
366 if (!NILP(Vbefore_change_functions) || !NILP(Vafter_change_functions)
367 || !NILP(Vbefore_change_function) || !NILP(Vafter_change_function))
372 && BUF_PT(buf) < BUF_ZV(buf)
373 && (EQ(overwrite, Qoverwrite_mode_binary)
374 || (c1 != '\n' && BUF_FETCH_CHAR(buf, BUF_PT(buf)) != '\n'))
375 && (EQ(overwrite, Qoverwrite_mode_binary)
376 || BUF_FETCH_CHAR(buf, BUF_PT(buf)) != '\t'
377 || ((tab_width = XINT(buf->tab_width), tab_width <= 0)
379 || !((current_column(buf) + 1) % tab_width)))) {
380 buffer_delete_range(buf, BUF_PT(buf), BUF_PT(buf) + 1, 0);
384 if (!NILP(buf->abbrev_mode)
385 && !WORD_SYNTAX_P(syntax_table, c1)
386 && NILP(buf->read_only)
387 && BUF_PT(buf) > BUF_BEGV(buf)) {
388 c2 = BUF_FETCH_CHAR(buf, BUF_PT(buf) - 1);
390 if (WORD_SYNTAX_P(syntax_table, c2)) {
394 Lisp_Object sym = Fexpand_abbrev();
396 /* I think this is too bogus to add. The function should
397 have a way of examining the character to be inserted, so
398 it can decide whether to insert it or not. We should
399 design it better than that. */
401 /* Here FSFmacs remembers MODIFF, compares it after
402 Fexpand_abbrev() finishes, and updates HAIRY. */
404 /* NOTE: we cannot simply check for Vlast_abbrev, because
405 Fexpand_abbrev() can bail out before setting it to
406 anything meaningful, leaving us stuck with an old value.
407 Thus Fexpand_abbrev() was extended to return the actual
410 && !NILP(symbol_function(XSYMBOL(sym)))
411 && SYMBOLP(symbol_function(XSYMBOL(sym)))) {
413 Fget(symbol_function(XSYMBOL(sym)),
414 Qno_self_insert, Qnil);
421 if ((CHAR_TABLEP(Vauto_fill_chars)
422 ? !NILP(XCHAR_TABLE_VALUE_UNSAFE(Vauto_fill_chars, c1))
423 : (c1 == ' ' || c1 == '\n'))
424 && !noautofill && !NILP(buf->auto_fill_function)) {
425 buffer_insert_emacs_char(buf, c1);
427 /* After inserting a newline, move to previous line and fill */
428 /* that. Must have the newline in place already so filling and */
429 /* justification, if any, know where the end is going to be. */
430 BUF_SET_PT(buf, BUF_PT(buf) - 1);
431 call0(buf->auto_fill_function);
433 BUF_SET_PT(buf, BUF_PT(buf) + 1);
436 buffer_insert_emacs_char(buf, c1);
438 /* If previous command specified a face to use, use it. */
439 if (!NILP(Vself_insert_face)
440 && EQ(Vlast_command, Vself_insert_face_command)) {
441 Lisp_Object before = make_int(BUF_PT(buf) - 1);
442 Lisp_Object after = make_int(BUF_PT(buf));
443 Fput_text_property(before, after, Qface, Vself_insert_face,
445 Fput_text_property(before, after, Qstart_open, Qt, Qnil);
446 Fput_text_property(before, after, Qend_open, Qnil, Qnil);
447 /* #### FSFmacs properties are normally closed ("sticky") on the
448 end but not the beginning. It's the opposite for us. */
449 Vself_insert_face = Qnil;
451 synt = SYNTAX(syntax_table, c1);
452 if ((synt == Sclose || synt == Smath)
453 && !NILP(Vblink_paren_function) && INTERACTIVE && !noautofill) {
454 call0(Vblink_paren_function);
461 /* (this comes from Mule but is a generally good idea) */
463 DEFUN("self-insert-internal", Fself_insert_internal, 1, 1, 0, /*
464 Invoke `self-insert-command' as if CHARACTER is entered from keyboard.
468 /* This function can GC */
469 CHECK_CHAR_COERCE_INT(character);
470 internal_self_insert(XCHAR(character), 0);
474 /* module initialization */
476 void syms_of_cmds(void)
478 defsymbol(&Qkill_forward_chars, "kill-forward-chars");
479 defsymbol(&Qself_insert_command, "self-insert-command");
480 defsymbol(&Qoverwrite_mode_binary, "overwrite-mode-binary");
481 defsymbol(&Qno_self_insert, "no-self-insert");
483 DEFSUBR(Fforward_char);
484 DEFSUBR(Fbackward_char);
485 DEFSUBR(Fforward_line);
486 DEFSUBR(Fbeginning_of_line);
487 DEFSUBR(Fend_of_line);
489 DEFSUBR(Fpoint_at_bol);
490 DEFSUBR(Fpoint_at_eol);
492 DEFSUBR(Fdelete_char);
493 DEFSUBR(Fdelete_backward_char);
495 DEFSUBR(Fself_insert_command);
496 DEFSUBR(Fself_insert_internal);
499 void vars_of_cmds(void)
501 DEFVAR_LISP("self-insert-face", &Vself_insert_face /*
502 If non-nil, set the face of the next self-inserting character to this.
503 See also `self-insert-face-command'.
505 Vself_insert_face = Qnil;
507 DEFVAR_LISP("self-insert-face-command", &Vself_insert_face_command /*
508 This is the command that set up `self-insert-face'.
509 If `last-command' does not equal this value, we ignore `self-insert-face'.
511 Vself_insert_face_command = Qnil;
513 DEFVAR_LISP("blink-paren-function", &Vblink_paren_function /*
514 Function called, if non-nil, whenever a close parenthesis is inserted.
515 More precisely, a char with closeparen syntax is self-inserted.
517 Vblink_paren_function = Qnil;
519 DEFVAR_LISP("auto-fill-chars", &Vauto_fill_chars /*
520 A char-table for characters which invoke auto-filling.
521 Such characters have value t in this table.
523 Vauto_fill_chars = Fmake_char_table(Qgeneric);
524 XCHAR_TABLE(Vauto_fill_chars)->ascii[' '] = Qt;
525 XCHAR_TABLE(Vauto_fill_chars)->ascii['\n'] = Qt;