home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / cmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-10  |  9.3 KB  |  365 lines

  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1992 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 2, 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.  
  23. #include "lisp.h"
  24. #include "commands.h"
  25. #include "buffer.h"
  26. #include "syntax.h"
  27. #include "insdel.h"
  28.  
  29. Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  30.  
  31. extern int zmacs_region_stays;
  32.  
  33.  
  34. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  35.   "Move point right ARG characters (left if ARG negative).\n\
  36. On reaching end of buffer, stop and signal error.")
  37.   (n)
  38.      Lisp_Object n;
  39. {
  40.   register int to;
  41.  
  42.   if (NILP (n))
  43.     XFASTINT (n) = 1;
  44.   else
  45.     CHECK_FIXNUM (n, 0);
  46.  
  47.   to = (point + XINT (n));
  48.   if (to < BEGV)
  49.     {
  50.       SET_PT (BEGV);
  51.       Fsignal (Qbeginning_of_buffer, Qnil);
  52.     }
  53.   if (to > ZV)
  54.     {
  55.       SET_PT (ZV);
  56.       Fsignal (Qend_of_buffer, Qnil);
  57.     }
  58.  
  59.   SET_PT (to);
  60.   zmacs_region_stays = 1;
  61.   return Qnil;
  62. }
  63.  
  64. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  65.   "Move point left ARG characters (right if ARG negative).\n\
  66. On attempt to pass beginning or end of buffer, stop and signal error.")
  67.   (n)
  68.      Lisp_Object n;
  69. {
  70.   if (NILP (n))
  71.     XFASTINT (n) = 1;
  72.   else
  73.     CHECK_FIXNUM (n, 0);
  74.  
  75.   XSETINT (n, - XINT (n));
  76.   return Fforward_char (n);
  77. }
  78.  
  79. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  80.   "Move ARG lines forward (backward if ARG is negative).\n\
  81. Precisely, if point is on line I, move to the start of line I + ARG.\n\
  82. If there isn't room, go as far as possible (no error).\n\
  83. Returns the count of lines left to move.  If moving forward,\n\
  84. that is ARG - number of lines moved; if backward, ARG + number moved.\n\
  85. With positive ARG, a non-empty line at the end counts as one line\n\
  86.   successfully moved (for the return value).")
  87.   (n)
  88.      Lisp_Object n;
  89. {
  90.   int pos2 = point;
  91.   int pos;
  92.   int count, shortage, negp;
  93.  
  94.   if (NILP (n))
  95.     count = 1;
  96.   else
  97.     {
  98.       CHECK_FIXNUM (n, 0);
  99.       count = XINT (n);
  100.     }
  101.  
  102.   negp = count <= 0;
  103.   pos = scan_buffer ('\n', pos2, count - negp, &shortage);
  104.   if (shortage > 0
  105.       && (negp
  106.       || (ZV > BEGV
  107.           && CHAR_AT (pos - 1) != '\n')))
  108.     shortage--;
  109.   SET_PT (pos);
  110.   zmacs_region_stays = 1;
  111.   return make_number (negp ? - shortage : shortage);
  112. }
  113.  
  114. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  115.   0, 1, "p",
  116.   "Move point to beginning of current line.\n\
  117. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  118. If scan reaches end of buffer, stop there without error.")
  119.   (n)
  120.      Lisp_Object n;
  121. {
  122.   if (NILP (n))
  123.     XFASTINT (n) = 1;
  124.   else
  125.     CHECK_FIXNUM (n, 0);
  126.  
  127.   Fforward_line (make_number (XINT (n) - 1));
  128.   return Qnil;
  129. }
  130.  
  131. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  132.   0, 1, "p",
  133.   "Move point to end of current line.\n\
  134. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  135. If scan reaches end of buffer, stop there without error.")
  136.   (n)
  137.      Lisp_Object n;
  138. {
  139.   register int pos;
  140.   register int stop;
  141.  
  142.   if (NILP (n))
  143.     XFASTINT (n) = 1;
  144.   else
  145.     CHECK_FIXNUM (n, 0);
  146.  
  147.   if (XINT (n) != 1)
  148.     Fforward_line (make_number (XINT (n) - 1));
  149.  
  150.   pos = point;
  151.   stop = ZV;
  152.   while (pos < stop && CHAR_AT (pos) != '\n') pos++;
  153.   SET_PT (pos);
  154.   zmacs_region_stays = 1;
  155.   return Qnil;
  156. }
  157.  
  158. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  159.   "Delete the following ARG characters (previous, with negative arg).\n\
  160. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  161. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  162. ARG was explicitly specified.")
  163.   (n, killflag)
  164.      Lisp_Object n, killflag;
  165. {
  166.   CHECK_FIXNUM (n, 0);
  167.  
  168.   if (NILP (killflag))
  169.     {
  170.       if (XINT (n) < 0)
  171.     {
  172.       if (point + XINT (n) < BEGV)
  173.         Fsignal (Qbeginning_of_buffer, Qnil);
  174.       else
  175.         del_range (point + XINT (n), point);
  176.     }
  177.       else
  178.     {
  179.       if (point + XINT (n) > ZV)
  180.         Fsignal (Qend_of_buffer, Qnil);
  181.       else
  182.         del_range (point, point + XINT (n));
  183.     }
  184.     }
  185.   else
  186.     {
  187.       call1 (Qkill_forward_chars, n);
  188.     }
  189.   return Qnil;
  190. }
  191.  
  192. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  193.   1, 2, "p\nP",
  194.   "Delete the previous ARG characters (following, with negative ARG).\n\
  195. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  196. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  197. ARG was explicitly specified.")
  198.   (n, killflag)
  199.      Lisp_Object n, killflag;
  200. {
  201.   CHECK_FIXNUM (n, 0);
  202.   return Fdelete_char (make_number (-XINT (n)), killflag);
  203. }
  204.  
  205. extern Lisp_Object Vlast_command_char, Vlast_command_event;
  206.  
  207. void internal_self_insert (int c1, int noautofill);
  208.  
  209. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  210.   "Insert the character you type.\n\
  211. Whichever character you type to run this command is inserted.")
  212.   (arg)
  213.      Lisp_Object arg;
  214. {
  215.   CHECK_FIXNUM (arg, 0);
  216.  
  217.   if (NILP (Vlast_command_char))
  218.     Fsignal (Qerror,
  219.          Fcons (build_string
  220.             ("last typed character has no ASCII equivalent"),
  221.             Fcons (Fcopy_event (Vlast_command_event, Qnil), Qnil)));
  222.   while (XINT (arg) > 0)
  223.     {
  224.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  225.       internal_self_insert (Vlast_command_char, XFASTINT (arg) != 0);
  226.     }
  227.   return Qnil;
  228. }
  229.  
  230. DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  231.   "Insert a newline.  With arg, insert that many newlines.\n\
  232. In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
  233.   (arg1)
  234.      Lisp_Object arg1;
  235. {
  236.   int flag;
  237.   Lisp_Object arg;
  238.   char c1 = '\n';
  239.  
  240.   arg = Fprefix_numeric_value (arg1);
  241.  
  242.   if (!NILP (current_buffer->read_only))
  243.     Fsignal (Qbuffer_read_only, Qnil);
  244.  
  245.   /* Inserting a newline at the end of a line
  246.      produces better redisplay in try_window_id
  247.      than inserting at the ebginning fo a line,
  248.      And the textual result is the same.
  249.      So if at beginning, pretend to be at the end.
  250.      Must avoid internal_self_insert in that case since point is wrong.
  251.      Luckily internal_self_insert's special features all do nothing in that case.  */
  252.  
  253.   flag = point > BEGV && CHAR_AT (point - 1) == '\n';
  254.   if (flag)
  255.     SET_PT (point - 1);
  256.  
  257.   while (XINT (arg) > 0)
  258.     {
  259.       if (flag)
  260.     insert_raw_string (&c1, 1);
  261.       else
  262.     internal_self_insert ('\n', !NILP (arg1));
  263.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  264.     }
  265.  
  266.   if (flag)
  267.     SET_PT (point + 1);
  268.  
  269.   return Qnil;
  270. }
  271.  
  272. void
  273. internal_self_insert (c1, noautofill)
  274.      int c1;
  275.      int noautofill;
  276. {
  277.   extern Lisp_Object Fexpand_abbrev ();
  278.   int hairy = 0;
  279.   Lisp_Object tem;
  280.   register enum syntaxcode synt;
  281.   register int c = (int) c1;
  282.   char s1[1];
  283.  
  284.   s1[0] = c;
  285.  
  286. #if 0
  287.   /* No, this is very bad, it makes undo *always* undo a character at a time
  288.      instead of grouping consecutive self-inserts together.  Nasty nasty.
  289.    */
  290.   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
  291.     hairy = 1;
  292. #endif
  293.  
  294.   if (!NILP (current_buffer->overwrite_mode)
  295.       && point < ZV
  296.       && c != '\n' && CHAR_AT (point) != '\n'
  297.       && (CHAR_AT (point) != '\t'
  298.       || XINT (current_buffer->tab_width) <= 0
  299.       || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
  300.     {
  301.       del_range (point, point + 1);
  302.       hairy = 1;
  303.     }
  304.   if (!NILP (current_buffer->abbrev_mode)
  305.       && SYNTAX (c) != Sword
  306.       && NILP (current_buffer->read_only)
  307.       && point > BEGV && SYNTAX (CHAR_AT (point - 1)) == Sword)
  308.     {
  309.       tem = Fexpand_abbrev ();
  310.       if (!NILP (tem))
  311.     hairy = 1;
  312.     }
  313.   if ((c == ' ' || c == '\n')
  314.       && !noautofill
  315.       && !NILP (current_buffer->auto_fill_function)
  316.       && current_column () > XFASTINT (current_buffer->fill_column))
  317.     {
  318.       if (c1 != '\n')
  319.     insert_raw_string (s1, 1);
  320.       call0 (current_buffer->auto_fill_function);
  321.       if (c1 == '\n')
  322.     insert_raw_string (s1, 1);
  323.       hairy = 1;
  324.     }
  325.   else
  326.     insert_raw_string (s1, 1);
  327.   synt = SYNTAX (c);
  328.   if ((synt == Sclose || synt == Smath)
  329.       && !NILP (Vblink_paren_function) && INTERACTIVE)
  330.     {
  331.       call0 (Vblink_paren_function);
  332.       hairy = 1;
  333.     }
  334. }
  335.  
  336. /* module initialization */
  337.  
  338. void
  339. syms_of_cmds ()
  340. {
  341.   Qkill_backward_chars = intern ("kill-backward-chars");
  342.   staticpro (&Qkill_backward_chars);
  343.  
  344.   Qkill_forward_chars = intern ("kill-forward-chars");
  345.   staticpro (&Qkill_forward_chars);
  346.  
  347.   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
  348.     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
  349. More precisely, a char with closeparen syntax is self-inserted.");
  350.   Vblink_paren_function = Qnil;
  351.  
  352.   defsubr (&Sforward_char);
  353.   defsubr (&Sbackward_char);
  354.   defsubr (&Sforward_line);
  355.   defsubr (&Sbeginning_of_line);
  356.   defsubr (&Send_of_line);
  357.  
  358.   defsubr (&Sdelete_char);
  359.   defsubr (&Sdelete_backward_char);
  360.  
  361.   defsubr (&Sself_insert_command);
  362.   defsubr (&Snewline);
  363. }
  364.  
  365.