src/cmds.c

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