/* Simple built-in editing commands. Copyright (C) 1985, 93, 94, 95, 1996 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* 87.6.10 modified by K.Handa */ /* 88.1.5 modified for Nemacs Ver.2.0 by K.Handa */ /* 90.3.2 modified for Nemacs Ver.3.3.1 by K.Handa overwrite mode for Japanese */ /* 91.10.28 modified for Nemacs Ver.4.0.0 by K.Handa */ /* 92.3.6 modified for Mule Ver.0.9.0 by K.Handa */ /* 92.4.1 modified for Mule Ver.0.9.2 by K.Handa In self_insert_internal, bug of overwrite-mode fixed. Fforward_byte and Fbackward_byte are addred. */ /* 92.10.26 modified for Mule Ver.0.9.6 by T.Saneto In self_insert_internal(), declaration of str[3] changed. */ /* 92.11.30 modified for Mule Ver.0.9.7 by K.Handa In self_insert_internal(), bug of overwrite-mode fixed. */ #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "syntax.h" #include "window.h" #include "keyboard.h" #include "charset.h" /* 91.10.28 by K.Handa */ Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; /* Non-nil means put this face on the next self-inserting character. */ Lisp_Object Vself_insert_face; /* This is the command that set up Vself_insert_face. */ Lisp_Object Vself_insert_face_command; extern Lisp_Object Qface; DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p", "Move point right N characters (left if N is negative).\n\ On reaching end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); /* This used to just set point to point + XINT (n), and then check to see if it was within boundaries. But now that SET_PT can potentially do a lot of stuff (calling entering and exiting hooks, etcetera), that's not a good approach. So we validate the proposed position, then set point. */ { int new_point = forward_point (XINT (n)); /* 91.10.28 by K.Handa */ if (new_point < BEGV) { SET_PT (BEGV); Fsignal (Qbeginning_of_buffer, Qnil); } if (new_point > ZV) { SET_PT (ZV); Fsignal (Qend_of_buffer, Qnil); } SET_PT (new_point); } return Qnil; } /* 92.4.1 by K.Handa */ DEFUN ("forward-byte", Fforward_byte, Sforward_byte, 0, 1, "p", "Move point right ARG bytes (left if ARG negative).\n\ On reaching end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); /* This used to just set point to point + XINT (n), and then check to see if it was within boundaries. But now that SET_PT can potentially do a lot of stuff (calling entering and exiting hooks, etcetera), that's not a good approach. So we validate the proposed position, then set point. */ { int new_point = point + XINT (n); if (new_point < BEGV) { SET_PT (BEGV); Fsignal (Qbeginning_of_buffer, Qnil); } if (new_point > ZV) { SET_PT (ZV); Fsignal (Qend_of_buffer, Qnil); } SET_PT (new_point); } return Qnil; } DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p", "Move point left N characters (right if N is negative).\n\ On attempt to pass beginning or end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); XSETINT (n, - XINT (n)); return Fforward_char (n); } DEFUN ("backward-byte", Fbackward_byte, Sbackward_byte, 0, 1, "p", "Move point left ARG bytes (right if ARG negative).\n\ On attempt to pass beginning or end of buffer, stop and signal error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); XSETINT (n, - XINT (n)); return Fforward_byte (n); } /* end of patch */ /* 91.10.28 by K.Handa */ int forward_point(n) int n; { int pos = point, c; if (NILP (current_buffer->mc_flag)) pos += n; else { if (n > 0) while (n--) INC_POS (pos); else while (n++) DEC_POS (pos); } return pos; } /* end of patch */ DEFUN ("point+", Fpoint_plus, Spoint_plus, 1, 1, 0, "Return the position of next ARG character.") (n) Lisp_Object n; { int pos; CHECK_NUMBER (n, 0); pos = forward_point (XINT (n)); if (pos < BEGV) pos = BEGV; else if (pos > ZV) pos = ZV; return make_number (pos); } DEFUN ("point-", Fpoint_minus, Spoint_minus, 1, 1, 0, "Return the position of previoius ARG character.") (n) Lisp_Object n; { int pos; CHECK_NUMBER (n, 0); pos = forward_point (- XINT (n)); if (pos < BEGV) pos = BEGV; else if (pos > ZV) pos = ZV; return make_number (pos); } DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p", "Move N lines forward (backward if N is negative).\n\ Precisely, if point is on line I, move to the start of line I + N.\n\ If there isn't room, go as far as possible (no error).\n\ Returns the count of lines left to move. If moving forward,\n\ that is N - number of lines moved; if backward, N + number moved.\n\ With positive N, a non-empty line at the end counts as one line\n\ successfully moved (for the return value).") (n) Lisp_Object n; { int pos2 = point; int pos; int count, shortage, negp; if (NILP (n)) count = 1; else { CHECK_NUMBER (n, 0); count = XINT (n); } negp = count <= 0; pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1); if (shortage > 0 && (negp || (ZV > BEGV && pos != pos2 && FETCH_CHAR (pos - 1) != '\n'))) shortage--; SET_PT (pos); return make_number (negp ? - shortage : shortage); } DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "p", "Move point to beginning of current line.\n\ With argument N not nil or 1, move forward N - 1 lines first.\n\ If scan reaches end of buffer, stop there without error.") (n) Lisp_Object n; { if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); Fforward_line (make_number (XINT (n) - 1)); return Qnil; } DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "p", "Move point to end of current line.\n\ With argument N not nil or 1, move forward N - 1 lines first.\n\ If scan reaches end of buffer, stop there without error.") (n) Lisp_Object n; { register int pos; register int stop; if (NILP (n)) XSETFASTINT (n, 1); else CHECK_NUMBER (n, 0); SET_PT (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0))); return Qnil; } DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP", "Delete the following N characters (previous if N is negative).\n\ Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\ Interactively, N is the prefix arg, and KILLFLAG is set if\n\ N was explicitly specified.") (n, killflag) Lisp_Object n, killflag; { int pos; /* 91.10.28 by K.Handa */ CHECK_NUMBER (n, 0); pos = forward_point (XINT (n)); /* 91.10.28 by K.Handa */ if (NILP (killflag)) { if (XINT (n) < 0) { if (pos < BEGV) /* 91.10.28 by K.Handa */ Fsignal (Qbeginning_of_buffer, Qnil); else del_range (pos, point); /* 91.10.28 by K.Handa */ } else { if (pos > ZV) /* 91.10.28 by K.Handa */ Fsignal (Qend_of_buffer, Qnil); else del_range (point, pos); /* 91.10.28 by K.Handa */ } } else { call1 (Qkill_forward_chars, n); } return Qnil; } DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char, 1, 2, "p\nP", "Delete the previous N characters (following if N is negative).\n\ Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\ Interactively, N is the prefix arg, and KILLFLAG is set if\n\ N was explicitly specified.") (n, killflag) Lisp_Object n, killflag; { Lisp_Object value; int deleted_tab = 0; int i; int deleted = 0; /* Number of columns deleted */ int pos = point; int mc_flag = !NILP (current_buffer->mc_flag); CHECK_NUMBER (n, 0); /* See if we are about to delete a tab backwards. */ for (i = 0; i < XINT (n); i++) { unsigned char c; if (pos <= BEGV) break; if (mc_flag) DEC_POS (pos); else pos--; c = FETCH_CHAR (pos); if (c == '\t') { deleted_tab = 1; break; } /* count up columns deleted. */ deleted += (mc_flag && LC_P (c)) ? char_width[c] : 1; } value = Fdelete_char (make_number (-XINT (n)), killflag); /* In overwrite mode, back over columns while clearing them out, unless at end of line. */ if (XINT (n) > 0 && ! NILP (current_buffer->overwrite_mode) && ! deleted_tab && ! (point == ZV || FETCH_CHAR (point) == '\n')) { Finsert_char (make_number (' '), deleted); SET_PT (point - XINT (n)); } return value; } DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p", "Insert the character you type.\n\ Whichever character you type to run this command is inserted.") (n) Lisp_Object n; { CHECK_NUMBER (n, 0); /* Barf if the key that invoked this was not a character. */ if (!INTEGERP (last_command_char)) bitch_at_user (); else if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode)) { XSETFASTINT (n, XFASTINT (n) - 2); /* The first one might want to expand an abbrev. */ internal_self_insert (XINT (last_command_char), 1); /* The bulk of the copies of this char can be inserted simply. We don't have to handle a user-specified face specially because it will get inherited from the first char inserted. */ Finsert_char (last_command_char, n, Qt); /* The last one might want to auto-fill. */ internal_self_insert (XINT (last_command_char), 0); } else while (XINT (n) > 0) { /* Ok since old and new vals both nonneg */ XSETFASTINT (n, XFASTINT (n) - 1); internal_self_insert (XINT (last_command_char), XFASTINT (n) != 0); } return Qnil; } /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill even if it is enabled. If this insertion is suitable for direct output (completely simple), return 0. A value of 1 indicates this *might* not have been simple. A value of 2 means this did things that call for an undo boundary. */ internal_self_insert (c1, noautofill) #ifndef MULE /* This has to be unsigned char; when it is char, some compilers sign-extend it in SYNTAX_ENTRY, despite the casts to unsigned char there. */ unsigned char c1; #else int c1; /* 92.1.16 by K.Handa */ #endif int noautofill; { /* 92.1.16 by K.Handa */ extern Lisp_Object Fexpand_abbrev (); int hairy = 0; Lisp_Object tem; register enum syntaxcode synt; register int c = c1; Lisp_Object overwrite; int pos, len; unsigned char str[4]; /* 92.10.26 by T.Saneto, 92.11.30 by K.Handa */ register unsigned char *p; overwrite = current_buffer->overwrite_mode; if (NILP (current_buffer->mc_flag)) str[0] = c1, len = 1; else len = CHARtoSTR (c1, str); if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function) || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) hairy = 1; if (!NILP (overwrite) && point < ZV) { int clm1 = current_column() + char_width[str[0]], clm2; c1 = FETCH_CHAR (point); if ((EQ (overwrite, Qoverwrite_mode_binary) || (c != '\n' && c1 != '\n')) && (EQ (overwrite, Qoverwrite_mode_binary) || c1 != '\t' || XINT (current_buffer->tab_width) <= 0 || XFASTINT (current_buffer->tab_width) > 20 || !(clm1 % XFASTINT (current_buffer->tab_width)))) { pos = point; clm2 = XFASTINT (Fmove_to_column (clm1)); del_range (pos, point); if (clm2 > clm1) { insert_and_inherit (" ", clm2 - clm1); SET_PT (pos); } hairy = 2; } } if (!NILP (current_buffer->abbrev_mode) && SYNTAX (c) != Sword && NILP (current_buffer->read_only) && point > BEGV) { pos = point; DEC_POS (pos); FETCH_MC_CHAR (c1, pos); if (SYNTAX (c1) == Sword) { int modiff = MODIFF; Fexpand_abbrev (); /* We can't trust the value of Fexpand_abbrev, but if Fexpand_abbrev changed the buffer, assume it expanded something. */ if (MODIFF != modiff) hairy = 2; } } if ((c == ' ' || c == '\n') && !noautofill && !NILP (current_buffer->auto_fill_function)) { Lisp_Object tem; insert_and_inherit (str, len); if (c == '\n') /* After inserting a newline, move to previous line and fill */ /* that. Must have the newline in place already so filling and */ /* justification, if any, know where the end is going to be. */ SET_PT (point - 1); tem = call0 (current_buffer->auto_fill_function); if (c == '\n') SET_PT (point + 1); if (!NILP (tem)) hairy = 2; } else insert_and_inherit (str, len); #ifdef HAVE_FACES /* If previous command specified a face to use, use it. */ if (!NILP (Vself_insert_face) && EQ (current_kboard->Vlast_command, Vself_insert_face_command)) { int prev = PT; Lisp_Object before, after; DEC_POS (prev); XSETINT (before, prev); XSETINT (after, PT); Fput_text_property (before, after, Qface, Vself_insert_face, Qnil); Vself_insert_face = Qnil; } #endif synt = SYNTAX (c); if ((synt == Sclose || synt == Smath) && !NILP (Vblink_paren_function) && INTERACTIVE && !noautofill) { call0 (Vblink_paren_function); hairy = 2; } return hairy; } /* 92.2.17 by K.Handa */ DEFUN ("self-insert-internal", Fself_insert_internal, Sself_insert_internal, 1, 1, 0, "Invoke self-insert-command as if CHAR is entered from keyboard.") (ch) Lisp_Object ch; { CHECK_CHARACTER (ch, 0); internal_self_insert (XFASTINT (ch), 0); return Qnil; } /* end of patch */ /* module initialization */ syms_of_cmds () { Qkill_backward_chars = intern ("kill-backward-chars"); staticpro (&Qkill_backward_chars); Qkill_forward_chars = intern ("kill-forward-chars"); staticpro (&Qkill_forward_chars); Qoverwrite_mode_binary = intern ("overwrite-mode-binary"); staticpro (&Qoverwrite_mode_binary); DEFVAR_LISP ("self-insert-face", &Vself_insert_face, "If non-nil, set the face of the next self-inserting character to this.\n\ See also `self-insert-face-command'."); Vself_insert_face = Qnil; DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command, "This is the command that set up `self-insert-face'.\n\ If `last-command' does not equal this value, we ignore `self-insert-face'."); Vself_insert_face_command = Qnil; DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, "Function called, if non-nil, whenever a close parenthesis is inserted.\n\ More precisely, a char with closeparen syntax is self-inserted."); Vblink_paren_function = Qnil; defsubr (&Sforward_char); defsubr (&Sbackward_char); defsubr (&Sforward_byte); /* 92.4.1 by K.Handa */ defsubr (&Sbackward_byte); /* 92.4.1 by K.Handa */ defsubr (&Spoint_plus); defsubr (&Spoint_minus); defsubr (&Sforward_line); defsubr (&Sbeginning_of_line); defsubr (&Send_of_line); defsubr (&Sdelete_char); defsubr (&Sdelete_backward_char); defsubr (&Sself_insert_command); defsubr (&Sself_insert_internal); /* 92.2.17 by K.Handa */ } keys_of_cmds () { int n; initial_define_key (global_map, Ctl ('I'), "self-insert-command"); for (n = 040; n < 0177; n++) initial_define_key (global_map, n, "self-insert-command"); #ifdef MSDOS for (n = 0200; n < 0240; n++) initial_define_key (global_map, n, "self-insert-command"); #endif for (n = 0240; n < 0400; n++) initial_define_key (global_map, n, "self-insert-command"); initial_define_key (global_map, Ctl ('A'), "beginning-of-line"); initial_define_key (global_map, Ctl ('B'), "backward-char"); initial_define_key (global_map, Ctl ('D'), "delete-char"); initial_define_key (global_map, Ctl ('E'), "end-of-line"); initial_define_key (global_map, Ctl ('F'), "forward-char"); initial_define_key (global_map, 0177, "delete-backward-char"); }