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