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