Return to cmds.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src

Annotation of 43BSD/contrib/emacs/src/cmds.c, revision 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: }

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