src/cmds.c

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