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