This is cmds.c in view mode; [Download] [Up]
/* Simple built-in editing commands.
Copyright (C) 1985, 1992, 1993, 1994 Free Software Foundation, Inc.
This file is part of XEmacs.
XEmacs 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.
XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Synched up with: Mule 2.0, FSF 19.28. */
#include <config.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "syntax.h"
#include "insdel.h"
Lisp_Object Qkill_forward_chars;
Lisp_Object Qself_insert_command;
Lisp_Object 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, 2, "_p",
"Move point right ARG characters (left if ARG negative).\n\
On reaching end of buffer, stop and signal error.\n\
If BUFFER is nil, the current buffer is assumed.")
(arg, buffer)
Lisp_Object arg, buffer;
{
struct buffer *buf = decode_buffer (buffer, 1);
if (NILP (arg))
arg = make_number (1);
else
CHECK_INT (arg, 0);
/* This used to just set point to point + XINT (arg), 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. */
{
Bufpos new_point = BUF_PT (buf) + XINT (arg);
if (new_point < BUF_BEGV (buf))
{
BUF_SET_PT (buf, BUF_BEGV (buf));
Fsignal (Qbeginning_of_buffer, Qnil);
}
if (new_point > BUF_ZV (buf))
{
BUF_SET_PT (buf, BUF_ZV (buf));
Fsignal (Qend_of_buffer, Qnil);
}
BUF_SET_PT (buf, new_point);
}
return Qnil;
}
DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 2, "_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\
If BUFFER is nil, the current buffer is assumed.")
(arg, buffer)
Lisp_Object arg, buffer;
{
if (NILP (arg))
arg = make_number (1);
else
CHECK_INT (arg, 0);
XSETINT (arg, - XINT (arg));
return Fforward_char (arg, buffer);
}
DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 2, "_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\
If BUFFER is nil, the current buffer is assumed.")
(arg, buffer)
Lisp_Object arg, buffer;
{
struct buffer *buf = decode_buffer (buffer, 1);
Bufpos pos2 = BUF_PT (buf);
Bufpos pos;
int count, shortage, negp;
if (NILP (arg))
count = 1;
else
{
CHECK_INT (arg, 0);
count = XINT (arg);
}
negp = count <= 0;
pos = scan_buffer (buf, '\n', pos2, 0, count - negp, &shortage, 1);
if (shortage > 0
&& (negp
|| (BUF_ZV (buf) > BUF_BEGV (buf)
&& pos != pos2
&& BUF_FETCH_CHAR (buf, pos - 1) != '\n')))
shortage--;
BUF_SET_PT (buf, pos);
return make_number (negp ? - shortage : shortage);
}
DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
0, 2, "_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\
If BUFFER is nil, the current buffer is assumed.")
(arg, buffer)
Lisp_Object arg, buffer;
{
struct buffer *b = decode_buffer (buffer, 1);
XSETBUFFER (buffer, b);
if (NILP (arg))
arg = make_number (1);
else
CHECK_INT (arg, 0);
Fforward_line (make_number (XINT (arg) - 1), buffer);
return Qnil;
}
DEFUN ("end-of-line", Fend_of_line, Send_of_line,
0, 2, "_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\
If BUFFER is nil, the current buffer is assumed.")
(arg, buffer)
Lisp_Object arg, buffer;
{
REGISTER Bufpos pos;
REGISTER Bufpos stop;
struct buffer *buf = decode_buffer (buffer, 1);
XSETBUFFER (buffer, buf);
if (NILP (arg))
arg = make_number (1);
else
CHECK_INT (arg, 0);
if (XINT (arg) != 1)
Fforward_line (make_number (XINT (arg) - 1), buffer);
pos = BUF_PT (buf);
stop = BUF_ZV (buf);
while (pos < stop && BUF_FETCH_CHAR (buf, pos) != '\n') pos++;
BUF_SET_PT (buf, 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.")
(arg, killflag)
Lisp_Object arg, killflag;
{
/* This function can GC */
Bufpos pos;
struct buffer *buf = current_buffer;
CHECK_INT (arg, 0);
pos = BUF_PT (buf) + XINT (arg);
if (NILP (killflag))
{
if (XINT (arg) < 0)
{
if (pos < BUF_BEGV (buf))
signal_error (Qbeginning_of_buffer, Qnil);
else
buffer_delete_range (buf, pos, BUF_PT (buf), 0);
}
else
{
if (pos > BUF_ZV (buf))
signal_error (Qend_of_buffer, Qnil);
else
buffer_delete_range (buf, BUF_PT (buf), pos, 0);
}
}
else
{
call1 (Qkill_forward_chars, arg);
}
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.")
(arg, killflag)
Lisp_Object arg, killflag;
{
/* This function can GC */
CHECK_INT (arg, 0);
return Fdelete_char (make_number (-XINT (arg)), killflag);
}
static void internal_self_insert (Emchar ch, int noautofill);
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;
{
/* This function can GC */
int n;
Emchar ch;
Lisp_Object c;
CHECK_INT (arg, 0);
if (INTP (Vlast_command_char))
c = Vlast_command_char;
else
c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qt);
if (NILP (c))
signal_simple_error ("last typed character has no ASCII equivalent",
Fcopy_event (Vlast_command_event, Qnil));
CHECK_COERCE_CHAR (c, 0);
n = XINT (arg);
ch = XINT (c);
while (n > 0)
{
n--;
internal_self_insert (ch, (n != 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;
{
/* This function can GC */
int flag;
int arg;
char c1 = '\n';
struct buffer *buf = current_buffer;
arg = XINT (Fprefix_numeric_value (arg1));
/* !!#### review this function. */
barf_if_buffer_read_only (buf, BUF_PT (buf), -1);
/* 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 = BUF_PT (buf) > BUF_BEGV (buf) &&
BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1) == '\n';
if (flag)
BUF_SET_PT (buf, BUF_PT (buf) - 1);
while (arg > 0)
{
if (flag)
buffer_insert_c_char (current_buffer, c1);
else
internal_self_insert ('\n', !NILP (arg1));
arg--;
}
if (flag)
BUF_SET_PT (buf, BUF_PT (buf) + 1);
return Qnil;
}
/* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill
even if it is enabled.
FSF:
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. */
static void
internal_self_insert (Emchar c1, int noautofill)
{
/* This function can GC */
/* int hairy = 0; -- unused */
REGISTER enum syntaxcode synt;
REGISTER Emchar c2;
Lisp_Object overwrite;
Lisp_Object syntax_table;
struct buffer *buf = current_buffer;
overwrite = buf->overwrite_mode;
syntax_table = buf->syntax_table;
#if 0
/* No, this is very bad, it makes undo *always* undo a character at a time
instead of grouping consecutive self-inserts together. Nasty nasty.
*/
if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)
|| !NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
hairy = 1;
#endif
if (!NILP (overwrite)
&& BUF_PT (buf) < BUF_ZV (buf)
&& (EQ (overwrite, Qoverwrite_mode_binary)
|| (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n'))
&& (EQ (overwrite, Qoverwrite_mode_binary)
|| BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t'
|| XINT (buf->tab_width) <= 0
|| XINT (buf->tab_width) > 20
|| !((current_column (buf) + 1) % XINT (buf->tab_width))))
{
buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0);
/* hairy = 1; */
}
if (!NILP (buf->abbrev_mode)
&& SYNTAX (syntax_table, c1) != Sword
&& NILP (buf->read_only)
&& BUF_PT (buf) > BUF_BEGV (buf))
{
c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
if (SYNTAX (syntax_table, c2) == Sword)
{
/* int modiff = BUF_MODIFF (current_buffer); */
Fexpand_abbrev ();
/* We can't trust the value of Fexpand_abbrev,
but if Fexpand_abbrev changed the buffer,
assume it expanded something. */
/* if (BUF_MODIFF (buf) != modiff)
hairy = 2; */
}
}
if ((c1 == ' ' || c1 == '\n')
&& !noautofill
&& !NILP (buf->auto_fill_function)
&& current_column (buf) > XINT (buf->fill_column))
{
if (c1 != '\n')
buffer_insert_emacs_char (buf, c1);
call0 (buf->auto_fill_function);
if (c1 == '\n')
buffer_insert_emacs_char (buf, c1);
/* hairy = 1; */
}
else
buffer_insert_emacs_char (buf, c1);
synt = SYNTAX (syntax_table, c1);
if ((synt == Sclose || synt == Smath)
&& !NILP (Vblink_paren_function) && INTERACTIVE)
{
call0 (Vblink_paren_function);
/* hairy = 2; */
}
}
/* (this comes from Mule but is a generally good idea) */
DEFUN ("self-insert-internal", Fself_insert_internal, Sself_insert_internal,
1, 1, 0,
"Invoke `self-insert-command' as if CH is entered from keyboard.")
(ch)
Lisp_Object ch;
{
/* This function can GC */
CHECK_COERCE_CHAR (ch, 0);
internal_self_insert (XINT (ch), 0);
return Qnil;
}
/* module initialization */
void
syms_of_cmds (void)
{
defsymbol (&Qkill_forward_chars, "kill-forward-chars");
defsymbol (&Qself_insert_command, "self-insert-command");
defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary");
defsubr (&Sforward_char);
defsubr (&Sbackward_char);
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);
defsubr (&Snewline);
}
void
vars_of_cmds (void)
{
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;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.