1 /* Simple built-in editing commands.
  2    Copyright (C) 1985, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002,
  3                  2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
  4                  Free Software Foundation, Inc.
  5 
  6 This file is part of GNU Emacs.
  7 
  8 GNU Emacs is free software: you can redistribute it and/or modify
  9 it under the terms of the GNU General Public License as published by
 10 the Free Software Foundation, either version 3 of the License, or
 11 (at your option) any later version.
 12 
 13 GNU Emacs is distributed in the hope that it will be useful,
 14 but WITHOUT ANY WARRANTY; without even the implied warranty of
 15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16 GNU General Public License for more details.
 17 
 18 You should have received a copy of the GNU General Public License
 19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 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 /* A possible value for a buffer's overwrite-mode variable.  */
 38 Lisp_Object Qoverwrite_mode_binary;
 39 
 40 /* Non-nil means put this face on the next self-inserting character.  */
 41 Lisp_Object Vself_insert_face;
 42 
 43 /* This is the command that set up Vself_insert_face.  */
 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: /* Return buffer position N characters after (before if N negative) point.  */)
 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: /* Move point N characters forward (backward if N is negative).
 61 On reaching end or beginning of buffer, stop and signal error.
 62 
 63 Depending on the bidirectional context, the movement may be to the
 64 right or to the left on the screen.  This is in contrast with
 65 \\[right-arrow-command], which see.  */)
 66      (n)
 67      Lisp_Object n;
 68 {
 69   if (NILP (n))
 70     XSETFASTINT (n, 1);
 71   else
 72     CHECK_NUMBER (n);
 73 
 74   /* This used to just set point to point + XINT (n), and then check
 75      to see if it was within boundaries.  But now that SET_PT can
 76      potentially do a lot of stuff (calling entering and exiting
 77      hooks, etcetera), that's not a good approach.  So we validate the
 78      proposed position, then set point.  */
 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: /* Move point N characters backward (forward if N is negative).
101 On attempt to pass beginning or end of buffer, stop and signal error.
102 
103 Depending on the bidirectional context, the movement may be to the
104 right or to the left on the screen.  This is in contrast with
105 \\[left-arrow-command], which see.  */)
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: /* Move N lines forward (backward if N is negative).
120 Precisely, if point is on line I, move to the start of line I + N.
121 If there isn't room, go as far as possible (no error).
122 Returns the count of lines left to move.  If moving forward,
123 that is N - number of lines moved; if backward, N + number moved.
124 With positive N, a non-empty line at the end counts as one line
125   successfully moved (for the return value).  */)
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   /* Since scan_newline does TEMP_SET_PT_BOTH,
147      and we want to set PT "for real",
148      go back to the old point and then come back here.  */
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: /* Move point to beginning of current line.
166 With argument N not nil or 1, move forward N - 1 lines first.
167 If point reaches the beginning or end of buffer, it stops there.
168 
169 This function constrains point to the current field unless this moves
170 point to a different line than the original, unconstrained result.  If
171 N is nil or 1, and a front-sticky field starts at point, the point
172 does not move.  To ignore field boundaries bind
173 `inhibit-field-text-motion' to t, or use the `forward-line' function
174 instead.  For instance, `(forward-line 0)' does the same thing as
175 `(beginning-of-line)', except that it ignores field boundaries.  */)
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: /* Move point to end of current line.
191 With argument N not nil or 1, move forward N - 1 lines first.
192 If point reaches the beginning or end of buffer, it stops there.
193 To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
194 
195 This function constrains point to the current field unless this moves
196 point to a different line than the original, unconstrained result.  If
197 N is nil or 1, and a rear-sticky field ends at point, the point does
198 not move.  To ignore field boundaries bind `inhibit-field-text-motion'
199 to t.  */)
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           /* If we skipped over a newline that follows
219              an invisible intangible run,
220              move back to the last tangible position
221              within the line.  */
222 
223           SET_PT (PT - 1);
224           break;
225         }
226       else if (PT > newpos && PT < ZV
227                && FETCH_CHAR (PT) != '\n')
228         /* If we skipped something intangible
229            and now we're not really at eol,
230            keep going.  */
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: /* Delete the following N characters (previous if N is negative).
241 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
242 Interactively, N is the prefix arg, and KILLFLAG is set if
243 N was explicitly specified.  */)
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: /* Delete the previous N characters (following if N is negative).
279 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
280 Interactively, N is the prefix arg, and KILLFLAG is set if
281 N was explicitly specified.
282 This is meant for interactive use only; from Lisp, better use `delete-char'
283 with a negated argument.  */)
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   /* See if we are about to delete a tab or newline backwards.  */
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   /* In overwrite mode, back over columns while clearing them out,
310      unless at end of line.  */
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 (); /* iftc */
317 
318       value = Fdelete_char (make_number (-XINT (n)), killflag);
319       i = column - (int) current_column (); /* iftc */
320       Finsert_char (make_number (' '), make_number (i), Qnil);
321       /* Whitespace chars are ASCII chars, so we can simply subtract.  */
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 /* Note that there's code in command_loop_1 which typically avoids
333    calling this.  */
334 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
335        doc: /* Insert the character you type.
336 Whichever character you type to run this command is inserted.
337 Before insertion, `expand-abbrev' is executed if the inserted character does
338 not have word syntax and the previous character in the buffer does.
339 After insertion, the value of `auto-fill-function' is called if the
340 `auto-fill-chars' table has a non-nil value for the inserted character.  */)
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     /* Remove the undo_boundary that was just pushed.  */
365     current_buffer->undo_list = XCDR (current_buffer->undo_list);
366 
367   /* Barf if the key that invoked this was not a character.  */
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         /* The first one might want to expand an abbrev.  */
377         internal_self_insert (character, 1);
378         /* The bulk of the copies of this char can be inserted simply.
379            We don't have to handle a user-specified face specially
380            because it will get inherited from the first char inserted.  */
381         Finsert_char (make_number (character), n, Qt);
382         /* The last one might want to auto-fill.  */
383         internal_self_insert (character, 0);
384       }
385     else
386       while (XINT (n) > 0)
387         {
388           int val;
389           /* Ok since old and new vals both nonneg */
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 /* Insert character C.  If NOAUTOFILL is nonzero, don't do autofill
402    even if it is enabled.
403 
404    If this insertion is suitable for direct output (completely simple),
405    return 0.  A value of 1 indicates this *might* not have been simple.
406    A value of 2 means this did things that call for an undo boundary.  */
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   /* Length of multi-byte form of C.  */
420   int len;
421   /* Working buffer and pointer for multi-byte form of C.  */
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   /* At first, get multi-byte form of C in STR.  */
431   if (!NILP (current_buffer->enable_multibyte_characters))
432     {
433       len = CHAR_STRING (c, str);
434       if (len == 1)
435         /* If C has modifier bits, this makes C an appropriate
436            one-byte char.  */
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       /* In overwrite-mode, we substitute a character at point (C2,
450          hereafter) by C.  For that, we delete C2 in advance.  But,
451          just substituting C2 by C may move a remaining text in the
452          line to the right or to the left, which is not preferable.
453          So we insert more spaces or delete more characters in the
454          following cases: if C is narrower than C2, after deleting C2,
455          we fill columns with spaces, if C is wider than C2, we delete
456          C2 and several characters following C2.  */
457 
458       /* This is the character after point.  */
459       int c2 = FETCH_CHAR (PT_BYTE);
460 
461       /* Column the cursor should be placed at after this insertion.
462          The correct value should be calculated only when necessary.  */
463       int target_clm = 0;
464 
465       /* Overwriting in binary-mode always replaces C2 by C.
466          Overwriting in textual-mode doesn't always do that.
467          It inserts newlines in the usual way,
468          and inserts any character at end of line
469          or before a tab if it doesn't use the whole width of the tab.  */
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 () /* iftc */
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               /* The actual cursor position after the trial of moving
488                  to column TARGET_CLM.  It is greater than TARGET_CLM
489                  if the TARGET_CLM is middle of multi-column
490                  character.  In that case, the new point is set after
491                  that character.  */
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                   /* We will delete too many columns.  Let's fill columns
500                      by spaces so that the remaining text won't move.  */
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       /* If we expanded an abbrev which has a hook,
527          and the hook has a non-nil `no-self-insert' property,
528          return right away--don't really self-insert.  */
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         /* After inserting a newline, move to previous line and fill
568            that.  Must have the newline in place already so filling and
569            justification, if any, know where the end is going to be.  */
570         SET_PT_BOTH (PT - 1, PT_BYTE - 1);
571       tem = call0 (current_buffer->auto_fill_function);
572       /* Test PT < ZV in case the auto-fill-function is strange.  */
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   /* If previous command specified a face to use, use it.  */
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 /* module initialization */
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: /* If non-nil, set the face of the next self-inserting character to this.
617 See also `self-insert-face-command'.  */);
618   Vself_insert_face = Qnil;
619 
620   DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
621                doc: /* This is the command that set up `self-insert-face'.
622 If `last-command' does not equal this value, we ignore `self-insert-face'.  */);
623   Vself_insert_face_command = Qnil;
624 
625   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
626                doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.
627 More precisely, a char with closeparen syntax is self-inserted.  */);
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 /* arch-tag: 022ba3cd-67f9-4978-9c5d-7d2b18d8644e
668    (do not change this comment) */