|
|
1.1 root 1: /* Simple built-in editing commands.
2: Copyright (C) 1985 Richard M. Stallman.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include "config.h"
23: #include "lisp.h"
24: #include "commands.h"
25: #include "buffer.h"
26: #include "syntax.h"
27:
28: Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_hook;
29:
30:
31: DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
32: "Move point right ARG characters (left if ARG negative).\n\
33: On reaching end of buffer, stop and signal error.")
34: (n)
35: Lisp_Object n;
36: {
37: if (NULL (n))
38: XFASTINT (n) = 1;
39: else
40: CHECK_NUMBER (n, 0);
41:
42: SetPoint (point + XINT (n));
43: if (point < FirstCharacter)
44: {
45: SetPoint (FirstCharacter);
46: Fsignal (Qbeginning_of_buffer, Qnil);
47: }
48: if (point > NumCharacters + 1)
49: {
50: SetPoint (NumCharacters + 1);
51: Fsignal (Qend_of_buffer, Qnil);
52: }
53: return Qnil;
54: }
55:
56: DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
57: "Move point left ARG characters (right if ARG negative).\n\
58: On reaching end of buffer, stop and signal error.")
59: (n)
60: Lisp_Object n;
61: {
62: if (NULL (n))
63: XFASTINT (n) = 1;
64: else
65: CHECK_NUMBER (n, 0);
66:
67: XSETINT (n, - XINT (n));
68: return Fforward_char (n);
69: }
70:
71: DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
72: "Move point forward past ARG newlines.\n\
73: If ARG is zero, position after previous newline.\n\
74: If ARG is negative, position after -ARG'th newline before that one.\n\
75: If scan reaches end of buffer, stop there without error;\n\
76: value is count of lines left to move.")
77: (n)
78: Lisp_Object n;
79: {
80: register int pos = point;
81: register int count, stop;
82:
83: if (NULL (n))
84: count = 1;
85: else
86: {
87: CHECK_NUMBER (n, 0);
88: count = XINT (n);
89: }
90:
91: stop = FirstCharacter;
92: if (count <= 0)
93: {
94: while (pos > stop && CharAt (pos - 1) != '\n')
95: pos--;
96: }
97: while (count < 0 && pos > stop)
98: {
99: count++;
100: pos--;
101: /* In this loop, pos is one less than the position of scan. */
102: while (--pos >= stop && CharAt (pos) != '\n');
103: pos++;
104: }
105: stop = NumCharacters;
106: while (count > 0 && pos <= stop)
107: {
108: count--;
109: pos--;
110: /* In this loop, pos is one less than the position of scan. */
111: while (++pos < stop && CharAt (pos) != '\n');
112: pos++;
113: }
114: SetPoint (pos);
115: return make_number (count);
116: }
117:
118: DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
119: 0, 1, "p",
120: "Move point to beginning of current line.\n\
121: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
122: If scan reaches end of buffer, stop there without error.")
123: (n)
124: Lisp_Object n;
125: {
126: if (NULL (n))
127: XFASTINT (n) = 1;
128: else
129: CHECK_NUMBER (n, 0);
130:
131: Fforward_line (make_number (XINT (n) - 1));
132: return Qnil;
133: }
134:
135: DEFUN ("end-of-line", Fend_of_line, Send_of_line,
136: 0, 1, "p",
137: "Move point to end of current line.\n\
138: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
139: If scan reaches end of buffer, stop there without error.")
140: (n)
141: Lisp_Object n;
142: {
143: register int pos;
144: register int stop;
145:
146: if (NULL (n))
147: XFASTINT (n) = 1;
148: else
149: CHECK_NUMBER (n, 0);
150:
151: if (XINT (n) != 1)
152: Fforward_line (make_number (XINT (n) - 1));
153:
154: pos = point;
155: stop = NumCharacters + 1;
156: while (pos < stop && CharAt (pos) != '\n') pos++;
157: SetPoint (pos);
158:
159: return Qnil;
160: }
161:
162: DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
163: "Delete the following ARG characters (previous, with negative arg).\n\
164: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
165: Interactively, ARG is the prefix arg, and kill if ARG was explicitly specd.")
166: (n, killflag)
167: Lisp_Object n, killflag;
168: {
169: CHECK_NUMBER (n, 0);
170:
171: if (NULL (killflag))
172: {
173: if (XINT (n) < 0)
174: {
175: if (point + XINT (n) < FirstCharacter)
176: Fsignal (Qbeginning_of_buffer, Qnil);
177: else
178: del_range (point + XINT (n), point);
179: }
180: else
181: {
182: if (point + XINT (n) > NumCharacters + 1)
183: Fsignal (Qend_of_buffer, Qnil);
184: else
185: del_range (point, point + XINT (n));
186: }
187: }
188: else
189: {
190: call1 (Qkill_forward_chars, n);
191: }
192: return Qnil;
193: }
194:
195: DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
196: 1, 2, "p\nP",
197: "Delete the previous ARG characters (following, with negative ARG).\n\
198: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
199: Interactively, ARG is the prefix arg, and kill if ARG was explicitly specd.")
200: (n, killflag)
201: Lisp_Object n, killflag;
202: {
203: CHECK_NUMBER (n, 0);
204: return Fdelete_char (make_number (-XINT (n)), killflag);
205: }
206:
207: DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
208: "Insert this character.")
209: (arg)
210: Lisp_Object arg;
211: {
212: CHECK_NUMBER (arg, 0);
213: if (XINT (arg) == 0
214: && last_command_char == ' '
215: && !NULL (bf_cur->auto_fill_hook)
216: && !NULL (bf_cur->read_only)
217: && current_column () > XFASTINT (bf_cur->fill_column))
218: Fapply (bf_cur->auto_fill_hook, Qnil);
219:
220: while (XINT (arg) > 0)
221: {
222: SelfInsert (last_command_char);
223: XFASTINT (arg)--; /* Ok since old and new vals both nonneg */
224: }
225: return Qnil;
226: }
227:
228: DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
229: "Insert a newline. With arg, insert that many newlines.\n\
230: In Auto Fill mode, can break the preceding line if no numeric arg.")
231: (arg1)
232: Lisp_Object arg1;
233: {
234: int flag;
235: Lisp_Object arg;
236:
237: arg = Fprefix_numeric_value (arg1);
238:
239: if (!NULL (bf_cur->read_only))
240: Fsignal (Qbuffer_read_only, Qnil);
241:
242: if (NULL (arg1)
243: && !NULL (bf_cur->auto_fill_hook)
244: && current_column () > XFASTINT (bf_cur->fill_column))
245: Fapply (bf_cur->auto_fill_hook, Qnil);
246:
247: flag = point > FirstCharacter && CharAt (point - 1) == '\n';
248: if (flag) PointLeft (1);
249:
250: while (XINT (arg) > 0)
251: {
252: SelfInsert ('\n');
253: XFASTINT (arg)--; /* Ok since old and new vals both nonneg */
254: }
255:
256: if (flag) PointRight (1);
257:
258: return Qnil;
259: }
260:
261: SelfInsert (c1)
262: char c1;
263: {
264: extern Lisp_Object Fexpand_abbrev ();
265: int hairy = 0;
266: Lisp_Object tem;
267: register enum syntaxcode synt;
268: register int c = c1;
269:
270: if (!NULL (bf_cur->overwrite_mode)
271: && point <= NumCharacters
272: && c != '\n' && CharAt (point) != '\n'
273: && (CharAt (point) != '\t'
274: || XINT (bf_cur->tab_width) <= 0
275: || !((current_column () + 1) % XFASTINT (bf_cur->tab_width))))
276: {
277: del_range (point, point + 1);
278: hairy = 1;
279: }
280: if (!NULL (bf_cur->abbrev_mode)
281: && SYNTAX (c) != Sword
282: && NULL (bf_cur->read_only)
283: && point > FirstCharacter && SYNTAX (CharAt (point - 1)) == Sword)
284: {
285: tem = Fexpand_abbrev ();
286: if (!NULL (tem))
287: hairy = 1;
288: }
289: if ((c == ' ' || c == '\n')
290: && !NULL (bf_cur->auto_fill_hook)
291: && current_column () > XFASTINT (bf_cur->fill_column))
292: {
293: InsCStr (&c1, 1);
294: Fapply (bf_cur->auto_fill_hook, Qnil);
295: hairy = 1;
296: }
297: else
298: InsCStr (&c1, 1);
299: synt = SYNTAX (c);
300: if ((synt == Sclose || synt == Smath)
301: && !NULL (Vblink_paren_hook) && INTERACTIVE)
302: {
303: Fapply (Vblink_paren_hook, Qnil);
304: hairy = 1;
305: }
306: return hairy;
307: }
308:
309: /* module initialization */
310:
311: syms_of_cmds ()
312: {
313: Qkill_backward_chars = intern ("kill-backward-chars");
314: staticpro (&Qkill_backward_chars);
315:
316: Qkill_forward_chars = intern ("kill-forward-chars");
317: staticpro (&Qkill_forward_chars);
318:
319: DefLispVar ("blink-paren-hook", &Vblink_paren_hook,
320: "Function called, if non-nil, whenever a char with closeparen syntax is self-inserted.");
321: Vblink_paren_hook = Qnil;
322:
323: defsubr (&Sforward_char);
324: defsubr (&Sbackward_char);
325: defsubr (&Sforward_line);
326: defsubr (&Sbeginning_of_line);
327: defsubr (&Send_of_line);
328:
329: defsubr (&Sdelete_char);
330: defsubr (&Sdelete_backward_char);
331:
332: defsubr (&Sself_insert_command);
333: defsubr (&Snewline);
334: }
335:
336: keys_of_cmds ()
337: {
338: int n;
339:
340: defkey (GlobalMap, Ctl('M'), "newline");
341: defkey (GlobalMap, Ctl('I'), "self-insert-command");
342: for (n = 040; n < 0177; n++)
343: defkey (GlobalMap, n, "self-insert-command");
344:
345: defkey (GlobalMap, Ctl ('A'), "beginning-of-line");
346: defkey (GlobalMap, Ctl ('B'), "backward-char");
347: defkey (GlobalMap, Ctl ('D'), "delete-char");
348: defkey (GlobalMap, Ctl ('E'), "end-of-line");
349: defkey (GlobalMap, Ctl ('F'), "forward-char");
350: defkey (GlobalMap, 0177, "delete-backward-char");
351: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.