/* Simple built-in editing commands.
   Copyright (C) 1985, 1993, 1994 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, 675 Mass Ave, Cambridge, MA 02139, 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 <handa@etl.go.jp> */
/* 92.3.6   modified for Mule Ver.0.9.0 by K.Handa <handa@etl.go.jp> */
/* 92.4.1   modified for Mule Ver.0.9.2 by K.Handa <handa@etl.go.jp>
	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 <sanewo@pdp.crl.sony.co.jp>
	In self_insert_internal(), declaration of str[3] changed. */
/* 92.11.30 modified for Mule Ver.0.9.7 by K.Handa <handa@etl.go.jp>
	In self_insert_internal(), bug of overwrite-mode fixed. */

#include <config.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "syntax.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;


DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  "Move point right ARG characters (left if ARG negative).\n\
On reaching end of buffer, stop and signal error.")
  (n)
     Lisp_Object n;
{
  if (NILP (n))
    XFASTINT (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))
    XFASTINT (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 ARG characters (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))
    XFASTINT (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))
    XFASTINT (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 ARG lines forward (backward if ARG is negative).\n\
Precisely, if point is on line I, move to the start of line I + ARG.\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 ARG - number of lines moved; if backward, ARG + number moved.\n\
With positive ARG, 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, 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 ARG not nil or 1, move forward ARG - 1 lines first.\n\
If scan reaches end of buffer, stop there without error.")
  (n)
     Lisp_Object n;
{
  if (NILP (n))
    XFASTINT (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 ARG not nil or 1, move forward ARG - 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))
    XFASTINT (n) = 1;
  else
    CHECK_NUMBER (n, 0);

  if (XINT (n) != 1)
    Fforward_line (make_number (XINT (n) - 1));

  pos = point;
  stop = ZV;
  while (pos < stop && FETCH_CHAR (pos) != '\n') pos++;
  SET_PT (pos);

  return Qnil;
}

DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  "Delete the following ARG characters (previous, with negative arg).\n\
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
ARG 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 ARG characters (following, with negative ARG).\n\
Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
ARG was explicitly specified.")
  (n, killflag)
     Lisp_Object n, killflag;
{
  CHECK_NUMBER (n, 0);
  return Fdelete_char (make_number (-XINT (n)), killflag);
}

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.")
  (arg)
     Lisp_Object arg;
{
  CHECK_NUMBER (arg, 0);

  /* Barf if the key that invoked this was not a character.  */
  if (XTYPE (last_command_char) != Lisp_Int)
    bitch_at_user ();
  else
    while (XINT (arg) > 0)
      {
	XFASTINT (arg)--;	/* Ok since old and new vals both nonneg */
	internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0);
      }

  return Qnil;
}

DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  "Insert a newline.  With arg, insert that many newlines.\n\
In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
  (arg1)
     Lisp_Object arg1;
{
  int flag;
  Lisp_Object arg;
  char c1 = '\n';

  arg = Fprefix_numeric_value (arg1);

  if (!NILP (current_buffer->read_only))
    Fbarf_if_buffer_read_only ();

  /* Inserting a newline at the end of a line produces better
     redisplay in try_window_id than inserting at the beginning of a
     line, and the textual result is the same.  So, if we're at
     beginning of line, pretend to be at the end of the previous line.  

     We can't use internal_self_insert in that case since it won't do
     the insertion correctly.  Luckily, internal_self_insert's special
     features all do nothing in that case.  */

  flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
#ifdef USE_TEXT_PROPERTIES
  /* We cannot use this optimization if properties change
     in the vicinity.
     ??? We need to check for change hook properties, etc.  */
  if (flag)
    if (! (point - 1 > BEGV && ! property_change_between_p (point - 2, point)))
      flag = 0;
#endif

  if (flag)
    SET_PT (point - 1);

  while (XINT (arg) > 0)
    {
      if (flag)
	insert (&c1, 1);
      else
	internal_self_insert ('\n', !NILP (arg1));
      XFASTINT (arg)--;		/* Ok since old and new vals both nonneg */
    }

  if (flag)
    SET_PT (point + 1);

  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)
     int c1;			/* 92.1.16 by K.Handa */
     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("        ",  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)
      && current_column () > XFASTINT (current_buffer->fill_column))
    {
      if (c != '\n')
	insert_and_inherit (str, len);
      call0 (current_buffer->auto_fill_function);
      if (c == '\n')
	insert_and_inherit (str, len);
      hairy = 2;
    }
  else
    insert_and_inherit (str, len);
  synt = SYNTAX (c);
  if ((synt == Sclose || synt == Smath)
      && !NILP (Vblink_paren_function) && INTERACTIVE)
    {
      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 ("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 */
  defsubr (&Snewline);
}

keys_of_cmds ()
{
  int n;

  initial_define_key (global_map, Ctl('M'), "newline");
  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");
}
