![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cmds.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to cmds.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 1: /* Simple built-in editing commands.
2: Copyright (C) 1985, 1990 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is free software; you can redistribute it and/or modify
7: it under the terms of the GNU General Public License as published by
8: the Free Software Foundation; either version 1, or (at your option)
9: any later version.
10:
11: GNU Emacs is distributed in the hope that it will be useful,
12: but WITHOUT ANY WARRANTY; without even the implied warranty of
13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: GNU General Public License for more details.
15:
16: You should have received a copy of the GNU General Public License
17: along with GNU Emacs; see the file COPYING. If not, write to
18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include "lisp.h"
23: #include "commands.h"
24: #include "buffer.h"
25: #include "syntax.h"
26:
27: Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_hook;
28:
29:
30: DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
31: "Move point right ARG characters (left if ARG negative).\n\
32: On reaching end of buffer, stop and signal error.")
33: (n)
34: Lisp_Object n;
35: {
36: if (NULL (n))
37: XFASTINT (n) = 1;
38: else
39: CHECK_NUMBER (n, 0);
40:
41: SET_PT (point + XINT (n));
42: if (point < BEGV)
43: {
44: SET_PT (BEGV);
45: Fsignal (Qbeginning_of_buffer, Qnil);
46: }
47: if (point > ZV)
48: {
49: SET_PT (ZV);
50: Fsignal (Qend_of_buffer, Qnil);
51: }
52: return Qnil;
53: }
54:
55: DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
56: "Move point left ARG characters (right if ARG negative).\n\
57: On attempt to pass beginning or end of buffer, stop and signal error.")
58: (n)
59: Lisp_Object n;
60: {
61: if (NULL (n))
62: XFASTINT (n) = 1;
63: else
64: CHECK_NUMBER (n, 0);
65:
66: XSETINT (n, - XINT (n));
67: return Fforward_char (n);
68: }
69:
70: DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
71: "If point is on line i, move to the start of line i + ARG.\n\
72: If there isn't room, go as far as possible (no error).\n\
73: Returns the count of lines left to move.\n\
74: With positive ARG, a non-empty line traversed at end of buffer \n\
75: counts as one line successfully moved (for the return value).")
76: (n)
77: Lisp_Object n;
78: {
79: int pos2 = point;
80: int pos;
81: int count, shortage, negp;
82:
83: if (NULL (n))
84: count = 1;
85: else
86: {
87: CHECK_NUMBER (n, 0);
88: count = XINT (n);
89: }
90:
91: negp = count <= 0;
92: pos = scan_buffer ('\n', pos2, count - negp, &shortage);
93: if (shortage > 0
94: && (negp
95: || (ZV > BEGV && pos != pos2
96: && FETCH_CHAR (pos - 1) != '\n')))
97: shortage--;
98: SET_PT (pos);
99: return make_number (negp ? - shortage : shortage);
100: }
101:
102: DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
103: 0, 1, "p",
104: "Move point to beginning of current line.\n\
105: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
106: If scan reaches end of buffer, stop there without error.")
107: (n)
108: Lisp_Object n;
109: {
110: if (NULL (n))
111: XFASTINT (n) = 1;
112: else
113: CHECK_NUMBER (n, 0);
114:
115: Fforward_line (make_number (XINT (n) - 1));
116: return Qnil;
117: }
118:
119: DEFUN ("end-of-line", Fend_of_line, Send_of_line,
120: 0, 1, "p",
121: "Move point to end of current line.\n\
122: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
123: If scan reaches end of buffer, stop there without error.")
124: (n)
125: Lisp_Object n;
126: {
127: register int pos;
128: register int stop;
129:
130: if (NULL (n))
131: XFASTINT (n) = 1;
132: else
133: CHECK_NUMBER (n, 0);
134:
135: if (XINT (n) != 1)
136: Fforward_line (make_number (XINT (n) - 1));
137:
138: pos = point;
139: stop = ZV;
140: while (pos < stop && FETCH_CHAR (pos) != '\n') pos++;
141: SET_PT (pos);
142:
143: return Qnil;
144: }
145:
146: DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
147: "Delete the following ARG characters (previous, with negative arg).\n\
148: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
149: Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
150: ARG was explicitly specified.")
151: (n, killflag)
152: Lisp_Object n, killflag;
153: {
154: CHECK_NUMBER (n, 0);
155:
156: if (NULL (killflag))
157: {
158: if (XINT (n) < 0)
159: {
160: if (point + XINT (n) < BEGV)
161: Fsignal (Qbeginning_of_buffer, Qnil);
162: else
163: del_range (point + XINT (n), point);
164: }
165: else
166: {
167: if (point + XINT (n) > ZV)
168: Fsignal (Qend_of_buffer, Qnil);
169: else
170: del_range (point, point + XINT (n));
171: }
172: }
173: else
174: {
175: call1 (Qkill_forward_chars, n);
176: }
177: return Qnil;
178: }
179:
180: DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
181: 1, 2, "p\nP",
182: "Delete the previous ARG characters (following, with negative ARG).\n\
183: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
184: Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
185: ARG was explicitly specified.")
186: (n, killflag)
187: Lisp_Object n, killflag;
188: {
189: CHECK_NUMBER (n, 0);
190: return Fdelete_char (make_number (-XINT (n)), killflag);
191: }
192:
193: DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
194: "Insert this character. Prefix arg is repeat-count.")
195: (arg)
196: Lisp_Object arg;
197: {
198: CHECK_NUMBER (arg, 0);
199:
200: while (XINT (arg) > 0)
201: {
202: XFASTINT (arg)--; /* Ok since old and new vals both nonneg */
203: self_insert_internal (last_command_char, XFASTINT (arg) != 0);
204: }
205: return Qnil;
206: }
207:
208: DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
209: "Insert a newline. With arg, insert that many newlines.\n\
210: In Auto Fill mode, can break the preceding line if no numeric arg.")
211: (arg1)
212: Lisp_Object arg1;
213: {
214: int flag;
215: Lisp_Object arg;
216: char c1 = '\n';
217:
218: arg = Fprefix_numeric_value (arg1);
219:
220: if (!NULL (current_buffer->read_only))
221: Fsignal (Qbuffer_read_only, Qnil);
222:
223: /* Inserting a newline at the end of a line
224: produces better redisplay in try_window_id
225: than inserting at the ebginning fo a line,
226: And the textual result is the same.
227: So if at beginning, pretend to be at the end.
228: Must avoid self_insert_internal in that case since point is wrong.
229: Luckily self_insert_internal's special features all do nothing in that case. */
230:
231: flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
232: if (flag)
233: SET_PT (point - 1);
234:
235: while (XINT (arg) > 0)
236: {
237: if (flag)
238: insert (&c1, 1);
239: else
240: self_insert_internal ('\n', !NULL (arg1));
241: XFASTINT (arg)--; /* Ok since old and new vals both nonneg */
242: }
243:
244: if (flag)
245: SET_PT (point + 1);
246:
247: return Qnil;
248: }
249:
250: self_insert_internal (c1, noautofill)
251: char c1;
252: int noautofill;
253: {
254: extern Lisp_Object Fexpand_abbrev ();
255: int hairy = 0;
256: Lisp_Object tem;
257: register enum syntaxcode synt;
258: register int c = c1;
259:
260: if (!NULL (current_buffer->overwrite_mode)
261: && point < ZV
262: && c != '\n' && FETCH_CHAR (point) != '\n'
263: && (FETCH_CHAR (point) != '\t'
264: || XINT (current_buffer->tab_width) <= 0
265: || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
266: {
267: del_range (point, point + 1);
268: hairy = 1;
269: }
270: if (!NULL (current_buffer->abbrev_mode)
271: && SYNTAX (c) != Sword
272: && NULL (current_buffer->read_only)
273: && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
274: {
275: tem = Fexpand_abbrev ();
276: if (!NULL (tem))
277: hairy = 1;
278: }
279: if ((c == ' ' || c == '\n')
280: && !noautofill
281: && !NULL (current_buffer->auto_fill_hook)
282: && current_column () > XFASTINT (current_buffer->fill_column))
283: {
284: if (c1 != '\n')
285: insert (&c1, 1);
286: call0 (current_buffer->auto_fill_hook);
287: if (c1 == '\n')
288: insert (&c1, 1);
289: hairy = 1;
290: }
291: else
292: insert (&c1, 1);
293: synt = SYNTAX (c);
294: if ((synt == Sclose || synt == Smath)
295: && !NULL (Vblink_paren_hook) && FROM_KBD)
296: {
297: call0 (Vblink_paren_hook);
298: hairy = 1;
299: }
300: return hairy;
301: }
302:
303: /* module initialization */
304:
305: syms_of_cmds ()
306: {
307: Qkill_backward_chars = intern ("kill-backward-chars");
308: staticpro (&Qkill_backward_chars);
309:
310: Qkill_forward_chars = intern ("kill-forward-chars");
311: staticpro (&Qkill_forward_chars);
312:
313: DEFVAR_LISP ("blink-paren-hook", &Vblink_paren_hook,
314: "Function called, if non-nil, whenever a char with closeparen syntax is self-inserted.");
315: Vblink_paren_hook = Qnil;
316:
317: defsubr (&Sforward_char);
318: defsubr (&Sbackward_char);
319: defsubr (&Sforward_line);
320: defsubr (&Sbeginning_of_line);
321: defsubr (&Send_of_line);
322:
323: defsubr (&Sdelete_char);
324: defsubr (&Sdelete_backward_char);
325:
326: defsubr (&Sself_insert_command);
327: defsubr (&Snewline);
328: }
329:
330: keys_of_cmds ()
331: {
332: int n;
333:
334: ndefkey (Vglobal_map, Ctl('M'), "newline");
335: ndefkey (Vglobal_map, Ctl('I'), "self-insert-command");
336: for (n = 040; n < 0177; n++)
337: ndefkey (Vglobal_map, n, "self-insert-command");
338:
339: ndefkey (Vglobal_map, Ctl ('A'), "beginning-of-line");
340: ndefkey (Vglobal_map, Ctl ('B'), "backward-char");
341: ndefkey (Vglobal_map, Ctl ('D'), "delete-char");
342: ndefkey (Vglobal_map, Ctl ('E'), "end-of-line");
343: ndefkey (Vglobal_map, Ctl ('F'), "forward-char");
344: ndefkey (Vglobal_map, 0177, "delete-backward-char");
345: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.