src/cmds.c

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