]> code.delx.au - gnu-emacs/blob - src/cmds.c
(echo_area_display): Use selected frame's minibuf window
[gnu-emacs] / src / cmds.c
1 /* Simple built-in editing commands.
2 Copyright (C) 1985, 1993, 1994, 1995 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 2, 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 #include "window.h"
27 #include "keyboard.h"
28
29 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
30
31 /* A possible value for a buffer's overwrite-mode variable. */
32 Lisp_Object Qoverwrite_mode_binary;
33
34 /* Non-nil means put this face on the next self-inserting character. */
35 Lisp_Object Vself_insert_face;
36
37 /* This is the command that set up Vself_insert_face. */
38 Lisp_Object Vself_insert_face_command;
39
40 extern Lisp_Object Qface;
41 \f
42 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
43 "Move point right ARG characters (left if ARG negative).\n\
44 On reaching end of buffer, stop and signal error.")
45 (n)
46 Lisp_Object n;
47 {
48 if (NILP (n))
49 XSETFASTINT (n, 1);
50 else
51 CHECK_NUMBER (n, 0);
52
53 /* This used to just set point to point + XINT (n), and then check
54 to see if it was within boundaries. But now that SET_PT can
55 potentially do a lot of stuff (calling entering and exiting
56 hooks, etcetera), that's not a good approach. So we validate the
57 proposed position, then set point. */
58 {
59 int new_point = point + XINT (n);
60
61 if (new_point < BEGV)
62 {
63 SET_PT (BEGV);
64 Fsignal (Qbeginning_of_buffer, Qnil);
65 }
66 if (new_point > ZV)
67 {
68 SET_PT (ZV);
69 Fsignal (Qend_of_buffer, Qnil);
70 }
71
72 SET_PT (new_point);
73 }
74
75 return Qnil;
76 }
77
78 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
79 "Move point left ARG characters (right if ARG negative).\n\
80 On attempt to pass beginning or end of buffer, stop and signal error.")
81 (n)
82 Lisp_Object n;
83 {
84 if (NILP (n))
85 XSETFASTINT (n, 1);
86 else
87 CHECK_NUMBER (n, 0);
88
89 XSETINT (n, - XINT (n));
90 return Fforward_char (n);
91 }
92
93 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
94 "Move ARG lines forward (backward if ARG is negative).\n\
95 Precisely, if point is on line I, move to the start of line I + ARG.\n\
96 If there isn't room, go as far as possible (no error).\n\
97 Returns the count of lines left to move. If moving forward,\n\
98 that is ARG - number of lines moved; if backward, ARG + number moved.\n\
99 With positive ARG, a non-empty line at the end counts as one line\n\
100 successfully moved (for the return value).")
101 (n)
102 Lisp_Object n;
103 {
104 int pos2 = point;
105 int pos;
106 int count, shortage, negp;
107
108 if (NILP (n))
109 count = 1;
110 else
111 {
112 CHECK_NUMBER (n, 0);
113 count = XINT (n);
114 }
115
116 negp = count <= 0;
117 pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1);
118 if (shortage > 0
119 && (negp
120 || (ZV > BEGV
121 && pos != pos2
122 && FETCH_CHAR (pos - 1) != '\n')))
123 shortage--;
124 SET_PT (pos);
125 return make_number (negp ? - shortage : shortage);
126 }
127
128 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
129 0, 1, "p",
130 "Move point to beginning of current line.\n\
131 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
132 If scan reaches end of buffer, stop there without error.")
133 (n)
134 Lisp_Object n;
135 {
136 if (NILP (n))
137 XSETFASTINT (n, 1);
138 else
139 CHECK_NUMBER (n, 0);
140
141 Fforward_line (make_number (XINT (n) - 1));
142 return Qnil;
143 }
144
145 DEFUN ("end-of-line", Fend_of_line, Send_of_line,
146 0, 1, "p",
147 "Move point to end of current line.\n\
148 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
149 If scan reaches end of buffer, stop there without error.")
150 (n)
151 Lisp_Object n;
152 {
153 register int pos;
154 register int stop;
155
156 if (NILP (n))
157 XSETFASTINT (n, 1);
158 else
159 CHECK_NUMBER (n, 0);
160
161 SET_PT (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0)));
162
163 return Qnil;
164 }
165
166 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
167 "Delete the following ARG characters (previous, with negative arg).\n\
168 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
169 Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
170 ARG was explicitly specified.")
171 (n, killflag)
172 Lisp_Object n, killflag;
173 {
174 CHECK_NUMBER (n, 0);
175
176 if (NILP (killflag))
177 {
178 if (XINT (n) < 0)
179 {
180 if (point + XINT (n) < BEGV)
181 Fsignal (Qbeginning_of_buffer, Qnil);
182 else
183 del_range (point + XINT (n), point);
184 }
185 else
186 {
187 if (point + XINT (n) > ZV)
188 Fsignal (Qend_of_buffer, Qnil);
189 else
190 del_range (point, point + XINT (n));
191 }
192 }
193 else
194 {
195 call1 (Qkill_forward_chars, n);
196 }
197 return Qnil;
198 }
199
200 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
201 1, 2, "p\nP",
202 "Delete the previous ARG characters (following, with negative ARG).\n\
203 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
204 Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
205 ARG was explicitly specified.")
206 (n, killflag)
207 Lisp_Object n, killflag;
208 {
209 CHECK_NUMBER (n, 0);
210 return Fdelete_char (make_number (-XINT (n)), killflag);
211 }
212
213 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
214 "Insert the character you type.\n\
215 Whichever character you type to run this command is inserted.")
216 (arg)
217 Lisp_Object arg;
218 {
219 CHECK_NUMBER (arg, 0);
220
221 /* Barf if the key that invoked this was not a character. */
222 if (!INTEGERP (last_command_char))
223 bitch_at_user ();
224 else
225 while (XINT (arg) > 0)
226 {
227 /* Ok since old and new vals both nonneg */
228 XSETFASTINT (arg, XFASTINT (arg) - 1);
229 internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0);
230 }
231
232 return Qnil;
233 }
234
235 /* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill
236 even if it is enabled.
237
238 If this insertion is suitable for direct output (completely simple),
239 return 0. A value of 1 indicates this *might* not have been simple.
240 A value of 2 means this did things that call for an undo boundary. */
241
242 internal_self_insert (c1, noautofill)
243 char c1;
244 int noautofill;
245 {
246 extern Lisp_Object Fexpand_abbrev ();
247 int hairy = 0;
248 Lisp_Object tem;
249 register enum syntaxcode synt;
250 register int c = c1;
251 Lisp_Object overwrite;
252
253 overwrite = current_buffer->overwrite_mode;
254 if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
255 || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
256 hairy = 1;
257
258 if (!NILP (overwrite)
259 && point < ZV
260 && (EQ (overwrite, Qoverwrite_mode_binary)
261 || (c != '\n' && FETCH_CHAR (point) != '\n'))
262 && (EQ (overwrite, Qoverwrite_mode_binary)
263 || FETCH_CHAR (point) != '\t'
264 || XINT (current_buffer->tab_width) <= 0
265 || XFASTINT (current_buffer->tab_width) > 20
266 || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
267 {
268 del_range (point, point + 1);
269 hairy = 2;
270 }
271 if (!NILP (current_buffer->abbrev_mode)
272 && SYNTAX (c) != Sword
273 && NILP (current_buffer->read_only)
274 && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
275 {
276 int modiff = MODIFF;
277 Fexpand_abbrev ();
278 /* We can't trust the value of Fexpand_abbrev,
279 but if Fexpand_abbrev changed the buffer,
280 assume it expanded something. */
281 if (MODIFF != modiff)
282 hairy = 2;
283 }
284 if ((c == ' ' || c == '\n')
285 && !noautofill
286 && !NILP (current_buffer->auto_fill_function))
287 {
288 insert_and_inherit (&c1, 1);
289 if (c1 == '\n')
290 /* After inserting a newline, move to previous line and fill */
291 /* that. Must have the newline in place already so filling and */
292 /* justification, if any, know where the end is going to be. */
293 SET_PT (point - 1);
294 call0 (current_buffer->auto_fill_function);
295 if (c1 == '\n')
296 SET_PT (point + 1);
297 hairy = 2;
298 }
299 else
300 insert_and_inherit (&c1, 1);
301
302 #ifdef HAVE_FACES
303 /* If previous command specified a face to use, use it. */
304 if (!NILP (Vself_insert_face)
305 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
306 {
307 Lisp_Object before, after;
308 XSETINT (before, PT - 1);
309 XSETINT (after, PT);
310 Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
311 Vself_insert_face = Qnil;
312 }
313 #endif
314 synt = SYNTAX (c);
315 if ((synt == Sclose || synt == Smath)
316 && !NILP (Vblink_paren_function) && INTERACTIVE)
317 {
318 call0 (Vblink_paren_function);
319 hairy = 2;
320 }
321 return hairy;
322 }
323 \f
324 /* module initialization */
325
326 syms_of_cmds ()
327 {
328 Qkill_backward_chars = intern ("kill-backward-chars");
329 staticpro (&Qkill_backward_chars);
330
331 Qkill_forward_chars = intern ("kill-forward-chars");
332 staticpro (&Qkill_forward_chars);
333
334 Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
335 staticpro (&Qoverwrite_mode_binary);
336
337 DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
338 "If non-nil, set the face of the next self-inserting character to this.\n\
339 See also `self-insert-face-command'.");
340 Vself_insert_face = Qnil;
341
342 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
343 "This is the command that set up `self-insert-face'.\n\
344 If `last-command' does not equal this value, we ignore `self-insert-face'.");
345 Vself_insert_face_command = Qnil;
346
347 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
348 "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
349 More precisely, a char with closeparen syntax is self-inserted.");
350 Vblink_paren_function = Qnil;
351
352 defsubr (&Sforward_char);
353 defsubr (&Sbackward_char);
354 defsubr (&Sforward_line);
355 defsubr (&Sbeginning_of_line);
356 defsubr (&Send_of_line);
357
358 defsubr (&Sdelete_char);
359 defsubr (&Sdelete_backward_char);
360
361 defsubr (&Sself_insert_command);
362 }
363
364 keys_of_cmds ()
365 {
366 int n;
367
368 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
369 for (n = 040; n < 0177; n++)
370 initial_define_key (global_map, n, "self-insert-command");
371 #ifdef MSDOS
372 for (n = 0200; n < 0240; n++)
373 initial_define_key (global_map, n, "self-insert-command");
374 #endif
375 for (n = 0240; n < 0400; n++)
376 initial_define_key (global_map, n, "self-insert-command");
377
378 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
379 initial_define_key (global_map, Ctl ('B'), "backward-char");
380 initial_define_key (global_map, Ctl ('D'), "delete-char");
381 initial_define_key (global_map, Ctl ('E'), "end-of-line");
382 initial_define_key (global_map, Ctl ('F'), "forward-char");
383 initial_define_key (global_map, 0177, "delete-backward-char");
384 }