Return to cmds.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/cmds.c, revision 1.1

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

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