src/cmds.c

   1 /* Simple built-in editing commands.
   2    Copyright (C) 1985, 1993, 1994 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
  28 Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  29 Lisp_Object Vuse_hard_newlines;
  30
  31 /* A possible value for a buffer's overwrite-mode variable.  */
  32 Lisp_Object Qoverwrite_mode_binary;
  33
  34 #ifdef USE_TEXT_PROPERTIES
  35 Lisp_Object Qhard;
  36 #endif
  37
  38 \f
  39 DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  40   "Move point right ARG characters (left if ARG negative).\n\
  41 On reaching end of buffer, stop and signal error.")
  42   (n)
  43      Lisp_Object n;
  44 {
  45   if (NILP (n))
  46     XSETFASTINT (n, 1);
  47   else
  48     CHECK_NUMBER (n, 0);
  49
  50   /* This used to just set point to point + XINT (n), and then check
  51      to see if it was within boundaries.  But now that SET_PT can
  52      potentially do a lot of stuff (calling entering and exiting
  53      hooks, etcetera), that's not a good approach.  So we validate the
  54      proposed position, then set point.  */
  55   {
  56     int new_point = point + XINT (n);
  57
  58     if (new_point < BEGV)
  59       {
  60         SET_PT (BEGV);
  61         Fsignal (Qbeginning_of_buffer, Qnil);
  62       }
  63     if (new_point > ZV)
  64       {
  65         SET_PT (ZV);
  66         Fsignal (Qend_of_buffer, Qnil);
  67       }
  68
  69     SET_PT (new_point);
  70   }
  71
  72   return Qnil;
  73 }
  74
  75 DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  76   "Move point left ARG characters (right if ARG negative).\n\
  77 On attempt to pass beginning or end of buffer, stop and signal error.")
  78   (n)
  79      Lisp_Object n;
  80 {
  81   if (NILP (n))
  82     XSETFASTINT (n, 1);
  83   else
  84     CHECK_NUMBER (n, 0);
  85
  86   XSETINT (n, - XINT (n));
  87   return Fforward_char (n);
  88 }
  89
  90 DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  91   "Move ARG lines forward (backward if ARG is negative).\n\
  92 Precisely, if point is on line I, move to the start of line I + ARG.\n\
  93 If there isn't room, go as far as possible (no error).\n\
  94 Returns the count of lines left to move.  If moving forward,\n\
  95 that is ARG - number of lines moved; if backward, ARG + number moved.\n\
  96 With positive ARG, a non-empty line at the end counts as one line\n\
  97   successfully moved (for the return value).")
  98   (n)
  99      Lisp_Object n;
 100 {
 101   int pos2 = point;
 102   int pos;
 103   int count, shortage, negp;
 104
 105   if (NILP (n))
 106     count = 1;
 107   else
 108     {
 109       CHECK_NUMBER (n, 0);
 110       count = XINT (n);
 111     }
 112
 113   negp = count <= 0;
 114   pos = scan_buffer ('\n', pos2, 0, count - negp, &shortage, 1);
 115   if (shortage > 0
 116       && (negp
 117           || (ZV > BEGV
 118               && pos != pos2
 119               && FETCH_CHAR (pos - 1) != '\n')))
 120     shortage--;
 121   SET_PT (pos);
 122   return make_number (negp ? - shortage : shortage);
 123 }
 124
 125 DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
 126   0, 1, "p",
 127   "Move point to beginning of current line.\n\
 128 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
 129 If scan reaches end of buffer, stop there without error.")
 130   (n)
 131      Lisp_Object n;
 132 {
 133   if (NILP (n))
 134     XSETFASTINT (n, 1);
 135   else
 136     CHECK_NUMBER (n, 0);
 137
 138   Fforward_line (make_number (XINT (n) - 1));
 139   return Qnil;
 140 }
 141
 142 DEFUN ("end-of-line", Fend_of_line, Send_of_line,
 143   0, 1, "p",
 144   "Move point to end of current line.\n\
 145 With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
 146 If scan reaches end of buffer, stop there without error.")
 147   (n)
 148      Lisp_Object n;
 149 {
 150   register int pos;
 151   register int stop;
 152
 153   if (NILP (n))
 154     XSETFASTINT (n, 1);
 155   else
 156     CHECK_NUMBER (n, 0);
 157
 158   SET_PT (find_before_next_newline (PT, 0, XINT (n) - (XINT (n) <= 0)));
 159
 160   return Qnil;
 161 }
 162
 163 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 164   "Delete the following ARG characters (previous, with negative arg).\n\
 165 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 166 Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
 167 ARG was explicitly specified.")
 168   (n, killflag)
 169      Lisp_Object n, killflag;
 170 {
 171   CHECK_NUMBER (n, 0);
 172
 173   if (NILP (killflag))
 174     {
 175       if (XINT (n) < 0)
 176         {
 177           if (point + XINT (n) < BEGV)
 178             Fsignal (Qbeginning_of_buffer, Qnil);
 179           else
 180             del_range (point + XINT (n), point);
 181         }
 182       else
 183         {
 184           if (point + XINT (n) > ZV)
 185             Fsignal (Qend_of_buffer, Qnil);
 186           else
 187             del_range (point, point + XINT (n));
 188         }
 189     }
 190   else
 191     {
 192       call1 (Qkill_forward_chars, n);
 193     }
 194   return Qnil;
 195 }
 196
 197 DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
 198   1, 2, "p\nP",
 199   "Delete the previous ARG characters (following, with negative ARG).\n\
 200 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 201 Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
 202 ARG was explicitly specified.")
 203   (n, killflag)
 204      Lisp_Object n, killflag;
 205 {
 206   CHECK_NUMBER (n, 0);
 207   return Fdelete_char (make_number (-XINT (n)), killflag);
 208 }
 209
 210 DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 211   "Insert the character you type.\n\
 212 Whichever character you type to run this command is inserted.")
 213   (arg)
 214      Lisp_Object arg;
 215 {
 216   CHECK_NUMBER (arg, 0);
 217
 218   /* Barf if the key that invoked this was not a character.  */
 219   if (!INTEGERP (last_command_char))
 220     bitch_at_user ();
 221   else
 222     while (XINT (arg) > 0)
 223       {
 224         /* Ok since old and new vals both nonneg */
 225         XSETFASTINT (arg, XFASTINT (arg) - 1);
 226         internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0);
 227       }
 228
 229   return Qnil;
 230 }
 231
 232 DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
 233   "Insert a newline.  With arg, insert that many newlines.\n\
 234 In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
 235   (arg1)
 236      Lisp_Object arg1;
 237 {
 238   int flag, i;
 239   Lisp_Object arg;
 240   char c1 = '\n';
 241
 242   arg = Fprefix_numeric_value (arg1);
 243
 244   if (!NILP (current_buffer->read_only))
 245     Fbarf_if_buffer_read_only ();
 246
 247   /* Inserting a newline at the end of a line produces better
 248      redisplay in try_window_id than inserting at the beginning of a
 249      line, and the textual result is the same.  So, if we're at
 250      beginning of line, pretend to be at the end of the previous line.
 251
 252      We can't use internal_self_insert in that case since it won't do
 253      the insertion correctly.  Luckily, internal_self_insert's special
 254      features all do nothing in that case.  */
 255
 256   flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
 257   /* Don't do this if at the beginning of the window.  */
 258   if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer
 259       && marker_position (XWINDOW (selected_window)->start) == PT)
 260     flag = 0;
 261
 262 #ifdef USE_TEXT_PROPERTIES
 263   /* We cannot use this optimization if properties change
 264      in the vicinity.
 265      ??? We need to check for change hook properties, etc.  */
 266   if (flag)
 267     if (! (point - 1 > BEGV && ! property_change_between_p (point - 2, point)))
 268       flag = 0;
 269 #endif
 270
 271   if (flag)
 272     SET_PT (point - 1);
 273
 274   for (i = XINT (arg); i > 0; i--)
 275     {
 276       if (flag)
 277         insert_and_inherit (&c1, 1);
 278       else
 279         internal_self_insert ('\n', !NILP (arg1));
 280     }
 281
 282 #ifdef USE_TEXT_PROPERTIES
 283   if (Vuse_hard_newlines)
 284     {
 285       Lisp_Object from, to, sticky;
 286       XSETFASTINT (from, PT - arg);
 287       XSETFASTINT (to, PT);
 288       Fput_text_property (from, to, Qhard, Qt, Qnil);
 289       /* If rear_nonsticky is not "t", locally add Qhard to the list. */
 290       sticky = Fget_text_property (from, Qrear_nonsticky, Qnil);
 291       if (NILP (sticky)
 292           || (CONSP (sticky) && NILP (Fmemq (Qhard, sticky))))
 293         {
 294           sticky = Fcons (Qhard, sticky);
 295           Fput_text_property (from, to, Qrear_nonsticky, sticky, Qnil);
 296         }
 297     }
 298 #endif
 299
 300
 301   if (flag)
 302     SET_PT (point + 1);
 303
 304   return Qnil;
 305 }
 306
 307 /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
 308    even if it is enabled.
 309
 310    If this insertion is suitable for direct output (completely simple),
 311    return 0.  A value of 1 indicates this *might* not have been simple.
 312    A value of 2 means this did things that call for an undo boundary.  */
 313
 314 internal_self_insert (c1, noautofill)
 315      char c1;
 316      int noautofill;
 317 {
 318   extern Lisp_Object Fexpand_abbrev ();
 319   int hairy = 0;
 320   Lisp_Object tem;
 321   register enum syntaxcode synt;
 322   register int c = c1;
 323   Lisp_Object overwrite;
 324
 325   overwrite = current_buffer->overwrite_mode;
 326   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
 327       || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
 328     hairy = 1;
 329
 330   if (!NILP (overwrite)
 331       && point < ZV
 332       && (EQ (overwrite, Qoverwrite_mode_binary)
 333           || (c != '\n' && FETCH_CHAR (point) != '\n'))
 334       && (EQ (overwrite, Qoverwrite_mode_binary)
 335           || FETCH_CHAR (point) != '\t'
 336           || XINT (current_buffer->tab_width) <= 0
 337           || XFASTINT (current_buffer->tab_width) > 20
 338           || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
 339     {
 340       del_range (point, point + 1);
 341       hairy = 2;
 342     }
 343   if (!NILP (current_buffer->abbrev_mode)
 344       && SYNTAX (c) != Sword
 345       && NILP (current_buffer->read_only)
 346       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
 347     {
 348       int modiff = MODIFF;
 349       Fexpand_abbrev ();
 350       /* We can't trust the value of Fexpand_abbrev,
 351          but if Fexpand_abbrev changed the buffer,
 352          assume it expanded something.  */
 353       if (MODIFF != modiff)
 354         hairy = 2;
 355     }
 356   if ((c == ' ' || c == '\n')
 357       && !noautofill
 358       && !NILP (current_buffer->auto_fill_function))
 359     {
 360       if (c1 != '\n')
 361         insert_and_inherit (&c1, 1);
 362       call0 (current_buffer->auto_fill_function);
 363       if (c1 == '\n')
 364         insert_and_inherit (&c1, 1);
 365       hairy = 2;
 366     }
 367   else
 368     insert_and_inherit (&c1, 1);
 369   synt = SYNTAX (c);
 370   if ((synt == Sclose || synt == Smath)
 371       && !NILP (Vblink_paren_function) && INTERACTIVE)
 372     {
 373       call0 (Vblink_paren_function);
 374       hairy = 2;
 375     }
 376   return hairy;
 377 }
 378 \f
 379 /* module initialization */
 380
 381 syms_of_cmds ()
 382 {
 383   Qkill_backward_chars = intern ("kill-backward-chars");
 384   staticpro (&Qkill_backward_chars);
 385
 386   Qkill_forward_chars = intern ("kill-forward-chars");
 387   staticpro (&Qkill_forward_chars);
 388
 389   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 390   staticpro (&Qoverwrite_mode_binary);
 391
 392   Qhard = intern ("hard");
 393   staticpro (&Qhard);
 394
 395   DEFVAR_BOOL ("use-hard-newlines", &Vuse_hard_newlines,
 396     "Non-nil means to distinguish hard and soft newlines.
 397 When this is non-nil, the functions `newline' and `open-line' add the
 398 text-property `hard' to newlines that they insert.  Also, a line is
 399 only considered as a candidate to match `paragraph-start' or
 400 `paragraph-separate' if it follows a hard newline.  Newlines not
 401 marked hard are called \"soft\", and are always internal to
 402 paragraphs.  The fill functions always insert soft newlines.");
 403   Vuse_hard_newlines = 0;
 404
 405   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 406     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
 407 More precisely, a char with closeparen syntax is self-inserted.");
 408   Vblink_paren_function = Qnil;
 409
 410   defsubr (&Sforward_char);
 411   defsubr (&Sbackward_char);
 412   defsubr (&Sforward_line);
 413   defsubr (&Sbeginning_of_line);
 414   defsubr (&Send_of_line);
 415
 416   defsubr (&Sdelete_char);
 417   defsubr (&Sdelete_backward_char);
 418
 419   defsubr (&Sself_insert_command);
 420   defsubr (&Snewline);
 421 }
 422
 423 keys_of_cmds ()
 424 {
 425   int n;
 426
 427   initial_define_key (global_map, Ctl ('M'), "newline");
 428   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
 429   for (n = 040; n < 0177; n++)
 430     initial_define_key (global_map, n, "self-insert-command");
 431 #ifdef MSDOS
 432   for (n = 0200; n < 0240; n++)
 433     initial_define_key (global_map, n, "self-insert-command");
 434 #endif
 435   for (n = 0240; n < 0400; n++)
 436     initial_define_key (global_map, n, "self-insert-command");
 437
 438   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 439   initial_define_key (global_map, Ctl ('B'), "backward-char");
 440   initial_define_key (global_map, Ctl ('D'), "delete-char");
 441   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 442   initial_define_key (global_map, Ctl ('F'), "forward-char");
 443   initial_define_key (global_map, 0177, "delete-backward-char");
 444 }