4.3BSD - /usr/src/new/emacs/src/cmds.c

   1: /* Simple built-in editing commands.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include "config.h"
  23: #include "lisp.h"
  24: #include "commands.h"
  25: #include "buffer.h"
  26: #include "syntax.h"
  27: 
  28: Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_hook;
  29: 
  30: 
  31: DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  32:   "Move point right ARG characters (left if ARG negative).\n\
  33: On reaching end of buffer, stop and signal error.")
  34:   (n)
  35:      Lisp_Object n;
  36: {
  37:   if (NULL (n))
  38:     XFASTINT (n) = 1;
  39:   else
  40:     CHECK_NUMBER (n, 0);
  41: 
  42:   SetPoint (point + XINT (n));
  43:   if (point < FirstCharacter)
  44:     {
  45:       SetPoint (FirstCharacter);
  46:       Fsignal (Qbeginning_of_buffer, Qnil);
  47:     }
  48:   if (point > NumCharacters + 1)
  49:     {
  50:       SetPoint (NumCharacters + 1);
  51:       Fsignal (Qend_of_buffer, Qnil);
  52:     }
  53:   return Qnil;
  54: }
  55: 
  56: DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  57:   "Move point left ARG characters (right if ARG negative).\n\
  58: On reaching end of buffer, stop and signal error.")
  59:   (n)
  60:      Lisp_Object n;
  61: {
  62:   if (NULL (n))
  63:     XFASTINT (n) = 1;
  64:   else
  65:     CHECK_NUMBER (n, 0);
  66: 
  67:   XSETINT (n, - XINT (n));
  68:   return Fforward_char (n);
  69: }
  70: 
  71: DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  72:   "Move point forward past ARG newlines.\n\
  73: If ARG is zero, position after previous newline.\n\
  74: If ARG is negative, position after -ARG'th newline before that one.\n\
  75: If scan reaches end of buffer, stop there without error;\n\
  76:  value is count of lines left to move.")
  77:   (n)
  78:      Lisp_Object n;
  79: {
  80:   register int pos = point;
  81:   register int count, stop;
  82: 
  83:   if (NULL (n))
  84:     count = 1;
  85:   else
  86:     {
  87:       CHECK_NUMBER (n, 0);
  88:       count = XINT (n);
  89:     }
  90: 
  91:   stop = FirstCharacter;
  92:   if (count <= 0)
  93:     {
  94:       while (pos > stop && CharAt (pos - 1) != '\n')
  95:     pos--;
  96:     }
  97:   while (count < 0 && pos > stop)
  98:     {
  99:       count++;
 100:       pos--;
 101:       /* In this loop, pos is one less than the position of scan. */
 102:       while (--pos >= stop && CharAt (pos) != '\n');
 103:       pos++;
 104:     }
 105:   stop = NumCharacters;
 106:   while (count > 0 && pos <= stop)
 107:     {
 108:       count--;
 109:       pos--;
 110:       /* In this loop, pos is one less than the position of scan. */
 111:       while (++pos < stop && CharAt (pos) != '\n');
 112:       pos++;
 113:     }
 114:   SetPoint (pos);
 115:   return make_number (count);
 116: }
 117: 
 118: DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
 119:   0, 1, "p",
 120:   "Move point to beginning of current line.\n\
 121: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
 122: If scan reaches end of buffer, stop there without error.")
 123:   (n)
 124:      Lisp_Object n;
 125: {
 126:   if (NULL (n))
 127:     XFASTINT (n) = 1;
 128:   else
 129:     CHECK_NUMBER (n, 0);
 130: 
 131:   Fforward_line (make_number (XINT (n) - 1));
 132:   return Qnil;
 133: }
 134: 
 135: DEFUN ("end-of-line", Fend_of_line, Send_of_line,
 136:   0, 1, "p",
 137:   "Move point to end of current line.\n\
 138: With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
 139: If scan reaches end of buffer, stop there without error.")
 140:   (n)
 141:      Lisp_Object n;
 142: {
 143:   register int pos;
 144:   register int stop;
 145: 
 146:   if (NULL (n))
 147:     XFASTINT (n) = 1;
 148:   else
 149:     CHECK_NUMBER (n, 0);
 150: 
 151:   if (XINT (n) != 1)
 152:     Fforward_line (make_number (XINT (n) - 1));
 153: 
 154:   pos = point;
 155:   stop = NumCharacters + 1;
 156:   while (pos < stop && CharAt (pos) != '\n') pos++;
 157:   SetPoint (pos);
 158: 
 159:   return Qnil;
 160: }
 161: 
 162: DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
 163:   "Delete the following ARG characters (previous, with negative arg).\n\
 164: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 165: Interactively, ARG is the prefix arg, and kill if ARG was explicitly specd.")
 166:   (n, killflag)
 167:      Lisp_Object n, killflag;
 168: {
 169:   CHECK_NUMBER (n, 0);
 170: 
 171:   if (NULL (killflag))
 172:     {
 173:       if (XINT (n) < 0)
 174:     {
 175:       if (point + XINT (n) < FirstCharacter)
 176:         Fsignal (Qbeginning_of_buffer, Qnil);
 177:       else
 178:         del_range (point + XINT (n), point);
 179:     }
 180:       else
 181:     {
 182:       if (point + XINT (n) > NumCharacters + 1)
 183:         Fsignal (Qend_of_buffer, Qnil);
 184:       else
 185:         del_range (point, point + XINT (n));
 186:     }
 187:     }
 188:   else
 189:     {
 190:       call1 (Qkill_forward_chars, n);
 191:     }
 192:   return Qnil;
 193: }
 194: 
 195: DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
 196:   1, 2, "p\nP",
 197:   "Delete the previous ARG characters (following, with negative ARG).\n\
 198: Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
 199: Interactively, ARG is the prefix arg, and kill if ARG was explicitly specd.")
 200:   (n, killflag)
 201:      Lisp_Object n, killflag;
 202: {
 203:   CHECK_NUMBER (n, 0);
 204:   return Fdelete_char (make_number (-XINT (n)), killflag);
 205: }
 206: 
 207: DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
 208:   "Insert this character.")
 209:   (arg)
 210:      Lisp_Object arg;
 211: {
 212:   CHECK_NUMBER (arg, 0);
 213:   if (XINT (arg) == 0
 214:       && last_command_char == ' '
 215:       && !NULL (bf_cur->auto_fill_hook)
 216:       && !NULL (bf_cur->read_only)
 217:       && current_column () > XFASTINT (bf_cur->fill_column))
 218:     Fapply (bf_cur->auto_fill_hook, Qnil);
 219: 
 220:   while (XINT (arg) > 0)
 221:     {
 222:       SelfInsert (last_command_char);
 223:       XFASTINT (arg)--;     /* Ok since old and new vals both nonneg */
 224:     }
 225:   return Qnil;
 226: }
 227: 
 228: DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
 229:   "Insert a newline.  With arg, insert that many newlines.\n\
 230: In Auto Fill mode, can break the preceding line if no numeric arg.")
 231:   (arg1)
 232:      Lisp_Object arg1;
 233: {
 234:   int flag;
 235:   Lisp_Object arg;
 236: 
 237:   arg = Fprefix_numeric_value (arg1);
 238: 
 239:   if (!NULL (bf_cur->read_only))
 240:     Fsignal (Qbuffer_read_only, Qnil);
 241: 
 242:   if (NULL (arg1)
 243:       && !NULL (bf_cur->auto_fill_hook)
 244:       && current_column () > XFASTINT (bf_cur->fill_column))
 245:     Fapply (bf_cur->auto_fill_hook, Qnil);
 246: 
 247:   flag = point > FirstCharacter && CharAt (point - 1) == '\n';
 248:   if (flag) PointLeft (1);
 249: 
 250:   while (XINT (arg) > 0)
 251:     {
 252:       SelfInsert ('\n');
 253:       XFASTINT (arg)--;     /* Ok since old and new vals both nonneg */
 254:     }
 255: 
 256:   if (flag) PointRight (1);
 257: 
 258:   return Qnil;
 259: }
 260: 
 261: SelfInsert (c1)
 262:      char c1;
 263: {
 264:   extern Lisp_Object Fexpand_abbrev ();
 265:   int hairy = 0;
 266:   Lisp_Object tem;
 267:   register enum syntaxcode synt;
 268:   register int c = c1;
 269: 
 270:   if (!NULL (bf_cur->overwrite_mode)
 271:       && point <= NumCharacters
 272:       && c != '\n' && CharAt (point) != '\n'
 273:       && (CharAt (point) != '\t'
 274:       || XINT (bf_cur->tab_width) <= 0
 275:       || !((current_column () + 1) % XFASTINT (bf_cur->tab_width))))
 276:     {
 277:       del_range (point, point + 1);
 278:       hairy = 1;
 279:     }
 280:   if (!NULL (bf_cur->abbrev_mode)
 281:       && SYNTAX (c) != Sword
 282:       && NULL (bf_cur->read_only)
 283:       && point > FirstCharacter && SYNTAX (CharAt (point - 1)) == Sword)
 284:     {
 285:       tem = Fexpand_abbrev ();
 286:       if (!NULL (tem))
 287:     hairy = 1;
 288:     }
 289:   if ((c == ' ' || c == '\n')
 290:       && !NULL (bf_cur->auto_fill_hook)
 291:       && current_column () > XFASTINT (bf_cur->fill_column))
 292:     {
 293:       InsCStr (&c1, 1);
 294:       Fapply (bf_cur->auto_fill_hook, Qnil);
 295:       hairy = 1;
 296:     }
 297:   else
 298:     InsCStr (&c1, 1);
 299:   synt = SYNTAX (c);
 300:   if ((synt == Sclose || synt == Smath)
 301:       && !NULL (Vblink_paren_hook) && INTERACTIVE)
 302:     {
 303:       Fapply (Vblink_paren_hook, Qnil);
 304:       hairy = 1;
 305:     }
 306:   return hairy;
 307: }
 308: 
 309: /* module initialization */
 310: 
 311: syms_of_cmds ()
 312: {
 313:   Qkill_backward_chars = intern ("kill-backward-chars");
 314:   staticpro (&Qkill_backward_chars);
 315: 
 316:   Qkill_forward_chars = intern ("kill-forward-chars");
 317:   staticpro (&Qkill_forward_chars);
 318: 
 319:   DefLispVar ("blink-paren-hook", &Vblink_paren_hook,
 320:     "Function called, if non-nil, whenever a char with closeparen syntax is self-inserted.");
 321:   Vblink_paren_hook = Qnil;
 322: 
 323:   defsubr (&Sforward_char);
 324:   defsubr (&Sbackward_char);
 325:   defsubr (&Sforward_line);
 326:   defsubr (&Sbeginning_of_line);
 327:   defsubr (&Send_of_line);
 328: 
 329:   defsubr (&Sdelete_char);
 330:   defsubr (&Sdelete_backward_char);
 331: 
 332:   defsubr (&Sself_insert_command);
 333:   defsubr (&Snewline);
 334: }
 335: 
 336: keys_of_cmds ()
 337: {
 338:   int n;
 339: 
 340:   defkey (GlobalMap, Ctl('M'), "newline");
 341:   defkey (GlobalMap, Ctl('I'), "self-insert-command");
 342:   for (n = 040; n < 0177; n++)
 343:     defkey (GlobalMap, n, "self-insert-command");
 344: 
 345:   defkey (GlobalMap, Ctl ('A'), "beginning-of-line");
 346:   defkey (GlobalMap, Ctl ('B'), "backward-char");
 347:   defkey (GlobalMap, Ctl ('D'), "delete-char");
 348:   defkey (GlobalMap, Ctl ('E'), "end-of-line");
 349:   defkey (GlobalMap, Ctl ('F'), "forward-char");
 350:   defkey (GlobalMap, 0177, "delete-backward-char");
 351: }

Defined functions

Defined variables