1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Mule 2.0, FSF 19.30. */
30 Lisp_Object Qkill_forward_chars;
31 Lisp_Object Qself_insert_command;
32 Lisp_Object Qno_self_insert;
34 Lisp_Object 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 /* A char-table for characters which may invoke auto-filling. */
46 Lisp_Object Vauto_fill_chars;
48 DEFUN ("forward-char", Fforward_char, 0, 2, "_p", /*
49 Move point right COUNT characters (left if COUNT is negative).
50 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
51 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
52 On reaching end of buffer, stop and signal error.
54 The characters that are moved over may be added to the current selection
55 \(i.e. active region) if the Shift key is held down, a motion key is used
56 to invoke this command, and `shifted-motion-keys-select-region' is t; see
57 the documentation for this variable for more details.
61 struct buffer *buf = decode_buffer (buffer, 1);
72 /* This used to just set point to point + XINT (count), and then check
73 to see if it was within boundaries. But now that SET_PT can
74 potentially do a lot of stuff (calling entering and exiting
75 hooks, etcetera), that's not a good approach. So we validate the
76 proposed position, then set point. */
78 Bufpos new_point = BUF_PT (buf) + n;
80 if (new_point < BUF_BEGV (buf))
82 BUF_SET_PT (buf, BUF_BEGV (buf));
83 Fsignal (Qbeginning_of_buffer, Qnil);
86 if (new_point > BUF_ZV (buf))
88 BUF_SET_PT (buf, BUF_ZV (buf));
89 Fsignal (Qend_of_buffer, Qnil);
93 BUF_SET_PT (buf, new_point);
99 DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /*
100 Move point left COUNT characters (right if COUNT is negative).
101 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
102 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
104 The characters that are moved over may be added to the current selection
105 \(i.e. active region) if the Shift key is held down, a motion key is used
106 to invoke this command, and `shifted-motion-keys-select-region' is t; see
107 the documentation for this variable for more details.
112 count = make_int (-1);
116 count = make_int (- XINT (count));
118 return Fforward_char (count, buffer);
121 DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /*
122 Move COUNT lines forward (backward if COUNT is negative).
123 Precisely, if point is on line I, move to the start of line I + COUNT.
124 If there isn't room, go as far as possible (no error).
125 Returns the count of lines left to move. If moving forward,
126 that is COUNT - number of lines moved; if backward, COUNT + number moved.
127 With positive COUNT, a non-empty line at the end counts as one line
128 successfully moved (for the return value).
129 If BUFFER is nil, the current buffer is assumed.
131 The characters that are moved over may be added to the current selection
132 \(i.e. active region) if the Shift key is held down, a motion key is used
133 to invoke this command, and `shifted-motion-keys-select-region' is t; see
134 the documentation for this variable for more details.
138 struct buffer *buf = decode_buffer (buffer, 1);
139 Bufpos pos2 = BUF_PT (buf);
141 EMACS_INT n, shortage, negp;
152 pos = scan_buffer (buf, '\n', pos2, 0, n - negp, &shortage, 1);
155 || (BUF_ZV (buf) > BUF_BEGV (buf)
157 && BUF_FETCH_CHAR (buf, pos - 1) != '\n')))
159 BUF_SET_PT (buf, pos);
160 return make_int (negp ? - shortage : shortage);
163 DEFUN ("point-at-bol", Fpoint_at_bol, 0, 2, 0, /*
164 Return the character position of the first character on the current line.
165 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
166 If scan reaches end of buffer, return that position.
167 This function does not move point.
171 struct buffer *b = decode_buffer (buffer, 1);
172 REGISTER int orig, end;
174 XSETBUFFER (buffer, b);
176 count = make_int (0);
180 count = make_int (XINT (count) - 1);
184 Fforward_line (count, buffer);
186 BUF_SET_PT (b, orig);
188 return make_int (end);
191 DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /*
192 Move point to beginning of current line.
193 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
194 If scan reaches end of buffer, stop there without error.
195 If BUFFER is nil, the current buffer is assumed.
197 The characters that are moved over may be added to the current selection
198 \(i.e. active region) if the Shift key is held down, a motion key is used
199 to invoke this command, and `shifted-motion-keys-select-region' is t; see
200 the documentation for this variable for more details.
204 struct buffer *b = decode_buffer (buffer, 1);
206 BUF_SET_PT (b, XINT (Fpoint_at_bol (count, buffer)));
210 DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /*
211 Return the character position of the last character on the current line.
212 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
213 If scan reaches end of buffer, return that position.
214 This function does not move point.
218 struct buffer *buf = decode_buffer (buffer, 1);
229 return make_int (find_before_next_newline (buf, BUF_PT (buf), 0,
233 DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /*
234 Move point to end of current line.
235 With argument COUNT not nil or 1, move forward COUNT - 1 lines first.
236 If scan reaches end of buffer, stop there without error.
237 If BUFFER is nil, the current buffer is assumed.
239 The characters that are moved over may be added to the current selection
240 \(i.e. active region) if the Shift key is held down, a motion key is used
241 to invoke this command, and `shifted-motion-keys-select-region' is t; see
242 the documentation for this variable for more details.
246 struct buffer *b = decode_buffer (buffer, 1);
248 BUF_SET_PT (b, XINT (Fpoint_at_eol (count, buffer)));
252 DEFUN ("delete-char", Fdelete_char, 0, 2, "*p\nP", /*
253 Delete the following COUNT characters (previous, with negative COUNT).
254 Optional second arg KILLP non-nil means kill instead (save in kill ring).
255 Interactively, COUNT is the prefix arg, and KILLP is set if
256 COUNT was explicitly specified.
260 /* This function can GC */
262 struct buffer *buf = current_buffer;
273 pos = BUF_PT (buf) + n;
278 if (pos < BUF_BEGV (buf))
279 signal_error (Qbeginning_of_buffer, Qnil);
281 buffer_delete_range (buf, pos, BUF_PT (buf), 0);
285 if (pos > BUF_ZV (buf))
286 signal_error (Qend_of_buffer, Qnil);
288 buffer_delete_range (buf, BUF_PT (buf), pos, 0);
293 call1 (Qkill_forward_chars, count);
298 DEFUN ("delete-backward-char", Fdelete_backward_char, 0, 2, "*p\nP", /*
299 Delete the previous COUNT characters (following, with negative COUNT).
300 Optional second arg KILLP non-nil means kill instead (save in kill ring).
301 Interactively, COUNT is the prefix arg, and KILLP is set if
302 COUNT was explicitly specified.
306 /* This function can GC */
317 return Fdelete_char (make_int (- n), killp);
320 static void internal_self_insert (Emchar ch, int noautofill);
322 DEFUN ("self-insert-command", Fself_insert_command, 1, 1, "*p", /*
323 Insert the character you type.
324 Whichever character you type to run this command is inserted.
325 If a prefix arg COUNT is specified, the character is inserted COUNT times.
329 /* This function can GC */
334 CHECK_NATNUM (count);
337 if (CHAR_OR_CHAR_INTP (Vlast_command_char))
338 c = Vlast_command_char;
340 c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qt);
343 signal_simple_error ("Last typed character has no ASCII equivalent",
344 Fcopy_event (Vlast_command_event, Qnil));
346 CHECK_CHAR_COERCE_INT (c);
351 internal_self_insert (ch, (n != 0));
356 /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill
357 even if it is enabled.
361 If this insertion is suitable for direct output (completely simple),
362 return 0. A value of 1 indicates this *might* not have been simple.
363 A value of 2 means this did things that call for an undo boundary. */
366 internal_self_insert (Emchar c1, int noautofill)
368 /* This function can GC */
369 /* int hairy = 0; -- unused */
370 REGISTER enum syntaxcode synt;
372 Lisp_Object overwrite;
373 Lisp_Char_Table *syntax_table;
374 struct buffer *buf = current_buffer;
377 overwrite = buf->overwrite_mode;
378 syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
381 /* No, this is very bad, it makes undo *always* undo a character at a time
382 instead of grouping consecutive self-inserts together. Nasty nasty.
384 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)
385 || !NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
389 if (!NILP (overwrite)
390 && BUF_PT (buf) < BUF_ZV (buf)
391 && (EQ (overwrite, Qoverwrite_mode_binary)
392 || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n'))
393 && (EQ (overwrite, Qoverwrite_mode_binary)
394 || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t'
395 || ((tab_width = XINT (buf->tab_width), tab_width <= 0)
397 || !((current_column (buf) + 1) % tab_width))))
399 buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0);
403 if (!NILP (buf->abbrev_mode)
404 && !WORD_SYNTAX_P (syntax_table, c1)
405 && NILP (buf->read_only)
406 && BUF_PT (buf) > BUF_BEGV (buf))
408 c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
410 if (WORD_SYNTAX_P (syntax_table, c2))
415 Lisp_Object sym = Fexpand_abbrev ();
417 /* I think this is too bogus to add. The function should
418 have a way of examining the character to be inserted, so
419 it can decide whether to insert it or not. We should
420 design it better than that. */
422 /* Here FSFmacs remembers MODIFF, compares it after
423 Fexpand_abbrev() finishes, and updates HAIRY. */
425 /* NOTE: we cannot simply check for Vlast_abbrev, because
426 Fexpand_abbrev() can bail out before setting it to
427 anything meaningful, leaving us stuck with an old value.
428 Thus Fexpand_abbrev() was extended to return the actual
431 && !NILP (symbol_function (XSYMBOL (sym)))
432 && SYMBOLP (symbol_function (XSYMBOL (sym))))
434 Lisp_Object prop = Fget (symbol_function (XSYMBOL (sym)),
435 Qno_self_insert, Qnil);
442 if ((CHAR_TABLEP (Vauto_fill_chars)
443 ? !NILP (XCHAR_TABLE_VALUE_UNSAFE (Vauto_fill_chars, c1))
444 : (c1 == ' ' || c1 == '\n'))
446 && !NILP (buf->auto_fill_function))
448 buffer_insert_emacs_char (buf, c1);
450 /* After inserting a newline, move to previous line and fill */
451 /* that. Must have the newline in place already so filling and */
452 /* justification, if any, know where the end is going to be. */
453 BUF_SET_PT (buf, BUF_PT (buf) - 1);
454 call0 (buf->auto_fill_function);
456 BUF_SET_PT (buf, BUF_PT (buf) + 1);
460 buffer_insert_emacs_char (buf, c1);
462 /* If previous command specified a face to use, use it. */
463 if (!NILP (Vself_insert_face)
464 && EQ (Vlast_command, Vself_insert_face_command))
466 Lisp_Object before = make_int (BUF_PT (buf) - 1);
467 Lisp_Object after = make_int (BUF_PT (buf));
468 Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
469 Fput_text_property (before, after, Qstart_open, Qt, Qnil);
470 Fput_text_property (before, after, Qend_open, Qnil, Qnil);
471 /* #### FSFmacs properties are normally closed ("sticky") on the
472 end but not the beginning. It's the opposite for us. */
473 Vself_insert_face = Qnil;
475 synt = SYNTAX (syntax_table, c1);
476 if ((synt == Sclose || synt == Smath)
477 && !NILP (Vblink_paren_function) && INTERACTIVE
480 call0 (Vblink_paren_function);
487 /* (this comes from Mule but is a generally good idea) */
489 DEFUN ("self-insert-internal", Fself_insert_internal, 1, 1, 0, /*
490 Invoke `self-insert-command' as if CHARACTER is entered from keyboard.
494 /* This function can GC */
495 CHECK_CHAR_COERCE_INT (character);
496 internal_self_insert (XCHAR (character), 0);
500 /* module initialization */
505 defsymbol (&Qkill_forward_chars, "kill-forward-chars");
506 defsymbol (&Qself_insert_command, "self-insert-command");
507 defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary");
508 defsymbol (&Qno_self_insert, "no-self-insert");
510 DEFSUBR (Fforward_char);
511 DEFSUBR (Fbackward_char);
512 DEFSUBR (Fforward_line);
513 DEFSUBR (Fbeginning_of_line);
514 DEFSUBR (Fend_of_line);
516 DEFSUBR (Fpoint_at_bol);
517 DEFSUBR (Fpoint_at_eol);
519 DEFSUBR (Fdelete_char);
520 DEFSUBR (Fdelete_backward_char);
522 DEFSUBR (Fself_insert_command);
523 DEFSUBR (Fself_insert_internal);
529 DEFVAR_LISP ("self-insert-face", &Vself_insert_face /*
530 If non-nil, set the face of the next self-inserting character to this.
531 See also `self-insert-face-command'.
533 Vself_insert_face = Qnil;
535 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command /*
536 This is the command that set up `self-insert-face'.
537 If `last-command' does not equal this value, we ignore `self-insert-face'.
539 Vself_insert_face_command = Qnil;
541 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function /*
542 Function called, if non-nil, whenever a close parenthesis is inserted.
543 More precisely, a char with closeparen syntax is self-inserted.
545 Vblink_paren_function = Qnil;
547 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars /*
548 A char-table for characters which invoke auto-filling.
549 Such characters have value t in this table.
551 Vauto_fill_chars = Fmake_char_table (Qgeneric);
552 XCHAR_TABLE (Vauto_fill_chars)->ascii[' '] = Qt;
553 XCHAR_TABLE (Vauto_fill_chars)->ascii['\n'] = Qt;