1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
20
21
22 #include <config.h>
23 #include <setjmp.h>
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "character.h"
28 #include "syntax.h"
29 #include "window.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "dispextern.h"
33 #include "frame.h"
34
35 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
36
37
38 Lisp_Object Qoverwrite_mode_binary;
39
40
41 Lisp_Object Vself_insert_face;
42
43
44 Lisp_Object Vself_insert_face_command;
45
46 extern Lisp_Object Qface;
47 extern Lisp_Object Vtranslation_table_for_input;
48
49 DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
50 doc: )
51 (n)
52 Lisp_Object n;
53 {
54 CHECK_NUMBER (n);
55
56 return make_number (PT + XINT (n));
57 }
58
59 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
60 doc: 61 62 63 64 65 )
66 (n)
67 Lisp_Object n;
68 {
69 if (NILP (n))
70 XSETFASTINT (n, 1);
71 else
72 CHECK_NUMBER (n);
73
74 75 76 77 78
79 {
80 int new_point = PT + XINT (n);
81
82 if (new_point < BEGV)
83 {
84 SET_PT (BEGV);
85 xsignal0 (Qbeginning_of_buffer);
86 }
87 if (new_point > ZV)
88 {
89 SET_PT (ZV);
90 xsignal0 (Qend_of_buffer);
91 }
92
93 SET_PT (new_point);
94 }
95
96 return Qnil;
97 }
98
99 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
100 doc: 101 102 103 104 105 )
106 (n)
107 Lisp_Object n;
108 {
109 if (NILP (n))
110 XSETFASTINT (n, 1);
111 else
112 CHECK_NUMBER (n);
113
114 XSETINT (n, - XINT (n));
115 return Fforward_char (n);
116 }
117
118 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
119 doc: 120 121 122 123 124 125 )
126 (n)
127 Lisp_Object n;
128 {
129 int opoint = PT, opoint_byte = PT_BYTE;
130 int pos, pos_byte;
131 int count, shortage;
132
133 if (NILP (n))
134 count = 1;
135 else
136 {
137 CHECK_NUMBER (n);
138 count = XINT (n);
139 }
140
141 if (count <= 0)
142 shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1);
143 else
144 shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1);
145
146 147 148
149 pos = PT;
150 pos_byte = PT_BYTE;
151 TEMP_SET_PT_BOTH (opoint, opoint_byte);
152 SET_PT_BOTH (pos, pos_byte);
153
154 if (shortage > 0
155 && (count <= 0
156 || (ZV > BEGV
157 && PT != opoint
158 && (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
159 shortage--;
160
161 return make_number (count <= 0 ? - shortage : shortage);
162 }
163
164 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
165 doc: 166 167 168 169 170 171 172 173 174 175 )
176 (n)
177 Lisp_Object n;
178 {
179 if (NILP (n))
180 XSETFASTINT (n, 1);
181 else
182 CHECK_NUMBER (n);
183
184 SET_PT (XINT (Fline_beginning_position (n)));
185
186 return Qnil;
187 }
188
189 DEFUN ("end-of-line", Fend_of_line, Send_of_line, 0, 1, "^p",
190 doc: 191 192 193 194 195 196 197 198 199 )
200 (n)
201 Lisp_Object n;
202 {
203 int newpos;
204
205 if (NILP (n))
206 XSETFASTINT (n, 1);
207 else
208 CHECK_NUMBER (n);
209
210 while (1)
211 {
212 newpos = XINT (Fline_end_position (n));
213 SET_PT (newpos);
214
215 if (PT > newpos
216 && FETCH_CHAR (PT - 1) == '\n')
217 {
218 219 220 221
222
223 SET_PT (PT - 1);
224 break;
225 }
226 else if (PT > newpos && PT < ZV
227 && FETCH_CHAR (PT) != '\n')
228 229 230
231 n = make_number (1);
232 else
233 break;
234 }
235
236 return Qnil;
237 }
238
239 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
240 doc: 241 242 243 )
244 (n, killflag)
245 Lisp_Object n, killflag;
246 {
247 int pos;
248
249 CHECK_NUMBER (n);
250
251 pos = PT + XINT (n);
252 if (NILP (killflag))
253 {
254 if (XINT (n) < 0)
255 {
256 if (pos < BEGV)
257 xsignal0 (Qbeginning_of_buffer);
258 else
259 del_range (pos, PT);
260 }
261 else
262 {
263 if (pos > ZV)
264 xsignal0 (Qend_of_buffer);
265 else
266 del_range (PT, pos);
267 }
268 }
269 else
270 {
271 call1 (Qkill_forward_chars, n);
272 }
273 return Qnil;
274 }
275
276 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
277 1, 2, "p\nP",
278 doc: 279 280 281 282 283 )
284 (n, killflag)
285 Lisp_Object n, killflag;
286 {
287 Lisp_Object value;
288 int deleted_special = 0;
289 int pos, pos_byte, i;
290
291 CHECK_NUMBER (n);
292
293
294 pos = PT;
295 pos_byte = PT_BYTE;
296 for (i = 0; i < XINT (n) && pos_byte > BEGV_BYTE; i++)
297 {
298 int c;
299
300 DEC_BOTH (pos, pos_byte);
301 c = FETCH_BYTE (pos_byte);
302 if (c == '\t' || c == '\n')
303 {
304 deleted_special = 1;
305 break;
306 }
307 }
308
309 310
311 if (XINT (n) > 0
312 && ! NILP (current_buffer->overwrite_mode)
313 && ! deleted_special
314 && ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
315 {
316 int column = (int) current_column ();
317
318 value = Fdelete_char (make_number (-XINT (n)), killflag);
319 i = column - (int) current_column ();
320 Finsert_char (make_number (' '), make_number (i), Qnil);
321
322 SET_PT_BOTH (PT - i, PT_BYTE - i);
323 }
324 else
325 value = Fdelete_char (make_number (-XINT (n)), killflag);
326
327 return value;
328 }
329
330 static int nonundocount;
331
332 333
334 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
335 doc: 336 337 338 339 340 )
341 (n)
342 Lisp_Object n;
343 {
344 int remove_boundary = 1;
345 CHECK_NUMBER (n);
346
347 if (!EQ (Vthis_command, current_kboard->Vlast_command))
348 nonundocount = 0;
349
350 if (NILP (Vexecuting_kbd_macro)
351 && !EQ (minibuf_window, selected_window))
352 {
353 if (nonundocount <= 0 || nonundocount >= 20)
354 {
355 remove_boundary = 0;
356 nonundocount = 0;
357 }
358 nonundocount++;
359 }
360
361 if (remove_boundary
362 && CONSP (current_buffer->undo_list)
363 && NILP (XCAR (current_buffer->undo_list)))
364
365 current_buffer->undo_list = XCDR (current_buffer->undo_list);
366
367
368 if (!CHARACTERP (last_command_event))
369 bitch_at_user ();
370 {
371 int character = translate_char (Vtranslation_table_for_input,
372 XINT (last_command_event));
373 if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
374 {
375 XSETFASTINT (n, XFASTINT (n) - 2);
376
377 internal_self_insert (character, 1);
378 379 380
381 Finsert_char (make_number (character), n, Qt);
382
383 internal_self_insert (character, 0);
384 }
385 else
386 while (XINT (n) > 0)
387 {
388 int val;
389
390 XSETFASTINT (n, XFASTINT (n) - 1);
391 val = internal_self_insert (character, XFASTINT (n) != 0);
392 if (val == 2)
393 nonundocount = 0;
394 frame_make_pointer_invisible ();
395 }
396 }
397
398 return Qnil;
399 }
400
401 402 403 404 405 406
407
408 static Lisp_Object Qexpand_abbrev;
409
410 int
411 internal_self_insert (c, noautofill)
412 int c;
413 int noautofill;
414 {
415 int hairy = 0;
416 Lisp_Object tem;
417 register enum syntaxcode synt;
418 Lisp_Object overwrite, string;
419
420 int len;
421
422 unsigned char str[MAX_MULTIBYTE_LENGTH];
423 int chars_to_delete = 0;
424 int spaces_to_insert = 0;
425
426 overwrite = current_buffer->overwrite_mode;
427 if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
428 hairy = 1;
429
430
431 if (!NILP (current_buffer->enable_multibyte_characters))
432 {
433 len = CHAR_STRING (c, str);
434 if (len == 1)
435 436
437 c = *str;
438 }
439 else
440 {
441 str[0] = (SINGLE_BYTE_CHAR_P (c)
442 ? c
443 : multibyte_char_to_unibyte (c, Qnil));
444 len = 1;
445 }
446 if (!NILP (overwrite)
447 && PT < ZV)
448 {
449 450 451 452 453 454 455 456
457
458
459 int c2 = FETCH_CHAR (PT_BYTE);
460
461 462
463 int target_clm = 0;
464
465 466 467 468 469
470 if (EQ (overwrite, Qoverwrite_mode_binary)
471 || (c != '\n'
472 && c2 != '\n'
473 && ! (c2 == '\t'
474 && XINT (current_buffer->tab_width) > 0
475 && XFASTINT (current_buffer->tab_width) < 20
476 && (target_clm = ((int) current_column ()
477 + XINT (Fchar_width (make_number (c)))),
478 target_clm % XFASTINT (current_buffer->tab_width)))))
479 {
480 int pos = PT;
481 int pos_byte = PT_BYTE;
482
483 if (target_clm == 0)
484 chars_to_delete = 1;
485 else
486 {
487 488 489 490 491
492 int actual_clm
493 = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
494
495 chars_to_delete = PT - pos;
496
497 if (actual_clm > target_clm)
498 {
499 500
501 spaces_to_insert = actual_clm - target_clm;
502 }
503 }
504 SET_PT_BOTH (pos, pos_byte);
505 hairy = 2;
506 }
507 hairy = 2;
508 }
509
510 synt = SYNTAX (c);
511
512 if (!NILP (current_buffer->abbrev_mode)
513 && synt != Sword
514 && NILP (current_buffer->read_only)
515 && PT > BEGV
516 && (!NILP (current_buffer->enable_multibyte_characters)
517 ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
518 : (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
519 == Sword)))
520 {
521 int modiff = MODIFF;
522 Lisp_Object sym;
523
524 sym = call0 (Qexpand_abbrev);
525
526 527 528
529 if (SYMBOLP (sym) && ! NILP (sym) && ! NILP (XSYMBOL (sym)->function)
530 && SYMBOLP (XSYMBOL (sym)->function))
531 {
532 Lisp_Object prop;
533 prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
534 if (! NILP (prop))
535 return 1;
536 }
537
538 if (MODIFF != modiff)
539 hairy = 2;
540 }
541
542 if (chars_to_delete)
543 {
544 string = make_string_from_bytes (str, 1, len);
545 if (spaces_to_insert)
546 {
547 tem = Fmake_string (make_number (spaces_to_insert),
548 make_number (' '));
549 string = concat2 (tem, string);
550 }
551
552 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1);
553 Fforward_char (make_number (1 + spaces_to_insert));
554 }
555 else
556 insert_and_inherit (str, len);
557
558 if ((CHAR_TABLE_P (Vauto_fill_chars)
559 ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
560 : (c == ' ' || c == '\n'))
561 && !noautofill
562 && !NILP (current_buffer->auto_fill_function))
563 {
564 Lisp_Object tem;
565
566 if (c == '\n')
567 568 569
570 SET_PT_BOTH (PT - 1, PT_BYTE - 1);
571 tem = call0 (current_buffer->auto_fill_function);
572
573 if (c == '\n' && PT < ZV)
574 SET_PT_BOTH (PT + 1, PT_BYTE + 1);
575 if (!NILP (tem))
576 hairy = 2;
577 }
578
579
580 if (!NILP (Vself_insert_face)
581 && EQ (current_kboard->Vlast_command, Vself_insert_face_command))
582 {
583 Fput_text_property (make_number (PT - 1), make_number (PT),
584 Qface, Vself_insert_face, Qnil);
585 Vself_insert_face = Qnil;
586 }
587
588 if ((synt == Sclose || synt == Smath)
589 && !NILP (Vblink_paren_function) && INTERACTIVE
590 && !noautofill)
591 {
592 call0 (Vblink_paren_function);
593 hairy = 2;
594 }
595 return hairy;
596 }
597
598
599
600 void
601 syms_of_cmds ()
602 {
603 Qkill_backward_chars = intern_c_string ("kill-backward-chars");
604 staticpro (&Qkill_backward_chars);
605
606 Qkill_forward_chars = intern_c_string ("kill-forward-chars");
607 staticpro (&Qkill_forward_chars);
608
609 Qoverwrite_mode_binary = intern_c_string ("overwrite-mode-binary");
610 staticpro (&Qoverwrite_mode_binary);
611
612 Qexpand_abbrev = intern_c_string ("expand-abbrev");
613 staticpro (&Qexpand_abbrev);
614
615 DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
616 doc: 617 );
618 Vself_insert_face = Qnil;
619
620 DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
621 doc: 622 );
623 Vself_insert_face_command = Qnil;
624
625 DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
626 doc: 627 );
628 Vblink_paren_function = Qnil;
629
630 defsubr (&Sforward_point);
631 defsubr (&Sforward_char);
632 defsubr (&Sbackward_char);
633 defsubr (&Sforward_line);
634 defsubr (&Sbeginning_of_line);
635 defsubr (&Send_of_line);
636
637 defsubr (&Sdelete_char);
638 defsubr (&Sdelete_backward_char);
639
640 defsubr (&Sself_insert_command);
641 }
642
643 void
644 keys_of_cmds ()
645 {
646 int n;
647
648 nonundocount = 0;
649 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
650 for (n = 040; n < 0177; n++)
651 initial_define_key (global_map, n, "self-insert-command");
652 #ifdef MSDOS
653 for (n = 0200; n < 0240; n++)
654 initial_define_key (global_map, n, "self-insert-command");
655 #endif
656 for (n = 0240; n < 0400; n++)
657 initial_define_key (global_map, n, "self-insert-command");
658
659 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
660 initial_define_key (global_map, Ctl ('B'), "backward-char");
661 initial_define_key (global_map, Ctl ('D'), "delete-char");
662 initial_define_key (global_map, Ctl ('E'), "end-of-line");
663 initial_define_key (global_map, Ctl ('F'), "forward-char");
664 initial_define_key (global_map, 0177, "delete-backward-char");
665 }
666
667 668