Annotation of 43BSD/contrib/emacs/src/cmds.c, revision 1.1.1.1

1.1       root        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: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.