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     hairy = 1;
 303
 304   if (!NILP (overwrite)
 305       && point < ZV
 306       && (EQ (overwrite, Qoverwrite_mode_binary)
 307           || (c != '\n' && FETCH_CHAR (point) != '\n'))
 308       && (EQ (overwrite, Qoverwrite_mode_binary)
 309           || FETCH_CHAR (point) != '\t'
 310           || XINT (current_buffer->tab_width) <= 0
 311           || XFASTINT (current_buffer->tab_width) > 20
 312           || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
 313     {
 314       del_range (point, point + 1);
 315       hairy = 1;
 316     }
 317   if (!NILP (current_buffer->abbrev_mode)
 318       && SYNTAX (c) != Sword
 319       && NILP (current_buffer->read_only)
 320       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
 321     {
 322       int modiff = MODIFF;
 323       Fexpand_abbrev ();
 324       /* We can't trust the value of Fexpand_abbrev,
 325          but if Fexpand_abbrev changed the buffer,
 326          assume it expanded something.  */
 327       if (MODIFF != modiff)
 328         hairy = 1;
 329     }
 330   if ((c == ' ' || c == '\n')
 331       && !noautofill
 332       && !NILP (current_buffer->auto_fill_function)
 333       && current_column () > XFASTINT (current_buffer->fill_column))
 334     {
 335       if (c1 != '\n')
 336         insert (&c1, 1);
 337       call0 (current_buffer->auto_fill_function);
 338       if (c1 == '\n')
 339         insert (&c1, 1);
 340       hairy = 1;
 341     }
 342   else
 343     insert (&c1, 1);
 344   synt = SYNTAX (c);
 345   if ((synt == Sclose || synt == Smath)
 346       && !NILP (Vblink_paren_function) && INTERACTIVE)
 347     {
 348       call0 (Vblink_paren_function);
 349       hairy = 1;
 350     }
 351   return hairy;
 352 }
 353 \f
 354 /* module initialization */
 355
 356 syms_of_cmds ()
 357 {
 358   Qkill_backward_chars = intern ("kill-backward-chars");
 359   staticpro (&Qkill_backward_chars);
 360
 361   Qkill_forward_chars = intern ("kill-forward-chars");
 362   staticpro (&Qkill_forward_chars);
 363
 364   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
 365   staticpro (&Qoverwrite_mode_binary);
 366
 367   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
 368     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
 369 More precisely, a char with closeparen syntax is self-inserted.");
 370   Vblink_paren_function = Qnil;
 371
 372   defsubr (&Sforward_char);
 373   defsubr (&Sbackward_char);
 374   defsubr (&Sforward_line);
 375   defsubr (&Sbeginning_of_line);
 376   defsubr (&Send_of_line);
 377
 378   defsubr (&Sdelete_char);
 379   defsubr (&Sdelete_backward_char);
 380
 381   defsubr (&Sself_insert_command);
 382   defsubr (&Snewline);
 383 }
 384
 385 keys_of_cmds ()
 386 {
 387   int n;
 388
 389   initial_define_key (global_map, Ctl('M'), "newline");
 390   initial_define_key (global_map, Ctl('I'), "self-insert-command");
 391   for (n = 040; n < 0177; n++)
 392     initial_define_key (global_map, n, "self-insert-command");
 393 #ifdef MSDOS
 394   for (n = 0200; n < 0240; n++)
 395     initial_define_key (global_map, n, "self-insert-command");
 396 #endif
 397   for (n = 0240; n < 0400; n++)
 398     initial_define_key (global_map, n, "self-insert-command");
 399
 400   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
 401   initial_define_key (global_map, Ctl ('B'), "backward-char");
 402   initial_define_key (global_map, Ctl ('D'), "delete-char");
 403   initial_define_key (global_map, Ctl ('E'), "end-of-line");
 404   initial_define_key (global_map, Ctl ('F'), "forward-char");
 405   initial_define_key (global_map, 0177, "delete-backward-char");
 406 }